FORM 4.3
proces.c
Go to the documentation of this file.
1
6/* #[ License : */
7/*
8 * Copyright (C) 1984-2022 J.A.M. Vermaseren
9 * When using this file you are requested to refer to the publication
10 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
11 * This is considered a matter of courtesy as the development was paid
12 * for by FOM the Dutch physics granting agency and we would like to
13 * be able to track its scientific use to convince FOM of its value
14 * for the community.
15 *
16 * This file is part of FORM.
17 *
18 * FORM is free software: you can redistribute it and/or modify it under the
19 * terms of the GNU General Public License as published by the Free Software
20 * Foundation, either version 3 of the License, or (at your option) any later
21 * version.
22 *
23 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
24 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
25 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
26 * details.
27 *
28 * You should have received a copy of the GNU General Public License along
29 * with FORM. If not, see <http://www.gnu.org/licenses/>.
30 */
31/* #] License : */
32/*
33#define HIDEDEBUG
34 #[ Includes : proces.c
35*/
36
37#include "form3.h"
38
39WORD printscratch[2];
40
41/*
42 #] Includes :
43 #[ Processor :
44 #[ Processor : WORD Processor()
45*/
65{
66 GETIDENTITY
67 WORD *term, *t, i, retval = 0, size;
69 POSITION position;
70 WORD last, LastExpression, fromspectator;
71 LONG dd = 0;
72 CBUF *C = cbuf+AC.cbufnum;
73 int firstterm;
74 CBUF *CC = cbuf+AT.ebufnum;
75 WORD **w, *cpo, *cbo;
76 FILEHANDLE *curfile, *oldoutfile = AR.outfile;
77 WORD oldBracketOn = AR.BracketOn;
78 WORD *oldBrackBuf = AT.BrackBuf;
79 WORD oldbracketindexflag = AT.bracketindexflag;
80#ifdef WITHPTHREADS
81 int OldMultiThreaded = AS.MultiThreaded, Oldmparallelflag = AC.mparallelflag;
82#endif
83 if ( CC->numrhs > 0 || CC->numlhs > 0 ) {
84 if ( CC->rhs ) {
85 w = CC->rhs; i = CC->numrhs;
86 do { *w++ = 0; } while ( --i > 0 );
87 }
88 if ( CC->lhs ) {
89 w = CC->lhs; i = CC->numlhs;
90 do { *w++ = 0; } while ( --i > 0 );
91 }
92 CC->numlhs = CC->numrhs = 0;
93 ClearTree(AT.ebufnum);
94 CC->Pointer = CC->Buffer;
95 }
96
97 if ( NumExpressions == 0 ) return(0);
98 AR.expflags = 0;
99 AR.CompressPointer = AR.CompressBuffer;
100 AR.NoCompress = AC.NoCompress;
101 term = AT.WorkPointer;
102 if ( ( (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer) ) > AT.WorkTop ) return(MesWork());
103 UpdatePositions();
104 C->rhs[C->numrhs+1] = C->Pointer;
105 AR.KeptInHold = 0;
106 if ( AC.CollectFun ) AR.DeferFlag = 0;
107 AR.outtohide = 0;
108 AN.PolyFunTodo = 0;
109#ifdef HIDEDEBUG
110 MesPrint("Status at the start of Processor (HideLevel = %d)",AC.HideLevel);
111 for ( i = 0; i < NumExpressions; i++ ) {
112 e = Expressions+i;
113 ExprStatus(e);
114 }
115#endif
116/*
117 Next determine the last expression. This is used for removing the
118 input file when the final stage of the sort of this expression is
119 reached. That can save up to 1/3 in disk space.
120*/
121 for ( i = NumExpressions-1; i >= 0; i-- ) {
122 e = Expressions+i;
123 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
124 || e->status == HIDELEXPRESSION || e->status == HIDEGEXPRESSION
125 || e->status == SKIPLEXPRESSION || e->status == SKIPGEXPRESSION
126 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
127 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
128 ) break;
129 }
130 last = i;
131 for ( i = NumExpressions-1; i >= 0; i-- ) {
132 AS.OldOnFile[i] = Expressions[i].onfile;
133 AS.OldNumFactors[i] = Expressions[i].numfactors;
134/* AS.Oldvflags[i] = e[i].vflags; */
135 AS.Oldvflags[i] = Expressions[i].vflags;
136 Expressions[i].vflags &= ~(ISUNMODIFIED|ISZERO);
137 }
138#ifdef WITHPTHREADS
139/*
140 When we run with threads we have to make sure that all local input
141 buffers are pointed correctly. Of course this isn't needed if we
142 run on a single thread only.
143*/
144 if ( AC.partodoflag && AM.totalnumberofthreads > 1 ) {
145 AS.MultiThreaded = 1; AC.mparallelflag = PARALLELFLAG;
146 }
147 if ( AS.MultiThreaded && AC.mparallelflag == PARALLELFLAG ) {
148 SetWorkerFiles();
149 }
150/*
151 We start with running the expressions with expr->partodo in parallel.
152 The current model is: give each worker an expression. Wait for
153 workers to finish and tell them where to write.
154 Then give them a new expression. Workers may have to wait for each
155 other. This is also the case with the last one.
156*/
157 if ( AS.MultiThreaded && AC.mparallelflag == PARALLELFLAG ) {
158 if ( InParallelProcessor() ) {
159 retval = 1;
160 }
161 AS.MultiThreaded = OldMultiThreaded;
162 AC.mparallelflag = Oldmparallelflag;
163 }
164#endif
165#ifdef WITHMPI
166 if ( AC.RhsExprInModuleFlag && PF.rhsInParallel && (AC.mparallelflag == PARALLELFLAG || AC.partodoflag) ) {
167 if ( PF_BroadcastRHS() ) {
168 retval = -1;
169 }
170 }
171 PF.exprtodo = -1; /* This means, the slave does not perform inparallel */
172 if ( AC.partodoflag > 0 ) {
173 if ( PF_InParallelProcessor() ) {
174 retval = -1;
175 }
176 }
177#endif
178 for ( i = 0; i < NumExpressions; i++ ) {
179#ifdef INNERTEST
180 if ( AC.InnerTest ) {
181 if ( StrCmp(AC.TestValue,(UBYTE *)INNERTEST) == 0 ) {
182 MesPrint("Testing(Processor): value = %s",AC.TestValue);
183 }
184 }
185#endif
186 e = Expressions+i;
187#ifdef WITHPTHREADS
188 if ( AC.partodoflag > 0 && e->partodo > 0 && AM.totalnumberofthreads > 2 ) {
189 e->partodo = 0;
190 continue;
191 }
192#endif
193#ifdef WITHMPI
194 if ( AC.partodoflag > 0 && e->partodo > 0 && PF.numtasks > 2 ) {
195 e->partodo = 0;
196 continue;
197 }
198#endif
199 AS.CollectOverFlag = 0;
200 AR.expchanged = 0;
201 if ( i == last ) LastExpression = 1;
202 else LastExpression = 0;
203 if ( e->inmem ) {
204/*
205 #[ in memory : Memory allocated by poly.c only thusfar.
206 Here GetTerm cannot work.
207 For the moment we ignore this for parallelization.
208*/
209 WORD j;
210
211 AR.GetFile = 0;
212 SetScratch(AR.infile,&(e->onfile));
213 if ( GetTerm(BHEAD term) <= 0 ) {
214 MesPrint("(1) Expression %d has problems in scratchfile",i);
215 retval = -1;
216 break;
217 }
218 term[3] = i;
219 AR.CurExpr = i;
220 SeekScratch(AR.outfile,&position);
221 e->onfile = position;
222 if ( PutOut(BHEAD term,&position,AR.outfile,0) < 0 ) goto ProcErr;
223 AR.DeferFlag = AC.ComDefer;
224 NewSort(BHEAD0);
225 AN.ninterms = 0;
226 t = e->inmem;
227 while ( *t ) {
228 for ( j = 0; j < *t; j++ ) term[j] = t[j];
229 t += *t;
230 AN.ninterms++; dd = AN.deferskipped;
231 if ( AC.CollectFun && *term <= (AM.MaxTer/(2*(LONG)(sizeof(WORD)))) ) {
232 if ( GetMoreFromMem(term,&t) ) {
233 LowerSortLevel(); goto ProcErr;
234 }
235 }
236 AT.WorkPointer = term + *term;
237 AN.RepPoint = AT.RepCount + 1;
238 AN.IndDum = AM.IndDum;
239 AR.CurDum = ReNumber(BHEAD term);
240 if ( AC.SymChangeFlag ) MarkDirty(term,DIRTYSYMFLAG);
241 if ( AN.ncmod ) {
242 if ( ( AC.modmode & ALSOFUNARGS ) != 0 ) MarkDirty(term,DIRTYFLAG);
243 else if ( AR.PolyFun ) PolyFunDirty(BHEAD term);
244 }
245 else if ( AC.PolyRatFunChanged ) PolyFunDirty(BHEAD term);
246 if ( Generator(BHEAD term,0) ) {
247 LowerSortLevel(); goto ProcErr;
248 }
249 AN.ninterms += dd;
250 }
251 AN.ninterms += dd;
252 if ( EndSort(BHEAD AM.S0->sBuffer,0) < 0 ) goto ProcErr;
253 if ( AM.S0->TermsLeft ) e->vflags &= ~ISZERO;
254 else e->vflags |= ISZERO;
255 if ( AR.expchanged == 0 ) e->vflags |= ISUNMODIFIED;
256 if ( AM.S0->TermsLeft ) AR.expflags |= ISZERO;
257 if ( AR.expchanged ) AR.expflags |= ISUNMODIFIED;
258 AR.GetFile = 0;
259/*
260 #] in memory :
261*/
262 }
263 else {
264 AR.CurExpr = i;
265 switch ( e->status ) {
266 case UNHIDELEXPRESSION:
267 case UNHIDEGEXPRESSION:
268 AR.GetFile = 2;
269#ifdef WITHMPI
270 if ( PF.me == MASTER ) SetScratch(AR.hidefile,&(e->onfile));
271#else
272 SetScratch(AR.hidefile,&(e->onfile));
273 AR.InHiBuf = AR.hidefile->POfull-AR.hidefile->POfill;
274#ifdef HIDEDEBUG
275 MesPrint("Hidefile: onfile: %15p, POposition: %15p, filesize: %15p",&(e->onfile)
276 ,&(AR.hidefile->POposition),&(AR.hidefile->filesize));
277 MesPrint("Set hidefile to buffer position %l/%l; AR.InHiBuf = %l"
278 ,(AR.hidefile->POfill-AR.hidefile->PObuffer)*sizeof(WORD)
279 ,(AR.hidefile->POfull-AR.hidefile->PObuffer)*sizeof(WORD)
280 ,AR.InHiBuf
281 );
282#endif
283#endif
284 curfile = AR.hidefile;
285 goto commonread;
286 case INTOHIDELEXPRESSION:
287 case INTOHIDEGEXPRESSION:
288 AR.outtohide = 1;
289/*
290 BugFix 12-feb-2016
291 This may not work when the file is open and we move around.
292 AR.hidefile->POfill = AR.hidefile->POfull;
293*/
294 SetEndHScratch(AR.hidefile,&position);
295 /* fall through */
296 case LOCALEXPRESSION:
297 case GLOBALEXPRESSION:
298 AR.GetFile = 0;
299/*[20oct2009 mt]:*/
300#ifdef WITHMPI
301 if( ( PF.me == MASTER ) || (PF.mkSlaveInfile) )
302#endif
303 SetScratch(AR.infile,&(e->onfile));
304/*:[20oct2009 mt]*/
305 curfile = AR.infile;
306commonread:;
307#ifdef WITHMPI
308 if ( PF_Processor(e,i,LastExpression) ) {
309 MesPrint("Error in PF_Processor");
310 goto ProcErr;
311 }
312/*[20oct2009 mt]:*/
313 if ( AC.mparallelflag != PARALLELFLAG ){
314 if(PF.me != MASTER)
315 break;
316#endif
317/*:[20oct2009 mt]*/
318 if ( GetTerm(BHEAD term) <= 0 ) {
319#ifdef HIDEDEBUG
320 MesPrint("Error condition 1a");
321 ExprStatus(e);
322#endif
323 MesPrint("(2) Expression %d has problems in scratchfile(process)",i);
324 retval = -1;
325 break;
326 }
327 term[3] = i;
328 if ( term[5] < 0 ) { /* Fill with spectator */
329 fromspectator = -term[5];
330 PUTZERO(AM.SpectatorFiles[fromspectator-1].readpos);
331 term[5] = AC.cbufnum;
332 }
333 else fromspectator = 0;
334 if ( AR.outtohide ) {
335 SeekScratch(AR.hidefile,&position);
336 e->onfile = position;
337 if ( PutOut(BHEAD term,&position,AR.hidefile,0) < 0 ) goto ProcErr;
338 }
339 else {
340 SeekScratch(AR.outfile,&position);
341 e->onfile = position;
342 if ( PutOut(BHEAD term,&position,AR.outfile,0) < 0 ) goto ProcErr;
343 }
344 AR.DeferFlag = AC.ComDefer;
345 AR.Eside = RHSIDE;
346 if ( ( e->vflags & ISFACTORIZED ) != 0 ) {
347 AR.BracketOn = 1;
348 AT.BrackBuf = AM.BracketFactors;
349 AT.bracketindexflag = 1;
350 }
351 if ( AT.bracketindexflag > 0 ) OpenBracketIndex(i);
352#ifdef WITHPTHREADS
353 if ( AS.MultiThreaded && AC.mparallelflag == PARALLELFLAG ) {
354 if ( ThreadsProcessor(e,LastExpression,fromspectator) ) {
355 MesPrint("Error in ThreadsProcessor");
356 goto ProcErr;
357 }
358 if ( AR.outtohide ) {
359 AR.outfile = oldoutfile;
360 AR.hidefile->POfull = AR.hidefile->POfill;
361 }
362 }
363 else
364#endif
365 {
366 NewSort(BHEAD0);
367 AR.MaxDum = AM.IndDum;
368 AN.ninterms = 0;
369 for(;;) {
370 if ( fromspectator ) size = GetFromSpectator(term,fromspectator-1);
371 else size = GetTerm(BHEAD term);
372 if ( size <= 0 ) break;
373 SeekScratch(curfile,&position);
374 if ( ( e->vflags & ISFACTORIZED ) != 0 && term[1] == HAAKJE ) {
375 StoreTerm(BHEAD term);
376 }
377 else {
378 AN.ninterms++; dd = AN.deferskipped;
379 if ( AC.CollectFun && *term <= (AM.MaxTer/(2*(LONG)(sizeof(WORD)))) ) {
380 if ( GetMoreTerms(term) < 0 ) {
381 LowerSortLevel(); goto ProcErr;
382 }
383 SeekScratch(curfile,&position);
384 }
385 AT.WorkPointer = term + *term;
386 AN.RepPoint = AT.RepCount + 1;
387 if ( AR.DeferFlag ) {
388 AN.IndDum = Expressions[AR.CurExpr].numdummies + AM.IndDum;
389 AR.CurDum = AN.IndDum;
390 }
391 else {
392 AN.IndDum = AM.IndDum;
393 AR.CurDum = ReNumber(BHEAD term);
394 }
395 if ( AC.SymChangeFlag ) MarkDirty(term,DIRTYSYMFLAG);
396 if ( AN.ncmod ) {
397 if ( ( AC.modmode & ALSOFUNARGS ) != 0 ) MarkDirty(term,DIRTYFLAG);
398 else if ( AR.PolyFun ) PolyFunDirty(BHEAD term);
399 }
400 else if ( AC.PolyRatFunChanged ) PolyFunDirty(BHEAD term);
401 if ( ( AR.PolyFunType == 2 ) && ( AC.PolyRatFunChanged == 0 )
402 && ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION ) ) {
403 PolyFunClean(BHEAD term);
404 }
405 if ( Generator(BHEAD term,0) ) {
406 LowerSortLevel(); goto ProcErr;
407 }
408 AN.ninterms += dd;
409 }
410 SetScratch(curfile,&position);
411 if ( AR.GetFile == 2 ) {
412 AR.InHiBuf = (curfile->POfull-curfile->PObuffer)
413 -DIFBASE(position,curfile->POposition)/sizeof(WORD);
414 }
415 else {
416 AR.InInBuf = (curfile->POfull-curfile->PObuffer)
417 -DIFBASE(position,curfile->POposition)/sizeof(WORD);
418 }
419 }
420 AN.ninterms += dd;
421 if ( LastExpression ) {
422 UpdateMaxSize();
423 if ( AR.infile->handle >= 0 ) {
424 CloseFile(AR.infile->handle);
425 AR.infile->handle = -1;
426 remove(AR.infile->name);
427 PUTZERO(AR.infile->POposition);
428 }
429 AR.infile->POfill = AR.infile->POfull = AR.infile->PObuffer;
430 }
431 if ( AR.outtohide ) AR.outfile = AR.hidefile;
432 if ( EndSort(BHEAD AM.S0->sBuffer,0) < 0 ) goto ProcErr;
433 if ( AR.outtohide ) {
434 AR.outfile = oldoutfile;
435 AR.hidefile->POfull = AR.hidefile->POfill;
436 }
437 e->numdummies = AR.MaxDum - AM.IndDum;
438 UpdateMaxSize();
439 }
440 AR.BracketOn = oldBracketOn;
441 AT.BrackBuf = oldBrackBuf;
442 if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
444 }
445 else if ( ( ( e->vflags & TOBEUNFACTORED ) != 0 )
446 && ( ( e->vflags & ISFACTORIZED ) != 0 ) ) {
448 }
449 AT.bracketindexflag = oldbracketindexflag;
450 if ( AM.S0->TermsLeft ) e->vflags &= ~ISZERO;
451 else e->vflags |= ISZERO;
452 if ( AR.expchanged == 0 ) e->vflags |= ISUNMODIFIED;
453 if ( AM.S0->TermsLeft ) AR.expflags |= ISZERO;
454 if ( AR.expchanged ) AR.expflags |= ISUNMODIFIED;
455 AR.GetFile = 0;
456 AR.outtohide = 0;
457/*[20oct2009 mt]:*/
458#ifdef WITHMPI
459 }
460#endif
461#ifdef WITHPTHREADS
462 if ( e->status == INTOHIDELEXPRESSION ||
463 e->status == INTOHIDEGEXPRESSION ) {
464 SetHideFiles();
465 }
466#endif
467 break;
468 case SKIPLEXPRESSION:
469 case SKIPGEXPRESSION:
470/*
471 This can be greatly improved of course by file-to-file copy.
472*/
473#ifdef WITHMPI
474 if ( PF.me != MASTER ) break;
475#endif
476 AR.GetFile = 0;
477 SetScratch(AR.infile,&(e->onfile));
478 if ( GetTerm(BHEAD term) <= 0 ) {
479#ifdef HIDEDEBUG
480 MesPrint("Error condition 1b");
481 ExprStatus(e);
482#endif
483 MesPrint("(3) Expression %d has problems in scratchfile",i);
484 retval = -1;
485 break;
486 }
487 term[3] = i;
488 AR.DeferFlag = 0;
489 SeekScratch(AR.outfile,&position);
490 e->onfile = position;
491 *AM.S0->sBuffer = 0; firstterm = -1;
492 do {
493 WORD *oldipointer = AR.CompressPointer;
494 WORD *comprtop = AR.ComprTop;
495 AR.ComprTop = AM.S0->sTop;
496 AR.CompressPointer = AM.S0->sBuffer;
497 if ( firstterm > 0 ) {
498 if ( PutOut(BHEAD term,&position,AR.outfile,1) < 0 ) goto ProcErr;
499 }
500 else if ( firstterm < 0 ) {
501 if ( PutOut(BHEAD term,&position,AR.outfile,0) < 0 ) goto ProcErr;
502 firstterm++;
503 }
504 else {
505 if ( PutOut(BHEAD term,&position,AR.outfile,-1) < 0 ) goto ProcErr;
506 firstterm++;
507 }
508 AR.CompressPointer = oldipointer;
509 AR.ComprTop = comprtop;
510 } while ( GetTerm(BHEAD term) );
511 if ( FlushOut(&position,AR.outfile,1) ) goto ProcErr;
512 UpdateMaxSize();
513 break;
514 case HIDELEXPRESSION:
515 case HIDEGEXPRESSION:
516#ifdef WITHMPI
517 if ( PF.me != MASTER ) break;
518#endif
519 AR.GetFile = 0;
520 SetScratch(AR.infile,&(e->onfile));
521 if ( GetTerm(BHEAD term) <= 0 ) {
522#ifdef HIDEDEBUG
523 MesPrint("Error condition 1c");
524 ExprStatus(e);
525#endif
526 MesPrint("(4) Expression %d has problems in scratchfile",i);
527 retval = -1;
528 break;
529 }
530 term[3] = i;
531 AR.DeferFlag = 0;
532 SetEndHScratch(AR.hidefile,&position);
533 e->onfile = position;
534#ifdef HIDEDEBUG
535 if ( AR.hidefile->handle >= 0 ) {
536 POSITION possize,pos;
537 PUTZERO(possize);
538 PUTZERO(pos);
539 SeekFile(AR.hidefile->handle,&pos,SEEK_CUR);
540 SeekFile(AR.hidefile->handle,&possize,SEEK_END);
541 SeekFile(AR.hidefile->handle,&pos,SEEK_SET);
542 MesPrint("Processor Hide1: filesize(th) = %12p, filesize(ex) = %12p",&(position),
543 &(possize));
544 MesPrint(" in buffer: %l",(AR.hidefile->POfill-AR.hidefile->PObuffer)*sizeof(WORD));
545 }
546#endif
547 *AM.S0->sBuffer = 0; firstterm = -1;
548 cbo = cpo = AM.S0->sBuffer;
549 do {
550 WORD *oldipointer = AR.CompressPointer;
551 WORD *oldibuffer = AR.CompressBuffer;
552 WORD *comprtop = AR.ComprTop;
553 AR.ComprTop = AM.S0->sTop;
554 AR.CompressPointer = cpo;
555 AR.CompressBuffer = cbo;
556 if ( firstterm > 0 ) {
557 if ( PutOut(BHEAD term,&position,AR.hidefile,1) < 0 ) goto ProcErr;
558 }
559 else if ( firstterm < 0 ) {
560 if ( PutOut(BHEAD term,&position,AR.hidefile,0) < 0 ) goto ProcErr;
561 firstterm++;
562 }
563 else {
564 if ( PutOut(BHEAD term,&position,AR.hidefile,-1) < 0 ) goto ProcErr;
565 firstterm++;
566 }
567 cpo = AR.CompressPointer;
568 cbo = AR.CompressBuffer;
569 AR.CompressPointer = oldipointer;
570 AR.CompressBuffer = oldibuffer;
571 AR.ComprTop = comprtop;
572 } while ( GetTerm(BHEAD term) );
573#ifdef HIDEDEBUG
574 if ( AR.hidefile->handle >= 0 ) {
575 POSITION possize,pos;
576 PUTZERO(possize);
577 PUTZERO(pos);
578 SeekFile(AR.hidefile->handle,&pos,SEEK_CUR);
579 SeekFile(AR.hidefile->handle,&possize,SEEK_END);
580 SeekFile(AR.hidefile->handle,&pos,SEEK_SET);
581 MesPrint("Processor Hide2: filesize(th) = %12p, filesize(ex) = %12p",&(position),
582 &(possize));
583 MesPrint(" in buffer: %l",(AR.hidefile->POfill-AR.hidefile->PObuffer)*sizeof(WORD));
584 }
585#endif
586 if ( FlushOut(&position,AR.hidefile,1) ) goto ProcErr;
587 AR.hidefile->POfull = AR.hidefile->POfill;
588#ifdef HIDEDEBUG
589 if ( AR.hidefile->handle >= 0 ) {
590 POSITION possize,pos;
591 PUTZERO(possize);
592 PUTZERO(pos);
593 SeekFile(AR.hidefile->handle,&pos,SEEK_CUR);
594 SeekFile(AR.hidefile->handle,&possize,SEEK_END);
595 SeekFile(AR.hidefile->handle,&pos,SEEK_SET);
596 MesPrint("Processor Hide3: filesize(th) = %12p, filesize(ex) = %12p",&(position),
597 &(possize));
598 MesPrint(" in buffer: %l",(AR.hidefile->POfill-AR.hidefile->PObuffer)*sizeof(WORD));
599 }
600#endif
601/*
602 Because we direct the e->onfile already to the hide file, we
603 need to change the status of the expression. Otherwise the use
604 of parts (or the whole) of the expression looks in the infile
605 while the position is that of the hide file.
606 We choose to get everything from the hide file. On average that
607 should give least file activity.
608*/
609 if ( e->status == HIDELEXPRESSION ) {
610 e->status = HIDDENLEXPRESSION;
611 AS.OldOnFile[i] = e->onfile;
612 AS.OldNumFactors[i] = Expressions[i].numfactors;
613 }
614 if ( e->status == HIDEGEXPRESSION ) {
615 e->status = HIDDENGEXPRESSION;
616 AS.OldOnFile[i] = e->onfile;
617 AS.OldNumFactors[i] = Expressions[i].numfactors;
618 }
619#ifdef WITHPTHREADS
620 SetHideFiles();
621#endif
622 UpdateMaxSize();
623 break;
624 case DROPPEDEXPRESSION:
625 case DROPLEXPRESSION:
626 case DROPGEXPRESSION:
627 case DROPHLEXPRESSION:
628 case DROPHGEXPRESSION:
629 case STOREDEXPRESSION:
630 case HIDDENLEXPRESSION:
631 case HIDDENGEXPRESSION:
632 case SPECTATOREXPRESSION:
633 default:
634 break;
635 }
636 }
637 AR.KeptInHold = 0;
638 }
639 AR.DeferFlag = 0;
640 AT.WorkPointer = term;
641#ifdef HIDEDEBUG
642 MesPrint("Status at the end of Processor (HideLevel = %d)",AC.HideLevel);
643 for ( i = 0; i < NumExpressions; i++ ) {
644 e = Expressions+i;
645 ExprStatus(e);
646 }
647#endif
648 return(retval);
649ProcErr:
650 AT.WorkPointer = term;
651 if ( AM.tracebackflag ) MesCall("Processor");
652 return(-1);
653}
654/*
655 #] Processor :
656 #[ TestSub : WORD TestSub(term,level)
657*/
681WORD TestSub(PHEAD WORD *term, WORD level)
682{
683 GETBIDENTITY
684 WORD *m, *t, *r, retvalue, funflag, j, oldncmod, nexpr;
685 WORD *stop, *t1, *t2, funnum, wilds, tbufnum, stilldirty = 0;
686 NESTING n;
687 CBUF *C = cbuf+AT.ebufnum;
688 LONG isp, i;
689 TABLES T;
690 COMPARE oldcompareroutine = AR.CompareRoutine;
691 WORD oldsorttype = AR.SortType;
692ReStart:
693 tbufnum = 0; i = 0;
694 AT.TMbuff = AM.rbufnum;
695 funflag = 0;
696 t = term;
697 r = t + *t - 1;
698 m = r - ABS(*r) + 1;
699 t++;
700 if ( t < m ) do {
701 if ( *t == SUBEXPRESSION ) {
702 /*
703 Subexpression encountered
704 There may be more than one.
705 The old strategy was to take the last.
706 A newer strategy was to take the lowest power first.
707 The current strategy is that we compute the number of terms
708 generated by this subexpression and take the minimum of that.
709 */
710
711#ifdef WHICHSUBEXPRESSION
712
713 WORD *tmin = t, AN.nbino;
714/* LONG minval = MAXLONG; */
715 LONG minval = -1;
716 LONG mm, mnum1 = 1;
717 if ( AN.BinoScrat == 0 ) {
718 AN.BinoScrat = (UWORD *)Malloc1((AM.MaxTal+2)*sizeof(UWORD),"GetBinoScrat");
719 }
720#endif
721 if ( t[3] ) {
722 r = t + t[1];
723 while ( AN.subsubveto == 0 &&
724 *r == SUBEXPRESSION && r < m && r[3] ) {
725#ifdef WHICHSUBEXPRESSION
726 mnum1++;
727#endif
728 if ( r[1] == t[1] && r[2] == t[2] && r[4] == t[4] ) {
729 j = t[1] - SUBEXPSIZE;
730 t1 = t + SUBEXPSIZE;
731 t2 = r + SUBEXPSIZE;
732 while ( j > 0 && *t1++ == *t2++ ) j--;
733 if ( j <= 0 ) {
734 t[3] += r[3];
735 if ( t[3] == 0 ) {
736 t1 = r + r[1];
737 t2 = term + *term;
738 *term -= r[1]+t[1];
739 r = t;
740 while ( t1 < t2 ) *r++ = *t1++;
741 goto ReStart;
742 }
743 else {
744 t1 = r + r[1];
745 t2 = term + *term;
746 *term -= r[1];
747 m -= r[1];
748 while ( t1 < t2 ) *r++ = *t1++;
749 r = t;
750 }
751 }
752 }
753#ifdef WHICHSUBEXPRESSION
754
755 else if ( t[2] >= 0 ) {
756/*
757 Compute Binom(numterms+power-1,power-1)
758 We need potentially long arrithmetic.
759 That is why we had to allocate AN.BinoScrat
760*/
761 if ( AN.last1 == t[3] && AN.last2 == cbuf[t[4]].NumTerms[t[2]] + t[3] - 1 ) {
762 if ( AN.last3 > minval ) {
763 minval = AN.last3; tmin = t;
764 }
765 }
766 else {
767 AN.last1 = t[3]; mm = AN.last2 = cbuf[t[4]].NumTerms[t[2]] + t[3] - 1;
768 if ( t[3] == 1 ) {
769 if ( mm > minval ) {
770 minval = mm; tmin = t;
771 }
772 }
773 else if ( t[3] > 0 ) {
774 if ( mm > MAXPOSITIVE ) goto TooMuch;
775 GetBinom(AN.BinoScrat,&AN.nbino,(WORD)mm,t[3]);
776 if ( AN.nbino > 2 ) goto TooMuch;
777 if ( AN.nbino == 2 ) {
778 mm = AN.BinoScrat[1];
779 mm = ( mm << BITSINWORD ) + AN.BinoScrat[0];
780 }
781 else if ( AN.nbino == 1 ) mm = AN.BinoScrat[0];
782 else mm = 0;
783 if ( mm > minval ) {
784 minval = mm; tmin = t;
785 }
786 }
787 AN.last3 = mm;
788 }
789 }
790#endif
791 t = r;
792 r += r[1];
793 }
794#ifdef WHICHSUBEXPRESSION
795 if ( mnum1 > 1 && t[2] >= 0 ) {
796/*
797 To keep the flowcontrol simple we duplicate some code here
798*/
799 if ( AN.last1 == t[3] && AN.last2 == cbuf[t[4]].NumTerms[t[2]] + t[3] - 1 ) {
800 if ( AN.last3 > minval ) {
801 minval = AN.last3; tmin = t;
802 }
803 }
804 else {
805 AN.last1 = t[3]; mm = AN.last2 = cbuf[t[4]].NumTerms[t[2]] + t[3] - 1;
806 if ( t[3] == 1 ) {
807 if ( mm > minval ) {
808 minval = mm; tmin = t;
809 }
810 }
811 else if ( t[3] > 0 ) {
812 if ( mm > MAXPOSITIVE ) {
813/*
814 We will generate more terms than we can count
815*/
816TooMuch:;
817 MLOCK(ErrorMessageLock);
818 MesPrint("Attempt to generate more terms than FORM can count");
819 MUNLOCK(ErrorMessageLock);
820 Terminate(-1);
821 }
822 GetBinom(AN.BinoScrat,&AN.nbino,(WORD)mm,t[3]);
823 if ( AN.nbino > 2 ) goto TooMuch;
824 if ( AN.nbino == 2 ) {
825 mm = AN.BinoScrat[1];
826 mm = ( mm << BITSINWORD ) + AN.BinoScrat[0];
827 }
828 else if ( AN.nbino == 1 ) mm = AN.BinoScrat[0];
829 else mm = 0;
830 if ( mm > minval ) {
831 minval = mm; tmin = t;
832 }
833 }
834 AN.last3 = mm;
835 }
836 }
837 t = tmin;
838#endif
839/* AR.TePos = 0; */
840 AR.TePos = WORDDIF(t,term);
841 AT.TMbuff = t[4];
842 if ( t[4] == AM.dbufnum && (t+t[1]) < m && t[t[1]] == DOLLAREXPR2 ) {
843 if ( t[t[1]+2] < 0 ) AT.TMdolfac = -t[t[1]+2];
844 else { /* resolve the element number */
845 AT.TMdolfac = GetDolNum(BHEAD t+t[1],m)+1;
846 }
847 }
848 else AT.TMdolfac = 0;
849 if ( t[3] < 0 ) {
850 AN.TeInFun = 1;
851 AR.TePos = WORDDIF(t,term);
852 return(t[2]);
853 }
854 else {
855 AN.TeInFun = 0;
856 AN.TeSuOut = t[3];
857 }
858 if ( t[2] < 0 ) {
859 AN.TeSuOut = -t[3];
860 return(-t[2]);
861 }
862 return(t[2]);
863 }
864 }
865 else if ( *t == EXPRESSION ) {
866 WORD *toTMaddr;
867 i = -t[2] - 1;
868 if ( t[3] < 0 ) {
869 AN.TeInFun = 1;
870 AR.TePos = WORDDIF(t,term);
871 return(i);
872 }
873 nexpr = t[3];
874 toTMaddr = m = AT.WorkPointer;
875 AN.Frozen = 0;
876/*
877 We have to be very careful with respect to setting variables
878 like AN.TeInFun, because we may still call Generator and that
879 may change those variables. That is why we set them at the
880 last moment only.
881*/
882 j = t[1];
883 AT.WorkPointer += j;
884 r = t;
885 NCOPY(m,r,j);
886 r = t + t[1];
887 t += SUBEXPSIZE;
888 while ( t < r ) {
889 if ( *t == FROMBRAC ) {
890 WORD *ttstop,*tttstop;
891/*
892 Note: Convention is that wildcards are done
893 after the expression has been picked up. So
894 no wildcard substitutions are needed here.
895*/
896 t += 2;
897 AN.Frozen = m = AT.WorkPointer;
898/*
899 We should check now for subexpressions and if necessary
900 we substitute them. Keep in mind: only one term allowed!
901
902 In retrospect (26-jan-2010): take also functions that
903 have a dirty flag on
904*/
905 j = *t; tttstop = t + j;
906 GETSTOP(t,ttstop);
907 *m++ = j; t++;
908 while ( t < ttstop ) {
909 if ( *t == SUBEXPRESSION ) break;
910 if ( *t >= FUNCTION && ( ( t[2] & DIRTYFLAG ) == DIRTYFLAG ) ) break;
911 j = t[1]; NCOPY(m,t,j);
912 }
913 if ( t < ttstop ) {
914/*
915 We ran into a subexpression or a function with a
916 'dirty' argument. It could also be a $ or
917 just e[(a^2)*b]. In all cases we should evaluate
918*/
919 while ( t < tttstop ) *m++ = *t++;
920 *AT.WorkPointer = m-AT.WorkPointer;
921 m = AT.WorkPointer;
922 AT.WorkPointer = m + *m;
923 NewSort(BHEAD0);
924 if ( Generator(BHEAD m,AR.Cnumlhs) ) {
925 LowerSortLevel(); goto EndTest;
926 }
927 if ( EndSort(BHEAD m,0) < 0 ) goto EndTest;
928 AN.Frozen = m;
929 if ( *m == 0 ) {
930 *m++ = 4; *m++ = 1; *m++ = 1; *m++ = 3;
931 }
932 else if ( m[*m] != 0 ) {
933 MLOCK(ErrorMessageLock);
934 MesPrint("Bracket specification in expression should be one single term");
935 MUNLOCK(ErrorMessageLock);
936 Terminate(-1);
937 }
938 else {
939 m += *m;
940 m -= ABS(m[-1]);
941 *m++ = 1; *m++ = 1; *m++ = 3;
942 *AN.Frozen = m - AN.Frozen;
943 }
944 }
945 else {
946 while ( t < tttstop ) *m++ = *t++;
947 *AT.WorkPointer = m-AT.WorkPointer;
948 m = AT.WorkPointer;
949 AT.WorkPointer = m + *m;
950 if ( Normalize(BHEAD m) ) {
951 MLOCK(ErrorMessageLock);
952 MesPrint("Error while picking up contents of bracket");
953 MUNLOCK(ErrorMessageLock);
954 Terminate(-1);
955 }
956 if ( !*m ) {
957 *m++ = 4; *m++ = 1; *m++ = 1; *m++ = 3;
958 }
959 else m += *m;
960 }
961 AT.WorkPointer = m;
962 break;
963 }
964 t += t[1];
965 }
966 AN.TeInFun = 0;
967 AR.TePos = 0;
968 AN.TeSuOut = nexpr;
969 AT.TMaddr = toTMaddr;
970 return(i);
971 }
972 else if ( *t >= FUNCTION ) {
973 if ( t[0] == EXPONENT ) {
974 if ( t[1] == FUNHEAD+4 && t[FUNHEAD] == -SYMBOL &&
975 t[FUNHEAD+2] == -SNUMBER && t[FUNHEAD+3] < MAXPOWER
976 && t[FUNHEAD+3] > -MAXPOWER ) {
977 t[0] = SYMBOL;
978 t[1] = 4;
979 t[2] = t[FUNHEAD+1];
980 t[3] = t[FUNHEAD+3];
981 r = term + *term;
982 m = t + FUNHEAD+4;
983 t += 4;
984 while ( m < r ) *t++ = *m++;
985 *term = WORDDIF(t,term);
986 goto ReStart;
987 }
988 else if ( t[1] == FUNHEAD+ARGHEAD+11 && t[FUNHEAD] == ARGHEAD+9
989 && t[FUNHEAD+ARGHEAD] == 9 && t[FUNHEAD+ARGHEAD+1] == DOTPRODUCT
990 && t[FUNHEAD+ARGHEAD+8] == 3
991 && t[FUNHEAD+ARGHEAD+7] == 1
992 && t[FUNHEAD+ARGHEAD+6] == 1
993 && t[FUNHEAD+ARGHEAD+5] == 1
994 && t[FUNHEAD+ARGHEAD+9] == -SNUMBER
995 && t[FUNHEAD+ARGHEAD+10] < MAXPOWER
996 && t[FUNHEAD+ARGHEAD+10] > -MAXPOWER ) {
997 t[0] = DOTPRODUCT;
998 t[1] = 5;
999 t[2] = t[FUNHEAD+ARGHEAD+3];
1000 t[3] = t[FUNHEAD+ARGHEAD+4];
1001 t[4] = t[FUNHEAD+ARGHEAD+10];
1002 r = term + *term;
1003 m = t + FUNHEAD+ARGHEAD+11;
1004 t += 5;
1005 while ( m < r ) *t++ = *m++;
1006 *term = WORDDIF(t,term);
1007 goto ReStart;
1008 }
1009 }
1010 funnum = *t;
1011 if ( *t >= FUNCTION + WILDOFFSET ) funnum -= WILDOFFSET;
1012 if ( *t == EXPONENT ) {
1013/*
1014 Test whether the second argument is an integer
1015*/
1016 r = t+FUNHEAD;
1017 NEXTARG(r)
1018 if ( *r == -SNUMBER && r[1] < MAXPOWER && r+2 == t+t[1] &&
1019 t[FUNHEAD] > -FUNCTION && ( t[FUNHEAD] != -SNUMBER
1020 || t[FUNHEAD+1] != 0 ) && t[FUNHEAD] != ARGHEAD ) {
1021 if ( r[1] == 0 ) {
1022 if ( t[FUNHEAD] == -SNUMBER && t[FUNHEAD+1] == 0 ) {
1023 MLOCK(ErrorMessageLock);
1024 MesPrint("Encountered 0^0. Fatal error.");
1025 MUNLOCK(ErrorMessageLock);
1026 SETERROR(-1);
1027 }
1028 *t = DUMMYFUN;
1029/*
1030 Now mark it clean to avoid further interference.
1031 Normalize will remove this object.
1032*/
1033 t[2] = 0;
1034 }
1035 else {
1036 /* Note that the case 0^ is treated in Normalize */
1037
1038 t1 = AddRHS(AT.ebufnum,1);
1039 m = t + FUNHEAD;
1040 if ( *m > 0 ) {
1041 m += ARGHEAD;
1042 i = t[FUNHEAD] - ARGHEAD;
1043 while ( (t1 + i + 10) > C->Top )
1044 t1 = DoubleCbuffer(AT.ebufnum,t1,9);
1045 while ( --i >= 0 ) *t1++ = *m++;
1046 }
1047 else {
1048 if ( (t1 + 20) > C->Top )
1049 t1 = DoubleCbuffer(AT.ebufnum,t1,10);
1050 ToGeneral(m,t1,1);
1051 t1 += *t1;
1052 }
1053 *t1++ = 0;
1054 C->rhs[C->numrhs+1] = t1;
1055 C->Pointer = t1;
1056
1057 /* No provisions yet for commuting objects */
1058
1059 C->CanCommu[C->numrhs] = 1;
1060 *t++ = SUBEXPRESSION;
1061 *t++ = SUBEXPSIZE;
1062 *t++ = C->numrhs;
1063 *t++ = r[1];
1064 *t++ = AT.ebufnum;
1065#if SUBEXPSIZE > 5
1066Important: we may not have enough spots here
1067#endif
1068 FILLSUB(t) /* Important: We have maybe only 5 spots! */
1069 r += 2;
1070 m = term + *term;
1071 do { *t++ = *r++; } while ( r < m );
1072 *term -= WORDDIF(r,t);
1073 goto ReStart;
1074 }
1075 }
1076 }
1077 else if ( *t == SUMF1 || *t == SUMF2 ) {
1078/*
1079 What we are looking for is:
1080 1-st argument: Single symbol or index.
1081 2-nd argument: Number.
1082 3-rd argument: Number.
1083 (4-th argument):Number.
1084 One more argument.
1085 This would activate the summation procedure.
1086 Note that the initiated recursion here can be done
1087 without upsetting the regular procedures.
1088*/
1089 WORD *tstop, lcounter, lcmin, lcmax, lcinc;
1090 tstop = t + t[1];
1091 r = t+FUNHEAD;
1092 if ( r+6 < tstop && r[2] == -SNUMBER && r[4] == -SNUMBER
1093 && ( ( r[0] == -SYMBOL )
1094 || ( r[0] == -INDEX && r[1] >= AM.OffsetIndex
1095 && r[3] >= 0 && r[3] < AM.OffsetIndex
1096 && r[5] >= 0 && r[5] < AM.OffsetIndex ) ) ) {
1097 lcounter = r[0] == -INDEX ? -r[1]: r[1]; /* The loop counter */
1098 lcmin = r[3];
1099 lcmax = r[5];
1100 r += 6;
1101 if ( *r == -SNUMBER && r+2 < tstop ) {
1102 lcinc = r[1];
1103 r += 2;
1104 }
1105 else lcinc = 1;
1106 if ( r < tstop && ( ( *r > 0 && (r+*r) == tstop )
1107 || ( *r <= -FUNCTION && r+1 == tstop )
1108 || ( *r > -FUNCTION && *r < 0 && r+2 == tstop ) ) ) {
1109 m = AddRHS(AT.ebufnum,1);
1110 if ( *r > 0 ) {
1111 i = *r - ARGHEAD;
1112 r += ARGHEAD;
1113 while ( (m + i + 10) > C->Top )
1114 m = DoubleCbuffer(AT.ebufnum,m,11);
1115 while ( --i >= 0 ) *m++ = *r++;
1116 }
1117 else {
1118 while ( (m + 20) > C->Top )
1119 m = DoubleCbuffer(AT.ebufnum,m,12);
1120 ToGeneral(r,m,1);
1121 m += *m;
1122 }
1123 *m++ = 0;
1124 C->rhs[C->numrhs+1] = m;
1125 C->Pointer = m;
1126 m = AT.TMout;
1127 *m++ = 6;
1128 if ( *t == SUMF1 ) *m++ = SUMNUM1;
1129 else *m++ = SUMNUM2;
1130 *m++ = lcounter;
1131 *m++ = lcmin;
1132 *m++ = lcmax;
1133 *m++ = lcinc;
1134 m = t + t[1];
1135 r = C->rhs[C->numrhs];
1136/*
1137 Test now if the argument was already evaluated.
1138 In that case it needs a new subexpression prototype.
1139 In either case we replace the function now by a
1140 subexpression prototype.
1141*/
1142 if ( *r >= (SUBEXPSIZE+4)
1143 && ABS(*(r+*r-1)) < (*r - 1)
1144 && r[1] == SUBEXPRESSION ) {
1145 r++;
1146 i = r[1] - 5;
1147 *t++ = *r++; *t++ = *r++; *t++ = C->numrhs;
1148 r++; *t++ = *r++; *t++ = AT.ebufnum; r++;
1149 while ( --i >= 0 ) *t++ = *r++;
1150 }
1151 else {
1152 *t++ = SUBEXPRESSION;
1153 *t++ = 4+SUBEXPSIZE;
1154 *t++ = C->numrhs;
1155 *t++ = 1;
1156 *t++ = AT.ebufnum;
1157 FILLSUB(t)
1158 if ( lcounter < 0 ) {
1159 *t++ = INDTOIND;
1160 *t++ = 4;
1161 *t++ = -lcounter;
1162 }
1163 else {
1164 *t++ = SYMTONUM;
1165 *t++ = 4;
1166 *t++ = lcounter;
1167 }
1168 *t++ = lcmin;
1169 }
1170 t2 = term + *term;
1171 while ( m < t2 ) *t++ = *m++;
1172 *term = WORDDIF(t,term);
1173 AN.TeInFun = -C->numrhs;
1174 AR.TePos = 0;
1175 AN.TeSuOut = 0;
1176 AT.TMbuff = AT.ebufnum;
1177 return(C->numrhs);
1178 }
1179 }
1180 }
1181 else if ( *t == TOPOLOGIES ) {
1182/*
1183 Syntax:
1184 topologies_(nloops,nlegs,setvertexsizes,setext,setint[,options])
1185*/
1186 t1 = t+FUNHEAD; t2 = t+t[1];
1187 if ( *t1 == -SNUMBER && t1[1] >= 0 &&
1188 t1[2] == -SNUMBER && ( t1[3] >= 0 || t1[3] == -2 ) &&
1189 t1[4] == -SETSET && Sets[t1[5]].type == CNUMBER &&
1190 t1[6] == -SETSET && Sets[t1[7]].type == CVECTOR &&
1191 t1[8] == -SETSET && Sets[t1[9]].type == CVECTOR &&
1192 t1+10 <= t2 ) {
1193 if ( t1+10 == t2 || ( t1+12 <= t2 && ( t1[10] == -SNUMBER ||
1194 ( t1[10] == -SETSET &&
1195 Sets[t1[5]].last-Sets[t1[5]].first ==
1196 Sets[t1[11]].last-Sets[t1[11]].first ) ) ) ) {
1197 AN.TeInFun = -15;
1198 AN.TeSuOut = 0;
1199 AR.TePos = -1;
1200 return(1);
1201 }
1202 }
1203 }
1204 else if ( *t == DIAGRAMS ) {
1205 }
1206 if ( functions[funnum-FUNCTION].spec == 0
1207 || ( t[2] & (DIRTYFLAG|MUSTCLEANPRF) ) != 0 ) { funflag = 1; }
1208 if ( *t <= MAXBUILTINFUNCTION ) {
1209 if ( *t <= DELTAP && *t >= THETA ) { /* Speeds up by 2 or 3 compares */
1210 if ( *t == THETA || *t == THETA2 ) {
1211 WORD *tstop, *tt2, kk;
1212 tstop = t + t[1];
1213 tt2 = t + FUNHEAD;
1214 while ( tt2 < tstop ) {
1215 if ( *tt2 > 0 && tt2[1] != 0 ) goto DoSpec;
1216 NEXTARG(tt2)
1217 }
1218 if ( !AT.RecFlag ) {
1219 if ( ( kk = DoTheta(BHEAD t) ) == 0 ) {
1220 *term = 0;
1221 return(0);
1222 }
1223 else if ( kk > 0 ) {
1224 m = t + t[1];
1225 r = term + *term;
1226 while ( m < r ) *t++ = *m++;
1227 *term = WORDDIF(t,term);
1228 goto ReStart;
1229 }
1230 }
1231 }
1232 else if ( *t == DELTA2 || *t == DELTAP ) {
1233 WORD *tstop, *tt2, kk;
1234 tstop = t + t[1];
1235 tt2 = t + FUNHEAD;
1236 while ( tt2 < tstop ) {
1237 if ( *tt2 > 0 && tt2[1] != 0 ) goto DoSpec;
1238 NEXTARG(tt2)
1239 }
1240 if ( !AT.RecFlag ) {
1241 if ( ( kk = DoDelta(t) ) == 0 ) {
1242 *term = 0;
1243 return(0);
1244 }
1245 else if ( kk > 0 ) {
1246 m = t + t[1];
1247 r = term + *term;
1248 while ( m < r ) *t++ = *m++;
1249 *term = WORDDIF(t,term);
1250 goto ReStart;
1251 }
1252 }
1253 } }
1254 else if ( *t == DISTRIBUTION && t[FUNHEAD] == -SNUMBER
1255 && t[FUNHEAD+1] >= -2 && t[FUNHEAD+1] <= 2
1256 && t[FUNHEAD+2] == -SNUMBER
1257 && t[FUNHEAD+4] <= -FUNCTION
1258 && t[FUNHEAD+5] <= -FUNCTION ) {
1259 WORD *ttt = t+FUNHEAD+6, *tttstop = t+t[1];
1260 while ( ttt < tttstop ) {
1261 if ( *ttt == -DOLLAREXPRESSION ) break;
1262 NEXTARG(ttt);
1263 }
1264 if ( ttt >= tttstop ) {
1265 AN.TeInFun = -1;
1266 AN.TeSuOut = 0;
1267 AR.TePos = -1;
1268 return(1);
1269 }
1270 }
1271 else if ( *t == DELTA3 && ((t[1]-FUNHEAD) & 1 ) == 0 ) {
1272 AN.TeInFun = -2;
1273 AN.TeSuOut = 0;
1274 AR.TePos = -1;
1275 return(1);
1276 }
1277 else if ( ( *t == TABLEFUNCTION ) && ( t[FUNHEAD] <= -FUNCTION )
1278 && ( T = functions[-t[FUNHEAD]-FUNCTION].tabl ) != 0
1279 && ( t[1] >= FUNHEAD+1+2*T->numind )
1280 && ( t[FUNHEAD+1] == -SYMBOL ) ) {
1281/*
1282 The case of table_(tab,sym1,...,symn)
1283*/
1284 for ( isp = 0; isp < T->numind; isp++ ) {
1285 if ( t[FUNHEAD+1+2*isp] != -SYMBOL ) break;
1286 }
1287 if ( isp >= T->numind ) {
1288 AN.TeInFun = -3;
1289 AN.TeSuOut = 0;
1290 AR.TePos = -1;
1291 return(1);
1292 }
1293 }
1294 else if ( *t == TABLEFUNCTION && t[FUNHEAD] <= -FUNCTION
1295 && ( T = functions[-t[FUNHEAD]-FUNCTION].tabl ) != 0
1296 && ( t[1] == FUNHEAD+2 )
1297 && ( t[FUNHEAD+1] <= -FUNCTION ) ) {
1298/*
1299 The case of table_(tab,fun)
1300*/
1301 AN.TeInFun = -3;
1302 AN.TeSuOut = 0;
1303 AR.TePos = -1;
1304 return(1);
1305 }
1306 else if ( *t == FACTORIN ) {
1307 if ( t[1] == FUNHEAD+2 && t[FUNHEAD] == -DOLLAREXPRESSION ) {
1308 AN.TeInFun = -4;
1309 AN.TeSuOut = 0;
1310 AR.TePos = -1;
1311 return(1);
1312 }
1313 else if ( t[1] == FUNHEAD+2 && t[FUNHEAD] == -EXPRESSION ) {
1314 AN.TeInFun = -5;
1315 AN.TeSuOut = 0;
1316 AR.TePos = -1;
1317 return(1);
1318 }
1319 }
1320 else if ( *t == TERMSINBRACKET ) {
1321 if ( t[1] == FUNHEAD || (
1322 t[1] == FUNHEAD+2
1323 && t[FUNHEAD] == -SNUMBER
1324 && t[FUNHEAD+1] == 0
1325 ) ) {
1326 AN.TeInFun = -6;
1327 AN.TeSuOut = 0;
1328 AR.TePos = -1;
1329 return(1);
1330 }
1331/*
1332 The other cases have not yet been implemented
1333 We still have to add the case of short arguments
1334 First the different bracket in same expression
1335
1336 else if ( t[1] > FUNHEAD+ARGHEAD
1337 && t[FUNHEAD] == t[1]-FUNHEAD
1338 && t[FUNHEAD+ARGHEAD] == t[1]-FUNHEAD-ARGHEAD
1339 && t[t[1]-1] == 3
1340 && t[t[1]-2] == 1
1341 && t[t[1]-3] == 1 ) {
1342 AN.TeInFun = -6;
1343 AN.TeSuOut = 0;
1344 AR.TePos = -1;
1345 return(1);
1346 }
1347
1348 Next the bracket in an other expression
1349
1350 else if ( t[1] > FUNHEAD+ARGHEAD+2
1351 && t[FUNHEAD] == -EXPRESSION
1352 && t[FUNHEAD+2] == t[1]-FUNHEAD-2
1353 && t[FUNHEAD+ARGHEAD+2] == t[1]-FUNHEAD-ARGHEAD-2
1354 && t[t[1]-1] == 3
1355 && t[t[1]-2] == 1
1356 && t[t[1]-3] == 1 ) {
1357 AN.TeInFun = -6;
1358 AN.TeSuOut = 0;
1359 AR.TePos = -1;
1360 return(1);
1361 }
1362*/
1363 }
1364 else if ( *t == EXTRASYMFUN ) {
1365 if ( t[1] == FUNHEAD+2 && (
1366 ( t[FUNHEAD] == -SNUMBER && t[FUNHEAD+1] <= cbuf[AM.sbufnum].numrhs
1367 && t[FUNHEAD+1] > 0 ) ||
1368 ( t[FUNHEAD] == -SYMBOL && t[FUNHEAD+1] < MAXVARIABLES
1369 && t[FUNHEAD+1] >= MAXVARIABLES-cbuf[AM.sbufnum].numrhs ) ) ) {
1370 AN.TeInFun = -7;
1371 AN.TeSuOut = 0;
1372 AR.TePos = -1;
1373 return(1);
1374 }
1375 else if ( t[1] == FUNHEAD ) {
1376 AN.TeInFun = -7;
1377 AN.TeSuOut = 0;
1378 AR.TePos = -1;
1379 return(1);
1380 }
1381 }
1382 else if ( *t == DIVFUNCTION || *t == REMFUNCTION
1383 || *t == INVERSEFUNCTION || *t == MULFUNCTION
1384 || *t == GCDFUNCTION ) {
1385 WORD *tf;
1386 int todo = 1, numargs = 0;
1387 tf = t + FUNHEAD;
1388 while ( tf < t + t[1] ) {
1389 DOLLARS d;
1390 if ( *tf == -DOLLAREXPRESSION ) {
1391 d = Dollars + tf[1];
1392 if ( d->type == DOLWILDARGS ) {
1393 WORD *tterm = AT.WorkPointer, *tw;
1394 WORD *ta = term, *tb = tterm, *tc, *td = term + *term;
1395 while ( ta < t ) *tb++ = *ta++;
1396 tc = tb;
1397 while ( ta < tf ) *tb++ = *ta++;
1398 tw = d->where+1;
1399 while ( *tw ) {
1400 if ( *tw < 0 ) {
1401 if ( *tw > -FUNCTION ) *tb++ = *tw++;
1402 *tb++ = *tw++;
1403 }
1404 else {
1405 int ia;
1406 for ( ia = 0; ia < *tw; ia++ ) *tb++ = *tw++;
1407 }
1408 }
1409 NEXTARG(ta)
1410 while ( ta < t+t[1] ) *tb++ = *ta++;
1411 tc[1] = tb-tc;
1412 while ( ta < td ) *tb++ = *ta++;
1413 *tterm = tb - tterm;
1414 {
1415 int ia, na = *tterm;
1416 ta = tterm; tb = term;
1417 for ( ia = 0; ia < na; ia++ ) *tb++ = *ta++;
1418 }
1419 if ( tb > AT.WorkTop ) {
1420 MLOCK(ErrorMessageLock);
1421 MesWork();
1422 goto EndTest2;
1423 }
1424 AT.WorkPointer = tb;
1425 goto ReStart;
1426 }
1427 }
1428 NEXTARG(tf);
1429 }
1430 tf = t + FUNHEAD;
1431 while ( tf < t + t[1] ) {
1432 numargs++;
1433 if ( *tf > 0 && tf[1] != 0 ) todo = 0;
1434 NEXTARG(tf);
1435 }
1436 if ( todo && numargs == 2 ) {
1437 if ( *t == DIVFUNCTION ) AN.TeInFun = -9;
1438 else if ( *t == REMFUNCTION ) AN.TeInFun = -10;
1439 else if ( *t == INVERSEFUNCTION ) AN.TeInFun = -11;
1440 else if ( *t == MULFUNCTION ) AN.TeInFun = -14;
1441 else if ( *t == GCDFUNCTION ) AN.TeInFun = -8;
1442 AN.TeSuOut = 0;
1443 AR.TePos = -1;
1444 return(1);
1445 }
1446 else if ( todo && numargs == 3 ) {
1447 if ( *t == DIVFUNCTION ) AN.TeInFun = -9;
1448 else if ( *t == REMFUNCTION ) AN.TeInFun = -10;
1449 else if ( *t == GCDFUNCTION ) AN.TeInFun = -8;
1450 AN.TeSuOut = 0;
1451 AR.TePos = -1;
1452 return(1);
1453 }
1454 else if ( todo && *t == GCDFUNCTION ) {
1455 AN.TeInFun = -8;
1456 AN.TeSuOut = 0;
1457 AR.TePos = -1;
1458 return(1);
1459 }
1460 }
1461 else if ( *t == PERMUTATIONS && ( ( t[1] >= FUNHEAD+1
1462 && t[FUNHEAD] <= -FUNCTION ) || ( t[1] >= FUNHEAD+3
1463 && t[FUNHEAD] == -SNUMBER && t[FUNHEAD+2] <= -FUNCTION ) ) ) {
1464 AN.TeInFun = -12;
1465 AN.TeSuOut = 0;
1466 AR.TePos = -1;
1467 return(1);
1468 }
1469 else if ( *t == PARTITIONS ) {
1470 if ( TestPartitions(t,&(AT.partitions)) ) {
1471 AT.partitions.where = t-term;
1472 AN.TeInFun = -13;
1473 AN.TeSuOut = 0;
1474 AR.TePos = -1;
1475 return(1);
1476 }
1477 }
1478 }
1479 }
1480 t += t[1];
1481 } while ( t < m );
1482 if ( funflag ) { /* Search in functions */
1483DoSpec:
1484 t = term;
1485 AT.NestPoin->termsize = t;
1486 if ( AT.NestPoin == AT.Nest ) AN.EndNest = t + *t;
1487 t++;
1488 oldncmod = AN.ncmod;
1489 if ( t < m ) do {
1490 if ( *t < FUNCTION ) {
1491 t += t[1]; continue;
1492 }
1493 if ( AN.ncmod && ( ( AC.modmode & ALSOFUNARGS ) == 0 ) ) {
1494 if ( *t != AR.PolyFun ) AN.ncmod = 0;
1495 else AN.ncmod = oldncmod;
1496 }
1497 r = t + t[1];
1498 funnum = *t;
1499 if ( *t >= FUNCTION + WILDOFFSET ) funnum -= WILDOFFSET;
1500 if ( ( *t == NUMFACTORS || *t == FIRSTTERM || *t == CONTENTTERM )
1501 && t[1] == FUNHEAD+2 &&
1502 ( t[FUNHEAD] == -EXPRESSION || t[FUNHEAD] == -DOLLAREXPRESSION ) ) {
1503/*
1504 if ( *t == NUMFACTORS ) {
1505 This we leave for Normalize
1506 }
1507*/
1508 }
1509 else if ( functions[funnum-FUNCTION].spec == 0 ) {
1510 AT.NestPoin->funsize = t + 1;
1511 t1 = t;
1512 t += FUNHEAD;
1513 while ( t < r ) { /* Sum over arguments */
1514 if ( *t > 0 && t[1] ) { /* Argument is dirty */
1515 AT.NestPoin->argsize = t;
1516 AT.NestPoin++;
1517/* stop = t + *t; */
1518 t2 = t;
1519 t += ARGHEAD;
1520 while ( t < AT.NestPoin[-1].argsize+*(AT.NestPoin[-1].argsize) ) {
1521 /* Sum over terms */
1522 AT.RecFlag++;
1523 i = *t;
1524 AN.subsubveto = 1;
1525/*
1526 AN.subsubveto repairs a bug that became apparent
1527 in an example by York Schroeder:
1528 f(k1.k1)*replace_(k1,2*k2)
1529 Is it possible to repair the counting of the various
1530 length indicators? (JV 1-jun-2010)
1531*/
1532 if ( ( retvalue = TestSub(BHEAD t,level) ) != 0 ) {
1533/*
1534 Possible size changes:
1535 Note defs at 471,467,460,400,425,328
1536*/
1537redosize:
1538 if ( i > *t ) {
1539/*
1540 Provisionally we replace this code with the code that also fixes
1541 up the NestPoin stack. That was the cause of other bugs some 60
1542 lines down. Presumably the same could happen here, although nobody
1543 has complained yet. (28-jul-2020)
1544 i -= *t;
1545 *t2 -= i;
1546 t1[1] -= i;
1547 t += *t;
1548 r = t + i;
1549 m = term + *term;
1550 while ( r < m ) *t++ = *r++;
1551 *term -= i;
1552*/
1553 i -= *t;
1554 t += *t;
1555 r = t + i;
1556 m = AN.EndNest;
1557 while ( r < m ) *t++ = *r++;
1558 n = AT.Nest;
1559 while ( n < AT.NestPoin ) {
1560 *(n->argsize) -= i;
1561 *(n->funsize) -= i;
1562 *(n->termsize) -= i;
1563 n++;
1564 }
1565 AN.EndNest -= i;
1566
1567 }
1568 AN.subsubveto = 0;
1569 t1[2] = 1;
1570 if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 )
1571 t1[2] |= MUSTCLEANPRF;
1572 AT.RecFlag--;
1573 AT.NestPoin--;
1574 AN.TeInFun++;
1575 AR.TePos = 0;
1576 AN.ncmod = oldncmod;
1577 return(retvalue);
1578 }
1579 else {
1580 /*
1581 * Somehow the next line fixes Issue #106.
1582 */
1583 i = *t;
1584 Normalize(BHEAD t);
1585/* if ( i > *t ) { retvalue = 1; goto redosize; } */
1586 /*
1587 * Experimentally, the next line fixes Issue #105.
1588 */
1589 if ( *t == 0 ) { retvalue = 1; goto redosize; }
1590 {
1591 WORD *tend = t + *t, *tt = t+1;
1592 stilldirty = 0;
1593 tend -= ABS(tend[-1]);
1594 while ( tt < tend ) {
1595 if ( *tt == SUBEXPRESSION ) {
1596 stilldirty = 1; break;
1597 }
1598 tt += tt[1];
1599 }
1600 }
1601 if ( i > *t ) {
1602/*
1603 We should not forget to correct the Nest
1604 stack. That caused trouble in the past. (28-jul-2020)
1605*/
1606 retvalue = 1;
1607 i -= *t;
1608 t += *t;
1609 r = t + i;
1610 m = AN.EndNest;
1611 while ( r < m ) *t++ = *r++;
1612 t = AT.NestPoin[-1].argsize + ARGHEAD;
1613 n = AT.Nest;
1614 while ( n < AT.NestPoin ) {
1615 *(n->argsize) -= i;
1616 *(n->funsize) -= i;
1617 *(n->termsize) -= i;
1618 n++;
1619 }
1620 AN.EndNest -= i;
1621 }
1622 }
1623 AN.subsubveto = 0;
1624 AT.RecFlag--;
1625 t += *t;
1626 }
1627 AT.NestPoin--;
1628/*
1629 Argument contains no subexpressions.
1630 It should be normalized and sorted.
1631 The main problem is the storage.
1632*/
1633 t = AT.NestPoin->argsize;
1634 j = *t;
1635 t += ARGHEAD;
1636 NewSort(BHEAD0);
1637 if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 ) {
1638 AR.CompareRoutine = &CompareSymbols;
1639 AR.SortType = SORTHIGHFIRST;
1640 }
1641 if ( AT.WorkPointer < term + *term )
1642 AT.WorkPointer = term + *term;
1643
1644 while ( t < AT.NestPoin->argsize+*(AT.NestPoin->argsize) ) {
1645 m = AT.WorkPointer;
1646 r = t + *t;
1647 do { *m++ = *t++; } while ( t < r );
1648 r = AT.WorkPointer;
1649 AT.WorkPointer = r + *r;
1650 if ( Normalize(BHEAD r) ) {
1651 if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 ) {
1652 AR.SortType = oldsorttype;
1653 AR.CompareRoutine = oldcompareroutine;
1654 t1[2] |= MUSTCLEANPRF;
1655 }
1656 LowerSortLevel(); goto EndTest;
1657 }
1658 if ( AN.ncmod != 0 ) {
1659 if ( *r ) {
1660 if ( Modulus(r) ) {
1662 AT.WorkPointer = r;
1663 if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 ) {
1664 AR.SortType = oldsorttype;
1665 AR.CompareRoutine = oldcompareroutine;
1666 t1[2] |= MUSTCLEANPRF;
1667 }
1668 goto EndTest;
1669 }
1670 }
1671 }
1672 if ( AR.PolyFun > 0 ) {
1673 if ( PrepPoly(BHEAD r,1) != 0 ) goto EndTest;
1674 }
1675 if ( *r ) StoreTerm(BHEAD r);
1676 AT.WorkPointer = r;
1677 }
1678/* the next call had parameter 0. That was wrong!!!!!) */
1679 if ( EndSort(BHEAD AT.WorkPointer+ARGHEAD,1) < 0 ) goto EndTest;
1680 m = AT.WorkPointer+ARGHEAD;
1681 if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 ) {
1682 AR.SortType = oldsorttype;
1683 AR.CompareRoutine = oldcompareroutine;
1684 t1[2] |= MUSTCLEANPRF;
1685 }
1686 while ( *m ) m += *m;
1687 i = WORDDIF(m,AT.WorkPointer);
1688 *AT.WorkPointer = i;
1689 AT.WorkPointer[1] = stilldirty;
1690 if ( ToFast(AT.WorkPointer,AT.WorkPointer) ) {
1691 m = AT.WorkPointer;
1692 if ( *m <= -FUNCTION ) { m++; i = 1; }
1693 else { m += 2; i = 2; }
1694 }
1695 j = i - j;
1696 if ( j > 0 ) {
1697 r = m + j;
1698 if ( r > AT.WorkTop ) {
1699 MLOCK(ErrorMessageLock);
1700 MesWork();
1701 goto EndTest2;
1702 }
1703 do { *--r = *--m; } while ( m > AT.WorkPointer );
1704 AT.WorkPointer = r;
1705 m = AN.EndNest;
1706 r = m + j;
1707 stop = AT.NestPoin->argsize+*(AT.NestPoin->argsize);
1708 do { *--r = *--m; } while ( m >= stop );
1709 }
1710 else if ( j < 0 ) {
1711 m = AT.NestPoin->argsize+*(AT.NestPoin->argsize);
1712 r = m + j;
1713 do { *r++ = *m++; } while ( m < AN.EndNest );
1714 }
1715 m = AT.NestPoin->argsize;
1716 r = AT.WorkPointer;
1717 while ( --i >= 0 ) *m++ = *r++;
1718 n = AT.Nest;
1719 while ( n <= AT.NestPoin ) {
1720 if ( *(n->argsize) > 0 && n != AT.NestPoin )
1721 *(n->argsize) += j;
1722 *(n->funsize) += j;
1723 *(n->termsize) += j;
1724 n++;
1725 }
1726 AN.EndNest += j;
1727/* (AT.NestPoin->argsize)[1] = 0; */
1728 if ( funnum == DENOMINATOR || funnum == EXPONENT ) {
1729 if ( Normalize(BHEAD term) ) {
1730/*
1731 In this case something has been substituted
1732 Either a $ or a replace_?????
1733 Originally we had here:
1734
1735 goto EndTest;
1736
1737 It seems better to restart.
1738*/
1739 AN.ncmod = oldncmod;
1740 goto ReStart;
1741 }
1742/*
1743 And size changes here?????
1744*/
1745 }
1746 AN.ncmod = oldncmod;
1747 goto ReStart;
1748 }
1749 else if ( *t == -DOLLAREXPRESSION ) {
1750 if ( ( *t1 == TERMSINEXPR || *t1 == SIZEOFFUNCTION )
1751 && t1[1] == FUNHEAD+2 ) {}
1752 else {
1753 if ( AR.Eside != LHSIDE ) {
1754 AN.TeInFun = 1; AR.TePos = 0;
1755 AT.TMbuff = AM.dbufnum; t1[2] |= DIRTYFLAG;
1756 AN.ncmod = oldncmod;
1757 return(1);
1758 }
1759 AC.lhdollarflag = 1;
1760 }
1761 }
1762 else if ( *t == -TERMSINBRACKET ) {
1763 if ( AR.Eside != LHSIDE ) {
1764 AN.TeInFun = 1; AR.TePos = 0;
1765 t1[2] |= DIRTYFLAG;
1766 AN.ncmod = oldncmod;
1767 return(1);
1768 }
1769 }
1770 else if ( AN.ncmod != 0 && *t == -SNUMBER ) {
1771 if ( AN.ncmod == 1 || AN.ncmod == -1 ) {
1772 isp = (UWORD)(AC.cmod[0]);
1773 isp = t[1] % isp;
1774 if ( ( AC.modmode & POSNEG ) != 0 ) {
1775 if ( isp > (UWORD)(AC.cmod[0])/2 ) isp = isp - (UWORD)(AC.cmod[0]);
1776 else if ( -isp > (UWORD)(AC.cmod[0])/2 ) isp = isp + (UWORD)(AC.cmod[0]);
1777 }
1778 else {
1779 if ( isp < 0 ) isp += (UWORD)(AC.cmod[0]);
1780 }
1781 if ( isp <= MAXPOSITIVE && isp >= -MAXPOSITIVE ) {
1782 t[1] = isp;
1783 }
1784 }
1785 }
1786 NEXTARG(t)
1787 }
1788 if ( funnum >= FUNCTION && functions[funnum-FUNCTION].tabl ) {
1789/*
1790 Test whether the table catches
1791 Test 1: index arguments and range. i will be the number
1792 of the element in the table.
1793*/
1794 WORD rhsnumber, *oldwork = AT.WorkPointer, *Tpattern;
1795 WORD ii, *p;
1796 MINMAX *mm;
1797 T = functions[funnum-FUNCTION].tabl;
1798/*
1799 The next application of T->pattern isn't thread safe.
1800 p = T->pattern + FUNHEAD+1;
1801 The new code is in the next three lines and in the application
1802 ii = T->pattern[1]; p = Tpattern; pp = T->pattern;
1803 for ( i = 0; i < ii; i++ ) *p++ = *pp++;
1804 AT.WorkPointer = p;
1805*/
1806#ifdef WITHPTHREADS
1807 Tpattern = T->pattern[AT.identity];
1808#else
1809 Tpattern = T->pattern;
1810#endif
1811 p = Tpattern + FUNHEAD+1;
1812
1813 mm = T->mm;
1814 if ( T->sparse ) {
1815 t = t1+FUNHEAD;
1816 if ( T->numind == 0 ) { isp = 0; }
1817 else {
1818 for ( i = 0; i < T->numind; i++, t += 2 ) {
1819 if ( *t != -SNUMBER ) break;
1820 }
1821 if ( i < T->numind ) goto teststrict;
1822
1823 isp = FindTableTree(T,t1+FUNHEAD,2);
1824 }
1825 if ( isp < 0 ) {
1826teststrict: if ( T->strict == -2 ) {
1827 rhsnumber = AM.zerorhs;
1828 tbufnum = AM.zbufnum;
1829 }
1830 else if ( T->strict == -3 ) {
1831 rhsnumber = AM.onerhs;
1832 tbufnum = AM.zbufnum;
1833 }
1834 else if ( T->strict < 0 ) goto NextFun;
1835 else {
1836 MLOCK(ErrorMessageLock);
1837 MesPrint("Element in table is undefined");
1838 goto showtable;
1839 }
1840/*
1841 Copy the indices;
1842*/
1843 t = t1+FUNHEAD+1;
1844 for ( i = 0; i < T->numind; i++ ) {
1845 *p = *t; p+=2; t+=2;
1846 }
1847 }
1848 else {
1849 rhsnumber = T->tablepointers[isp+T->numind];
1850#if ( TABLEEXTENSION == 2 )
1851 tbufnum = T->bufnum;
1852#else
1853 tbufnum = T->tablepointers[isp+T->numind+1];
1854#endif
1855 t = t1+FUNHEAD+1;
1856 ii = T->numind;
1857 while ( --ii >= 0 ) {
1858 *p = *t; t += 2; p += 2;
1859 }
1860 }
1861 goto caughttable;
1862 }
1863 else {
1864 i = 0;
1865 t = t1 + FUNHEAD;
1866 j = T->numind;
1867 while ( --j >= 0 ) {
1868 if ( *t != -SNUMBER ) goto NextFun;
1869 t++;
1870 if ( *t < mm->mini || *t > mm->maxi ) {
1871 if ( T->bounds ) {
1872 MLOCK(ErrorMessageLock);
1873 MesPrint("Table boundary check. Argument %d",
1874 T->numind-j);
1875showtable: AO.OutFill = AO.OutputLine = (UBYTE *)m;
1876 AO.OutSkip = 8;
1877 IniLine(0);
1878 WriteSubTerm(t1,1);
1879 FiniLine();
1880 MUNLOCK(ErrorMessageLock);
1881 SETERROR(-1)
1882 }
1883 goto NextFun;
1884 }
1885 i += ( *t - mm->mini ) * (LONG)(mm->size);
1886 *p = *t++;
1887 p += 2;
1888 mm++;
1889 }
1890/*
1891 Test now whether the entry exists.
1892*/
1893 i *= TABLEEXTENSION;
1894 if ( T->tablepointers[i] == -1 ) {
1895 if ( T->strict == -2 ) {
1896 rhsnumber = AM.zerorhs;
1897 tbufnum = AM.zbufnum;
1898 }
1899 else if ( T->strict == -3 ) {
1900 rhsnumber = AM.onerhs;
1901 tbufnum = AM.zbufnum;
1902 }
1903 else if ( T->strict < 0 ) goto NextFun;
1904 else {
1905 MLOCK(ErrorMessageLock);
1906 MesPrint("Element in table is undefined");
1907 goto showtable;
1908 }
1909 }
1910 else {
1911 rhsnumber = T->tablepointers[i];
1912#if ( TABLEEXTENSION == 2 )
1913 tbufnum = T->bufnum;
1914#else
1915 tbufnum = T->tablepointers[i+1];
1916#endif
1917 }
1918 }
1919/*
1920 If there are more arguments we have to do some
1921 pattern matching. This should be easy. We addapted the
1922 pattern, so that the array indices match already.
1923 Note that if there is no match the program will become
1924 very slow.
1925*/
1926caughttable:
1927#ifdef WITHPTHREADS
1928 AN.FullProto = T->prototype[AT.identity];
1929#else
1930 AN.FullProto = T->prototype;
1931#endif
1932 AN.WildValue = AN.FullProto + SUBEXPSIZE;
1933 AN.WildStop = AN.FullProto+AN.FullProto[1];
1934 ClearWild(BHEAD0);
1935 AN.RepFunNum = 0;
1936 AN.RepFunList = AN.EndNest;
1937 AT.WorkPointer = (WORD *)(((UBYTE *)(AN.EndNest)) + AM.MaxTer/2);
1938 if ( AT.WorkPointer >= AT.WorkTop ) {
1939 MLOCK(ErrorMessageLock);
1940 MesWork();
1941 MUNLOCK(ErrorMessageLock);
1942 }
1943 wilds = 0;
1944/* if ( MatchFunction(BHEAD T->pattern,t1,&wilds) > 0 ) { } */
1945 if ( MatchFunction(BHEAD Tpattern,t1,&wilds) > 0 ) {
1946 AT.WorkPointer = oldwork;
1947 if ( AT.NestPoin != AT.Nest ) {
1948 AN.ncmod = oldncmod;
1949 return(1);
1950 }
1951
1952 m = AN.FullProto;
1953 retvalue = m[2] = rhsnumber;
1954 m[4] = tbufnum;
1955 t = t1;
1956 j = t[1];
1957 i = m[1];
1958 if ( j > i ) {
1959 j = i - j;
1960 NCOPY(t,m,i);
1961 m = term + *term;
1962 while ( r < m ) *t++ = *r++;
1963 *term += j;
1964 }
1965 else if ( j < i ) {
1966 j = i-j;
1967 t = term + *term;
1968 while ( t >= r ) { t[j] = *t; t--; }
1969 t = t1;
1970 NCOPY(t,m,i);
1971 *term += j;
1972 }
1973 else {
1974 NCOPY(t,m,j);
1975 }
1976 AN.TeInFun = 0;
1977 AR.TePos = 0;
1978 AN.TeSuOut = -1;
1979 if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
1980 AT.TMbuff = tbufnum;
1981 AN.ncmod = oldncmod;
1982 return(retvalue);
1983 }
1984 AT.WorkPointer = oldwork;
1985 }
1986NextFun:;
1987 }
1988 else if ( ( t[2] & DIRTYFLAG ) != 0 ) {
1989 t += FUNHEAD;
1990 while ( t < r ) {
1991 if ( *t == FUNNYDOLLAR ) {
1992 if ( AR.Eside != LHSIDE ) {
1993 AN.TeInFun = 1;
1994 AR.TePos = 0;
1995 AT.TMbuff = AM.dbufnum;
1996 AN.ncmod = oldncmod;
1997 return(1);
1998 }
1999 AC.lhdollarflag = 1;
2000 }
2001 t++;
2002 }
2003 }
2004 t = r;
2005 AN.ncmod = oldncmod;
2006 } while ( t < m );
2007 }
2008 return(0);
2009EndTest:;
2010 MLOCK(ErrorMessageLock);
2011EndTest2:;
2012 MesCall("TestSub");
2013 MUNLOCK(ErrorMessageLock);
2014 SETERROR(-1)
2015}
2016
2017/*
2018 #] TestSub :
2019 #[ InFunction : WORD InFunction(term,termout)
2020*/
2033WORD InFunction(PHEAD WORD *term, WORD *termout)
2034{
2035 GETBIDENTITY
2036 WORD *m, *t, *r, *rr, sign = 1, oldncmod;
2037 WORD *u, *v, *w, *from, *to,
2038 ipp, olddefer = AR.DeferFlag, oldPolyFun = AR.PolyFun, i, j;
2039 LONG numterms;
2040 from = t = term;
2041 r = t + *t - 1;
2042 m = r - ABS(*r) + 1;
2043 t++;
2044 while ( t < m ) {
2045 if ( *t >= FUNCTION+WILDOFFSET ) ipp = *t - WILDOFFSET;
2046 else ipp = *t;
2047 if ( AR.TePos ) {
2048 if ( ( term + AR.TePos ) == t ) {
2049 m = termout;
2050 while ( from < t ) *m++ = *from++;
2051 *m++ = DENOMINATOR;
2052 *m++ = t[1] + 4 + FUNHEAD + ARGHEAD;
2053 *m++ = DIRTYFLAG;
2054 FILLFUN3(m)
2055 *m++ = t[1] + 4 + ARGHEAD;
2056 *m++ = 1;
2057 FILLARG(m)
2058 *m++ = t[1] + 4;
2059 t[3] = -t[3];
2060 v = t + t[1];
2061 while ( t < v ) *m++ = *t++;
2062 from[3] = -from[3];
2063 *m++ = 1;
2064 *m++ = 1;
2065 *m++ = 3;
2066 r = term + *term;
2067 while ( t < r ) *m++ = *t++;
2068 if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2069 *termout = WORDDIF(m,termout);
2070 return(0);
2071 }
2072 }
2073 else if ( ( *t >= FUNCTION && functions[ipp-FUNCTION].spec == 0 )
2074 && ( t[2] & DIRTYFLAG ) == DIRTYFLAG ) {
2075 m = termout;
2076 r = t + t[1];
2077 u = t;
2078 t += FUNHEAD;
2079 oldncmod = AN.ncmod;
2080 while ( t < r ) { /* t points at an argument */
2081 if ( *t > 0 && t[1] ) { /* Argument has been modified */
2082 WORD oldsorttype = AR.SortType;
2083 /* This whole argument must be redone */
2084
2085 if ( ( AN.ncmod != 0 )
2086 && ( ( AC.modmode & ALSOFUNARGS ) == 0 )
2087 && ( *u != AR.PolyFun ) ) { AN.ncmod = 0; }
2088 AR.DeferFlag = 0;
2089 v = t + *t;
2090 t += ARGHEAD; /* First term */
2091 w = 0; /* to appease the compilers warning devices */
2092 while ( from < t ) {
2093 if ( from == u ) w = m;
2094 *m++ = *from++;
2095 }
2096 to = m;
2097 NewSort(BHEAD0);
2098 if ( *u == AR.PolyFun && AR.PolyFunType == 2 ) {
2099 AR.CompareRoutine = &CompareSymbols;
2100 AR.SortType = SORTHIGHFIRST;
2101 }
2102/*
2103 AR.PolyFun = 0;
2104*/
2105 while ( t < v ) {
2106 i = *t;
2107 NCOPY(m,t,i);
2108 m = to;
2109 if ( AT.WorkPointer < m+*m ) AT.WorkPointer = m + *m;
2110 if ( Generator(BHEAD m,AR.Cnumlhs) ) {
2111 AN.ncmod = oldncmod;
2112 LowerSortLevel(); goto InFunc;
2113 }
2114 }
2115 /* w = the function */
2116 /* v = the next argument */
2117 /* u = the function */
2118 /* to is new argument */
2119
2120 to -= ARGHEAD;
2121 if ( EndSort(BHEAD m,1) < 0 ) {
2122 AN.ncmod = oldncmod;
2123 goto InFunc;
2124 }
2125 AR.PolyFun = oldPolyFun;
2126 if ( *u == AR.PolyFun && AR.PolyFunType == 2 ) {
2127 AR.CompareRoutine = &Compare1;
2128 AR.SortType = oldsorttype;
2129 }
2130 while ( *m ) m += *m;
2131 *to = WORDDIF(m,to);
2132 to[1] = 1; /* ??????? or rather 0?. 24-mar-2006 JV */
2133 if ( ToFast(to,to) ) {
2134 if ( *to <= -FUNCTION ) m = to+1;
2135 else m = to+2;
2136 }
2137 w[1] = WORDDIF(m,w) + WORDDIF(r,v);
2138 r = term + *term;
2139 t = v;
2140 while ( t < r ) *m++ = *t++;
2141 if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2142 *termout = WORDDIF(m,termout);
2143 AR.DeferFlag = olddefer;
2144 AN.ncmod = oldncmod;
2145 return(0);
2146 }
2147 else if ( *t == -DOLLAREXPRESSION ) {
2148 if ( AR.Eside == LHSIDE ) {
2149 NEXTARG(t)
2150 AC.lhdollarflag = 1;
2151 }
2152 else {
2153/*
2154 This whole argument must be redone
2155*/
2156 DOLLARS d = Dollars + t[1];
2157#ifdef WITHPTHREADS
2158 int nummodopt, dtype = -1;
2159 if ( AS.MultiThreaded ) {
2160 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2161 if ( t[1] == ModOptdollars[nummodopt].number ) break;
2162 }
2163 if ( nummodopt < NumModOptdollars ) {
2164 dtype = ModOptdollars[nummodopt].type;
2165 if ( dtype == MODLOCAL ) {
2166 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2167 }
2168 else {
2169 LOCK(d->pthreadslockread);
2170 }
2171 }
2172 }
2173#endif
2174 oldncmod = AN.ncmod;
2175 if ( ( AN.ncmod != 0 )
2176 && ( ( AC.modmode & ALSOFUNARGS ) == 0 )
2177 && ( *u != AR.PolyFun ) ) { AN.ncmod = 0; }
2178 AR.DeferFlag = 0;
2179 v = t + 2;
2180 w = 0; /* to appease the compilers warning devices */
2181 while ( from < t ) {
2182 if ( from == u ) w = m;
2183 *m++ = *from++;
2184 }
2185 to = m;
2186 switch ( d->type ) {
2187 case DOLINDEX:
2188 if ( d->index >= 0 && d->index < AM.OffsetIndex ) {
2189 *m++ = -SNUMBER; *m++ = d->index;
2190 }
2191 else { *m++ = -INDEX; *m++ = d->index; }
2192 break;
2193 case DOLZERO:
2194 *m++ = -SNUMBER; *m++ = 0; break;
2195 case DOLNUMBER:
2196 if ( d->where[0] == 4 &&
2197 ( d->where[1] & MAXPOSITIVE ) == d->where[1] ) {
2198 *m++ = -SNUMBER;
2199 if ( d->where[3] >= 0 ) *m++ = d->where[1];
2200 else *m++ = -d->where[1];
2201 break;
2202 }
2203 /* fall through */
2204 case DOLTERMS:
2205/*
2206 Here we have the special case of the PolyRatFun
2207 That function may have a different sort of the
2208 terms in the argument.
2209*/
2210 to = m; r = d->where;
2211 *m++ = 0; *m++ = 1;
2212 FILLARG(m)
2213 while ( *r ) {
2214 i = *r; NCOPY(m,r,i)
2215 }
2216 *to = m-to;
2217 if ( ToFast(to,to) ) {
2218 if ( *to <= -FUNCTION ) m = to+1;
2219 else m = to+2;
2220 }
2221 else if ( *u == AR.PolyFun && AR.PolyFunType == 2 ) {
2222 AR.PolyFun = 0;
2223 NewSort(BHEAD0);
2224 AR.CompareRoutine = &CompareSymbols;
2225 r = to + ARGHEAD;
2226 while ( r < m ) {
2227 rr = r; r += *r;
2228 if ( SymbolNormalize(rr) ) goto InFunc;
2229 if ( StoreTerm(BHEAD rr) ) {
2230 AR.CompareRoutine = &Compare1;
2232 Terminate(-1);
2233 }
2234 }
2235 if ( EndSort(BHEAD to+ARGHEAD,1) < 0 ) goto InFunc;
2236 AR.PolyFun = oldPolyFun;
2237 AR.CompareRoutine = &Compare1;
2238 m = to+ARGHEAD;
2239 if ( *m == 0 ) {
2240 *to = -SNUMBER;
2241 to[1] = 0;
2242 m = to + 2;
2243 }
2244 else {
2245 while ( *m ) m += *m;
2246 *t = m - to;
2247 if ( ToFast(to,to) ) {
2248 if ( *to <= -FUNCTION ) m = to+1;
2249 else m = to+2;
2250 }
2251 }
2252 }
2253 w[1] = w[1] - 2 + (m-to);
2254 break;
2255 case DOLSUBTERM:
2256 to = m; r = d->where;
2257 i = r[1];
2258 *m++ = i+4+ARGHEAD; *m++ = 1;
2259 FILLARG(m)
2260 *m++ = i+4;
2261 while ( --i >= 0 ) *m++ = *r++;
2262 *m++ = 1; *m++ = 1; *m++ = 3;
2263 if ( ToFast(to,to) ) {
2264 if ( *to <= -FUNCTION ) m = to+1;
2265 else m = to+2;
2266 }
2267 w[1] = w[1] - 2 + (m-to);
2268 break;
2269 case DOLARGUMENT:
2270 to = m; r = d->where;
2271 if ( *r > 0 ) {
2272 i = *r - 2;
2273 *m++ = *r++; *m++ = 1; r++;
2274 while ( --i >= 0 ) *m++ = *r++;
2275 }
2276 else if ( *r <= -FUNCTION ) *m++ = *r++;
2277 else { *m++ = *r++; *m++ = *r++; }
2278 w[1] = w[1] - 2 + (m-to);
2279 break;
2280 case DOLWILDARGS:
2281 to = m; r = d->where;
2282 if ( *r > 0 ) { /* Tensor arguments */
2283 i = *r++;
2284 while ( --i >= 0 ) {
2285 if ( *r < 0 ) {
2286 *m++ = -VECTOR; *m++ = *r++;
2287 }
2288 else if ( *r >= AM.OffsetIndex ) {
2289 *m++ = -INDEX; *m++ = *r++;
2290 }
2291 else { *m++ = -SNUMBER; *m++ = *r++; }
2292 }
2293 }
2294 else { /* Regular arguments */
2295 r++;
2296 while ( *r ) {
2297 if ( *r > 0 ) {
2298 i = *r - 2;
2299 *m++ = *r++; *m++ = 1; r++;
2300 while ( --i >= 0 ) *m++ = *r++;
2301 }
2302 else if ( *r <= -FUNCTION ) *m++ = *r++;
2303 else { *m++ = *r++; *m++ = *r++; }
2304 }
2305 }
2306 w[1] = w[1] - 2 + (m-to);
2307 break;
2308 case DOLUNDEFINED:
2309 default:
2310 MLOCK(ErrorMessageLock);
2311 MesPrint("!!!Undefined $-variable: $%s!!!",
2312 AC.dollarnames->namebuffer+d->name);
2313 MUNLOCK(ErrorMessageLock);
2314#ifdef WITHPTHREADS
2315 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2316#endif
2317 Terminate(-1);
2318 }
2319#ifdef WITHPTHREADS
2320 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2321#endif
2322 r = term + *term;
2323 t = v;
2324 while ( t < r ) *m++ = *t++;
2325 if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2326 *termout = WORDDIF(m,termout);
2327 AR.DeferFlag = olddefer;
2328 AN.ncmod = oldncmod;
2329 return(0);
2330 }
2331 }
2332 else if ( *t == -TERMSINBRACKET ) {
2333 if ( AC.ComDefer ) numterms = CountTerms1(BHEAD0);
2334 else numterms = 1;
2335/*
2336 Compose the output term
2337 First copy the part till this function argument
2338 m points at the output term space
2339 u points at the start of the function
2340 t points at the start of the argument
2341*/
2342 w = 0;
2343 while ( from < t ) {
2344 if ( from == u ) w = m;
2345 *m++ = *from++;
2346 }
2347 if ( ( numterms & MAXPOSITIVE ) == numterms ) {
2348 *m++ = -SNUMBER; *m++ = numterms & MAXPOSITIVE;
2349 w[1] += 1;
2350 }
2351 else if ( ( i = numterms >> BITSINWORD ) == 0 ) {
2352 *m++ = ARGHEAD+4;
2353 for ( j = 1; j < ARGHEAD; j++ ) *m++ = 0;
2354 *m++ = 4; *m++ = numterms & WORDMASK; *m++ = 1; *m++ = 3;
2355 w[1] += ARGHEAD+3;
2356 }
2357 else {
2358 *m++ = ARGHEAD+6;
2359 for ( j = 1; j < ARGHEAD; j++ ) *m++ = 0;
2360 *m++ = 6; *m++ = numterms & WORDMASK;
2361 *m++ = i; *m++ = 1; *m++ = 0; *m++ = 5;
2362 w[1] += ARGHEAD+5;
2363 }
2364 from++; /* Skip our function */
2365 r = term + *term;
2366 while ( from < r ) *m++ = *from++;
2367 if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2368 *termout = WORDDIF(m,termout);
2369 return(0);
2370 }
2371 else { NEXTARG(t) }
2372 }
2373 t = u;
2374 }
2375 else if ( ( *t >= FUNCTION && functions[ipp-FUNCTION].spec )
2376 && ( t[2] & DIRTYFLAG ) == DIRTYFLAG ) { /* Could be FUNNYDOLLAR */
2377 u = t; v = t + t[1];
2378 t += FUNHEAD;
2379 while ( t < v ) {
2380 if ( *t == FUNNYDOLLAR ) {
2381 if ( AR.Eside != LHSIDE ) {
2382 DOLLARS d = Dollars + t[1];
2383#ifdef WITHPTHREADS
2384 int nummodopt, dtype = -1;
2385 if ( AS.MultiThreaded ) {
2386 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2387 if ( t[1] == ModOptdollars[nummodopt].number ) break;
2388 }
2389 if ( nummodopt < NumModOptdollars ) {
2390 dtype = ModOptdollars[nummodopt].type;
2391 if ( dtype == MODLOCAL ) {
2392 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2393 }
2394 else {
2395 LOCK(d->pthreadslockread);
2396 }
2397 }
2398 }
2399#endif
2400 oldncmod = AN.ncmod;
2401 if ( ( AN.ncmod != 0 )
2402 && ( ( AC.modmode & ALSOFUNARGS ) == 0 )
2403 && ( *u != AR.PolyFun ) ) { AN.ncmod = 0; }
2404 m = termout; w = 0;
2405 while ( from < t ) {
2406 if ( from == u ) w = m;
2407 *m++ = *from++;
2408 }
2409 to = m;
2410 switch ( d->type ) {
2411 case DOLINDEX:
2412 *m++ = d->index; break;
2413 case DOLZERO:
2414 *m++ = 0; break;
2415 case DOLNUMBER:
2416 case DOLTERMS:
2417 if ( d->where[0] == 4 && d->where[4] == 0
2418 && d->where[3] == 3 && d->where[2] == 1
2419 && d->where[1] < AM.OffsetIndex ) {
2420 *m++ = d->where[1];
2421 }
2422 else {
2423wrongtype:;
2424#ifdef WITHPTHREADS
2425 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2426#endif
2427 MLOCK(ErrorMessageLock);
2428 MesPrint("$%s has wrong type for tensor substitution",
2429 AC.dollarnames->namebuffer+d->name);
2430 MUNLOCK(ErrorMessageLock);
2431 AN.ncmod = oldncmod;
2432 return(-1);
2433 }
2434 break;
2435 case DOLARGUMENT:
2436 if ( d->where[0] == -INDEX ) {
2437 *m++ = d->where[1]; break;
2438 }
2439 else if ( d->where[0] == -VECTOR ) {
2440 *m++ = d->where[1]; break;
2441 }
2442 else if ( d->where[0] == -MINVECTOR ) {
2443 *m++ = d->where[1];
2444 sign = -sign;
2445 break;
2446 }
2447 else if ( d->where[0] == -SNUMBER ) {
2448 if ( d->where[1] >= 0
2449 && d->where[1] < AM.OffsetIndex ) {
2450 *m++ = d->where[1]; break;
2451 }
2452 }
2453 goto wrongtype;
2454 case DOLWILDARGS:
2455 if ( d->where[0] > 0 ) {
2456 r = d->where; i = *r++;
2457 while ( --i >= 0 ) *m++ = *r++;
2458 }
2459 else {
2460 r = d->where + 1;
2461 while ( *r ) {
2462 if ( *r == -INDEX ) {
2463 *m++ = r[1]; r += 2; continue;
2464 }
2465 else if ( *r == -VECTOR ) {
2466 *m++ = r[1]; r += 2; continue;
2467 }
2468 else if ( *r == -MINVECTOR ) {
2469 *m++ = r[1]; r += 2;
2470 sign = -sign; continue;
2471 }
2472 else if ( *r == -SNUMBER ) {
2473 if ( r[1] >= 0
2474 && r[1] < AM.OffsetIndex ) {
2475 *m++ = r[1]; r += 2; continue;
2476 }
2477 }
2478 goto wrongtype;
2479 }
2480 }
2481 break;
2482 case DOLSUBTERM:
2483 r = d->where;
2484 if ( *r == INDEX && r[1] == 3 ) {
2485 *m++ = r[2];
2486 }
2487 else goto wrongtype;
2488 break;
2489 case DOLUNDEFINED:
2490#ifdef WITHPTHREADS
2491 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2492#endif
2493 MLOCK(ErrorMessageLock);
2494 MesPrint("$%s is undefined in tensor substitution",
2495 AC.dollarnames->namebuffer+d->name);
2496 MUNLOCK(ErrorMessageLock);
2497 AN.ncmod = oldncmod;
2498 return(-1);
2499 }
2500#ifdef WITHPTHREADS
2501 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2502#endif
2503 w[1] = w[1] - 2 + (m-to);
2504 from += 2;
2505 term += *term;
2506 while ( from < term ) *m++ = *from++;
2507 if ( sign < 0 ) m[-1] = -m[-1];
2508 if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2509 *termout = m - termout;
2510 AN.ncmod = oldncmod;
2511 return(0);
2512 }
2513 else {
2514 AC.lhdollarflag = 1;
2515 }
2516 }
2517 t++;
2518 }
2519 t = u;
2520 }
2521 t += t[1];
2522 }
2523 MLOCK(ErrorMessageLock);
2524 MesPrint("Internal error in InFunction: Function not encountered.");
2525 if ( AM.tracebackflag ) {
2526 MesPrint("%w: AR.TePos = %d",AR.TePos);
2527 MesPrint("%w: AN.TeInFun = %d",AN.TeInFun);
2528 termout = term;
2529 AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer + AM.MaxTer;
2530 AO.OutSkip = 3;
2531 FiniLine();
2532 i = *termout;
2533 while ( --i >= 0 ) {
2534 TalToLine((UWORD)(*termout++));
2535 TokenToLine((UBYTE *)" ");
2536 }
2537 AO.OutSkip = 0;
2538 FiniLine();
2539 MesCall("InFunction");
2540 }
2541 MUNLOCK(ErrorMessageLock);
2542 return(1);
2543
2544InFunc:
2545 MLOCK(ErrorMessageLock);
2546 MesCall("InFunction");
2547 MUNLOCK(ErrorMessageLock);
2548 SETERROR(-1)
2549
2550TooLarge:
2551 MLOCK(ErrorMessageLock);
2552 MesPrint("Output term too large. Try to increase MaxTermSize in the setup.");
2553 MesCall("InFunction");
2554 MUNLOCK(ErrorMessageLock);
2555 SETERROR(-1)
2556}
2557
2558/*
2559 #] InFunction :
2560 #[ InsertTerm : WORD InsertTerm(term,replac,extractbuff,position,termout)
2561*/
2579WORD InsertTerm(PHEAD WORD *term, WORD replac, WORD extractbuff, WORD *position, WORD *termout,
2580 WORD tepos)
2581{
2582 GETBIDENTITY
2583 WORD *m, *t, *r, i, l2, j;
2584 WORD *u, *v, l1, *coef;
2585 coef = AT.WorkPointer;
2586 if ( ( AT.WorkPointer = coef + 2*AM.MaxTal ) > AT.WorkTop ) {
2587 MLOCK(ErrorMessageLock);
2588 MesWork();
2589 MUNLOCK(ErrorMessageLock);
2590 return(-1);
2591 }
2592 t = term;
2593 r = t + *t;
2594 l1 = l2 = r[-1];
2595 m = r - ABS(l2);
2596 if ( tepos > 0 ) {
2597 t = term + tepos;
2598 goto foundit;
2599 }
2600 t++;
2601 while ( t < m ) {
2602 if ( *t == SUBEXPRESSION && t[2] == replac && t[3] && t[4] == extractbuff ) {
2603 r = t + t[1];
2604 while ( *r == SUBEXPRESSION && r[2] == replac && r[3] && r < m && r[4] == extractbuff ) {
2605 t = r; r += r[1];
2606 }
2607foundit:;
2608 u = m;
2609 r = term;
2610 m = termout;
2611 do { *m++ = *r++; } while ( r < t );
2612 if ( t[1] > SUBEXPSIZE ) {
2613/*
2614 if this is a dollar expression there are no wildcards
2615*/
2616 i = *--m;
2617 if ( ( l2 = WildFill(BHEAD m,position,t) ) < 0 ) goto InsCall;
2618 *m = i;
2619 m += l2-1;
2620 l2 = *m;
2621 i = ( j = ABS(l2) ) - 1;
2622 r = coef + i;
2623 do { *--r = *--m; } while ( --i > 0 );
2624 }
2625 else {
2626 v = t;
2627 t = position;
2628 r = t + *t;
2629 l2 = r[-1];
2630 r -= ( j = ABS(l2) );
2631 t++;
2632 if ( t < r ) do { *m++ = *t++; } while ( t < r );
2633 t = v;
2634 }
2635 t += t[1];
2636 while ( t < u && *t == DOLLAREXPR2 ) t += t[1];
2637ComAct: if ( t < u ) do { *m++ = *t++; } while ( t < u );
2638 if ( *r == 1 && r[1] == 1 && j == 3 ) {
2639 if ( l2 < 0 ) l1 = -l1;
2640 i = ABS(l1)-1;
2641 NCOPY(m,t,i);
2642 *m++ = l1;
2643 }
2644 else {
2645 if ( MulRat(BHEAD (UWORD *)u,REDLENG(l1),(UWORD *)r,REDLENG(l2),
2646 (UWORD *)m,&l1) ) goto InsCall;
2647 l2 = l1;
2648 l2 *= 2;
2649 if ( l2 < 0 ) {
2650 m -= l2;
2651 *m++ = l2-1;
2652 }
2653 else {
2654 m += l2;
2655 *m++ = l2+1;
2656 }
2657 }
2658 *termout = WORDDIF(m,termout);
2659 if ( (*termout)*((LONG)sizeof(WORD)) > AM.MaxTer ) {
2660 MLOCK(ErrorMessageLock);
2661 MesPrint("Term too complex during substitution. MaxTermSize of %l is too small",AM.MaxTer);
2662 goto InsCall2;
2663 }
2664 AT.WorkPointer = coef;
2665 return(0);
2666 }
2667 t += t[1];
2668 }
2669/*
2670 The next action is for when there is no subexpression pointer.
2671 We append the extra term. Effectively the routine becomes now a
2672 merge routine for two terms.
2673*/
2674 v = t;
2675 u = m;
2676 r = term;
2677 m = termout;
2678 do { *m++ = *r++; } while ( r < t );
2679 t = position;
2680 r = t + *t;
2681 l2 = r[-1];
2682 r -= ( j = ABS(l2) );
2683 t++;
2684 if ( t < r ) do { *m++ = *t++; } while ( t < r );
2685 t = v;
2686 goto ComAct;
2687
2688InsCall:
2689 MLOCK(ErrorMessageLock);
2690InsCall2:
2691 MesCall("InsertTerm");
2692 MUNLOCK(ErrorMessageLock);
2693 SETERROR(-1)
2694}
2695
2696/*
2697 #] InsertTerm :
2698 #[ PasteFile : WORD PasteFile(num,acc,pos,accf,renum,freeze,nexpr)
2699*/
2715LONG PasteFile(PHEAD WORD number, WORD *accum, POSITION *position, WORD **accfill,
2716 RENUMBER renumber, WORD *freeze, WORD nexpr)
2717{
2718 GETBIDENTITY
2719 WORD *r, l, *m, i;
2720 WORD *stop, *s1, *s2;
2721/* POSITION AccPos; bug 12-apr-2008 JV */
2722 WORD InCompState;
2723 WORD *oldipointer;
2724 LONG retlength;
2725 stop = (WORD *)(((UBYTE *)(accum)) + 2*AM.MaxTer);
2726 *accum++ = number;
2727 while ( --number >= 0 ) accum += *accum;
2728 if ( freeze ) {
2729/* AccPos = *position; bug 12-apr-2008 JV */
2730 oldipointer = AR.CompressPointer;
2731 do {
2732 AR.CompressPointer = oldipointer;
2733/* if ( ( l = GetFromStore(accum,&AccPos,renumber,&InCompState,nexpr) ) < 0 ) bug 12-apr-2008 JV */
2734 if ( ( l = GetFromStore(accum,position,renumber,&InCompState,nexpr) ) < 0 )
2735 goto PasErr;
2736 if ( !l ) { *accum = 0; return(0); }
2737 r = accum;
2738 m = r + *r;
2739 m -= ABS(m[-1]);
2740 r++;
2741 while ( r < m && *r != HAAKJE ) r += r[1];
2742 if ( r >= m ) {
2743 if ( *freeze != 4 ) l = -1;
2744 }
2745 else {
2746/*
2747 The algorithm for accepting terms with a given (freeze)
2748 representation outside brackets is rather crude. A refinement
2749 would be to store the part outside the bracket and skip the
2750 term when this part doesn't alter (and is unacceptable).
2751 Once accepting one can keep accepting till the bracket alters
2752 and then one may stop the generation. It is necessary to
2753 set up a struct to remember the bracket and the progress
2754 status.
2755*/
2756 m = AT.WorkPointer;
2757 s2 = r;
2758 r = accum;
2759 *m++ = WORDDIF(s2,r) + 3;
2760 r++;
2761 while ( r < s2 ) *m++ = *r++;
2762 *m++ = 1; *m++ = 1; *m++ = 3;
2763 m = AT.WorkPointer;
2764 if ( Normalize(BHEAD AT.WorkPointer) ) goto PasErr;
2765 r = freeze;
2766 i = *m;
2767 while ( --i >= 0 && *m++ == *r++ ) {}
2768 if ( i > 0 ) {
2769 l = -1;
2770 }
2771 else { /* Term to be accepted */
2772 r = accum;
2773 s1 = r + *r;
2774 r++;
2775 m = s2;
2776 m += m[1];
2777 do { *r++ = *m++; } while ( m < s1 );
2778 *accum = l = WORDDIF(r,accum);
2779 }
2780 }
2781 } while ( l < 0 );
2782 retlength = InCompState;
2783/* retlength = DIFBASE(AccPos,*position) / sizeof(WORD); bug 12-apr-2008 JV */
2784 }
2785 else {
2786 if ( ( l = GetFromStore(accum,position,renumber,&InCompState,nexpr) ) < 0 ) {
2787 MLOCK(ErrorMessageLock);
2788 MesCall("PasteFile");
2789 MUNLOCK(ErrorMessageLock);
2790 SETERROR(-1)
2791 }
2792 if ( l == 0 ) { *accum = 0; return(0); }
2793 retlength = InCompState;
2794 }
2795 accum += l;
2796 if ( accum > stop ) {
2797 MLOCK(ErrorMessageLock);
2798 MesPrint("Buffer too small in PasteFile");
2799 MUNLOCK(ErrorMessageLock);
2800 SETERROR(-1)
2801 }
2802 *accum = 0;
2803 *accfill = accum;
2804 return(retlength);
2805PasErr:
2806 MLOCK(ErrorMessageLock);
2807 MesCall("PasteFile");
2808 MUNLOCK(ErrorMessageLock);
2809 SETERROR(-1)
2810}
2811
2812/*
2813 #] PasteFile :
2814 #[ PasteTerm : WORD PasteTerm(number,accum,position,times,divby)
2815*/
2837WORD *PasteTerm(PHEAD WORD number, WORD *accum, WORD *position, WORD times, WORD divby)
2838{
2839 GETBIDENTITY
2840 WORD *t, *r, x, y, z;
2841 WORD *m, *u, l1, a[2];
2842 m = (WORD *)(((UBYTE *)(accum)) + AM.MaxTer);
2843/* m = (WORD *)(((UBYTE *)(accum)) + 2*AM.MaxTer); */
2844 *accum++ = number;
2845 while ( --number >= 0 ) accum += *accum;
2846 if ( times == divby ) {
2847 t = position;
2848 r = t + *t;
2849 if ( t < r ) do { *accum++ = *t++; } while ( t < r );
2850 }
2851 else {
2852 u = accum;
2853 t = position;
2854 r = t + *t - 1;
2855 l1 = *r;
2856 r -= ABS(*r) - 1;
2857 if ( t < r ) do { *accum++ = *t++; } while ( t < r );
2858 if ( divby > times ) { x = divby; y = times; }
2859 else { x = times; y = divby; }
2860 z = x%y;
2861 while ( z ) { x = y; y = z; z = x%y; }
2862 if ( y != 1 ) { divby /= y; times /= y; }
2863 a[1] = divby;
2864 a[0] = times;
2865 if ( MulRat(BHEAD (UWORD *)t,REDLENG(l1),(UWORD *)a,1,(UWORD *)accum,&l1) ) {
2866 MLOCK(ErrorMessageLock);
2867 MesCall("PasteTerm");
2868 MUNLOCK(ErrorMessageLock);
2869 return(0);
2870 }
2871 x = l1;
2872 x *= 2;
2873 if ( x < 0 ) { accum -= x; *accum++ = x - 1; }
2874 else { accum += x; *accum++ = x + 1; }
2875 *u = WORDDIF(accum,u);
2876 }
2877 if ( accum >= m ) {
2878 MLOCK(ErrorMessageLock);
2879 MesPrint("Buffer too small in PasteTerm");
2880 MUNLOCK(ErrorMessageLock);
2881 return(0);
2882 }
2883 *accum = 0;
2884 return(accum);
2885}
2886
2887/*
2888 #] PasteTerm :
2889 #[ FiniTerm : WORD FiniTerm(term,accum,termout,number)
2890*/
2902WORD FiniTerm(PHEAD WORD *term, WORD *accum, WORD *termout, WORD number, WORD tepos)
2903{
2904 GETBIDENTITY
2905 WORD *m, *t, *r, i, numacc, l2, ipp;
2906 WORD *u, *v, l1, *coef = AT.WorkPointer, *oldaccum;
2907 if ( ( AT.WorkPointer = coef + 2*AM.MaxTal ) > AT.WorkTop ) {
2908 MLOCK(ErrorMessageLock);
2909 MesWork();
2910 MUNLOCK(ErrorMessageLock);
2911 return(-1);
2912 }
2913 oldaccum = accum;
2914 t = term;
2915 m = t + *t - 1;
2916 l1 = REDLENG(*m);
2917 i = ABS(*m) - 1;
2918 r = coef + i;
2919 do { *--r = *--m; } while ( --i > 0 ); /* Copies coefficient */
2920 if ( tepos > 0 ) {
2921 t = term + tepos;
2922 goto foundit;
2923 }
2924 t++;
2925 if ( t < m ) do {
2926 if ( ( ( *t == SUBEXPRESSION && ( *(r=t+t[1]) != SUBEXPRESSION
2927 || r >= m || !r[3] ) ) || *t == EXPRESSION ) && t[2] == number && t[3] ) {
2928foundit:;
2929 u = m;
2930 r = term;
2931 m = termout;
2932 if ( r < t ) do { *m++ = *r++; } while ( r < t );
2933 numacc = *accum++;
2934 if ( numacc >= 0 ) do {
2935 if ( *t == EXPRESSION ) {
2936 v = t + t[1];
2937 r = t + SUBEXPSIZE;
2938 while ( r < v ) {
2939 if ( *r == WILDCARDS ) {
2940 r += 2;
2941 i = *--m;
2942 if ( ( l2 = WildFill(BHEAD m,accum,r) ) < 0 ) goto FiniCall;
2943 goto AllWild;
2944 }
2945 r += r[1];
2946 }
2947 goto NoWild;
2948 }
2949 else if ( t[1] > SUBEXPSIZE && t[SUBEXPSIZE] != FROMBRAC ) {
2950 i = *--m;
2951 if ( ( l2 = WildFill(BHEAD m,accum,t) ) < 0 ) goto FiniCall;
2952AllWild: *m = i;
2953 m += l2-1;
2954 l2 = *m;
2955 m -= ABS(l2) - 1;
2956 r = m;
2957 }
2958 else {
2959NoWild: r = accum;
2960 v = r + *r - 1;
2961 l2 = *v;
2962 v -= ABS(l2) - 1;
2963 r++;
2964 if ( r < v ) do { *m++ = *r++; } while ( r < v );
2965 }
2966 if ( *r == 1 && r[1] == 1 && ABS(l2) == 3 ) {
2967 if ( l2 < 0 ) l1 = -l1;
2968 }
2969 else {
2970 l2 = REDLENG(l2);
2971 if ( l2 == 0 ) {
2972 t = oldaccum;
2973 numacc = *t++;
2974 AO.OutSkip = 3;
2975 FiniLine();
2976 while ( --numacc >= 0 ) {
2977 i = *t;
2978 while ( --i >= 0 ) {
2979 TalToLine((UWORD)(*t++));
2980 TokenToLine((UBYTE *)" ");
2981 }
2982 }
2983 AO.OutSkip = 0;
2984 FiniLine();
2985 goto FiniCall;
2986 }
2987 if ( MulRat(BHEAD (UWORD *)coef,l1,(UWORD *)r,l2,(UWORD *)coef,&l1) ) goto FiniCall;
2988 if ( AN.ncmod != 0 && TakeModulus((UWORD *)coef,&l1,AC.cmod,AN.ncmod,UNPACK|AC.modmode) ) goto FiniCall;
2989 }
2990 accum += *accum;
2991 } while ( --numacc >= 0 );
2992 if ( *t == SUBEXPRESSION ) {
2993 while ( t+t[1] < u && t[t[1]] == DOLLAREXPR2 ) t += t[1];
2994 }
2995 t += t[1];
2996 if ( t < u ) do { *m++ = *t++; } while ( t < u );
2997 l2 = l1;
2998/*
2999 Code to economize when taking x = (a+b)/2
3000*/
3001 r = termout+1;
3002 while ( r < m ) {
3003 if ( *r == SUBEXPRESSION ) {
3004 t = r + r[1];
3005 l1 = (WORD)(cbuf[r[4]].CanCommu[r[2]]);
3006 while ( t < m ) {
3007 if ( *t == SUBEXPRESSION &&
3008 t[1] == r[1] && t[2] == r[2] && t[4] == r[4] ) {
3009 i = t[1] - SUBEXPSIZE;
3010 u = r + SUBEXPSIZE; v = t + SUBEXPSIZE;
3011 while ( i > 0 ) {
3012 if ( *v++ != *u++ ) break;
3013 i--;
3014 }
3015 if ( i <= 0 ) {
3016 u = r;
3017 r[3] += t[3];
3018 r = t + t[1];
3019 while ( r < m ) *t++ = *r++;
3020 m = t;
3021 r = u;
3022 goto Nextr;
3023 }
3024 if ( l1 && cbuf[t[4]].CanCommu[t[2]] ) break;
3025 while ( t+t[1] < m && t[t[1]] == DOLLAREXPR2 ) t += t[1];
3026 }
3027 else if ( l1 ) {
3028 if ( *t == SUBEXPRESSION && cbuf[t[4]].CanCommu[t[2]] )
3029 break;
3030 if ( *t >= FUNCTION+WILDOFFSET )
3031 ipp = *t - WILDOFFSET;
3032 else ipp = *t;
3033 if ( *t >= FUNCTION
3034 && functions[ipp-FUNCTION].commute && l1 ) break;
3035 if ( *t == EXPRESSION ) break;
3036 }
3037 t += t[1];
3038 }
3039 r += r[1];
3040 }
3041 else r += r[1];
3042Nextr:;
3043 }
3044
3045 i = ABS(l2);
3046 i *= 2;
3047 i++;
3048 l2 = ( l2 >= 0 ) ? i: -i;
3049 r = coef;
3050 while ( --i > 0 ) *m++ = *r++;
3051 *m++ = l2;
3052 *termout = WORDDIF(m,termout);
3053 AT.WorkPointer = coef;
3054 return(0);
3055 }
3056 t += t[1];
3057 } while ( t < m );
3058 AT.WorkPointer = coef;
3059 return(1);
3060
3061FiniCall:
3062 MLOCK(ErrorMessageLock);
3063 MesCall("FiniTerm");
3064 MUNLOCK(ErrorMessageLock);
3065 SETERROR(-1)
3066}
3067
3068/*
3069 #] FiniTerm :
3070 #[ Generator : WORD Generator(BHEAD term,level)
3071*/
3072
3073static WORD zeroDollar[] = { 0, 0 };
3074/*
3075static LONG debugcounter = 0;
3076*/
3077
3101WORD Generator(PHEAD WORD *term, WORD level)
3102{
3103 GETBIDENTITY
3104 WORD replac, *accum, *termout, *t, i, j, tepos, applyflag = 0, *StartBuf;
3105 WORD *a, power, power1, DumNow = AR.CurDum, oldtoprhs, oldatoprhs, retnorm, extractbuff;
3106 int *RepSto = AN.RepPoint, iscopy = 0;
3107 CBUF *C = cbuf+AM.rbufnum, *CC = cbuf + AT.ebufnum, *CCC = cbuf + AT.aebufnum;
3108 LONG posisub, oldcpointer, oldacpointer;
3109 DOLLARS d = 0;
3110 WORD numfac[5], idfunctionflag;
3111#ifdef WITHPTHREADS
3112 int nummodopt, dtype = -1, id;
3113#endif
3114 oldtoprhs = CC->numrhs;
3115 oldcpointer = CC->Pointer - CC->Buffer;
3116 oldatoprhs = CCC->numrhs;
3117 oldacpointer = CCC->Pointer - CCC->Buffer;
3118ReStart:
3119 if ( ( replac = TestSub(BHEAD term,level) ) == 0 ) {
3120 if ( applyflag ) { TableReset(); applyflag = 0; }
3121/*
3122 if ( AN.PolyNormFlag > 1 ) {
3123 if ( PolyFunMul(BHEAD term) < 0 ) goto GenCall;
3124 AN.PolyNormFlag = 0;
3125 if ( !*term ) goto Return0;
3126 }
3127*/
3128Renormalize:
3129 AN.PolyNormFlag = 0;
3130 AN.idfunctionflag = 0;
3131 if ( ( retnorm = Normalize(BHEAD term) ) != 0 ) {
3132 if ( retnorm > 0 ) {
3133 if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
3134 goto ReStart;
3135 }
3136 goto GenCall;
3137 }
3138 idfunctionflag = AN.idfunctionflag;
3139 if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3140
3141 if ( AN.PolyNormFlag ) {
3142 if ( AN.PolyFunTodo == 0 ) {
3143 if ( PolyFunMul(BHEAD term) < 0 ) goto GenCall;
3144 if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3145 }
3146 else {
3147 WORD oldPolyFunExp = AR.PolyFunExp;
3148 AR.PolyFunExp = 0;
3149 if ( PolyFunMul(BHEAD term) < 0 ) goto GenCall;
3150 AT.WorkPointer = term+*term;
3151 AR.PolyFunExp = oldPolyFunExp;
3152 if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3153 if ( Normalize(BHEAD term) < 0 ) goto GenCall;
3154 if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3155 AT.WorkPointer = term+*term;
3156 if ( AN.PolyNormFlag ) {
3157 if ( PolyFunMul(BHEAD term) < 0 ) goto GenCall;
3158 if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3159 AT.WorkPointer = term+*term;
3160 }
3161 AN.PolyFunTodo = 0;
3162 }
3163 }
3164 if ( idfunctionflag > 0 ) {
3165 if ( TakeIDfunction(BHEAD term) ) {
3166 AT.WorkPointer = term + *term;
3167 goto ReStart;
3168 }
3169 }
3170 if ( AT.WorkPointer < (WORD *)(((UBYTE *)(term)) + AM.MaxTer) )
3171 AT.WorkPointer = (WORD *)(((UBYTE *)(term)) + AM.MaxTer);
3172 do {
3173SkipCount: level++;
3174 if ( level > AR.Cnumlhs ) {
3175 if ( AR.DeferFlag && AR.sLevel <= 0 ) {
3176#ifdef WITHMPI
3177 if ( PF.me != MASTER && AC.mparallelflag == PARALLELFLAG && PF.exprtodo < 0 ) {
3178 if ( PF_Deferred(term,level) ) goto GenCall;
3179 }
3180 else
3181#endif
3182 if ( Deferred(BHEAD term,level) ) goto GenCall;
3183 goto Return0;
3184 }
3185 if ( AN.ncmod != 0 ) {
3186 if ( Modulus(term) ) goto GenCall;
3187 if ( !*term ) goto Return0;
3188 }
3189 if ( AR.CurDum > AM.IndDum && AR.sLevel <= 0 ) {
3190 WORD olddummies = AN.IndDum;
3191 AN.IndDum = AM.IndDum;
3192 ReNumber(BHEAD term);
3193 Normalize(BHEAD term);
3194 AN.IndDum = olddummies;
3195 if ( !*term ) goto Return0;
3196 olddummies = DetCurDum(BHEAD term);
3197 if ( olddummies > AR.MaxDum ) AR.MaxDum = olddummies;
3198 }
3199 if ( AR.PolyFun > 0 && ( AR.sLevel <= 0 || AN.FunSorts[AR.sLevel]->PolyFlag > 0 ) ) {
3200 if ( PrepPoly(BHEAD term,0) != 0 ) goto Return0;
3201 }
3202 else if ( AR.PolyFun > 0 ) {
3203 if ( PrepPoly(BHEAD term,1) != 0 ) goto Return0;
3204 }
3205 if ( AR.sLevel <= 0 && AR.BracketOn ) {
3206 if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
3207 termout = AT.WorkPointer;
3208 if ( AT.WorkPointer + *term + 3 > AT.WorkTop ) goto OverWork;
3209 if ( PutBracket(BHEAD term) ) return(-1);
3210 AN.RepPoint = RepSto;
3211 *AT.WorkPointer = 0;
3212 i = StoreTerm(BHEAD termout);
3213 AT.WorkPointer = termout;
3214 CC->numrhs = oldtoprhs;
3215 CC->Pointer = CC->Buffer + oldcpointer;
3216 CCC->numrhs = oldatoprhs;
3217 CCC->Pointer = CCC->Buffer + oldacpointer;
3218 return(i);
3219 }
3220 else {
3221 if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
3222 if ( AT.WorkPointer >= AT.WorkTop ) goto OverWork;
3223 *AT.WorkPointer = 0;
3224 AN.RepPoint = RepSto;
3225 i = StoreTerm(BHEAD term);
3226 CC->numrhs = oldtoprhs;
3227 CC->Pointer = CC->Buffer + oldcpointer;
3228 CCC->numrhs = oldatoprhs;
3229 CCC->Pointer = CCC->Buffer + oldacpointer;
3230 return(i);
3231 }
3232 }
3233 i = C->lhs[level][0];
3234 if ( i >= TYPECOUNT ) {
3235/*
3236 #[ Special action :
3237*/
3238 switch ( i ) {
3239 case TYPECOUNT:
3240 if ( CountDo(term,C->lhs[level]) < C->lhs[level][2] ) {
3241 AT.WorkPointer = term + *term;
3242 goto Return0;
3243 }
3244 break;
3245 case TYPEMULT:
3246 if ( MultDo(BHEAD term,C->lhs[level]) ) goto GenCall;
3247 goto ReStart;
3248 case TYPEGOTO:
3249 level = AC.Labels[C->lhs[level][2]];
3250 break;
3251 case TYPEDISCARD:
3252 AT.WorkPointer = term + *term;
3253 goto Return0;
3254 case TYPEIF:
3255#ifdef WITHPTHREADS
3256 {
3257/*
3258 We may be writing in the space here when wildcards
3259 are involved in a match(). Hence we have to make
3260 a private copy here!!!!
3261*/
3262 WORD ic, jc, *ifcode, *jfcode;
3263 jfcode = C->lhs[level]; jc = jfcode[1];
3264 ifcode = AT.WorkPointer; AT.WorkPointer += jc;
3265 for ( ic = 0; ic < jc; ic++ ) ifcode[ic] = jfcode[ic];
3266 while ( !DoIfStatement(BHEAD ifcode,term) ) {
3267 level = C->lhs[level][2];
3268 if ( C->lhs[level][0] != TYPEELIF ) break;
3269 }
3270 AT.WorkPointer = ifcode;
3271 }
3272#else
3273 while ( !DoIfStatement(BHEAD C->lhs[level],term) ) {
3274 level = C->lhs[level][2];
3275 if ( C->lhs[level][0] != TYPEELIF ) break;
3276 }
3277#endif
3278 break;
3279 case TYPEELIF:
3280 do {
3281 level = C->lhs[level][2];
3282 } while ( C->lhs[level][0] == TYPEELIF );
3283 break;
3284 case TYPEELSE:
3285 case TYPEENDIF:
3286 level = C->lhs[level][2];
3287 break;
3288 case TYPESUMFIX:
3289 {
3290 WORD *cp = AR.CompressPointer, *op = AR.CompressPointer;
3291 WORD *tlhs = C->lhs[level] + 3, *m, jlhs;
3292 WORD theindex = C->lhs[level][2];
3293 if ( theindex < 0 ) { /* $-variable */
3294#ifdef WITHPTHREADS
3295 int ddtype = -1;
3296 theindex = -theindex;
3297 d = Dollars + theindex;
3298 if ( AS.MultiThreaded ) {
3299 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3300 if ( theindex == ModOptdollars[nummodopt].number ) break;
3301 }
3302 if ( nummodopt < NumModOptdollars ) {
3303 ddtype = ModOptdollars[nummodopt].type;
3304 if ( ddtype == MODLOCAL ) {
3305 d = ModOptdollars[nummodopt].dstruct+AT.identity;
3306 }
3307 else {
3308 LOCK(d->pthreadslockread);
3309 }
3310 }
3311 }
3312#else
3313 theindex = -theindex;
3314 d = Dollars + theindex;
3315#endif
3316
3317 if ( d->type != DOLINDEX
3318 || d->index < AM.OffsetIndex
3319 || d->index >= AM.OffsetIndex + WILDOFFSET ) {
3320 MLOCK(ErrorMessageLock);
3321 MesPrint("$%s should have been an index"
3322 ,AC.dollarnames->namebuffer+d->name);
3323 AN.currentTerm = term;
3324 MesPrint("Current term: %t");
3325 AN.listinprint = printscratch;
3326 printscratch[0] = DOLLAREXPRESSION;
3327 printscratch[1] = theindex;
3328 MesPrint("$%s = %$"
3329 ,AC.dollarnames->namebuffer+d->name);
3330 MUNLOCK(ErrorMessageLock);
3331#ifdef WITHPTHREADS
3332 if ( ddtype > 0 && ddtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3333#endif
3334 goto GenCall;
3335 }
3336 theindex = d->index;
3337#ifdef WITHPTHREADS
3338 if ( ddtype > 0 && ddtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3339#endif
3340 }
3341 cp[1] = SUBEXPSIZE+4;
3342 cp += SUBEXPSIZE;
3343 *cp++ = INDTOIND;
3344 *cp++ = 4;
3345 *cp++ = theindex;
3346 i = C->lhs[level][1] - 3;
3347 cp++;
3348 AR.CompressPointer = cp;
3349 while ( --i >= 0 ) {
3350 cp[-1] = *tlhs++;
3351 termout = AT.WorkPointer;
3352 if ( ( jlhs = WildFill(BHEAD termout,term,op)) < 0 )
3353 goto GenCall;
3354 m = term;
3355 jlhs = *m;
3356 while ( --jlhs >= 0 ) {
3357 if ( *m++ != *termout++ ) break;
3358 }
3359 if ( jlhs >= 0 ) {
3360 termout = AT.WorkPointer;
3361 AT.WorkPointer = termout + *termout;
3362 if ( Generator(BHEAD termout,level) ) goto GenCall;
3363 AT.WorkPointer = termout;
3364 }
3365 else {
3366 AR.CompressPointer = op;
3367 goto SkipCount;
3368 }
3369 }
3370 AR.CompressPointer = op;
3371 goto CommonEnd;
3372 }
3373 case TYPESUM:
3374 {
3375 WORD *wp, *cp = AR.CompressPointer, *op = AR.CompressPointer;
3376 WORD theindex;
3377 WORD *ow;
3378/*
3379 At this point it is safest to determine CurDum
3380*/
3381 AR.CurDum = DetCurDum(BHEAD term);
3382 i = C->lhs[level][1]-2;
3383 wp = C->lhs[level] + 2;
3384 cp[1] = SUBEXPSIZE+4*i;
3385 cp += SUBEXPSIZE;
3386 while ( --i >= 0 ) {
3387 theindex = *wp++;
3388 if ( theindex < 0 ) { /* $-variable */
3389#ifdef WITHPTHREADS
3390 int ddtype = -1;
3391 theindex = -theindex;
3392 d = Dollars + theindex;
3393 if ( AS.MultiThreaded ) {
3394 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3395 if ( theindex == ModOptdollars[nummodopt].number ) break;
3396 }
3397 if ( nummodopt < NumModOptdollars ) {
3398 ddtype = ModOptdollars[nummodopt].type;
3399 if ( ddtype == MODLOCAL ) {
3400 d = ModOptdollars[nummodopt].dstruct+AT.identity;
3401 }
3402 else {
3403 LOCK(d->pthreadslockread);
3404 }
3405 }
3406 }
3407#else
3408 theindex = -theindex;
3409 d = Dollars + theindex;
3410#endif
3411 if ( d->type != DOLINDEX
3412 || d->index < AM.OffsetIndex
3413 || d->index >= AM.OffsetIndex + WILDOFFSET ) {
3414 MLOCK(ErrorMessageLock);
3415 MesPrint("$%s should have been an index"
3416 ,AC.dollarnames->namebuffer+d->name);
3417 AN.currentTerm = term;
3418 MesPrint("Current term: %t");
3419 AN.listinprint = printscratch;
3420 printscratch[0] = DOLLAREXPRESSION;
3421 printscratch[1] = theindex;
3422 MesPrint("$%s = %$"
3423 ,AC.dollarnames->namebuffer+d->name);
3424 MUNLOCK(ErrorMessageLock);
3425#ifdef WITHPTHREADS
3426 if ( ddtype > 0 && ddtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3427#endif
3428 goto GenCall;
3429 }
3430 theindex = d->index;
3431#ifdef WITHPTHREADS
3432 if ( ddtype > 0 && ddtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3433#endif
3434 }
3435 *cp++ = INDTOIND;
3436 *cp++ = 4;
3437 *cp++ = theindex;
3438 *cp++ = ++AR.CurDum;
3439 }
3440 ow = AT.WorkPointer;
3441 AR.CompressPointer = cp;
3442 if ( WildFill(BHEAD ow,term,op) < 0 ) goto GenCall;
3443 AR.CompressPointer = op;
3444 i = ow[0];
3445 for ( j = 0; j < i; j++ ) term[j] = ow[j];
3446 AT.WorkPointer = ow;
3447 ReNumber(BHEAD term);
3448 goto Renormalize;
3449 }
3450 case TYPECHISHOLM:
3451 if ( Chisholm(BHEAD term,level) ) goto GenCall;
3452CommonEnd:
3453 AT.WorkPointer = term + *term;
3454 goto Return0;
3455 case TYPEARG:
3456 if ( ( i = execarg(BHEAD term,level) ) < 0 ) goto GenCall;
3457 level = C->lhs[level][2];
3458 if ( i > 0 ) goto ReStart;
3459 break;
3460 case TYPENORM:
3461 case TYPENORM2:
3462 case TYPENORM3:
3463 case TYPENORM4:
3464 case TYPESPLITARG:
3465 case TYPESPLITARG2:
3466 case TYPESPLITFIRSTARG:
3467 case TYPESPLITLASTARG:
3468 case TYPEARGTOEXTRASYMBOL:
3469 if ( execarg(BHEAD term,level) < 0 ) goto GenCall;
3470 level = C->lhs[level][2];
3471 break;
3472 case TYPEFACTARG:
3473 case TYPEFACTARG2:
3474 { WORD jjj;
3475 if ( ( jjj = execarg(BHEAD term,level) ) < 0 ) goto GenCall;
3476 if ( jjj > 0 ) goto ReStart;
3477 level = C->lhs[level][2];
3478 break; }
3479 case TYPEEXIT:
3480 if ( C->lhs[level][2] > 0 ) {
3481 MLOCK(ErrorMessageLock);
3482 MesPrint("%s",C->lhs[level]+3);
3483 MUNLOCK(ErrorMessageLock);
3484 }
3485 Terminate(-1);
3486 goto GenCall;
3487 case TYPESETEXIT:
3488 AM.exitflag = 1; /* no danger of race conditions */
3489 break;
3490 case TYPEPRINT:
3491 AN.currentTerm = term;
3492 AN.numlistinprint = (C->lhs[level][1] - C->lhs[level][4] - 5)/2;
3493 AN.listinprint = C->lhs[level]+5+C->lhs[level][4];
3494 MLOCK(ErrorMessageLock);
3495 AO.ErrorBlock = 1;
3496 MesPrint((char *)(C->lhs[level]+5));
3497 AO.ErrorBlock = 0;
3498 MUNLOCK(ErrorMessageLock);
3499 break;
3500 case TYPEFPRINT:
3501 {
3502 int oldFOflag;
3503 WORD oldPrintType, oldLogHandle = AC.LogHandle;
3504 AC.LogHandle = C->lhs[level][2];
3505 MLOCK(ErrorMessageLock);
3506 oldFOflag = AM.FileOnlyFlag;
3507 oldPrintType = AO.PrintType;
3508 if ( AC.LogHandle >= 0 ) {
3509 AM.FileOnlyFlag = 1;
3510 AO.PrintType |= PRINTLFILE;
3511 }
3512 AO.PrintType |= C->lhs[level][3];
3513 AN.currentTerm = term;
3514 AN.numlistinprint = (C->lhs[level][1] - C->lhs[level][4] - 5)/2;
3515 AN.listinprint = C->lhs[level]+5+C->lhs[level][4];
3516 MesPrint((char *)(C->lhs[level]+5));
3517 AO.PrintType = oldPrintType;
3518 AM.FileOnlyFlag = oldFOflag;
3519 MUNLOCK(ErrorMessageLock);
3520 AC.LogHandle = oldLogHandle;
3521 }
3522 break;
3523 case TYPEREDEFPRE:
3524 j = C->lhs[level][2];
3525#ifdef WITHMPI
3526 {
3527 /*
3528 * Regardless of parallel/nonparallel switch, we need to set
3529 * AC.inputnumbers[ii], which indicates that the corresponding
3530 * preprocessor variable is redefined and so we need to
3531 * send/broadcast it.
3532 */
3533 int ii;
3534 for ( ii = 0; ii < AC.numpfirstnum; ii++ ) {
3535 if ( AC.pfirstnum[ii] == j ) break;
3536 }
3537 AC.inputnumbers[ii] = AN.ninterms;
3538 }
3539#endif
3540#ifdef WITHPTHREADS
3541 if ( AS.MultiThreaded ) {
3542 int ii;
3543 for ( ii = 0; ii < AC.numpfirstnum; ii++ ) {
3544 if ( AC.pfirstnum[ii] == j ) break;
3545 }
3546 if ( AN.inputnumber < AC.inputnumbers[ii] ) break;
3547 LOCK(AP.PreVarLock);
3548 if ( AN.inputnumber >= AC.inputnumbers[ii] ) {
3549 a = C->lhs[level]+4;
3550 if ( a[a[-1]] == 0 )
3551 PutPreVar(PreVar[j].name,(UBYTE *)(a),0,1);
3552 else
3553 PutPreVar(PreVar[j].name,(UBYTE *)(a)
3554 ,(UBYTE *)(a+a[-1]+1),1);
3555/*
3556 PutPreVar(PreVar[j].name,(UBYTE *)(C->lhs[level]+4),0,1);
3557*/
3558 AC.inputnumbers[ii] = AN.inputnumber;
3559 }
3560 UNLOCK(AP.PreVarLock);
3561 }
3562 else
3563#endif
3564 {
3565 a = C->lhs[level]+4;
3566 LOCK(AP.PreVarLock);
3567 if ( a[a[-1]] == 0 )
3568 PutPreVar(PreVar[j].name,(UBYTE *)(a),0,1);
3569 else
3570 PutPreVar(PreVar[j].name,(UBYTE *)(a)
3571 ,(UBYTE *)(a+a[-1]+1),1);
3572 UNLOCK(AP.PreVarLock);
3573 }
3574 break;
3575 case TYPERENUMBER:
3576 AT.WorkPointer = term + *term;
3577 if ( FullRenumber(BHEAD term,C->lhs[level][2]) ) goto GenCall;
3578 AT.WorkPointer = term + *term;
3579 if ( *term == 0 ) goto Return0;
3580 break;
3581 case TYPETRY:
3582 if ( TryDo(BHEAD term,C->lhs[level],level) ) goto GenCall;
3583 AT.WorkPointer = term + *term;
3584 goto Return0;
3585 case TYPEASSIGN:
3586 { WORD onc = AR.NoCompress, oldEside = AR.Eside;
3587 WORD oldrepeat = *AN.RepPoint;
3588/*
3589 Here we have to assign an expression to a $ variable.
3590*/
3591 AR.Eside = RHSIDE;
3592 AR.NoCompress = 1;
3593 AN.cTerm = AN.currentTerm = term;
3594 AT.WorkPointer = term + *term;
3595 *AT.WorkPointer++ = 0;
3596 if ( AssignDollar(BHEAD term,level) ) goto GenCall;
3597 AT.WorkPointer = term + *term;
3598 AN.cTerm = 0;
3599 *AN.RepPoint = oldrepeat;
3600 AR.NoCompress = onc;
3601 AR.Eside = oldEside;
3602 break;
3603 }
3604 case TYPEFINDLOOP:
3605 if ( Lus(term,C->lhs[level][3],C->lhs[level][4],
3606 C->lhs[level][5],C->lhs[level][6],C->lhs[level][2]) ) {
3607 AT.WorkPointer = term + *term;
3608 goto Renormalize;
3609 }
3610 break;
3611 case TYPEINSIDE:
3612 if ( InsideDollar(BHEAD C->lhs[level],level) < 0 ) goto GenCall;
3613 level = C->lhs[level][2];
3614 break;
3615 case TYPETERM:
3616 retnorm = execterm(BHEAD term,level);
3617 AN.RepPoint = RepSto;
3618 AR.CurDum = DumNow;
3619 CC->numrhs = oldtoprhs;
3620 CC->Pointer = CC->Buffer + oldcpointer;
3621 CCC->numrhs = oldatoprhs;
3622 CCC->Pointer = CCC->Buffer + oldacpointer;
3623 return(retnorm);
3624 case TYPEDETCURDUM:
3625 AT.WorkPointer = term + *term;
3626 AR.CurDum = DetCurDum(BHEAD term);
3627 break;
3628 case TYPEINEXPRESSION:
3629 {WORD *ll = C->lhs[level];
3630 int numexprs = (int)(ll[1]-3);
3631 ll += 3;
3632 while ( numexprs-- >= 0 ) {
3633 if ( *ll == AR.CurExpr ) break;
3634 ll++;
3635 }
3636 if ( numexprs < 0 ) level = C->lhs[level][2];
3637 }
3638 break;
3639 case TYPEMERGE:
3640 AT.WorkPointer = term + *term;
3641 if ( DoShuffle(term,level,C->lhs[level][2],C->lhs[level][3]) )
3642 goto GenCall;
3643 AT.WorkPointer = term + *term;
3644 goto Return0;
3645 case TYPESTUFFLE:
3646 AT.WorkPointer = term + *term;
3647 if ( DoStuffle(term,level,C->lhs[level][2],C->lhs[level][3]) )
3648 goto GenCall;
3649 AT.WorkPointer = term + *term;
3650 goto Return0;
3651 case TYPETESTUSE:
3652 AT.WorkPointer = term + *term;
3653 if ( TestUse(term,level) ) goto GenCall;
3654 AT.WorkPointer = term + *term;
3655 break;
3656 case TYPEAPPLY:
3657 AT.WorkPointer = term + *term;
3658 if ( ApplyExec(term,C->lhs[level][2],level) < C->lhs[level][2] ) {
3659 AT.WorkPointer = term + *term;
3660 *AN.RepPoint = 1;
3661 goto ReStart;
3662 }
3663 AT.WorkPointer = term + *term;
3664 break;
3665/*
3666 case TYPEAPPLYRESET:
3667 AT.WorkPointer = term + *term;
3668 if ( ApplyReset(level) ) goto GenCall;
3669 AT.WorkPointer = term + *term;
3670 break;
3671*/
3672 case TYPECHAININ:
3673 AT.WorkPointer = term + *term;
3674 if ( ChainIn(BHEAD term,C->lhs[level][2]) ) goto GenCall;
3675 AT.WorkPointer = term + *term;
3676 break;
3677 case TYPECHAINOUT:
3678 AT.WorkPointer = term + *term;
3679 if ( ChainOut(BHEAD term,C->lhs[level][2]) ) goto GenCall;
3680 AT.WorkPointer = term + *term;
3681 break;
3682 case TYPEFACTOR:
3683 AT.WorkPointer = term + *term;
3684 if ( DollarFactorize(BHEAD C->lhs[level][2]) ) goto GenCall;
3685 AT.WorkPointer = term + *term;
3686 break;
3687 case TYPEARGIMPLODE:
3688 AT.WorkPointer = term + *term;
3689 if ( ArgumentImplode(BHEAD term,C->lhs[level]) ) goto GenCall;
3690 AT.WorkPointer = term + *term;
3691 break;
3692 case TYPEARGEXPLODE:
3693 AT.WorkPointer = term + *term;
3694 if ( ArgumentExplode(BHEAD term,C->lhs[level]) ) goto GenCall;
3695 AT.WorkPointer = term + *term;
3696 break;
3697 case TYPEDENOMINATORS:
3698 if ( DenToFunction(term,C->lhs[level][2]) ) goto ReStart;
3699 break;
3700 case TYPEDROPCOEFFICIENT:
3701 DropCoefficient(BHEAD term);
3702 break;
3703 case TYPETRANSFORM:
3704 AT.WorkPointer = term + *term;
3705 if ( RunTransform(BHEAD term,C->lhs[level]+2) ) goto GenCall;
3706 AT.WorkPointer = term + *term;
3707 if ( *term == 0 ) goto Return0;
3708 goto ReStart;
3709 case TYPETOPOLYNOMIAL:
3710 AT.WorkPointer = term + *term;
3711 termout = AT.WorkPointer;
3712 if ( ConvertToPoly(BHEAD term,termout,C->lhs[level],0) < 0 ) goto GenCall;
3713 if ( *termout == 0 ) goto Return0;
3714 i = termout[0]; t = term; NCOPY(t,termout,i);
3715 AT.WorkPointer = term + *term;
3716 break;
3717 case TYPEFROMPOLYNOMIAL:
3718 AT.WorkPointer = term + *term;
3719 termout = AT.WorkPointer;
3720 if ( ConvertFromPoly(BHEAD term,termout,0,numxsymbol,0,0) < 0 ) goto GenCall;
3721 if ( *term == 0 ) goto Return0;
3722 i = termout[0]; t = term; NCOPY(t,termout,i);
3723 AT.WorkPointer = term + *term;
3724 goto ReStart;
3725 case TYPEDOLOOP:
3726 level = TestDoLoop(BHEAD C->lhs[level],level);
3727 if ( level < 0 ) goto GenCall;
3728 break;
3729 case TYPEENDDOLOOP:
3730 level = TestEndDoLoop(BHEAD C->lhs[C->lhs[level][2]],C->lhs[level][2]);
3731 if ( level < 0 ) goto GenCall;
3732 break;
3733 case TYPEDROPSYMBOLS:
3734 DropSymbols(BHEAD term);
3735 break;
3736 case TYPEPUTINSIDE:
3737 AT.WorkPointer = term + *term;
3738 if ( PutInside(BHEAD term,C->lhs[level]) < 0 ) goto GenCall;
3739 AT.WorkPointer = term + *term;
3740 /*
3741 * We need to call Generator() to convert slow notation to
3742 * fast notation, which fixes Issue #30.
3743 */
3744 if ( Generator(BHEAD term,level) < 0 ) goto GenCall;
3745 goto Return0;
3746 case TYPETOSPECTATOR:
3747 if ( PutInSpectator(term,C->lhs[level][2]) < 0 ) goto GenCall;
3748 goto Return0;
3749 case TYPECANONICALIZE:
3750 AT.WorkPointer = term + *term;
3751 if ( DoCanonicalize(BHEAD term,C->lhs[level]) ) goto GenCall;
3752 AT.WorkPointer = term + *term;
3753 if ( *term == 0 ) goto Return0;
3754 break;
3755 case TYPESWITCH:
3756 AT.WorkPointer = term + *term;
3757 if ( DoSwitch(BHEAD term,C->lhs[level]) ) goto GenCall;
3758 goto Return0;
3759 case TYPEENDSWITCH:
3760 AT.WorkPointer = term + *term;
3761 if ( DoEndSwitch(BHEAD term,C->lhs[level]) ) goto GenCall;
3762 goto Return0;
3763 }
3764 goto SkipCount;
3765/*
3766 #] Special action :
3767*/
3768 }
3769 } while ( ( i = TestMatch(BHEAD term,&level) ) == 0 );
3770 if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
3771 if ( i > 0 ) replac = TestSub(BHEAD term,level);
3772 else replac = i;
3773 if ( replac >= 0 || AT.TMout[1] != SYMMETRIZE ) {
3774 *AN.RepPoint = 1;
3775 AR.expchanged = 1;
3776 }
3777 if ( replac < 0 ) { /* Terms come from automatic generation */
3778AutoGen: i = *AT.TMout;
3779 t = termout = AT.WorkPointer;
3780 if ( ( AT.WorkPointer += i ) > AT.WorkTop ) goto OverWork;
3781 accum = AT.TMout;
3782 while ( --i >= 0 ) *t++ = *accum++;
3783 if ( (*(FG.Operation[termout[1]]))(BHEAD term,termout,replac,level) ) goto GenCall;
3784 AT.WorkPointer = termout;
3785 goto Return0;
3786 }
3787 }
3788 if ( applyflag ) { TableReset(); applyflag = 0; }
3789/* DumNow = AR.CurDum; */
3790
3791 if ( AN.TeInFun ) { /* Match in function argument */
3792 if ( AN.TeInFun < 0 && !AN.TeSuOut ) {
3793
3794 if ( AR.TePos >= 0 ) goto AutoGen;
3795 switch ( AN.TeInFun ) {
3796 case -1:
3797 if ( DoDistrib(BHEAD term,level) ) goto GenCall;
3798 break;
3799 case -2:
3800 if ( DoDelta3(BHEAD term,level) ) goto GenCall;
3801 break;
3802 case -3:
3803 if ( DoTableExpansion(term,level) ) goto GenCall;
3804 break;
3805 case -4:
3806 if ( FactorIn(BHEAD term,level) ) goto GenCall;
3807 break;
3808 case -5:
3809 if ( FactorInExpr(BHEAD term,level) ) goto GenCall;
3810 break;
3811 case -6:
3812 if ( TermsInBracket(BHEAD term,level) < 0 ) goto GenCall;
3813 break;
3814 case -7:
3815 if ( ExtraSymFun(BHEAD term,level) < 0 ) goto GenCall;
3816 break;
3817 case -8:
3818 if ( GCDfunction(BHEAD term,level) < 0 ) goto GenCall;
3819 break;
3820 case -9:
3821 if ( DIVfunction(BHEAD term,level,0) < 0 ) goto GenCall;
3822 break;
3823 case -10:
3824 if ( DIVfunction(BHEAD term,level,1) < 0 ) goto GenCall;
3825 break;
3826 case -11:
3827 if ( DIVfunction(BHEAD term,level,2) < 0 ) goto GenCall;
3828 break;
3829 case -12:
3830 if ( DoPermutations(BHEAD term,level) ) goto GenCall;
3831 break;
3832 case -13:
3833 if ( DoPartitions(BHEAD term,level) ) goto GenCall;
3834 break;
3835 case -14:
3836 if ( DIVfunction(BHEAD term,level,3) < 0 ) goto GenCall;
3837 break;
3838 case -15:
3839 if ( GenTopologies(BHEAD term,level) < 0 ) goto GenCall;
3840 break;
3841 case -16:
3842 if ( GenDiagrams(BHEAD term,level) < 0 ) goto GenCall;
3843 break;
3844 }
3845 }
3846 else {
3847 termout = AT.WorkPointer;
3848 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
3849 if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
3850 if ( InFunction(BHEAD term,termout) ) goto GenCall;
3851 AT.WorkPointer = termout + *termout;
3852 *AN.RepPoint = 1;
3853 AR.expchanged = 1;
3854 if ( *termout && Generator(BHEAD termout,level) < 0 ) goto GenCall;
3855 AT.WorkPointer = termout;
3856 }
3857 }
3858 else if ( replac > 0 ) {
3859 power = AN.TeSuOut;
3860 tepos = AR.TePos;
3861 if ( power < 0 ) { /* Table expansion */
3862 power = -power; tepos = 0;
3863 }
3864 extractbuff = AT.TMbuff;
3865 if ( extractbuff == AM.dbufnum ) {
3866 d = DolToTerms(BHEAD replac);
3867 if ( d && d->where != 0 ) {
3868 iscopy = 1;
3869 if ( AT.TMdolfac > 0 ) { /* We need a factor */
3870 if ( AT.TMdolfac == 1 ) {
3871 if ( d->nfactors ) {
3872 numfac[0] = 4;
3873 numfac[1] = d->nfactors;
3874 numfac[2] = 1;
3875 numfac[3] = 3;
3876 numfac[4] = 0;
3877 }
3878 else {
3879 numfac[0] = 0;
3880 }
3881 StartBuf = numfac;
3882 }
3883 else {
3884 if ( (AT.TMdolfac-1) > d->nfactors && d->nfactors > 0 ) {
3885 MLOCK(ErrorMessageLock);
3886 MesPrint("Attempt to use an nonexisting factor %d of a $-variable",(WORD)(AT.TMdolfac-1));
3887 if ( d->nfactors == 1 )
3888 MesPrint("There is only one factor");
3889 else
3890 MesPrint("There are only %d factors",(WORD)(d->nfactors));
3891 MUNLOCK(ErrorMessageLock);
3892 goto GenCall;
3893 }
3894 if ( d->nfactors > 1 ) {
3895 DOLLARS dd;
3896 LONG dsize;
3897 WORD *td1, *td2;
3898 dd = Dollars + replac;
3899#ifdef WITHPTHREADS
3900 {
3901 int nummodopt, dtype = -1;
3902 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
3903 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3904 if ( replac == ModOptdollars[nummodopt].number ) break;
3905 }
3906 if ( nummodopt < NumModOptdollars ) {
3907 dtype = ModOptdollars[nummodopt].type;
3908 if ( dtype == MODLOCAL ) {
3909 dd = ModOptdollars[nummodopt].dstruct+AT.identity;
3910 }
3911 }
3912 }
3913 }
3914#endif
3915 dsize = dd->factors[AT.TMdolfac-2].size;
3916/*
3917 We copy only the factor we need
3918*/
3919 if ( dsize == 0 ) {
3920 numfac[0] = 4;
3921 numfac[1] = d->factors[AT.TMdolfac-2].value;
3922 numfac[2] = 1;
3923 numfac[3] = 3;
3924 numfac[4] = 0;
3925 StartBuf = numfac;
3926 if ( numfac[1] < 0 ) {
3927 numfac[1] = -numfac[1];
3928 numfac[3] = -numfac[3];
3929 }
3930 }
3931 else {
3932 d->factors[AT.TMdolfac-2].where = td2 = (WORD *)Malloc1(
3933 (dsize+1)*sizeof(WORD),"Copy of factor");
3934 td1 = dd->factors[AT.TMdolfac-2].where;
3935 StartBuf = td2;
3936 d->size = dsize; d->type = DOLTERMS;
3937 NCOPY(td2,td1,dsize);
3938 *td2 = 0;
3939 }
3940 }
3941 else if ( d->nfactors == 1 ) {
3942 StartBuf = d->where;
3943 }
3944 else {
3945 MLOCK(ErrorMessageLock);
3946 if ( d->nfactors == 0 ) {
3947 MesPrint("Attempt to use factor %d of an unfactored $-variable",(WORD)(AT.TMdolfac-1));
3948 }
3949 else {
3950 MesPrint("Internal error. Illegal number of factors for $-variable");
3951 }
3952 MUNLOCK(ErrorMessageLock);
3953 goto GenCall;
3954 }
3955 }
3956 }
3957 else StartBuf = d->where;
3958 }
3959 else {
3960 d = Dollars + replac;
3961 StartBuf = zeroDollar;
3962 }
3963 posisub = 0;
3964 i = DetCommu(d->where);
3965#ifdef WITHPTHREADS
3966 if ( AS.MultiThreaded ) {
3967 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3968 if ( replac == ModOptdollars[nummodopt].number ) break;
3969 }
3970 if ( nummodopt < NumModOptdollars ) {
3971 dtype = ModOptdollars[nummodopt].type;
3972 if ( dtype != MODLOCAL && dtype != MODSUM ) {
3973 if ( StartBuf[0] && StartBuf[StartBuf[0]] ) {
3974 MLOCK(ErrorMessageLock);
3975 MesPrint("A dollar variable with modoption max or min can have only one term");
3976 MUNLOCK(ErrorMessageLock);
3977 goto GenCall;
3978 }
3979 LOCK(d->pthreadslockread);
3980 }
3981 }
3982 }
3983#endif
3984 }
3985 else {
3986 StartBuf = cbuf[extractbuff].Buffer;
3987 posisub = cbuf[extractbuff].rhs[replac] - StartBuf;
3988 i = (WORD)cbuf[extractbuff].CanCommu[replac];
3989 }
3990 if ( power == 1 ) { /* Just a single power */
3991 termout = AT.WorkPointer;
3992 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
3993 if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
3994 while ( StartBuf[posisub] ) {
3995 if ( extractbuff == AT.allbufnum ) WildDollars(BHEAD &(StartBuf[posisub]));
3996 AT.WorkPointer = (WORD *)(((UBYTE *)(termout)) + AM.MaxTer);
3997 if ( InsertTerm(BHEAD term,replac,extractbuff,
3998 &(StartBuf[posisub]),termout,tepos) < 0 ) goto GenCall;
3999 AT.WorkPointer = termout + *termout;
4000 *AN.RepPoint = 1;
4001 AR.expchanged = 1;
4002 posisub += StartBuf[posisub];
4003/*
4004 For multiple table substitutions it may be better to
4005 do modulus arithmetic right here
4006 Turns out to be not very effective.
4007
4008 if ( AN.ncmod != 0 ) {
4009 if ( Modulus(termout) ) goto GenCall;
4010 if ( !*termout ) goto Return0;
4011 }
4012*/
4013#ifdef WITHPTHREADS
4014 if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); }
4015 if ( ( AS.Balancing && CC->numrhs == 0 ) && StartBuf[posisub] ) {
4016 if ( ( id = ConditionalGetAvailableThread() ) >= 0 ) {
4017 if ( BalanceRunThread(BHEAD id,termout,level) < 0 ) goto GenCall;
4018 }
4019 }
4020 else
4021#endif
4022 if ( Generator(BHEAD termout,level) < 0 ) goto GenCall;
4023#ifdef WITHPTHREADS
4024 if ( dtype > 0 && dtype != MODLOCAL ) { dtype = 0; break; }
4025#endif
4026 if ( iscopy == 0 && ( extractbuff != AM.dbufnum ) ) {
4027/*
4028 There are cases in which a bigger buffer is created
4029 on the fly, like with wildcard buffers.
4030 We play it safe here. Maybe we can be more selective
4031 in some distant future?
4032*/
4033 StartBuf = cbuf[extractbuff].Buffer;
4034 }
4035 }
4036 if ( extractbuff == AT.allbufnum ) {
4037 CBUF *Ce = cbuf + extractbuff;
4038 Ce->Pointer = Ce->rhs[Ce->numrhs--];
4039 }
4040#ifdef WITHPTHREADS
4041 if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); dtype = 0; }
4042#endif
4043 if ( iscopy ) {
4044 if ( d->nfactors > 1 ) {
4045 int j;
4046 for ( j = 0; j < d->nfactors; j++ ) {
4047 if ( d->factors[j].where ) M_free(d->factors[j].where,"Copy of factor");
4048 }
4049 M_free(d->factors,"Dollar factors");
4050 }
4051 M_free(d,"Copy of dollar variable");
4052 d = 0; iscopy = 0;
4053 }
4054 AT.WorkPointer = termout;
4055 }
4056 else if ( i <= 1 ) { /* Use binomials */
4057 LONG posit, olw;
4058 WORD *same, *ow = AT.WorkPointer;
4059 LONG olpw = AT.posWorkPointer;
4060 power1 = power+1;
4061 WantAddLongs(power1);
4062 olw = posit = AT.lWorkPointer; AT.lWorkPointer += power1;
4063 same = ++AT.WorkPointer;
4064 a = accum = ( AT.WorkPointer += power1+1 );
4065 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4066 if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4067 AT.lWorkSpace[posit] = posisub;
4068 same[-1] = 0;
4069 *same = 1;
4070 *accum = 0;
4071 tepos = AR.TePos;
4072 i = 1;
4073 do {
4074 if ( StartBuf[AT.lWorkSpace[posit]] ) {
4075 if ( ( a = PasteTerm(BHEAD i-1,accum,
4076 &(StartBuf[AT.lWorkSpace[posit]]),i,*same) ) == 0 )
4077 goto GenCall;
4078 AT.lWorkSpace[posit+1] = AT.lWorkSpace[posit];
4079 same[1] = *same + 1;
4080 if ( i > 1 && AT.lWorkSpace[posit] < AT.lWorkSpace[posit-1] ) *same = 1;
4081 AT.lWorkSpace[posit] += StartBuf[AT.lWorkSpace[posit]];
4082 i++;
4083 posit++;
4084 same++;
4085 }
4086 else {
4087 i--; posit--; same--;
4088 }
4089 if ( i > power ) {
4090 termout = AT.WorkPointer = a;
4091 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4092 if ( AT.WorkPointer > AT.WorkTop )
4093 goto OverWork;
4094 if ( FiniTerm(BHEAD term,accum,termout,replac,tepos) ) goto GenCall;
4095 AT.WorkPointer = termout + *termout;
4096 *AN.RepPoint = 1;
4097 AR.expchanged = 1;
4098#ifdef WITHPTHREADS
4099 if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); }
4100 if ( ( AS.Balancing && CC->numrhs == 0 ) && ( i > 0 )
4101 && ( id = ConditionalGetAvailableThread() ) >= 0 ) {
4102 if ( BalanceRunThread(BHEAD id,termout,level) < 0 ) goto GenCall;
4103 }
4104 else
4105#endif
4106 if ( Generator(BHEAD termout,level) ) goto GenCall;
4107#ifdef WITHPTHREADS
4108 if ( dtype > 0 && dtype != MODLOCAL ) { dtype = 0; break; }
4109#endif
4110 if ( iscopy == 0 && ( extractbuff != AM.dbufnum ) )
4111 StartBuf = cbuf[extractbuff].Buffer;
4112 i--; posit--; same--;
4113 }
4114 } while ( i > 0 );
4115#ifdef WITHPTHREADS
4116 if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); dtype = 0; }
4117#endif
4118 if ( iscopy ) {
4119 if ( d->nfactors > 1 ) {
4120 int j;
4121 for ( j = 0; j < d->nfactors; j++ ) {
4122 if ( d->factors[j].where ) M_free(d->factors[j].where,"Copy of factor");
4123 }
4124 M_free(d->factors,"Dollar factors");
4125 }
4126 M_free(d,"Copy of dollar variable");
4127 d = 0; iscopy = 0;
4128 }
4129 AT.WorkPointer = ow; AT.lWorkPointer = olw; AT.posWorkPointer = olpw;
4130 }
4131 else { /* No binomials */
4132 LONG posit, olw, olpw = AT.posWorkPointer;
4133 WantAddLongs(power);
4134 posit = olw = AT.lWorkPointer; AT.lWorkPointer += power;
4135 a = accum = AT.WorkPointer;
4136 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4137 if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4138 for ( i = 0; i < power; i++ ) AT.lWorkSpace[posit++] = posisub;
4139 posit = olw;
4140 *accum = 0;
4141 tepos = AR.TePos;
4142 i = 0;
4143 while ( i >= 0 ) {
4144 if ( StartBuf[AT.lWorkSpace[posit]] ) {
4145 if ( ( a = PasteTerm(BHEAD i,accum,
4146 &(StartBuf[AT.lWorkSpace[posit]]),1,1) ) == 0 ) goto GenCall;
4147 AT.lWorkSpace[posit] += StartBuf[AT.lWorkSpace[posit]];
4148 i++; posit++;
4149 }
4150 else {
4151 AT.lWorkSpace[posit--] = posisub;
4152 i--;
4153 }
4154 if ( i >= power ) {
4155 termout = AT.WorkPointer = a;
4156 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4157 if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4158 if ( FiniTerm(BHEAD term,accum,termout,replac,tepos) ) goto GenCall;
4159 AT.WorkPointer = termout + *termout;
4160 *AN.RepPoint = 1;
4161 AR.expchanged = 1;
4162#ifdef WITHPTHREADS
4163 if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); }
4164 if ( ( AS.Balancing && CC->numrhs == 0 ) && ( i > 0 ) && ( id = ConditionalGetAvailableThread() ) >= 0 ) {
4165 if ( BalanceRunThread(BHEAD id,termout,level) < 0 ) goto GenCall;
4166 }
4167 else
4168#endif
4169 if ( Generator(BHEAD termout,level) ) goto GenCall;
4170#ifdef WITHPTHREADS
4171 if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { dtype = 0; break; }
4172#endif
4173 if ( iscopy == 0 && ( extractbuff != AM.dbufnum ) )
4174 StartBuf = cbuf[extractbuff].Buffer;
4175 i--; posit--;
4176 }
4177 }
4178#ifdef WITHPTHREADS
4179 if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); dtype = 0; }
4180#endif
4181 if ( iscopy ) {
4182 if ( d->nfactors > 1 ) {
4183 int j;
4184 for ( j = 0; j < d->nfactors; j++ ) {
4185 if ( d->factors[j].where ) M_free(d->factors[j].where,"Copy of factor");
4186 }
4187 M_free(d->factors,"Dollar factors");
4188 }
4189 M_free(d,"Copy of dollar variable");
4190 d = 0; iscopy = 0;
4191 }
4192 AT.WorkPointer = accum;
4193 AT.lWorkPointer = olw;
4194 AT.posWorkPointer = olpw;
4195 }
4196 }
4197 else { /* Expression from disk */
4198 POSITION StartPos;
4199 LONG position, olpw, opw, comprev, extra;
4200 RENUMBER renumber;
4201 WORD *Freeze, *aa, *dummies;
4202 replac = -replac-1;
4203 power = AN.TeSuOut;
4204 Freeze = AN.Frozen;
4205 if ( Expressions[replac].status == STOREDEXPRESSION ) {
4206 POSITION firstpos;
4207 SETSTARTPOS(firstpos);
4208
4209/* Note that AT.TMaddr is needed for GetTable just once! */
4210/*
4211 We need space for the previous term in the compression
4212 This is made available in AR.CompressBuffer, although we may get
4213 problems with this sooner or later. Hence we need to keep
4214 a set of pointers in AR.CompressBuffer
4215 Note that after the last call there has been no use made
4216 of AR.CompressPointer, so it points automatically at its original
4217 position!
4218*/
4219 WantAddPointers(power+1);
4220 comprev = opw = AT.pWorkPointer;
4221 AT.pWorkPointer += power+1;
4222 WantAddPositions(power+1);
4223 position = olpw = AT.posWorkPointer;
4224 AT.posWorkPointer += power + 1;
4225
4226 AT.pWorkSpace[comprev++] = AR.CompressPointer;
4227
4228 for ( i = 0; i < power; i++ ) {
4229 PUTZERO(AT.posWorkSpace[position]); position++;
4230 }
4231 position = olpw;
4232 if ( ( renumber = GetTable(replac,&(AT.posWorkSpace[position]),1) ) == 0 ) goto GenCall;
4233 dummies = AT.WorkPointer;
4234 *dummies++ = AR.CurDum;
4235 AT.WorkPointer += power+2;
4236 accum = AT.WorkPointer;
4237 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4238 if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4239 aa = AT.WorkPointer;
4240 *accum = 0;
4241 i = 0; StartPos = AT.posWorkSpace[position];
4242 dummies[i] = AR.CurDum;
4243 while ( i >= 0 ) {
4244skippedfirst:
4245 AR.CompressPointer = AT.pWorkSpace[comprev-1];
4246 if ( ( extra = PasteFile(BHEAD i,accum,&(AT.posWorkSpace[position])
4247 ,&a,renumber,Freeze,replac) ) < 0 ) goto GenCall;
4248 if ( Expressions[replac].numdummies > 0 ) {
4249 AR.CurDum = dummies[i] + Expressions[replac].numdummies;
4250 }
4251 if ( NOTSTARTPOS(firstpos) ) {
4252 if ( ISMINPOS(firstpos) || ISEQUALPOS(firstpos,AT.posWorkSpace[position]) ) {
4253 firstpos = AT.posWorkSpace[position];
4254/*
4255 ADDPOS(AT.posWorkSpace[position],extra * sizeof(WORD));
4256*/
4257 goto skippedfirst;
4258 }
4259 }
4260 if ( extra ) {
4261/*
4262 ADDPOS(AT.posWorkSpace[position],extra * sizeof(WORD));
4263*/
4264 i++; AT.posWorkSpace[++position] = StartPos;
4265 AT.pWorkSpace[comprev++] = AR.CompressPointer;
4266 dummies[i] = AR.CurDum;
4267 }
4268 else {
4269 PUTZERO(AT.posWorkSpace[position]); position--; i--;
4270 AR.CurDum = dummies[i];
4271 comprev--;
4272 }
4273 if ( i >= power ) {
4274 termout = AT.WorkPointer = a;
4275 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4276 if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4277 if ( FiniTerm(BHEAD term,accum,termout,replac,0) ) goto GenCall;
4278 if ( *termout ) {
4279 AT.WorkPointer = termout + *termout;
4280 *AN.RepPoint = 1;
4281 AR.expchanged = 1;
4282#ifdef WITHPTHREADS
4283 if ( ( AS.Balancing && CC->numrhs == 0 ) && ( i > 0 ) && ( id = ConditionalGetAvailableThread() ) >= 0 ) {
4284 if ( BalanceRunThread(BHEAD id,termout,level) < 0 ) goto GenCall;
4285
4286 }
4287 else
4288#endif
4289 if ( Generator(BHEAD termout,level) ) goto GenCall;
4290 }
4291 i--; position--;
4292 AR.CurDum = dummies[i];
4293 comprev--;
4294 }
4295 AT.WorkPointer = aa;
4296 }
4297 AT.WorkPointer = accum;
4298 AT.posWorkPointer = olpw;
4299 AT.pWorkPointer = opw;
4300/*
4301 Bug fix. See also GetTable
4302#ifdef WITHPTHREADS
4303 M_free(renumber->symb.lo,"VarSpace");
4304 M_free(renumber,"Renumber");
4305#endif
4306*/
4307 if ( renumber->symb.lo != AN.dummyrenumlist )
4308 M_free(renumber->symb.lo,"VarSpace");
4309 M_free(renumber,"Renumber");
4310
4311 }
4312 else { /* Active expression */
4313 aa = accum = AT.WorkPointer;
4314 if ( ( (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2 * AM.MaxTer + sizeof(WORD)) ) > AT.WorkTop )
4315 goto OverWork;
4316 *accum++ = -1; AT.WorkPointer++;
4317 if ( DoOnePow(BHEAD term,power,replac,accum,aa,level,Freeze) ) goto GenCall;
4318 AT.WorkPointer = aa;
4319 }
4320 }
4321Return0:
4322 AR.CurDum = DumNow;
4323 AN.RepPoint = RepSto;
4324 CC->numrhs = oldtoprhs;
4325 CC->Pointer = CC->Buffer + oldcpointer;
4326 CCC->numrhs = oldatoprhs;
4327 CCC->Pointer = CCC->Buffer + oldacpointer;
4328 return(0);
4329
4330GenCall:
4331 if ( AM.tracebackflag ) {
4332 termout = term;
4333 MLOCK(ErrorMessageLock);
4334 AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
4335 AO.OutSkip = 3;
4336 FiniLine();
4337 i = *termout;
4338 while ( --i >= 0 ) {
4339 TalToLine((UWORD)(*termout++));
4340 TokenToLine((UBYTE *)" ");
4341 }
4342 AO.OutSkip = 0;
4343 FiniLine();
4344 MesCall("Generator");
4345 MUNLOCK(ErrorMessageLock);
4346 }
4347 CC->numrhs = oldtoprhs;
4348 CC->Pointer = CC->Buffer + oldcpointer;
4349 CCC->numrhs = oldatoprhs;
4350 CCC->Pointer = CCC->Buffer + oldacpointer;
4351 return(-1);
4352OverWork:
4353 CC->numrhs = oldtoprhs;
4354 CC->Pointer = CC->Buffer + oldcpointer;
4355 CCC->numrhs = oldatoprhs;
4356 CCC->Pointer = CCC->Buffer + oldacpointer;
4357 MLOCK(ErrorMessageLock);
4358 MesWork();
4359 MUNLOCK(ErrorMessageLock);
4360 return(-1);
4361}
4362
4363/*
4364 #] Generator :
4365 #[ DoOnePow : WORD DoOnePow(term,power,nexp,accum,aa,level,freeze)
4366*/
4391#ifdef WITHPTHREADS
4392char freezestring[] = "freeze<-xxxx";
4393#endif
4394
4395WORD DoOnePow(PHEAD WORD *term, WORD power, WORD nexp, WORD * accum,
4396 WORD *aa, WORD level, WORD *freeze)
4397{
4398 GETBIDENTITY
4399 POSITION oldposition, startposition;
4400 WORD *acc, *termout, fromfreeze = 0;
4401 WORD *oldipointer = AR.CompressPointer;
4402 FILEHANDLE *fi;
4403 WORD type, retval;
4404 WORD oldGetOneFile = AR.GetOneFile;
4405 WORD olddummies = AR.CurDum;
4406 WORD extradummies = Expressions[nexp].numdummies;
4407/*
4408 The next code is for some tricky debugging. (5-jan-2010 JV)
4409 Normally it should be disabled.
4410*/
4411/*
4412#ifdef WITHPTHREADS
4413 if ( freeze ) {
4414 MLOCK(ErrorMessageLock);
4415 if ( AT.identity < 10 ) {
4416 freezestring[8] = '0'+AT.identity;
4417 freezestring[9] = '>';
4418 freezestring[10] = 0;
4419 }
4420 else if ( AT.identity < 100 ) {
4421 freezestring[8] = '0'+AT.identity/10;
4422 freezestring[9] = '0'+AT.identity%10;
4423 freezestring[10] = '>';
4424 freezestring[11] = 0;
4425 }
4426 else {
4427 freezestring[8] = 0;
4428 }
4429 PrintTerm(freeze,freezestring);
4430 MUNLOCK(ErrorMessageLock);
4431 }
4432#else
4433 if ( freeze ) PrintTerm(freeze,"freeze");
4434#endif
4435*/
4436 type = Expressions[nexp].status;
4437 if ( type == HIDDENLEXPRESSION || type == HIDDENGEXPRESSION
4438 || type == DROPHLEXPRESSION || type == DROPHGEXPRESSION
4439 || type == UNHIDELEXPRESSION || type == UNHIDEGEXPRESSION ) {
4440 AR.GetOneFile = 2; fi = AR.hidefile;
4441 }
4442 else {
4443 AR.GetOneFile = 0; fi = AR.infile;
4444 }
4445 if ( fi->handle >= 0 ) {
4446 PUTZERO(oldposition);
4447#ifdef WITHSEEK
4448 LOCK(AS.inputslock);
4449 SeekFile(fi->handle,&oldposition,SEEK_CUR);
4450 UNLOCK(AS.inputslock);
4451#endif
4452 }
4453 else {
4454 SETBASEPOSITION(oldposition,fi->POfill-fi->PObuffer);
4455 }
4456 if ( freeze && ( Expressions[nexp].bracketinfo != 0 ) ) {
4457 POSITION *brapos;
4458/*
4459 There is a bracket index
4460 AR.CompressPointer = oldipointer;
4461*/
4462 (*aa)++;
4463 power--;
4464 if ( ( brapos = FindBracket(nexp,freeze) ) == 0 )
4465 goto EndExpr;
4466 startposition = *brapos;
4467 goto doterms;
4468 }
4469 startposition = AS.OldOnFile[nexp];
4470 retval = GetOneTerm(BHEAD accum,fi,&startposition,0);
4471 if ( retval > 0 ) { /* Skip prototype */
4472 (*aa)++;
4473 power--;
4474doterms:
4475 AR.CompressPointer = oldipointer;
4476 for (;;) {
4477 retval = GetOneTerm(BHEAD accum,fi,&startposition,0);
4478 if ( retval <= 0 ) break;
4479/*
4480 Here should come the code to test for [].
4481*/
4482 if ( freeze ) {
4483 WORD *t, *m, *r, *mstop;
4484 WORD *tset;
4485 t = accum;
4486 m = freeze;
4487 m += *m;
4488 m -= ABS(m[-1]);
4489 mstop = m;
4490 m = freeze + 1;
4491 r = t;
4492 r += *t;
4493 r -= ABS(r[-1]);
4494 t++;
4495 tset = t;
4496 while ( t < r && *t != HAAKJE ) t += t[1];
4497 if ( t >= r ) {
4498 if ( m < mstop ) {
4499 if ( fromfreeze ) goto EndExpr;
4500 goto NextTerm;
4501 }
4502 t = tset;
4503 }
4504 else {
4505 r = tset;
4506 while ( r < t && m < mstop ) {
4507 if ( *r == *m ) { m++; r++; }
4508 else {
4509 if ( fromfreeze ) goto EndExpr;
4510 goto NextTerm;
4511 }
4512 }
4513 if ( r < t || m < mstop ) {
4514 if ( fromfreeze ) goto EndExpr;
4515 goto NextTerm;
4516 }
4517 }
4518 fromfreeze = 1;
4519 r = tset;
4520 m = accum;
4521 m += *m;
4522 while ( t < m ) *r++ = *t++;
4523 *accum = WORDDIF(r,accum);
4524 }
4525 if ( extradummies > 0 ) {
4526 if ( olddummies > AM.IndDum ) {
4527 MoveDummies(BHEAD accum,olddummies-AM.IndDum);
4528 }
4529 AR.CurDum = olddummies+extradummies;
4530 }
4531 acc = accum;
4532 acc += *acc;
4533 if ( power <= 0 ) {
4534 termout = acc;
4535 AT.WorkPointer = (WORD *)(((UBYTE *)(acc)) + 2*AM.MaxTer);
4536 if ( AT.WorkPointer > AT.WorkTop ) {
4537 MLOCK(ErrorMessageLock);
4538 MesWork();
4539 MUNLOCK(ErrorMessageLock);
4540 return(-1);
4541 }
4542 if ( FiniTerm(BHEAD term,aa,termout,nexp,0) ) goto PowCall;
4543 if ( *termout ) {
4544 MarkPolyRatFunDirty(termout)
4545/* PolyFunDirty(BHEAD termout); */
4546 AT.WorkPointer = termout + *termout;
4547 *AN.RepPoint = 1;
4548 AR.expchanged = 1;
4549 if ( Generator(BHEAD termout,level) ) goto PowCall;
4550 }
4551 }
4552 else {
4553 if ( acc > AT.WorkTop ) {
4554 MLOCK(ErrorMessageLock);
4555 MesWork();
4556 MUNLOCK(ErrorMessageLock);
4557 return(-1);
4558 }
4559 if ( DoOnePow(BHEAD term,power,nexp,acc,aa,level,freeze) ) goto PowCall;
4560 }
4561NextTerm:;
4562 AR.CompressPointer = oldipointer;
4563 }
4564EndExpr:
4565 (*aa)--;
4566 }
4567 AR.CompressPointer = oldipointer;
4568 if ( fi->handle >= 0 ) {
4569#ifdef WITHSEEK
4570 LOCK(AS.inputslock);
4571 SeekFile(fi->handle,&oldposition,SEEK_SET);
4572 UNLOCK(AS.inputslock);
4573 if ( ISNEGPOS(oldposition) ) {
4574 MLOCK(ErrorMessageLock);
4575 MesPrint("File error");
4576 goto PowCall2;
4577 }
4578#endif
4579 }
4580 else {
4581 fi->POfill = fi->PObuffer + BASEPOSITION(oldposition);
4582 }
4583 AR.GetOneFile = oldGetOneFile;
4584 AR.CurDum = olddummies;
4585 return(0);
4586PowCall:;
4587 MLOCK(ErrorMessageLock);
4588#ifdef WITHSEEK
4589PowCall2:;
4590#endif
4591 MesCall("DoOnePow");
4592 MUNLOCK(ErrorMessageLock);
4593 SETERROR(-1)
4594}
4595
4596/*
4597 #] DoOnePow :
4598 #[ Deferred : WORD Deferred(term,level)
4599*/
4616WORD Deferred(PHEAD WORD *term, WORD level)
4617{
4618 GETBIDENTITY
4619 POSITION startposition;
4620 WORD *t, *m, *mstop, *tstart, decr, oldb, *termout, i, *oldwork, retval;
4621 WORD *oldipointer = AR.CompressPointer, *oldPOfill = AR.infile->POfill;
4622 WORD oldGetOneFile = AR.GetOneFile;
4623 AR.GetOneFile = 1;
4624 oldwork = AT.WorkPointer;
4625 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
4626 termout = AT.WorkPointer;
4627 AR.DeferFlag = 0;
4628 startposition = AR.DefPosition;
4629/*
4630 Store old position
4631*/
4632 if ( AR.infile->handle >= 0 ) {
4633/*
4634 PUTZERO(oldposition);
4635 SeekFile(AR.infile->handle,&oldposition,SEEK_CUR);
4636*/
4637 }
4638 else {
4639/*
4640 SETBASEPOSITION(oldposition,AR.infile->POfill-AR.infile->PObuffer);
4641*/
4642 AR.infile->POfill = (WORD *)((UBYTE *)(AR.infile->PObuffer)
4643 +BASEPOSITION(startposition));
4644 }
4645/*
4646 Look in the CompressBuffer where the bracket contents start
4647*/
4648 t = m = AR.CompressBuffer;
4649 t += *t;
4650 mstop = t - ABS(t[-1]);
4651 m++;
4652 while ( *m != HAAKJE && m < mstop ) m += m[1];
4653 if ( m >= mstop ) { /* No deferred action! */
4654 AT.WorkPointer = term + *term;
4655 if ( Generator(BHEAD term,level) ) goto DefCall;
4656 AR.DeferFlag = 1;
4657 AT.WorkPointer = oldwork;
4658 AR.GetOneFile = oldGetOneFile;
4659 return(0);
4660 }
4661 mstop = m + m[1];
4662 decr = WORDDIF(mstop,AR.CompressBuffer)-1;
4663 tstart = AR.CompressPointer + decr;
4664
4665 m = AR.CompressBuffer;
4666 t = AR.CompressPointer;
4667 i = *m;
4668 NCOPY(t,m,i);
4669 oldb = *tstart;
4670 AR.TePos = 0;
4671 AN.TeSuOut = 0;
4672/*
4673 Status:
4674 First bracket content starts at mstop.
4675 Next term starts at startposition.
4676 Decompression information is in AR.CompressPointer.
4677 The outside of the bracket runs from AR.CompressBuffer+1 to mstop.
4678*/
4679 for(;;) {
4680 *tstart = *(AR.CompressPointer)-decr;
4681 AR.CompressPointer = AR.CompressPointer+AR.CompressPointer[0];
4682 if ( InsertTerm(BHEAD term,0,AM.rbufnum,tstart,termout,0) < 0 ) {
4683 goto DefCall;
4684 }
4685 *tstart = oldb;
4686 AT.WorkPointer = termout + *termout;
4687 if ( Generator(BHEAD termout,level) ) goto DefCall;
4688 AR.CompressPointer = oldipointer;
4689 AT.WorkPointer = termout;
4690 retval = GetOneTerm(BHEAD AT.WorkPointer,AR.infile,&startposition,0);
4691 if ( retval >= 0 ) AR.CompressPointer = oldipointer;
4692 if ( retval <= 0 ) break;
4693 t = AR.CompressPointer;
4694 if ( *t < (1 + decr + ABS(*(t+*t-1))) ) break;
4695 t++;
4696 m = AR.CompressBuffer+1;
4697 while ( m < mstop ) {
4698 if ( *m != *t ) goto Thatsit;
4699 m++; t++;
4700 }
4701 }
4702Thatsit:;
4703/*
4704 Finished. Reposition the file, restore information and return.
4705*/
4706 if ( AR.infile->handle < 0 ) AR.infile->POfill = oldPOfill;
4707 AR.DeferFlag = 1;
4708 AR.GetOneFile = oldGetOneFile;
4709 AT.WorkPointer = oldwork;
4710 return(0);
4711DefCall:;
4712 MLOCK(ErrorMessageLock);
4713 MesCall("Deferred");
4714 MUNLOCK(ErrorMessageLock);
4715 SETERROR(-1)
4716}
4717
4718/*
4719 #] Deferred :
4720 #[ PrepPoly : WORD PrepPoly(term,par)
4721*/
4744WORD PrepPoly(PHEAD WORD *term,WORD par)
4745{
4746 GETBIDENTITY
4747 WORD count = 0, i, jcoef, ncoef;
4748 WORD *t, *m, *r, *tstop, *poly = 0, *v, *w, *vv, *ww;
4749 WORD *oldworkpointer = AT.WorkPointer;
4750/*
4751 The problem here is that the function will be forced into 'long'
4752 notation. After this -SNUMBER,1 becomes 6,0,4,1,1,3 and the
4753 pattern matcher cannot match a short 1 with a long 1.
4754 But because this is an undocumented feature for very special
4755 purposes, we don't do anything about it. (30-aug-2011)
4756*/
4757 if ( AR.PolyFunType == 2 && AR.PolyFunExp != 2 ) {
4758 WORD oldtype = AR.SortType;
4759 AR.SortType = SORTHIGHFIRST;
4760 if ( poly_ratfun_normalize(BHEAD term) != 0 ) Terminate(-1);
4761/* if ( ReadPolyRatFun(BHEAD term) != 0 ) Terminate(-1); */
4762 oldworkpointer = AT.WorkPointer;
4763 AR.SortType = oldtype;
4764 }
4765 AT.PolyAct = 0;
4766 t = term;
4767 GETSTOP(t,tstop);
4768 t++;
4769 while ( t < tstop ) {
4770 if ( *t == AR.PolyFun ) {
4771 if ( count > 0 ) return(0);
4772 poly = t;
4773 count++;
4774 }
4775 t += t[1];
4776 }
4777 r = m = term + *term;
4778 i = ABS(m[-1]);
4779 if ( par > 0 ) {
4780 if ( count == 0 ) return(0);
4781 else if ( AR.PolyFunType == 1 || (AR.PolyFunType == 2 && AR.PolyFunExp == 2) )
4782 goto DoOne;
4783 else if ( AR.PolyFunType == 2 )
4784 goto DoTwo;
4785 else
4786 goto DoError;
4787 }
4788 else if ( count == 0 ) {
4789/*
4790 #[ Create a PolyFun :
4791*/
4792 poly = t = tstop;
4793 if ( i == 3 && m[-2] == 1 && (m[-3]&MAXPOSITIVE) == m[-3] ) {
4794 *m++ = AR.PolyFun;
4795 if ( AR.PolyFunType == 1 || (AR.PolyFunType == 2 && AR.PolyFunExp == 2) ) {
4796 *m++ = FUNHEAD+2;
4797 FILLFUN(m)
4798 *m++ = -SNUMBER;
4799 *m = m[-2-FUNHEAD] < 0 ? -m[-4-FUNHEAD]: m[-4-FUNHEAD];
4800 m++;
4801 }
4802 else if ( AR.PolyFunType == 2 ) {
4803 *m++ = FUNHEAD+4;
4804 FILLFUN(m)
4805 *m++ = -SNUMBER;
4806 *m = m[-2-FUNHEAD] < 0 ? -m[-4-FUNHEAD]: m[-4-FUNHEAD];
4807 m++;
4808 *m++ = -SNUMBER;
4809 *m++ = 1;
4810 }
4811 }
4812 else {
4813 WORD *vm;
4814 r = tstop;
4815 if ( AR.PolyFunType == 1 || (AR.PolyFunType == 2 && AR.PolyFunExp == 2) ) {
4816 *m++ = AR.PolyFun;
4817 *m++ = FUNHEAD+ARGHEAD+i+1;
4818 FILLFUN(m)
4819 *m++ = ARGHEAD+i+1;
4820 *m++ = 0;
4821 FILLARG(m)
4822 *m++ = i+1;
4823 NCOPY(m,r,i);
4824 }
4825 else if ( AR.PolyFunType == 2 ) {
4826 WORD *num, *den, size, sign, sizenum, sizeden;
4827 if ( m[-1] < 0 ) { sign = -1; size = -m[-1]; }
4828 else { sign = 1; size = m[-1]; }
4829 num = m - size; size = (size-1)/2; den = num + size;
4830 sizenum = size; while ( num[sizenum-1] == 0 ) sizenum--;
4831 sizeden = size; while ( den[sizeden-1] == 0 ) sizeden--;
4832 v = m;
4833 AT.PolyAct = WORDDIF(v,term);
4834 *v++ = AR.PolyFun;
4835 v++;
4836 FILLFUN(v);
4837 vm = v;
4838 *v++ = ARGHEAD+2*sizenum+2;
4839 *v++ = 0;
4840 FILLARG(v);
4841 *v++ = 2*sizenum+2;
4842 for ( i = 0; i < sizenum; i++ ) *v++ = num[i];
4843 *v++ = 1;
4844 for ( i = 1; i < sizenum; i++ ) *v++ = 0;
4845 *v++ = sign*(2*sizenum+1);
4846 if ( ToFast(vm,vm) ) v = vm+2;
4847 vm = v;
4848 *v++ = ARGHEAD+2*sizeden+2;
4849 *v++ = 0;
4850 FILLARG(v);
4851 *v++ = 2*sizeden+2;
4852 for ( i = 0; i < sizeden; i++ ) *v++ = den[i];
4853 *v++ = 1;
4854 for ( i = 1; i < sizeden; i++ ) *v++ = 0;
4855 *v++ = 2*sizeden+1;
4856 if ( ToFast(vm,vm) ) v = vm+2;
4857 i = v-m;
4858 m[1] = i;
4859 w = num;
4860 NCOPY(w,m,i);
4861 *w++ = 1; *w++ = 1; *w++ = 3; *term = w - term;
4862 return(0);
4863 }
4864 }
4865/*
4866 #] Create a PolyFun :
4867*/
4868 }
4869 else if ( AR.PolyFunType == 1 || (AR.PolyFunType == 2 && AR.PolyFunExp == 2) ) {
4870 DoOne:;
4871/*
4872 #[ One argument :
4873*/
4874 m = term + *term;
4875 r = poly + poly[1];
4876 if ( ( poly[1] == FUNHEAD+2 && poly[FUNHEAD+1] == 0
4877 && poly[FUNHEAD] == -SNUMBER ) || poly[1] == FUNHEAD ) return(1);
4878 t = poly + FUNHEAD;
4879 if ( t >= r ) return(0);
4880 if ( m[-1] == 3 && *tstop == 1 && tstop[1] == 1 ) {
4881 i = poly[1];
4882 t = poly;
4883 NCOPY(m,t,i);
4884 }
4885 else if ( *t <= -FUNCTION ) {
4886 if ( t+1 < r ) return(0); /* More than one argument */
4887 r = tstop;
4888 *m++ = AR.PolyFun;
4889 *m++ = FUNHEAD*2+ARGHEAD+i+1;
4890 FILLFUN(m)
4891 *m++ = FUNHEAD+ARGHEAD+i+1;
4892 *m++ = 0;
4893 FILLARG(m)
4894 *m++ = FUNHEAD+i+1;
4895 *m++ = -*t++;
4896 *m++ = FUNHEAD;
4897 FILLFUN(m)
4898 NCOPY(m,r,i);
4899 }
4900 else if ( *t < 0 ) {
4901 if ( t+2 < r ) return(0); /* More than one argument */
4902 r = tstop;
4903 if ( *t == -SNUMBER ) {
4904 if ( t[1] == 0 ) return(1); /* Term should be zero now */
4905 *m = AR.PolyFun;
4906 w = m+1;
4907 m += FUNHEAD+ARGHEAD;
4908 v = m;
4909 *m++ = 5+i;
4910 *m++ = SNUMBER;
4911 *m++ = 4;
4912 *m++ = t[1];
4913 *m++ = 1;
4914 NCOPY(m,r,i);
4915 if ( m >= AT.WorkSpace && m < AT.WorkTop )
4916 AT.WorkPointer = m;
4917 if ( Normalize(BHEAD v) ) Terminate(-1);
4918 AT.WorkPointer = oldworkpointer;
4919 m = w;
4920 if ( *v == 4 && v[2] == 1 && (v[1]&MAXPOSITIVE) == v[1] ) {
4921 *m++ = FUNHEAD+2;
4922 FILLFUN(m)
4923 *m++ = -SNUMBER;
4924 *m++ = v[3] < 0 ? -v[1] : v[1];
4925 }
4926 else if ( *v == 0 ) return(1);
4927 else {
4928 *m++ = FUNHEAD+ARGHEAD+*v;
4929 FILLFUN(m)
4930 *m++ = ARGHEAD+*v;
4931 *m++ = 0;
4932 FILLARG(m)
4933 m = v + *v;
4934 }
4935 }
4936 else if ( *t == -SYMBOL ) {
4937 *m++ = AR.PolyFun;
4938 *m++ = FUNHEAD+ARGHEAD+5+i;
4939 FILLFUN(m)
4940 *m++ = ARGHEAD+5+i;
4941 *m++ = 0;
4942 FILLARG(m)
4943 *m++ = 5+i;
4944 *m++ = SYMBOL;
4945 *m++ = 4;
4946 *m++ = t[1];
4947 *m++ = 1;
4948 NCOPY(m,r,i);
4949 }
4950 else return(0); /* Not symbol-like */
4951 }
4952 else {
4953 if ( t + *t < r ) return(0); /* More than one argument */
4954 i = m[-1];
4955 *m++ = AR.PolyFun;
4956 w = m;
4957 m += ARGHEAD+FUNHEAD-1;
4958 t += ARGHEAD;
4959 jcoef = i < 0 ? (i+1)>>1:(i-1)>>1;
4960 v = t;
4961/*
4962 Test now the scalar nature of the argument.
4963 No indices allowed.
4964*/
4965 while ( t < r ) {
4966 WORD *vstop;
4967 vv = t + *t;
4968 vstop = vv - ABS(vv[-1]);
4969 t++;
4970 while( t < vstop ) {
4971 if ( *t == INDEX ) return(0);
4972 t += t[1];
4973 }
4974 t = vv;
4975 }
4976/*
4977 Now multiply each term by the coefficient.
4978*/
4979 t = v;
4980 while ( t < r ) {
4981 ww = m;
4982 v = t + *t;
4983 ncoef = v[-1];
4984 vv = v - ABS(ncoef);
4985 if ( ncoef < 0 ) ncoef++;
4986 else ncoef--;
4987 ncoef >>= 1;
4988 while ( t < vv ) *m++ = *t++;
4989 if ( MulRat(BHEAD (UWORD *)vv,ncoef,(UWORD *)tstop,jcoef,
4990 (UWORD *)m,&ncoef) ) Terminate(-1);
4991 ncoef *= 2;
4992 m += ABS(ncoef);
4993 if ( ncoef < 0 ) ncoef--;
4994 else ncoef++;
4995 *m++ = ncoef;
4996 *ww = WORDDIF(m,ww);
4997 if ( AN.ncmod != 0 ) {
4998 if ( Modulus(ww) ) Terminate(-1);
4999 if ( *ww == 0 ) return(1);
5000 m = ww + *ww;
5001 }
5002 t = v;
5003 }
5004 *w = (WORDDIF(m,w))+1;
5005 w[FUNHEAD-1] = w[0] - FUNHEAD;
5006 w[FUNHEAD] = 0;
5007 w[1] = 0; /* omission survived for years. 23-mar-2006 JV */
5008 w += FUNHEAD-1;
5009 if ( ToFast(w,w) ) {
5010 if ( *w <= -FUNCTION ) { w[-FUNHEAD+1] = FUNHEAD+1; m = w+1; }
5011 else { w[-FUNHEAD+1] = FUNHEAD+2; m = w+2; }
5012
5013 }
5014 }
5015 t = poly + poly[1];
5016 while ( t < tstop ) *poly++ = *t++;
5017/*
5018 #] One argument :
5019*/
5020 }
5021 else if ( AR.PolyFunType == 2 ) {
5022 DoTwo:;
5023/*
5024 #[ Two arguments :
5025*/
5026 WORD *num, *den, size, sign, sizenum, sizeden;
5027/*
5028 First make sure that the PolyFun is last
5029*/
5030 m = term + *term;
5031 if ( poly + poly[1] < tstop ) {
5032 for ( i = 0; i < poly[1]; i++ ) m[i] = poly[i];
5033 t = poly; v = poly + poly[1];
5034 while ( v < tstop ) *t++ = *v++;
5035 poly = t;
5036 for ( i = 0; i < m[1]; i++ ) t[i] = m[i];
5037 t += m[1];
5038 }
5039 AT.PolyAct = WORDDIF(poly,term);
5040/*
5041 If needed we convert the coefficient into a PolyRatFun and then
5042 we call poly_ratfun_normalize
5043*/
5044 if ( m[-1] == 3 && m[-2] == 1 && m[-3] == 1 ) return(0);
5045 if ( AR.PolyFunExp != 1 ) {
5046 if ( m[-1] < 0 ) { sign = -1; size = -m[-1]; } else { sign = 1; size = m[-1]; }
5047 num = m - size; size = (size-1)/2; den = num + size;
5048 sizenum = size; while ( num[sizenum-1] == 0 ) sizenum--;
5049 sizeden = size; while ( den[sizeden-1] == 0 ) sizeden--;
5050 v = m;
5051 *v++ = AR.PolyFun;
5052 *v++ = FUNHEAD + 2*(ARGHEAD+sizenum+sizeden+2);
5053/* *v++ = MUSTCLEANPRF; */
5054 *v++ = 0;
5055 FILLFUN3(v);
5056 *v++ = ARGHEAD+2*sizenum+2;
5057 *v++ = 0;
5058 FILLARG(v);
5059 *v++ = 2*sizenum+2;
5060 for ( i = 0; i < sizenum; i++ ) *v++ = num[i];
5061 *v++ = 1;
5062 for ( i = 1; i < sizenum; i++ ) *v++ = 0;
5063 *v++ = sign*(2*sizenum+1);
5064 *v++ = ARGHEAD+2*sizeden+2;
5065 *v++ = 0;
5066 FILLARG(v);
5067 *v++ = 2*sizeden+2;
5068 for ( i = 0; i < sizeden; i++ ) *v++ = den[i];
5069 *v++ = 1;
5070 for ( i = 1; i < sizeden; i++ ) *v++ = 0;
5071 *v++ = 2*sizeden+1;
5072 w = num;
5073 i = v - m;
5074 NCOPY(w,m,i);
5075 }
5076 else {
5077 w = m-ABS(m[-1]);
5078 }
5079 *w++ = 1; *w++ = 1; *w++ = 3; *term = w - term;
5080 {
5081 WORD oldtype = AR.SortType;
5082 AR.SortType = SORTHIGHFIRST;
5083/*
5084 if ( count > 0 )
5085 poly_ratfun_normalize(BHEAD term);
5086 else
5087 ReadPolyRatFun(BHEAD term);
5088*/
5089 poly_ratfun_normalize(BHEAD term);
5090
5091/* oldworkpointer = AT.WorkPointer; */
5092 AR.SortType = oldtype;
5093 }
5094 goto endofit;
5095/*
5096 #] Two arguments :
5097*/
5098 }
5099 else {
5100 DoError:;
5101 MLOCK(ErrorMessageLock);
5102 MesPrint("Illegal value for PolyFunType in PrepPoly");
5103 MUNLOCK(ErrorMessageLock);
5104 Terminate(-1);
5105 }
5106 r = term + *term;
5107 AT.PolyAct = WORDDIF(poly,term);
5108 while ( r < m ) *poly++ = *r++;
5109 *poly++ = 1;
5110 *poly++ = 1;
5111 *poly++ = 3;
5112 *term = WORDDIF(poly,term);
5113endofit:;
5114 return(0);
5115}
5116
5117/*
5118 #] PrepPoly :
5119 #[ PolyFunMul : WORD PolyFunMul(term)
5120*/
5132WORD PolyFunMul(PHEAD WORD *term)
5133{
5134 GETBIDENTITY
5135 WORD *t, *fun1, *fun2, *t1, *t2, *m, *w, *ww, *tt1, *tt2, *tt4, *arg1, *arg2;
5136 WORD *tstop, i, dirty = 0, OldPolyFunPow = AR.PolyFunPow, minp1, minp2;
5137 WORD n1, n2, i1, i2, l1, l2, l3, l4, action = 0, noac = 0, retval = 0;
5138 if ( AR.PolyFunType == 2 && AR.PolyFunExp == 1 ) {
5139 WORD pow = 0, pow1;
5140 t = term + 1; t1 = term + *term; t1 -= ABS(t1[-1]);
5141 w = t;
5142 while ( t < t1 ) {
5143 if ( *t != AR.PolyFun ) {
5144SkipFun:
5145 if ( t == w ) { t += t[1]; w = t; }
5146 else { i = t[1]; NCOPY(w,t,i) }
5147 continue;
5148 }
5149 pow1 = 0;
5150 t2 = t + t[1]; t += FUNHEAD;
5151 if ( *t < 0 ) {
5152 if ( *t == -SYMBOL && t[1] == AR.PolyFunVar ) pow1++;
5153 else if ( *t != -SNUMBER ) goto NoLegal;
5154 t += 2;
5155 }
5156 else if ( t[0] == ARGHEAD+8 && t[ARGHEAD] == 8
5157 && t[ARGHEAD+1] == SYMBOL && t[ARGHEAD+3] == AR.PolyFunVar
5158 && t[ARGHEAD+5] == 1 && t[ARGHEAD+6] == 1 && t[ARGHEAD+7] == 3 ) {
5159 pow1 += t[ARGHEAD+4];
5160 t += *t;
5161 }
5162 else {
5163NoLegal:
5164 MLOCK(ErrorMessageLock);
5165 MesPrint("Illegal term with divergence in PolyRatFun");
5166 MesCall("PolyFunMul");
5167 MUNLOCK(ErrorMessageLock);
5168 Terminate(-1);
5169 }
5170 if ( *t < 0 ) {
5171 if ( *t == -SYMBOL && t[1] == AR.PolyFunVar ) pow1--;
5172 else if ( *t != -SNUMBER ) goto NoLegal;
5173 t += 2;
5174 }
5175 else if ( t[0] == ARGHEAD+8 && t[ARGHEAD] == 8
5176 && t[ARGHEAD+1] == SYMBOL && t[ARGHEAD+3] == AR.PolyFunVar
5177 && t[ARGHEAD+5] == 1 && t[ARGHEAD+6] == 1 && t[ARGHEAD+7] == 3 ) {
5178 pow1 -= t[ARGHEAD+4];
5179 t += *t;
5180 }
5181 else goto NoLegal;
5182 if ( t == t2 ) pow += pow1;
5183 else goto SkipFun;
5184 }
5185 m = w;
5186 *w++ = AR.PolyFun; *w++ = 0; FILLFUN(w);
5187 if ( pow > 1 ) {
5188 *w++ = 8+ARGHEAD; *w++ = 0; FILLARG(w);
5189 *w++ = 8; *w++ = SYMBOL; *w++ = 4; *w++ = AR.PolyFunVar; *w++ = pow;
5190 *w++ = 1; *w++ = 1; *w++ = 3; *w++ = -SNUMBER; *w++ = 1;
5191 }
5192 else if ( pow == 1 ) {
5193 *w++ = -SYMBOL; *w++ = AR.PolyFunVar; *w++ = -SNUMBER; *w++ = 1;
5194 }
5195 else if ( pow < -1 ) {
5196 *w++ = -SNUMBER; *w++ = 1; *w++ = 8+ARGHEAD; *w++ = 0; FILLARG(w);
5197 *w++ = 8; *w++ = SYMBOL; *w++ = 4; *w++ = AR.PolyFunVar; *w++ = -pow;
5198 *w++ = 1; *w++ = 1; *w++ = 3;
5199 }
5200 else if ( pow == -1 ) {
5201 *w++ = -SNUMBER; *w++ = 1; *w++ = -SYMBOL; *w++ = AR.PolyFunVar;
5202 }
5203 else {
5204 *w++ = -SNUMBER; *w++ = 1; *w++ = -SNUMBER; *w++ = 1;
5205 }
5206 m[1] = w - m;
5207 *w++ = 1; *w++ = 1; *w++ = 3;
5208 *term = w - term;
5209 if ( w > AT.WorkSpace && w < AT.WorkTop ) AT.WorkPointer = w;
5210 return(0);
5211 }
5212ReStart:
5213 if ( AR.PolyFunType == 2 && ( ( AR.PolyFunExp != 2 )
5214 || ( AR.PolyFunExp == 2 && AN.PolyNormFlag > 1 ) ) ) {
5215 WORD count1 = 0, count2 = 0, count3;
5216 WORD oldtype = AR.SortType;
5217 t = term + 1; t1 = term + *term; t1 -= ABS(t1[-1]);
5218 while ( t < t1 ) {
5219 if ( *t == AR.PolyFun ) {
5220 if ( t[2] && dirty == 0 ) { /* Any dirty flag on? */
5221 dirty = 1;
5222/* ReadPolyRatFun(BHEAD term); */
5223/* ToPolyFunGeneral(BHEAD term); */
5224 poly_ratfun_normalize(BHEAD term);
5225 if ( term[0] == 0 ) return(0);
5226 count1 = 0;
5227 action++;
5228 goto ReStart;
5229 }
5230 t2 = t + t[1]; tt2 = t+FUNHEAD; count3 = 0;
5231 while ( tt2 < t2 ) { count3++; NEXTARG(tt2); }
5232 if ( count3 == 2 ) {
5233 count1++;
5234 if ( ( t[2] & MUSTCLEANPRF ) != 0 ) { /* Better civilize this guy */
5235 action++;
5236 w = AT.WorkPointer;
5237 AR.SortType = SORTHIGHFIRST;
5238 t2 = t + t[1]; tt2 = t+FUNHEAD;
5239 while ( tt2 < t2 ) {
5240 if ( *tt2 > 0 ) {
5241 tt4 = tt2; tt1 = tt2 + ARGHEAD; tt2 += *tt2;
5242 NewSort(BHEAD0);
5243 while ( tt1 < tt2 ) {
5244 i = *tt1; ww = w; NCOPY(ww,tt1,i);
5245 AT.WorkPointer = ww;
5246 Normalize(BHEAD w);
5247 StoreTerm(BHEAD w);
5248 }
5249 EndSort(BHEAD w,1);
5250 ww = w; while ( *ww ) ww += *ww;
5251 if ( ww-w != *tt4-ARGHEAD ) { /* Little problem */
5252/*
5253 Solution: brute force copy
5254 Maybe it will never come here????
5255*/
5256 WORD *r1 = TermMalloc("PolyFunMul");
5257 WORD ii = (ww-w)-(*tt4-ARGHEAD); /* increment */
5258 WORD *r2 = tt4+ARGHEAD, *r3, *r4 = r1;
5259 i = r2 - term; r3 = term; NCOPY(r4,r3,i);
5260 i = ww-w; ww = w; NCOPY(r4,ww,i);
5261 r3 = tt2; i = term+*term-tt2; NCOPY(r4,r3,i);
5262 *r1 = i = r4-r1; r4 = term; r3 = r1;
5263 NCOPY(r4,r3,i);
5264 t[1] += ii; t1 += ii; *tt4 += ii;
5265 tt2 = tt4 + *tt4;
5266 TermFree(r1,"PolyFunMul");
5267 }
5268 else {
5269 i = ww-w; ww = w; tt1 = tt4+ARGHEAD;
5270 NCOPY(tt1,ww,i);
5271 AT.WorkPointer = w;
5272 }
5273 }
5274 else if ( *tt2 <= -FUNCTION ) tt2++;
5275 else tt2 += 2;
5276 }
5277 AR.SortType = oldtype;
5278 }
5279 }
5280 }
5281 t += t[1];
5282 }
5283 if ( count1 <= 1 ) { goto checkaction; }
5284 if ( AR.PolyFunExp == 1 ) {
5285 t = term + *term; t -= ABS(t[-1]);
5286 *t++ = 1; *t++ = 1; *t++ = 3; *term = t - term;
5287 }
5288 {
5289 AR.SortType = SORTHIGHFIRST;
5290/* retval = ReadPolyRatFun(BHEAD term); */
5291/* ToPolyFunGeneral(BHEAD term); */
5292 retval = poly_ratfun_normalize(BHEAD term);
5293 if ( *term == 0 ) return(retval);
5294 AR.SortType = oldtype;
5295 }
5296
5297 t = term + 1; t1 = term + *term; t1 -= ABS(t1[-1]);
5298 while ( t < t1 ) {
5299 if ( *t == AR.PolyFun ) {
5300 t2 = t + t[1]; tt2 = t+FUNHEAD; count3 = 0;
5301 while ( tt2 < t2 ) { count3++; NEXTARG(tt2); }
5302 if ( count3 == 2 ) {
5303 count2++;
5304 }
5305 }
5306 t += t[1];
5307 }
5308 if ( count1 >= count2 ) {
5309 t = term + 1;
5310 while ( t < t1 ) {
5311 if ( *t == AR.PolyFun ) {
5312 t2 = t;
5313 t = t + t[1];
5314 t2[2] |= (DIRTYFLAG|MUSTCLEANPRF);
5315 t2 += FUNHEAD;
5316 while ( t2 < t ) {
5317 if ( *t2 > 0 ) t2[1] = DIRTYFLAG;
5318 NEXTARG(t2);
5319 }
5320 }
5321 else t += t[1];
5322 }
5323 }
5324
5325 w = term + *term;
5326 if ( w > AT.WorkSpace && w < AT.WorkTop ) AT.WorkPointer = w;
5327checkaction:
5328 if ( action ) retval = action;
5329 return(retval);
5330 }
5331retry:
5332 if ( term >= AT.WorkSpace && term+*term < AT.WorkTop )
5333 AT.WorkPointer = term + *term;
5334 GETSTOP(term,tstop);
5335 t = term+1;
5336 while ( *t != AR.PolyFun && t < tstop ) t += t[1];
5337 while ( t < tstop && *t == AR.PolyFun ) {
5338 if ( t[1] > FUNHEAD ) {
5339 if ( t[FUNHEAD] < 0 ) {
5340 if ( t[FUNHEAD] <= -FUNCTION && t[1] == FUNHEAD+1 ) break;
5341 if ( t[FUNHEAD] > -FUNCTION && t[1] == FUNHEAD+2 ) {
5342 if ( t[FUNHEAD] == -SNUMBER && t[FUNHEAD+1] == 0 ) {
5343 *term = 0;
5344 return(0);
5345 }
5346 break;
5347 }
5348 }
5349 else if ( t[FUNHEAD] == t[1] - FUNHEAD ) break;
5350 }
5351 noac = 1;
5352 t += t[1];
5353 }
5354 if ( *t != AR.PolyFun || t >= tstop ) goto done;
5355 fun1 = t;
5356 t += t[1];
5357 while ( t < tstop && *t == AR.PolyFun ) {
5358 if ( t[1] > FUNHEAD ) {
5359 if ( t[FUNHEAD] < 0 ) {
5360 if ( t[FUNHEAD] <= -FUNCTION && t[1] == FUNHEAD+1 ) break;
5361 if ( t[FUNHEAD] > -FUNCTION && t[1] == FUNHEAD+2 ) {
5362 if ( t[FUNHEAD] == -SNUMBER && t[FUNHEAD+1] == 0 ) {
5363 *term = 0;
5364 return(0);
5365 }
5366 break;
5367 }
5368 }
5369 else if ( t[FUNHEAD] == t[1] - FUNHEAD ) break;
5370 }
5371 noac = 1;
5372 t += t[1];
5373 }
5374 if ( *t != AR.PolyFun || t >= tstop ) goto done;
5375 fun2 = t;
5376/*
5377 We have two functions of the proper type.
5378 Count terms (needed for the specials)
5379*/
5380 t = fun1 + FUNHEAD;
5381 if ( *t < 0 ) {
5382 n1 = 1; arg1 = AT.WorkPointer;
5383 ToGeneral(t,arg1,1);
5384 AT.WorkPointer = arg1 + *arg1;
5385 }
5386 else {
5387 t += ARGHEAD;
5388 n1 = 0; t1 = fun1 + fun1[1]; arg1 = t;
5389 while ( t < t1 ) { n1++; t += *t; }
5390 }
5391 t = fun2 + FUNHEAD;
5392 if ( *t < 0 ) {
5393 n2 = 1; arg2 = AT.WorkPointer;
5394 ToGeneral(t,arg2,1);
5395 AT.WorkPointer = arg2 + *arg2;
5396 }
5397 else {
5398 t += ARGHEAD;
5399 n2 = 0; t2 = fun2 + fun2[1]; arg2 = t;
5400 while ( t < t2 ) { n2++; t += *t; }
5401 }
5402/*
5403 Now we can start the multiplications. We first multiply the terms
5404 without coefficients, then normalize, and finally put the coefficients
5405 in place. This is because one has often truncated series and the
5406 high powers may get killed, while their coefficients are the most
5407 expensive ones.
5408 Note: We may run into fun(-SNUMBER,value)
5409*/
5410 w = AT.WorkPointer;
5411 NewSort(BHEAD0);
5412 if ( AR.PolyFunType == 2 && AR.PolyFunExp == 2 ) {
5413 AT.TrimPower = 1;
5414/*
5415 We have to find the lowest power in both polynomials.
5416 This will be needed to temporarily correct the AR.PolyFunPow
5417*/
5418 minp1 = MAXPOWER;
5419 for ( t1 = arg1, i1 = 0; i1 < n1; i1++, t1 += *t1 ) {
5420 if ( *t1 == 4 ) {
5421 if ( minp1 > 0 ) minp1 = 0;
5422 }
5423 else if ( ABS(t1[*t1-1]) == (*t1-1) ) {
5424 if ( minp1 > 0 ) minp1 = 0;
5425 }
5426 else {
5427 if ( t1[1] == SYMBOL && t1[2] == 4 && t1[3] == AR.PolyFunVar ) {
5428 if ( t1[4] < minp1 ) minp1 = t1[4];
5429 }
5430 else {
5431 MesPrint("Illegal term in expanded polyratfun.");
5432 goto PolyCall;
5433 }
5434 }
5435 }
5436 minp2 = MAXPOWER;
5437 for ( t2 = arg2, i2 = 0; i2 < n2; i2++, t2 += *t2 ) {
5438 if ( *t2 == 4 ) {
5439 if ( minp2 > 0 ) minp2 = 0;
5440 }
5441 else if ( ABS(t2[*t2-1]) == (*t2-1) ) {
5442 if ( minp2 > 0 ) minp2 = 0;
5443 }
5444 else {
5445 if ( t2[1] == SYMBOL && t2[2] == 4 && t2[3] == AR.PolyFunVar ) {
5446 if ( t2[4] < minp2 ) minp2 = t2[4];
5447 }
5448 else {
5449 MesPrint("Illegal term in expanded polyratfun.");
5450 goto PolyCall;
5451 }
5452 }
5453 }
5454 AR.PolyFunPow += minp1+minp2;
5455 }
5456 for ( t1 = arg1, i1 = 0; i1 < n1; i1++, t1 += *t1 ) {
5457 for ( t2 = arg2, i2 = 0; i2 < n2; i2++, t2 += *t2 ) {
5458 m = w;
5459 m++;
5460 GETSTOP(t1,tt1);
5461 t = t1 + 1;
5462 while ( t < tt1 ) *m++ = *t++;
5463 GETSTOP(t2,tt2);
5464 t = t2+1;
5465 while ( t < tt2 ) *m++ = *t++;
5466 *m++ = 1; *m++ = 1; *m++ = 3; *w = WORDDIF(m,w);
5467 AT.WorkPointer = m;
5468 if ( Normalize(BHEAD w) ) { LowerSortLevel(); goto PolyCall; }
5469 if ( *w ) {
5470 m = w + *w;
5471 if ( m[-1] != 3 || m[-2] != 1 || m[-3] != 1 ) {
5472 l3 = REDLENG(m[-1]);
5473 m -= ABS(m[-1]);
5474 t = t1 + *t1 - 1;
5475 l1 = REDLENG(*t);
5476 if ( MulRat(BHEAD (UWORD *)m,l3,(UWORD *)tt1,l1,(UWORD *)m,&l4) ) {
5477 LowerSortLevel(); goto PolyCall; }
5478 if ( AN.ncmod != 0 && TakeModulus((UWORD *)m,&l4,AC.cmod,AN.ncmod,UNPACK|AC.modmode) ) {
5479 LowerSortLevel(); goto PolyCall; }
5480 if ( l4 == 0 ) continue;
5481 t = t2 + *t2 - 1;
5482 l2 = REDLENG(*t);
5483 if ( MulRat(BHEAD (UWORD *)m,l4,(UWORD *)tt2,l2,(UWORD *)m,&l3) ) {
5484 LowerSortLevel(); goto PolyCall; }
5485 if ( AN.ncmod != 0 && TakeModulus((UWORD *)m,&l3,AC.cmod,AN.ncmod,UNPACK|AC.modmode) ) {
5486 LowerSortLevel(); goto PolyCall; }
5487 }
5488 else {
5489 m -= 3;
5490 t = t1 + *t1 - 1;
5491 l1 = REDLENG(*t);
5492 t = t2 + *t2 - 1;
5493 l2 = REDLENG(*t);
5494 if ( MulRat(BHEAD (UWORD *)tt1,l1,(UWORD *)tt2,l2,(UWORD *)m,&l3) ) {
5495 LowerSortLevel(); goto PolyCall; }
5496 if ( AN.ncmod != 0 && TakeModulus((UWORD *)m,&l3,AC.cmod,AN.ncmod,UNPACK|AC.modmode) ) {
5497 LowerSortLevel(); goto PolyCall; }
5498 }
5499 if ( l3 == 0 ) continue;
5500 l3 = INCLENG(l3);
5501 m += ABS(l3);
5502 m[-1] = l3;
5503 *w = WORDDIF(m,w);
5504 AT.WorkPointer = m;
5505 if ( StoreTerm(BHEAD w) ) { LowerSortLevel(); goto PolyCall; }
5506 }
5507 }
5508 }
5509 if ( EndSort(BHEAD w,0) < 0 ) goto PolyCall;
5510 AR.PolyFunPow = OldPolyFunPow;
5511 AT.TrimPower = 0;
5512 if ( *w == 0 ) {
5513 *term = 0;
5514 return(0);
5515 }
5516 t = w;
5517 while ( *t ) t += *t;
5518 AT.WorkPointer = t;
5519 n1 = WORDDIF(t,w);
5520 t1 = term;
5521 while ( t1 < fun1 ) *t++ = *t1++;
5522 t2 = t;
5523 *t++ = AR.PolyFun;
5524 *t++ = FUNHEAD+ARGHEAD+n1;
5525 *t++ = 0;
5526 FILLFUN3(t)
5527 *t++ = ARGHEAD+n1;
5528 *t++ = 0;
5529 FILLARG(t)
5530 NCOPY(t,w,n1);
5531 if ( ToFast(t2+FUNHEAD,t2+FUNHEAD) ) {
5532 if ( t2[FUNHEAD] > -FUNCTION ) t2[1] = FUNHEAD+2;
5533 else t2[FUNHEAD] = FUNHEAD+1;
5534 t = t2 + t2[1];
5535 }
5536 t1 = fun1 + fun1[1];
5537 while ( t1 < fun2 ) *t++ = *t1++;
5538 t1 = fun2 + fun2[1];
5539 t2 = term + *term;
5540 while ( t1 < t2 ) *t++ = *t1++;
5541 *AT.WorkPointer = n1 = WORDDIF(t,AT.WorkPointer);
5542 if ( n1*((LONG)sizeof(WORD)) > AM.MaxTer ) {
5543 MLOCK(ErrorMessageLock);
5544 MesPrint("Term too complex. Maybe increasing MaxTermSize can help");
5545 goto PolyCall2;
5546 }
5547 m = term; t = AT.WorkPointer;
5548 NCOPY(m,t,n1);
5549 action++;
5550 goto retry;
5551done:
5552 AT.WorkPointer = term + *term;
5553 if ( action && noac ) {
5554 if ( Normalize(BHEAD term) ) goto PolyCall;
5555 AT.WorkPointer = term + *term;
5556 }
5557 return(0);
5558PolyCall:;
5559 MLOCK(ErrorMessageLock);
5560PolyCall2:;
5561 AR.PolyFunPow = OldPolyFunPow;
5562 MesCall("PolyFunMul");
5563 MUNLOCK(ErrorMessageLock);
5564 SETERROR(-1)
5565}
5566
5567/*
5568 #] PolyFunMul :
5569 #] Processor :
5570*/
Definition poly.h:49
WORD * AddRHS(int num, int type)
Definition comtool.c:214
WORD * DoubleCbuffer(int num, WORD *w, int par)
Definition comtool.c:143
WORD CompareSymbols(WORD *, WORD *, WORD)
Definition sort.c:2976
int poly_unfactorize_expression(EXPRESSIONS)
Definition polywrap.cc:1457
WORD NewSort(PHEAD0)
Definition sort.c:592
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
Definition sort.c:1405
int poly_ratfun_normalize(PHEAD WORD *)
Definition polywrap.cc:719
LONG EndSort(PHEAD WORD *, int)
Definition sort.c:682
WORD StoreTerm(PHEAD WORD *)
Definition sort.c:4333
WORD TestMatch(PHEAD WORD *, WORD *)
Definition pattern.c:97
int poly_factorize_expression(EXPRESSIONS)
Definition polywrap.cc:1100
WORD FlushOut(POSITION *, FILEHANDLE *, int)
Definition sort.c:1748
WORD Compare1(WORD *, WORD *, WORD)
Definition sort.c:2536
int PutPreVar(UBYTE *, UBYTE *, UBYTE *, int)
Definition pre.c:642
int SymbolNormalize(WORD *)
Definition normal.c:5014
WORD PF_Deferred(WORD *term, WORD level)
Definition parallel.c:1208
int PF_BroadcastRHS(void)
Definition parallel.c:3564
int PF_Processor(EXPRESSIONS e, WORD i, WORD LastExpression)
Definition parallel.c:1540
int PF_InParallelProcessor(void)
Definition parallel.c:3611
WORD DoOnePow(PHEAD WORD *term, WORD power, WORD nexp, WORD *accum, WORD *aa, WORD level, WORD *freeze)
Definition proces.c:4395
WORD Processor()
Definition proces.c:64
WORD InFunction(PHEAD WORD *term, WORD *termout)
Definition proces.c:2033
WORD FiniTerm(PHEAD WORD *term, WORD *accum, WORD *termout, WORD number, WORD tepos)
Definition proces.c:2902
WORD InsertTerm(PHEAD WORD *term, WORD replac, WORD extractbuff, WORD *position, WORD *termout, WORD tepos)
Definition proces.c:2579
WORD PrepPoly(PHEAD WORD *term, WORD par)
Definition proces.c:4744
LONG PasteFile(PHEAD WORD number, WORD *accum, POSITION *position, WORD **accfill, RENUMBER renumber, WORD *freeze, WORD nexpr)
Definition proces.c:2715
WORD Deferred(PHEAD WORD *term, WORD level)
Definition proces.c:4616
WORD TestSub(PHEAD WORD *term, WORD level)
Definition proces.c:681
WORD PolyFunMul(PHEAD WORD *term)
Definition proces.c:5132
WORD Generator(PHEAD WORD *term, WORD level)
Definition proces.c:3101
WORD * PasteTerm(PHEAD WORD number, WORD *accum, WORD *position, WORD times, WORD divby)
Definition proces.c:2837
VOID LowerSortLevel()
Definition sort.c:4727
WORD * Top
Definition structs.h:940
WORD ** rhs
Definition structs.h:943
WORD ** lhs
Definition structs.h:942
WORD * Buffer
Definition structs.h:939
WORD * Pointer
Definition structs.h:941
LONG * CanCommu
Definition structs.h:944
int handle
Definition structs.h:661
WORD mini
Definition structs.h:307
WORD size
Definition structs.h:309
WORD maxi
Definition structs.h:308
VARRENUM symb
Definition structs.h:180
WORD * pattern
Definition structs.h:356
WORD * tablepointers
Definition structs.h:350
int strict
Definition structs.h:372
WORD * prototype
Definition structs.h:355
MINMAX * mm
Definition structs.h:358
WORD bufnum
Definition structs.h:377
int bounds
Definition structs.h:371
int numind
Definition structs.h:370
int sparse
Definition structs.h:373
WORD * lo
Definition structs.h:167