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