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