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

vermaseren / form / 9364948935

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

Pull #526

github

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

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

32 existing lines in 2 files now uncovered.

41391 of 82816 relevant lines covered (49.98%)

878690.77 hits per line

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

53.41
/sources/argument.c
1
/** @file argument.c
2
 * 
3
 *  Contains the routines that deal with the execution phase of the argument
4
 *        and related statements (like term)
5
 */
6

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

34
/*
35
          #[ include : argument.c
36
*/
37

38
#include "form3.h"
39

40
/*
41
          #] include : 
42
          #[ execarg :
43

44
        Executes the subset of statements in an argument environment.
45
        The calling routine should be of the type
46
        if ( C->lhs[level][0] == TYPEARG ) {
47
                if ( execarg(term,level) ) goto GenCall;
48
                level = C->lhs[level][2];
49
                goto SkipCount;
50
        }
51
        Note that there will be cases in which extra space is needed.
52
        In addition the compare with C->numlhs isn't very fine, because we
53
        need to insert a different value (C->lhs[level][2]).
54
*/
55

56
WORD execarg(PHEAD WORD *term, WORD level)
302,437✔
57
{
58
        GETBIDENTITY
59
        WORD *t, *r, *m, *v;
302,437✔
60
        WORD *start, *stop, *rstop, *r1, *r2 = 0, *r3 = 0, *r4, *r5, *r6, *r7, *r8, *r9;
302,437✔
61
        WORD *mm, *mstop, *rnext, *rr, *factor, type, ngcd, nq;
302,437✔
62
        CBUF *C = cbuf+AM.rbufnum, *CC = cbuf+AT.ebufnum;
302,437✔
63
        WORD i, j, k, oldnumlhs = AR.Cnumlhs, count, action = 0, olddefer = AR.DeferFlag;
302,437✔
64
        WORD oldnumrhs = CC->numrhs, size, pow, jj;
302,437✔
65
        LONG oldcpointer = CC->Pointer - CC->Buffer, oldppointer = AT.pWorkPointer, lp;
302,437✔
66
        WORD *oldwork = AT.WorkPointer, *oldwork2, scale, renorm;
302,437✔
67
        WORD kLCM = 0, kGCD = 0, kGCD2, kkLCM = 0, jLCM = 0, jGCD, sign = 1;
302,437✔
68
        int ii, didpolyratfun;
302,437✔
69
        UWORD *EAscrat, *GCDbuffer = 0, *GCDbuffer2 = 0, *LCMbuffer = 0, *LCMb = 0, *LCMc = 0;
302,437✔
70
        AT.WorkPointer += *term;
302,437✔
71
        start = C->lhs[level];
302,437✔
72
        AR.Cnumlhs = start[2];
302,437✔
73
        stop = start + start[1];
302,437✔
74
        type = *start;
302,437✔
75
        scale = start[4];
302,437✔
76
        renorm = start[5];
302,437✔
77
        start += TYPEARGHEADSIZE;
302,437✔
78
/*
79
          #[ Dollars :
80
*/
81
        if ( renorm && start[1] != 0 ) {/* We have to evaluate $ symbols inside () */
302,437✔
82
                t = start+1; factor = oldwork2 = v = AT.WorkPointer;
×
83
                i = *t; t++;
×
84
                *v++ = i+3; i--; NCOPY(v,t,i);
×
85
                *v++ = 1; *v++ = 1; *v++ = 3;
×
86
                AT.WorkPointer = v;
×
87
                start = t; AR.Eside = LHSIDEX;
×
88
                NewSort(BHEAD0);
×
89
                if ( Generator(BHEAD factor,AR.Cnumlhs) ) {
×
90
                        LowerSortLevel();
×
91
                        AT.WorkPointer = oldwork;
×
92
                        return(-1);
×
93
                }
94
                AT.WorkPointer = v;
×
95
                if ( EndSort(BHEAD factor,0) < 0 ) {}
×
96
                if ( *factor && *(factor+*factor) != 0 ) {
×
97
                        MLOCK(ErrorMessageLock);
×
98
                        MesPrint("&$ in () does not evaluate into a single term");
×
99
                        MUNLOCK(ErrorMessageLock);
×
100
                        return(-1);
×
101
                }
102
                AR.Eside = RHSIDE;
×
103
                if ( *factor > 0 ) {
×
104
                        v = factor+*factor;
×
105
                        v -= ABS(v[-1]);
×
106
                        *factor = v-factor;
×
107
                }
108
                AT.WorkPointer = v;
×
109
        }
110
        else {
111
                if ( *start < 0 ) {
302,437✔
112
                        factor = start + 1;
9,360✔
113
                        start += -*start;
9,360✔
114
                }
115
                else factor = 0;
116
        }
117
/*
118
          #] Dollars : 
119
*/
120
        t = term;
302,437✔
121
        r = t + *t;
302,437✔
122
        rstop = r - ABS(r[-1]);
302,437✔
123
        t++;
302,437✔
124
/*
125
          #[ Argument detection : + argument statement
126
*/
127
/*
128
        Allocate Numbers for MakeInteger here, for re-use in case multiple
129
        functions are treated in the same term.
130
*/
131
        if ( type == TYPENORM4 ) {
302,437✔
132
                GCDbuffer = NumberMalloc("execarg");
20,004✔
133
                GCDbuffer2 = NumberMalloc("execarg");
20,004✔
134
                LCMbuffer = NumberMalloc("execarg");
20,004✔
135
                LCMb = NumberMalloc("execarg"); LCMc = NumberMalloc("execarg");
20,004✔
136
        }
137
        didpolyratfun = 0;
302,437✔
138
        while ( t < rstop ) {
1,672,223✔
139
                if ( *t >= FUNCTION && functions[*t-FUNCTION].spec <= 0 ) {
1,369,789✔
140
/*
141
                        We have a function. First count the number of arguments.
142
                        Tensors are excluded.
143
*/
144
                        count = 0;
1,338,912✔
145
                        v = t;
1,338,912✔
146
                        m = t + FUNHEAD;
1,338,912✔
147
                        r = t + t[1];
1,338,912✔
148
                        while ( m < r ) {
2,703,668✔
149
                                count++;
1,364,756✔
150
                                NEXTARG(m)
1,364,756✔
151
                        }
152
                        if ( count <= 0 ) { t += t[1]; continue; }
1,338,912✔
153
/*
154
                        Now we take the arguments one by one and test for a match
155
*/
156
                        for ( i = 1; i <= count; i++ ) {
2,703,665✔
157
                                m = start;
158
                                while ( m < stop ) {
1,686,266✔
159
                                        r = m + m[1];
1,364,756✔
160
                                        j = *r++;
1,364,756✔
161
                                        if ( j > 1 ) {
1,364,756✔
162
                                                while ( --j > 0 ) {
×
163
                                                        if ( *r == i ) goto RightNum;
×
164
                                                        r++;
×
165
                                                }
166
                                                m = r;
×
167
                                                continue;
×
168
                                        }
169
RightNum:
1,364,756✔
170
                                        if ( m[1] == 2 ) {
1,364,756✔
171
#ifdef WITHFLOAT
172
                                                if ( *t != FLOATFUN || AT.aux_ == 0 || TestFloat(t) == 0 )
12,076✔
173
#endif
174
                                                {
175
                                                        m += 2;
12,076✔
176
                                                        m += *m;
12,076✔
177
                                                        goto HaveTodo;
12,076✔
178
                                                }
179
                                        }
180
                                        else {
181
                                                r = m + m[1];
1,352,680✔
182
                                                m += 2;
1,352,680✔
183
                                                while ( m < r ) {
1,674,194✔
184
                                                        if ( *m == CSET ) {
1,352,684✔
185
                                                                r1 = SetElements + Sets[m[1]].first;
12✔
186
                                                                r2 = SetElements + Sets[m[1]].last;
12✔
187
                                                                while ( r1 < r2 ) {
20✔
188
                                                                        if ( *r1++ == *t ) goto HaveTodo;
12✔
189
                                                                }
190
                                                        }
191
                                                        else if ( m[1] == *t ) goto HaveTodo;
1,352,672✔
192
                                                        m += 2;
321,514✔
193
                                                }
194
                                        }
195
                                        m += *m;
321,510✔
196
                                }
197
                                continue;
321,510✔
198
HaveTodo:
1,043,246✔
199
/*
200
                                If we come here we have to do the argument i (first is 1).
201
*/
202
                                sign = 1;
1,043,246✔
203
                                action = 1;
1,043,246✔
204
                                if ( *t == AR.PolyFun ) didpolyratfun = 1;
1,043,246✔
205
                                v[2] |= DIRTYFLAG;
1,043,246✔
206
                                r = t + FUNHEAD;
1,043,246✔
207
                                j = i;
1,043,246✔
208
                                while ( --j > 0 ) { NEXTARG(r) }
1,048,646✔
209
                                if ( ( type == TYPESPLITARG ) || ( type == TYPESPLITFIRSTARG )
1,043,246✔
210
                                 || ( type == TYPESPLITLASTARG ) ) {
1,043,246✔
211
                                        if ( *t > FUNCTION && *r > 0 ) {
×
212
                                                WantAddPointers(2);
×
213
                                                AT.pWorkSpace[AT.pWorkPointer++] = t;
×
214
                                                AT.pWorkSpace[AT.pWorkPointer++] = r;
×
215
                                        }
216
                                        continue;
×
217
                                }
218
                                else if ( type == TYPESPLITARG2 ) {
1,043,246✔
219
                                        if ( *t > FUNCTION && *r > 0 ) {
7,452✔
220
                                                WantAddPointers(2);
3,676✔
221
                                                AT.pWorkSpace[AT.pWorkPointer++] = t;
3,676✔
222
                                                AT.pWorkSpace[AT.pWorkPointer++] = r;
3,676✔
223
                                        }
224
                                        continue;
7,452✔
225
                                }
226
                                else if ( type == TYPEFACTARG || type == TYPEFACTARG2 ) {
1,035,794✔
227
                                        if ( *t > FUNCTION || *t == DENOMINATOR ) {
9,535✔
228
                                                if ( *r > 0 ) {
9,535✔
229
                                                mm = r + ARGHEAD; mstop = r + *r;
5,151✔
230
                                                if ( mm + *mm < mstop ) {
5,151✔
231
                                                        WantAddPointers(2);
5,099✔
232
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
5,063✔
233
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
5,063✔
234
                                                        continue;
5,063✔
235
                                                }
236
                                                if ( *mm == 1+ABS(mstop[-1]) ) continue;
88✔
237
                                                if ( mstop[-3] != 1 || mstop[-2] != 1
88✔
238
                                                        || mstop[-1] != 3 ) {
56✔
239
                                                        WantAddPointers(2);
36✔
240
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
32✔
241
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
32✔
242
                                                        continue;
32✔
243
                                                }
244
                                                GETSTOP(mm,mstop); mm++;
56✔
245
                                                if ( mm + mm[1] < mstop ) {
56✔
246
                                                        WantAddPointers(2);
20✔
247
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
16✔
248
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
16✔
249
                                                        continue;
16✔
250
                                                }
251
                                                if ( *mm == SYMBOL && ( mm[1] > 4 ||
40✔
252
                                                        ( mm[3] != 1 && mm[3] != -1 ) ) ) {
32✔
253
                                                        WantAddPointers(2);
37✔
254
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
36✔
255
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
36✔
256
                                                        continue;
36✔
257
                                                }
258
                                                else if ( *mm == DOTPRODUCT && ( mm[1] > 5 ||
4✔
259
                                                        ( mm[4] != 1 && mm[4] != -1 ) ) ) {
×
260
                                                        WantAddPointers(2);
8✔
261
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
4✔
262
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
4✔
263
                                                        continue;
4✔
264
                                                }
265
                                                else if ( ( *mm == DELTA || *mm == VECTOR )
×
266
                                                         && mm[1] > 4 ) {
×
267
                                                        WantAddPointers(2);
×
268
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
×
269
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
×
270
                                                        continue;
×
271
                                                }
272
                                                }
273
                                                else if ( factor && *factor == 4 && factor[2] == 1 ) {
4,384✔
274
                                                        WantAddPointers(2);
×
275
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
×
276
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
×
277
                                                        continue;
×
278
                                                }
279
                                                else if ( factor && *factor == 0
4,384✔
280
                                                && ( *r == -SNUMBER && r[1] != 1 ) ) {
×
281
                                                        WantAddPointers(2);
×
282
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
×
283
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
×
284
                                                        continue;
×
285
                                                }
286
                                                else if ( *r == -MINVECTOR ) {
4,384✔
287
                                                        WantAddPointers(2);
×
288
                                                        AT.pWorkSpace[AT.pWorkPointer++] = t;
×
289
                                                        AT.pWorkSpace[AT.pWorkPointer++] = r;
×
290
                                                        continue;
×
291
                                                }
292
                                        }
293
                                        continue;
4,384✔
294
                                }
295
                                else if ( type == TYPENORM || type == TYPENORM2 || type == TYPENORM3 || type == TYPENORM4 ) {
1,026,259✔
296
                                        if ( *r < 0 ) {
1,000,668✔
297
                                                WORD rone;
152✔
298
                                                if ( *r == -MINVECTOR ) { rone = -1; *r = -INDEX; }
152✔
299
                                                else if ( *r != -SNUMBER || r[1] == 1 || r[1] == 0 ) continue;
152✔
300
                                                else { rone = r[1]; r[1] = 1; }
×
301
/*
302
                                                Now we must multiply the general coefficient by r[1]
303
*/
304
                                                if ( scale && ( factor == 0 || *factor ) ) {
8✔
305
                                                        action = 1;
4✔
306
                                                        v[2] |= DIRTYFLAG;
4✔
307
                                                        if ( rone < 0 ) {
4✔
308
                                                                if ( type == TYPENORM3 ) k = 1;
4✔
309
                                                                else k = -1;
4✔
310
                                                                rone = -rone;
4✔
311
                                                        }
312
                                                        else k = 1;
313
                                                        r1 = term + *term;
4✔
314
                                                        size = r1[-1];
4✔
315
                                                        size = REDLENG(size);
4✔
316
                                                        if ( scale > 0 ) {
4✔
317
                                                                for ( jj = 0; jj < scale; jj++ ) {
8✔
318
                                                                        if ( Mully(BHEAD (UWORD *)rstop,&size,(UWORD *)(&rone),k) )
4✔
319
                                                                                goto execargerr;
×
320
                                                                }
321
                                                        }
322
                                                        else {
323
                                                                for ( jj = 0; jj > scale; jj-- ) {
×
324
                                                                        if ( Divvy(BHEAD (UWORD *)rstop,&size,(UWORD *)(&rone),k) )
×
325
                                                                                goto execargerr;
×
326
                                                                }
327
                                                        }
328
                                                        size = INCLENG(size);
4✔
329
                                                        k = size < 0 ? -size: size;
4✔
330
                                                        rstop[k-1] = size;
4✔
331
                                                        *term = (WORD)(rstop - term) + k;
4✔
332
                                                }
333
                                                continue;
8✔
334
                                        }
335
/*
336
                                        Now we have to find a reference term.
337
                                        If factor is defined and *factor != 0 we have to
338
                                        look for the first term that matches the pattern exactly
339
                                        Otherwise the first term plays this role
340
                                        If its coefficient is not one,
341
                                        we must set up a division of the whole argument by
342
                                        this coefficient, and a multiplication of the term
343
                                        when the type is not equal to TYPENORM2.
344
                                        We first multiply the coefficient of the term.
345
                                        Then we set up the division.
346

347
                                        First find the magic term
348
*/
349
                                        if ( type == TYPENORM4 ) {
1,000,516✔
350
/*
351
                                                For normalizing everything to integers we have to
352
                                                determine for all elements of this argument the LCM of
353
                                                the denominators and the GCD of the numerators.
354
                                                The buffers have been allocated already.
355
*/
356
                                                r4 = r + *r;
1,000,004✔
357
                                                r1 = r + ARGHEAD;
1,000,004✔
358
/*
359
                                                First take the first term to load up the LCM and the GCD
360
*/
361
                                                r2 = r1 + *r1;
1,000,004✔
362
                                                j = r2[-1];
1,000,004✔
363
                                                if ( j < 0 ) sign = -1;
1,000,004✔
364
                                                r3 = r2 - ABS(j);
1,000,004✔
365
                                                k = REDLENG(j);
1,000,004✔
366
                                                if ( k < 0 ) k = -k;
1,000,004✔
367
                                                while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
1,000,004✔
368
                                                for ( kGCD = 0; kGCD < k; kGCD++ ) GCDbuffer[kGCD] = r3[kGCD];
2,000,008✔
369
                                                k = REDLENG(j);
1,000,004✔
370
                                                if ( k < 0 ) k = -k;
1,000,004✔
371
                                                r3 += k;
1,000,004✔
372
                                                while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
1,000,004✔
373
                                                for ( kLCM = 0; kLCM < k; kLCM++ ) LCMbuffer[kLCM] = r3[kLCM];
2,000,008✔
374
                                                r1 = r2;
375
/*
376
                                                Now go through the rest of the terms in this argument.
377
*/
378
                                                while ( r1 < r4 ) {
2,000,012✔
379
                                                        r2 = r1 + *r1;
1,000,008✔
380
                                                        j = r2[-1];
1,000,008✔
381
                                                        r3 = r2 - ABS(j);
1,000,008✔
382
                                                        k = REDLENG(j);
1,000,008✔
383
                                                        if ( k < 0 ) k = -k;
1,000,008✔
384
                                                        while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
1,000,008✔
385
                                                        if ( ( ( GCDbuffer[0] == 1 ) && ( kGCD == 1 ) ) ) {
1,000,008✔
386
/*
387
                                                                GCD is already 1
388
*/
389
                                                        }
390
                                                        else if ( ( ( k != 1 ) || ( r3[0] != 1 ) ) ) {
8✔
391
                                                                if ( GcdLong(BHEAD GCDbuffer,kGCD,(UWORD *)r3,k,GCDbuffer2,&kGCD2) ) {
8✔
392
                                                                        NumberFree(GCDbuffer,"execarg");
×
393
                                                                        NumberFree(GCDbuffer2,"execarg");
×
394
                                                                        NumberFree(LCMbuffer,"execarg");
×
395
                                                                        NumberFree(LCMb,"execarg"); NumberFree(LCMc,"execarg");
×
396
                                                                        goto execargerr;
×
397
                                                                }
398
                                                                kGCD = kGCD2;
8✔
399
                                                                for ( ii = 0; ii < kGCD; ii++ ) GCDbuffer[ii] = GCDbuffer2[ii];
16✔
400
                                                        }
401
                                                        else {
402
                                                                kGCD = 1; GCDbuffer[0] = 1;
×
403
                                                        }
404
                                                        k = REDLENG(j);
1,000,008✔
405
                                                        if ( k < 0 ) k = -k;
1,000,008✔
406
                                                        r3 += k;
1,000,008✔
407
                                                        while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
1,000,008✔
408
                                                        if ( ( ( LCMbuffer[0] == 1 ) && ( kLCM == 1 ) ) ) {
1,000,008✔
409
                                                                for ( kLCM = 0; kLCM < k; kLCM++ )
400✔
410
                                                                        LCMbuffer[kLCM] = r3[kLCM];
200✔
411
                                                        }
412
                                                        else if ( ( k != 1 ) || ( r3[0] != 1 ) ) {
999,808✔
413
                                                                if ( GcdLong(BHEAD LCMbuffer,kLCM,(UWORD *)r3,k,LCMb,&kkLCM) ) {
8✔
414
                                                                        NumberFree(GCDbuffer,"execarg"); NumberFree(GCDbuffer2,"execarg");
×
415
                                                                        NumberFree(LCMbuffer,"execarg"); NumberFree(LCMb,"execarg"); NumberFree(LCMc,"execarg");
×
416
                                                                        goto execargerr;
×
417
                                                                }
418
                                                                DivLong((UWORD *)r3,k,LCMb,kkLCM,LCMb,&kkLCM,LCMc,&jLCM);
8✔
419
                                                                MulLong(LCMbuffer,kLCM,LCMb,kkLCM,LCMc,&jLCM);
8✔
420
                                                                for ( kLCM = 0; kLCM < jLCM; kLCM++ )
24✔
421
                                                                        LCMbuffer[kLCM] = LCMc[kLCM];
8✔
422
                                                        }
423
                                                        else {} /* LCM doesn't change */
424
                                                        r1 = r2;
425
                                                }
426
/*
427
                                                Now put the factor together: GCD/LCM
428
*/
429
                                                r3 = (WORD *)(GCDbuffer);
1,000,004✔
430
                                                if ( kGCD == kLCM ) {
1,000,004✔
431
                                                        for ( jGCD = 0; jGCD < kGCD; jGCD++ )
2,000,008✔
432
                                                                r3[jGCD+kGCD] = LCMbuffer[jGCD];
1,000,004✔
433
                                                        k = kGCD;
434
                                                }
435
                                                else if ( kGCD > kLCM ) {
×
436
                                                        for ( jGCD = 0; jGCD < kLCM; jGCD++ )
×
437
                                                                r3[jGCD+kGCD] = LCMbuffer[jGCD];
×
438
                                                        for ( jGCD = kLCM; jGCD < kGCD; jGCD++ )
×
439
                                                                r3[jGCD+kGCD] = 0;
×
440
                                                        k = kGCD;
441
                                                }
442
                                                else {
443
                                                        for ( jGCD = kGCD; jGCD < kLCM; jGCD++ )
×
444
                                                                r3[jGCD] = 0;
×
445
                                                        for ( jGCD = 0; jGCD < kLCM; jGCD++ )
×
446
                                                                r3[jGCD+kLCM] = LCMbuffer[jGCD];
×
447
                                                        k = kLCM;
448
                                                }
449

450
                                                j = 2*k+1;
1,000,004✔
451
/*
452
                                                Now we have to correct the overall factor
453
*/
454
                                                if ( scale && ( factor == 0 || *factor > 0 ) )
1,000,004✔
455
                                                        goto ScaledVariety;
1,000,004✔
456
/*
457
                                                The if was added 28-nov-2012 to give MakeInteger also
458
                                                the (0) option.
459
*/
460
                                                if ( scale && ( factor == 0 || *factor ) ) {
×
461
                                                        size = term[*term-1];
×
462
                                                        size = REDLENG(size);
×
463
                                                        if ( MulRat(BHEAD (UWORD *)rstop,size,(UWORD *)r3,k,
×
464
                                                                        (UWORD *)rstop,&size) ) goto execargerr;
×
465
                                                        size = INCLENG(size);
×
466
                                                        k = size < 0 ? -size: size;
×
467
                                                        rstop[k-1] = size*sign;
×
468
                                                        *term = (WORD)(rstop - term) + k;
×
469
                                                }
470
                                        }
471
                                        else {
472
                                                if ( factor && *factor >= 1 ) {
512✔
473
                                                        r4 = r + *r;
×
474
                                                        r1 = r + ARGHEAD;
×
475
                                                        while ( r1 < r4 ) {
×
476
                                                                r2 = r1 + *r1;
×
477
                                                                r3 = r2 - ABS(r2[-1]);
×
478
                                                                j = r3 - r1;
×
479
                                                                r5 = factor;
×
480
                                                                if ( j != *r5 ) { r1 = r2; continue; }
×
481
                                                                r5++; r6 = r1+1;
×
482
                                                                while ( --j > 0 ) {
×
483
                                                                        if ( *r5 != *r6 ) break;
×
484
                                                                        r5++; r6++;
×
485
                                                                }
486
                                                                if ( j > 0 ) { r1 = r2; continue; }
×
487
                                                                break;
488
                                                        }
489
                                                        if ( r1 >= r4 ) continue;
×
490
                                                }
491
                                                else {
492
                                                        r1 = r + ARGHEAD;
512✔
493
                                                        r2 = r1 + *r1;
512✔
494
                                                        r3 = r2 - ABS(r2[-1]);
512✔
495
                                                }
496
                                                if ( *r3 == 1 && r3[1] == 1 ) {
512✔
497
                                                        if ( r2[-1] == 3 ) continue;
488✔
498
                                                        if ( r2[-1] == -3 && type == TYPENORM3 ) continue;
×
499
                                                }
500
                                                action = 1;
24✔
501
                                                v[2] |= DIRTYFLAG;
24✔
502
                                                j = r2[-1];
24✔
503
                                                k = REDLENG(j);
24✔
504
                                                if ( j < 0 ) j = -j;
24✔
505
                                                if ( type == TYPENORM && scale && ( factor == 0 || *factor ) ) {
24✔
506
/*
507
                                                        Now we correct the overall factor
508
*/
509
ScaledVariety:;
24✔
510
                                                        size = term[*term-1];
1,000,028✔
511
                                                        size = REDLENG(size);
1,000,028✔
512
                                                        if ( scale > 0 ) {
1,000,028✔
513
                                                                for ( jj = 0; jj < scale; jj++ ) {
2,000,024✔
514
                                                                        if ( MulRat(BHEAD (UWORD *)rstop,size,(UWORD *)r3,k,
1,000,012✔
515
                                                                                (UWORD *)rstop,&size) ) goto execargerr;
×
516
                                                                }
517
                                                        }
518
                                                        else {
519
                                                                for ( jj = 0; jj > scale; jj-- ) {
32✔
520
                                                                        if ( DivRat(BHEAD (UWORD *)rstop,size,(UWORD *)r3,k,
16✔
521
                                                                                (UWORD *)rstop,&size) ) goto execargerr;
×
522
                                                                }
523
                                                        }
524
                                                        size = INCLENG(size);
1,000,028✔
525
                                                        k = size < 0 ? -size: size;
1,000,028✔
526
                                                        rstop[k-1] = size*sign;
1,000,028✔
527
                                                        *term = (WORD)(rstop - term) + k;
1,000,028✔
528
                                                }
529
                                        }
530
/*
531
                          We generate a statement for adapting all terms in the
532
                                        argument successively
533
*/
534
                                        r4 = AddRHS(AT.ebufnum,1);
1,000,028✔
535
                                        while ( (r4+j+12) > CC->Top ) r4 = DoubleCbuffer(AT.ebufnum,r4,3);
1,000,028✔
536
                                        *r4++ = j+1;
1,000,028✔
537
                                        i = (j-1)/2;  /* was (j-1)*2  ????? 17-oct-2017 */
1,000,028✔
538
                                        for ( k = 0; k < i; k++ ) *r4++ = r3[i+k];
2,000,056✔
539
                                        for ( k = 0; k < i; k++ ) *r4++ = r3[k];
2,000,056✔
540
                                        if ( ( type == TYPENORM3 ) || ( type == TYPENORM4 ) ) *r4++ = j*sign;
1,000,028✔
541
                                        else *r4++ = r3[j-1];
24✔
542
                                        *r4++ = 0;
1,000,028✔
543
                                        CC->rhs[CC->numrhs+1] = r4;
1,000,028✔
544
                                        CC->Pointer = r4;
1,000,028✔
545
                                        AT.mulpat[5] = CC->numrhs;
1,000,028✔
546
                                        AT.mulpat[7] = AT.ebufnum;
1,000,028✔
547
                                }
548
                                else if ( type == TYPEARGTOEXTRASYMBOL ) {
25,591✔
549
                                        WORD n;
6,076✔
550
                                        if ( r[0] < 0 ) {
6,076✔
551
                                                /* The argument is in the fast notation. */
552
                                                WORD tmp[MaX(9,FUNHEAD+5)];
56✔
553
                                                switch ( r[0] ) {
56✔
554
                                                        case -SNUMBER:
20✔
555
                                                                if ( r[1] == 0 ) {
20✔
556
                                                                        tmp[0] = 0;
4✔
557
                                                                }
558
                                                                else {
559
                                                                        tmp[0] = 4;
16✔
560
                                                                        tmp[1] = ABS(r[1]);
16✔
561
                                                                        tmp[2] = 1;
16✔
562
                                                                        tmp[3] = r[1] > 0 ? 3 : -3;
16✔
563
                                                                        tmp[4] = 0;
16✔
564
                                                                }
565
                                                                break;
566
                                                        case -SYMBOL:
20✔
567
                                                                tmp[0] = 8;
20✔
568
                                                                tmp[1] = SYMBOL;
20✔
569
                                                                tmp[2] = 4;
20✔
570
                                                                tmp[3] = r[1];
20✔
571
                                                                tmp[4] = 1;
20✔
572
                                                                tmp[5] = 1;
20✔
573
                                                                tmp[6] = 1;
20✔
574
                                                                tmp[7] = 3;
20✔
575
                                                                tmp[8] = 0;
20✔
576
                                                                break;
20✔
577
                                                        case -INDEX:
12✔
578
                                                        case -VECTOR:
579
                                                        case -MINVECTOR:
580
                                                                tmp[0] = 7;
12✔
581
                                                                tmp[1] = INDEX;
12✔
582
                                                                tmp[2] = 3;
12✔
583
                                                                tmp[3] = r[1];
12✔
584
                                                                tmp[4] = 1;
12✔
585
                                                                tmp[5] = 1;
12✔
586
                                                                tmp[6] = r[0] != -MINVECTOR ? 3 : -3;
12✔
587
                                                                tmp[7] = 0;
12✔
588
                                                                break;
12✔
589
                                                        default:
4✔
590
                                                                if ( r[0] <= -FUNCTION ) {
4✔
591
                                                                        tmp[0] = FUNHEAD+4;
4✔
592
                                                                        tmp[1] = -r[0];
4✔
593
                                                                        tmp[2] = FUNHEAD;
4✔
594
                                                                        ZeroFillRange(tmp,3,1+FUNHEAD);
8✔
595
                                                                        tmp[FUNHEAD+1] = 1;
4✔
596
                                                                        tmp[FUNHEAD+2] = 1;
4✔
597
                                                                        tmp[FUNHEAD+3] = 3;
4✔
598
                                                                        tmp[FUNHEAD+4] = 0;
4✔
599
                                                                        break;
4✔
600
                                                                }
601
                                                                else {
602
                                                                        MLOCK(ErrorMessageLock);
×
603
                                                                        MesPrint("Unknown fast notation found (TYPEARGTOEXTRASYMBOL)");
×
604
                                                                        MUNLOCK(ErrorMessageLock);
×
605
                                                                        return(-1);
×
606
                                                                }
607
                                                }
608
                                                n = FindSubexpression(tmp);
56✔
609
                                        }
610
                                        else {
611
                                                /*
612
                                                 * NOTE: writing to r[r[0]] is legal. As long as we work
613
                                                 * in a part of the term, at least the coefficient of
614
                                                 * the term must follow.
615
                                                 */
616
                                                WORD old_rr0 = r[r[0]];
6,020✔
617
                                                r[r[0]] = 0;  /* zero-terminated */
6,020✔
618
                                                n = FindSubexpression(r+ARGHEAD);
6,020✔
619
                                                r[r[0]] = old_rr0;
6,020✔
620
                                        }
621
                                        /* Put the new argument in the work space. */
622
                                        if ( AT.WorkPointer+2 > AT.WorkTop ) {
6,076✔
623
                                                MLOCK(ErrorMessageLock);
×
624
                                                MesWork();
×
625
                                                MUNLOCK(ErrorMessageLock);
×
626
                                                return(-1);
×
627
                                        }
628
                                        r1 = AT.WorkPointer;
6,076✔
629
                                        if ( scale ) {  /* means "tonumber" */
6,076✔
630
                                                r1[0] = -SNUMBER;
16✔
631
                                                r1[1] = n;
16✔
632
                                        }
633
                                        else {
634
                                                r1[0] = -SYMBOL;
6,060✔
635
                                                r1[1] = MAXVARIABLES-n;
6,060✔
636
                                        }
637
                                        /* We need r2, r3, m and k to shift the data. */
638
                                        r2 = r + (r[0] > 0 ? r[0] : r[0] <= -FUNCTION ? 1 : 2);
6,076✔
639
                                        r3 = r;
6,076✔
640
                                        m = r1+ARGHEAD+2;
6,076✔
641
                                        k = 2;
6,076✔
642
                                        goto do_shift;
6,076✔
643
                                }
644
                                r3 = r;
1,019,543✔
645
                                AR.DeferFlag = 0;
1,019,543✔
646
                                if ( *r > 0 ) {
1,019,543✔
647
                                        NewSort(BHEAD0);
1,005,559✔
648
                                        action = 1;
1,005,559✔
649
                                        r2 = r + *r;
1,005,559✔
650
                                        r += ARGHEAD;
1,005,559✔
651
                                        while ( r < r2 ) {        /* Sum over the terms */
3,023,671✔
652
                                                m = AT.WorkPointer;
2,018,115✔
653
                                                j = *r;
2,018,115✔
654
                                                while ( --j >= 0 ) *m++ = *r++;
14,187,150✔
655
                                                r1 = AT.WorkPointer;
2,018,115✔
656
                                                AT.WorkPointer = m;
2,018,115✔
657
/*
658
                                                What to do with dummy indices?
659
*/
660
                                                if ( type == TYPENORM || type == TYPENORM2 || type == TYPENORM3 || type == TYPENORM4 ) {
2,018,115✔
661
                                                        if ( MultDo(BHEAD r1,AT.mulpat) ) goto execargerr;
2,000,060✔
662
                                                        AT.WorkPointer = r1 + *r1;
2,000,060✔
663
                                                }
664
                                                if ( Generator(BHEAD r1,level) ) goto execargerr;
2,018,115✔
665
                                                AT.WorkPointer = r1;
2,018,112✔
666
                                        }
667
                                }
668
                                else {
669
                                        r2 = r + (( *r <= -FUNCTION ) ? 1:2);
13,984✔
670
                                        r1 = AT.WorkPointer;
13,984✔
671
                                        ToGeneral(r,r1,0);
13,984✔
672
                                        m = r1 + ARGHEAD;
13,984✔
673
                                        AT.WorkPointer = r1 + *r1;
13,984✔
674
                                        NewSort(BHEAD0);
13,984✔
675
                                        action = 1;
13,984✔
676
/*
677
                                        What to do with dummy indices?
678
*/
679
                                        if ( type == TYPENORM || type == TYPENORM2 || type == TYPENORM3 || type == TYPENORM4 ) {
13,984✔
680
                                                if ( MultDo(BHEAD m,AT.mulpat) ) goto execargerr;
×
681
                                                AT.WorkPointer = m + *m;
×
682
                                        }
683
                                        if ( (*m != 0 ) && Generator(BHEAD m,level) ) goto execargerr;
13,984✔
684
                                        AT.WorkPointer = r1;
13,984✔
685
                                }
686
                                if ( EndSort(BHEAD AT.WorkPointer+ARGHEAD,1) < 0 ) goto execargerr;
1,019,540✔
687
                                AR.DeferFlag = olddefer;
1,019,540✔
688
/*
689
                                Now shift the sorted entity over the old argument.
690
*/
691
                                m = AT.WorkPointer+ARGHEAD;
1,019,540✔
692
                                while ( *m ) m += *m;
3,055,240✔
693
                                k = WORDDIF(m,AT.WorkPointer);
1,019,540✔
694
                                *AT.WorkPointer = k;
1,019,540✔
695
                                AT.WorkPointer[1] = 0;
1,019,540✔
696
                                if ( ToFast(AT.WorkPointer,AT.WorkPointer) ) {
1,019,540✔
697
                                        if ( *AT.WorkPointer <= -FUNCTION ) k = 1;
8,452✔
698
                                        else k = 2;
8,452✔
699
                                }
700
do_shift:
1,011,088✔
701
                                if ( *r3 > 0 ) j = k - *r3;
1,025,616✔
702
                                else if ( *r3 <= -FUNCTION ) j = k - 1;
14,040✔
703
                                else j = k - 2;
14,036✔
704

705
                                t[1] += j;
1,025,616✔
706
                                action = 1;
1,025,616✔
707
                                v[2] |= DIRTYFLAG;
1,025,616✔
708
                                if ( j > 0 ) {
1,025,616✔
709
                                        r = m + j;
6,012✔
710
                                        while ( m > AT.WorkPointer ) *--r = *--m;
139,500✔
711
                                        AT.WorkPointer = r;
6,012✔
712
                                        m = term + *term;
6,012✔
713
                                        r = m + j;
6,012✔
714
                                        while ( m > r2 ) *--r = *--m;
54,064✔
715
                                }
716
                                else if ( j < 0 ) {
1,019,604✔
717
                                        r = r2 + j;
7,164✔
718
                                        r1 = term + *term;
7,164✔
719
                                        while ( r2 < r1 ) *r++ = *r2++;
134,460✔
720
                                }
721
                                r = r3;
1,025,616✔
722
                                m = AT.WorkPointer;
1,025,616✔
723
                                NCOPY(r,m,k);
15,306,520✔
724
                                *term += j;
1,025,616✔
725
                                rstop += j;
1,025,616✔
726
                                CC->numrhs = oldnumrhs;
1,025,616✔
727
                                CC->Pointer = CC->Buffer + oldcpointer;
1,025,616✔
728
                        }
729
                }
730
                t += t[1];
1,369,786✔
731
        }
732
/*
733
                If TYPENORM4, we allocated Number buffers before the above while loop. Free them.
734
*/
735
        if ( type == TYPENORM4 ) {
302,434✔
736
                NumberFree(GCDbuffer,"execarg");
20,004✔
737
                NumberFree(GCDbuffer2,"execarg");
20,004✔
738
                NumberFree(LCMbuffer,"execarg");
20,004✔
739
                NumberFree(LCMb,"execarg"); NumberFree(LCMc,"execarg");
20,004✔
740
        }
741
        if ( didpolyratfun ) {
302,434✔
742
                PolyFunDirty(BHEAD term);
4✔
743
                didpolyratfun = 0;
4✔
744
        }
745
/*
746
          #] Argument detection : 
747
          #[ SplitArg : + varieties
748
*/
749
        if ( ( type == TYPESPLITARG || type == TYPESPLITARG2
302,434✔
750
         || type == TYPESPLITFIRSTARG || type == TYPESPLITLASTARG ) && 
302,434✔
751
        AT.pWorkPointer > oldppointer ) {
9,240✔
752
                t = term+1;
3,660✔
753
                r1 = AT.WorkPointer + 1;
3,660✔
754
                lp = oldppointer;
3,660✔
755
                while ( t < rstop ) {
16,420✔
756
                        if ( lp < AT.pWorkPointer && t == AT.pWorkSpace[lp] ) {
12,760✔
757
                                v = t;
3,676✔
758
                                m = t + FUNHEAD;
3,676✔
759
                                r = t + t[1];
3,676✔
760
                                r2 = r1; while ( t < m ) *r1++ = *t++;
14,704✔
761
                                while ( m < r ) {
7,352✔
762
                                        t = m;
3,676✔
763
                                        NEXTARG(m)
3,676✔
764
                                        if ( lp >= AT.pWorkPointer || t != AT.pWorkSpace[lp+1] ) {
3,676✔
765
                                                if ( *t > 0 ) t[1] = 0;
×
766
                                                while ( t < m ) *r1++ = *t++;
×
767
                                                continue;
×
768
                                        }
769
/*
770
                                        Now we have a nontrivial argument that should be done.
771
*/
772
                                        lp += 2;
3,676✔
773
                                        action = 1;
3,676✔
774
                                        v[2] |= DIRTYFLAG;
3,676✔
775
                                        r3 = t + *t;
3,676✔
776
                                        t += ARGHEAD;
3,676✔
777
                                        if ( type == TYPESPLITFIRSTARG ) {
3,676✔
778
                                                r4 = r1; r5 = t; r7 = oldwork;
×
779
                                                *r1++ = *t + ARGHEAD;
×
780
                                                for ( i = 1; i < ARGHEAD; i++ ) *r1++ = 0;
×
781
                                                j = 0;
782
                                                while ( t < r3 ) {
×
783
                                                        i = *t;
×
784
                                                        if ( j == 0 ) {
×
785
                                                                NCOPY(r7,t,i)
×
786
                                                                j++;
×
787
                                                        }
788
                                                        else {
789
                                                                NCOPY(r1,t,i)
×
790
                                                        }
791
                                                }
792
                                                *r4 = r1 - r4;
×
793
                                                if ( j ) {
×
794
                                                        if ( ToFast(r4,r4) ) {
×
795
                                                                r1 = r4;
×
796
                                                                if ( *r1 > -FUNCTION ) r1++;
×
797
                                                                r1++;
×
798
                                                        }
799
                                                        r7 = oldwork;
800
                                                        while ( --j >= 0 ) {
×
801
                                                                r4 = r1; i = *r7;
×
802
                                                                *r1++ = i+ARGHEAD; *r1++ = 0;
×
803
                                                                FILLARG(r1);
×
804
                                                                NCOPY(r1,r7,i)
×
805
                                                                if ( ToFast(r4,r4) ) {
×
806
                                                                        r1 = r4;
×
807
                                                                        if ( *r1 > -FUNCTION ) r1++;
×
808
                                                                        r1++;
×
809
                                                                }
810
                                                        }
811
                                                }
812
                                                t = r3;
813
                                        }
814
                                        else if ( type == TYPESPLITLASTARG ) {
3,676✔
815
                                                r4 = r1; r5 = t; r7 = oldwork;
×
816
                                                *r1++ = *t + ARGHEAD;
×
817
                                                for ( i = 1; i < ARGHEAD; i++ ) *r1++ = 0;
×
818
                                                j = 0;
819
                                                while ( t < r3 ) {
×
820
                                                        i = *t;
×
821
                                                        if ( t+i >= r3 ) {
×
822
                                                                NCOPY(r7,t,i)
×
823
                                                                j++;
×
824
                                                        }
825
                                                        else {
826
                                                                NCOPY(r1,t,i)
×
827
                                                        }
828
                                                }
829
                                                *r4 = r1 - r4;
×
830
                                                if ( j ) {
×
831
                                                        if ( ToFast(r4,r4) ) {
×
832
                                                                r1 = r4;
×
833
                                                                if ( *r1 > -FUNCTION ) r1++;
×
834
                                                                r1++;
×
835
                                                        }
836
                                                        r7 = oldwork;
837
                                                        while ( --j >= 0 ) {
×
838
                                                                r4 = r1; i = *r7;
×
839
                                                                *r1++ = i+ARGHEAD; *r1++ = 0;
×
840
                                                                FILLARG(r1);
×
841
                                                                NCOPY(r1,r7,i)
×
842
                                                                if ( ToFast(r4,r4) ) {
×
843
                                                                        r1 = r4;
×
844
                                                                        if ( *r1 > -FUNCTION ) r1++;
×
845
                                                                        r1++;
×
846
                                                                }
847
                                                        }
848
                                                }
849
                                                t = r3;
850
                                        }
851
                                        else if ( factor == 0 || ( type == TYPESPLITARG2 && *factor == 0 ) ) {
3,676✔
852
                                                while ( t < r3 ) {
×
853
                                                        r4 = r1;
×
854
                                                        *r1++ = *t + ARGHEAD;                                        
×
855
                                                        for ( i = 1; i < ARGHEAD; i++ ) *r1++ = 0;
×
856
                                                        i = *t;
×
857
                                                        while ( --i >= 0 ) *r1++ = *t++;
×
858
                                                        if ( ToFast(r4,r4) ) {
×
859
                                                                r1 = r4;
×
860
                                                                if ( *r1 > -FUNCTION ) r1++;
×
861
                                                                r1++;
×
862
                                                        }
863
                                                }
864
                                        }
865
                                        else if ( type == TYPESPLITARG2 ) {
3,676✔
866
/*
867
                                                Here we better put the pattern matcher at work?
868
                                                Remember: there are no wildcards.
869
*/
870
                                                WORD *oRepFunList = AN.RepFunList;
3,676✔
871
                                                WORD *oWildMask = AT.WildMask, *oWildValue = AN.WildValue;
3,676✔
872
                                                AN.WildValue = AT.locwildvalue; AT.WildMask = AT.locwildvalue+2;
3,676✔
873
                                                AN.NumWild = 0;
3,676✔
874
                                                r4 = r1; r5 = t; r7 = oldwork;
3,676✔
875
                                                *r1++ = *t + ARGHEAD;
3,676✔
876
                                                for ( i = 1; i < ARGHEAD; i++ ) *r1++ = 0;
7,352✔
877
                                                j = 0;
878
                                                while ( t < r3 ) {
18,360✔
879
                                                        AN.UseFindOnly = 0; oldwork2 = AT.WorkPointer;
14,684✔
880
                                                        AN.RepFunList = r1;
14,684✔
881
                                                        AT.WorkPointer = r1+AN.RepFunNum+2;
14,684✔
882
                                                        i = *t;
14,684✔
883
                                                        if ( FindRest(BHEAD t,factor) &&
14,684✔
884
                                                         ( AN.UsedOtherFind || FindOnce(BHEAD t,factor) ) ) {
14,684✔
885
                                                                NCOPY(r7,t,i)
116,024✔
886
                                                                j++;
10,576✔
887
                                                        }
888
                                                        else if ( factor[0] == FUNHEAD+1 && factor[1] >= FUNCTION ) {
4,108✔
889
                                                                WORD *rr1 = t+1, *rr2 = t+i;
×
890
                                                                rr2 -= ABS(rr2[-1]);
×
891
                                                                while ( rr1 < rr2 ) {
×
892
                                                                        if ( *rr1 == factor[1] ) break;
×
893
                                                                        rr1 += rr1[1];
×
894
                                                                }
895
                                                                if ( rr1 < rr2 ) {
×
896
                                                                        NCOPY(r7,t,i)
×
897
                                                                        j++;
×
898
                                                                }
899
                                                                else {
900
                                                                        NCOPY(r1,t,i)
×
901
                                                                }
902
                                                        }
903
                                                        else {
904
                                                                NCOPY(r1,t,i)
36,348✔
905
                                                        }
906
                                                        AT.WorkPointer = oldwork2;
14,684✔
907
                                                }
908
                                                AN.RepFunList = oRepFunList;
3,676✔
909
                                                *r4 = r1 - r4;
3,676✔
910
                                                if ( j ) {
3,676✔
911
                                                        if ( ToFast(r4,r4) ) {
3,616✔
912
                                                                r1 = r4;
3,228✔
913
                                                                if ( *r1 > -FUNCTION ) r1++;
3,228✔
914
                                                                r1++;
3,228✔
915
                                                        }
916
                                                        r7 = oldwork;
917
                                                        while ( --j >= 0 ) {
14,192✔
918
                                                                r4 = r1; i = *r7;
10,576✔
919
                                                                *r1++ = i+ARGHEAD; *r1++ = 0;
10,576✔
920
                                                                FILLARG(r1);
10,576✔
921
                                                                NCOPY(r1,r7,i)
116,024✔
922
                                                                if ( ToFast(r4,r4) ) {
10,576✔
923
                                                                        r1 = r4;
140✔
924
                                                                        if ( *r1 > -FUNCTION ) r1++;
140✔
925
                                                                        r1++;
140✔
926
                                                                }
927
                                                        }
928
                                                }
929
                                                t = r3;
3,676✔
930
                                                AT.WildMask = oWildMask; AN.WildValue = oWildValue;
3,676✔
931
                                        }
932
                                        else {
933
/*
934
                                                This code deals with splitting off a single term
935
*/
936
                                                r4 = r1; r5 = t;
×
937
                                                *r1++ = *t + ARGHEAD;
×
938
                                                for ( i = 1; i < ARGHEAD; i++ ) *r1++ = 0;
×
939
                                                j = 0;
940
                                                while ( t < r3 ) {
×
941
                                                        r6 = t + *t; r6 -= ABS(r6[-1]);
×
942
                                                        if ( (r6 - t) == *factor ) {
×
943
                                                                k = *factor - 1;
×
944
                                                                for ( ; k > 0; k-- ) {
×
945
                                                                        if ( t[k] != factor[k] ) break;
×
946
                                                                }
947
                                                                if ( k <= 0 ) {
×
948
                                                                        j = r3 - t; t += *t; continue;
×
949
                                                                }
950
                                                        }
951
                                                        else if ( (r6 - t) == 1 && *factor == 0 ) {
×
952
                                                                j = r3 - t; t += *t; continue;
×
953
                                                        }
954
                                                        i = *t;
955
                                                        NCOPY(r1,t,i)
×
956
                                                }
957
                                                *r4 = r1 - r4;
×
958
                                                if ( j ) {
×
959
                                                        if ( ToFast(r4,r4) ) {
×
960
                                                                r1 = r4;
×
961
                                                                if ( *r1 > -FUNCTION ) r1++;
×
962
                                                                r1++;
×
963
                                                        }
964
                                                        t = r3 - j;
×
965
                                                        r4 = r1;
×
966
                                                        *r1++ = *t + ARGHEAD;
×
967
                                                        for ( i = 1; i < ARGHEAD; i++ ) *r1++ = 0;
×
968
                                                        i = *t;
×
969
                                                        while ( --i >= 0 ) *r1++ = *t++;
×
970
                                                        if ( ToFast(r4,r4) ) {
×
971
                                                                r1 = r4;
×
972
                                                                if ( *r1 > -FUNCTION ) r1++;
×
973
                                                                r1++;
×
974
                                                        }
975
                                                }
976
                                                t = r3;
977
                                        }
978
                                }
979
                                r2[1] = r1 - r2;
3,676✔
980
                        }
981
                        else {
982
                                r = t + t[1];
9,084✔
983
                                while ( t < r ) *r1++ = *t++;
155,044✔
984
                        }
985
                }
986
                r = term + *term;
3,660✔
987
                while ( t < r ) *r1++ = *t++;
14,640✔
988
                m = AT.WorkPointer;
3,660✔
989
                i = m[0] = r1 - m;
3,660✔
990
                t = term;
3,660✔
991
                while ( --i >= 0 ) *t++ = *m++;
315,096✔
992
                if ( AT.WorkPointer < m ) AT.WorkPointer = m;
3,660✔
993
        }
994
/*
995
          #] SplitArg : 
996
          #[ FACTARG :
997
*/
998
        if ( ( type == TYPEFACTARG || type == TYPEFACTARG2 ) && 
302,434✔
999
        AT.pWorkPointer > oldppointer ) {
9,712✔
1000
                t = term+1;
5,135✔
1001
                r1 = AT.WorkPointer + 1;
5,135✔
1002
                lp = oldppointer;
5,135✔
1003
                while ( t < rstop ) {
20,734✔
1004
                        if ( lp < AT.pWorkPointer && AT.pWorkSpace[lp] == t ) {
15,599✔
1005
                                v = t;
5,151✔
1006
                                m = t + FUNHEAD;
5,151✔
1007
                                r = t + t[1];
5,151✔
1008
                                r2 = r1; while ( t < m ) *r1++ = *t++;
20,604✔
1009
                                while ( m < r ) {
10,302✔
1010
                                        rr = t = m;
5,151✔
1011
                                        NEXTARG(m)
5,151✔
1012
                                        if ( lp >= AT.pWorkPointer || AT.pWorkSpace[lp+1] != t ) {
5,151✔
1013
                                                if ( *t > 0 ) t[1] = 0;
×
1014
                                                while ( t < m ) *r1++ = *t++;
×
1015
                                                continue;
×
1016
                                        }
1017
/*
1018
                                        Now we have a nontrivial argument that should be studied.
1019
                                        Try to find common factors.
1020
*/
1021
                                        lp += 2;
5,151✔
1022
                                        if ( *t < 0 ) {
5,151✔
1023
                                                if ( factor && ( *factor == 0 && *t == -SNUMBER ) ) {
×
1024
                                                        *r1++ = *t++;
×
1025
                                                        if ( *t == 0 ) *r1++ = *t++;
×
1026
                                                        else { *r1++ = 1; t++; }
×
1027
                                                        continue;
×
1028
                                                }
1029
                                                else if ( factor && *factor == 4 && factor[2] == 1 ) {
×
1030
                                                        if ( *t == -SNUMBER ) {
×
1031
                                                                if ( factor[3] < 0 || t[1] >= 0 ) {
×
1032
                                                                        while ( t < m ) *r1++ = *t++;
×
1033
                                                                }
1034
                                                                else {
1035
                                                                        *r1++ = -SNUMBER; *r1++ = -1;
×
1036
                                                                        *r1++ = *t++; *r1++ = -*t++;
×
1037
                                                                }
1038
                                                        }
1039
                                                        else {
1040
                                                                while ( t < m ) *r1++ = *t++;
×
1041
                                                                *r1++ = -SNUMBER; *r1++ = 1;
×
1042
                                                        }
1043
                                                        continue;
×
1044
                                                }
1045
                                                else if ( *t == -MINVECTOR ) {
×
1046
                                                        *r1++ = -VECTOR; t++; *r1++ = *t++;
×
1047
                                                        *r1++ = -SNUMBER; *r1++ = -1;
×
1048
                                                        *r1++ = -SNUMBER; *r1++ = 1;
×
1049
                                                        continue;
×
1050
                                                }
1051
                                        }
1052
/*
1053
                                        Now we have a nontrivial argument
1054
*/
1055
                                        r3 = t + *t;
5,151✔
1056
                                        t += ARGHEAD;  r5 = t; /* Store starting point */
5,151✔
1057
                                        /* We have terms from r5 to r3 */
1058
                                        if ( r5+*r5 == r3 && factor ) { /* One term only */
5,151✔
1059
                                                if ( *factor == 0 ) {
24✔
1060
                                                        GETSTOP(t,r6);
8✔
1061
                                                        r9 = r1; *r1++ = 0; *r1++ = 1;
8✔
1062
                                                        FILLARG(r1);
8✔
1063
                                                        *r1++ = (r6-t)+3; t++;
8✔
1064
                                                        while ( t < r6 ) *r1++ = *t++;
56✔
1065
                                                        *r1++ = 1; *r1++ = 1; *r1++ = 3;
8✔
1066
                                                        *r9 = r1-r9;
8✔
1067
                                                        if ( ToFast(r9,r9) ) {
8✔
1068
                                                                if ( *r9 <= -FUNCTION ) r1 = r9+1;
×
1069
                                                                else r1 = r9+2;
×
1070
                                                        }
1071
                                                        t = r3; continue;
8✔
1072
                                                }
1073
                                                if ( factor[0] == 4 && factor[2] == 1 ) {
16✔
1074
                                                        GETSTOP(t,r6);
16✔
1075
                                                        r7 = r1; *r1++ = (r6-t)+3+ARGHEAD; *r1++ = 0;
16✔
1076
                                                        FILLARG(r1);
16✔
1077
                                                        *r1++ = (r6-t)+3; t++;
16✔
1078
                                                        while ( t < r6 ) *r1++ = *t++;
112✔
1079
                                                        *r1++ = 1; *r1++ = 1; *r1++ = 3;
16✔
1080
                                                        if ( ToFast(r7,r7) ) {
16✔
1081
                                                                if ( *r7 <= -FUNCTION ) r1 = r7+1;
×
1082
                                                                else r1 = r7+2;
×
1083
                                                        }
1084
                                                        if ( r3[-1] < 0 && factor[3] > 0 ) {
16✔
1085
                                                                *r1++ = -SNUMBER; *r1++ = -1;
4✔
1086
                                                                if ( r3[-1] == -3 && r3[-2] == 1
4✔
1087
                                                                && ( r3[-3] & MAXPOSITIVE ) == r3[-3] ) {
4✔
1088
                                                                        *r1++ = -SNUMBER; *r1++ = r3[-3];
4✔
1089
                                                                }
1090
                                                                else {
1091
                                                                        *r1++ = (r3-r6)+1+ARGHEAD;
×
1092
                                                                        *r1++ = 0;
×
1093
                                                                        FILLARG(r1);
×
1094
                                                                        *r1++ = (r3-r6+1);
×
1095
                                                                        while ( t < r3 ) *r1++ = *t++;
×
1096
                                                                        r1[-1] = -r1[-1];
×
1097
                                                                }
1098
                                                        }
1099
                                                        else {
1100
                                                                if ( ( r3[-1] == -3 || r3[-1] == 3 )
12✔
1101
                                                                && r3[-2] == 1
12✔
1102
                                                                && ( r3[-3] & MAXPOSITIVE ) == r3[-3] ) {
12✔
1103
                                                                        *r1++ = -SNUMBER; *r1++ = r3[-3];
12✔
1104
                                                                        if ( r3[-1] < 0 ) r1[-1] = - r1[-1];
12✔
1105
                                                                }
1106
                                                                else {
1107
                                                                        *r1++ = (r3-r6)+1+ARGHEAD;
×
1108
                                                                        *r1++ = 0;
×
1109
                                                                        FILLARG(r1);
×
1110
                                                                        *r1++ = (r3-r6+1);
×
1111
                                                                        while ( t < r3 ) *r1++ = *t++;
×
1112
                                                                }
1113
                                                        }
1114
                                                        t = r3; continue;
16✔
1115
                                                }
1116
                                        }
1117
/*
1118
                                        Now we take the first term and look for its pieces
1119
                                        inside the other terms.
1120

1121
                                        It is at this point that a more general factorization
1122
                                        routine could take over (allowing for writing the output
1123
                                        properly of course).
1124
*/
1125
                                        if ( AC.OldFactArgFlag == NEWFACTARG ) {
5,127✔
1126
                                        if ( factor == 0 ) {
5,095✔
1127
                                                WORD *oldworkpointer2 = AT.WorkPointer;
5,079✔
1128
                                                AT.WorkPointer = r1 + AM.MaxTer+FUNHEAD;
5,079✔
1129
                                                if ( ArgFactorize(BHEAD t-ARGHEAD,r1) < 0 ) {
5,079✔
1130
                                                        MesCall("ExecArg");
×
1131
                                                        return(-1);
×
1132
                                                }
1133
                                                AT.WorkPointer = oldworkpointer2;
5,079✔
1134
                                                t = r3;
5,079✔
1135
                                                while ( *r1 ) { NEXTARG(r1) }
11,037✔
1136
                                        }
1137
                                        else {
1138
                                                rnext = t + *t;
16✔
1139
                                                GETSTOP(t,r6);
16✔
1140
                                                t++;
24✔
1141
                                                t = r5; pow = 1;
24✔
1142
                                                while ( t < r3 ) {
24✔
1143
                                                        t += *t; if ( t[-1] > 0 ) { pow = 0; break; }
20✔
1144
                                                }
1145
/*
1146
                                                We have to add here the code for computing the GCD
1147
                                                and to divide it out.
1148

1149
                        #[ Numerical factor :
1150
*/
1151
                                                t = r5;
16✔
1152
                                                EAscrat = (UWORD *)(TermMalloc("execarg"));
16✔
1153
                                                if ( t + *t == r3 ) {
16✔
1154
                                                        if ( factor == 0 || *factor > 2 ) {
×
1155
                                                          if ( pow > 0 ) {
×
1156
                                                                *r1++ = -SNUMBER; *r1++ = -1;
×
1157
                                                                t = r5;
×
1158
                                                                while ( t < r3 ) {
×
1159
                                                                        t += *t; t[-1] = -t[-1];
×
1160
                                                                }
1161
                                                          }
1162
                                                          t = rr; *r1++ = *t++; *r1++ = 1; t++;
×
1163
                                                          COPYARG(r1,t);
×
1164
                                                          while ( t < m ) *r1++ = *t++;
×
1165
                                                        }
1166
                                                }
1167
                                                else {
1168
                                                GETSTOP(t,r6);
16✔
1169
                                                ngcd = t[t[0]-1];
16✔
1170
                                                i = abs(ngcd)-1;
16✔
1171
                                                while ( --i >= 0 ) EAscrat[i] = r6[i];
48✔
1172
                                                t += *t;
16✔
1173
                                                while ( t < r3 ) {
16✔
1174
                                                        GETSTOP(t,r6);
16✔
1175
                                                        i = t[t[0]-1];
16✔
1176
                                                        if ( AccumGCD(BHEAD EAscrat,&ngcd,(UWORD *)r6,i) ) goto execargerr;
16✔
1177
                                                        if ( ngcd == 3 && EAscrat[0] == 1 && EAscrat[1] == 1 ) break;
16✔
1178
                                                        t += *t;
×
1179
                                                }
1180
/*
1181
                                                 if ( ngcd != 3 || EAscrat[0] != 1 || EAscrat[1] != 1 )
1182
*/
1183
                                                {
1184
                                                        if ( pow ) ngcd = -ngcd;
16✔
1185
                                                        t = r5; r9 = r1; *r1++ = t[-ARGHEAD]; *r1++ = 1;
16✔
1186
                                                        FILLARG(r1); ngcd = REDLENG(ngcd);
16✔
1187
                                                        while ( t < r3 ) {
52✔
1188
                                                                GETSTOP(t,r6);
36✔
1189
                                                                r7 = t; r8 = r1;
36✔
1190
                                                                while ( r7 < r6) *r1++ = *r7++;
192✔
1191
                                                                t += *t;
36✔
1192
                                                                i = REDLENG(t[-1]);
36✔
1193
                                                                if ( DivRat(BHEAD (UWORD *)r6,i,EAscrat,ngcd,(UWORD *)r1,&nq) ) goto execargerr;
36✔
1194
                                                                nq = INCLENG(nq);
36✔
1195
                                                                i = ABS(nq)-1;
36✔
1196
                                                                r1 += i; *r1++ = nq; *r8 = r1-r8;
36✔
1197
                                                        }
1198
                                                        *r9 = r1-r9;
16✔
1199
                                                        ngcd = INCLENG(ngcd);
16✔
1200
                                                        i = ABS(ngcd)-1;
16✔
1201
                                                        if ( factor && *factor == 0 ) {}
16✔
1202
                                                        else if ( ( factor && factor[0] == 4 && factor[2] == 1
×
1203
                                                        && factor[3] == -3 ) || pow == 0 ) {
×
1204
                                                                r9 = r1; *r1++ = ARGHEAD+2+i; *r1++ = 0;
×
1205
                                                                FILLARG(r1); *r1++ = i+2;
×
1206
                                                                for ( j = 0; j < i; j++ ) *r1++ = EAscrat[j];
×
1207
                                                                *r1++ = ngcd;
×
1208
                                                                if ( ToFast(r9,r9) ) r1 = r9+2;
×
1209
                                                        }
1210
                                                        else if ( factor && factor[0] == 4 && factor[2] == 1
×
1211
                                                        && factor[3] > 0 && pow ) {
×
1212
                                                                if ( ngcd < 0 ) ngcd = -ngcd;
×
1213
                                                                *r1++ = -SNUMBER; *r1++ = -1;
×
1214
                                                                r9 = r1; *r1++ = ARGHEAD+2+i; *r1++ = 0;
×
1215
                                                                FILLARG(r1); *r1++ = i+2;
×
1216
                                                                for ( j = 0; j < i; j++ ) *r1++ = EAscrat[j];
×
1217
                                                                *r1++ = ngcd;
×
1218
                                                                if ( ToFast(r9,r9) ) r1 = r9+2;
×
1219
                                                        }
1220
                                                        else {
1221
                                                                if ( ngcd < 0 ) ngcd = -ngcd;
×
1222
                                                                if ( pow ) { *r1++ = -SNUMBER; *r1++ = -1; }
×
1223
                                                                if ( ngcd != 3 || EAscrat[0] != 1 || EAscrat[1] != 1 ) {
×
1224
                                                                        r9 = r1; *r1++ = ARGHEAD+2+i; *r1++ = 0;
×
1225
                                                                        FILLARG(r1); *r1++ = i+2;
×
1226
                                                                        for ( j = 0; j < i; j++ ) *r1++ = EAscrat[j];
×
1227
                                                                        *r1++ = ngcd;
×
1228
                                                                        if ( ToFast(r9,r9) ) r1 = r9+2;
×
1229
                                                                }
1230
                                                        }
1231
                                                 }
1232
/*
1233
                        #] Numerical factor : 
1234
                                                else {
1235
onetermnew:;
1236

1237
                                                        if ( factor == 0 || *factor > 2 ) {
1238
                                                          if ( pow > 0 ) {
1239
                                                                *r1++ = -SNUMBER; *r1++ = -1;
1240
                                                                t = r5;
1241
                                                                while ( t < r3 ) {
1242
                                                                        t += *t; t[-1] = -t[-1];
1243
                                                                }
1244
                                                          }
1245
                                                          t = rr; *r1++ = *t++; *r1++ = 1; t++;
1246
                                                          COPYARG(r1,t);
1247
                                                          while ( t < m ) *r1++ = *t++;
1248
                                                        }
1249
                                                }
1250
onetermnew:;
1251
*/
1252
                                                }
1253
                                                TermFree(EAscrat,"execarg");
16✔
1254
                                        }
1255
                                        }
1256
                                        else {        /* AC.OldFactArgFlag is ON */
1257
                                        {
1258
                                        WORD *mnext, ncom;
32✔
1259
                                        rnext = t + *t;
32✔
1260
                                        GETSTOP(t,r6);
32✔
1261
                                        t++;
32✔
1262
                                        if ( factor == 0 ) {
32✔
1263
                                          while ( t < r6 ) {
80✔
1264
/*
1265
                        #[ SYMBOL :
1266
*/
1267
                                                if ( *t == SYMBOL ) {
48✔
1268
                                                        r7 = t; r8 = t + t[1]; t += 2;
28✔
1269
                                                        while ( t < r8 ) {
68✔
1270
                                                                pow = t[1];
40✔
1271
                                                                mm = rnext;
40✔
1272
                                                                while ( mm < r3 ) {
40✔
1273
                                                                        mnext = mm + *mm;
×
1274
                                                                        GETSTOP(mm,mstop); mm++;
×
1275
                                                                        while ( mm < mstop ) {
×
1276
                                                                                if ( *mm != SYMBOL ) mm += mm[1];
×
1277
                                                                                else break;
1278
                                                                        }
1279
                                                                        if ( *mm == SYMBOL ) {
×
1280
                                                                                mstop = mm + mm[1]; mm += 2;
×
1281
                                                                                while ( *mm != *t && mm < mstop ) mm += 2;
×
1282
                                                                                if ( mm >= mstop ) pow = 0;
×
1283
                                                                                else if ( pow > 0 && mm[1] > 0 ) {
×
1284
                                                                                        if ( mm[1] < pow ) pow = mm[1];
×
1285
                                                                                }
1286
                                                                                else if ( pow < 0 && mm[1] < 0 ) {
×
1287
                                                                                        if ( mm[1] > pow ) pow = mm[1];
×
1288
                                                                                }
1289
                                                                                else pow = 0;
1290
                                                                        }
1291
                                                                        else pow = 0;
1292
                                                                        if ( pow == 0 ) break;
×
1293
                                                                        mm = mnext;
1294
                                                                }
1295
                                                                if ( pow == 0 ) { t += 2; continue; }
40✔
1296
/*
1297
                                                                We have a factor
1298
*/
1299
                                                                action = 1; i = pow;
40✔
1300
                                                                if ( i > 0 ) {
40✔
1301
                                                                        while ( --i >= 0 ) {
80✔
1302
                                                                                *r1++ = -SYMBOL;
40✔
1303
                                                                                *r1++ = *t;
40✔
1304
                                                                        }
1305
                                                                }
1306
                                                                else {
1307
                                                                        while ( i++ < 0 ) {
×
1308
                                                                                *r1++ = 8 + ARGHEAD;
×
1309
                                                                                for ( j = 1; j < ARGHEAD; j++ ) *r1++ = 0;
×
1310
                                                                                *r1++ = 8; *r1++ = SYMBOL;
×
1311
                                                                                *r1++ = 4; *r1++ = *t; *r1++ = -1;
×
1312
                                                                                *r1++ = 1; *r1++ = 1; *r1++ = 3;
×
1313
                                                                        }
1314
                                                                }
1315
/*
1316
                                                                Now we have to remove the symbols
1317
*/
1318
                                                                t[1] -= pow;
40✔
1319
                                                                mm = rnext;
40✔
1320
                                                                while ( mm < r3 ) {
40✔
1321
                                                                        mnext = mm + *mm;
×
1322
                                                                        GETSTOP(mm,mstop); mm++;
×
1323
                                                                        while ( mm < mstop ) {
×
1324
                                                                                if ( *mm != SYMBOL ) mm += mm[1];
×
1325
                                                                                else break;
1326
                                                                        }
1327
                                                                        mstop = mm + mm[1]; mm += 2;
×
1328
                                                                        while ( mm < mstop && *mm != *t ) mm += 2;
×
1329
                                                                        mm[1] -= pow;
×
1330
                                                                        mm = mnext;
×
1331
                                                                }
1332
                                                                t += 2;
40✔
1333
                                                        }
1334
                                                }
1335
/*
1336
                        #] SYMBOL : 
1337
                        #[ DOTPRODUCT :
1338
*/
1339
                                                else if ( *t == DOTPRODUCT ) {
20✔
1340
                                                        r7 = t; r8 = t + t[1]; t += 2;
4✔
1341
                                                        while ( t < r8 ) {
12✔
1342
                                                                pow = t[2];
8✔
1343
                                                                mm = rnext;
8✔
1344
                                                                while ( mm < r3 ) {
8✔
1345
                                                                        mnext = mm + *mm;
×
1346
                                                                        GETSTOP(mm,mstop); mm++;
×
1347
                                                                        while ( mm < mstop ) {
×
1348
                                                                                if ( *mm != DOTPRODUCT ) mm += mm[1];
×
1349
                                                                                else break;
1350
                                                                        }
1351
                                                                        if ( *mm == DOTPRODUCT ) {
×
1352
                                                                                mstop = mm + mm[1]; mm += 2;
×
1353
                                                                                while ( ( *mm != *t || mm[1] != t[1] )
×
1354
                                                                                         && mm < mstop ) mm += 3;
×
1355
                                                                                if ( mm >= mstop ) pow = 0;
×
1356
                                                                                else if ( pow > 0 && mm[2] > 0 ) {
×
1357
                                                                                        if ( mm[2] < pow ) pow = mm[2];
×
1358
                                                                                }
1359
                                                                                else if ( pow < 0 && mm[2] < 0 ) {
×
1360
                                                                                        if ( mm[2] > pow ) pow = mm[2];
×
1361
                                                                                }
1362
                                                                                else pow = 0;
1363
                                                                        }
1364
                                                                        else pow = 0;
1365
                                                                        if ( pow == 0 ) break;
×
1366
                                                                        mm = mnext;
1367
                                                                }
1368
                                                                if ( pow == 0 ) { t += 3; continue; }
8✔
1369
/*
1370
                                                                We have a factor
1371
*/
1372
                                                                action = 1; i = pow;
8✔
1373
                                                                if ( i > 0 ) {
8✔
1374
                                                                        while ( --i >= 0 ) {
16✔
1375
                                                                                *r1++ = 9 + ARGHEAD;
8✔
1376
                                                                                for ( j = 1; j < ARGHEAD; j++ ) *r1++ = 0;
16✔
1377
                                                                                *r1++ = 9; *r1++ = DOTPRODUCT;
8✔
1378
                                                                                *r1++ = 5; *r1++ = *t; *r1++ = t[1]; *r1++ = 1;
8✔
1379
                                                                                *r1++ = 1; *r1++ = 1; *r1++ = 3;
8✔
1380
                                                                        }
1381
                                                                }
1382
                                                                else {
1383
                                                                        while ( i++ < 0 ) {
×
1384
                                                                                *r1++ = 9 + ARGHEAD;
×
1385
                                                                                for ( j = 1; j < ARGHEAD; j++ ) *r1++ = 0;
×
1386
                                                                                *r1++ = 9; *r1++ = DOTPRODUCT;
×
1387
                                                                                *r1++ = 5; *r1++ = *t; *r1++ = t[1]; *r1++ = -1;
×
1388
                                                                                *r1++ = 1; *r1++ = 1; *r1++ = 3;
×
1389
                                                                        }
1390
                                                                }
1391
/*
1392
                                                                Now we have to remove the dotproducts
1393
*/
1394
                                                                t[2] -= pow;
8✔
1395
                                                                mm = rnext;
8✔
1396
                                                                while ( mm < r3 ) {
8✔
1397
                                                                        mnext = mm + *mm;
×
1398
                                                                        GETSTOP(mm,mstop); mm++;
×
1399
                                                                        while ( mm < mstop ) {
×
1400
                                                                                if ( *mm != DOTPRODUCT ) mm += mm[1];
×
1401
                                                                                else break;
1402
                                                                        }
1403
                                                                        mstop = mm + mm[1]; mm += 2;
×
1404
                                                                        while ( mm < mstop && ( *mm != *t
×
1405
                                                                                || mm[1] != t[1] ) ) mm += 3;
×
1406
                                                                        mm[2] -= pow;
×
1407
                                                                        mm = mnext;
×
1408
                                                                }
1409
                                                                t += 3;
8✔
1410
                                                        }
1411
                                                }
1412
/*
1413
                        #] DOTPRODUCT : 
1414
                        #[ DELTA/VECTOR :
1415
*/
1416
                                                else if ( *t == DELTA || *t == VECTOR ) {
16✔
1417
                                                        r7 = t; r8 = t + t[1]; t += 2;
×
1418
                                                        while ( t < r8 ) {
×
1419
                                                                mm = rnext;
1420
                                                                pow = 1;
1421
                                                                while ( mm < r3 ) {
×
1422
                                                                        mnext = mm + *mm;
×
1423
                                                                        GETSTOP(mm,mstop); mm++;
×
1424
                                                                        while ( mm < mstop ) {
×
1425
                                                                                if ( *mm != *r7 ) mm += mm[1];
×
1426
                                                                                else break;
1427
                                                                        }
1428
                                                                        if ( *mm == *r7 ) {
×
1429
                                                                                mstop = mm + mm[1]; mm += 2;
×
1430
                                                                                while ( ( *mm != *t || mm[1] != t[1] )
×
1431
                                                                                        && mm < mstop ) mm += 2;
×
1432
                                                                                if ( mm >= mstop ) pow = 0;
×
1433
                                                                        }
1434
                                                                        else pow = 0;
1435
                                                                        if ( pow == 0 ) break;
×
1436
                                                                        mm = mnext;
1437
                                                                }
1438
                                                                if ( pow == 0 ) { t += 2; continue; }
×
1439
/*
1440
                                                                We have a factor
1441
*/
1442
                                                                action = 1;
×
1443
                                                                *r1++ = 8 + ARGHEAD;
×
1444
                                                                for ( j = 1; j < ARGHEAD; j++ ) *r1++ = 0;
×
1445
                                                                *r1++ = 8; *r1++ = *r7;
×
1446
                                                                *r1++ = 4; *r1++ = *t; *r1++ = t[1];
×
1447
                                                                *r1++ = 1; *r1++ = 1; *r1++ = 3;
×
1448
/*
1449
                                                                Now we have to remove the delta's/vectors
1450
*/
1451
                                                                mm = rnext;
×
1452
                                                                while ( mm < r3 ) {
×
1453
                                                                        mnext = mm + *mm;
×
1454
                                                                        GETSTOP(mm,mstop); mm++;
×
1455
                                                                        while ( mm < mstop ) {
×
1456
                                                                                if ( *mm != *r7 ) mm += mm[1];
×
1457
                                                                                else break;
1458
                                                                        }
1459
                                                                        mstop = mm + mm[1]; mm += 2;
×
1460
                                                                        while ( mm < mstop && (
×
1461
                                                                         *mm != *t || mm[1] != t[1] ) ) mm += 2;
×
1462
                                                                        *mm = mm[1] = NOINDEX;
×
1463
                                                                        mm = mnext;
×
1464
                                                                }
1465
                                                                *t = t[1] = NOINDEX;
×
1466
                                                                t += 2;
×
1467
                                                        }
1468
                                                }
1469
/*
1470
                        #] DELTA/VECTOR : 
1471
                        #[ INDEX :
1472
*/
1473
                                                else if ( *t == INDEX ) {
16✔
1474
                                                        r7 = t; r8 = t + t[1]; t += 2;
×
1475
                                                        while ( t < r8 ) {
×
1476
                                                                mm = rnext;
1477
                                                                pow = 1;
1478
                                                                while ( mm < r3 ) {
×
1479
                                                                        mnext = mm + *mm;
×
1480
                                                                        GETSTOP(mm,mstop); mm++;
×
1481
                                                                        while ( mm < mstop ) {
×
1482
                                                                                if ( *mm != *r7 ) mm += mm[1];
×
1483
                                                                                else break;
1484
                                                                        }
1485
                                                                        if ( *mm == *r7 ) {
×
1486
                                                                                mstop = mm + mm[1]; mm += 2;
×
1487
                                                                                while ( *mm != *t 
×
1488
                                                                                        && mm < mstop ) mm++;
×
1489
                                                                                if ( mm >= mstop ) pow = 0;
×
1490
                                                                        }
1491
                                                                        else pow = 0;
1492
                                                                        if ( pow == 0 ) break;
×
1493
                                                                        mm = mnext;
1494
                                                                }
1495
                                                                if ( pow == 0 ) { t++; continue; }
×
1496
/*
1497
                                                                We have a factor
1498
*/
1499
                                                                action = 1;
×
1500
/*
1501
                                                                The next looks like an error.
1502
                                                                We should have here a VECTOR or INDEX like object
1503

1504
                                                                *r1++ = 7 + ARGHEAD;
1505
                                                                for ( j = 1; j < ARGHEAD; j++ ) *r1++ = 0;
1506
                                                                *r1++ = 7; *r1++ = *r7;
1507
                                                                *r1++ = 3; *r1++ = *t;
1508
                                                                *r1++ = 1; *r1++ = 1; *r1++ = 3;
1509

1510
                                                                Replace this by:  (11-apr-2007)
1511
*/
1512
                                                                if ( *t < 0 ) { *r1++ = -VECTOR; }
×
1513
                                                                else { *r1++ = -INDEX; }
×
1514
                                                                *r1++ = *t;
×
1515
/*
1516
                                                                Now we have to remove the index
1517
*/
1518
                                                                *t = NOINDEX;
×
1519
                                                                mm = rnext;
×
1520
                                                                while ( mm < r3 ) {
×
1521
                                                                        mnext = mm + *mm;
×
1522
                                                                        GETSTOP(mm,mstop); mm++;
×
1523
                                                                        while ( mm < mstop ) {
×
1524
                                                                                if ( *mm != *r7 ) mm += mm[1];
×
1525
                                                                                else break;
1526
                                                                        }
1527
                                                                        mstop = mm + mm[1]; mm += 2;
×
1528
                                                                        while ( mm < mstop && 
×
1529
                                                                         *mm != *t ) mm += 1;
×
1530
                                                                        *mm = NOINDEX;
×
1531
                                                                        mm = mnext;
×
1532
                                                                }
1533
                                                                t += 1;
×
1534
                                                        }
1535
                                                }
1536
/*
1537
                        #] INDEX : 
1538
                        #[ FUNCTION :
1539
*/
1540
                                                else if ( *t >= FUNCTION ) {
16✔
1541
/*
1542
                                                        In the next code we should actually look inside
1543
                                                        the DENOMINATOR or EXPONENT for noncommuting objects
1544
*/
1545
                                                        if ( *t >= FUNCTION &&
16✔
1546
                                                                functions[*t-FUNCTION].commute == 0 ) ncom = 0;
16✔
1547
                                                        else ncom = 1;
1548
                                                        if ( ncom ) {
1549
                                                                mm = r5 + 1;
1550
                                                                while ( mm < t && ( *mm == DUMMYFUN
×
1551
                                                                || *mm == DUMMYTEN ) ) mm += mm[1];
×
1552
                                                                if ( mm < t ) { t += t[1]; continue; }
×
1553
                                                        }
1554
                                                        mm = rnext; pow = 1;
1555
                                                        while ( mm < r3 ) {
16✔
1556
                                                                mnext = mm + *mm;
×
1557
                                                                GETSTOP(mm,mstop); mm++;
×
1558
                                                                while ( mm < mstop ) {
×
1559
                                                                        if ( *mm == *t && mm[1] == t[1] ) {
×
1560
                                                                                for ( i = 2; i < t[1]; i++ ) {
×
1561
                                                                                        if ( mm[i] != t[i] ) break;
×
1562
                                                                                }
1563
                                                                                if ( i >= t[1] )
×
1564
                                                                                        { mm += mm[1]; goto nextmterm; }
×
1565
                                                                        }
1566
                                                                        if ( ncom && *mm != DUMMYFUN && *mm != DUMMYTEN )
×
1567
                                                                                { pow = 0; break; }
1568
                                                                        mm += mm[1];
×
1569
                                                                }
1570
                                                                if ( mm >= mstop ) pow = 0;
×
1571
                                                                if ( pow == 0 ) break;
×
1572
nextmterm:                                                mm = mnext;
×
1573
                                                        }
1574
                                                        if ( pow == 0 ) { t += t[1]; continue; }
16✔
1575
/*
1576
                                                        Copy the function
1577
*/
1578
                                                        action = 1;
16✔
1579
                                                        *r1++ = t[1] + 4 + ARGHEAD;
16✔
1580
                                                        for ( i = 1; i < ARGHEAD; i++ ) *r1++ = 0;
32✔
1581
                                                        *r1++ = t[1] + 4;
16✔
1582
                                                        for ( i = 0; i < t[1]; i++ ) *r1++ = t[i];
104✔
1583
                                                        *r1++ = 1; *r1++ = 1; *r1++ = 3;
16✔
1584
/*
1585
                                                        Now we have to take out the functions
1586
*/
1587
                                                        mm = rnext;
16✔
1588
                                                        while ( mm < r3 ) {
16✔
1589
                                                                mnext = mm + *mm;
×
1590
                                                                GETSTOP(mm,mstop); mm++;
×
1591
                                                                while ( mm < mstop ) {
×
1592
                                                                        if ( *mm == *t && mm[1] == t[1] ) {
×
1593
                                                                                for ( i = 2; i < t[1]; i++ ) {
×
1594
                                                                                        if ( mm[i] != t[i] ) break;
×
1595
                                                                                }
1596
                                                                                if ( i >= t[1] ) {
×
1597
                                                                                        if ( functions[*t-FUNCTION].spec > 0 )
×
1598
                                                                                                *mm = DUMMYTEN;
×
1599
                                                                                        else
1600
                                                                                                *mm = DUMMYFUN;
×
1601
                                                                                        mm += mm[1];
×
1602
                                                                                        goto nextterm;
×
1603
                                                                                }
1604
                                                                        }
1605
                                                                        mm += mm[1];
×
1606
                                                                }
1607
nextterm:                                                mm = mnext;
×
1608
                                                        }
1609
                                                        if ( functions[*t-FUNCTION].spec > 0 )
16✔
1610
                                                                        *t = DUMMYTEN;
16✔
1611
                                                        else
1612
                                                                        *t = DUMMYFUN;
×
1613
                                                        action = 1;
16✔
1614
                                                        v[2] = DIRTYFLAG;
16✔
1615
                                                        t += t[1];
16✔
1616
                                                }
1617
/*
1618
                        #] FUNCTION : 
1619
*/
1620
                                                else {
1621
                                                        t += t[1];
×
1622
                                                }
1623
                                          }
1624
                                        }
1625
                                        t = r5; pow = 1;
32✔
1626
                                        while ( t < r3 ) {
36✔
1627
                                                t += *t; if ( t[-1] > 0 ) { pow = 0; break; }
32✔
1628
                                        }
1629
/*
1630
                                        We have to add here the code for computing the GCD
1631
                                        and to divide it out.
1632
*/
1633
/*
1634
                        #[ Numerical factor :
1635
*/
1636
                                        t = r5;
32✔
1637
                                        EAscrat = (UWORD *)(TermMalloc("execarg"));
32✔
1638
                                        if ( t + *t == r3 ) goto oneterm;
32✔
1639
                                        GETSTOP(t,r6);
×
1640
                                        ngcd = t[t[0]-1];
×
1641
                                        i = abs(ngcd)-1;
×
1642
                                        while ( --i >= 0 ) EAscrat[i] = r6[i];
×
1643
                                        t += *t;
×
1644
                                        while ( t < r3 ) {
×
1645
                                                GETSTOP(t,r6);
×
1646
                                                i = t[t[0]-1];
×
1647
                                                if ( AccumGCD(BHEAD EAscrat,&ngcd,(UWORD *)r6,i) ) goto execargerr;
×
1648
                                                if ( ngcd == 3 && EAscrat[0] == 1 && EAscrat[1] == 1 ) break;
×
1649
                                                t += *t;
×
1650
                                        }
1651
                                         if ( ngcd != 3 || EAscrat[0] != 1 || EAscrat[1] != 1 ) {
×
1652
                                                if ( pow ) ngcd = -ngcd;
×
1653
                                                t = r5; r9 = r1; *r1++ = t[-ARGHEAD]; *r1++ = 1;
×
1654
                                                FILLARG(r1); ngcd = REDLENG(ngcd);
×
1655
                                                while ( t < r3 ) {
×
1656
                                                        GETSTOP(t,r6);
×
1657
                                                        r7 = t; r8 = r1;
×
1658
                                                        while ( r7 < r6) *r1++ = *r7++;
×
1659
                                                        t += *t;
×
1660
                                                        i = REDLENG(t[-1]);
×
1661
                                                        if ( DivRat(BHEAD (UWORD *)r6,i,EAscrat,ngcd,(UWORD *)r1,&nq) ) goto execargerr;
×
1662
                                                        nq = INCLENG(nq);
×
1663
                                                        i = ABS(nq)-1;
×
1664
                                                        r1 += i; *r1++ = nq; *r8 = r1-r8;
×
1665
                                                }
1666
                                                *r9 = r1-r9;
×
1667
                                                ngcd = INCLENG(ngcd);
×
1668
                                                i = ABS(ngcd)-1;
×
1669
                                                if ( factor && *factor == 0 ) {}
×
1670
                                                else if ( ( factor && factor[0] == 4 && factor[2] == 1
×
1671
                                                && factor[3] == -3 ) || pow == 0 ) {
×
1672
                                                        r9 = r1; *r1++ = ARGHEAD+2+i; *r1++ = 0;
×
1673
                                                        FILLARG(r1); *r1++ = i+2;
×
1674
                                                        for ( j = 0; j < i; j++ ) *r1++ = EAscrat[j];
×
1675
                                                        *r1++ = ngcd;
×
1676
                                                        if ( ToFast(r9,r9) ) r1 = r9+2;
×
1677
                                                }
1678
                                                else if ( factor && factor[0] == 4 && factor[2] == 1
×
1679
                                                && factor[3] > 0 && pow ) {
×
1680
                                                        if ( ngcd < 0 ) ngcd = -ngcd;
×
1681
                                                        *r1++ = -SNUMBER; *r1++ = -1;
×
1682
                                                        r9 = r1; *r1++ = ARGHEAD+2+i; *r1++ = 0;
×
1683
                                                        FILLARG(r1); *r1++ = i+2;
×
1684
                                                        for ( j = 0; j < i; j++ ) *r1++ = EAscrat[j];
×
1685
                                                        *r1++ = ngcd;
×
1686
                                                        if ( ToFast(r9,r9) ) r1 = r9+2;
×
1687
                                                }
1688
                                                else {
1689
                                                        if ( ngcd < 0 ) ngcd = -ngcd;
×
1690
                                                        if ( pow ) { *r1++ = -SNUMBER; *r1++ = -1; }
×
1691
                                                        if ( ngcd != 3 || EAscrat[0] != 1 || EAscrat[1] != 1 ) {
×
1692
                                                                r9 = r1; *r1++ = ARGHEAD+2+i; *r1++ = 0;
×
1693
                                                                FILLARG(r1); *r1++ = i+2;
×
1694
                                                                for ( j = 0; j < i; j++ ) *r1++ = EAscrat[j];
×
1695
                                                                *r1++ = ngcd;
×
1696
                                                                if ( ToFast(r9,r9) ) r1 = r9+2;
×
1697
                                                        }
1698
                                                }
1699
                                         }
1700
/*
1701
                        #] Numerical factor : 
1702
*/
1703
                                        else {
1704
oneterm:;
×
1705
                                                if ( factor == 0 || *factor > 2 ) {
32✔
1706
                                                if ( pow > 0 ) {
32✔
1707
                                                        *r1++ = -SNUMBER; *r1++ = -1;
4✔
1708
                                                        t = r5;
4✔
1709
                                                        while ( t < r3 ) {
8✔
1710
                                                                t += *t; t[-1] = -t[-1];
4✔
1711
                                                        }
1712
                                                }
1713
                                                t = rr; *r1++ = *t++; *r1++ = 1; t++;
32✔
1714
                                                COPYARG(r1,t);
32✔
1715
                                                while ( t < m ) *r1++ = *t++;
416✔
1716
                                                }
1717
                                        }
1718
                                        TermFree(EAscrat,"execarg");
32✔
1719
                                        }
1720
                        } /* AC.OldFactArgFlag */
1721
                                }
1722
/* r1 is fout in ons voorbeeld. */
1723
                                r2[1] = r1 - r2;
5,151✔
1724
                                action = 1;
5,151✔
1725
                                v[2] = DIRTYFLAG;
5,151✔
1726
                        }
1727
                        else {
1728
                                r = t + t[1];
10,448✔
1729
                                while ( t < r ) *r1++ = *t++;
132,472✔
1730
                        }
1731
                }
1732
                r = term + *term;
5,135✔
1733
                while ( t < r ) *r1++ = *t++;
20,540✔
1734
                m = AT.WorkPointer;
5,135✔
1735
                i = m[0] = r1 - m;
5,135✔
1736
                t = term;
5,135✔
1737
                while ( --i >= 0 ) *t++ = *m++;
385,158✔
1738
                if ( AT.WorkPointer < t ) AT.WorkPointer = t;
5,135✔
1739
        }
1740
/*
1741
          #] FACTARG : 
1742
*/
1743
        AR.Cnumlhs = oldnumlhs;
302,434✔
1744
        if ( action && Normalize(BHEAD term) ) goto execargerr;
302,434✔
1745
        AT.WorkPointer = oldwork;
302,434✔
1746
        if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
302,434✔
1747
        AT.pWorkPointer = oldppointer;
302,434✔
1748
        return(action);
302,434✔
1749
execargerr:
×
1750
        AT.WorkPointer = oldwork;
×
1751
        AT.pWorkPointer = oldppointer;
×
1752
        MLOCK(ErrorMessageLock);
×
1753
        MesCall("execarg");
×
1754
        MUNLOCK(ErrorMessageLock);
×
1755
        return(-1);
1756
}
1757

