FORM  4.2.1
proces.c
Go to the documentation of this file.
1 
6 /* #[ License : */
7 /*
8  * Copyright (C) 1984-2017 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 
39 WORD printscratch[2];
40 
41 /*
42  #] Includes :
43  #[ Processor :
44  #[ Processor : WORD Processor()
45 */
64 WORD Processor()
65 {
66  GETIDENTITY
67  WORD *term, *t, i, retval = 0, size;
68  EXPRESSIONS e;
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;
306 commonread:;
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 ) {
443  poly_factorize_expression(e);
444  }
445  else if ( ( ( e->vflags & TOBEUNFACTORED ) != 0 )
446  && ( ( e->vflags & ISFACTORIZED ) != 0 ) ) {
447  poly_unfactorize_expression(e);
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);
649 ProcErr:
650  AT.WorkPointer = term;
651  if ( AM.tracebackflag ) MesCall("Processor");
652  return(-1);
653 }
654 /*
655  #] Processor :
656  #[ TestSub : WORD TestSub(term,level)
657 */
681 WORD 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;
692 ReStart:
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 */
816 TooMuch:;
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
1066 Important: 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 */
1483 DoSpec:
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 */
1537 redosize:
1538  if ( i > *t ) {
1539  i -= *t;
1540  *t2 -= i;
1541  t1[1] -= i;
1542  t += *t;
1543  r = t + i;
1544  m = term + *term;
1545  while ( r < m ) *t++ = *r++;
1546  *term -= i;
1547  }
1548  AN.subsubveto = 0;
1549  t1[2] = 1;
1550  if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 )
1551  t1[2] |= MUSTCLEANPRF;
1552  AT.RecFlag--;
1553  AT.NestPoin--;
1554  AN.TeInFun++;
1555  AR.TePos = 0;
1556  AN.ncmod = oldncmod;
1557  return(retvalue);
1558  }
1559  else {
1560  /*
1561  * Somehow the next line fixes Issue #106.
1562  */
1563  i = *t;
1564  Normalize(BHEAD t);
1565 /* if ( i > *t ) { retvalue = 1; goto redosize; } */
1566  /*
1567  * Experimentally, the next line fixes Issue #105.
1568  */
1569  if ( *t == 0 ) { retvalue = 1; goto redosize; }
1570  {
1571  WORD *tend = t + *t, *tt = t+1;
1572  stilldirty = 0;
1573  tend -= ABS(tend[-1]);
1574  while ( tt < tend ) {
1575  if ( *tt == SUBEXPRESSION ) {
1576  stilldirty = 1; break;
1577  }
1578  tt += tt[1];
1579  }
1580  }
1581  if ( i > *t ) {
1582  retvalue = 1;
1583  i -= *t;
1584  *t2 -= i;
1585  t1[1] -= i;
1586  t += *t;
1587  r = t + i;
1588  m = term + *term;
1589  while ( r < m ) *t++ = *r++;
1590  *term -= i;
1591  t = AT.NestPoin[-1].argsize + ARGHEAD;
1592  }
1593  }
1594  AN.subsubveto = 0;
1595  AT.RecFlag--;
1596  t += *t;
1597  }
1598  AT.NestPoin--;
1599 /*
1600  Argument contains no subexpressions.
1601  It should be normalized and sorted.
1602  The main problem is the storage.
1603 */
1604  t = AT.NestPoin->argsize;
1605  j = *t;
1606  t += ARGHEAD;
1607  NewSort(BHEAD0);
1608  if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 ) {
1609  AR.CompareRoutine = &CompareSymbols;
1610  AR.SortType = SORTHIGHFIRST;
1611  }
1612  if ( AT.WorkPointer < term + *term )
1613  AT.WorkPointer = term + *term;
1614 
1615  while ( t < AT.NestPoin->argsize+*(AT.NestPoin->argsize) ) {
1616  m = AT.WorkPointer;
1617  r = t + *t;
1618  do { *m++ = *t++; } while ( t < r );
1619  r = AT.WorkPointer;
1620  AT.WorkPointer = r + *r;
1621  if ( Normalize(BHEAD r) ) {
1622  if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 ) {
1623  AR.SortType = oldsorttype;
1624  AR.CompareRoutine = oldcompareroutine;
1625  t1[2] |= MUSTCLEANPRF;
1626  }
1627  LowerSortLevel(); goto EndTest;
1628  }
1629  if ( AN.ncmod != 0 ) {
1630  if ( *r ) {
1631  if ( Modulus(r) ) {
1632  LowerSortLevel();
1633  AT.WorkPointer = r;
1634  if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 ) {
1635  AR.SortType = oldsorttype;
1636  AR.CompareRoutine = oldcompareroutine;
1637  t1[2] |= MUSTCLEANPRF;
1638  }
1639  goto EndTest;
1640  }
1641  }
1642  }
1643  if ( AR.PolyFun > 0 ) {
1644  if ( PrepPoly(BHEAD r,1) != 0 ) goto EndTest;
1645  }
1646  if ( *r ) StoreTerm(BHEAD r);
1647  AT.WorkPointer = r;
1648  }
1649 /* the next call had parameter 0. That was wrong!!!!!) */
1650  if ( EndSort(BHEAD AT.WorkPointer+ARGHEAD,1) < 0 ) goto EndTest;
1651  m = AT.WorkPointer+ARGHEAD;
1652  if ( *t1 == AR.PolyFun && AR.PolyFunType == 2 ) {
1653  AR.SortType = oldsorttype;
1654  AR.CompareRoutine = oldcompareroutine;
1655  t1[2] |= MUSTCLEANPRF;
1656  }
1657  while ( *m ) m += *m;
1658  i = WORDDIF(m,AT.WorkPointer);
1659  *AT.WorkPointer = i;
1660  AT.WorkPointer[1] = stilldirty;
1661  if ( ToFast(AT.WorkPointer,AT.WorkPointer) ) {
1662  m = AT.WorkPointer;
1663  if ( *m <= -FUNCTION ) { m++; i = 1; }
1664  else { m += 2; i = 2; }
1665  }
1666  j = i - j;
1667  if ( j > 0 ) {
1668  r = m + j;
1669  if ( r > AT.WorkTop ) {
1670  MLOCK(ErrorMessageLock);
1671  MesWork();
1672  goto EndTest2;
1673  }
1674  do { *--r = *--m; } while ( m > AT.WorkPointer );
1675  AT.WorkPointer = r;
1676  m = AN.EndNest;
1677  r = m + j;
1678  stop = AT.NestPoin->argsize+*(AT.NestPoin->argsize);
1679  do { *--r = *--m; } while ( m >= stop );
1680  }
1681  else if ( j < 0 ) {
1682  m = AT.NestPoin->argsize+*(AT.NestPoin->argsize);
1683  r = m + j;
1684  do { *r++ = *m++; } while ( m < AN.EndNest );
1685  }
1686  m = AT.NestPoin->argsize;
1687  r = AT.WorkPointer;
1688  while ( --i >= 0 ) *m++ = *r++;
1689  n = AT.Nest;
1690  while ( n <= AT.NestPoin ) {
1691  if ( *(n->argsize) > 0 && n != AT.NestPoin )
1692  *(n->argsize) += j;
1693  *(n->funsize) += j;
1694  *(n->termsize) += j;
1695  n++;
1696  }
1697  AN.EndNest += j;
1698 /* (AT.NestPoin->argsize)[1] = 0; */
1699  if ( funnum == DENOMINATOR || funnum == EXPONENT ) {
1700  if ( Normalize(BHEAD term) ) {
1701 /*
1702  In this case something has been substituted
1703  Either a $ or a replace_?????
1704  Originally we had here:
1705 
1706  goto EndTest;
1707 
1708  It seems better to restart.
1709 */
1710  AN.ncmod = oldncmod;
1711  goto ReStart;
1712  }
1713 /*
1714  And size changes here?????
1715 */
1716  }
1717  AN.ncmod = oldncmod;
1718  goto ReStart;
1719  }
1720  else if ( *t == -DOLLAREXPRESSION ) {
1721  if ( ( *t1 == TERMSINEXPR || *t1 == SIZEOFFUNCTION )
1722  && t1[1] == FUNHEAD+2 ) {}
1723  else {
1724  if ( AR.Eside != LHSIDE ) {
1725  AN.TeInFun = 1; AR.TePos = 0;
1726  AT.TMbuff = AM.dbufnum; t1[2] |= DIRTYFLAG;
1727  AN.ncmod = oldncmod;
1728  return(1);
1729  }
1730  AC.lhdollarflag = 1;
1731  }
1732  }
1733  else if ( *t == -TERMSINBRACKET ) {
1734  if ( AR.Eside != LHSIDE ) {
1735  AN.TeInFun = 1; AR.TePos = 0;
1736  t1[2] |= DIRTYFLAG;
1737  AN.ncmod = oldncmod;
1738  return(1);
1739  }
1740  }
1741  else if ( AN.ncmod != 0 && *t == -SNUMBER ) {
1742  if ( AN.ncmod == 1 || AN.ncmod == -1 ) {
1743  isp = (UWORD)(AC.cmod[0]);
1744  isp = t[1] % isp;
1745  if ( ( AC.modmode & POSNEG ) != 0 ) {
1746  if ( isp > (UWORD)(AC.cmod[0])/2 ) isp = isp - (UWORD)(AC.cmod[0]);
1747  else if ( -isp > (UWORD)(AC.cmod[0])/2 ) isp = isp + (UWORD)(AC.cmod[0]);
1748  }
1749  else {
1750  if ( isp < 0 ) isp += (UWORD)(AC.cmod[0]);
1751  }
1752  if ( isp <= MAXPOSITIVE && isp >= -MAXPOSITIVE ) {
1753  t[1] = isp;
1754  }
1755  }
1756  }
1757  NEXTARG(t)
1758  }
1759  if ( funnum >= FUNCTION && functions[funnum-FUNCTION].tabl ) {
1760 /*
1761  Test whether the table catches
1762  Test 1: index arguments and range. i will be the number
1763  of the element in the table.
1764 */
1765  WORD rhsnumber, *oldwork = AT.WorkPointer, *Tpattern;
1766  WORD ii, *p;
1767  MINMAX *mm;
1768  T = functions[funnum-FUNCTION].tabl;
1769 /*
1770  The next application of T->pattern isn't thread safe.
1771  p = T->pattern + FUNHEAD+1;
1772  The new code is in the next three lines and in the application
1773  ii = T->pattern[1]; p = Tpattern; pp = T->pattern;
1774  for ( i = 0; i < ii; i++ ) *p++ = *pp++;
1775  AT.WorkPointer = p;
1776 */
1777 #ifdef WITHPTHREADS
1778  Tpattern = T->pattern[AT.identity];
1779 #else
1780  Tpattern = T->pattern;
1781 #endif
1782  p = Tpattern + FUNHEAD+1;
1783 
1784  mm = T->mm;
1785  if ( T->sparse ) {
1786  t = t1+FUNHEAD;
1787  if ( T->numind == 0 ) { isp = 0; }
1788  else {
1789  for ( i = 0; i < T->numind; i++, t += 2 ) {
1790  if ( *t != -SNUMBER ) break;
1791  }
1792  if ( i < T->numind ) goto teststrict;
1793 
1794  isp = FindTableTree(T,t1+FUNHEAD,2);
1795  }
1796  if ( isp < 0 ) {
1797 teststrict: if ( T->strict == -2 ) {
1798  rhsnumber = AM.zerorhs;
1799  tbufnum = AM.zbufnum;
1800  }
1801  else if ( T->strict == -3 ) {
1802  rhsnumber = AM.onerhs;
1803  tbufnum = AM.zbufnum;
1804  }
1805  else if ( T->strict < 0 ) goto NextFun;
1806  else {
1807  MLOCK(ErrorMessageLock);
1808  MesPrint("Element in table is undefined");
1809  goto showtable;
1810  }
1811 /*
1812  Copy the indices;
1813 */
1814  t = t1+FUNHEAD+1;
1815  for ( i = 0; i < T->numind; i++ ) {
1816  *p = *t; p+=2; t+=2;
1817  }
1818  }
1819  else {
1820  rhsnumber = T->tablepointers[isp+T->numind];
1821 #if ( TABLEEXTENSION == 2 )
1822  tbufnum = T->bufnum;
1823 #else
1824  tbufnum = T->tablepointers[isp+T->numind+1];
1825 #endif
1826  t = t1+FUNHEAD+1;
1827  ii = T->numind;
1828  while ( --ii >= 0 ) {
1829  *p = *t; t += 2; p += 2;
1830  }
1831  }
1832  goto caughttable;
1833  }
1834  else {
1835  i = 0;
1836  t = t1 + FUNHEAD;
1837  j = T->numind;
1838  while ( --j >= 0 ) {
1839  if ( *t != -SNUMBER ) goto NextFun;
1840  t++;
1841  if ( *t < mm->mini || *t > mm->maxi ) {
1842  if ( T->bounds ) {
1843  MLOCK(ErrorMessageLock);
1844  MesPrint("Table boundary check. Argument %d",
1845  T->numind-j);
1846 showtable: AO.OutFill = AO.OutputLine = (UBYTE *)m;
1847  AO.OutSkip = 8;
1848  IniLine(0);
1849  WriteSubTerm(t1,1);
1850  FiniLine();
1851  MUNLOCK(ErrorMessageLock);
1852  SETERROR(-1)
1853  }
1854  goto NextFun;
1855  }
1856  i += ( *t - mm->mini ) * (LONG)(mm->size);
1857  *p = *t++;
1858  p += 2;
1859  mm++;
1860  }
1861 /*
1862  Test now whether the entry exists.
1863 */
1864  i *= TABLEEXTENSION;
1865  if ( T->tablepointers[i] == -1 ) {
1866  if ( T->strict == -2 ) {
1867  rhsnumber = AM.zerorhs;
1868  tbufnum = AM.zbufnum;
1869  }
1870  else if ( T->strict == -3 ) {
1871  rhsnumber = AM.onerhs;
1872  tbufnum = AM.zbufnum;
1873  }
1874  else if ( T->strict < 0 ) goto NextFun;
1875  else {
1876  MLOCK(ErrorMessageLock);
1877  MesPrint("Element in table is undefined");
1878  goto showtable;
1879  }
1880  }
1881  else {
1882  rhsnumber = T->tablepointers[i];
1883 #if ( TABLEEXTENSION == 2 )
1884  tbufnum = T->bufnum;
1885 #else
1886  tbufnum = T->tablepointers[i+1];
1887 #endif
1888  }
1889  }
1890 /*
1891  If there are more arguments we have to do some
1892  pattern matching. This should be easy. We addapted the
1893  pattern, so that the array indices match already.
1894  Note that if there is no match the program will become
1895  very slow.
1896 */
1897 caughttable:
1898 #ifdef WITHPTHREADS
1899  AN.FullProto = T->prototype[AT.identity];
1900 #else
1901  AN.FullProto = T->prototype;
1902 #endif
1903  AN.WildValue = AN.FullProto + SUBEXPSIZE;
1904  AN.WildStop = AN.FullProto+AN.FullProto[1];
1905  ClearWild(BHEAD0);
1906  AN.RepFunNum = 0;
1907  AN.RepFunList = AN.EndNest;
1908  AT.WorkPointer = (WORD *)(((UBYTE *)(AN.EndNest)) + AM.MaxTer/2);
1909  if ( AT.WorkPointer >= AT.WorkTop ) {
1910  MLOCK(ErrorMessageLock);
1911  MesWork();
1912  MUNLOCK(ErrorMessageLock);
1913  }
1914  wilds = 0;
1915 /* if ( MatchFunction(BHEAD T->pattern,t1,&wilds) > 0 ) { } */
1916  if ( MatchFunction(BHEAD Tpattern,t1,&wilds) > 0 ) {
1917  AT.WorkPointer = oldwork;
1918  if ( AT.NestPoin != AT.Nest ) {
1919  AN.ncmod = oldncmod;
1920  return(1);
1921  }
1922 
1923  m = AN.FullProto;
1924  retvalue = m[2] = rhsnumber;
1925  m[4] = tbufnum;
1926  t = t1;
1927  j = t[1];
1928  i = m[1];
1929  if ( j > i ) {
1930  j = i - j;
1931  NCOPY(t,m,i);
1932  m = term + *term;
1933  while ( r < m ) *t++ = *r++;
1934  *term += j;
1935  }
1936  else if ( j < i ) {
1937  j = i-j;
1938  t = term + *term;
1939  while ( t >= r ) { t[j] = *t; t--; }
1940  t = t1;
1941  NCOPY(t,m,i);
1942  *term += j;
1943  }
1944  else {
1945  NCOPY(t,m,j);
1946  }
1947  AN.TeInFun = 0;
1948  AR.TePos = 0;
1949  AN.TeSuOut = -1;
1950  if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
1951  AT.TMbuff = tbufnum;
1952  AN.ncmod = oldncmod;
1953  return(retvalue);
1954  }
1955  AT.WorkPointer = oldwork;
1956  }
1957 NextFun:;
1958  }
1959  else if ( ( t[2] & DIRTYFLAG ) != 0 ) {
1960  t += FUNHEAD;
1961  while ( t < r ) {
1962  if ( *t == FUNNYDOLLAR ) {
1963  if ( AR.Eside != LHSIDE ) {
1964  AN.TeInFun = 1;
1965  AR.TePos = 0;
1966  AT.TMbuff = AM.dbufnum;
1967  AN.ncmod = oldncmod;
1968  return(1);
1969  }
1970  AC.lhdollarflag = 1;
1971  }
1972  t++;
1973  }
1974  }
1975  t = r;
1976  AN.ncmod = oldncmod;
1977  } while ( t < m );
1978  }
1979  return(0);
1980 EndTest:;
1981  MLOCK(ErrorMessageLock);
1982 EndTest2:;
1983  MesCall("TestSub");
1984  MUNLOCK(ErrorMessageLock);
1985  SETERROR(-1)
1986 }
1987 
1988 /*
1989  #] TestSub :
1990  #[ InFunction : WORD InFunction(term,termout)
1991 */
2004 WORD InFunction(PHEAD WORD *term, WORD *termout)
2005 {
2006  GETBIDENTITY
2007  WORD *m, *t, *r, *rr, sign = 1, oldncmod;
2008  WORD *u, *v, *w, *from, *to,
2009  ipp, olddefer = AR.DeferFlag, oldPolyFun = AR.PolyFun, i, j;
2010  LONG numterms;
2011  from = t = term;
2012  r = t + *t - 1;
2013  m = r - ABS(*r) + 1;
2014  t++;
2015  while ( t < m ) {
2016  if ( *t >= FUNCTION+WILDOFFSET ) ipp = *t - WILDOFFSET;
2017  else ipp = *t;
2018  if ( AR.TePos ) {
2019  if ( ( term + AR.TePos ) == t ) {
2020  m = termout;
2021  while ( from < t ) *m++ = *from++;
2022  *m++ = DENOMINATOR;
2023  *m++ = t[1] + 4 + FUNHEAD + ARGHEAD;
2024  *m++ = DIRTYFLAG;
2025  FILLFUN3(m)
2026  *m++ = t[1] + 4 + ARGHEAD;
2027  *m++ = 1;
2028  FILLARG(m)
2029  *m++ = t[1] + 4;
2030  t[3] = -t[3];
2031  v = t + t[1];
2032  while ( t < v ) *m++ = *t++;
2033  from[3] = -from[3];
2034  *m++ = 1;
2035  *m++ = 1;
2036  *m++ = 3;
2037  r = term + *term;
2038  while ( t < r ) *m++ = *t++;
2039  if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2040  *termout = WORDDIF(m,termout);
2041  return(0);
2042  }
2043  }
2044  else if ( ( *t >= FUNCTION && functions[ipp-FUNCTION].spec == 0 )
2045  && ( t[2] & DIRTYFLAG ) == DIRTYFLAG ) {
2046  m = termout;
2047  r = t + t[1];
2048  u = t;
2049  t += FUNHEAD;
2050  oldncmod = AN.ncmod;
2051  while ( t < r ) { /* t points at an argument */
2052  if ( *t > 0 && t[1] ) { /* Argument has been modified */
2053  WORD oldsorttype = AR.SortType;
2054  /* This whole argument must be redone */
2055 
2056  if ( ( AN.ncmod != 0 )
2057  && ( ( AC.modmode & ALSOFUNARGS ) == 0 )
2058  && ( *u != AR.PolyFun ) ) { AN.ncmod = 0; }
2059  AR.DeferFlag = 0;
2060  v = t + *t;
2061  t += ARGHEAD; /* First term */
2062  w = 0; /* to appease the compilers warning devices */
2063  while ( from < t ) {
2064  if ( from == u ) w = m;
2065  *m++ = *from++;
2066  }
2067  to = m;
2068  NewSort(BHEAD0);
2069  if ( *u == AR.PolyFun && AR.PolyFunType == 2 ) {
2070  AR.CompareRoutine = &CompareSymbols;
2071  AR.SortType = SORTHIGHFIRST;
2072  }
2073 /*
2074  AR.PolyFun = 0;
2075 */
2076  while ( t < v ) {
2077  i = *t;
2078  NCOPY(m,t,i);
2079  m = to;
2080  if ( AT.WorkPointer < m+*m ) AT.WorkPointer = m + *m;
2081  if ( Generator(BHEAD m,AR.Cnumlhs) ) {
2082  AN.ncmod = oldncmod;
2083  LowerSortLevel(); goto InFunc;
2084  }
2085  }
2086  /* w = the function */
2087  /* v = the next argument */
2088  /* u = the function */
2089  /* to is new argument */
2090 
2091  to -= ARGHEAD;
2092  if ( EndSort(BHEAD m,1) < 0 ) {
2093  AN.ncmod = oldncmod;
2094  goto InFunc;
2095  }
2096  AR.PolyFun = oldPolyFun;
2097  if ( *u == AR.PolyFun && AR.PolyFunType == 2 ) {
2098  AR.CompareRoutine = &Compare1;
2099  AR.SortType = oldsorttype;
2100  }
2101  while ( *m ) m += *m;
2102  *to = WORDDIF(m,to);
2103  to[1] = 1; /* ??????? or rather 0?. 24-mar-2006 JV */
2104  if ( ToFast(to,to) ) {
2105  if ( *to <= -FUNCTION ) m = to+1;
2106  else m = to+2;
2107  }
2108  w[1] = WORDDIF(m,w) + WORDDIF(r,v);
2109  r = term + *term;
2110  t = v;
2111  while ( t < r ) *m++ = *t++;
2112  if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2113  *termout = WORDDIF(m,termout);
2114  AR.DeferFlag = olddefer;
2115  AN.ncmod = oldncmod;
2116  return(0);
2117  }
2118  else if ( *t == -DOLLAREXPRESSION ) {
2119  if ( AR.Eside == LHSIDE ) {
2120  NEXTARG(t)
2121  AC.lhdollarflag = 1;
2122  }
2123  else {
2124 /*
2125  This whole argument must be redone
2126 */
2127  DOLLARS d = Dollars + t[1];
2128 #ifdef WITHPTHREADS
2129  int nummodopt, dtype = -1;
2130  if ( AS.MultiThreaded ) {
2131  for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2132  if ( t[1] == ModOptdollars[nummodopt].number ) break;
2133  }
2134  if ( nummodopt < NumModOptdollars ) {
2135  dtype = ModOptdollars[nummodopt].type;
2136  if ( dtype == MODLOCAL ) {
2137  d = ModOptdollars[nummodopt].dstruct+AT.identity;
2138  }
2139  else {
2140  LOCK(d->pthreadslockread);
2141  }
2142  }
2143  }
2144 #endif
2145  oldncmod = AN.ncmod;
2146  if ( ( AN.ncmod != 0 )
2147  && ( ( AC.modmode & ALSOFUNARGS ) == 0 )
2148  && ( *u != AR.PolyFun ) ) { AN.ncmod = 0; }
2149  AR.DeferFlag = 0;
2150  v = t + 2;
2151  w = 0; /* to appease the compilers warning devices */
2152  while ( from < t ) {
2153  if ( from == u ) w = m;
2154  *m++ = *from++;
2155  }
2156  to = m;
2157  switch ( d->type ) {
2158  case DOLINDEX:
2159  if ( d->index >= 0 && d->index < AM.OffsetIndex ) {
2160  *m++ = -SNUMBER; *m++ = d->index;
2161  }
2162  else { *m++ = -INDEX; *m++ = d->index; }
2163  break;
2164  case DOLZERO:
2165  *m++ = -SNUMBER; *m++ = 0; break;
2166  case DOLNUMBER:
2167  if ( d->where[0] == 4 &&
2168  ( d->where[1] & MAXPOSITIVE ) == d->where[1] ) {
2169  *m++ = -SNUMBER;
2170  if ( d->where[3] >= 0 ) *m++ = d->where[1];
2171  else *m++ = -d->where[1];
2172  break;
2173  }
2174  /* fall through */
2175  case DOLTERMS:
2176 /*
2177  Here we have the special case of the PolyRatFun
2178  That function may have a different sort of the
2179  terms in the argument.
2180 */
2181  to = m; r = d->where;
2182  *m++ = 0; *m++ = 1;
2183  FILLARG(m)
2184  while ( *r ) {
2185  i = *r; NCOPY(m,r,i)
2186  }
2187  *to = m-to;
2188  if ( ToFast(to,to) ) {
2189  if ( *to <= -FUNCTION ) m = to+1;
2190  else m = to+2;
2191  }
2192  else if ( *u == AR.PolyFun && AR.PolyFunType == 2 ) {
2193  AR.PolyFun = 0;
2194  NewSort(BHEAD0);
2195  AR.CompareRoutine = &CompareSymbols;
2196  r = to + ARGHEAD;
2197  while ( r < m ) {
2198  rr = r; r += *r;
2199  if ( SymbolNormalize(rr) ) goto InFunc;
2200  if ( StoreTerm(BHEAD rr) ) {
2201  AR.CompareRoutine = &Compare1;
2202  LowerSortLevel();
2203  Terminate(-1);
2204  }
2205  }
2206  if ( EndSort(BHEAD to+ARGHEAD,1) < 0 ) goto InFunc;
2207  AR.PolyFun = oldPolyFun;
2208  AR.CompareRoutine = &Compare1;
2209  m = to+ARGHEAD;
2210  if ( *m == 0 ) {
2211  *to = -SNUMBER;
2212  to[1] = 0;
2213  m = to + 2;
2214  }
2215  else {
2216  while ( *m ) m += *m;
2217  *t = m - to;
2218  if ( ToFast(to,to) ) {
2219  if ( *to <= -FUNCTION ) m = to+1;
2220  else m = to+2;
2221  }
2222  }
2223  }
2224  w[1] = w[1] - 2 + (m-to);
2225  break;
2226  case DOLSUBTERM:
2227  to = m; r = d->where;
2228  i = r[1];
2229  *m++ = i+4+ARGHEAD; *m++ = 1;
2230  FILLARG(m)
2231  *m++ = i+4;
2232  while ( --i >= 0 ) *m++ = *r++;
2233  *m++ = 1; *m++ = 1; *m++ = 3;
2234  if ( ToFast(to,to) ) {
2235  if ( *to <= -FUNCTION ) m = to+1;
2236  else m = to+2;
2237  }
2238  w[1] = w[1] - 2 + (m-to);
2239  break;
2240  case DOLARGUMENT:
2241  to = m; r = d->where;
2242  if ( *r > 0 ) {
2243  i = *r - 2;
2244  *m++ = *r++; *m++ = 1; r++;
2245  while ( --i >= 0 ) *m++ = *r++;
2246  }
2247  else if ( *r <= -FUNCTION ) *m++ = *r++;
2248  else { *m++ = *r++; *m++ = *r++; }
2249  w[1] = w[1] - 2 + (m-to);
2250  break;
2251  case DOLWILDARGS:
2252  to = m; r = d->where;
2253  if ( *r > 0 ) { /* Tensor arguments */
2254  i = *r++;
2255  while ( --i >= 0 ) {
2256  if ( *r < 0 ) {
2257  *m++ = -VECTOR; *m++ = *r++;
2258  }
2259  else if ( *r >= AM.OffsetIndex ) {
2260  *m++ = -INDEX; *m++ = *r++;
2261  }
2262  else { *m++ = -SNUMBER; *m++ = *r++; }
2263  }
2264  }
2265  else { /* Regular arguments */
2266  r++;
2267  while ( *r ) {
2268  if ( *r > 0 ) {
2269  i = *r - 2;
2270  *m++ = *r++; *m++ = 1; r++;
2271  while ( --i >= 0 ) *m++ = *r++;
2272  }
2273  else if ( *r <= -FUNCTION ) *m++ = *r++;
2274  else { *m++ = *r++; *m++ = *r++; }
2275  }
2276  }
2277  w[1] = w[1] - 2 + (m-to);
2278  break;
2279  case DOLUNDEFINED:
2280  default:
2281  MLOCK(ErrorMessageLock);
2282  MesPrint("!!!Undefined $-variable: $%s!!!",
2283  AC.dollarnames->namebuffer+d->name);
2284  MUNLOCK(ErrorMessageLock);
2285 #ifdef WITHPTHREADS
2286  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2287 #endif
2288  Terminate(-1);
2289  }
2290 #ifdef WITHPTHREADS
2291  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2292 #endif
2293  r = term + *term;
2294  t = v;
2295  while ( t < r ) *m++ = *t++;
2296  if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2297  *termout = WORDDIF(m,termout);
2298  AR.DeferFlag = olddefer;
2299  AN.ncmod = oldncmod;
2300  return(0);
2301  }
2302  }
2303  else if ( *t == -TERMSINBRACKET ) {
2304  if ( AC.ComDefer ) numterms = CountTerms1(BHEAD0);
2305  else numterms = 1;
2306 /*
2307  Compose the output term
2308  First copy the part till this function argument
2309  m points at the output term space
2310  u points at the start of the function
2311  t points at the start of the argument
2312 */
2313  w = 0;
2314  while ( from < t ) {
2315  if ( from == u ) w = m;
2316  *m++ = *from++;
2317  }
2318  if ( ( numterms & MAXPOSITIVE ) == numterms ) {
2319  *m++ = -SNUMBER; *m++ = numterms & MAXPOSITIVE;
2320  w[1] += 1;
2321  }
2322  else if ( ( i = numterms >> BITSINWORD ) == 0 ) {
2323  *m++ = ARGHEAD+4;
2324  for ( j = 1; j < ARGHEAD; j++ ) *m++ = 0;
2325  *m++ = 4; *m++ = numterms & WORDMASK; *m++ = 1; *m++ = 3;
2326  w[1] += ARGHEAD+3;
2327  }
2328  else {
2329  *m++ = ARGHEAD+6;
2330  for ( j = 1; j < ARGHEAD; j++ ) *m++ = 0;
2331  *m++ = 6; *m++ = numterms & WORDMASK;
2332  *m++ = i; *m++ = 1; *m++ = 0; *m++ = 5;
2333  w[1] += ARGHEAD+5;
2334  }
2335  from++; /* Skip our function */
2336  r = term + *term;
2337  while ( from < r ) *m++ = *from++;
2338  if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2339  *termout = WORDDIF(m,termout);
2340  return(0);
2341  }
2342  else { NEXTARG(t) }
2343  }
2344  t = u;
2345  }
2346  else if ( ( *t >= FUNCTION && functions[ipp-FUNCTION].spec )
2347  && ( t[2] & DIRTYFLAG ) == DIRTYFLAG ) { /* Could be FUNNYDOLLAR */
2348  u = t; v = t + t[1];
2349  t += FUNHEAD;
2350  while ( t < v ) {
2351  if ( *t == FUNNYDOLLAR ) {
2352  if ( AR.Eside != LHSIDE ) {
2353  DOLLARS d = Dollars + t[1];
2354 #ifdef WITHPTHREADS
2355  int nummodopt, dtype = -1;
2356  if ( AS.MultiThreaded ) {
2357  for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2358  if ( t[1] == ModOptdollars[nummodopt].number ) break;
2359  }
2360  if ( nummodopt < NumModOptdollars ) {
2361  dtype = ModOptdollars[nummodopt].type;
2362  if ( dtype == MODLOCAL ) {
2363  d = ModOptdollars[nummodopt].dstruct+AT.identity;
2364  }
2365  else {
2366  LOCK(d->pthreadslockread);
2367  }
2368  }
2369  }
2370 #endif
2371  oldncmod = AN.ncmod;
2372  if ( ( AN.ncmod != 0 )
2373  && ( ( AC.modmode & ALSOFUNARGS ) == 0 )
2374  && ( *u != AR.PolyFun ) ) { AN.ncmod = 0; }
2375  m = termout; w = 0;
2376  while ( from < t ) {
2377  if ( from == u ) w = m;
2378  *m++ = *from++;
2379  }
2380  to = m;
2381  switch ( d->type ) {
2382  case DOLINDEX:
2383  *m++ = d->index; break;
2384  case DOLZERO:
2385  *m++ = 0; break;
2386  case DOLNUMBER:
2387  case DOLTERMS:
2388  if ( d->where[0] == 4 && d->where[4] == 0
2389  && d->where[3] == 3 && d->where[2] == 1
2390  && d->where[1] < AM.OffsetIndex ) {
2391  *m++ = d->where[1];
2392  }
2393  else {
2394 wrongtype:;
2395 #ifdef WITHPTHREADS
2396  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2397 #endif
2398  MLOCK(ErrorMessageLock);
2399  MesPrint("$%s has wrong type for tensor substitution",
2400  AC.dollarnames->namebuffer+d->name);
2401  MUNLOCK(ErrorMessageLock);
2402  AN.ncmod = oldncmod;
2403  return(-1);
2404  }
2405  break;
2406  case DOLARGUMENT:
2407  if ( d->where[0] == -INDEX ) {
2408  *m++ = d->where[1]; break;
2409  }
2410  else if ( d->where[0] == -VECTOR ) {
2411  *m++ = d->where[1]; break;
2412  }
2413  else if ( d->where[0] == -MINVECTOR ) {
2414  *m++ = d->where[1];
2415  sign = -sign;
2416  break;
2417  }
2418  else if ( d->where[0] == -SNUMBER ) {
2419  if ( d->where[1] >= 0
2420  && d->where[1] < AM.OffsetIndex ) {
2421  *m++ = d->where[1]; break;
2422  }
2423  }
2424  goto wrongtype;
2425  case DOLWILDARGS:
2426  if ( d->where[0] > 0 ) {
2427  r = d->where; i = *r++;
2428  while ( --i >= 0 ) *m++ = *r++;
2429  }
2430  else {
2431  r = d->where + 1;
2432  while ( *r ) {
2433  if ( *r == -INDEX ) {
2434  *m++ = r[1]; r += 2; continue;
2435  }
2436  else if ( *r == -VECTOR ) {
2437  *m++ = r[1]; r += 2; continue;
2438  }
2439  else if ( *r == -MINVECTOR ) {
2440  *m++ = r[1]; r += 2;
2441  sign = -sign; continue;
2442  }
2443  else if ( *r == -SNUMBER ) {
2444  if ( r[1] >= 0
2445  && r[1] < AM.OffsetIndex ) {
2446  *m++ = r[1]; r += 2; continue;
2447  }
2448  }
2449  goto wrongtype;
2450  }
2451  }
2452  break;
2453  case DOLSUBTERM:
2454  r = d->where;
2455  if ( *r == INDEX && r[1] == 3 ) {
2456  *m++ = r[2];
2457  }
2458  else goto wrongtype;
2459  break;
2460  case DOLUNDEFINED:
2461 #ifdef WITHPTHREADS
2462  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2463 #endif
2464  MLOCK(ErrorMessageLock);
2465  MesPrint("$%s is undefined in tensor substitution",
2466  AC.dollarnames->namebuffer+d->name);
2467  MUNLOCK(ErrorMessageLock);
2468  AN.ncmod = oldncmod;
2469  return(-1);
2470  }
2471 #ifdef WITHPTHREADS
2472  if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2473 #endif
2474  w[1] = w[1] - 2 + (m-to);
2475  from += 2;
2476  term += *term;
2477  while ( from < term ) *m++ = *from++;
2478  if ( sign < 0 ) m[-1] = -m[-1];
2479  if ( (m-termout) > (LONG)(AM.MaxTer/sizeof(WORD)) ) goto TooLarge;
2480  *termout = m - termout;
2481  AN.ncmod = oldncmod;
2482  return(0);
2483  }
2484  else {
2485  AC.lhdollarflag = 1;
2486  }
2487  }
2488  t++;
2489  }
2490  t = u;
2491  }
2492  t += t[1];
2493  }
2494  MLOCK(ErrorMessageLock);
2495  MesPrint("Internal error in InFunction: Function not encountered.");
2496  if ( AM.tracebackflag ) {
2497  MesPrint("%w: AR.TePos = %d",AR.TePos);
2498  MesPrint("%w: AN.TeInFun = %d",AN.TeInFun);
2499  termout = term;
2500  AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer + AM.MaxTer;
2501  AO.OutSkip = 3;
2502  FiniLine();
2503  i = *termout;
2504  while ( --i >= 0 ) {
2505  TalToLine((UWORD)(*termout++));
2506  TokenToLine((UBYTE *)" ");
2507  }
2508  AO.OutSkip = 0;
2509  FiniLine();
2510  MesCall("InFunction");
2511  }
2512  MUNLOCK(ErrorMessageLock);
2513  return(1);
2514 
2515 InFunc:
2516  MLOCK(ErrorMessageLock);
2517  MesCall("InFunction");
2518  MUNLOCK(ErrorMessageLock);
2519  SETERROR(-1)
2520 
2521 TooLarge:
2522  MLOCK(ErrorMessageLock);
2523  MesPrint("Output term too large. Try to increase MaxTermSize in the setup.");
2524  MesCall("InFunction");
2525  MUNLOCK(ErrorMessageLock);
2526  SETERROR(-1)
2527 }
2528 
2529 /*
2530  #] InFunction :
2531  #[ InsertTerm : WORD InsertTerm(term,replac,extractbuff,position,termout)
2532 */
2550 WORD InsertTerm(PHEAD WORD *term, WORD replac, WORD extractbuff, WORD *position, WORD *termout,
2551  WORD tepos)
2552 {
2553  GETBIDENTITY
2554  WORD *m, *t, *r, i, l2, j;
2555  WORD *u, *v, l1, *coef;
2556  coef = AT.WorkPointer;
2557  if ( ( AT.WorkPointer = coef + 2*AM.MaxTal ) > AT.WorkTop ) {
2558  MLOCK(ErrorMessageLock);
2559  MesWork();
2560  MUNLOCK(ErrorMessageLock);
2561  return(-1);
2562  }
2563  t = term;
2564  r = t + *t;
2565  l1 = l2 = r[-1];
2566  m = r - ABS(l2);
2567  if ( tepos > 0 ) {
2568  t = term + tepos;
2569  goto foundit;
2570  }
2571  t++;
2572  while ( t < m ) {
2573  if ( *t == SUBEXPRESSION && t[2] == replac && t[3] && t[4] == extractbuff ) {
2574  r = t + t[1];
2575  while ( *r == SUBEXPRESSION && r[2] == replac && r[3] && r < m && r[4] == extractbuff ) {
2576  t = r; r += r[1];
2577  }
2578 foundit:;
2579  u = m;
2580  r = term;
2581  m = termout;
2582  do { *m++ = *r++; } while ( r < t );
2583  if ( t[1] > SUBEXPSIZE ) {
2584 /*
2585  if this is a dollar expression there are no wildcards
2586 */
2587  i = *--m;
2588  if ( ( l2 = WildFill(BHEAD m,position,t) ) < 0 ) goto InsCall;
2589  *m = i;
2590  m += l2-1;
2591  l2 = *m;
2592  i = ( j = ABS(l2) ) - 1;
2593  r = coef + i;
2594  do { *--r = *--m; } while ( --i > 0 );
2595  }
2596  else {
2597  v = t;
2598  t = position;
2599  r = t + *t;
2600  l2 = r[-1];
2601  r -= ( j = ABS(l2) );
2602  t++;
2603  if ( t < r ) do { *m++ = *t++; } while ( t < r );
2604  t = v;
2605  }
2606  t += t[1];
2607  while ( t < u && *t == DOLLAREXPR2 ) t += t[1];
2608 ComAct: if ( t < u ) do { *m++ = *t++; } while ( t < u );
2609  if ( *r == 1 && r[1] == 1 && j == 3 ) {
2610  if ( l2 < 0 ) l1 = -l1;
2611  i = ABS(l1)-1;
2612  NCOPY(m,t,i);
2613  *m++ = l1;
2614  }
2615  else {
2616  if ( MulRat(BHEAD (UWORD *)u,REDLENG(l1),(UWORD *)r,REDLENG(l2),
2617  (UWORD *)m,&l1) ) goto InsCall;
2618  l2 = l1;
2619  l2 *= 2;
2620  if ( l2 < 0 ) {
2621  m -= l2;
2622  *m++ = l2-1;
2623  }
2624  else {
2625  m += l2;
2626  *m++ = l2+1;
2627  }
2628  }
2629  *termout = WORDDIF(m,termout);
2630  if ( (*termout)*((LONG)sizeof(WORD)) > AM.MaxTer ) {
2631  MLOCK(ErrorMessageLock);
2632  MesPrint("Term too complex during substitution. MaxTermSize of %l is too small",AM.MaxTer);
2633  goto InsCall2;
2634  }
2635  AT.WorkPointer = coef;
2636  return(0);
2637  }
2638  t += t[1];
2639  }
2640 /*
2641  The next action is for when there is no subexpression pointer.
2642  We append the extra term. Effectively the routine becomes now a
2643  merge routine for two terms.
2644 */
2645  v = t;
2646  u = m;
2647  r = term;
2648  m = termout;
2649  do { *m++ = *r++; } while ( r < t );
2650  t = position;
2651  r = t + *t;
2652  l2 = r[-1];
2653  r -= ( j = ABS(l2) );
2654  t++;
2655  if ( t < r ) do { *m++ = *t++; } while ( t < r );
2656  t = v;
2657  goto ComAct;
2658 
2659 InsCall:
2660  MLOCK(ErrorMessageLock);
2661 InsCall2:
2662  MesCall("InsertTerm");
2663  MUNLOCK(ErrorMessageLock);
2664  SETERROR(-1)
2665 }
2666 
2667 /*
2668  #] InsertTerm :
2669  #[ PasteFile : WORD PasteFile(num,acc,pos,accf,renum,freeze,nexpr)
2670 */
2686 LONG PasteFile(PHEAD WORD number, WORD *accum, POSITION *position, WORD **accfill,
2687  RENUMBER renumber, WORD *freeze, WORD nexpr)
2688 {
2689  GETBIDENTITY
2690  WORD *r, l, *m, i;
2691  WORD *stop, *s1, *s2;
2692 /* POSITION AccPos; bug 12-apr-2008 JV */
2693  WORD InCompState;
2694  WORD *oldipointer;
2695  LONG retlength;
2696  stop = (WORD *)(((UBYTE *)(accum)) + 2*AM.MaxTer);
2697  *accum++ = number;
2698  while ( --number >= 0 ) accum += *accum;
2699  if ( freeze ) {
2700 /* AccPos = *position; bug 12-apr-2008 JV */
2701  oldipointer = AR.CompressPointer;
2702  do {
2703  AR.CompressPointer = oldipointer;
2704 /* if ( ( l = GetFromStore(accum,&AccPos,renumber,&InCompState,nexpr) ) < 0 ) bug 12-apr-2008 JV */
2705  if ( ( l = GetFromStore(accum,position,renumber,&InCompState,nexpr) ) < 0 )
2706  goto PasErr;
2707  if ( !l ) { *accum = 0; return(0); }
2708  r = accum;
2709  m = r + *r;
2710  m -= ABS(m[-1]);
2711  r++;
2712  while ( r < m && *r != HAAKJE ) r += r[1];
2713  if ( r >= m ) {
2714  if ( *freeze != 4 ) l = -1;
2715  }
2716  else {
2717 /*
2718  The algorithm for accepting terms with a given (freeze)
2719  representation outside brackets is rather crude. A refinement
2720  would be to store the part outside the bracket and skip the
2721  term when this part doesn't alter (and is unacceptable).
2722  Once accepting one can keep accepting till the bracket alters
2723  and then one may stop the generation. It is necessary to
2724  set up a struct to remember the bracket and the progress
2725  status.
2726 */
2727  m = AT.WorkPointer;
2728  s2 = r;
2729  r = accum;
2730  *m++ = WORDDIF(s2,r) + 3;
2731  r++;
2732  while ( r < s2 ) *m++ = *r++;
2733  *m++ = 1; *m++ = 1; *m++ = 3;
2734  m = AT.WorkPointer;
2735  if ( Normalize(BHEAD AT.WorkPointer) ) goto PasErr;
2736  r = freeze;
2737  i = *m;
2738  while ( --i >= 0 && *m++ == *r++ ) {}
2739  if ( i > 0 ) {
2740  l = -1;
2741  }
2742  else { /* Term to be accepted */
2743  r = accum;
2744  s1 = r + *r;
2745  r++;
2746  m = s2;
2747  m += m[1];
2748  do { *r++ = *m++; } while ( m < s1 );
2749  *accum = l = WORDDIF(r,accum);
2750  }
2751  }
2752  } while ( l < 0 );
2753  retlength = InCompState;
2754 /* retlength = DIFBASE(AccPos,*position) / sizeof(WORD); bug 12-apr-2008 JV */
2755  }
2756  else {
2757  if ( ( l = GetFromStore(accum,position,renumber,&InCompState,nexpr) ) < 0 ) {
2758  MLOCK(ErrorMessageLock);
2759  MesCall("PasteFile");
2760  MUNLOCK(ErrorMessageLock);
2761  SETERROR(-1)
2762  }
2763  if ( l == 0 ) { *accum = 0; return(0); }
2764  retlength = InCompState;
2765  }
2766  accum += l;
2767  if ( accum > stop ) {
2768  MLOCK(ErrorMessageLock);
2769  MesPrint("Buffer too small in PasteFile");
2770  MUNLOCK(ErrorMessageLock);
2771  SETERROR(-1)
2772  }
2773  *accum = 0;
2774  *accfill = accum;
2775  return(retlength);
2776 PasErr:
2777  MLOCK(ErrorMessageLock);
2778  MesCall("PasteFile");
2779  MUNLOCK(ErrorMessageLock);
2780  SETERROR(-1)
2781 }
2782 
2783 /*
2784  #] PasteFile :
2785  #[ PasteTerm : WORD PasteTerm(number,accum,position,times,divby)
2786 */
2808 WORD *PasteTerm(PHEAD WORD number, WORD *accum, WORD *position, WORD times, WORD divby)
2809 {
2810  GETBIDENTITY
2811  WORD *t, *r, x, y, z;
2812  WORD *m, *u, l1, a[2];
2813  m = (WORD *)(((UBYTE *)(accum)) + AM.MaxTer);
2814 /* m = (WORD *)(((UBYTE *)(accum)) + 2*AM.MaxTer); */
2815  *accum++ = number;
2816  while ( --number >= 0 ) accum += *accum;
2817  if ( times == divby ) {
2818  t = position;
2819  r = t + *t;
2820  if ( t < r ) do { *accum++ = *t++; } while ( t < r );
2821  }
2822  else {
2823  u = accum;
2824  t = position;
2825  r = t + *t - 1;
2826  l1 = *r;
2827  r -= ABS(*r) - 1;
2828  if ( t < r ) do { *accum++ = *t++; } while ( t < r );
2829  if ( divby > times ) { x = divby; y = times; }
2830  else { x = times; y = divby; }
2831  z = x%y;
2832  while ( z ) { x = y; y = z; z = x%y; }
2833  if ( y != 1 ) { divby /= y; times /= y; }
2834  a[1] = divby;
2835  a[0] = times;
2836  if ( MulRat(BHEAD (UWORD *)t,REDLENG(l1),(UWORD *)a,1,(UWORD *)accum,&l1) ) {
2837  MLOCK(ErrorMessageLock);
2838  MesCall("PasteTerm");
2839  MUNLOCK(ErrorMessageLock);
2840  return(0);
2841  }
2842  x = l1;
2843  x *= 2;
2844  if ( x < 0 ) { accum -= x; *accum++ = x - 1; }
2845  else { accum += x; *accum++ = x + 1; }
2846  *u = WORDDIF(accum,u);
2847  }
2848  if ( accum >= m ) {
2849  MLOCK(ErrorMessageLock);
2850  MesPrint("Buffer too small in PasteTerm");
2851  MUNLOCK(ErrorMessageLock);
2852  return(0);
2853  }
2854  *accum = 0;
2855  return(accum);
2856 }
2857 
2858 /*
2859  #] PasteTerm :
2860  #[ FiniTerm : WORD FiniTerm(term,accum,termout,number)
2861 */
2873 WORD FiniTerm(PHEAD WORD *term, WORD *accum, WORD *termout, WORD number, WORD tepos)
2874 {
2875  GETBIDENTITY
2876  WORD *m, *t, *r, i, numacc, l2, ipp;
2877  WORD *u, *v, l1, *coef = AT.WorkPointer, *oldaccum;
2878  if ( ( AT.WorkPointer = coef + 2*AM.MaxTal ) > AT.WorkTop ) {
2879  MLOCK(ErrorMessageLock);
2880  MesWork();
2881  MUNLOCK(ErrorMessageLock);
2882  return(-1);
2883  }
2884  oldaccum = accum;
2885  t = term;
2886  m = t + *t - 1;
2887  l1 = REDLENG(*m);
2888  i = ABS(*m) - 1;
2889  r = coef + i;
2890  do { *--r = *--m; } while ( --i > 0 ); /* Copies coefficient */
2891  if ( tepos > 0 ) {
2892  t = term + tepos;
2893  goto foundit;
2894  }
2895  t++;
2896  if ( t < m ) do {
2897  if ( ( ( *t == SUBEXPRESSION && ( *(r=t+t[1]) != SUBEXPRESSION
2898  || r >= m || !r[3] ) ) || *t == EXPRESSION ) && t[2] == number && t[3] ) {
2899 foundit:;
2900  u = m;
2901  r = term;
2902  m = termout;
2903  if ( r < t ) do { *m++ = *r++; } while ( r < t );
2904  numacc = *accum++;
2905  if ( numacc >= 0 ) do {
2906  if ( *t == EXPRESSION ) {
2907  v = t + t[1];
2908  r = t + SUBEXPSIZE;
2909  while ( r < v ) {
2910  if ( *r == WILDCARDS ) {
2911  r += 2;
2912  i = *--m;
2913  if ( ( l2 = WildFill(BHEAD m,accum,r) ) < 0 ) goto FiniCall;
2914  goto AllWild;
2915  }
2916  r += r[1];
2917  }
2918  goto NoWild;
2919  }
2920  else if ( t[1] > SUBEXPSIZE && t[SUBEXPSIZE] != FROMBRAC ) {
2921  i = *--m;
2922  if ( ( l2 = WildFill(BHEAD m,accum,t) ) < 0 ) goto FiniCall;
2923 AllWild: *m = i;
2924  m += l2-1;
2925  l2 = *m;
2926  m -= ABS(l2) - 1;
2927  r = m;
2928  }
2929  else {
2930 NoWild: r = accum;
2931  v = r + *r - 1;
2932  l2 = *v;
2933  v -= ABS(l2) - 1;
2934  r++;
2935  if ( r < v ) do { *m++ = *r++; } while ( r < v );
2936  }
2937  if ( *r == 1 && r[1] == 1 && ABS(l2) == 3 ) {
2938  if ( l2 < 0 ) l1 = -l1;
2939  }
2940  else {
2941  l2 = REDLENG(l2);
2942  if ( l2 == 0 ) {
2943  t = oldaccum;
2944  numacc = *t++;
2945  AO.OutSkip = 3;
2946  FiniLine();
2947  while ( --numacc >= 0 ) {
2948  i = *t;
2949  while ( --i >= 0 ) {
2950  TalToLine((UWORD)(*t++));
2951  TokenToLine((UBYTE *)" ");
2952  }
2953  }
2954  AO.OutSkip = 0;
2955  FiniLine();
2956  goto FiniCall;
2957  }
2958  if ( MulRat(BHEAD (UWORD *)coef,l1,(UWORD *)r,l2,(UWORD *)coef,&l1) ) goto FiniCall;
2959  if ( AN.ncmod != 0 && TakeModulus((UWORD *)coef,&l1,AC.cmod,AN.ncmod,UNPACK|AC.modmode) ) goto FiniCall;
2960  }
2961  accum += *accum;
2962  } while ( --numacc >= 0 );
2963  if ( *t == SUBEXPRESSION ) {
2964  while ( t+t[1] < u && t[t[1]] == DOLLAREXPR2 ) t += t[1];
2965  }
2966  t += t[1];
2967  if ( t < u ) do { *m++ = *t++; } while ( t < u );
2968  l2 = l1;
2969 /*
2970  Code to economize when taking x = (a+b)/2
2971 */
2972  r = termout+1;
2973  while ( r < m ) {
2974  if ( *r == SUBEXPRESSION ) {
2975  t = r + r[1];
2976  l1 = (WORD)(cbuf[r[4]].CanCommu[r[2]]);
2977  while ( t < m ) {
2978  if ( *t == SUBEXPRESSION &&
2979  t[1] == r[1] && t[2] == r[2] && t[4] == r[4] ) {
2980  i = t[1] - SUBEXPSIZE;
2981  u = r + SUBEXPSIZE; v = t + SUBEXPSIZE;
2982  while ( i > 0 ) {
2983  if ( *v++ != *u++ ) break;
2984  i--;
2985  }
2986  if ( i <= 0 ) {
2987  u = r;
2988  r[3] += t[3];
2989  r = t + t[1];
2990  while ( r < m ) *t++ = *r++;
2991  m = t;
2992  r = u;
2993  goto Nextr;
2994  }
2995  if ( l1 && cbuf[t[4]].CanCommu[t[2]] ) break;
2996  while ( t+t[1] < m && t[t[1]] == DOLLAREXPR2 ) t += t[1];
2997  }
2998  else if ( l1 ) {
2999  if ( *t == SUBEXPRESSION && cbuf[t[4]].CanCommu[t[2]] )
3000  break;
3001  if ( *t >= FUNCTION+WILDOFFSET )
3002  ipp = *t - WILDOFFSET;
3003  else ipp = *t;
3004  if ( *t >= FUNCTION
3005  && functions[ipp-FUNCTION].commute && l1 ) break;
3006  if ( *t == EXPRESSION ) break;
3007  }
3008  t += t[1];
3009  }
3010  r += r[1];
3011  }
3012  else r += r[1];
3013 Nextr:;
3014  }
3015 
3016  i = ABS(l2);
3017  i *= 2;
3018  i++;
3019  l2 = ( l2 >= 0 ) ? i: -i;
3020  r = coef;
3021  while ( --i > 0 ) *m++ = *r++;
3022  *m++ = l2;
3023  *termout = WORDDIF(m,termout);
3024  AT.WorkPointer = coef;
3025  return(0);
3026  }
3027  t += t[1];
3028  } while ( t < m );
3029  AT.WorkPointer = coef;
3030  return(1);
3031 
3032 FiniCall:
3033  MLOCK(ErrorMessageLock);
3034  MesCall("FiniTerm");
3035  MUNLOCK(ErrorMessageLock);
3036  SETERROR(-1)
3037 }
3038 
3039 /*
3040  #] FiniTerm :
3041  #[ Generator : WORD Generator(BHEAD term,level)
3042 */
3043 
3044 static WORD zeroDollar[] = { 0, 0 };
3045 /*
3046 static LONG debugcounter = 0;
3047 */
3048 
3072 WORD Generator(PHEAD WORD *term, WORD level)
3073 {
3074  GETBIDENTITY
3075  WORD replac, *accum, *termout, *t, i, j, tepos, applyflag = 0, *StartBuf;
3076  WORD *a, power, power1, DumNow = AR.CurDum, oldtoprhs, oldatoprhs, retnorm, extractbuff;
3077  int *RepSto = AN.RepPoint, iscopy = 0;
3078  CBUF *C = cbuf+AM.rbufnum, *CC = cbuf + AT.ebufnum, *CCC = cbuf + AT.aebufnum;
3079  LONG posisub, oldcpointer, oldacpointer;
3080  DOLLARS d = 0;
3081  WORD numfac[5], idfunctionflag;
3082 #ifdef WITHPTHREADS
3083  int nummodopt, dtype = -1, id;
3084 #endif
3085  oldtoprhs = CC->numrhs;
3086  oldcpointer = CC->Pointer - CC->Buffer;
3087  oldatoprhs = CCC->numrhs;
3088  oldacpointer = CCC->Pointer - CCC->Buffer;
3089 ReStart:
3090  if ( ( replac = TestSub(BHEAD term,level) ) == 0 ) {
3091  if ( applyflag ) { TableReset(); applyflag = 0; }
3092 /*
3093  if ( AN.PolyNormFlag > 1 ) {
3094  if ( PolyFunMul(BHEAD term) < 0 ) goto GenCall;
3095  AN.PolyNormFlag = 0;
3096  if ( !*term ) goto Return0;
3097  }
3098 */
3099 Renormalize:
3100  AN.PolyNormFlag = 0;
3101  AN.idfunctionflag = 0;
3102  if ( ( retnorm = Normalize(BHEAD term) ) != 0 ) {
3103  if ( retnorm > 0 ) {
3104  if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
3105  goto ReStart;
3106  }
3107  goto GenCall;
3108  }
3109  idfunctionflag = AN.idfunctionflag;
3110  if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3111 
3112  if ( AN.PolyNormFlag ) {
3113  if ( AN.PolyFunTodo == 0 ) {
3114  if ( PolyFunMul(BHEAD term) < 0 ) goto GenCall;
3115  if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3116  }
3117  else {
3118  WORD oldPolyFunExp = AR.PolyFunExp;
3119  AR.PolyFunExp = 0;
3120  if ( PolyFunMul(BHEAD term) < 0 ) goto GenCall;
3121  AT.WorkPointer = term+*term;
3122  AR.PolyFunExp = oldPolyFunExp;
3123  if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3124  if ( Normalize(BHEAD term) < 0 ) goto GenCall;
3125  if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3126  AT.WorkPointer = term+*term;
3127  if ( AN.PolyNormFlag ) {
3128  if ( PolyFunMul(BHEAD term) < 0 ) goto GenCall;
3129  if ( !*term ) { AN.PolyNormFlag = 0; goto Return0; }
3130  AT.WorkPointer = term+*term;
3131  }
3132  AN.PolyFunTodo = 0;
3133  }
3134  }
3135  if ( idfunctionflag > 0 ) {
3136  if ( TakeIDfunction(BHEAD term) ) {
3137  AT.WorkPointer = term + *term;
3138  goto ReStart;
3139  }
3140  }
3141  if ( AT.WorkPointer < (WORD *)(((UBYTE *)(term)) + AM.MaxTer) )
3142  AT.WorkPointer = (WORD *)(((UBYTE *)(term)) + AM.MaxTer);
3143  do {
3144 SkipCount: level++;
3145  if ( level > AR.Cnumlhs ) {
3146  if ( AR.DeferFlag && AR.sLevel <= 0 ) {
3147 #ifdef WITHMPI
3148  if ( PF.me != MASTER && AC.mparallelflag == PARALLELFLAG && PF.exprtodo < 0 ) {
3149  if ( PF_Deferred(term,level) ) goto GenCall;
3150  }
3151  else
3152 #endif
3153  if ( Deferred(BHEAD term,level) ) goto GenCall;
3154  goto Return0;
3155  }
3156  if ( AN.ncmod != 0 ) {
3157  if ( Modulus(term) ) goto GenCall;
3158  if ( !*term ) goto Return0;
3159  }
3160  if ( AR.CurDum > AM.IndDum && AR.sLevel <= 0 ) {
3161  WORD olddummies = AN.IndDum;
3162  AN.IndDum = AM.IndDum;
3163  ReNumber(BHEAD term); Normalize(BHEAD term);
3164  AN.IndDum = olddummies;
3165  if ( !*term ) goto Return0;
3166  olddummies = DetCurDum(BHEAD term);
3167  if ( olddummies > AR.MaxDum ) AR.MaxDum = olddummies;
3168  }
3169  if ( AR.PolyFun > 0 && ( AR.sLevel <= 0 || AN.FunSorts[AR.sLevel]->PolyFlag > 0 ) ) {
3170  if ( PrepPoly(BHEAD term,0) != 0 ) goto Return0;
3171  }
3172  else if ( AR.PolyFun > 0 ) {
3173  if ( PrepPoly(BHEAD term,1) != 0 ) goto Return0;
3174  }
3175  if ( AR.sLevel <= 0 && AR.BracketOn ) {
3176  if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
3177  termout = AT.WorkPointer;
3178  if ( AT.WorkPointer + *term + 3 > AT.WorkTop ) goto OverWork;
3179  if ( PutBracket(BHEAD term) ) return(-1);
3180  AN.RepPoint = RepSto;
3181  *AT.WorkPointer = 0;
3182  i = StoreTerm(BHEAD termout);
3183  AT.WorkPointer = termout;
3184  CC->numrhs = oldtoprhs;
3185  CC->Pointer = CC->Buffer + oldcpointer;
3186  CCC->numrhs = oldatoprhs;
3187  CCC->Pointer = CCC->Buffer + oldacpointer;
3188  return(i);
3189  }
3190  else {
3191  if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
3192  if ( AT.WorkPointer >= AT.WorkTop ) goto OverWork;
3193  *AT.WorkPointer = 0;
3194  AN.RepPoint = RepSto;
3195  i = StoreTerm(BHEAD term);
3196  CC->numrhs = oldtoprhs;
3197  CC->Pointer = CC->Buffer + oldcpointer;
3198  CCC->numrhs = oldatoprhs;
3199  CCC->Pointer = CCC->Buffer + oldacpointer;
3200  return(i);
3201  }
3202  }
3203  i = C->lhs[level][0];
3204  if ( i >= TYPECOUNT ) {
3205 /*
3206  #[ Special action :
3207 */
3208  switch ( i ) {
3209  case TYPECOUNT:
3210  if ( CountDo(term,C->lhs[level]) < C->lhs[level][2] ) {
3211  AT.WorkPointer = term + *term;
3212  goto Return0;
3213  }
3214  break;
3215  case TYPEMULT:
3216  if ( MultDo(BHEAD term,C->lhs[level]) ) goto GenCall;
3217  goto ReStart;
3218  case TYPEGOTO:
3219  level = AC.Labels[C->lhs[level][2]];
3220  break;
3221  case TYPEDISCARD:
3222  AT.WorkPointer = term + *term;
3223  goto Return0;
3224  case TYPEIF:
3225 #ifdef WITHPTHREADS
3226  {
3227 /*
3228  We may be writing in the space here when wildcards
3229  are involved in a match(). Hence we have to make
3230  a private copy here!!!!
3231 */
3232  WORD ic, jc, *ifcode, *jfcode;
3233  jfcode = C->lhs[level]; jc = jfcode[1];
3234  ifcode = AT.WorkPointer; AT.WorkPointer += jc;
3235  for ( ic = 0; ic < jc; ic++ ) ifcode[ic] = jfcode[ic];
3236  while ( !DoIfStatement(BHEAD ifcode,term) ) {
3237  level = C->lhs[level][2];
3238  if ( C->lhs[level][0] != TYPEELIF ) break;
3239  }
3240  AT.WorkPointer = ifcode;
3241  }
3242 #else
3243  while ( !DoIfStatement(BHEAD C->lhs[level],term) ) {
3244  level = C->lhs[level][2];
3245  if ( C->lhs[level][0] != TYPEELIF ) break;
3246  }
3247 #endif
3248  break;
3249  case TYPEELIF:
3250  do {
3251  level = C->lhs[level][2];
3252  } while ( C->lhs[level][0] == TYPEELIF );
3253  break;
3254  case TYPEELSE:
3255  case TYPEENDIF:
3256  level = C->lhs[level][2];
3257  break;
3258  case TYPESUMFIX:
3259  {
3260  WORD *cp = AR.CompressPointer, *op = AR.CompressPointer;
3261  WORD *tlhs = C->lhs[level] + 3, *m, jlhs;
3262  WORD theindex = C->lhs[level][2];
3263  if ( theindex < 0 ) { /* $-variable */
3264 #ifdef WITHPTHREADS
3265  int ddtype = -1;
3266  theindex = -theindex;
3267  d = Dollars + theindex;
3268  if ( AS.MultiThreaded ) {
3269  for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3270  if ( theindex == ModOptdollars[nummodopt].number ) break;
3271  }
3272  if ( nummodopt < NumModOptdollars ) {
3273  ddtype = ModOptdollars[nummodopt].type;
3274  if ( ddtype == MODLOCAL ) {
3275  d = ModOptdollars[nummodopt].dstruct+AT.identity;
3276  }
3277  else {
3278  LOCK(d->pthreadslockread);
3279  }
3280  }
3281  }
3282 #else
3283  theindex = -theindex;
3284  d = Dollars + theindex;
3285 #endif
3286 
3287  if ( d->type != DOLINDEX
3288  || d->index < AM.OffsetIndex
3289  || d->index >= AM.OffsetIndex + WILDOFFSET ) {
3290  MLOCK(ErrorMessageLock);
3291  MesPrint("$%s should have been an index"
3292  ,AC.dollarnames->namebuffer+d->name);
3293  AN.currentTerm = term;
3294  MesPrint("Current term: %t");
3295  AN.listinprint = printscratch;
3296  printscratch[0] = DOLLAREXPRESSION;
3297  printscratch[1] = theindex;
3298  MesPrint("$%s = %$"
3299  ,AC.dollarnames->namebuffer+d->name);
3300  MUNLOCK(ErrorMessageLock);
3301 #ifdef WITHPTHREADS
3302  if ( ddtype > 0 && ddtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3303 #endif
3304  goto GenCall;
3305  }
3306  theindex = d->index;
3307 #ifdef WITHPTHREADS
3308  if ( ddtype > 0 && ddtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3309 #endif
3310  }
3311  cp[1] = SUBEXPSIZE+4;
3312  cp += SUBEXPSIZE;
3313  *cp++ = INDTOIND;
3314  *cp++ = 4;
3315  *cp++ = theindex;
3316  i = C->lhs[level][1] - 3;
3317  cp++;
3318  AR.CompressPointer = cp;
3319  while ( --i >= 0 ) {
3320  cp[-1] = *tlhs++;
3321  termout = AT.WorkPointer;
3322  if ( ( jlhs = WildFill(BHEAD termout,term,op)) < 0 )
3323  goto GenCall;
3324  m = term;
3325  jlhs = *m;
3326  while ( --jlhs >= 0 ) {
3327  if ( *m++ != *termout++ ) break;
3328  }
3329  if ( jlhs >= 0 ) {
3330  termout = AT.WorkPointer;
3331  AT.WorkPointer = termout + *termout;
3332  if ( Generator(BHEAD termout,level) ) goto GenCall;
3333  AT.WorkPointer = termout;
3334  }
3335  else {
3336  AR.CompressPointer = op;
3337  goto SkipCount;
3338  }
3339  }
3340  AR.CompressPointer = op;
3341  goto CommonEnd;
3342  }
3343  case TYPESUM:
3344  {
3345  WORD *wp, *cp = AR.CompressPointer, *op = AR.CompressPointer;
3346  WORD theindex;
3347  WORD *ow;
3348 /*
3349  At this point it is safest to determine CurDum
3350 */
3351  AR.CurDum = DetCurDum(BHEAD term);
3352  i = C->lhs[level][1]-2;
3353  wp = C->lhs[level] + 2;
3354  cp[1] = SUBEXPSIZE+4*i;
3355  cp += SUBEXPSIZE;
3356  while ( --i >= 0 ) {
3357  theindex = *wp++;
3358  if ( theindex < 0 ) { /* $-variable */
3359 #ifdef WITHPTHREADS
3360  int ddtype = -1;
3361  theindex = -theindex;
3362  d = Dollars + theindex;
3363  if ( AS.MultiThreaded ) {
3364  for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3365  if ( theindex == ModOptdollars[nummodopt].number ) break;
3366  }
3367  if ( nummodopt < NumModOptdollars ) {
3368  ddtype = ModOptdollars[nummodopt].type;
3369  if ( ddtype == MODLOCAL ) {
3370  d = ModOptdollars[nummodopt].dstruct+AT.identity;
3371  }
3372  else {
3373  LOCK(d->pthreadslockread);
3374  }
3375  }
3376  }
3377 #else
3378  theindex = -theindex;
3379  d = Dollars + theindex;
3380 #endif
3381  if ( d->type != DOLINDEX
3382  || d->index < AM.OffsetIndex
3383  || d->index >= AM.OffsetIndex + WILDOFFSET ) {
3384  MLOCK(ErrorMessageLock);
3385  MesPrint("$%s should have been an index"
3386  ,AC.dollarnames->namebuffer+d->name);
3387  AN.currentTerm = term;
3388  MesPrint("Current term: %t");
3389  AN.listinprint = printscratch;
3390  printscratch[0] = DOLLAREXPRESSION;
3391  printscratch[1] = theindex;
3392  MesPrint("$%s = %$"
3393  ,AC.dollarnames->namebuffer+d->name);
3394  MUNLOCK(ErrorMessageLock);
3395 #ifdef WITHPTHREADS
3396  if ( ddtype > 0 && ddtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3397 #endif
3398  goto GenCall;
3399  }
3400  theindex = d->index;
3401 #ifdef WITHPTHREADS
3402  if ( ddtype > 0 && ddtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3403 #endif
3404  }
3405  *cp++ = INDTOIND;
3406  *cp++ = 4;
3407  *cp++ = theindex;
3408  *cp++ = ++AR.CurDum;
3409  }
3410  ow = AT.WorkPointer;
3411  AR.CompressPointer = cp;
3412  if ( WildFill(BHEAD ow,term,op) < 0 ) goto GenCall;
3413  AR.CompressPointer = op;
3414  i = ow[0];
3415  for ( j = 0; j < i; j++ ) term[j] = ow[j];
3416  AT.WorkPointer = ow;
3417  ReNumber(BHEAD term);
3418  goto Renormalize;
3419  }
3420  case TYPECHISHOLM:
3421  if ( Chisholm(BHEAD term,level) ) goto GenCall;
3422 CommonEnd:
3423  AT.WorkPointer = term + *term;
3424  goto Return0;
3425  case TYPEARG:
3426  if ( ( i = execarg(BHEAD term,level) ) < 0 ) goto GenCall;
3427  level = C->lhs[level][2];
3428  if ( i > 0 ) goto ReStart;
3429  break;
3430  case TYPENORM:
3431  case TYPENORM2:
3432  case TYPENORM3:
3433  case TYPENORM4:
3434  case TYPESPLITARG:
3435  case TYPESPLITARG2:
3436  case TYPESPLITFIRSTARG:
3437  case TYPESPLITLASTARG:
3438  case TYPEARGTOEXTRASYMBOL:
3439  if ( execarg(BHEAD term,level) < 0 ) goto GenCall;
3440  level = C->lhs[level][2];
3441  break;
3442  case TYPEFACTARG:
3443  case TYPEFACTARG2:
3444  { WORD jjj;
3445  if ( ( jjj = execarg(BHEAD term,level) ) < 0 ) goto GenCall;
3446  if ( jjj > 0 ) goto ReStart;
3447  level = C->lhs[level][2];
3448  break; }
3449  case TYPEEXIT:
3450  if ( C->lhs[level][2] > 0 ) {
3451  MLOCK(ErrorMessageLock);
3452  MesPrint("%s",C->lhs[level]+3);
3453  MUNLOCK(ErrorMessageLock);
3454  }
3455  Terminate(-1);
3456  goto GenCall;
3457  case TYPESETEXIT:
3458  AM.exitflag = 1; /* no danger of race conditions */
3459  break;
3460  case TYPEPRINT:
3461  AN.currentTerm = term;
3462  AN.numlistinprint = (C->lhs[level][1] - C->lhs[level][4] - 5)/2;
3463  AN.listinprint = C->lhs[level]+5+C->lhs[level][4];
3464  MLOCK(ErrorMessageLock);
3465  AO.ErrorBlock = 1;
3466  MesPrint((char *)(C->lhs[level]+5));
3467  AO.ErrorBlock = 0;
3468  MUNLOCK(ErrorMessageLock);
3469  break;
3470  case TYPEFPRINT:
3471  {
3472  int oldFOflag;
3473  WORD oldPrintType, oldLogHandle = AC.LogHandle;
3474  AC.LogHandle = C->lhs[level][2];
3475  MLOCK(ErrorMessageLock);
3476  oldFOflag = AM.FileOnlyFlag;
3477  oldPrintType = AO.PrintType;
3478  if ( AC.LogHandle >= 0 ) {
3479  AM.FileOnlyFlag = 1;
3480  AO.PrintType |= PRINTLFILE;
3481  }
3482  AO.PrintType |= C->lhs[level][3];
3483  AN.currentTerm = term;
3484  AN.numlistinprint = (C->lhs[level][1] - C->lhs[level][4] - 5)/2;
3485  AN.listinprint = C->lhs[level]+5+C->lhs[level][4];
3486  MesPrint((char *)(C->lhs[level]+5));
3487  AO.PrintType = oldPrintType;
3488  AM.FileOnlyFlag = oldFOflag;
3489  MUNLOCK(ErrorMessageLock);
3490  AC.LogHandle = oldLogHandle;
3491  }
3492  break;
3493  case TYPEREDEFPRE:
3494  j = C->lhs[level][2];
3495 #ifdef WITHMPI
3496  {
3497  /*
3498  * Regardless of parallel/nonparallel switch, we need to set
3499  * AC.inputnumbers[ii], which indicates that the corresponding
3500  * preprocessor variable is redefined and so we need to
3501  * send/broadcast it.
3502  */
3503  int ii;
3504  for ( ii = 0; ii < AC.numpfirstnum; ii++ ) {
3505  if ( AC.pfirstnum[ii] == j ) break;
3506  }
3507  AC.inputnumbers[ii] = AN.ninterms;
3508  }
3509 #endif
3510 #ifdef WITHPTHREADS
3511  if ( AS.MultiThreaded ) {
3512  int ii;
3513  for ( ii = 0; ii < AC.numpfirstnum; ii++ ) {
3514  if ( AC.pfirstnum[ii] == j ) break;
3515  }
3516  if ( AN.inputnumber < AC.inputnumbers[ii] ) break;
3517  LOCK(AP.PreVarLock);
3518  if ( AN.inputnumber >= AC.inputnumbers[ii] ) {
3519  a = C->lhs[level]+4;
3520  if ( a[a[-1]] == 0 )
3521  PutPreVar(PreVar[j].name,(UBYTE *)(a),0,1);
3522  else
3523  PutPreVar(PreVar[j].name,(UBYTE *)(a)
3524  ,(UBYTE *)(a+a[-1]+1),1);
3525 /*
3526  PutPreVar(PreVar[j].name,(UBYTE *)(C->lhs[level]+4),0,1);
3527 */
3528  AC.inputnumbers[ii] = AN.inputnumber;
3529  }
3530  UNLOCK(AP.PreVarLock);
3531  }
3532  else
3533 #endif
3534  {
3535  a = C->lhs[level]+4;
3536  LOCK(AP.PreVarLock);
3537  if ( a[a[-1]] == 0 )
3538  PutPreVar(PreVar[j].name,(UBYTE *)(a),0,1);
3539  else
3540  PutPreVar(PreVar[j].name,(UBYTE *)(a)
3541  ,(UBYTE *)(a+a[-1]+1),1);
3542  UNLOCK(AP.PreVarLock);
3543  }
3544  break;
3545  case TYPERENUMBER:
3546  AT.WorkPointer = term + *term;
3547  if ( FullRenumber(BHEAD term,C->lhs[level][2]) ) goto GenCall;
3548  AT.WorkPointer = term + *term;
3549  if ( *term == 0 ) goto Return0;
3550  break;
3551  case TYPETRY:
3552  if ( TryDo(BHEAD term,C->lhs[level],level) ) goto GenCall;
3553  AT.WorkPointer = term + *term;
3554  goto Return0;
3555  case TYPEASSIGN:
3556  { WORD onc = AR.NoCompress, oldEside = AR.Eside;
3557  WORD oldrepeat = *AN.RepPoint;
3558 /*
3559  Here we have to assign an expression to a $ variable.
3560 */
3561  AR.Eside = RHSIDE;
3562  AR.NoCompress = 1;
3563  AN.cTerm = AN.currentTerm = term;
3564  AT.WorkPointer = term + *term;
3565  *AT.WorkPointer++ = 0;
3566  if ( AssignDollar(BHEAD term,level) ) goto GenCall;
3567  AT.WorkPointer = term + *term;
3568  AN.cTerm = 0;
3569  *AN.RepPoint = oldrepeat;
3570  AR.NoCompress = onc;
3571  AR.Eside = oldEside;
3572  break;
3573  }
3574  case TYPEFINDLOOP:
3575  if ( Lus(term,C->lhs[level][3],C->lhs[level][4],
3576  C->lhs[level][5],C->lhs[level][6],C->lhs[level][2]) ) {
3577  AT.WorkPointer = term + *term;
3578  goto Renormalize;
3579  }
3580  break;
3581  case TYPEINSIDE:
3582  if ( InsideDollar(BHEAD C->lhs[level],level) < 0 ) goto GenCall;
3583  level = C->lhs[level][2];
3584  break;
3585  case TYPETERM:
3586  retnorm = execterm(BHEAD term,level);
3587  AN.RepPoint = RepSto;
3588  AR.CurDum = DumNow;
3589  CC->numrhs = oldtoprhs;
3590  CC->Pointer = CC->Buffer + oldcpointer;
3591  CCC->numrhs = oldatoprhs;
3592  CCC->Pointer = CCC->Buffer + oldacpointer;
3593  return(retnorm);
3594  case TYPEDETCURDUM:
3595  AT.WorkPointer = term + *term;
3596  AR.CurDum = DetCurDum(BHEAD term);
3597  break;
3598  case TYPEINEXPRESSION:
3599  {WORD *ll = C->lhs[level];
3600  int numexprs = (int)(ll[1]-3);
3601  ll += 3;
3602  while ( numexprs-- >= 0 ) {
3603  if ( *ll == AR.CurExpr ) break;
3604  ll++;
3605  }
3606  if ( numexprs < 0 ) level = C->lhs[level][2];
3607  }
3608  break;
3609  case TYPEMERGE:
3610  AT.WorkPointer = term + *term;
3611  if ( DoShuffle(term,level,C->lhs[level][2],C->lhs[level][3]) )
3612  goto GenCall;
3613  AT.WorkPointer = term + *term;
3614  goto Return0;
3615  case TYPESTUFFLE:
3616  AT.WorkPointer = term + *term;
3617  if ( DoStuffle(term,level,C->lhs[level][2],C->lhs[level][3]) )
3618  goto GenCall;
3619  AT.WorkPointer = term + *term;
3620  goto Return0;
3621  case TYPETESTUSE:
3622  AT.WorkPointer = term + *term;
3623  if ( TestUse(term,level) ) goto GenCall;
3624  AT.WorkPointer = term + *term;
3625  break;
3626  case TYPEAPPLY:
3627  AT.WorkPointer = term + *term;
3628  if ( ApplyExec(term,C->lhs[level][2],level) < C->lhs[level][2] ) {
3629  AT.WorkPointer = term + *term;
3630  *AN.RepPoint = 1;
3631  goto ReStart;
3632  }
3633  AT.WorkPointer = term + *term;
3634  break;
3635 /*
3636  case TYPEAPPLYRESET:
3637  AT.WorkPointer = term + *term;
3638  if ( ApplyReset(level) ) goto GenCall;
3639  AT.WorkPointer = term + *term;
3640  break;
3641 */
3642  case TYPECHAININ:
3643  AT.WorkPointer = term + *term;
3644  if ( ChainIn(BHEAD term,C->lhs[level][2]) ) goto GenCall;
3645  AT.WorkPointer = term + *term;
3646  break;
3647  case TYPECHAINOUT:
3648  AT.WorkPointer = term + *term;
3649  if ( ChainOut(BHEAD term,C->lhs[level][2]) ) goto GenCall;
3650  AT.WorkPointer = term + *term;
3651  break;
3652  case TYPEFACTOR:
3653  AT.WorkPointer = term + *term;
3654  if ( DollarFactorize(BHEAD C->lhs[level][2]) ) goto GenCall;
3655  AT.WorkPointer = term + *term;
3656  break;
3657  case TYPEARGIMPLODE:
3658  AT.WorkPointer = term + *term;
3659  if ( ArgumentImplode(BHEAD term,C->lhs[level]) ) goto GenCall;
3660  AT.WorkPointer = term + *term;
3661  break;
3662  case TYPEARGEXPLODE:
3663  AT.WorkPointer = term + *term;
3664  if ( ArgumentExplode(BHEAD term,C->lhs[level]) ) goto GenCall;
3665  AT.WorkPointer = term + *term;
3666  break;
3667  case TYPEDENOMINATORS:
3668  DenToFunction(term,C->lhs[level][2]);
3669  break;
3670  case TYPEDROPCOEFFICIENT:
3671  DropCoefficient(BHEAD term);
3672  break;
3673  case TYPETRANSFORM:
3674  AT.WorkPointer = term + *term;
3675  if ( RunTransform(BHEAD term,C->lhs[level]+2) ) goto GenCall;
3676  AT.WorkPointer = term + *term;
3677  if ( *term == 0 ) goto Return0;
3678  goto ReStart;
3679  case TYPETOPOLYNOMIAL:
3680  AT.WorkPointer = term + *term;
3681  termout = AT.WorkPointer;
3682  if ( ConvertToPoly(BHEAD term,termout,C->lhs[level],0) < 0 ) goto GenCall;
3683  if ( *termout == 0 ) goto Return0;
3684  i = termout[0]; t = term; NCOPY(t,termout,i);
3685  AT.WorkPointer = term + *term;
3686  break;
3687  case TYPEFROMPOLYNOMIAL:
3688  AT.WorkPointer = term + *term;
3689  termout = AT.WorkPointer;
3690  if ( ConvertFromPoly(BHEAD term,termout,0,numxsymbol,0,0) < 0 ) goto GenCall;
3691  if ( *term == 0 ) goto Return0;
3692  i = termout[0]; t = term; NCOPY(t,termout,i);
3693  AT.WorkPointer = term + *term;
3694  goto ReStart;
3695  case TYPEDOLOOP:
3696  level = TestDoLoop(BHEAD C->lhs[level],level);
3697  if ( level < 0 ) goto GenCall;
3698  break;
3699  case TYPEENDDOLOOP:
3700  level = TestEndDoLoop(BHEAD C->lhs[C->lhs[level][2]],C->lhs[level][2]);
3701  if ( level < 0 ) goto GenCall;
3702  break;
3703  case TYPEDROPSYMBOLS:
3704  DropSymbols(BHEAD term);
3705  break;
3706  case TYPEPUTINSIDE:
3707  AT.WorkPointer = term + *term;
3708  if ( PutInside(BHEAD term,C->lhs[level]) < 0 ) goto GenCall;
3709  AT.WorkPointer = term + *term;
3710  /*
3711  * We need to call Generator() to convert slow notation to
3712  * fast notation, which fixes Issue #30.
3713  */
3714  if ( Generator(BHEAD term,level) < 0 ) goto GenCall;
3715  goto Return0;
3716  case TYPETOSPECTATOR:
3717  if ( PutInSpectator(term,C->lhs[level][2]) < 0 ) goto GenCall;
3718  goto Return0;
3719  case TYPECANONICALIZE:
3720  AT.WorkPointer = term + *term;
3721  if ( DoCanonicalize(BHEAD term,C->lhs[level]) ) goto GenCall;
3722  AT.WorkPointer = term + *term;
3723  if ( *term == 0 ) goto Return0;
3724  break;
3725  case TYPESWITCH:
3726  AT.WorkPointer = term + *term;
3727  if ( DoSwitch(BHEAD term,C->lhs[level]) ) goto GenCall;
3728  goto Return0;
3729  case TYPEENDSWITCH:
3730  AT.WorkPointer = term + *term;
3731  if ( DoEndSwitch(BHEAD term,C->lhs[level]) ) goto GenCall;
3732  goto Return0;
3733  }
3734  goto SkipCount;
3735 /*
3736  #] Special action :
3737 */
3738  }
3739  } while ( ( i = TestMatch(BHEAD term,&level) ) == 0 );
3740  if ( AT.WorkPointer < term + *term ) AT.WorkPointer = term + *term;
3741  if ( i > 0 ) replac = TestSub(BHEAD term,level);
3742  else replac = i;
3743  if ( replac >= 0 || AT.TMout[1] != SYMMETRIZE ) {
3744  *AN.RepPoint = 1;
3745  AR.expchanged = 1;
3746  }
3747  if ( replac < 0 ) { /* Terms come from automatic generation */
3748 AutoGen: i = *AT.TMout;
3749  t = termout = AT.WorkPointer;
3750  if ( ( AT.WorkPointer += i ) > AT.WorkTop ) goto OverWork;
3751  accum = AT.TMout;
3752  while ( --i >= 0 ) *t++ = *accum++;
3753  if ( (*(FG.Operation[termout[1]]))(BHEAD term,termout,replac,level) ) goto GenCall;
3754  AT.WorkPointer = termout;
3755  goto Return0;
3756  }
3757  }
3758  if ( applyflag ) { TableReset(); applyflag = 0; }
3759 /* DumNow = AR.CurDum; */
3760 
3761  if ( AN.TeInFun ) { /* Match in function argument */
3762  if ( AN.TeInFun < 0 && !AN.TeSuOut ) {
3763 
3764  if ( AR.TePos >= 0 ) goto AutoGen;
3765  switch ( AN.TeInFun ) {
3766  case -1:
3767  if ( DoDistrib(BHEAD term,level) ) goto GenCall;
3768  break;
3769  case -2:
3770  if ( DoDelta3(BHEAD term,level) ) goto GenCall;
3771  break;
3772  case -3:
3773  if ( DoTableExpansion(term,level) ) goto GenCall;
3774  break;
3775  case -4:
3776  if ( FactorIn(BHEAD term,level) ) goto GenCall;
3777  break;
3778  case -5:
3779  if ( FactorInExpr(BHEAD term,level) ) goto GenCall;
3780  break;
3781  case -6:
3782  if ( TermsInBracket(BHEAD term,level) < 0 ) goto GenCall;
3783  break;
3784  case -7:
3785  if ( ExtraSymFun(BHEAD term,level) < 0 ) goto GenCall;
3786  break;
3787  case -8:
3788  if ( GCDfunction(BHEAD term,level) < 0 ) goto GenCall;
3789  break;
3790  case -9:
3791  if ( DIVfunction(BHEAD term,level,0) < 0 ) goto GenCall;
3792  break;
3793  case -10:
3794  if ( DIVfunction(BHEAD term,level,1) < 0 ) goto GenCall;
3795  break;
3796  case -11:
3797  if ( DIVfunction(BHEAD term,level,2) < 0 ) goto GenCall;
3798  break;
3799  case -12:
3800  if ( DoPermutations(BHEAD term,level) ) goto GenCall;
3801  break;
3802  case -13:
3803  if ( DoPartitions(BHEAD term,level) ) goto GenCall;
3804  break;
3805  case -14:
3806  if ( DIVfunction(BHEAD term,level,3) < 0 ) goto GenCall;
3807  break;
3808  case -15:
3809  if ( GenTopologies(BHEAD term,level) < 0 ) goto GenCall;
3810  break;
3811  case -16:
3812  if ( GenDiagrams(BHEAD term,level) < 0 ) goto GenCall;
3813  break;
3814  }
3815  }
3816  else {
3817  termout = AT.WorkPointer;
3818  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
3819  if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
3820  if ( InFunction(BHEAD term,termout) ) goto GenCall;
3821  AT.WorkPointer = termout + *termout;
3822  *AN.RepPoint = 1;
3823  AR.expchanged = 1;
3824  if ( *termout && Generator(BHEAD termout,level) < 0 ) goto GenCall;
3825  AT.WorkPointer = termout;
3826  }
3827  }
3828  else if ( replac > 0 ) {
3829  power = AN.TeSuOut;
3830  tepos = AR.TePos;
3831  if ( power < 0 ) { /* Table expansion */
3832  power = -power; tepos = 0;
3833  }
3834  extractbuff = AT.TMbuff;
3835  if ( extractbuff == AM.dbufnum ) {
3836  d = DolToTerms(BHEAD replac);
3837  if ( d && d->where != 0 ) {
3838  iscopy = 1;
3839  if ( AT.TMdolfac > 0 ) { /* We need a factor */
3840  if ( AT.TMdolfac == 1 ) {
3841  if ( d->nfactors ) {
3842  numfac[0] = 4;
3843  numfac[1] = d->nfactors;
3844  numfac[2] = 1;
3845  numfac[3] = 3;
3846  numfac[4] = 0;
3847  }
3848  else {
3849  numfac[0] = 0;
3850  }
3851  StartBuf = numfac;
3852  }
3853  else {
3854  if ( (AT.TMdolfac-1) > d->nfactors && d->nfactors > 0 ) {
3855  MLOCK(ErrorMessageLock);
3856  MesPrint("Attempt to use an nonexisting factor %d of a $-variable",(WORD)(AT.TMdolfac-1));
3857  if ( d->nfactors == 1 )
3858  MesPrint("There is only one factor");
3859  else
3860  MesPrint("There are only %d factors",(WORD)(d->nfactors));
3861  MUNLOCK(ErrorMessageLock);
3862  goto GenCall;
3863  }
3864  if ( d->nfactors > 1 ) {
3865  DOLLARS dd;
3866  LONG dsize;
3867  WORD *td1, *td2;
3868  dd = Dollars + replac;
3869 #ifdef WITHPTHREADS
3870  {
3871  int nummodopt, dtype = -1;
3872  if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
3873  for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3874  if ( replac == ModOptdollars[nummodopt].number ) break;
3875  }
3876  if ( nummodopt < NumModOptdollars ) {
3877  dtype = ModOptdollars[nummodopt].type;
3878  if ( dtype == MODLOCAL ) {
3879  dd = ModOptdollars[nummodopt].dstruct+AT.identity;
3880  }
3881  }
3882  }
3883  }
3884 #endif
3885  dsize = dd->factors[AT.TMdolfac-2].size;
3886 /*
3887  We copy only the factor we need
3888 */
3889  if ( dsize == 0 ) {
3890  numfac[0] = 4;
3891  numfac[1] = d->factors[AT.TMdolfac-2].value;
3892  numfac[2] = 1;
3893  numfac[3] = 3;
3894  numfac[4] = 0;
3895  StartBuf = numfac;
3896  if ( numfac[1] < 0 ) {
3897  numfac[1] = -numfac[1];
3898  numfac[3] = -numfac[3];
3899  }
3900  }
3901  else {
3902  d->factors[AT.TMdolfac-2].where = td2 = (WORD *)Malloc1(
3903  (dsize+1)*sizeof(WORD),"Copy of factor");
3904  td1 = dd->factors[AT.TMdolfac-2].where;
3905  StartBuf = td2;
3906  d->size = dsize; d->type = DOLTERMS;
3907  NCOPY(td2,td1,dsize);
3908  *td2 = 0;
3909  }
3910  }
3911  else if ( d->nfactors == 1 ) {
3912  StartBuf = d->where;
3913  }
3914  else {
3915  MLOCK(ErrorMessageLock);
3916  if ( d->nfactors == 0 ) {
3917  MesPrint("Attempt to use factor %d of an unfactored $-variable",(WORD)(AT.TMdolfac-1));
3918  }
3919  else {
3920  MesPrint("Internal error. Illegal number of factors for $-variable");
3921  }
3922  MUNLOCK(ErrorMessageLock);
3923  goto GenCall;
3924  }
3925  }
3926  }
3927  else StartBuf = d->where;
3928  }
3929  else {
3930  d = Dollars + replac;
3931  StartBuf = zeroDollar;
3932  }
3933  posisub = 0;
3934  i = DetCommu(d->where);
3935 #ifdef WITHPTHREADS
3936  if ( AS.MultiThreaded ) {
3937  for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3938  if ( replac == ModOptdollars[nummodopt].number ) break;
3939  }
3940  if ( nummodopt < NumModOptdollars ) {
3941  dtype = ModOptdollars[nummodopt].type;
3942  if ( dtype != MODLOCAL && dtype != MODSUM ) {
3943  if ( StartBuf[0] && StartBuf[StartBuf[0]] ) {
3944  MLOCK(ErrorMessageLock);
3945  MesPrint("A dollar variable with modoption max or min can have only one term");
3946  MUNLOCK(ErrorMessageLock);
3947  goto GenCall;
3948  }
3949  LOCK(d->pthreadslockread);
3950  }
3951  }
3952  }
3953 #endif
3954  }
3955  else {
3956  StartBuf = cbuf[extractbuff].Buffer;
3957  posisub = cbuf[extractbuff].rhs[replac] - StartBuf;
3958  i = (WORD)cbuf[extractbuff].CanCommu[replac];
3959  }
3960  if ( power == 1 ) { /* Just a single power */
3961  termout = AT.WorkPointer;
3962  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
3963  if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
3964  while ( StartBuf[posisub] ) {
3965  if ( extractbuff == AT.allbufnum ) WildDollars(BHEAD &(StartBuf[posisub]));
3966  AT.WorkPointer = (WORD *)(((UBYTE *)(termout)) + AM.MaxTer);
3967  if ( InsertTerm(BHEAD term,replac,extractbuff,
3968  &(StartBuf[posisub]),termout,tepos) < 0 ) goto GenCall;
3969  AT.WorkPointer = termout + *termout;
3970  *AN.RepPoint = 1;
3971  AR.expchanged = 1;
3972  posisub += StartBuf[posisub];
3973 /*
3974  For multiple table substitutions it may be better to
3975  do modulus arithmetic right here
3976  Turns out to be not very effective.
3977 
3978  if ( AN.ncmod != 0 ) {
3979  if ( Modulus(termout) ) goto GenCall;
3980  if ( !*termout ) goto Return0;
3981  }
3982 */
3983 #ifdef WITHPTHREADS
3984  if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); }
3985  if ( ( AS.Balancing && CC->numrhs == 0 ) && StartBuf[posisub] ) {
3986  if ( ( id = ConditionalGetAvailableThread() ) >= 0 ) {
3987  if ( BalanceRunThread(BHEAD id,termout,level) < 0 ) goto GenCall;
3988  }
3989  }
3990  else
3991 #endif
3992  if ( Generator(BHEAD termout,level) < 0 ) goto GenCall;
3993 #ifdef WITHPTHREADS
3994  if ( dtype > 0 && dtype != MODLOCAL ) { dtype = 0; break; }
3995 #endif
3996  if ( iscopy == 0 && ( extractbuff != AM.dbufnum ) ) {
3997 /*
3998  There are cases in which a bigger buffer is created
3999  on the fly, like with wildcard buffers.
4000  We play it safe here. Maybe we can be more selective
4001  in some distant future?
4002 */
4003  StartBuf = cbuf[extractbuff].Buffer;
4004  }
4005  }
4006  if ( extractbuff == AT.allbufnum ) {
4007  CBUF *Ce = cbuf + extractbuff;
4008  Ce->Pointer = Ce->rhs[Ce->numrhs--];
4009  }
4010 #ifdef WITHPTHREADS
4011  if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); dtype = 0; }
4012 #endif
4013  if ( iscopy ) {
4014  if ( d->nfactors > 1 ) {
4015  int j;
4016  for ( j = 0; j < d->nfactors; j++ ) {
4017  if ( d->factors[j].where ) M_free(d->factors[j].where,"Copy of factor");
4018  }
4019  M_free(d->factors,"Dollar factors");
4020  }
4021  M_free(d,"Copy of dollar variable");
4022  d = 0; iscopy = 0;
4023  }
4024  AT.WorkPointer = termout;
4025  }
4026  else if ( i <= 1 ) { /* Use binomials */
4027  LONG posit, olw;
4028  WORD *same, *ow = AT.WorkPointer;
4029  LONG olpw = AT.posWorkPointer;
4030  power1 = power+1;
4031  WantAddLongs(power1);
4032  olw = posit = AT.lWorkPointer; AT.lWorkPointer += power1;
4033  same = ++AT.WorkPointer;
4034  a = accum = ( AT.WorkPointer += power1+1 );
4035  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4036  if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4037  AT.lWorkSpace[posit] = posisub;
4038  same[-1] = 0;
4039  *same = 1;
4040  *accum = 0;
4041  tepos = AR.TePos;
4042  i = 1;
4043  do {
4044  if ( StartBuf[AT.lWorkSpace[posit]] ) {
4045  if ( ( a = PasteTerm(BHEAD i-1,accum,
4046  &(StartBuf[AT.lWorkSpace[posit]]),i,*same) ) == 0 )
4047  goto GenCall;
4048  AT.lWorkSpace[posit+1] = AT.lWorkSpace[posit];
4049  same[1] = *same + 1;
4050  if ( i > 1 && AT.lWorkSpace[posit] < AT.lWorkSpace[posit-1] ) *same = 1;
4051  AT.lWorkSpace[posit] += StartBuf[AT.lWorkSpace[posit]];
4052  i++;
4053  posit++;
4054  same++;
4055  }
4056  else {
4057  i--; posit--; same--;
4058  }
4059  if ( i > power ) {
4060  termout = AT.WorkPointer = a;
4061  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4062  if ( AT.WorkPointer > AT.WorkTop )
4063  goto OverWork;
4064  if ( FiniTerm(BHEAD term,accum,termout,replac,tepos) ) goto GenCall;
4065  AT.WorkPointer = termout + *termout;
4066  *AN.RepPoint = 1;
4067  AR.expchanged = 1;
4068 #ifdef WITHPTHREADS
4069  if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); }
4070  if ( ( AS.Balancing && CC->numrhs == 0 ) && ( i > 0 )
4071  && ( id = ConditionalGetAvailableThread() ) >= 0 ) {
4072  if ( BalanceRunThread(BHEAD id,termout,level) < 0 ) goto GenCall;
4073  }
4074  else
4075 #endif
4076  if ( Generator(BHEAD termout,level) ) goto GenCall;
4077 #ifdef WITHPTHREADS
4078  if ( dtype > 0 && dtype != MODLOCAL ) { dtype = 0; break; }
4079 #endif
4080  if ( iscopy == 0 && ( extractbuff != AM.dbufnum ) )
4081  StartBuf = cbuf[extractbuff].Buffer;
4082  i--; posit--; same--;
4083  }
4084  } while ( i > 0 );
4085 #ifdef WITHPTHREADS
4086  if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); dtype = 0; }
4087 #endif
4088  if ( iscopy ) {
4089  if ( d->nfactors > 1 ) {
4090  int j;
4091  for ( j = 0; j < d->nfactors; j++ ) {
4092  if ( d->factors[j].where ) M_free(d->factors[j].where,"Copy of factor");
4093  }
4094  M_free(d->factors,"Dollar factors");
4095  }
4096  M_free(d,"Copy of dollar variable");
4097  d = 0; iscopy = 0;
4098  }
4099  AT.WorkPointer = ow; AT.lWorkPointer = olw; AT.posWorkPointer = olpw;
4100  }
4101  else { /* No binomials */
4102  LONG posit, olw, olpw = AT.posWorkPointer;
4103  WantAddLongs(power);
4104  posit = olw = AT.lWorkPointer; AT.lWorkPointer += power;
4105  a = accum = AT.WorkPointer;
4106  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4107  if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4108  for ( i = 0; i < power; i++ ) AT.lWorkSpace[posit++] = posisub;
4109  posit = olw;
4110  *accum = 0;
4111  tepos = AR.TePos;
4112  i = 0;
4113  while ( i >= 0 ) {
4114  if ( StartBuf[AT.lWorkSpace[posit]] ) {
4115  if ( ( a = PasteTerm(BHEAD i,accum,
4116  &(StartBuf[AT.lWorkSpace[posit]]),1,1) ) == 0 ) goto GenCall;
4117  AT.lWorkSpace[posit] += StartBuf[AT.lWorkSpace[posit]];
4118  i++; posit++;
4119  }
4120  else {
4121  AT.lWorkSpace[posit--] = posisub;
4122  i--;
4123  }
4124  if ( i >= power ) {
4125  termout = AT.WorkPointer = a;
4126  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4127  if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4128  if ( FiniTerm(BHEAD term,accum,termout,replac,tepos) ) goto GenCall;
4129  AT.WorkPointer = termout + *termout;
4130  *AN.RepPoint = 1;
4131  AR.expchanged = 1;
4132 #ifdef WITHPTHREADS
4133  if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); }
4134  if ( ( AS.Balancing && CC->numrhs == 0 ) && ( i > 0 ) && ( id = ConditionalGetAvailableThread() ) >= 0 ) {
4135  if ( BalanceRunThread(BHEAD id,termout,level) < 0 ) goto GenCall;
4136  }
4137  else
4138 #endif
4139  if ( Generator(BHEAD termout,level) ) goto GenCall;
4140 #ifdef WITHPTHREADS
4141  if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { dtype = 0; break; }
4142 #endif
4143  if ( iscopy == 0 && ( extractbuff != AM.dbufnum ) )
4144  StartBuf = cbuf[extractbuff].Buffer;
4145  i--; posit--;
4146  }
4147  }
4148 #ifdef WITHPTHREADS
4149  if ( dtype > 0 && dtype != MODLOCAL && dtype != MODSUM ) { UNLOCK(d->pthreadslockread); dtype = 0; }
4150 #endif
4151  if ( iscopy ) {
4152  if ( d->nfactors > 1 ) {
4153  int j;
4154  for ( j = 0; j < d->nfactors; j++ ) {
4155  if ( d->factors[j].where ) M_free(d->factors[j].where,"Copy of factor");
4156  }
4157  M_free(d->factors,"Dollar factors");
4158  }
4159  M_free(d,"Copy of dollar variable");
4160  d = 0; iscopy = 0;
4161  }
4162  AT.WorkPointer = accum;
4163  AT.lWorkPointer = olw;
4164  AT.posWorkPointer = olpw;
4165  }
4166  }
4167  else { /* Expression from disk */
4168  POSITION StartPos;
4169  LONG position, olpw, opw, comprev, extra;
4170  RENUMBER renumber;
4171  WORD *Freeze, *aa, *dummies;
4172  replac = -replac-1;
4173  power = AN.TeSuOut;
4174  Freeze = AN.Frozen;
4175  if ( Expressions[replac].status == STOREDEXPRESSION ) {
4176  POSITION firstpos;
4177  SETSTARTPOS(firstpos);
4178 
4179 /* Note that AT.TMaddr is needed for GetTable just once! */
4180 /*
4181  We need space for the previous term in the compression
4182  This is made available in AR.CompressBuffer, although we may get
4183  problems with this sooner or later. Hence we need to keep
4184  a set of pointers in AR.CompressBuffer
4185  Note that after the last call there has been no use made
4186  of AR.CompressPointer, so it points automatically at its original
4187  position!
4188 */
4189  WantAddPointers(power+1);
4190  comprev = opw = AT.pWorkPointer;
4191  AT.pWorkPointer += power+1;
4192  WantAddPositions(power+1);
4193  position = olpw = AT.posWorkPointer;
4194  AT.posWorkPointer += power + 1;
4195 
4196  AT.pWorkSpace[comprev++] = AR.CompressPointer;
4197 
4198  for ( i = 0; i < power; i++ ) {
4199  PUTZERO(AT.posWorkSpace[position]); position++;
4200  }
4201  position = olpw;
4202  if ( ( renumber = GetTable(replac,&(AT.posWorkSpace[position]),1) ) == 0 ) goto GenCall;
4203  dummies = AT.WorkPointer;
4204  *dummies++ = AR.CurDum;
4205  AT.WorkPointer += power+2;
4206  accum = AT.WorkPointer;
4207  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4208  if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4209  aa = AT.WorkPointer;
4210  *accum = 0;
4211  i = 0; StartPos = AT.posWorkSpace[position];
4212  dummies[i] = AR.CurDum;
4213  while ( i >= 0 ) {
4214 skippedfirst:
4215  AR.CompressPointer = AT.pWorkSpace[comprev-1];
4216  if ( ( extra = PasteFile(BHEAD i,accum,&(AT.posWorkSpace[position])
4217  ,&a,renumber,Freeze,replac) ) < 0 ) goto GenCall;
4218  if ( Expressions[replac].numdummies > 0 ) {
4219  AR.CurDum = dummies[i] + Expressions[replac].numdummies;
4220  }
4221  if ( NOTSTARTPOS(firstpos) ) {
4222  if ( ISMINPOS(firstpos) || ISEQUALPOS(firstpos,AT.posWorkSpace[position]) ) {
4223  firstpos = AT.posWorkSpace[position];
4224 /*
4225  ADDPOS(AT.posWorkSpace[position],extra * sizeof(WORD));
4226 */
4227  goto skippedfirst;
4228  }
4229  }
4230  if ( extra ) {
4231 /*
4232  ADDPOS(AT.posWorkSpace[position],extra * sizeof(WORD));
4233 */
4234  i++; AT.posWorkSpace[++position] = StartPos;
4235  AT.pWorkSpace[comprev++] = AR.CompressPointer;
4236  dummies[i] = AR.CurDum;
4237  }
4238  else {
4239  PUTZERO(AT.posWorkSpace[position]); position--; i--;
4240  AR.CurDum = dummies[i];
4241  comprev--;
4242  }
4243  if ( i >= power ) {
4244  termout = AT.WorkPointer = a;
4245  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2*AM.MaxTer);
4246  if ( AT.WorkPointer > AT.WorkTop ) goto OverWork;
4247  if ( FiniTerm(BHEAD term,accum,termout,replac,0) ) goto GenCall;
4248  if ( *termout ) {
4249  AT.WorkPointer = termout + *termout;
4250  *AN.RepPoint = 1;
4251  AR.expchanged = 1;
4252 #ifdef WITHPTHREADS
4253  if ( ( AS.Balancing && CC->numrhs == 0 ) && ( i > 0 ) && ( id = ConditionalGetAvailableThread() ) >= 0 ) {
4254  if ( BalanceRunThread(BHEAD id,termout,level) < 0 ) goto GenCall;
4255 
4256  }
4257  else
4258 #endif
4259  if ( Generator(BHEAD termout,level) ) goto GenCall;
4260  }
4261  i--; position--;
4262  AR.CurDum = dummies[i];
4263  comprev--;
4264  }
4265  AT.WorkPointer = aa;
4266  }
4267  AT.WorkPointer = accum;
4268  AT.posWorkPointer = olpw;
4269  AT.pWorkPointer = opw;
4270 /*
4271  Bug fix. See also GetTable
4272 #ifdef WITHPTHREADS
4273  M_free(renumber->symb.lo,"VarSpace");
4274  M_free(renumber,"Renumber");
4275 #endif
4276 */
4277  if ( renumber->symb.lo != AN.dummyrenumlist )
4278  M_free(renumber->symb.lo,"VarSpace");
4279  M_free(renumber,"Renumber");
4280 
4281  }
4282  else { /* Active expression */
4283  aa = accum = AT.WorkPointer;
4284  if ( ( (WORD *)(((UBYTE *)(AT.WorkPointer)) + 2 * AM.MaxTer + sizeof(WORD)) ) > AT.WorkTop )
4285  goto OverWork;
4286  *accum++ = -1; AT.WorkPointer++;
4287  if ( DoOnePow(BHEAD term,power,replac,accum,aa,level,Freeze) ) goto GenCall;
4288  AT.WorkPointer = aa;
4289  }
4290  }
4291 Return0:
4292  AR.CurDum = DumNow;
4293  AN.RepPoint = RepSto;
4294  CC->numrhs = oldtoprhs;
4295  CC->Pointer = CC->Buffer + oldcpointer;
4296  CCC->numrhs = oldatoprhs;
4297  CCC->Pointer = CCC->Buffer + oldacpointer;
4298  return(0);
4299 
4300 GenCall:
4301  if ( AM.tracebackflag ) {
4302  termout = term;
4303  MLOCK(ErrorMessageLock);
4304  AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
4305  AO.OutSkip = 3;
4306  FiniLine();
4307  i = *termout;
4308  while ( --i >= 0 ) {
4309  TalToLine((UWORD)(*termout++));
4310  TokenToLine((UBYTE *)" ");
4311  }
4312  AO.OutSkip = 0;
4313  FiniLine();
4314  MesCall("Generator");
4315  MUNLOCK(ErrorMessageLock);
4316  }
4317  CC->numrhs = oldtoprhs;
4318  CC->Pointer = CC->Buffer + oldcpointer;
4319  CCC->numrhs = oldatoprhs;
4320  CCC->Pointer = CCC->Buffer + oldacpointer;
4321  return(-1);
4322 OverWork:
4323  CC->numrhs = oldtoprhs;
4324  CC->Pointer = CC->Buffer + oldcpointer;
4325  CCC->numrhs = oldatoprhs;
4326  CCC->Pointer = CCC->Buffer + oldacpointer;
4327  MLOCK(ErrorMessageLock);
4328  MesWork();
4329  MUNLOCK(ErrorMessageLock);
4330  return(-1);
4331 }
4332 
4333 /*
4334  #] Generator :
4335  #[ DoOnePow : WORD DoOnePow(term,power,nexp,accum,aa,level,freeze)
4336 */
4361 #ifdef WITHPTHREADS
4362 char freezestring[] = "freeze<-xxxx";
4363 #endif
4364 
4365 WORD DoOnePow(PHEAD WORD *term, WORD power, WORD nexp, WORD * accum,
4366  WORD *aa, WORD level, WORD *freeze)
4367 {
4368  GETBIDENTITY
4369  POSITION oldposition, startposition;
4370  WORD *acc, *termout, fromfreeze = 0;
4371  WORD *oldipointer = AR.CompressPointer;
4372  FILEHANDLE *fi;
4373  WORD type, retval;
4374  WORD oldGetOneFile = AR.GetOneFile;
4375  WORD olddummies = AR.CurDum;
4376  WORD extradummies = Expressions[nexp].numdummies;
4377 /*
4378  The next code is for some tricky debugging. (5-jan-2010 JV)
4379  Normally it should be disabled.
4380 */
4381 /*
4382 #ifdef WITHPTHREADS
4383  if ( freeze ) {
4384  MLOCK(ErrorMessageLock);
4385  if ( AT.identity < 10 ) {
4386  freezestring[8] = '0'+AT.identity;
4387  freezestring[9] = '>';
4388  freezestring[10] = 0;
4389  }
4390  else if ( AT.identity < 100 ) {
4391  freezestring[8] = '0'+AT.identity/10;
4392  freezestring[9] = '0'+AT.identity%10;
4393  freezestring[10] = '>';
4394  freezestring[11] = 0;
4395  }
4396  else {
4397  freezestring[8] = 0;
4398  }
4399  PrintTerm(freeze,freezestring);
4400  MUNLOCK(ErrorMessageLock);
4401  }
4402 #else
4403  if ( freeze ) PrintTerm(freeze,"freeze");
4404 #endif
4405 */
4406  type = Expressions[nexp].status;
4407  if ( type == HIDDENLEXPRESSION || type == HIDDENGEXPRESSION
4408  || type == DROPHLEXPRESSION || type == DROPHGEXPRESSION
4409  || type == UNHIDELEXPRESSION || type == UNHIDEGEXPRESSION ) {
4410  AR.GetOneFile = 2; fi = AR.hidefile;
4411  }
4412  else {
4413  AR.GetOneFile = 0; fi = AR.infile;
4414  }
4415  if ( fi->handle >= 0 ) {
4416  PUTZERO(oldposition);
4417 #ifdef WITHSEEK
4418  LOCK(AS.inputslock);
4419  SeekFile(fi->handle,&oldposition,SEEK_CUR);
4420  UNLOCK(AS.inputslock);
4421 #endif
4422  }
4423  else {
4424  SETBASEPOSITION(oldposition,fi->POfill-fi->PObuffer);
4425  }
4426  if ( freeze && ( Expressions[nexp].bracketinfo != 0 ) ) {
4427  POSITION *brapos;
4428 /*
4429  There is a bracket index
4430  AR.CompressPointer = oldipointer;
4431 */
4432  (*aa)++;
4433  power--;
4434  if ( ( brapos = FindBracket(nexp,freeze) ) == 0 )
4435  goto EndExpr;
4436  startposition = *brapos;
4437  goto doterms;
4438  }
4439  startposition = AS.OldOnFile[nexp];
4440  retval = GetOneTerm(BHEAD accum,fi,&startposition,0);
4441  if ( retval > 0 ) { /* Skip prototype */
4442  (*aa)++;
4443  power--;
4444 doterms:
4445  AR.CompressPointer = oldipointer;
4446  for (;;) {
4447  retval = GetOneTerm(BHEAD accum,fi,&startposition,0);
4448  if ( retval <= 0 ) break;
4449 /*
4450  Here should come the code to test for [].
4451 */
4452  if ( freeze ) {
4453  WORD *t, *m, *r, *mstop;
4454  WORD *tset;
4455  t = accum;
4456  m = freeze;
4457  m += *m;
4458  m -= ABS(m[-1]);
4459  mstop = m;
4460  m = freeze + 1;
4461  r = t;
4462  r += *t;
4463  r -= ABS(r[-1]);
4464  t++;
4465  tset = t;
4466  while ( t < r && *t != HAAKJE ) t += t[1];
4467  if ( t >= r ) {
4468  if ( m < mstop ) {
4469  if ( fromfreeze ) goto EndExpr;
4470  goto NextTerm;
4471  }
4472  t = tset;
4473  }
4474  else {
4475  r = tset;
4476  while ( r < t && m < mstop ) {
4477  if ( *r == *m ) { m++; r++; }
4478  else {
4479  if ( fromfreeze ) goto EndExpr;
4480  goto NextTerm;
4481  }
4482  }
4483  if ( r < t || m < mstop ) {
4484  if ( fromfreeze ) goto EndExpr;
4485  goto NextTerm;
4486  }
4487  }
4488  fromfreeze = 1;
4489  r = tset;
4490  m = accum;
4491  m += *m;
4492  while ( t < m ) *r++ = *t++;
4493  *accum = WORDDIF(r,accum);
4494  }
4495  if ( extradummies > 0 ) {
4496  if ( olddummies > AM.IndDum ) {
4497  MoveDummies(BHEAD accum,olddummies-AM.IndDum);
4498  }
4499  AR.CurDum = olddummies+extradummies;
4500  }
4501  acc = accum;
4502  acc += *acc;
4503  if ( power <= 0 ) {
4504  termout = acc;
4505  AT.WorkPointer = (WORD *)(((UBYTE *)(acc)) + 2*AM.MaxTer);
4506  if ( AT.WorkPointer > AT.WorkTop ) {
4507  MLOCK(ErrorMessageLock);
4508  MesWork();
4509  MUNLOCK(ErrorMessageLock);
4510  return(-1);
4511  }
4512  if ( FiniTerm(BHEAD term,aa,termout,nexp,0) ) goto PowCall;
4513  if ( *termout ) {
4514  MarkPolyRatFunDirty(termout)
4515 /* PolyFunDirty(BHEAD termout); */
4516  AT.WorkPointer = termout + *termout;
4517  *AN.RepPoint = 1;
4518  AR.expchanged = 1;
4519  if ( Generator(BHEAD termout,level) ) goto PowCall;
4520  }
4521  }
4522  else {
4523  if ( acc > AT.WorkTop ) {
4524  MLOCK(ErrorMessageLock);
4525  MesWork();
4526  MUNLOCK(ErrorMessageLock);
4527  return(-1);
4528  }
4529  if ( DoOnePow(BHEAD term,power,nexp,acc,aa,level,freeze) ) goto PowCall;
4530  }
4531 NextTerm:;
4532  AR.CompressPointer = oldipointer;
4533  }
4534 EndExpr:
4535  (*aa)--;
4536  }
4537  AR.CompressPointer = oldipointer;
4538  if ( fi->handle >= 0 ) {
4539 #ifdef WITHSEEK
4540  LOCK(AS.inputslock);
4541  SeekFile(fi->handle,&oldposition,SEEK_SET);
4542  UNLOCK(AS.inputslock);
4543  if ( ISNEGPOS(oldposition) ) {
4544  MLOCK(ErrorMessageLock);
4545  MesPrint("File error");
4546  goto PowCall2;
4547  }
4548 #endif
4549  }
4550  else {
4551  fi->POfill = fi->PObuffer + BASEPOSITION(oldposition);
4552  }
4553  AR.GetOneFile = oldGetOneFile;
4554  AR.CurDum = olddummies;
4555  return(0);
4556 PowCall:;
4557  MLOCK(ErrorMessageLock);
4558 #ifdef WITHSEEK
4559 PowCall2:;
4560 #endif
4561  MesCall("DoOnePow");
4562  MUNLOCK(ErrorMessageLock);
4563  SETERROR(-1)
4564 }
4565 
4566 /*
4567  #] DoOnePow :
4568  #[ Deferred : WORD Deferred(term,level)
4569 */
4586 WORD Deferred(PHEAD WORD *term, WORD level)
4587 {
4588  GETBIDENTITY
4589  POSITION startposition;
4590  WORD *t, *m, *mstop, *tstart, decr, oldb, *termout, i, *oldwork, retval;
4591  WORD *oldipointer = AR.CompressPointer, *oldPOfill = AR.infile->POfill;
4592  WORD oldGetOneFile = AR.GetOneFile;
4593  AR.GetOneFile = 1;
4594  oldwork = AT.WorkPointer;
4595  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
4596  termout = AT.WorkPointer;
4597  AR.DeferFlag = 0;
4598  startposition = AR.DefPosition;
4599 /*
4600  Store old position
4601 */
4602  if ( AR.infile->handle >= 0 ) {
4603 /*
4604  PUTZERO(oldposition);
4605  SeekFile(AR.infile->handle,&oldposition,SEEK_CUR);
4606 */
4607  }
4608  else {
4609 /*
4610  SETBASEPOSITION(oldposition,AR.infile->POfill-AR.infile->PObuffer);
4611 */
4612  AR.infile->POfill = (WORD *)((UBYTE *)(AR.infile->PObuffer)
4613  +BASEPOSITION(startposition));
4614  }
4615 /*
4616  Look in the CompressBuffer where the bracket contents start
4617 */
4618  t = m = AR.CompressBuffer;
4619  t += *t;
4620  mstop = t - ABS(t[-1]);
4621  m++;
4622  while ( *m != HAAKJE && m < mstop ) m += m[1];
4623  if ( m >= mstop ) { /* No deferred action! */
4624  AT.WorkPointer = term + *term;
4625  if ( Generator(BHEAD term,level) ) goto DefCall;
4626  AR.DeferFlag = 1;
4627  AT.WorkPointer = oldwork;
4628  AR.GetOneFile = oldGetOneFile;
4629  return(0);
4630  }
4631  mstop = m + m[1];
4632  decr = WORDDIF(mstop,AR.CompressBuffer)-1;
4633  tstart = AR.CompressPointer + decr;
4634 
4635  m = AR.CompressBuffer;
4636  t = AR.CompressPointer;
4637  i = *m;
4638  NCOPY(t,m,i);
4639  oldb = *tstart;
4640  AR.TePos = 0;
4641  AN.TeSuOut = 0;
4642 /*
4643  Status:
4644  First bracket content starts at mstop.
4645  Next term starts at startposition.
4646  Decompression information is in AR.CompressPointer.
4647  The outside of the bracket runs from AR.CompressBuffer+1 to mstop.
4648 */
4649  for(;;) {
4650  *tstart = *(AR.CompressPointer)-decr;
4651  AR.CompressPointer = AR.CompressPointer+AR.CompressPointer[0];
4652  if ( InsertTerm(BHEAD term,0,AM.rbufnum,tstart,termout,0) < 0 ) {
4653  goto DefCall;
4654  }
4655  *tstart = oldb;
4656  AT.WorkPointer = termout + *termout;
4657  if ( Generator(BHEAD termout,level) ) goto DefCall;
4658  AR.CompressPointer = oldipointer;
4659  AT.WorkPointer = termout;
4660  retval = GetOneTerm(BHEAD AT.WorkPointer,AR.infile,&startposition,0);
4661  if ( retval >= 0 ) AR.CompressPointer = oldipointer;
4662  if ( retval <= 0 ) break;
4663  t = AR.CompressPointer;
4664  if ( *t < (1 + decr + ABS(*(t+*t-1))) ) break;
4665  t++;
4666  m = AR.CompressBuffer+1;
4667  while ( m < mstop ) {
4668  if ( *m != *t ) goto Thatsit;
4669  m++; t++;
4670  }
4671  }
4672 Thatsit:;
4673 /*
4674  Finished. Reposition the file, restore information and return.
4675 */
4676  if ( AR.infile->handle < 0 ) AR.infile->POfill = oldPOfill;
4677  AR.DeferFlag = 1;
4678  AR.GetOneFile = oldGetOneFile;
4679  AT.WorkPointer = oldwork;
4680  return(0);
4681 DefCall:;
4682  MLOCK(ErrorMessageLock);
4683  MesCall("Deferred");
4684  MUNLOCK(ErrorMessageLock);
4685  SETERROR(-1)
4686 }
4687 
4688 /*
4689  #] Deferred :
4690  #[ PrepPoly : WORD PrepPoly(term,par)
4691 */
4714 WORD PrepPoly(PHEAD WORD *term,WORD par)
4715 {
4716  GETBIDENTITY
4717  WORD count = 0, i, jcoef, ncoef;
4718  WORD *t, *m, *r, *tstop, *poly = 0, *v, *w, *vv, *ww;
4719  WORD *oldworkpointer = AT.WorkPointer;
4720 /*
4721  The problem here is that the function will be forced into 'long'
4722  notation. After this -SNUMBER,1 becomes 6,0,4,1,1,3 and the
4723  pattern matcher cannot match a short 1 with a long 1.
4724  But because this is an undocumented feature for very special
4725  purposes, we don't do anything about it. (30-aug-2011)
4726 */
4727  if ( AR.PolyFunType == 2 && AR.PolyFunExp != 2 ) {
4728  WORD oldtype = AR.SortType;
4729  AR.SortType = SORTHIGHFIRST;
4730  if ( poly_ratfun_normalize(BHEAD term) != 0 ) Terminate(-1);
4731 /* if ( ReadPolyRatFun(BHEAD term) != 0 ) Terminate(-1); */
4732  oldworkpointer = AT.WorkPointer;
4733  AR.SortType = oldtype;
4734  }
4735  AT.PolyAct = 0;
4736  t = term;
4737  GETSTOP(t,tstop);
4738  t++;
4739  while ( t < tstop ) {
4740  if ( *t == AR.PolyFun ) {
4741  if ( count > 0 ) return(0);
4742  poly = t;
4743  count++;
4744  }
4745  t += t[1];
4746  }
4747  r = m = term + *term;
4748  i = ABS(m[-1]);
4749  if ( par > 0 ) {
4750  if ( count == 0 ) return(0);
4751  else if ( AR.PolyFunType == 1 || (AR.PolyFunType == 2 && AR.PolyFunExp == 2) )
4752  goto DoOne;
4753  else if ( AR.PolyFunType == 2 )
4754  goto DoTwo;
4755  else
4756  goto DoError;
4757  }
4758  else if ( count == 0 ) {
4759 /*
4760  #[ Create a PolyFun :
4761 */
4762  poly = t = tstop;
4763  if ( i == 3 && m[-2] == 1 && (m[-3]&MAXPOSITIVE) == m[-3] ) {
4764  *m++ = AR.PolyFun;
4765  if ( AR.PolyFunType == 1 || (AR.PolyFunType == 2 && AR.PolyFunExp == 2) ) {
4766  *m++ = FUNHEAD+2;
4767  FILLFUN(m)
4768  *m++ = -SNUMBER;
4769  *m = m[-2-FUNHEAD] < 0 ? -m[-4-FUNHEAD]: m[-4-FUNHEAD];
4770  m++;
4771  }
4772  else if ( AR.PolyFunType == 2 ) {
4773  *m++ = FUNHEAD+4;
4774  FILLFUN(m)
4775  *m++ = -SNUMBER;
4776  *m = m[-2-FUNHEAD] < 0 ? -m[-4-FUNHEAD]: m[-4-FUNHEAD];
4777  m++;
4778  *m++ = -SNUMBER;
4779  *m++ = 1;
4780  }
4781  }
4782  else {
4783  WORD *vm;
4784  r = tstop;
4785  if ( AR.PolyFunType == 1 || (AR.PolyFunType == 2 && AR.PolyFunExp == 2) ) {
4786  *m++ = AR.PolyFun;
4787  *m++ = FUNHEAD+ARGHEAD+i+1;
4788  FILLFUN(m)
4789  *m++ = ARGHEAD+i+1;
4790  *m++ = 0;
4791  FILLARG(m)
4792  *m++ = i+1;
4793  NCOPY(m,r,i);
4794  }
4795  else if ( AR.PolyFunType == 2 ) {
4796  WORD *num, *den, size, sign, sizenum, sizeden;
4797  if ( m[-1] < 0 ) { sign = -1; size = -m[-1]; }
4798  else { sign = 1; size = m[-1]; }
4799  num = m - size; size = (size-1)/2; den = num + size;
4800  sizenum = size; while ( num[sizenum-1] == 0 ) sizenum--;
4801  sizeden = size; while ( den[sizeden-1] == 0 ) sizeden--;
4802  v = m;
4803  AT.PolyAct = WORDDIF(v,term);
4804  *v++ = AR.PolyFun;
4805  v++;
4806  FILLFUN(v);
4807  vm = v;
4808  *v++ = ARGHEAD+2*sizenum+2;
4809  *v++ = 0;
4810  FILLARG(v);
4811  *v++ = 2*sizenum+2;
4812  for ( i = 0; i < sizenum; i++ ) *v++ = num[i];
4813  *v++ = 1;
4814  for ( i = 1; i < sizenum; i++ ) *v++ = 0;
4815  *v++ = sign*(2*sizenum+1);
4816  if ( ToFast(vm,vm) ) v = vm+2;
4817  vm = v;
4818  *v++ = ARGHEAD+2*sizeden+2;
4819  *v++ = 0;
4820  FILLARG(v);
4821  *v++ = 2*sizeden+2;
4822  for ( i = 0; i < sizeden; i++ ) *v++ = den[i];
4823  *v++ = 1;
4824  for ( i = 1; i < sizeden; i++ ) *v++ = 0;
4825  *v++ = 2*sizeden+1;
4826  if ( ToFast(vm,vm) ) v = vm+2;
4827  i = v-m;
4828  m[1] = i;
4829  w = num;
4830  NCOPY(w,m,i);
4831  *w++ = 1; *w++ = 1; *w++ = 3; *term = w - term;
4832  return(0);
4833  }
4834  }
4835 /*
4836  #] Create a PolyFun :
4837 */
4838  }
4839  else if ( AR.PolyFunType == 1 || (AR.PolyFunType == 2 && AR.PolyFunExp == 2) ) {
4840  DoOne:;
4841 /*
4842  #[ One argument :
4843 */
4844  m = term + *term;
4845  r = poly + poly[1];
4846  if ( ( poly[1] == FUNHEAD+2 && poly[FUNHEAD+1] == 0
4847  && poly[FUNHEAD] == -SNUMBER ) || poly[1] == FUNHEAD ) return(1);
4848  t = poly + FUNHEAD;
4849  if ( t >= r ) return(0);
4850  if ( m[-1] == 3 && *tstop == 1 && tstop[1] == 1 ) {
4851  i = poly[1];
4852  t = poly;
4853  NCOPY(m,t,i);
4854  }
4855  else if ( *t <= -FUNCTION ) {
4856  if ( t+1 < r ) return(0); /* More than one argument */
4857  r = tstop;
4858  *m++ = AR.PolyFun;
4859  *m++ = FUNHEAD*2+ARGHEAD+i+1;
4860  FILLFUN(m)
4861  *m++ = FUNHEAD+ARGHEAD+i+1;
4862  *m++ = 0;
4863  FILLARG(m)
4864  *m++ = FUNHEAD+i+1;
4865  *m++ = -*t++;
4866  *m++ = FUNHEAD;
4867  FILLFUN(m)
4868  NCOPY(m,r,i);
4869  }
4870  else if ( *t < 0 ) {
4871  if ( t+2 < r ) return(0); /* More than one argument */
4872  r = tstop;
4873  if ( *t == -SNUMBER ) {
4874  if ( t[1] == 0 ) return(1); /* Term should be zero now */
4875  *m = AR.PolyFun;
4876  w = m+1;
4877  m += FUNHEAD+ARGHEAD;
4878  v = m;
4879  *m++ = 5+i;
4880  *m++ = SNUMBER;
4881  *m++ = 4;
4882  *m++ = t[1];
4883  *m++ = 1;
4884  NCOPY(m,r,i);
4885  if ( m >= AT.WorkSpace && m < AT.WorkTop )
4886  AT.WorkPointer = m;
4887  if ( Normalize(BHEAD v) ) Terminate(-1);
4888  AT.WorkPointer = oldworkpointer;
4889  m = w;
4890  if ( *v == 4 && v[2] == 1 && (v[1]&MAXPOSITIVE) == v[1] ) {
4891  *m++ = FUNHEAD+2;
4892  FILLFUN(m)
4893  *m++ = -SNUMBER;
4894  *m++ = v[3] < 0 ? -v[1] : v[1];
4895  }
4896  else if ( *v == 0 ) return(1);
4897  else {
4898  *m++ = FUNHEAD+ARGHEAD+*v;
4899  FILLFUN(m)
4900  *m++ = ARGHEAD+*v;
4901  *m++ = 0;
4902  FILLARG(m)
4903  m = v + *v;
4904  }
4905  }
4906  else if ( *t == -SYMBOL ) {
4907  *m++ = AR.PolyFun;
4908  *m++ = FUNHEAD+ARGHEAD+5+i;
4909  FILLFUN(m)
4910  *m++ = ARGHEAD+5+i;
4911  *m++ = 0;
4912  FILLARG(m)
4913  *m++ = 5+i;
4914  *m++ = SYMBOL;
4915  *m++ = 4;
4916  *m++ = t[1];
4917  *m++ = 1;
4918  NCOPY(m,r,i);
4919  }
4920  else return(0); /* Not symbol-like */
4921  }
4922  else {
4923  if ( t + *t < r ) return(0); /* More than one argument */
4924  i = m[-1];
4925  *m++ = AR.PolyFun;
4926  w = m;
4927  m += ARGHEAD+FUNHEAD-1;
4928  t += ARGHEAD;
4929  jcoef = i < 0 ? (i+1)>>1:(i-1)>>1;
4930  v = t;
4931 /*
4932  Test now the scalar nature of the argument.
4933  No indices allowed.
4934 */
4935  while ( t < r ) {
4936  WORD *vstop;
4937  vv = t + *t;
4938  vstop = vv - ABS(vv[-1]);
4939  t++;
4940  while( t < vstop ) {
4941  if ( *t == INDEX ) return(0);
4942  t += t[1];
4943  }
4944  t = vv;
4945  }
4946 /*
4947  Now multiply each term by the coefficient.
4948 */
4949  t = v;
4950  while ( t < r ) {
4951  ww = m;
4952  v = t + *t;
4953  ncoef = v[-1];
4954  vv = v - ABS(ncoef);
4955  if ( ncoef < 0 ) ncoef++;
4956  else ncoef--;
4957  ncoef >>= 1;
4958  while ( t < vv ) *m++ = *t++;
4959  if ( MulRat(BHEAD (UWORD *)vv,ncoef,(UWORD *)tstop,jcoef,
4960  (UWORD *)m,&ncoef) ) Terminate(-1);
4961  ncoef *= 2;
4962  m += ABS(ncoef);
4963  if ( ncoef < 0 ) ncoef--;
4964  else ncoef++;
4965  *m++ = ncoef;
4966  *ww = WORDDIF(m,ww);
4967  if ( AN.ncmod != 0 ) {
4968  if ( Modulus(ww) ) Terminate(-1);
4969  if ( *ww == 0 ) return(1);
4970  m = ww + *ww;
4971  }
4972  t = v;
4973  }
4974  *w = (WORDDIF(m,w))+1;
4975  w[FUNHEAD-1] = w[0] - FUNHEAD;
4976  w[FUNHEAD] = 0;
4977  w[1] = 0; /* omission survived for years. 23-mar-2006 JV */
4978  w += FUNHEAD-1;
4979  if ( ToFast(w,w) ) {
4980  if ( *w <= -FUNCTION ) { w[-FUNHEAD+1] = FUNHEAD+1; m = w+1; }
4981  else { w[-FUNHEAD+1] = FUNHEAD+2; m = w+2; }
4982 
4983  }
4984  }
4985  t = poly + poly[1];
4986  while ( t < tstop ) *poly++ = *t++;
4987 /*
4988  #] One argument :
4989 */
4990  }
4991  else if ( AR.PolyFunType == 2 ) {
4992  DoTwo:;
4993 /*
4994  #[ Two arguments :
4995 */
4996  WORD *num, *den, size, sign, sizenum, sizeden;
4997 /*
4998  First make sure that the PolyFun is last
4999 */
5000  m = term + *term;
5001  if ( poly + poly[1] < tstop ) {
5002  for ( i = 0; i < poly[1]; i++ ) m[i] = poly[i];
5003  t = poly; v = poly + poly[1];
5004  while ( v < tstop ) *t++ = *v++;
5005  poly = t;
5006  for ( i = 0; i < m[1]; i++ ) t[i] = m[i];
5007  t += m[1];
5008  }
5009  AT.PolyAct = WORDDIF(poly,term);
5010 /*
5011  If needed we convert the coefficient into a PolyRatFun and then
5012  we call poly_ratfun_normalize
5013 */
5014  if ( m[-1] == 3 && m[-2] == 1 && m[-3] == 1 ) return(0);
5015  if ( AR.PolyFunExp != 1 ) {
5016  if ( m[-1] < 0 ) { sign = -1; size = -m[-1]; } else { sign = 1; size = m[-1]; }
5017  num = m - size; size = (size-1)/2; den = num + size;
5018  sizenum = size; while ( num[sizenum-1] == 0 ) sizenum--;
5019  sizeden = size; while ( den[sizeden-1] == 0 ) sizeden--;
5020  v = m;
5021  *v++ = AR.PolyFun;
5022  *v++ = FUNHEAD + 2*(ARGHEAD+sizenum+sizeden+2);
5023 /* *v++ = MUSTCLEANPRF; */
5024  *v++ = 0;
5025  FILLFUN3(v);
5026  *v++ = ARGHEAD+2*sizenum+2;
5027  *v++ = 0;
5028  FILLARG(v);
5029  *v++ = 2*sizenum+2;
5030  for ( i = 0; i < sizenum; i++ ) *v++ = num[i];
5031  *v++ = 1;
5032  for ( i = 1; i < sizenum; i++ ) *v++ = 0;
5033  *v++ = sign*(2*sizenum+1);
5034  *v++ = ARGHEAD+2*sizeden+2;
5035  *v++ = 0;
5036  FILLARG(v);
5037  *v++ = 2*sizeden+2;
5038  for ( i = 0; i < sizeden; i++ ) *v++ = den[i];
5039  *v++ = 1;
5040  for ( i = 1; i < sizeden; i++ ) *v++ = 0;
5041  *v++ = 2*sizeden+1;
5042  w = num;
5043  i = v - m;
5044  NCOPY(w,m,i);
5045  }
5046  else {
5047  w = m-ABS(m[-1]);
5048  }
5049  *w++ = 1; *w++ = 1; *w++ = 3; *term = w - term;
5050  {
5051  WORD oldtype = AR.SortType;
5052  AR.SortType = SORTHIGHFIRST;
5053 /*
5054  if ( count > 0 )
5055  poly_ratfun_normalize(BHEAD term);
5056  else
5057  ReadPolyRatFun(BHEAD term);
5058 */
5059  poly_ratfun_normalize(BHEAD term);
5060 
5061 /* oldworkpointer = AT.WorkPointer; */
5062  AR.SortType = oldtype;
5063  }
5064  goto endofit;
5065 /*
5066  #] Two arguments :
5067 */
5068  }
5069  else {
5070  DoError:;
5071  MLOCK(ErrorMessageLock);
5072  MesPrint("Illegal value for PolyFunType in PrepPoly");
5073  MUNLOCK(ErrorMessageLock);
5074  Terminate(-1);
5075  }
5076  r = term + *term;
5077  AT.PolyAct = WORDDIF(poly,term);
5078  while ( r < m ) *poly++ = *r++;
5079  *poly++ = 1;
5080  *poly++ = 1;
5081  *poly++ = 3;
5082  *term = WORDDIF(poly,term);
5083 endofit:;
5084  return(0);
5085 }
5086 
5087 /*
5088  #] PrepPoly :
5089  #[ PolyFunMul : WORD PolyFunMul(term)
5090 */
5102 WORD PolyFunMul(PHEAD WORD *term)
5103 {
5104  GETBIDENTITY
5105  WORD *t, *fun1, *fun2, *t1, *t2, *m, *w, *ww, *tt1, *tt2, *tt4, *arg1, *arg2;
5106  WORD *tstop, i, dirty = 0, OldPolyFunPow = AR.PolyFunPow, minp1, minp2;
5107  WORD n1, n2, i1, i2, l1, l2, l3, l4, action = 0, noac = 0, retval = 0;
5108  if ( AR.PolyFunType == 2 && AR.PolyFunExp == 1 ) {
5109  WORD pow = 0, pow1;
5110  t = term + 1; t1 = term + *term; t1 -= ABS(t1[-1]);
5111  w = t;
5112  while ( t < t1 ) {
5113  if ( *t != AR.PolyFun ) {
5114 SkipFun:
5115  if ( t == w ) { t += t[1]; w = t; }
5116  else { i = t[1]; NCOPY(w,t,i) }
5117  continue;
5118  }
5119  pow1 = 0;
5120  t2 = t + t[1]; t += FUNHEAD;
5121  if ( *t < 0 ) {
5122  if ( *t == -SYMBOL && t[1] == AR.PolyFunVar ) pow1++;
5123  else if ( *t != -SNUMBER ) goto NoLegal;
5124  t += 2;
5125  }
5126  else if ( t[0] == ARGHEAD+8 && t[ARGHEAD] == 8
5127  && t[ARGHEAD+1] == SYMBOL && t[ARGHEAD+3] == AR.PolyFunVar
5128  && t[ARGHEAD+5] == 1 && t[ARGHEAD+6] == 1 && t[ARGHEAD+7] == 3 ) {
5129  pow1 += t[ARGHEAD+4];
5130  t += *t;
5131  }
5132  else {
5133 NoLegal:
5134  MLOCK(ErrorMessageLock);
5135  MesPrint("Illegal term with divergence in PolyRatFun");
5136  MesCall("PolyFunMul");
5137  MUNLOCK(ErrorMessageLock);
5138  Terminate(-1);
5139  }
5140  if ( *t < 0 ) {
5141  if ( *t == -SYMBOL && t[1] == AR.PolyFunVar ) pow1--;
5142  else if ( *t != -SNUMBER ) goto NoLegal;
5143  t += 2;
5144  }
5145  else if ( t[0] == ARGHEAD+8 && t[ARGHEAD] == 8
5146  && t[ARGHEAD+1] == SYMBOL && t[ARGHEAD+3] == AR.PolyFunVar
5147  && t[ARGHEAD+5] == 1 && t[ARGHEAD+6] == 1 && t[ARGHEAD+7] == 3 ) {
5148  pow1 -= t[ARGHEAD+4];
5149  t += *t;
5150  }
5151  else goto NoLegal;
5152  if ( t == t2 ) pow += pow1;
5153  else goto SkipFun;
5154  }
5155  m = w;
5156  *w++ = AR.PolyFun; *w++ = 0; FILLFUN(w);
5157  if ( pow > 1 ) {
5158  *w++ = 8+ARGHEAD; *w++ = 0; FILLARG(w);
5159  *w++ = 8; *w++ = SYMBOL; *w++ = 4; *w++ = AR.PolyFunVar; *w++ = pow;
5160  *w++ = 1; *w++ = 1; *w++ = 3; *w++ = -SNUMBER; *w++ = 1;
5161  }
5162  else if ( pow == 1 ) {
5163  *w++ = -SYMBOL; *w++ = AR.PolyFunVar; *w++ = -SNUMBER; *w++ = 1;
5164  }
5165  else if ( pow < -1 ) {
5166  *w++ = -SNUMBER; *w++ = 1; *w++ = 8+ARGHEAD; *w++ = 0; FILLARG(w);
5167  *w++ = 8; *w++ = SYMBOL; *w++ = 4; *w++ = AR.PolyFunVar; *w++ = -pow;
5168  *w++ = 1; *w++ = 1; *w++ = 3;
5169  }
5170  else if ( pow == -1 ) {
5171  *w++ = -SNUMBER; *w++ = 1; *w++ = -SYMBOL; *w++ = AR.PolyFunVar;
5172  }
5173  else {
5174  *w++ = -SNUMBER; *w++ = 1; *w++ = -SNUMBER; *w++ = 1;
5175  }
5176  m[1] = w - m;
5177  *w++ = 1; *w++ = 1; *w++ = 3;
5178  *term = w - term;
5179  if ( w > AT.WorkSpace && w < AT.WorkTop ) AT.WorkPointer = w;
5180  return(0);
5181  }
5182 ReStart:
5183  if ( AR.PolyFunType == 2 && ( ( AR.PolyFunExp != 2 )
5184  || ( AR.PolyFunExp == 2 && AN.PolyNormFlag > 1 ) ) ) {
5185  WORD count1 = 0, count2 = 0, count3;
5186  WORD oldtype = AR.SortType;
5187  t = term + 1; t1 = term + *term; t1 -= ABS(t1[-1]);
5188  while ( t < t1 ) {
5189  if ( *t == AR.PolyFun ) {
5190  if ( t[2] && dirty == 0 ) { /* Any dirty flag on? */
5191  dirty = 1;
5192 /* ReadPolyRatFun(BHEAD term); */
5193 /* ToPolyFunGeneral(BHEAD term); */
5194  poly_ratfun_normalize(BHEAD term);
5195  if ( term[0] == 0 ) return(0);
5196  count1 = 0;
5197  action++;
5198  goto ReStart;
5199  }
5200  t2 = t + t[1]; tt2 = t+FUNHEAD; count3 = 0;
5201  while ( tt2 < t2 ) { count3++; NEXTARG(tt2); }
5202  if ( count3 == 2 ) {
5203  count1++;
5204  if ( ( t[2] & MUSTCLEANPRF ) != 0 ) { /* Better civilize this guy */
5205  action++;
5206  w = AT.WorkPointer;
5207  AR.SortType = SORTHIGHFIRST;
5208  t2 = t + t[1]; tt2 = t+FUNHEAD;
5209  while ( tt2 < t2 ) {
5210  if ( *tt2 > 0 ) {
5211  tt4 = tt2; tt1 = tt2 + ARGHEAD; tt2 += *tt2;
5212  NewSort(BHEAD0);
5213  while ( tt1 < tt2 ) {
5214  i = *tt1; ww = w; NCOPY(ww,tt1,i);
5215  AT.WorkPointer = ww;
5216  Normalize(BHEAD w);
5217  StoreTerm(BHEAD w);
5218  }
5219  EndSort(BHEAD w,1);
5220  ww = w; while ( *ww ) ww += *ww;
5221  if ( ww-w != *tt4-ARGHEAD ) { /* Little problem */
5222 /*
5223  Solution: brute force copy
5224  Maybe it will never come here????
5225 */
5226  WORD *r1 = TermMalloc("PolyFunMul");
5227  WORD ii = (ww-w)-(*tt4-ARGHEAD); /* increment */
5228  WORD *r2 = tt4+ARGHEAD, *r3, *r4 = r1;
5229  i = r2 - term; r3 = term; NCOPY(r4,r3,i);
5230  i = ww-w; ww = w; NCOPY(r4,ww,i);
5231  r3 = tt2; i = term+*term-tt2; NCOPY(r4,r3,i);
5232  *r1 = i = r4-r1; r4 = term; r3 = r1;
5233  NCOPY(r4,r3,i);
5234  t[1] += ii; t1 += ii; *tt4 += ii;
5235  tt2 = tt4 + *tt4;
5236  TermFree(r1,"PolyFunMul");
5237  }
5238  else {
5239  i = ww-w; ww = w; tt1 = tt4+ARGHEAD;
5240  NCOPY(tt1,ww,i);
5241  AT.WorkPointer = w;
5242  }
5243  }
5244  else if ( *tt2 <= -FUNCTION ) tt2++;
5245  else tt2 += 2;
5246  }
5247  AR.SortType = oldtype;
5248  }
5249  }
5250  }
5251  t += t[1];
5252  }
5253  if ( count1 <= 1 ) { goto checkaction; }
5254  if ( AR.PolyFunExp == 1 ) {
5255  t = term + *term; t -= ABS(t[-1]);
5256  *t++ = 1; *t++ = 1; *t++ = 3; *term = t - term;
5257  }
5258  {
5259  AR.SortType = SORTHIGHFIRST;
5260 /* retval = ReadPolyRatFun(BHEAD term); */
5261 /* ToPolyFunGeneral(BHEAD term); */
5262  retval = poly_ratfun_normalize(BHEAD term);
5263  if ( *term == 0 ) return(retval);
5264  AR.SortType = oldtype;
5265  }
5266 
5267  t = term + 1; t1 = term + *term; t1 -= ABS(t1[-1]);
5268  while ( t < t1 ) {
5269  if ( *t == AR.PolyFun ) {
5270  t2 = t + t[1]; tt2 = t+FUNHEAD; count3 = 0;
5271  while ( tt2 < t2 ) { count3++; NEXTARG(tt2); }
5272  if ( count3 == 2 ) {
5273  count2++;
5274  }
5275  }
5276  t += t[1];
5277  }
5278  if ( count1 >= count2 ) {
5279  t = term + 1;
5280  while ( t < t1 ) {
5281  if ( *t == AR.PolyFun ) {
5282  t2 = t;
5283  t = t + t[1];
5284  t2[2] |= (DIRTYFLAG|MUSTCLEANPRF);
5285  t2 += FUNHEAD;
5286  while ( t2 < t ) {
5287  if ( *t2 > 0 ) t2[1] = DIRTYFLAG;
5288  NEXTARG(t2);
5289  }
5290  }
5291  else t += t[1];
5292  }
5293  }
5294 
5295  w = term + *term;
5296  if ( w > AT.WorkSpace && w < AT.WorkTop ) AT.WorkPointer = w;
5297 checkaction:
5298  if ( action ) retval = action;
5299  return(retval);
5300  }
5301 retry:
5302  if ( term >= AT.WorkSpace && term+*term < AT.WorkTop )
5303  AT.WorkPointer = term + *term;
5304  GETSTOP(term,tstop);
5305  t = term+1;
5306  while ( *t != AR.PolyFun && t < tstop ) t += t[1];
5307  while ( t < tstop && *t == AR.PolyFun ) {
5308  if ( t[1] > FUNHEAD ) {
5309  if ( t[FUNHEAD] < 0 ) {
5310  if ( t[FUNHEAD] <= -FUNCTION && t[1] == FUNHEAD+1 ) break;
5311  if ( t[FUNHEAD] > -FUNCTION && t[1] == FUNHEAD+2 ) {
5312  if ( t[FUNHEAD] == -SNUMBER && t[FUNHEAD+1] == 0 ) {
5313  *term = 0;
5314  return(0);
5315  }
5316  break;
5317  }
5318  }
5319  else if ( t[FUNHEAD] == t[1] - FUNHEAD ) break;
5320  }
5321  noac = 1;
5322  t += t[1];
5323  }
5324  if ( *t != AR.PolyFun || t >= tstop ) goto done;
5325  fun1 = t;
5326  t += t[1];
5327  while ( t < tstop && *t == AR.PolyFun ) {
5328  if ( t[1] > FUNHEAD ) {
5329  if ( t[FUNHEAD] < 0 ) {
5330  if ( t[FUNHEAD] <= -FUNCTION && t[1] == FUNHEAD+1 ) break;
5331  if ( t[FUNHEAD] > -FUNCTION && t[1] == FUNHEAD+2 ) {
5332  if ( t[FUNHEAD] == -SNUMBER && t[FUNHEAD+1] == 0 ) {
5333  *term = 0;
5334  return(0);
5335  }
5336  break;
5337  }
5338  }
5339  else if ( t[FUNHEAD] == t[1] - FUNHEAD ) break;
5340  }
5341  noac = 1;
5342  t += t[1];
5343  }
5344  if ( *t != AR.PolyFun || t >= tstop ) goto done;
5345  fun2 = t;
5346 /*
5347  We have two functions of the proper type.
5348  Count terms (needed for the specials)
5349 */
5350  t = fun1 + FUNHEAD;
5351  if ( *t < 0 ) {
5352  n1 = 1; arg1 = AT.WorkPointer;
5353  ToGeneral(t,arg1,1);
5354  AT.WorkPointer = arg1 + *arg1;
5355  }
5356  else {
5357  t += ARGHEAD;
5358  n1 = 0; t1 = fun1 + fun1[1]; arg1 = t;
5359  while ( t < t1 ) { n1++; t += *t; }
5360  }
5361  t = fun2 + FUNHEAD;
5362  if ( *t < 0 ) {
5363  n2 = 1; arg2 = AT.WorkPointer;
5364  ToGeneral(t,arg2,1);
5365  AT.WorkPointer = arg2 + *arg2;
5366  }
5367  else {
5368  t += ARGHEAD;
5369  n2 = 0; t2 = fun2 + fun2[1]; arg2 = t;
5370  while ( t < t2 ) { n2++; t += *t; }
5371  }
5372 /*
5373  Now we can start the multiplications. We first multiply the terms
5374  without coefficients, then normalize, and finally put the coefficients
5375  in place. This is because one has often truncated series and the
5376  high powers may get killed, while their coefficients are the most
5377  expensive ones.
5378  Note: We may run into fun(-SNUMBER,value)
5379 */
5380  w = AT.WorkPointer;
5381  NewSort(BHEAD0);
5382  if ( AR.PolyFunType == 2 && AR.PolyFunExp == 2 ) {
5383  AT.TrimPower = 1;
5384 /*
5385  We have to find the lowest power in both polynomials.
5386  This will be needed to temporarily correct the AR.PolyFunPow
5387 */
5388  minp1 = MAXPOWER;
5389  for ( t1 = arg1, i1 = 0; i1 < n1; i1++, t1 += *t1 ) {
5390  if ( *t1 == 4 ) {
5391  if ( minp1 > 0 ) minp1 = 0;
5392  }
5393  else if ( ABS(t1[*t1-1]) == (*t1-1) ) {
5394  if ( minp1 > 0 ) minp1 = 0;
5395  }
5396  else {
5397  if ( t1[1] == SYMBOL && t1[2] == 4 && t1[3] == AR.PolyFunVar ) {
5398  if ( t1[4] < minp1 ) minp1 = t1[4];
5399  }
5400  else {
5401  MesPrint("Illegal term in expanded polyratfun.");
5402  goto PolyCall;
5403  }
5404  }
5405  }
5406  minp2 = MAXPOWER;
5407  for ( t2 = arg2, i2 = 0; i2 < n2; i2++, t2 += *t2 ) {
5408  if ( *t2 == 4 ) {
5409  if ( minp2 > 0 ) minp2 = 0;
5410  }
5411  else if ( ABS(t2[*t2-1]) == (*t2-1) ) {
5412  if ( minp2 > 0 ) minp2 = 0;
5413  }
5414  else {
5415  if ( t2[1] == SYMBOL && t2[2] == 4 && t2[3] == AR.PolyFunVar ) {
5416  if ( t2[4] < minp2 ) minp2 = t2[4];
5417  }
5418  else {
5419  MesPrint("Illegal term in expanded polyratfun.");
5420  goto PolyCall;
5421  }
5422  }
5423  }
5424  AR.PolyFunPow += minp1+minp2;
5425  }
5426  for ( t1 = arg1, i1 = 0; i1 < n1; i1++, t1 += *t1 ) {
5427  for ( t2 = arg2, i2 = 0; i2 < n2; i2++, t2 += *t2 ) {
5428  m = w;
5429  m++;
5430  GETSTOP(t1,tt1);
5431  t = t1 + 1;
5432  while ( t < tt1 ) *m++ = *t++;
5433  GETSTOP(t2,tt2);
5434  t = t2+1;
5435  while ( t < tt2 ) *m++ = *t++;
5436  *m++ = 1; *m++ = 1; *m++ = 3; *w = WORDDIF(m,w);
5437  AT.WorkPointer = m;
5438  if ( Normalize(BHEAD w) ) { LowerSortLevel(); goto PolyCall; }
5439  if ( *w ) {
5440  m = w + *w;
5441  if ( m[-1] != 3 || m[-2] != 1 || m[-3] != 1 ) {
5442  l3 = REDLENG(m[-1]);
5443  m -= ABS(m[-1]);
5444  t = t1 + *t1 - 1;
5445  l1 = REDLENG(*t);
5446  if ( MulRat(BHEAD (UWORD *)m,l3,(UWORD *)tt1,l1,(UWORD *)m,&l4) ) {
5447  LowerSortLevel(); goto PolyCall; }
5448  if ( AN.ncmod != 0 && TakeModulus((UWORD *)m,&l4,AC.cmod,AN.ncmod,UNPACK|AC.modmode) ) {
5449  LowerSortLevel(); goto PolyCall; }
5450  if ( l4 == 0 ) continue;
5451  t = t2 + *t2 - 1;
5452  l2 = REDLENG(*t);
5453  if ( MulRat(BHEAD (UWORD *)m,l4,(UWORD *)tt2,l2,(UWORD *)m,&l3) ) {
5454  LowerSortLevel(); goto PolyCall; }
5455  if ( AN.ncmod != 0 && TakeModulus((UWORD *)m,&l3,AC.cmod,AN.ncmod,UNPACK|AC.modmode) ) {
5456  LowerSortLevel(); goto PolyCall; }
5457  }
5458  else {
5459  m -= 3;
5460  t = t1 + *t1 - 1;
5461  l1 = REDLENG(*t);
5462  t = t2 + *t2 - 1;
5463  l2 = REDLENG(*t);
5464  if ( MulRat(BHEAD (UWORD *)tt1,l1,(UWORD *)tt2,l2,(UWORD *)m,&l3) ) {
5465  LowerSortLevel(); goto PolyCall; }
5466  if ( AN.ncmod != 0 && TakeModulus((UWORD *)m,&l3,AC.cmod,AN.ncmod,UNPACK|AC.modmode) ) {
5467  LowerSortLevel(); goto PolyCall; }
5468  }
5469  if ( l3 == 0 ) continue;
5470  l3 = INCLENG(l3);
5471  m += ABS(l3);
5472  m[-1] = l3;
5473  *w = WORDDIF(m,w);
5474  AT.WorkPointer = m;
5475  if ( StoreTerm(BHEAD w) ) { LowerSortLevel(); goto PolyCall; }
5476  }
5477  }
5478  }
5479  if ( EndSort(BHEAD w,0) < 0 ) goto PolyCall;
5480  AR.PolyFunPow = OldPolyFunPow;
5481  AT.TrimPower = 0;
5482  if ( *w == 0 ) {
5483  *term = 0;
5484  return(0);
5485  }
5486  t = w;
5487  while ( *t ) t += *t;
5488  AT.WorkPointer = t;
5489  n1 = WORDDIF(t,w);
5490  t1 = term;
5491  while ( t1 < fun1 ) *t++ = *t1++;
5492  t2 = t;
5493  *t++ = AR.PolyFun;
5494  *t++ = FUNHEAD+ARGHEAD+n1;
5495  *t++ = 0;
5496  FILLFUN3(t)
5497  *t++ = ARGHEAD+n1;
5498  *t++ = 0;
5499  FILLARG(t)
5500  NCOPY(t,w,n1);
5501  if ( ToFast(t2+FUNHEAD,t2+FUNHEAD) ) {
5502  if ( t2[FUNHEAD] > -FUNCTION ) t2[1] = FUNHEAD+2;
5503  else t2[FUNHEAD] = FUNHEAD+1;
5504  t = t2 + t2[1];
5505  }
5506  t1 = fun1 + fun1[1];
5507  while ( t1 < fun2 ) *t++ = *t1++;
5508  t1 = fun2 + fun2[1];
5509  t2 = term + *term;
5510  while ( t1 < t2 ) *t++ = *t1++;
5511  *AT.WorkPointer = n1 = WORDDIF(t,AT.WorkPointer);
5512  if ( n1*((LONG)sizeof(WORD)) > AM.MaxTer ) {
5513  MLOCK(ErrorMessageLock);
5514  MesPrint("Term too complex. Maybe increasing MaxTermSize can help");
5515  goto PolyCall2;
5516  }
5517  m = term; t = AT.WorkPointer;
5518  NCOPY(m,t,n1);
5519  action++;
5520  goto retry;
5521 done:
5522  AT.WorkPointer = term + *term;
5523  if ( action && noac ) {
5524  if ( Normalize(BHEAD term) ) goto PolyCall;
5525  AT.WorkPointer = term + *term;
5526  }
5527  return(0);
5528 PolyCall:;
5529  MLOCK(ErrorMessageLock);
5530 PolyCall2:;
5531  AR.PolyFunPow = OldPolyFunPow;
5532  MesCall("PolyFunMul");
5533  MUNLOCK(ErrorMessageLock);
5534  SETERROR(-1)
5535 }
5536 
5537 /*
5538  #] PolyFunMul :
5539  #] Processor :
5540 */
WORD Compare1(WORD *, WORD *, WORD)
Definition: sort.c:2535
WORD CompareSymbols(WORD *, WORD *, WORD)
Definition: sort.c:2975
int PutPreVar(UBYTE *, UBYTE *, UBYTE *, int)
Definition: pre.c:642
WORD size
Definition: structs.h:309
WORD * pattern
Definition: structs.h:356
Definition: structs.h:633
WORD Processor()
Definition: proces.c:64
WORD InFunction(PHEAD WORD *, WORD *)
Definition: proces.c:2004
int sparse
Definition: structs.h:373
WORD PrepPoly(PHEAD WORD *, WORD)
Definition: proces.c:4714
int SymbolNormalize(WORD *)
Definition: normal.c:5000
WORD PolyFunMul(PHEAD WORD *)
Definition: proces.c:5102
int strict
Definition: structs.h:372
WORD PF_Deferred(WORD *term, WORD level)
Definition: parallel.c:1208
WORD * DoubleCbuffer(int num, WORD *w, int par)
Definition: comtool.c:143
int PF_InParallelProcessor(void)
Definition: parallel.c:3611
WORD ** lhs
Definition: structs.h:942
int numind
Definition: structs.h:370
WORD mini
Definition: structs.h:307
Definition: structs.h:938
WORD InsertTerm(PHEAD WORD *, WORD, WORD, WORD *, WORD *, WORD)
Definition: proces.c:2550
WORD * Pointer
Definition: structs.h:941
WORD FiniTerm(PHEAD WORD *, WORD *, WORD *, WORD, WORD)
Definition: proces.c:2873
WORD StoreTerm(PHEAD WORD *)
Definition: sort.c:4332
WORD maxi
Definition: structs.h:308
WORD TestMatch(PHEAD WORD *, WORD *)
Definition: pattern.c:97
WORD * tablepointers
Definition: structs.h:350
WORD DoOnePow(PHEAD WORD *, WORD, WORD, WORD *, WORD *, WORD, WORD *)
Definition: proces.c:4365
Definition: poly.h:49
WORD ** rhs
Definition: structs.h:943
LONG PasteFile(PHEAD WORD, WORD *, POSITION *, WORD **, RENUMBER, WORD *, WORD)
Definition: proces.c:2686
WORD bufnum
Definition: structs.h:377
WORD Deferred(PHEAD WORD *, WORD)
Definition: proces.c:4586
MINMAX * mm
Definition: structs.h:358
VOID LowerSortLevel()
Definition: sort.c:4726
WORD * prototype
Definition: structs.h:355
int bounds
Definition: structs.h:371
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
Definition: sort.c:1404
WORD * Buffer
Definition: structs.h:939
WORD TestSub(PHEAD WORD *, WORD)
Definition: proces.c:681
WORD NewSort(PHEAD0)
Definition: sort.c:591
WORD Generator(PHEAD WORD *, WORD)
Definition: proces.c:3072
WORD * PasteTerm(PHEAD WORD, WORD *, WORD *, WORD, WORD)
Definition: proces.c:2808
WORD * Top
Definition: structs.h:940
WORD FlushOut(POSITION *, FILEHANDLE *, int)
Definition: sort.c:1747
int PF_Processor(EXPRESSIONS e, WORD i, WORD LastExpression)
Definition: parallel.c:1540
int handle
Definition: structs.h:661
LONG EndSort(PHEAD WORD *, int)
Definition: sort.c:681
VARRENUM symb
Definition: structs.h:180
LONG * CanCommu
Definition: structs.h:944
int PF_BroadcastRHS(void)
Definition: parallel.c:3564
WORD * AddRHS(int num, int type)
Definition: comtool.c:214
WORD * lo
Definition: structs.h:167