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