1758
/*
1759
          #] execarg : 
1760
          #[ execterm :
1761
*/
1762

1763
WORD execterm(PHEAD WORD *term, WORD level)
320✔
1764
{
1765
        GETBIDENTITY
1766
        CBUF *C = cbuf+AM.rbufnum;
320✔
1767
        WORD oldnumlhs = AR.Cnumlhs;
320✔
1768
        WORD maxisat = C->lhs[level][2];
320✔
1769
        WORD *buffer1 = 0;
320✔
1770
        WORD *oldworkpointer = AT.WorkPointer;
320✔
1771
        WORD *t1, i;
320✔
1772
        WORD olddeferflag = AR.DeferFlag, tryterm = 0;
320✔
1773
        AR.DeferFlag = 0;
320✔
1774
        do {
2,528✔
1775
                AR.Cnumlhs = C->lhs[level][3];
2,528✔
1776
                NewSort(BHEAD0);
2,528✔
1777
/*
1778
                Normally for function arguments we do not use PolyFun/PolyRatFun.
1779
                Hence NewSort sets the corresponding variables to zero.
1780
                Here we overwrite that.
1781
*/
1782
                AN.FunSorts[AR.sLevel]->PolyFlag = ( AR.PolyFun != 0 ) ? AR.PolyFunType: 0;
2,528✔
1783
                if ( AR.PolyFun == 0 ) { AN.FunSorts[AR.sLevel]->PolyFlag = 0; }
2,528✔
1784
                else if ( AR.PolyFunType == 1 ) { AN.FunSorts[AR.sLevel]->PolyFlag = 1; }
2,524✔
1785
                else if ( AR.PolyFunType == 2 ) {
2,524✔
1786
                        if ( AR.PolyFunExp == 2 ) AN.FunSorts[AR.sLevel]->PolyFlag = 1;
2,524✔
1787
                        else                      AN.FunSorts[AR.sLevel]->PolyFlag = 2;
2,524✔
1788
                }
1789
                if ( buffer1 ) {
2,528✔
1790
                        term = buffer1;
1791
                        while ( *term ) {
23,536✔
1792
                                t1 = oldworkpointer;
1793
                                i = *term; while ( --i >= 0 ) *t1++ = *term++;
5,340,520✔
1794
                                AT.WorkPointer = t1;
21,328✔
1795
                                if ( Generator(BHEAD oldworkpointer,level) ) goto exectermerr;
21,328✔
1796
                        }
1797
                }
1798
                else {
1799
                        if ( Generator(BHEAD term,level) ) goto exectermerr;
320✔
1800
                }
1801
                if ( buffer1 ) {
2,528✔
1802
                        if ( tryterm ) { TermFree(buffer1,"buffer in sort statement"); tryterm = 0; }
2,208✔
1803
                        else { M_free((void *)buffer1,"buffer in sort statement"); }
52✔
1804
                        buffer1 = 0;
2,208✔
1805
                }
1806
                AN.tryterm = 1;
2,528✔
1807
                if ( EndSort(BHEAD (WORD *)((VOID *)(&buffer1)),2) < 0 ) goto exectermerr;
2,528✔
1808
                tryterm = AN.tryterm; AN.tryterm = 0;
2,528✔
1809
                level = AR.Cnumlhs;
2,528✔
1810
        } while ( AR.Cnumlhs < maxisat );
2,528✔
1811
        AR.Cnumlhs = oldnumlhs;
320✔
1812
        AR.DeferFlag = olddeferflag;
320✔
1813
        term = buffer1;
320✔
1814
        while ( *term ) {
2,556✔
1815
                t1 = oldworkpointer;
1816
                i = *term; while ( --i >= 0 ) *t1++ = *term++;
537,912✔
1817
                AT.WorkPointer = t1;
2,236✔
1818
                if ( Generator(BHEAD oldworkpointer,level) ) goto exectermerr;
2,236✔
1819
        }
1820
        if ( tryterm ) { TermFree(buffer1,"buffer in term statement"); tryterm = 0; }
320✔
1821
        else { M_free(buffer1,"buffer in term statement"); }
4✔
1822
        buffer1 = 0;
320✔
1823
        AT.WorkPointer = oldworkpointer;
320✔
1824
        return(0);
320✔
1825
exectermerr:
×
1826
        AT.WorkPointer = oldworkpointer;
×
1827
        AR.DeferFlag = olddeferflag;
×
1828
        MLOCK(ErrorMessageLock);
×
1829
        MesCall("execterm");
×
1830
        MUNLOCK(ErrorMessageLock);
×
1831
        return(-1);
1832
}
1833

1834
/*
1835
          #] execterm : 
1836
          #[ ArgumentImplode :
1837
*/
1838

1839
int ArgumentImplode(PHEAD WORD *term, WORD *thelist)
16✔
1840
{
1841
        GETBIDENTITY
1842
        WORD *liststart, *liststop, *inlist;
16✔
1843
        WORD *w, *t, *tend, *tstop, *tt, *ttstop, *ttt, ncount, i;
16✔
1844
        int action = 0;
16✔
1845
        liststop = thelist + thelist[1];
16✔
1846
        liststart = thelist + 2;
16✔
1847
        t = term;
16✔
1848
        tend = t + *t;
16✔
1849
        tstop = tend - ABS(tend[-1]);
16✔
1850
        t++;
16✔
1851
        while ( t < tstop ) {
48✔
1852
                if ( *t >= FUNCTION ) {
32✔
1853
                        inlist = liststart;
1854
                        while ( inlist < liststop && *inlist != *t ) inlist += inlist[1];
28✔
1855
                        if ( inlist < liststop ) {
16✔
1856
                                tt = t; ttstop = t + t[1]; w = AT.WorkPointer;
4✔
1857
                                for ( i = 0; i < FUNHEAD; i++ ) *w++ = *tt++;
16✔
1858
                                while ( tt < ttstop ) {
12✔
1859
                                        ncount = 0;
8✔
1860
                                        if ( *tt == -SNUMBER && tt[1] == 0 ) {
8✔
1861
                                                ncount = 1; ttt = tt; tt += 2;
8✔
1862
                                                while ( tt < ttstop && *tt == -SNUMBER && tt[1] == 0 ) {
20✔
1863
                                                        ncount++; tt += 2;
12✔
1864
                                                }
1865
                                        }
1866
                                        if ( ncount > 0 ) {
8✔
1867
                                                if ( tt < ttstop && *tt == -SNUMBER && ( tt[1] == 1 || tt[1] == -1 ) ) {
8✔
1868
                                                        *w++ = -SNUMBER;
8✔
1869
                                                        *w++ = (ncount+1) * tt[1];
8✔
1870
                                                        tt += 2;
8✔
1871
                                                        action = 1;
8✔
1872
                                                }
1873
                                                else if ( ( tt[0] == tt[ARGHEAD] + ARGHEAD )
×
1874
                                                && ( ABS(tt[tt[0]-1]) == 3 )
×
1875
                                                && ( tt[tt[0]-2] == 1 )
×
1876
                                                && ( tt[tt[0]-3] == 1 ) ) { /* Single term with coef +/- 1 */
×
1877
                                                        i = *tt; NCOPY(w,tt,i)
×
1878
                                                        w[-3] = ncount+1;
×
1879
                                                        action = 1;
×
1880
                                                }
1881
                                                else if ( *tt == -SYMBOL ) {
×
1882
                                                        *w++ = ARGHEAD+8;
×
1883
                                                        *w++ = 0;
×
1884
                                                        FILLARG(w)
1885
                                                        *w++ = 8;
×
1886
                                                        *w++ = SYMBOL;
×
1887
                                                        *w++ = tt[1];
×
1888
                                                        *w++ = 1;
×
1889
                                                        *w++ = ncount+1; *w++ = 1; *w++ = 3;
×
1890
                                                        tt += 2;
×
1891
                                                        action = 1;
×
1892
                                                }
1893
                                                else if ( *tt <= -FUNCTION ) {
×
1894
                                                        *w++ = ARGHEAD+FUNHEAD+4;
×
1895
                                                        *w++ = 0;
×
1896
                                                        FILLARG(w)
1897
                                                        *w++ = -*tt++;
×
1898
                                                        *w++ = FUNHEAD+4;
×
1899
                                                        FILLFUN(w)
×
1900
                                                        *w++ = ncount+1; *w++ = 1; *w++ = 3;
×
1901
                                                        action = 1;
×
1902
                                                }
1903
                                                else {
1904
                                                        while ( ttt < tt ) *w++ = *ttt++;
×
1905
                                                        if ( tt < ttstop && *tt == -SNUMBER ) {
×
1906
                                                                *w++ = *tt++; *w++ = *tt++;
×
1907
                                                        }
1908
                                                }
1909
                                        }
1910
                                        else if ( *tt <= -FUNCTION ) {
×
1911
                                                *w++ = *tt++;
×
1912
                                        }
1913
                                        else if ( *tt < 0 ) {
×
1914
                                                *w++ = *tt++;
×
1915
                                                *w++ = *tt++;
×
1916
                                        }
1917
                                        else {
1918
                                                i = *tt; NCOPY(w,tt,i)
×
1919
                                        }
1920
                                }
1921
                                AT.WorkPointer[1] = w - AT.WorkPointer;
4✔
1922
                                while ( tt < tend ) *w++ = *tt++;
32✔
1923
                                ttt = AT.WorkPointer; tt = t;
4✔
1924
                                while ( ttt < w ) *tt++ = *ttt++;
60✔
1925
                                term[0] = tt - term;
4✔
1926
                                AT.WorkPointer = tt;
4✔
1927
                                tend = tt; tstop = tt - ABS(tt[-1]);
4✔
1928
                        }
1929
                }
1930
                t += t[1];
32✔
1931
        }
1932
        if ( action ) {
16✔
1933
                if ( Normalize(BHEAD term) ) return(-1);
4✔
1934
        }
1935
        return(0);
1936
}
1937

1938
/*
1939
          #] ArgumentImplode : 
1940
          #[ ArgumentExplode :
1941
*/
1942

1943
int ArgumentExplode(PHEAD WORD *term, WORD *thelist)
16✔
1944
{
1945
        GETBIDENTITY
1946
        WORD *liststart, *liststop, *inlist, *old;
16✔
1947
        WORD *w, *t, *tend, *tstop, *tt, *ttstop, *ttt, ncount, i;
16✔
1948
        int action = 0;
16✔
1949
        LONG x;
16✔
1950
        liststop = thelist + thelist[1];
16✔
1951
        liststart = thelist + 2;
16✔
1952
        t = term;
16✔
1953
        tend = t + *t;
16✔
1954
        tstop = tend - ABS(tend[-1]);
16✔
1955
        t++;
16✔
1956
        while ( t < tstop ) {
48✔
1957
                if ( *t >= FUNCTION ) {
32✔
1958
                        inlist = liststart;
1959
                        while ( inlist < liststop && *inlist != *t ) inlist += inlist[1];
28✔
1960
                        if ( inlist < liststop ) {
16✔
1961
                                tt = t; ttstop = t + t[1]; w = AT.WorkPointer;
4✔
1962
                                for ( i = 0; i < FUNHEAD; i++ ) *w++ = *tt++;
16✔
1963
                                while ( tt < ttstop ) {
20✔
1964
                                        if ( *tt == -SNUMBER && tt[1] != 0 ) {
16✔
1965
                                                if ( tt[1] < AM.MaxTer/((WORD)sizeof(WORD)*4)
16✔
1966
                                                        && tt[1] > -(AM.MaxTer/((WORD)sizeof(WORD)*4))
16✔
1967
                                                        && ( tt[1] > 1 || tt[1] < -1 ) ) {
16✔
1968
                                                        ncount = ABS(tt[1]);
8✔
1969
                                                        while ( ncount > 1 ) {
40✔
1970
                                                                *w++ = -SNUMBER; *w++ = 0; ncount--;
32✔
1971
                                                        }
1972
                                                        *w++ = -SNUMBER;
8✔
1973
                                                        if ( tt[1] < 0 ) *w++ = -1;
8✔
1974
                                                        else             *w++ =  1;
4✔
1975
                                                        tt += 2;
8✔
1976
                                                        action = 1;
8✔
1977
                                                }
1978
                                                else {
1979
                                                        *w++ = *tt++; *w++ = *tt++;
8✔
1980
                                                }
1981
                                        }
1982
                                        else if ( *tt <= -FUNCTION ) {
×
1983
                                                *w++ = *tt++;
×
1984
                                        }
1985
                                        else if ( *tt < 0 ) {
×
1986
                                                *w++ = *tt++;
×
1987
                                                *w++ = *tt++;
×
1988
                                        }
1989
                                        else if ( tt[0] == tt[ARGHEAD]+ARGHEAD ) {
×
1990
                                                ttt = tt + tt[0] - 1;
×
1991
                                                i = (ABS(ttt[0])-1)/2; 
×
1992
                                                if ( i > 1 ) {
×
1993
TooMany:                                        old = AN.currentTerm;
×
1994
                                                        AN.currentTerm = term;
×
1995
                                                        MesPrint("Too many arguments in output of ArgExplode");
×
1996
                                                        MesPrint("Term = %t");
×
1997
                                                        AN.currentTerm = old;
×
1998
                                                        return(-1);
×
1999
                                                }
2000
                                                if ( ttt[-1] != 1 ) goto NoExplode;
×
2001
                                                x = ttt[-2];
×
2002
                                                if ( 2*x > (AT.WorkTop-w)-*term ) goto TooMany;
×
2003
                                                ncount = x - 1;
×
2004
                                                while ( ncount > 0 ) {
×
2005
                                                        *w++ = -SNUMBER; *w++ = 0; ncount--;
×
2006
                                                }
2007
                                                ttt[-2] = 1;
×
2008
                                                i = *tt; NCOPY(w,tt,i)
×
2009
                                                action = 1;
2010
                                        }
2011
                                        else {
2012
NoExplode:
×
2013
                                                i = *tt; NCOPY(w,tt,i)
×
2014
                                        }
2015
                                }
2016
                                AT.WorkPointer[1] = w - AT.WorkPointer;
4✔
2017
                                while ( tt < tend ) *w++ = *tt++;
32✔
2018
                                ttt = AT.WorkPointer; tt = t;
4✔
2019
                                while ( ttt < w ) *tt++ = *ttt++;
140✔
2020
                                term[0] = tt - term;
4✔
2021
                                AT.WorkPointer = tt;
4✔
2022
                                tend = tt; tstop = tt - ABS(tt[-1]);
4✔
2023
                        }
2024
                }
2025
                t += t[1];
32✔
2026
        }
2027
        if ( action ) {
16✔
2028
                if ( Normalize(BHEAD term) ) return(-1);
4✔
2029
        }
2030
        return(0);
2031
}
2032

2033
/*
2034
          #] ArgumentExplode : 
2035
          #[ ArgFactorize :
2036
*/
2037
/**
2038
 *        Factorizes an argument in general notation (meaning that the first
2039
 *        word of the argument is a positive size indicator)
2040
 *        Input (argin):   pointer to the complete argument
2041
 *        Output (argout): Pointer to where the output should be written.
2042
 *                         This is in the WorkSpace
2043
 *        Return value should be negative if anything goes wrong.
2044
 *
2045
 *        The notation of the output should be a string of arguments terminated
2046
 *        by the number zero.
2047
 *
2048
 *        Originally we sorted in a way that the constants came last. This gave
2049
 *        conflicts with the dollar and expression factorizations (in the expressions
2050
 *        we wanted the zero first and then followed by the constants).
2051
 */
2052
#define NEWORDER
2053

2054
int ArgFactorize(PHEAD WORD *argin, WORD *argout)
5,079✔
2055
{
2056
/*
2057
          #[ step 0 : Declarations and initializations
2058
*/
2059
        WORD *argfree, *argextra, *argcopy, *t, *tstop, *a, *a1, *a2;
5,079✔
2060
#ifdef NEWORDER
2061
        WORD *tt;
5,079✔
2062
#endif
2063
        WORD startebuf = cbuf[AT.ebufnum].numrhs,oldword;
5,079✔
2064
        WORD oldsorttype = AR.SortType, numargs;
5,079✔
2065
        int error = 0, action = 0, i, ii, number, sign = 1;
5,079✔
2066

2067
        *argout = 0;
5,079✔
2068
/*
2069
          #] step 0 : 
2070
          #[ step 1 : Take care of ordering
2071
*/
2072
        AR.SortType = SORTHIGHFIRST;
5,079✔
2073
        if ( oldsorttype != AR.SortType ) {
5,079✔
2074
                NewSort(BHEAD0);
15✔
2075
                oldword = argin[*argin]; argin[*argin] = 0;
15✔
2076
                t = argin+ARGHEAD;
15✔
2077
                while ( *t ) {
804✔
2078
                        tstop = t + *t;
789✔
2079
                        if ( AN.ncmod != 0 ) {
789✔
2080
                                if ( AN.ncmod != 1 || ( (WORD)AN.cmod[0] < 0 ) ) {
×
2081
                                        MLOCK(ErrorMessageLock);
×
2082
                                        MesPrint("Factorization modulus a number, greater than a WORD not implemented.");
×
2083
                                        MUNLOCK(ErrorMessageLock);
×
NEW
2084
                                        TERMINATE(-1);
×
2085
                                }
2086
                                if ( Modulus(t) ) {
×
2087
                                        MLOCK(ErrorMessageLock);
×
2088
                                        MesCall("ArgFactorize");
×
2089
                                        MUNLOCK(ErrorMessageLock);
×
NEW
2090
                                        TERMINATE(-1);
×
2091
                                }
2092
                                if ( !*t) { t = tstop; continue; }
×
2093
                        }
2094
                        StoreTerm(BHEAD t);
789✔
2095
                        t = tstop;
789✔
2096
                }
2097
                EndSort(BHEAD argin+ARGHEAD,0);
15✔
2098
                argin[*argin] = oldword;
15✔
2099
        }
2100
/*
2101
          #] step 1 : 
2102
          #[ step 2 : take out the 'content'.
2103
*/
2104
        argfree = TakeArgContent(BHEAD argin,argout);
5,079✔
2105
        {
2106
                a1 = argout;
5,079✔
2107
                while ( *a1 ) {
5,079✔
2108
                        if ( a1[0] == -SNUMBER && ( a1[1] == 1 || a1[1] == -1 ) ) {
5,937✔
2109
                                if ( a1[1] == -1 ) { sign = -sign; a1[1] = 1; }
5,079✔
2110
                                if ( a1[2] ) {
5,079✔
2111
                                        a = t = a1+2; while ( *t ) NEXTARG(t);
×
2112
                                        i = t - a1-2;
×
2113
                                        t = a1; NCOPY(t,a,i);
×
2114
                                        *t = 0;
×
2115
                                        continue;
×
2116
                                }
2117
                                else {
2118
                                        a1[0] = 0;
5,079✔
2119
                                }
2120
                                break;
5,079✔
2121
                        }
2122
                        else if ( a1[0] == FUNHEAD+ARGHEAD+4 && a1[ARGHEAD] == FUNHEAD+4
858✔
2123
                        && a1[*a1-1] == 3 && a1[*a1-2] == 1 && a1[*a1-3] == 1
×
2124
                        && a1[ARGHEAD+1] >= FUNCTION ) {
×
2125
                                a = t = a1+*a1; while ( *t ) NEXTARG(t);
×
2126
                                i = t - a;
×
2127
                                *a1 = -a1[ARGHEAD+1]; t = a1+1; NCOPY(t,a,i);
×
2128
                                *t = 0;
×
2129
                        }
2130
                        NEXTARG(a1);
6,795✔
2131
                }
2132
        }
2133
        if ( argfree == 0 ) {
5,079✔
2134
                argfree = argin;
2135
        }
2136
        else if ( argfree[0] == ( argfree[ARGHEAD]+ARGHEAD ) ) {
5,079✔
2137
                Normalize(BHEAD argfree+ARGHEAD);
32✔
2138
                argfree[0] = argfree[ARGHEAD]+ARGHEAD;
32✔
2139
                argfree[1] = 0;
32✔
2140
                if ( ( argfree[0] == ARGHEAD+4 ) && ( argfree[ARGHEAD+3] == 3 )
32✔
2141
                        && ( argfree[ARGHEAD+1] == 1 ) && ( argfree[ARGHEAD+2] == 1 ) ) {
32✔
2142
                        goto return0;
32✔
2143
                }
2144
        }
2145
        else {
2146
/*
2147
                The way we took out objects is rather brutish. We have to
2148
                normalize
2149
*/
2150
                NewSort(BHEAD0);
5,047✔
2151
                t = argfree+ARGHEAD;
5,047✔
2152
                while ( *t ) {
27,856✔
2153
                        tstop = t + *t;
22,809✔
2154
                        Normalize(BHEAD t);
22,809✔
2155
                        StoreTerm(BHEAD t);
22,809✔
2156
                        t = tstop;
22,809✔
2157
                }
2158
                EndSort(BHEAD argfree+ARGHEAD,0);
5,047✔
2159
                t = argfree+ARGHEAD;
5,047✔
2160
                while ( *t ) t += *t;
27,856✔
2161
                *argfree = t - argfree;
5,047✔
2162
        }
2163
/*
2164
          #] step 2 : 
2165
          #[ step 3 : look whether we have done this one already.
2166
*/
2167
        if ( ( number = FindArg(BHEAD argfree) ) != 0 ) {
5,047✔
2168
                if ( number > 0 ) t = cbuf[AT.fbufnum].rhs[number-1];
4,843✔
2169
                else              t = cbuf[AC.ffbufnum].rhs[-number-1];
×
2170
/*
2171
                Now position on the result. Remember we have in the cache:
2172
                                        inputarg,0,outputargs,0
2173
                t is currently at inputarg. *inputarg is always positive.
2174
                in principle this holds also for the arguments in the output
2175
                but we take no risks here (in case of future developments).
2176
*/
2177
                t += *t; t++;
4,843✔
2178
                tstop = t;
4,843✔
2179
                ii = 0;
4,843✔
2180
                while ( *tstop ) {
4,843✔
2181
                        if ( *tstop == -SNUMBER && tstop[1] == -1 ) {
4,864✔
2182
                                sign = -sign; ii += 2;
4✔
2183
                        }
2184
                        NEXTARG(tstop);
14,571✔
2185
                }
2186
                a = argout; while ( *a ) NEXTARG(a);
5,276✔
2187
#ifndef NEWORDER
2188
                if ( sign == -1 ) { *a++ = -SNUMBER; *a++ = -1; *a = 0; sign = 1; }
2189
#endif
2190
                i = tstop - t - ii;
4,843✔
2191
                ii = a - argout;
4,843✔
2192
                a2 = a; a1 = a + i;
4,843✔
2193
                *a1 = 0;
4,843✔
2194
                while ( ii > 0 ) { *--a1 = *--a2; ii--; }
5,709✔
2195
                a = argout;
2196
                while ( *t ) {
9,707✔
2197
                        if ( *t == -SNUMBER && t[1] == -1 ) { t += 2; }
4,864✔
2198
                        else { COPY1ARG(a,t) }
214,568✔
2199
                }
2200
                goto return0;
4,843✔
2201
        }
2202
/*
2203
          #] step 3 : 
2204
          #[ step 4 : invoke ConvertToPoly
2205

2206
                                We make a copy first in case there are no factors
2207
*/
2208
        argcopy = TermMalloc("argcopy");
204✔
2209
        for ( i = 0; i <= *argfree; i++ ) argcopy[i] = argfree[i];
16,366✔
2210

2211
        tstop = argfree + *argfree;
204✔
2212
        {
2213
                WORD sumcommu = 0;
204✔
2214
                t = argfree + ARGHEAD;
204✔
2215
                while ( t < tstop ) {
1,715✔
2216
                        sumcommu += DoesCommu(t);
1,511✔
2217
                        t += *t;
1,511✔
2218
                }
2219
                if ( sumcommu > 1 ) {
204✔
2220
                        MesPrint("ERROR: Cannot factorize an argument with more than one noncommuting object");
×
NEW
2221
                        TERMINATE(-1);
×
2222
                }
2223
        }
2224
        t = argfree + ARGHEAD;
204✔
2225

2226
        while ( t < tstop ) {
1,715✔
2227
                if ( ( t[1] != SYMBOL ) && ( *t != (ABS(t[*t-1])+1) ) ) {
1,511✔
2228
                        action = 1; break;
2229
                }
2230
                t += *t;
1,511✔
2231
        }
2232
        if ( action ) {
204✔
2233
                t = argfree + ARGHEAD;
×
2234
                argextra = AT.WorkPointer;
×
2235
                NewSort(BHEAD0);
×
2236
                while ( t < tstop ) {
×
2237
                        if ( LocalConvertToPoly(BHEAD t,argextra,startebuf,0) < 0 ) {
×
2238
                                error = -1;
×
2239
getout:
×
2240
                                AR.SortType = oldsorttype;
×
2241
                                TermFree(argcopy,"argcopy");
×
2242
                                if ( argfree != argin ) TermFree(argfree,"argfree");
×
2243
                                MesCall("ArgFactorize");
×
NEW
2244
                                TERMINATE(-1);
×
2245
                                return(-1);
×
2246
                        }
2247
                        StoreTerm(BHEAD argextra);
×
2248
                        t += *t; argextra += *argextra;
×
2249
                }
2250
                if ( EndSort(BHEAD argfree+ARGHEAD,0) ) { error = -2; goto getout; }
×
2251
                t = argfree + ARGHEAD;
2252
                while ( *t > 0 ) t += *t;
×
2253
                *argfree = t - argfree;
×
2254
        }
2255
/*
2256
          #] step 4 : 
2257
          #[ step 5 : If not in the tables, we have to do this by hard work.
2258
*/
2259

2260
        a = argout;
204✔
2261
        while ( *a ) NEXTARG(a);
421✔
2262
        if ( poly_factorize_argument(BHEAD argfree,a) < 0 ) {
204✔
2263
                MesCall("ArgFactorize");
×
2264
                error = -1;
×
2265
        }
2266
/*
2267
          #] step 5 : 
2268
          #[ step 6 : use now ConvertFromPoly
2269

2270
                        Be careful: there should be more than one argument now.
2271
*/
2272
        if ( error == 0 && action ) {
204✔
2273
          a1 = a; NEXTARG(a1);
×
2274
          if ( *a1 != 0 ) {
×
2275
                CBUF *C = cbuf+AC.cbufnum;
×
2276
                CBUF *CC = cbuf+AT.ebufnum;
×
2277
                WORD *oldworkpointer = AT.WorkPointer;
×
2278
                WORD *argcopy2 = TermMalloc("argcopy2"), *a1, *a2;
×
2279
                a1 = a; a2 = argcopy2;
×
2280
                while ( *a1 ) {
×
2281
                        if ( *a1 < 0 ) {
×
2282
                                if ( *a1 > -FUNCTION ) *a2++ = *a1++;
×
2283
                                *a2++ = *a1++; *a2 = 0;
×
2284
                                continue;
×
2285
                        }
2286
                        t = a1 + ARGHEAD;
×
2287
                        tstop = a1 + *a1;
×
2288
                        argextra = AT.WorkPointer;
×
2289
                        NewSort(BHEAD0);
×
2290
                        while ( t < tstop ) {
×
2291
                                if ( ConvertFromPoly(BHEAD t,argextra,numxsymbol,CC->numrhs-startebuf+numxsymbol
×
2292
                                ,startebuf-numxsymbol,1) <= 0 ) {
×
2293
                                        TermFree(argcopy2,"argcopy2");
×
2294
                                        LowerSortLevel();
×
2295
                                        error = -3;
×
2296
                                        goto getout;
×
2297
                                }
2298
                                t += *t;
×
2299
                                AT.WorkPointer = argextra + *argextra;
×
2300
/*
2301
                                ConvertFromPoly leaves terms with subexpressions. Hence:
2302
*/
2303
                                if ( Generator(BHEAD argextra,C->numlhs) ) {
×
2304
                                        TermFree(argcopy2,"argcopy2");
×
2305
                                        LowerSortLevel();
×
2306
                                        error = -4;
×
2307
                                        goto getout;
×
2308
                                }
2309
                        }
2310
                        AT.WorkPointer = oldworkpointer;
×
2311
                        if ( EndSort(BHEAD a2+ARGHEAD,0) ) { error = -5; goto getout; }
×
2312
                        t = a2+ARGHEAD; while ( *t ) t += *t;
×
2313
                        *a2 = t - a2; a2[1] = 0; ZEROARG(a2);
×
2314
                        ToFast(a2,a2); NEXTARG(a2);
×
2315
                        a1 = tstop;
2316
                }
2317
                i = a2 - argcopy2;
×
2318
                a2 = argcopy2; a1 = a;
×
2319
                NCOPY(a1,a2,i);
×
2320
                *a1 = 0;
×
2321
                TermFree(argcopy2,"argcopy2");
×
2322
/*
2323
                Erase the entries we made temporarily in cbuf[AT.ebufnum]
2324
*/
2325
                CC->numrhs = startebuf;
×
2326
          }
2327
          else {        /* no factorization. recover the argument from before step 3. */
2328
                for ( i = 0; i <= *argcopy; i++ ) a[i] = argcopy[i];
×
2329
          }
2330
        }
2331
/*
2332
          #] step 6 : 
2333
          #[ step 7 : Add this one to the tables.
2334

2335
                                Possibly drop some elements in the tables
2336
                                when they become too full.
2337
*/
2338
        if ( error == 0 && AN.ncmod == 0 ) {
204✔
2339
                if ( InsertArg(BHEAD argcopy,a,0) < 0 ) { error = -1; }
204✔
2340
        }
2341
/*
2342
          #] step 7 : 
2343
          #[ step 8 : Clean up and return.
2344

2345
                Change the order of the arguments in argout and a.
2346
                Use argcopy as spare space.
2347
*/
2348
        ii = a - argout;
204✔
2349
        for ( i = 0; i < ii; i++ ) argcopy[i] = argout[i];
656✔
2350
        a1 = a;
204✔
2351
        while ( *a1 ) {
204✔
2352
                if ( *a1 == -SNUMBER && a1[1] < 0 ) {
204✔
2353
                        sign = -sign; a1[1] = -a1[1];
8✔
2354
                        if ( a1[1] == 1 ) {
8✔
2355
                                a2 = a1+2; while ( *a2 ) NEXTARG(a2);
32✔
2356
                                i = a2-a1-2; a2 = a1+2;
8✔
2357
                                NCOPY(a1,a2,i);
440✔
2358
                                *a1 = 0;
8✔
2359
                        }
2360
                        while ( *a1 ) NEXTARG(a1);
8✔
2361
                        break;
2362
                }
2363
                else {
2364
                        if ( *a1 > 0 && *a1 == a1[ARGHEAD]+ARGHEAD && a1[*a1-1] < 0 ) {
196✔
2365
                                a1[*a1-1] = -a1[*a1-1]; sign = -sign;
×
2366
                        }
2367
                        if ( *a1 == ARGHEAD+4 && a1[ARGHEAD+1] == 1 && a1[ARGHEAD+2] == 1 ) {
196✔
2368
                                a2 = a1+ARGHEAD+4; while ( *a2 ) NEXTARG(a2);
×
2369
                                i = a2-a1-ARGHEAD-4; a2 = a1+ARGHEAD+4;
×
2370
                                NCOPY(a1,a2,i);
×
2371
                                *a1 = 0;
×
2372
                                break;
×
2373
                        }
2374
                        while ( *a1 ) NEXTARG(a1);
408✔
2375
                        break;
2376
                }
2377
                NEXTARG(a1);
204✔
2378
        }
2379
        i = a1 - a;
204✔
2380
        a2 = argout;
204✔
2381
        NCOPY(a2,a,i);
9,328✔
2382
        for ( i = 0; i < ii; i++ ) *a2++ = argcopy[i];
656✔
2383
#ifndef NEWORDER
2384
        if ( sign == -1 ) { *a2++ = -SNUMBER; *a2++ = -1; sign = 1; }
2385
#endif
2386
        *a2 = 0;
204✔
2387
        TermFree(argcopy,"argcopy");
204✔
2388
return0:
5,079✔
2389
        if ( argfree != argin ) TermFree(argfree,"argfree");
5,079✔
2390
        if ( oldsorttype != AR.SortType ) {
5,079✔
2391
                AR.SortType = oldsorttype;
15✔
2392
                a = argout;
15✔
2393
                while ( *a ) {
15✔
2394
                        if ( *a > 0 ) {
218✔
2395
                                NewSort(BHEAD0);
51✔
2396
                                oldword = a[*a]; a[*a] = 0;
51✔
2397
                                t = a+ARGHEAD;
51✔
2398
                                while ( *t ) {
303✔
2399
                                        tstop = t + *t;
252✔
2400
                                        StoreTerm(BHEAD t);
252✔
2401
                                        t = tstop;
252✔
2402
                                }
2403
                                EndSort(BHEAD a+ARGHEAD,0);
51✔
2404
                                a[*a] = oldword;
51✔
2405
                                a += *a;
51✔
2406
                        }
2407
                        else { NEXTARG(a); }
400✔
2408
                }
2409
        }
2410
#ifdef NEWORDER
2411
        t = argout; numargs = 0;
2412
        while ( *t ) {
11,033✔
2413
                tt = t;
5,954✔
2414
                NEXTARG(t);
5,954✔
2415
                if ( *tt == ABS(t[-1])+1+ARGHEAD && sign == -1 ) { t[-1] = -t[-1]; sign = 1; }
5,954✔
2416
                else if ( *tt == -SNUMBER && sign == -1 ) { tt[1] = -tt[1]; sign = 1; }
5,951✔
2417
                numargs++;
5,954✔
2418
        }
2419
        if ( sign == -1 ) {
5,079✔
2420
                *t++ = -SNUMBER; *t++ = -1; *t = 0; sign = 1; numargs++;
4✔
2421
        }
2422
#else
2423
/*
2424
        Now we have to sort the arguments
2425
        First have the number of 'nontrivial/nonnumerical' arguments
2426
        Then make a piece of code like in FullSymmetrize with that number
2427
        of arguments to be symmetrized.
2428
        Put a function in front
2429
        Call the Symmetrize routine
2430
*/
2431
        t = argout; numargs = 0;
2432
        while ( *t && *t != -SNUMBER && ( *t < 0 || ( ABS(t[*t-1]) != *t-1 ) ) ) {
2433
                NEXTARG(t);
2434
                numargs++;
2435
        }
2436
#endif
2437
        if ( numargs > 1 ) {
5,079✔
2438
                WORD *Lijst;
383✔
2439
                WORD x[3];
383✔
2440
                x[0] = argout[-FUNHEAD];
383✔
2441
                x[1] = argout[-FUNHEAD+1];
383✔
2442
                x[2] = argout[-FUNHEAD+2];
383✔
2443
                while ( *t ) { NEXTARG(t); }
383✔
2444
                argout[-FUNHEAD] = SQRTFUNCTION;
383✔
2445
                argout[-FUNHEAD+1] = t-argout+FUNHEAD;
383✔
2446
                argout[-FUNHEAD+2] = 0;
383✔
2447
                AT.WorkPointer = t+1;
383✔
2448
                Lijst = AT.WorkPointer;
383✔
2449
                for ( i = 0; i < numargs; i++ ) Lijst[i] = i;
1,645✔
2450
                AT.WorkPointer += numargs;
383✔
2451
                error = Symmetrize(BHEAD argout-FUNHEAD,Lijst,numargs,1,SYMMETRIC);
383✔
2452
                AT.WorkPointer = Lijst;
383✔
2453
                argout[-FUNHEAD] = x[0];
383✔
2454
                argout[-FUNHEAD+1] = x[1];
383✔
2455
                argout[-FUNHEAD+2] = x[2];
383✔
2456
#ifdef NEWORDER
2457
/*
2458
                Now we have to get a potential numerical argument to the first position
2459
*/
2460
                tstop = argout; while ( *tstop ) { NEXTARG(tstop); }
1,645✔
2461
                t = argout; number = 0;
2462
                while ( *t ) {
1,582✔
2463
                        tt = t; NEXTARG(t);
1,214✔
2464
                        if ( *tt == -SNUMBER ) {
1,214✔
2465
                                if ( number == 0 ) break;
12✔
2466
                                x[0] = tt[1];
×
2467
                                while ( tt > argout ) { *--t = *--tt; }
×
2468
                                argout[0] = -SNUMBER; argout[1] = x[0];
×
2469
                                break;
×
2470
                        }
2471
                        else if ( *tt == ABS(t[-1])+1+ARGHEAD ) {
1,202✔
2472
                                if ( number == 0 ) break;
3✔
2473
                                ii = t - tt;
3✔
2474
                                for ( i = 0; i < ii; i++ ) tstop[i] = tt[i];
27✔
2475
                                while ( tt > argout ) { *--t = *--tt; }
321✔
2476
                                for ( i = 0; i < ii; i++ ) argout[i] = tstop[i];
27✔
2477
                                *tstop = 0;
3✔
2478
                                break;
3✔
2479
                        }
2480
                        number++;
1,199✔
2481
                }
2482
#endif
2483
        }
2484
/*
2485
          #] step 8 : 
2486
*/
2487
        return(error);
2488
}
2489

2490
/*
2491
          #] ArgFactorize : 
2492
          #[ FindArg :
2493
*/
2494
/**
2495
 *        Looks the argument up in the (workers) table.
2496
 *        If it is found the number in the table is returned (plus one to make it positive).
2497
 *        If it is not found we look in the compiler provided table.
2498
 *        If it is found - the number in the table is returned (minus one to make it negative).
2499
 *        If in neither table we return zero.
2500
 */
2501

2502
WORD FindArg(PHEAD WORD *a)
5,047✔
2503
{
2504
        int number;
5,047✔
2505
        if ( AN.ncmod != 0 ) return(0);        /* no room for mod stuff */
5,047✔
2506
        number = FindTree(AT.fbufnum,a);
5,047✔
2507
        if ( number >= 0 ) return(number+1);
5,047✔
2508
        number = FindTree(AC.ffbufnum,a);
204✔
2509
        if ( number >= 0 ) return(-number-1);
204✔
2510
        return(0);
2511
}
2512

2513
/*
2514
          #] FindArg : 
2515
          #[ InsertArg :
2516
*/
2517
/**
2518
 *        Inserts the argument into the (workers) table.
2519
 *        If the table is too full we eliminate half of it.
2520
 *        The eliminated elements are the ones that have not been used
2521
 *        most recently, weighted by their total use and age(?).
2522
 *        If par == 0 it inserts in the regular factorization cache
2523
 *        If par == 1 it inserts in the cache defined with the FactorCache statement
2524
 */
2525

2526
WORD InsertArg(PHEAD WORD *argin, WORD *argout,int par)
204✔
2527
{
2528
        CBUF *C;
204✔
2529
        WORD *a, i, bufnum;
204✔
2530
        if ( par == 0 ) {
204✔
2531
                bufnum = AT.fbufnum;
204✔
2532
                C = cbuf+bufnum;
204✔
2533
                if ( C->numrhs >= (C->maxrhs-2) ) CleanupArgCache(BHEAD AT.fbufnum);
204✔
2534
        }
2535
        else if ( par == 1 ) {
×
2536
                bufnum = AC.ffbufnum;
×
2537
                C = cbuf+bufnum;
×
2538
        }
2539
        else { return(-1); }
2540
        AddRHS(bufnum,1);
204✔
2541
        AddNtoC(bufnum,*argin,argin,1);
204✔
2542
        AddToCB(C,0)
204✔
2543
        a = argout; while ( *a ) NEXTARG(a);
448✔
2544
        i = a - argout;
204✔
2545
        AddNtoC(bufnum,i,argout,2);
204✔
2546
        AddToCB(C,0)
204✔
2547
        return(InsTree(bufnum,C->numrhs));
204✔
2548
}
2549

2550
/*
2551
          #] InsertArg : 
2552
          #[ CleanupArgCache :
2553
*/
2554
/**
2555
 *        Cleans up the argument factorization cache.
2556
 *        We throw half the elements.
2557
 *        For a weight of what we want to keep we use the product of
2558
 *        usage and the number in the buffer.
2559
 */
2560

2561
int CleanupArgCache(PHEAD WORD bufnum)
×
2562
{
2563
        CBUF *C = cbuf + bufnum;
×
2564
        COMPTREE *boomlijst = C->boomlijst;
×
2565
        LONG *weights = (LONG *)Malloc1(2*(C->numrhs+1)*sizeof(LONG),"CleanupArgCache");
×
2566
        LONG w, whalf, *extraweights;
×
2567
        WORD *a, *to, *from;
×
2568
        int i,j,k;
×
2569
        for ( i = 1; i <= C->numrhs; i++ ) {
×
2570
                weights[i] = ((LONG)i) * (boomlijst[i].usage);
×
2571
        }
2572
/*
2573
                Now sort the weights and determine the halfway weight
2574
*/
2575
        extraweights = weights+C->numrhs+1;
×
2576
        SortWeights(weights+1,extraweights,C->numrhs);
×
2577
        whalf = weights[C->numrhs/2+1];
×
2578
/*
2579
                We should drop everybody with a weight < whalf.
2580
*/
2581
        to = C->Buffer;
×
2582
        k = 1;
×
2583
        for ( i = 1; i <= C->numrhs; i++ ) {
×
2584
                from = C->rhs[i]; w = ((LONG)i) * (boomlijst[i].usage);
×
2585
                if ( w >= whalf ) {
×
2586
                        if ( i < C->numrhs-1 ) {
×
2587
                                if ( to == from ) {
×
2588
                                        to = C->rhs[i+1];
×
2589
                                }
2590
                                else {
2591
                                        j = C->rhs[i+1] - from;
×
2592
                                        C->rhs[k] = to;
×
2593
                                        NCOPY(to,from,j)
×
2594
                                }
2595
                        }
2596
                        else if ( to == from ) {
×
2597
                                to += *to + 1; while ( *to ) NEXTARG(to); to++;
×
2598
                        }
2599
                        else {
2600
                                a = from; a += *a+1; while ( *a ) NEXTARG(a); a++;
×
2601
                                j = a - from;
×
2602
                                C->rhs[k] = to;
×
2603
                                NCOPY(to,from,j)
×
2604
                        }
2605
                        weights[k++] = boomlijst[i].usage;
×
2606
                }
2607
        }
2608
        C->numrhs = --k;
×
2609
        C->Pointer = to;
×
2610
/*
2611
                Next we need to rebuild the tree.
2612
                Note that this can probably be done much faster by using the
2613
                remains of the old tree !!!!!!!!!!!!!!!!
2614
*/
2615
        ClearTree(AT.fbufnum);
×
2616
        for ( i = 1; i <= k; i++ ) {
×
2617
                InsTree(AT.fbufnum,i);
×
2618
                boomlijst[i].usage = weights[i];
×
2619
        }
2620
/*
2621
                And cleanup
2622
*/
2623
        M_free(weights,"CleanupArgCache");
×
2624
        return(0);
×
2625
}
2626

2627
/*
2628
          #] CleanupArgCache : 
2629
          #[ ArgSymbolMerge :
2630
*/
2631

2632
int ArgSymbolMerge(WORD *t1, WORD *t2)
17,762✔
2633
{
2634
        WORD *t1e = t1+t1[1];
17,762✔
2635
        WORD *t2e = t2+t2[1];
17,762✔
2636
        WORD *t1a = t1+2;
17,762✔
2637
        WORD *t2a = t2+2;
17,762✔
2638
        WORD *t3;
17,762✔
2639
        while ( t1a < t1e && t2a < t2e ) {
44,149✔
2640
                if ( *t1a < *t2a ) {
26,387✔
2641
                        if ( t1a[1] >= 0 ) {
4,443✔
2642
                                t3 = t1a+2;
4,443✔
2643
                                while ( t3 < t1e ) { t3[-2] = *t3; t3[-1] = t3[1]; t3 += 2; }
4,836✔
2644
                                t1e -= 2;
4,443✔
2645
                        }
2646
                        else t1a += 2;
×
2647
                }
2648
                else if ( *t1a > *t2a ) {
21,944✔
2649
                        if ( t2a[1] >= 0 ) t2a += 2;
4,861✔
2650
                        else {
2651
                                t3 = t1e;
2652
                                while ( t3 > t1a ) { *t3 = t3[-2]; t3[1] = t3[-1]; t3 -= 2; }
×
2653
                                *t1a++ = *t2a++;
×
2654
                                *t1a++ = *t2a++;
×
2655
                                t1e += 2;
×
2656
                        }
2657
                }
2658
                else {
2659
                        if ( t2a[1] < t1a[1] ) t1a[1] = t2a[1];
17,083✔
2660
                        t1a += 2; t2a += 2;
17,083✔
2661
                }
2662
        }
2663
        while ( t2a < t2e ) {
29,806✔
2664
                if ( t2a[1] < 0 ) {
12,044✔
2665
                        *t1a++ = *t2a++;
×
2666
                        *t1a++ = *t2a++;
×
2667
                }
2668
                else t2a += 2;
12,044✔
2669
        }
2670
        while ( t1a < t1e ) {
22,686✔
2671
                if ( t1a[1] >= 0 ) {
4,924✔
2672
                        t3 = t1a+2;
4,924✔
2673
                        while ( t3 < t1e ) { t3[-2] = *t3; t3[-1] = t3[1]; t3 += 2; }
4,924✔
2674
                        t1e -= 2;
4,924✔
2675
                }
2676
                else t1a += 2;
×
2677
        }
2678
        t1[1] = t1a - t1;
17,762✔
2679
        return(0);
17,762✔
2680
}
2681

2682
/*
2683
          #] ArgSymbolMerge : 
2684
          #[ ArgDotproductMerge :
2685
*/
2686

2687
int ArgDotproductMerge(WORD *t1, WORD *t2)
17,762✔
2688
{
2689
        WORD *t1e = t1+t1[1];
17,762✔
2690
        WORD *t2e = t2+t2[1];
17,762✔
2691
        WORD *t1a = t1+2;
17,762✔
2692
        WORD *t2a = t2+2;
17,762✔
2693
        WORD *t3;
17,762✔
2694
        while ( t1a < t1e && t2a < t2e ) {
17,762✔
2695
                if ( *t1a < *t2a || ( *t1a == *t2a && t1a[1] < t2a[1] ) ) {
×
2696
                        if ( t1a[2] >= 0 ) {
×
2697
                                t3 = t1a+3;
×
2698
                                while ( t3 < t1e ) { t3[-3] = *t3; t3[-2] = t3[1]; t3[-1] = t3[2]; t3 += 3; }
×
2699
                                t1e -= 3;
×
2700
                        }
2701
                        else t1a += 3;
×
2702
                }
2703
                else if ( *t1a > *t2a || ( *t1a == *t2a && t1a[1] > t2a[1] ) ) {
×
2704
                        if ( t2a[2] >= 0 ) t2a += 3;
×
2705
                        else {
2706
                                t3 = t1e;
2707
                                while ( t3 > t1a ) { *t3 = t3[-3]; t3[1] = t3[-2]; t3[2] = t3[-1]; t3 -= 3; }
×
2708
                                *t1a++ = *t2a++;
×
2709
                                *t1a++ = *t2a++;
×
2710
                                *t1a++ = *t2a++;
×
2711
                                t1e += 3;
×
2712
                        }
2713
                }
2714
                else {
2715
                        if ( t2a[2] < t1a[2] ) t1a[2] = t2a[2];
×
2716
                        t1a += 3; t2a += 3;
×
2717
                }
2718
        }
2719
        while ( t2a < t2e ) {
17,762✔
2720
                if ( t2a[2] < 0 ) {
×
2721
                        *t1a++ = *t2a++;
×
2722
                        *t1a++ = *t2a++;
×
2723
                        *t1a++ = *t2a++;
×
2724
                }
2725
                else t2a += 3;
×
2726
        }
2727
        while ( t1a < t1e ) {
17,762✔
2728
                if ( t1a[2] >= 0 ) {
×
2729
                        t3 = t1a+3;
×
2730
                        while ( t3 < t1e ) { t3[-3] = *t3; t3[-2] = t3[1]; t3[-1] = t3[2]; t3 += 3; }
×
2731
                        t1e -= 3;
×
2732
                }
2733
                else t1a += 2;
×
2734
        }
2735
        t1[1] = t1a - t1;
17,762✔
2736
        return(0);
17,762✔
2737
}
2738

2739
/*
2740
          #] ArgDotproductMerge : 
2741
          #[ TakeArgContent :
2742
*/
2743
/**
2744
 *        Implements part of the old ExecArg in which we take common factors
2745
 *        from arguments with more than one term.
2746
 *        The common pieces are put in argout as a sequence of arguments.
2747
 *        The part with the multiple terms that are now relative prime is
2748
 *        put in argfree which is allocated via TermMalloc and is given as the
2749
 *        return value.
2750
 *        The difference with the old code is that negative powers are always
2751
 *        removed. Hence it is as in MakeInteger in which only numerators will
2752
 *        be left: now only zero or positive powers will be remaining.
2753
 */
2754

2755
WORD *TakeArgContent(PHEAD WORD *argin, WORD *argout)
5,079✔
2756
{
2757
        GETBIDENTITY
2758
        WORD *t, *rnext, *r1, *r2, *r3, *r5, *r6, *r7, *r8, *r9;
5,079✔
2759
        WORD pow, *mm, *mnext, *mstop, *argin2 = argin, *argin3 = argin, *argfree;
5,079✔
2760
        WORD ncom;
5,079✔
2761
        int j, i, act;
5,079✔
2762
        r5 = t = argin + ARGHEAD;
5,079✔
2763
        r3 = argin + *argin;
5,079✔
2764
        rnext = t + *t;
5,079✔
2765
        GETSTOP(t,r6);
5,079✔
2766
        r1 = argout;
5,079✔
2767
        t++;
5,079✔
2768
/*
2769
                First pass: arrange everything but the symbols and dotproducts.
2770
                They need separate treatment because we have to take out negative
2771
                powers.
2772
*/
2773
        while ( t < r6 ) {
10,158✔
2774
/*
2775
                        #[ DELTA/VECTOR :
2776
*/
2777
                if ( *t == DELTA || *t == VECTOR ) {
5,079✔
2778
                        r7 = t; r8 = t + t[1]; t += 2;
×
2779
                        while ( t < r8 ) {
×
2780
                                mm = rnext;
2781
                                pow = 1;
2782
                                while ( mm < r3 ) {
×
2783
                                        mnext = mm + *mm;
×
2784
                                        GETSTOP(mm,mstop); mm++;
×
2785
                                        while ( mm < mstop ) {
×
2786
                                                if ( *mm != *r7 ) mm += mm[1];
×
2787
                                                else break;
2788
                                        }
2789
                                        if ( *mm == *r7 ) {
×
2790
                                                mstop = mm + mm[1]; mm += 2;
×
2791
                                                while ( ( *mm != *t || mm[1] != t[1] )
×
2792
                                                        && mm < mstop ) mm += 2;
×
2793
                                                if ( mm >= mstop ) pow = 0;
×
2794
                                        }
2795
                                        else pow = 0;
2796
                                        if ( pow == 0 ) break;
×
2797
                                        mm = mnext;
2798
                                }
2799
                                if ( pow == 0 ) { t += 2; continue; }
×
2800
/*
2801
                                We have a factor
2802
*/
2803
                                *r1++ = 8 + ARGHEAD;
×
2804
                                for ( j = 1; j < ARGHEAD; j++ ) *r1++ = 0;
×
2805
                                *r1++ = 8; *r1++ = *r7;
×
2806
                                *r1++ = 4; *r1++ = *t; *r1++ = t[1];
×
2807
                                *r1++ = 1; *r1++ = 1; *r1++ = 3;
×
2808
                                argout = r1;
×
2809
/*
2810
                                Now we have to remove the delta's/vectors
2811
*/
2812
                                mm = rnext;
×
2813
                                while ( mm < r3 ) {
×
2814
                                        mnext = mm + *mm;
×
2815
                                        GETSTOP(mm,mstop); mm++;
×
2816
                                        while ( mm < mstop ) {
×
2817
                                                if ( *mm != *r7 ) mm += mm[1];
×
2818
                                                else break;
2819
                                        }
2820
                                        mstop = mm + mm[1]; mm += 2;
×
2821
                                        while ( mm < mstop && (
×
2822
                                         *mm != *t || mm[1] != t[1] ) ) mm += 2;
×
2823
                                        *mm = mm[1] = NOINDEX;
×
2824
                                        mm = mnext;
×
2825
                                }
2826
                                *t = t[1] = NOINDEX;
×
2827
                                t += 2;
×
2828
                        }
2829
                }
2830
/*
2831
                        #] DELTA/VECTOR : 
2832
                        #[ INDEX :
2833
*/
2834
                else if ( *t == INDEX ) {
5,079✔
2835
                        r7 = t; r8 = t + t[1]; t += 2;
×
2836
                        while ( t < r8 ) {
×
2837
                                mm = rnext;
2838
                                pow = 1;
2839
                                while ( mm < r3 ) {
×
2840
                                        mnext = mm + *mm;
×
2841
                                        GETSTOP(mm,mstop); mm++;
×
2842
                                        while ( mm < mstop ) {
×
2843
                                                if ( *mm != *r7 ) mm += mm[1];
×
2844
                                                else break;
2845
                                        }
2846
                                        if ( *mm == *r7 ) {
×
2847
                                                mstop = mm + mm[1]; mm += 2;
×
2848
                                                while ( *mm != *t 
×
2849
                                                        && mm < mstop ) mm++;
×
2850
                                                if ( mm >= mstop ) pow = 0;
×
2851
                                        }
2852
                                        else pow = 0;
2853
                                        if ( pow == 0 ) break;
×
2854
                                        mm = mnext;
2855
                                }
2856
                                if ( pow == 0 ) { t++; continue; }
×
2857
/*
2858
                                We have a factor
2859
*/
2860
                                if ( *t < 0 ) { *r1++ = -VECTOR; }
×
2861
                                else          { *r1++ = -INDEX; }
×
2862
                                *r1++ = *t;
×
2863
                                argout = r1;
×
2864
/*
2865
                                Now we have to remove the index
2866
*/
2867
                                *t = NOINDEX;
×
2868
                                mm = rnext;
×
2869
                                while ( mm < r3 ) {
×
2870
                                        mnext = mm + *mm;
×
2871
                                        GETSTOP(mm,mstop); mm++;
×
2872
                                        while ( mm < mstop ) {
×
2873
                                                if ( *mm != *r7 ) mm += mm[1];
×
2874
                                                else break;
2875
                                        }
2876
                                        mstop = mm + mm[1]; mm += 2;
×
2877
                                        while ( mm < mstop && 
×
2878
                                         *mm != *t ) mm += 1;
×
2879
                                        *mm = NOINDEX;
×
2880
                                        mm = mnext;
×
2881
                                }
2882
                                t += 1;
×
2883
                        }
2884
                }
2885
/*
2886
                        #] INDEX : 
2887
                        #[ FUNCTION :
2888
*/
2889
                else if ( *t >= FUNCTION ) {
5,079✔
2890
/*
2891
                        In the next code we should actually look inside
2892
                        the DENOMINATOR or EXPONENT for noncommuting objects
2893
*/
2894
                        if ( *t >= FUNCTION &&
×
2895
                                functions[*t-FUNCTION].commute == 0 ) ncom = 0;
×
2896
                        else ncom = 1;
2897
                        if ( ncom ) {
2898
                                mm = r5 + 1;
2899
                                while ( mm < t && ( *mm == DUMMYFUN
×
2900
                                || *mm == DUMMYTEN ) ) mm += mm[1];
×
2901
                                if ( mm < t ) { t += t[1]; continue; }
×
2902
                        }
2903
                        mm = rnext; pow = 1;
2904
                        while ( mm < r3 ) {
×
2905
                                mnext = mm + *mm;
×
2906
                                GETSTOP(mm,mstop); mm++;
×
2907
                                while ( mm < mstop ) {
×
2908
                                        if ( *mm == *t && mm[1] == t[1] ) {
×
2909
                                                for ( i = 2; i < t[1]; i++ ) {
×
2910
                                                        if ( mm[i] != t[i] ) break;
×
2911
                                                }
2912
                                                if ( i >= t[1] )
×
2913
                                                        { mm += mm[1]; goto nextmterm; }
×
2914
                                        }
2915
                                        if ( ncom && *mm != DUMMYFUN && *mm != DUMMYTEN )
×
2916
                                                { pow = 0; break; }
2917
                                        mm += mm[1];
×
2918
                                }
2919
                                if ( mm >= mstop ) pow = 0;
×
2920
                                if ( pow == 0 ) break;
×
2921
nextmterm:                mm = mnext;
×
2922
                        }
2923
                        if ( pow == 0 ) { t += t[1]; continue; }
×
2924
/*
2925
                        Copy the function
2926
*/
2927
                        *r1++ = t[1] + 4 + ARGHEAD;
×
2928
                        for ( i = 1; i < ARGHEAD; i++ ) *r1++ = 0;
×
2929
                        *r1++ = t[1] + 4;
×
2930
                        for ( i = 0; i < t[1]; i++ ) *r1++ = t[i];
×
2931
                        *r1++ = 1; *r1++ = 1; *r1++ = 3;
×
2932
                        argout = r1;
×
2933
/*
2934
                        Now we have to take out the functions
2935
*/
2936
                        mm = rnext;
×
2937
                        while ( mm < r3 ) {
×
2938
                                mnext = mm + *mm;
×
2939
                                GETSTOP(mm,mstop); mm++;
×
2940
                                while ( mm < mstop ) {
×
2941
                                        if ( *mm == *t && mm[1] == t[1] ) {
×
2942
                                                for ( i = 2; i < t[1]; i++ ) {
×
2943
                                                        if ( mm[i] != t[i] ) break;
×
2944
                                                }
2945
                                                if ( i >= t[1] ) {
×
2946
                                                        if ( functions[*t-FUNCTION].spec > 0 )
×
2947
                                                                *mm = DUMMYTEN;
×
2948
                                                        else
2949
                                                                *mm = DUMMYFUN;
×
2950
                                                        mm += mm[1];
×
2951
                                                        goto nextterm;
×
2952
                                                }
2953
                                        }
2954
                                        mm += mm[1];
×
2955
                                }
2956
nextterm:                                                mm = mnext;
×
2957
                        }
2958
                        if ( functions[*t-FUNCTION].spec > 0 )
×
2959
                                        *t = DUMMYTEN;
×
2960
                        else
2961
                                        *t = DUMMYFUN;
×
2962
                        t += t[1];
×
2963
                }
2964
/*
2965
                        #] FUNCTION : 
2966
*/
2967
                else {
2968
                        t += t[1];
5,079✔
2969
                }
2970
        }
2971
/*
2972
                        #[ SYMBOL :
2973

2974
                Now collect all symbols. We can use the space after r1 as storage
2975
*/
2976
        t = argin+ARGHEAD;
5,079✔
2977
        rnext = t + *t;
5,079✔
2978
        r2 = r1;
5,079✔
2979
        while ( t < r3 ) {
27,920✔
2980
                GETSTOP(t,r6);
22,841✔
2981
                t++;
22,841✔
2982
                act = 0;
22,841✔
2983
                while ( t < r6 ) {
45,382✔
2984
                        if ( *t == SYMBOL ) {
22,541✔
2985
                                act = 1;
22,541✔
2986
                                i = t[1];
22,541✔
2987
                                NCOPY(r2,t,i)
155,079✔
2988
                        }
2989
                        else { t += t[1]; }
×
2990
                }
2991
                if ( act == 0 ) {
22,841✔
2992
                        *r2++ = SYMBOL; *r2++ = 2;
300✔
2993
                }
2994
                t = rnext; rnext = rnext + *rnext;
22,841✔
2995
        }
2996
        *r2 = 0;
5,079✔
2997
        argin2 = argin;
5,079✔
2998
/*
2999
                Now we have a list of all symbols as a sequence of SYMBOL subterms.
3000
                Any symbol that is absent in a subterm has power zero.
3001
                We now need a list of all minimum powers.
3002
                This can be done by subsequent merges.
3003
*/
3004
        r7 = r1;          /* The first object into which we merge. */        
5,079✔
3005
        r8 = r7 + r7[1];  /* The object that gets merged into r7.  */
5,079✔
3006
        while ( *r8 ) {
22,841✔
3007
                r2 = r8 + r8[1]; /* Next object */
17,762✔
3008
                ArgSymbolMerge(r7,r8);
17,762✔
3009
                r8 = r2;
17,762✔
3010
        }
3011
/*
3012
                Now we have to divide by the object in r7 and take it apart as factors.
3013
                The division can be simple if there are no negative powers.
3014
*/
3015
        if ( r7[1] > 2 ) {
5,079✔
3016
                r8 = r7+2;
355✔
3017
                r2 = r7 + r7[1];
355✔
3018
                act = 0;
355✔
3019
                pow = 0;
355✔
3020
                while ( r8 < r2 ) {
728✔
3021
                        if ( r8[1] < 0 ) { act = 1; pow += -r8[1]*(ARGHEAD+8); }
373✔
3022
                        else { pow += 2*r8[1]; }
373✔
3023
                        r8 += 2;
373✔
3024
                }
3025
/*
3026
                The amount of space we need to move r7 is given in pow
3027
*/
3028
                if ( act == 0 ) {        /* this can be done 'in situ' */
355✔
3029
                        t = argin + ARGHEAD;
3030
                        while ( t < r3 ) {
2,656✔
3031
                                rnext = t + *t;
2,301✔
3032
                                GETSTOP(t,r6);
2,301✔
3033
                                t++;
2,301✔
3034
                                while ( t < r6 ) {
4,602✔
3035
                                        if ( *t != SYMBOL ) { t += t[1]; continue; }
2,301✔
3036
                                        r8 = r7+2; r9 = t + t[1]; t += 2;
2,301✔
3037
                                        while ( ( t < r9 ) && ( r8 < r2 ) ) {
9,549✔
3038
                                                if ( *t == *r8 ) {
7,248✔
3039
                                                        t[1] -= r8[1]; t += 2; r8 += 2;
6,891✔
3040
                                                }
3041
                                                else { /* *t must be < than *r8 !!! */
3042
                                                        t += 2;
357✔
3043
                                                }
3044
                                        }
3045
                                        t = r9;
3046
                                }
3047
                                t = rnext;
3048
                        }
3049
/*
3050
                        And now the factors that go to argout.
3051
                        First we have to move r7 out of the way.
3052
*/
3053
                        r8 = r7+pow; i = r7[1];
355✔
3054
                        while ( --i >= 0 ) r8[i] = r7[i];
1,811✔
3055
                        r2 += pow;
355✔
3056
                        r8 += 2;
355✔
3057
                        while ( r8 < r2 ) {
728✔
3058
                                for ( i = 0; i < r8[1]; i++ ) { *r1++ = -SYMBOL; *r1++ = *r8; }
1,220✔
3059
                                r8 += 2;
373✔
3060
                        }
3061
                }
3062
                else {        /* this needs a new location */
3063
                        argin2 = TermMalloc("TakeArgContent2");
×
3064
/*
3065
                        We have to multiply the inverse of r7 into argin
3066
                        The answer should go to argin2.
3067
*/
3068
                        r5 = argin2; *r5++ = 0; *r5++ = 0; FILLARG(r5);
×
3069
                        t = argin+ARGHEAD;
×
3070
                        while ( t < r3 ) {
×
3071
                                rnext = t + *t;
×
3072
                                GETSTOP(t,r6);
×
3073
                                r9 = r5;
×
3074
                                *r5++ = *t++ + r7[1];
×
3075
                                while ( t < r6 ) *r5++ = *t++;
×
3076
                                i = r7[1] - 2; r8 = r7+2;
×
3077
                                *r5++ = r7[0]; *r5++ = r7[1];
×
3078
                                while ( i > 0 ) { *r5++ = *r8++; *r5++ = -*r8++; i -= 2; }
×
3079
                                while ( t < rnext ) *r5++ = *t++;
×
3080
                                Normalize(BHEAD r9);
×
3081
                                r5 = r9 + *r9;
×
3082
                        }
3083
                        *r5 = 0;
×
3084
                        *argin2 = r5-argin2;
×
3085
/*
3086
                        We may have to sort the terms in argin2.
3087
*/
3088
                        NewSort(BHEAD0);
×
3089
                        t = argin2+ARGHEAD;
×
3090
                        while ( *t ) {
×
3091
                                StoreTerm(BHEAD t);
×
3092
                                t += *t;
×
3093
                        }
3094
                        t = argin2+ARGHEAD;
×
3095
                        if ( EndSort(BHEAD t,0) < 0 ) goto Irreg;
×
3096
                        while ( *t ) t += *t;
×
3097
                        *argin2 = t - argin2;
×
3098
                        r3 = t;
×
3099
/*
3100
                        And now the factors that go to argout.
3101
                        First we have to move r7 out of the way.
3102
*/
3103
                        r8 = r7+pow; i = r7[1];
×
3104
                        while ( --i >= 0 ) r8[i] = r7[i];
×
3105
                        r2 += pow;
×
3106
                        r8 += 2;
×
3107
                        while ( r8 < r2 ) {
×
3108
                                if ( r8[1] >= 0 ) {
×
3109
                                        for ( i = 0; i < r8[1]; i++ ) { *r1++ = -SYMBOL; *r1++ = *r8; }
×
3110
                                }
3111
                                else {
3112
                                        for ( i = 0; i < -r8[1]; i++ ) {
×
3113
                                                *r1++ = ARGHEAD+8; *r1++ = 0;
×
3114
                                                FILLARG(r1);
×
3115
                                                *r1++ = 8; *r1++ = SYMBOL; *r1++ = 4; *r1++ = *r8;
×
3116
                                                *r1++ = -1; *r1++ = 1; *r1++ = 1; *r1++ = 3;
×
3117
                                        }
3118
                                }
3119
                                r8 += 2;
×
3120
                        }
3121
                        argout = r1;
5,079✔
3122
                }
3123
        }
3124
/*
3125
                        #] SYMBOL : 
3126
                        #[ DOTPRODUCT :
3127

3128
                Now collect all dotproducts. We can use the space after r1 as storage
3129
*/
3130
          t = argin2+ARGHEAD;
5,079✔
3131
          rnext = t + *t;
5,079✔
3132
          r2 = r1;
5,079✔
3133
          while ( t < r3 ) {
27,920✔
3134
                GETSTOP(t,r6);
22,841✔
3135
                t++;
22,841✔
3136
                act = 0;
22,841✔
3137
                while ( t < r6 ) {
45,382✔
3138
                        if ( *t == DOTPRODUCT ) {
22,541✔
3139
                                act = 1;
×
3140
                                i = t[1];
×
3141
                                NCOPY(r2,t,i)
×
3142
                        }
3143
                        else { t += t[1]; }
22,541✔
3144
                }
3145
                if ( act == 0 ) {
22,841✔
3146
                        *r2++ = DOTPRODUCT; *r2++ = 2;
22,841✔
3147
                }
3148
                t = rnext; rnext = rnext + *rnext;
22,841✔
3149
          }
3150
          *r2 = 0;
5,079✔
3151
          argin3 = argin2;
5,079✔
3152
/*
3153
                Now we have a list of all dotproducts as a sequence of DOTPRODUCT
3154
                subterms. Any dotproduct that is absent in a subterm has power zero.
3155
                We now need a list of all minimum powers.
3156
                This can be done by subsequent merges.
3157
*/
3158
          r7 = r1;          /* The first object into which we merge. */        
5,079✔
3159
          r8 = r7 + r7[1];  /* The object that gets merged into r7.  */
5,079✔
3160
          while ( *r8 ) {
22,841✔
3161
                r2 = r8 + r8[1]; /* Next object */
17,762✔
3162
                ArgDotproductMerge(r7,r8);
17,762✔
3163
                r8 = r2;
17,762✔
3164
          }
3165
/*
3166
                Now we have to divide by the object in r7 and take it apart as factors.
3167
                The division can be simple if there are no negative powers.
3168
*/
3169
          if ( r7[1] > 2 ) {
5,079✔
3170
                r8 = r7+2;
×
3171
                r2 = r7 + r7[1];
×
3172
                act = 0;
×
3173
                pow = 0;
×
3174
                while ( r8 < r2 ) {
×
3175
                        if ( r8[2] < 0 ) { pow += -r8[2]*(ARGHEAD+9); }
×
3176
                        else             { pow +=  r8[2]*(ARGHEAD+9); }
×
3177
                        r8 += 3;
×
3178
                }
3179
/*
3180
                The amount of space we need to move r7 is given in pow
3181
                For dotproducts we always need a new location
3182
*/
3183
                {
3184
                        argin3 = TermMalloc("TakeArgContent3");
×
3185
/*
3186
                        We have to multiply the inverse of r7 into argin
3187
                        The answer should go to argin2.
3188
*/
3189
                        r5 = argin3; *r5++ = 0; *r5++ = 0; FILLARG(r5);
×
3190
                        t = argin2+ARGHEAD;
×
3191
                        while ( t < r3 ) {
×
3192
                                rnext = t + *t;
×
3193
                                GETSTOP(t,r6);
×
3194
                                r9 = r5;
×
3195
                                *r5++ = *t++ + r7[1];
×
3196
                                while ( t < r6 ) *r5++ = *t++;
×
3197
                                i = r7[1] - 2; r8 = r7+2;
×
3198
                                *r5++ = r7[0]; *r5++ = r7[1];
×
3199
                                while ( i > 0 ) { *r5++ = *r8++; *r5++ = *r8++; *r5++ = -*r8++; i -= 3; }
×
3200
                                while ( t < rnext ) *r5++ = *t++;
×
3201
                                Normalize(BHEAD r9);
×
3202
                                r5 = r9 + *r9;
×
3203
                        }
3204
                        *r5 = 0;
×
3205
                        *argin3 = r5-argin3;
×
3206
/*
3207
                        We may have to sort the terms in argin3.
3208
*/
3209
                        NewSort(BHEAD0);
×
3210
                        t = argin3+ARGHEAD;
×
3211
                        while ( *t ) {
×
3212
                                StoreTerm(BHEAD t);
×
3213
                                t += *t;
×
3214
                        }
3215
                        t = argin3+ARGHEAD;
×
3216
                        if ( EndSort(BHEAD t,0) < 0 ) goto Irreg;
×
3217
                        while ( *t ) t += *t;
×
3218
                        *argin3 = t - argin3;
×
3219
                        r3 = t;
×
3220
/*
3221
                        And now the factors that go to argout.
3222
                        First we have to move r7 out of the way.
3223
*/
3224
                        r8 = r7+pow; i = r7[1];
×
3225
                        while ( --i >= 0 ) r8[i] = r7[i];
×
3226
                        r2 += pow;
×
3227
                        r8 += 2;
×
3228
                        while ( r8 < r2 ) {
×
3229
                                for ( i = ABS(r8[2]); i > 0; i-- ) {
×
3230
                                        *r1++ = ARGHEAD+9; *r1++ = 0; FILLARG(r1);
×
3231
                                        *r1++ = 9; *r1++ = DOTPRODUCT; *r1++ = 5; *r1++ = *r8;
×
3232
                                        *r1++ = r8[1]; *r1++ = r8[2] < 0 ? -1: 1;
×
3233
                                        *r1++ = 1; *r1++ = 1; *r1++ = 3;
×
3234
                                }
3235
                                r8 += 3;
×
3236
                        }
3237
                        argout = r1;
5,079✔
3238
                }
3239
          }
3240
/*
3241
                        #] DOTPRODUCT : 
3242

3243
        We have now in argin3 the argument stripped of negative powers and
3244
        common factors. The only thing left to deal with is to make the
3245
        coefficients integer. For that we have to find the LCM of the denominators
3246
        and the GCD of the numerators. And to start with, the sign.
3247
        We force the sign of the first term to be positive.
3248
*/
3249
        t = argin3 + ARGHEAD; pow = 1;
5,079✔
3250
        t += *t;
5,079✔
3251
        if ( t[-1] < 0 ) {
5,079✔
3252
                pow = 0;
11✔
3253
                t[-1] = -t[-1];
11✔
3254
                while ( t < r3 ) {
781✔
3255
                        t += *t; t[-1] = -t[-1];
770✔
3256
                }
3257
        }
3258
/*
3259
        Now the GCD of the numerators and the LCM of the denominators:
3260
*/
3261
        argfree = TermMalloc("TakeArgContent1");
5,079✔
3262
        if ( AN.cmod != 0 ) {
5,079✔
3263
                r1 = MakeMod(BHEAD argin3,r1,argfree);
×
3264
        }
3265
        else {
3266
                r1 = MakeInteger(BHEAD argin3,r1,argfree);
5,079✔
3267
        }
3268
        if ( pow == 0 ) {
5,079✔
3269
                *r1++ = -SNUMBER;
11✔
3270
                *r1++ = -1;
11✔
3271
        }
3272
        *r1 = 0;
5,079✔
3273
/*
3274
        Cleanup
3275
*/
3276
        if ( argin3 != argin2 ) TermFree(argin3,"TakeArgContent3");
5,079✔
3277
        if ( argin2 != argin  ) TermFree(argin2,"TakeArgContent2");
5,079✔
3278
        return(argfree);
3279
Irreg:
×
3280
        MesPrint("Irregularity while sorting argument in TakeArgContent");
×
3281
        if ( argin3 != argin2 ) TermFree(argin3,"TakeArgContent3");
×
3282
        if ( argin2 != argin  ) TermFree(argin2,"TakeArgContent2");
×
NEW
3283
        TERMINATE(-1);
×
3284
        return(0);
×
3285
}
3286

3287
/*
3288
          #] TakeArgContent : 
3289
          #[ MakeInteger :
3290
*/
3291
/**
3292
 *        For normalizing everything to integers we have to
3293
 *        determine for all elements of this argument the LCM of
3294
 *        the denominators and the GCD of the numerators.
3295
 *        The input argument is in argin.
3296
 *        The number that comes out should go to argout.
3297
 *        The new pointer in the argout buffer is the return value.
3298
 *        The normalized argument is in argfree.
3299
 */
3300

3301
WORD *MakeInteger(PHEAD WORD *argin,WORD *argout,WORD *argfree)
5,079✔
3302
{
3303
        UWORD *GCDbuffer, *GCDbuffer2, *LCMbuffer, *LCMb, *LCMc;
5,079✔
3304
        WORD *r, *r1, *r2, *r3, *r4, *r5, *rnext, i, k, j;
5,079✔
3305
        WORD kGCD, kLCM, kGCD2, kkLCM, jLCM, jGCD;
5,079✔
3306
        GCDbuffer = NumberMalloc("MakeInteger");
5,079✔
3307
        GCDbuffer2 = NumberMalloc("MakeInteger");
5,079✔
3308
        LCMbuffer = NumberMalloc("MakeInteger");
5,079✔
3309
        LCMb = NumberMalloc("MakeInteger");
5,079✔
3310
        LCMc = NumberMalloc("MakeInteger");
5,079✔
3311
        r4 = argin + *argin;
5,079✔
3312
        r = argin + ARGHEAD;
5,079✔
3313
/*
3314
        First take the first term to load up the LCM and the GCD
3315
*/
3316
        r2 = r + *r;
5,079✔
3317
        j = r2[-1];
5,079✔
3318
        r3 = r2 - ABS(j);
5,079✔
3319
        k = REDLENG(j);
5,079✔
3320
        if ( k < 0 ) k = -k;
5,079✔
3321
        while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
5,079✔
3322
        for ( kGCD = 0; kGCD < k; kGCD++ ) GCDbuffer[kGCD] = r3[kGCD];
10,161✔
3323
        k = REDLENG(j);
5,079✔
3324
        if ( k < 0 ) k = -k;
5,079✔
3325
        r3 += k;
5,079✔
3326
        while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
5,082✔
3327
        for ( kLCM = 0; kLCM < k; kLCM++ ) LCMbuffer[kLCM] = r3[kLCM];
10,158✔
3328
        r1 = r2;
3329
/*
3330
        Now go through the rest of the terms in this argument.
3331
*/
3332
        while ( r1 < r4 ) {
22,841✔
3333
                r2 = r1 + *r1;
17,762✔
3334
                j = r2[-1];
17,762✔
3335
                r3 = r2 - ABS(j);
17,762✔
3336
                k = REDLENG(j);
17,762✔
3337
                if ( k < 0 ) k = -k;
17,762✔
3338
                while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
17,762✔
3339
                if ( ( ( GCDbuffer[0] == 1 ) && ( kGCD == 1 ) ) ) {
17,762✔
3340
/*
3341
                        GCD is already 1
3342
*/
3343
                }
3344
                else if ( ( ( k != 1 ) || ( r3[0] != 1 ) ) ) {
834✔
3345
                        if ( GcdLong(BHEAD GCDbuffer,kGCD,(UWORD *)r3,k,GCDbuffer2,&kGCD2) ) {
770✔
3346
                                NumberFree(GCDbuffer,"MakeInteger");
×
3347
                                NumberFree(GCDbuffer2,"MakeInteger");
×
3348
                                NumberFree(LCMbuffer,"MakeInteger");
×
3349
                                NumberFree(LCMb,"MakeInteger"); NumberFree(LCMc,"MakeInteger");
×
3350
                                goto MakeIntegerErr;
×
3351
                        }
3352
                        kGCD = kGCD2;
770✔
3353
                        for ( i = 0; i < kGCD; i++ ) GCDbuffer[i] = GCDbuffer2[i];
2,302✔
3354
                }
3355
                else {
3356
                        kGCD = 1; GCDbuffer[0] = 1;
64✔
3357
                }
3358
                k = REDLENG(j);
17,762✔
3359
                if ( k < 0 ) k = -k;
17,762✔
3360
                r3 += k;
17,762✔
3361
                while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
18,524✔
3362
                if ( ( ( LCMbuffer[0] == 1 ) && ( kLCM == 1 ) ) ) {
17,762✔
3363
                        for ( kLCM = 0; kLCM < k; kLCM++ )
35,524✔
3364
                                LCMbuffer[kLCM] = r3[kLCM];
17,762✔
3365
                }
3366
                else if ( ( k != 1 ) || ( r3[0] != 1 ) ) {
×
3367
                        if ( GcdLong(BHEAD LCMbuffer,kLCM,(UWORD *)r3,k,LCMb,&kkLCM) ) {
×
3368
                                NumberFree(GCDbuffer,"MakeInteger"); NumberFree(GCDbuffer2,"MakeInteger");
×
3369
                                NumberFree(LCMbuffer,"MakeInteger"); NumberFree(LCMb,"MakeInteger"); NumberFree(LCMc,"MakeInteger");
×
3370
                                goto MakeIntegerErr;
×
3371
                        }
3372
                        DivLong((UWORD *)r3,k,LCMb,kkLCM,LCMb,&kkLCM,LCMc,&jLCM);
×
3373
                        MulLong(LCMbuffer,kLCM,LCMb,kkLCM,LCMc,&jLCM);
×
3374
                        for ( kLCM = 0; kLCM < jLCM; kLCM++ )
×
3375
                                LCMbuffer[kLCM] = LCMc[kLCM];
×
3376
                }
3377
                else {} /* LCM doesn't change */
3378
                r1 = r2;
3379
        }
3380
/*
3381
        Now put the factor together: GCD/LCM
3382
*/
3383
        r3 = (WORD *)(GCDbuffer);
5,079✔
3384
        if ( kGCD == kLCM ) {
5,079✔
3385
                for ( jGCD = 0; jGCD < kGCD; jGCD++ )
10,152✔
3386
                        r3[jGCD+kGCD] = LCMbuffer[jGCD];
5,076✔
3387
                k = kGCD;
3388
        }
3389
        else if ( kGCD > kLCM ) {
3✔
3390
                for ( jGCD = 0; jGCD < kLCM; jGCD++ )
6✔
3391
                        r3[jGCD+kGCD] = LCMbuffer[jGCD];
3✔
3392
                for ( jGCD = kLCM; jGCD < kGCD; jGCD++ )
6✔
3393
                        r3[jGCD+kGCD] = 0;
3✔
3394
                k = kGCD;
3395
        }
3396
        else {
3397
                for ( jGCD = kGCD; jGCD < kLCM; jGCD++ )
×
3398
                        r3[jGCD] = 0;
×
3399
                for ( jGCD = 0; jGCD < kLCM; jGCD++ )
×
3400
                        r3[jGCD+kLCM] = LCMbuffer[jGCD];
×
3401
                k = kLCM;
3402
        }
3403
        j = 2*k+1;
5,079✔
3404
/*
3405
        Now we have to write this to argout
3406
*/
3407
        if ( ( j == 3 ) && ( r3[1] == 1 ) && ( (WORD)(r3[0]) > 0 ) ) {
5,079✔
3408
                *argout = -SNUMBER;
5,076✔
3409
                argout[1] = r3[0];
5,076✔
3410
                r1 = argout+2;
5,076✔
3411
        }
3412
        else {
3413
                r1 = argout;
3✔
3414
                *r1++ = j+1+ARGHEAD; *r1++ = 0; FILLARG(r1);
3✔
3415
                *r1++ = j+1; r2 = r3;
3✔
3416
                for ( i = 0; i < k; i++ ) { *r1++ = *r2++; *r1++ = *r2++; }
9✔
3417
                *r1++ = j;
3✔
3418
        }
3419
/*
3420
        Next we have to take the factor out from the argument.
3421
        This cannot be done in location, because the denominator stuff can make
3422
        coefficients longer.
3423
*/
3424
        r2 = argfree + 2; FILLARG(r2)
5,079✔
3425
        while ( r < r4 ) {
27,920✔
3426
                rnext = r + *r;
22,841✔
3427
                j = ABS(rnext[-1]);
22,841✔
3428
                r5 = rnext - j;
22,841✔
3429
                r3 = r2;
22,841✔
3430
                while ( r < r5 ) *r2++ = *r++;
178,220✔
3431
                j = (j-1)/2;        /* reduced length. Remember, k is the other red length */
22,841✔
3432
                if ( DivRat(BHEAD (UWORD *)r5,j,GCDbuffer,k,(UWORD *)r2,&i) ) {
22,841✔
3433
                        goto MakeIntegerErr;
×
3434
                }
3435
                i = 2*i+1;
22,841✔
3436
                r2 = r2 + i;
22,841✔
3437
                if ( rnext[-1] < 0 ) r2[-1] = -i;
22,841✔
3438
                else                 r2[-1] =  i;
22,475✔
3439
                *r3 = r2-r3;
22,841✔
3440
                r = rnext;
22,841✔
3441
        }
3442
        *r2 = 0;
5,079✔
3443
        argfree[0] = r2-argfree;
5,079✔
3444
        argfree[1] = 0;
5,079✔
3445
/*
3446
        Cleanup
3447
*/
3448
        NumberFree(LCMc,"MakeInteger");
5,079✔
3449
        NumberFree(LCMb,"MakeInteger");
5,079✔
3450
        NumberFree(LCMbuffer,"MakeInteger");
5,079✔
3451
        NumberFree(GCDbuffer2,"MakeInteger");
5,079✔
3452
        NumberFree(GCDbuffer,"MakeInteger");
5,079✔
3453
        return(r1);
5,079✔
3454

3455
MakeIntegerErr:
×
3456
        MesCall("MakeInteger");
×
NEW
3457
        TERMINATE(-1);
×
3458
        return(0);
×
3459
}
3460

3461
/*
3462
          #] MakeInteger : 
3463
          #[ MakeMod :
3464
*/
3465
/**
3466
 *        Similar to MakeInteger but now with modulus arithmetic using only
3467
 *        a one WORD 'prime'. We make the coefficient of the first term in the
3468
 *        argument equal to one.
3469
 *        Already the coefficients are taken modulus AN.cmod and AN.ncmod == 1
3470
 */
3471

3472
WORD *MakeMod(PHEAD WORD *argin,WORD *argout,WORD *argfree)
×
3473
{
3474
        WORD *r, *instop, *r1, *m, x, xx, ix, ip;
×
3475
        int i;
×
3476
        r = argin; instop = r + *r; r += ARGHEAD;
×
3477
        x = r[*r-3];
×
3478
        if ( r[*r-1] < 0 ) x += AN.cmod[0];
×
3479
        if ( GetModInverses(x,(WORD)(AN.cmod[0]),&ix,&ip) ) {
×
NEW
3480
                TERMINATE(-1);
×
3481
        }
3482
        argout[0] = -SNUMBER;
×
3483
        argout[1] = x;
×
3484
        argout[2] = 0;
×
3485
        r1 = argout+2;
×
3486
/*
3487
        Now we have to multiply all coefficients by ix.
3488
        This does not make things longer, but we should keep to the conventions
3489
        of MakeInteger.
3490
*/
3491
        m = argfree + ARGHEAD;
×
3492
        while ( r < instop ) {
×
3493
                xx = r[*r-3]; if ( r[*r-1] < 0 ) xx += AN.cmod[0];
×
3494
                xx = (WORD)((((LONG)xx)*ix) % AN.cmod[0]);
×
3495
                if ( xx != 0 ) {
×
3496
                        i = *r; NCOPY(m,r,i);
×
3497
                        m[-3] = xx; m[-1] = 3;
×
3498
                }
3499
                else { r += *r; }
×
3500
        }
3501
        *m = 0;
×
3502
        *argfree = m - argfree;
×
3503
        argfree[1] = 0;
×
3504
        argfree += 2; FILLARG(argfree);
×
3505
        return(r1);
×
3506
}
3507

3508
/*
3509
          #] MakeMod : 
3510
          #[ SortWeights :
3511
*/
3512
/**
3513
 *        Sorts an array of LONGS in the same way SplitMerge (in sort.c) works
3514
 *        We use gradual division in two.
3515
 */
3516

3517
void SortWeights(LONG *weights,LONG *extraspace,WORD number)
×
3518
{
3519
        LONG w, *fill, *from1, *from2;
×
3520
        int n1,n2,i;
×
3521
        if ( number >= 4 ) {
×
3522
                n1 = number/2; n2 = number - n1;
×
3523
                SortWeights(weights,extraspace,n1);
×
3524
                SortWeights(weights+n1,extraspace,n2);
×
3525
/*
3526
                We copy the first patch to the extra space. Then we merge
3527
                Note that a potential remaining n2 objects are already in place.
3528
*/
3529
                for ( i = 0; i < n1; i++ ) extraspace[i] = weights[i];
×
3530
                fill = weights; from1 = extraspace; from2 = weights+n1;
3531
                while ( n1 > 0 && n2 > 0 ) {
×
3532
                        if ( *from1 <= *from2 ) { *fill++ = *from1++; n1--; }
×
3533
                        else                    { *fill++ = *from2++; n2--; }
×
3534
                }
3535
                while ( n1 > 0 ) { *fill++ = *from1++; n1--; }
×
3536
        }
3537
/*
3538
        Special cases
3539
*/
3540
        else if ( number == 3 ) { /* 6 permutations of which one is trivial */
×
3541
                if ( weights[0] > weights[1] ) {
×
3542
                        if ( weights[1] > weights[2] ) {
×
3543
                                w = weights[0]; weights[0] = weights[2]; weights[2] = w;
×
3544
                        }
3545
                        else if ( weights[0] > weights[2] ) {
×
3546
                                w = weights[0]; weights[0] = weights[1];
×
3547
                                weights[1] = weights[2]; weights[2] = w;
×
3548
                        }
3549
                        else {
3550
                                w = weights[0]; weights[0] = weights[1]; weights[1] = w;
×
3551
                        }
3552
                }
3553
                else if ( weights[0] > weights[2] ) {
×
3554
                        w = weights[0]; weights[0] = weights[2];
×
3555
                        weights[2] = weights[1]; weights[1] = w;
×
3556
                }
3557
                else if ( weights[1] > weights[2] ) {
×
3558
                        w = weights[1]; weights[1] = weights[2]; weights[2] = w;
×
3559
                }
3560
        }
3561
        else if ( number == 2 ) {
×
3562
                if ( weights[0] > weights[1] ) {
×
3563
                        w = weights[0]; weights[0] = weights[1]; weights[1] = w;
×
3564
                }
3565
        }
3566
        return;
×
3567
}
3568

3569
/*
3570
          #] SortWeights : 
3571
*/
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