FORM  4.1
execute.c
Go to the documentation of this file.
1 
6 /* #[ License : */
7 /*
8  * Copyright (C) 1984-2013 J.A.M. Vermaseren
9  * When using this file you are requested to refer to the publication
10  * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
11  * This is considered a matter of courtesy as the development was paid
12  * for by FOM the Dutch physics granting agency and we would like to
13  * be able to track its scientific use to convince FOM of its value
14  * for the community.
15  *
16  * This file is part of FORM.
17  *
18  * FORM is free software: you can redistribute it and/or modify it under the
19  * terms of the GNU General Public License as published by the Free Software
20  * Foundation, either version 3 of the License, or (at your option) any later
21  * version.
22  *
23  * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
24  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
25  * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
26  * details.
27  *
28  * You should have received a copy of the GNU General Public License along
29  * with FORM. If not, see <http://www.gnu.org/licenses/>.
30  */
31 /* #] License : */
32 /*
33  #[ Includes : execute.c
34 */
35 
36 #include "form3.h"
37 
38 /*
39  #] Includes :
40  #[ DoExecute :
41  #[ CleanExpr :
42 
43  par == 1 after .store or .clear
44  par == 0 after .sort
45 */
46 
47 WORD CleanExpr(WORD par)
48 {
49  GETIDENTITY
50  WORD j, n, i;
51  POSITION length;
52  EXPRESSIONS e_in, e_out, e;
53  int numhid = 0;
54  NAMENODE *node;
55  n = NumExpressions;
56  j = 0;
57  e_in = e_out = Expressions;
58  if ( n > 0 ) { do {
59  e_in->vflags &= ~( TOBEFACTORED | TOBEUNFACTORED );
60  if ( par ) {
61  if ( e_in->renumlists ) {
62  if ( e_in->renumlists != AN.dummyrenumlist )
63  M_free(e_in->renumlists,"Renumber-lists");
64  e_in->renumlists = 0;
65  }
66  if ( e_in->renum ) {
67  M_free(e_in->renum,"Renumber"); e_in->renum = 0;
68  }
69  }
70  if ( e_in->status == HIDDENLEXPRESSION
71  || e_in->status == HIDDENGEXPRESSION ) numhid++;
72  switch ( e_in->status ) {
73  case LOCALEXPRESSION:
74  case HIDDENLEXPRESSION:
75  if ( par ) {
76  AC.exprnames->namenode[e_in->node].type = CDELETE;
77  AC.DidClean = 1;
78  if ( e_in->status != HIDDENLEXPRESSION )
79  ClearBracketIndex(e_in-Expressions);
80  break;
81  }
82  case GLOBALEXPRESSION:
83  case HIDDENGEXPRESSION:
84  if ( par ) {
85 #ifdef WITHMPI
86  /*
87  * Broadcast the global expression from the master to the all workers.
88  */
89  if ( PF_BroadcastExpr(e_in, e_in->status == HIDDENGEXPRESSION ? AR.hidefile : AR.outfile) ) return -1;
90  if ( PF.me == MASTER ) {
91 #endif
92  e = e_in;
93  i = n-1;
94  while ( --i >= 0 ) {
95  e++;
96  if ( e_in->status == HIDDENGEXPRESSION ) {
97  if ( e->status == HIDDENGEXPRESSION
98  || e->status == HIDDENLEXPRESSION ) break;
99  }
100  else {
101  if ( e->status == GLOBALEXPRESSION
102  || e->status == LOCALEXPRESSION ) break;
103  }
104  }
105 #ifdef WITHMPI
106  }
107  else {
108  /*
109  * On the slaves, the broadcast expression is sitting at the end of the file.
110  */
111  e = e_in;
112  i = -1;
113  }
114 #endif
115  if ( i >= 0 ) {
116  DIFPOS(length,e->onfile,e_in->onfile);
117  }
118  else {
119  FILEHANDLE *f = e_in->status == HIDDENGEXPRESSION ? AR.hidefile : AR.outfile;
120  if ( f->handle < 0 ) {
121  SETBASELENGTH(length,TOLONG(f->POfull)
122  - TOLONG(f->PObuffer)
123  - BASEPOSITION(e_in->onfile));
124  }
125  else {
126  SeekFile(f->handle,&(f->filesize),SEEK_SET);
127  DIFPOS(length,f->filesize,e_in->onfile);
128  }
129  }
130  if ( ToStorage(e_in,&length) ) {
131  return(MesCall("CleanExpr"));
132  }
133  e_in->status = STOREDEXPRESSION;
134  if ( e_in->status != HIDDENGEXPRESSION )
135  ClearBracketIndex(e_in-Expressions);
136  }
137  /* Fall through is intentional */
138  case SKIPLEXPRESSION:
139  case DROPLEXPRESSION:
140  case DROPHLEXPRESSION:
141  case DROPGEXPRESSION:
142  case DROPHGEXPRESSION:
143  case STOREDEXPRESSION:
144  if ( e_out != e_in ) {
145  node = AC.exprnames->namenode + e_in->node;
146  node->number = e_out - Expressions;
147 
148  e_out->onfile = e_in->onfile;
149  e_out->printflag = 0;
150  if ( par ) e_out->status = STOREDEXPRESSION;
151  else e_out->status = e_in->status;
152  e_out->name = e_in->name;
153  e_out->node = e_in->node;
154  e_out->renum = e_in->renum;
155  e_out->renumlists = e_in->renumlists;
156  e_out->counter = e_in->counter;
157  e_out->hidelevel = e_in->hidelevel;
158  e_out->inmem = e_in->inmem;
159  e_out->bracketinfo = e_in->bracketinfo;
160  e_out->newbracketinfo = e_in->newbracketinfo;
161  e_out->numdummies = e_in->numdummies;
162  e_out->numfactors = e_in->numfactors;
163  e_out->vflags = e_in->vflags;
164  }
165 #ifdef PARALLELCODE
166  e_out->partodo = 0;
167 #endif
168  e_out++;
169  j++;
170  break;
171  case DROPPEDEXPRESSION:
172  break;
173  default:
174  AC.exprnames->namenode[e_in->node].type = CDELETE;
175  AC.DidClean = 1;
176  break;
177  }
178  e_in++;
179  } while ( --n > 0 ); }
180  UpdateMaxSize();
181  NumExpressions = j;
182  if ( numhid == 0 && AR.hidefile->PObuffer ) {
183  if ( AR.hidefile->handle >= 0 ) {
184  CloseFile(AR.hidefile->handle);
185  remove(AR.hidefile->name);
186  AR.hidefile->handle = -1;
187  }
188  AR.hidefile->POfull =
189  AR.hidefile->POfill = AR.hidefile->PObuffer;
190  PUTZERO(AR.hidefile->POposition);
191  }
192  return(0);
193 }
194 
195 /*
196  #] CleanExpr :
197  #[ PopVariables :
198 
199  Pops the local variables from the tables.
200  The Expressions are reprocessed and their tables are compactified.
201 
202 */
203 
204 WORD PopVariables()
205 {
206  GETIDENTITY
207  WORD i, j, retval;
208  UBYTE *s;
209 
210  retval = CleanExpr(1);
211  ResetVariables(1);
212 
213  if ( AC.DidClean ) CompactifyTree(AC.exprnames,EXPRNAMES);
214 
215  AC.CodesFlag = AM.gCodesFlag;
216  AC.NamesFlag = AM.gNamesFlag;
217  AC.StatsFlag = AM.gStatsFlag;
218  AC.OldFactArgFlag = AM.gOldFactArgFlag;
219  AC.TokensWriteFlag = AM.gTokensWriteFlag;
220  AC.extrasymbols = AM.gextrasymbols;
221  if ( AC.extrasym ) { M_free(AC.extrasym,"extrasym"); AC.extrasym = 0; }
222  i = 1; s = AM.gextrasym; while ( *s ) { s++; i++; }
223  AC.extrasym = (UBYTE *)Malloc1(i*sizeof(UBYTE),"extrasym");
224  for ( j = 0; j < i; j++ ) AC.extrasym[j] = AM.gextrasym[j];
225  AO.NoSpacesInNumbers = AM.gNoSpacesInNumbers;
226  AO.IndentSpace = AM.gIndentSpace;
227  AC.lUnitTrace = AM.gUnitTrace;
228  AC.lDefDim = AM.gDefDim;
229  AC.lDefDim4 = AM.gDefDim4;
230  if ( AC.halfmod ) {
231  if ( AC.ncmod == AM.gncmod && AC.modmode == AM.gmodmode ) {
232  j = ABS(AC.ncmod);
233  while ( --j >= 0 ) {
234  if ( AC.cmod[j] != AM.gcmod[j] ) break;
235  }
236  if ( j >= 0 ) {
237  M_free(AC.halfmod,"halfmod");
238  AC.halfmod = 0; AC.nhalfmod = 0;
239  }
240  }
241  else {
242  M_free(AC.halfmod,"halfmod");
243  AC.halfmod = 0; AC.nhalfmod = 0;
244  }
245  }
246  if ( AC.modinverses ) {
247  if ( AC.ncmod == AM.gncmod && AC.modmode == AM.gmodmode ) {
248  j = ABS(AC.ncmod);
249  while ( --j >= 0 ) {
250  if ( AC.cmod[j] != AM.gcmod[j] ) break;
251  }
252  if ( j >= 0 ) {
253  M_free(AC.modinverses,"modinverses");
254  AC.modinverses = 0;
255  }
256  }
257  else {
258  M_free(AC.modinverses,"modinverses");
259  AC.modinverses = 0;
260  }
261  }
262  AN.ncmod = AC.ncmod = AM.gncmod;
263  AC.npowmod = AM.gnpowmod;
264  AC.modmode = AM.gmodmode;
265  if ( ( ( AC.modmode & INVERSETABLE ) != 0 ) && ( AC.modinverses == 0 ) )
266  MakeInverses();
267  AC.funpowers = AM.gfunpowers;
268  AC.lPolyFun = AM.gPolyFun;
269  AC.lPolyFunType = AM.gPolyFunType;
270  AC.parallelflag = AM.gparallelflag;
271  AC.ProcessBucketSize = AC.mProcessBucketSize = AM.gProcessBucketSize;
272  AC.properorderflag = AM.gproperorderflag;
273  AC.ThreadBucketSize = AM.gThreadBucketSize;
274  AC.ThreadStats = AM.gThreadStats;
275  AC.FinalStats = AM.gFinalStats;
276  AC.ThreadsFlag = AM.gThreadsFlag;
277  AC.ThreadBalancing = AM.gThreadBalancing;
278  AC.ThreadSortFileSynch = AM.gThreadSortFileSynch;
279  AC.ProcessStats = AM.gProcessStats;
280  AC.OldParallelStats = AM.gOldParallelStats;
281  AC.IsFortran90 = AM.gIsFortran90;
282  if ( AC.Fortran90Kind ) {
283  M_free(AC.Fortran90Kind,"Fortran90 Kind");
284  AC.Fortran90Kind = 0;
285  }
286  if ( AM.gFortran90Kind ) {
287  AC.Fortran90Kind = strDup1(AM.gFortran90Kind,"Fortran90 Kind");
288  }
289  if ( AC.ThreadsFlag && AM.totalnumberofthreads > 1 ) AS.MultiThreaded = 1;
290  {
291  UWORD *p, *m;
292  p = AM.gcmod;
293  m = AC.cmod;
294  j = ABS(AC.ncmod);
295  NCOPY(m,p,j);
296  p = AM.gpowmod;
297  m = AC.powmod;
298  j = AC.npowmod;
299  NCOPY(m,p,j);
300  if ( AC.DirtPow ) {
301  if ( MakeModTable() ) {
302  MesPrint("===No printing in powers of generator");
303  }
304  AC.DirtPow = 0;
305  }
306  }
307  {
308  WORD *p, *m;
309  p = AM.gUniTrace;
310  m = AC.lUniTrace;
311  j = 4;
312  NCOPY(m,p,j);
313  }
314  AC.Cnumpows = AM.gCnumpows;
315  AC.OutputMode = AM.gOutputMode;
316  AC.OutputSpaces = AM.gOutputSpaces;
317  AC.OutNumberType = AM.gOutNumberType;
318  AR.SortType = AC.SortType = AM.gSortType;
319  AC.ShortStatsMax = AM.gShortStatsMax;
320  return(retval);
321 }
322 
323 /*
324  #] PopVariables :
325  #[ MakeGlobal :
326 */
327 
328 VOID MakeGlobal()
329 {
330  WORD i, j, *pp, *mm;
331  UWORD *p, *m;
332  UBYTE *s;
333  Globalize(0);
334 
335  AM.gCodesFlag = AC.CodesFlag;
336  AM.gNamesFlag = AC.NamesFlag;
337  AM.gStatsFlag = AC.StatsFlag;
338  AM.gOldFactArgFlag = AC.OldFactArgFlag;
339  AM.gextrasymbols = AC.extrasymbols;
340  if ( AM.gextrasym ) { M_free(AM.gextrasym,"extrasym"); AM.gextrasym = 0; }
341  i = 1; s = AC.extrasym; while ( *s ) { s++; i++; }
342  AM.gextrasym = (UBYTE *)Malloc1(i*sizeof(UBYTE),"extrasym");
343  for ( j = 0; j < i; j++ ) AM.gextrasym[j] = AC.extrasym[j];
344  AM.gTokensWriteFlag= AC.TokensWriteFlag;
345  AM.gNoSpacesInNumbers = AO.NoSpacesInNumbers;
346  AM.gIndentSpace = AO.IndentSpace;
347  AM.gUnitTrace = AC.lUnitTrace;
348  AM.gDefDim = AC.lDefDim;
349  AM.gDefDim4 = AC.lDefDim4;
350  AM.gncmod = AC.ncmod;
351  AM.gnpowmod = AC.npowmod;
352  AM.gmodmode = AC.modmode;
353  AM.gCnumpows = AC.Cnumpows;
354  AM.gOutputMode = AC.OutputMode;
355  AM.gOutputSpaces = AC.OutputSpaces;
356  AM.gOutNumberType = AC.OutNumberType;
357  AM.gfunpowers = AC.funpowers;
358  AM.gPolyFun = AC.lPolyFun;
359  AM.gPolyFunType = AC.lPolyFunType;
360  AM.gparallelflag = AC.parallelflag;
361  AM.gProcessBucketSize = AC.ProcessBucketSize;
362  AM.gproperorderflag = AC.properorderflag;
363  AM.gThreadBucketSize = AC.ThreadBucketSize;
364  AM.gThreadStats = AC.ThreadStats;
365  AM.gFinalStats = AC.FinalStats;
366  AM.gThreadsFlag = AC.ThreadsFlag;
367  AM.gThreadBalancing = AC.ThreadBalancing;
368  AM.gThreadSortFileSynch = AC.ThreadSortFileSynch;
369  AM.gProcessStats = AC.ProcessStats;
370  AM.gOldParallelStats = AC.OldParallelStats;
371  AM.gIsFortran90 = AC.IsFortran90;
372  if ( AM.gFortran90Kind ) {
373  M_free(AM.gFortran90Kind,"Fortran 90 Kind");
374  AM.gFortran90Kind = 0;
375  }
376  if ( AC.Fortran90Kind ) {
377  AM.gFortran90Kind = strDup1(AC.Fortran90Kind,"Fortran 90 Kind");
378  }
379  p = AM.gcmod;
380  m = AC.cmod;
381  i = ABS(AC.ncmod);
382  NCOPY(p,m,i);
383  p = AM.gpowmod;
384  m = AC.powmod;
385  i = AC.npowmod;
386  NCOPY(p,m,i);
387  pp = AM.gUniTrace;
388  mm = AC.lUniTrace;
389  i = 4;
390  NCOPY(pp,mm,i);
391  AM.gSortType = AC.SortType;
392  AM.gShortStatsMax = AC.ShortStatsMax;
393 }
394 
395 /*
396  #] MakeGlobal :
397  #[ TestDrop :
398 */
399 
400 VOID TestDrop()
401 {
402  EXPRESSIONS e;
403  WORD j;
404  for ( j = 0, e = Expressions; j < NumExpressions; j++, e++ ) {
405  switch ( e->status ) {
406  case SKIPLEXPRESSION:
407  e->status = LOCALEXPRESSION;
408  break;
409  case UNHIDELEXPRESSION:
410  e->status = LOCALEXPRESSION;
411  ClearBracketIndex(j);
412  e->bracketinfo = e->newbracketinfo; e->newbracketinfo = 0;
413  break;
414  case HIDELEXPRESSION:
415  e->status = HIDDENLEXPRESSION;
416  break;
417  case SKIPGEXPRESSION:
418  e->status = GLOBALEXPRESSION;
419  break;
420  case UNHIDEGEXPRESSION:
421  e->status = GLOBALEXPRESSION;
422  ClearBracketIndex(j);
423  e->bracketinfo = e->newbracketinfo; e->newbracketinfo = 0;
424  break;
425  case HIDEGEXPRESSION:
426  e->status = HIDDENGEXPRESSION;
427  break;
428  case DROPLEXPRESSION:
429  case DROPGEXPRESSION:
430  case DROPHLEXPRESSION:
431  case DROPHGEXPRESSION:
432  e->status = DROPPEDEXPRESSION;
433  ClearBracketIndex(j);
434  e->bracketinfo = e->newbracketinfo; e->newbracketinfo = 0;
435  if ( e->replace >= 0 ) {
436  Expressions[e->replace].replace = REGULAREXPRESSION;
437  AC.exprnames->namenode[e->node].number = e->replace;
438  e->replace = REGULAREXPRESSION;
439  }
440  else {
441  AC.exprnames->namenode[e->node].type = CDELETE;
442  AC.DidClean = 1;
443  }
444  break;
445  case LOCALEXPRESSION:
446  case GLOBALEXPRESSION:
447  ClearBracketIndex(j);
448  e->bracketinfo = e->newbracketinfo; e->newbracketinfo = 0;
449  break;
450  case HIDDENLEXPRESSION:
451  case HIDDENGEXPRESSION:
452  break;
453  case INTOHIDELEXPRESSION:
454  e->status = HIDDENLEXPRESSION;
455  break;
456  case INTOHIDEGEXPRESSION:
457  e->status = HIDDENGEXPRESSION;
458  break;
459  default:
460  ClearBracketIndex(j);
461  break;
462  }
463  if ( e->replace == NEWLYDEFINEDEXPRESSION ) e->replace = REGULAREXPRESSION;
464  }
465 }
466 
467 /*
468  #] TestDrop :
469  #[ PutInVflags :
470 */
471 
472 void PutInVflags(WORD nexpr)
473 {
474  EXPRESSIONS e = Expressions + nexpr;
475  POSITION *old;
476  WORD *oldw;
477  int i;
478 restart:;
479  if ( AS.OldOnFile == 0 ) {
480  AS.NumOldOnFile = 20;
481  AS.OldOnFile = (POSITION *)Malloc1(AS.NumOldOnFile*sizeof(POSITION),"file pointers");
482  }
483  else if ( nexpr >= AS.NumOldOnFile ) {
484  old = AS.OldOnFile;
485  AS.OldOnFile = (POSITION *)Malloc1(2*AS.NumOldOnFile*sizeof(POSITION),"file pointers");
486  for ( i = 0; i < AS.NumOldOnFile; i++ ) AS.OldOnFile[i] = old[i];
487  AS.NumOldOnFile = 2*AS.NumOldOnFile;
488  M_free(old,"proces file pointers");
489  }
490  if ( AS.OldNumFactors == 0 ) {
491  AS.NumOldNumFactors = 20;
492  AS.OldNumFactors = (WORD *)Malloc1(AS.NumOldNumFactors*sizeof(WORD),"numfactors pointers");
493  AS.Oldvflags = (WORD *)Malloc1(AS.NumOldNumFactors*sizeof(WORD),"vflags pointers");
494  }
495  else if ( nexpr >= AS.NumOldNumFactors ) {
496  oldw = AS.OldNumFactors;
497  AS.OldNumFactors = (WORD *)Malloc1(2*AS.NumOldNumFactors*sizeof(WORD),"numfactors pointers");
498  for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.OldNumFactors[i] = oldw[i];
499  M_free(oldw,"numfactors pointers");
500  oldw = AS.Oldvflags;
501  AS.Oldvflags = (WORD *)Malloc1(2*AS.NumOldNumFactors*sizeof(WORD),"vflags pointers");
502  for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.Oldvflags[i] = oldw[i];
503  AS.NumOldNumFactors = 2*AS.NumOldNumFactors;
504  M_free(oldw,"vflags pointers");
505  }
506 /*
507  The next is needed when we Load a .sav file with lots of expressions.
508 */
509  if ( nexpr >= AS.NumOldOnFile || nexpr >= AS.NumOldNumFactors ) goto restart;
510  AS.OldOnFile[nexpr] = e->onfile;
511  AS.OldNumFactors[nexpr] = e->numfactors;
512  AS.Oldvflags[nexpr] = e->vflags;
513 }
514 
515 /*
516  #] PutInVflags :
517  #[ DoExecute :
518 */
519 
520 WORD DoExecute(WORD par, WORD skip)
521 {
522  GETIDENTITY
523  WORD RetCode = 0;
524  int i, oldmultithreaded = AS.MultiThreaded;
525 #ifdef PARALLELCODE
526  int j;
527 #endif
528 
529  SpecialCleanup(BHEAD0);
530  if ( skip ) goto skipexec;
531  if ( AC.IfLevel > 0 ) {
532  MesPrint(" %d endif statement(s) missing",AC.IfLevel);
533  RetCode = 1;
534  }
535  if ( AC.WhileLevel > 0 ) {
536  MesPrint(" %d endwhile statement(s) missing",AC.WhileLevel);
537  RetCode = 1;
538  }
539  if ( AC.arglevel > 0 ) {
540  MesPrint(" %d endargument statement(s) missing",AC.arglevel);
541  RetCode = 1;
542  }
543  if ( AC.termlevel > 0 ) {
544  MesPrint(" %d endterm statement(s) missing",AC.termlevel);
545  RetCode = 1;
546  }
547  if ( AC.insidelevel > 0 ) {
548  MesPrint(" %d endinside statement(s) missing",AC.insidelevel);
549  RetCode = 1;
550  }
551  if ( AC.inexprlevel > 0 ) {
552  MesPrint(" %d endinexpression statement(s) missing",AC.inexprlevel);
553  RetCode = 1;
554  }
555  if ( AC.NumLabels > 0 ) {
556  for ( i = 0; i < AC.NumLabels; i++ ) {
557  if ( AC.Labels[i] < 0 ) {
558  MesPrint(" -->Label %s missing",AC.LabelNames[i]);
559  RetCode = 1;
560  }
561  }
562  }
563  if ( AC.dolooplevel > 0 ) {
564  MesPrint(" %d enddo statement(s) missing",AC.dolooplevel);
565  RetCode = 1;
566  }
567  if ( RetCode ) return(RetCode);
568  AR.Cnumlhs = cbuf[AM.rbufnum].numlhs;
569 
570  if ( ( AS.ExecMode = par ) == GLOBALMODULE ) AS.ExecMode = 0;
571 /*
572  Now we compare whether all elements of PotModdollars are contained in
573  ModOptdollars. If not, we may not run parallel.
574 */
575 #ifdef WITHMPI
576  if ( NumPotModdollars > 0 && AC.mparallelflag == PARALLELFLAG ) {
577  if ( NumPotModdollars > NumModOptdollars )
578  AC.mparallelflag |= NOPARALLEL_DOLLAR;
579  else
580  for ( i = 0; i < NumPotModdollars; i++ ) {
581  for ( j = 0; j < NumModOptdollars; j++ )
582  if ( PotModdollars[i] == ModOptdollars[j].number ) break;
583  if ( j >= NumModOptdollars ) {
584  AC.parallelflag |= NOPARALLEL_DOLLAR;
585  break;
586  }
587  }
588  }
589  /*
590  * Set $-variables with MODSUM to zero on the slaves.
591  */
592  if ( AC.mparallelflag == PARALLELFLAG && PF.me != MASTER ) {
593  for ( i = 0; i < NumModOptdollars; i++ ) {
594  if ( ModOptdollars[i].type == MODSUM ) {
595  DOLLARS d = Dollars + ModOptdollars[i].number;
596  d->type = DOLZERO;
597  if ( d->where && d->where != &AM.dollarzero ) M_free(d->where, "old content of dollar");
598  d->where = &AM.dollarzero;
599  d->size = 0;
600  CleanDollarFactors(d);
601  }
602  }
603  }
604 #endif
605 #ifdef WITHPTHREADS
606 /*
607  Now check whether we have either the regular parallel flag or the
608  mparallel flag set.
609  Next check whether any of the expressions has partodo set.
610  If any of the above we need to check what the dollar status is.
611 */
612  AC.partodoflag = -1;
613  if ( NumPotModdollars >= 0 ) {
614  for ( i = 0; i < NumExpressions; i++ ) {
615  if ( Expressions[i].partodo ) { AC.partodoflag = 1; break; }
616  }
617  }
618  if ( AC.partodoflag > 0 || ( NumPotModdollars > 0 && AC.mparallelflag == PARALLELFLAG ) ) {
619  if ( NumPotModdollars > NumModOptdollars ) {
620  AC.mparallelflag |= NOPARALLEL_DOLLAR;
621  AS.MultiThreaded = 0;
622  AC.partodoflag = 0;
623  }
624  else {
625  for ( i = 0; i < NumPotModdollars; i++ ) {
626  for ( j = 0; j < NumModOptdollars; j++ )
627  if ( PotModdollars[i] == ModOptdollars[j].number ) break;
628  if ( j >= NumModOptdollars ) {
629  AC.mparallelflag |= NOPARALLEL_DOLLAR;
630  AS.MultiThreaded = 0;
631  AC.partodoflag = 0;
632  break;
633  }
634  switch ( ModOptdollars[j].type ) {
635  case MODSUM:
636  case MODMAX:
637  case MODMIN:
638  case MODLOCAL:
639  break;
640  default:
641  AC.mparallelflag |= NOPARALLEL_DOLLAR;
642  AS.MultiThreaded = 0;
643  AC.partodoflag = 0;
644  break;
645  }
646  }
647  }
648  }
649  else if ( ( AC.mparallelflag & NOPARALLEL_USER ) != 0 ) {
650  AS.MultiThreaded = 0;
651  AC.partodoflag = 0;
652  }
653  if ( AC.partodoflag == 0 ) {
654  for ( i = 0; i < NumExpressions; i++ ) {
655  Expressions[i].partodo = 0;
656  }
657  }
658  else if ( AC.partodoflag == -1 ) {
659  AC.partodoflag = 0;
660  }
661 #endif
662 #ifdef WITHMPI
663 /*[20oct2009 mt]:*/
664  if ( AC.RhsExprInModuleFlag && AC.mparallelflag == PARALLELFLAG ) {
665  if (PF.rhsInParallel) {
666  PF.mkSlaveInfile=1;
667  if(PF.me != MASTER){
668  PF.slavebuf.PObuffer=(WORD *)Malloc1(AM.ScratSize*sizeof(WORD),"PF inbuf");
669  PF.slavebuf.POsize=AM.ScratSize*sizeof(WORD);
670  PF.slavebuf.POfull = PF.slavebuf.POfill = PF.slavebuf.PObuffer;
671  PF.slavebuf.POstop= PF.slavebuf.PObuffer+AM.ScratSize;
672  PUTZERO(PF.slavebuf.POposition);
673  }/*if(PF.me != MASTER)*/
674  }
675  else {
676  AC.mparallelflag |= NOPARALLEL_RHS;
677  }
678  }
679 /*:[20oct2009 mt]*/
680 #endif
681  AR.SortType = AC.SortType;
682 #ifdef WITHMPI
683  if ( PF.me == MASTER )
684 #endif
685  {
686  if ( AC.SetupFlag ) WriteSetup();
687  if ( AC.NamesFlag || AC.CodesFlag ) WriteLists();
688  }
689  if ( par == GLOBALMODULE ) MakeGlobal();
690  if ( RevertScratch() ) return(-1);
691 /*[20oct2009 mt]:*/
692 #ifdef WITHMPI
693  AC.partodoflag = 0;
694  if ( PF.numtasks >= 3 ) {
695  for ( i = 0; i < NumExpressions; i++ ) {
696  if ( Expressions[i].partodo > 0 ) { AC.partodoflag = 1; break; }
697  }
698  }
699  else {
700  for ( i = 0; i < NumExpressions; i++ ) {
701  Expressions[i].partodo = 0;
702  }
703  }
704 #endif
705  if ( AC.ncmod ) SetMods();
706 /*
707  Warn if the module has to run in sequential mode due to some problems.
708 */
709 #ifdef WITHMPI
710  if ( PF.me == MASTER )
711 #endif
712  {
713  if ( !AC.ThreadsFlag || AC.mparallelflag & NOPARALLEL_USER ) {
714  /* The user switched off the parallel execution explicitly. */
715  }
716  else if ( AC.mparallelflag & NOPARALLEL_DOLLAR ) {
717  HighWarning("This module is forced to run in sequential mode due to $-variables");
718  }
719  else if ( AC.mparallelflag & NOPARALLEL_RHS ) {
720  HighWarning("This module is forced to run in sequential mode due to RHS expression names");
721  }
722  else if ( AC.mparallelflag & NOPARALLEL_CONVPOLY ) {
723  HighWarning("This module is forced to run in sequential mode due to topolynomial/frompolynomial");
724  }
725  else if ( AC.mparallelflag & NOPARALLEL_TBLDOLLAR ) {
726  HighWarning("This module is forced to run in sequential mode due to $-variable assignments in tables");
727  }
728  else if ( AC.mparallelflag & NOPARALLEL_NPROC ) {
729  HighWarning("This module is forced to run in sequential mode because there is only one processor");
730  }
731  }
732 /*
733  Now the actual execution
734 */
735 #ifdef WITHMPI
736  /*
737  * Turn on AS.printflag to print runtime errors occurring on slaves.
738  */
739  AS.printflag = 1;
740 #endif
741  if ( AP.preError == 0 && ( Processor() || WriteAll() ) ) RetCode = -1;
742 #ifdef WITHMPI
743  AS.printflag = 0;
744 #endif
745 /*
746  That was it. Next is cleanup.
747 */
748  if ( AC.ncmod ) UnSetMods();
749  AS.MultiThreaded = oldmultithreaded;
750  TableReset();
751 
752 /*[28sep2005 mt]:*/
753 #ifdef WITHMPI
754  /* Combine and then broadcast modified dollar variables. */
755  if ( NumPotModdollars > 0 ) {
756  RetCode = PF_CollectModifiedDollars();
757  if ( RetCode ) return RetCode;
758  RetCode = PF_BroadcastModifiedDollars();
759  if ( RetCode ) return RetCode;
760  }
761  /* Broadcast redefined preprocessor variables. */
762  if ( AC.numpfirstnum > 0 ) {
763  RetCode = PF_BroadcastRedefinedPreVars();
764  if ( RetCode ) return RetCode;
765  }
766  /* Broadcast the list of objects converted to symbols in AM.sbufnum. */
767  if ( AC.topolynomialflag & TOPOLYNOMIALFLAG ) {
768  RetCode = PF_BroadcastCBuf(AM.sbufnum);
769  if ( RetCode ) return RetCode;
770  }
771  /*
772  * Broadcast AR.expflags, which may be used on the slaves in the next module
773  * via ZERO_ or UNCHANGED_. It also broadcasts several flags of each expression.
774  */
775  RetCode = PF_BroadcastExpFlags();
776  if ( RetCode ) return RetCode;
777  /*
778  * Clean the hide file on the slaves, which was used for RHS expressions
779  * broadcast from the master at the beginning of the module.
780  */
781  if ( PF.me != MASTER && AR.hidefile->PObuffer ) {
782  if ( AR.hidefile->handle >= 0 ) {
783  CloseFile(AR.hidefile->handle);
784  AR.hidefile->handle = -1;
785  remove(AR.hidefile->name);
786  }
787  AR.hidefile->POfull = AR.hidefile->POfill = AR.hidefile->PObuffer;
788  PUTZERO(AR.hidefile->POposition);
789  }
790 #endif
791 #ifdef WITHPTHREADS
792  for ( j = 0; j < NumModOptdollars; j++ ) {
793  if ( ModOptdollars[j].dstruct ) {
794 /*
795  First clean up dollar values.
796 */
797  for ( i = 0; i < AM.totalnumberofthreads; i++ ) {
798  if ( ModOptdollars[j].dstruct[i].size > 0 ) {
799  CleanDollarFactors(&(ModOptdollars[j].dstruct[i]));
800  M_free(ModOptdollars[j].dstruct[i].where,"Local dollar value");
801  }
802  }
803 /*
804  Now clean up the whole array.
805 */
806  M_free(ModOptdollars[j].dstruct,"Local DOLLARS");
807  ModOptdollars[j].dstruct = 0;
808  }
809  }
810 #endif
811 /*:[28sep2005 mt]*/
812 
813 /*
814  @@@@@@@@@@@@@@@
815  Now follows the code to invalidate caches for all objects in the
816  PotModdollars. There are NumPotModdollars of them and PotModdollars
817  is an array of WORD.
818 */
819 /*
820  Cleanup:
821 */
822 #ifdef JV_IS_WRONG
823 /*
824  Giving back this memory gives way too much activity with Malloc1
825  Better to keep it and just put the number of used objects to zero (JV)
826  If you put the lijst equal to NULL, please also make maxnum = 0
827 */
828  if ( ModOptdollars ) M_free(ModOptdollars, "ModOptdollars pointer");
829  if ( PotModdollars ) M_free(PotModdollars, "PotModdollars pointer");
830 
831  /* ModOptdollars changed to AC.ModOptDolList.lijst because AIX C compiler complained. MF 30/07/2003. */
832  AC.ModOptDolList.lijst = NULL;
833  /* PotModdollars changed to AC.PotModDolList.lijst because AIX C compiler complained. MF 30/07/2003. */
834  AC.PotModDolList.lijst = NULL;
835 #endif
836  NumPotModdollars = 0;
837  NumModOptdollars = 0;
838 
839 skipexec:
840 #ifdef PARALLELCODE
841  AC.numpfirstnum = 0;
842 #endif
843  AC.DidClean = 0;
844  AC.PolyRatFunChanged = 0;
845  TestDrop();
846  if ( par == STOREMODULE || par == CLEARMODULE ) {
847  ClearOptimize();
848  if ( par == STOREMODULE && PopVariables() ) RetCode = -1;
849  if ( AR.infile->handle >= 0 ) {
850  CloseFile(AR.infile->handle);
851  remove(AR.infile->name);
852  AR.infile->handle = -1;
853  }
854  AR.infile->POfill = AR.infile->PObuffer;
855  PUTZERO(AR.infile->POposition);
856  AR.infile->POfull = AR.infile->PObuffer;
857  if ( AR.outfile->handle >= 0 ) {
858  CloseFile(AR.outfile->handle);
859  remove(AR.outfile->name);
860  AR.outfile->handle = -1;
861  }
862  AR.outfile->POfull =
863  AR.outfile->POfill = AR.outfile->PObuffer;
864  PUTZERO(AR.outfile->POposition);
865  if ( AR.hidefile->handle >= 0 ) {
866  CloseFile(AR.hidefile->handle);
867  remove(AR.hidefile->name);
868  AR.hidefile->handle = -1;
869  }
870  AR.hidefile->POfull =
871  AR.hidefile->POfill = AR.hidefile->PObuffer;
872  PUTZERO(AR.hidefile->POposition);
873  AC.HideLevel = 0;
874  if ( par == CLEARMODULE ) {
875  if ( DeleteStore(0) < 0 ) {
876  MesPrint("Cannot restart the storage file");
877  RetCode = -1;
878  }
879  else RetCode = 0;
880  CleanUp(1);
881  ResetVariables(2);
882  AM.gProcessBucketSize = AM.hProcessBucketSize;
883  AM.gparallelflag = PARALLELFLAG;
884  IniVars();
885  }
886  }
887  else {
888  if ( CleanExpr(0) ) RetCode = -1;
889  if ( AC.DidClean ) CompactifyTree(AC.exprnames,EXPRNAMES);
890  ResetVariables(0);
891  CleanUpSort(-1);
892  }
893  clearcbuf(AC.cbufnum);
894  if ( AC.MultiBracketBuf != 0 ) {
895  for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
896  if ( AC.MultiBracketBuf[i] ) {
897  M_free(AC.MultiBracketBuf[i],"bracket buffer i");
898  AC.MultiBracketBuf[i] = 0;
899  }
900  }
901  AC.MultiBracketLevels = 0;
902  M_free(AC.MultiBracketBuf,"multi bracket buffer");
903  AC.MultiBracketBuf = 0;
904  }
905 
906  return(RetCode);
907 }
908 
909 /*
910  #] DoExecute :
911  #[ PutBracket :
912 
913  Routine uses the bracket info to split a term into two pieces:
914  1: the part outside the bracket, and
915  2: the part inside the bracket.
916  These parts are separated by a subterm of type HAAKJE.
917  This subterm looks like: HAAKJE,3,level
918  The level is used for nestings of brackets. The print routines
919  cannot handle this yet (31-Mar-1988).
920 
921  The Bracket selector is in AT.BrackBuf in the form of a regular term,
922  but without coefficient.
923  When AR.BracketOn < 0 we have a socalled antibracket. The main effect
924  is an exchange of the inner and outer part and where the coefficient goes.
925 
926  Routine recoded to facilitate b p1,p2; etc for dotproducts and tensors
927  15-oct-1991
928 */
929 
930 WORD PutBracket(PHEAD WORD *termin)
931 {
932  GETBIDENTITY
933  WORD *t, *t1, *b, i, j, *lastfun;
934  WORD *t2, *s1, *s2;
935  WORD *bStop, *bb, *bf, *tStop;
936  WORD *term1,*term2, *m1, *m2, *tStopa;
937  WORD *bbb = 0, *bind, *binst = 0, bwild = 0;
938  term1 = AT.WorkPointer+1;
939  term2 = (WORD *)(((UBYTE *)(term1)) + AM.MaxTer);
940  if ( ( (WORD *)(((UBYTE *)(term2)) + AM.MaxTer) ) > AT.WorkTop ) return(MesWork());
941  if ( AR.BracketOn < 0 ) {
942  t2 = term1; t1 = term2; /* AntiBracket */
943  }
944  else {
945  t1 = term1; t2 = term2; /* Regular bracket */
946  }
947  b = AT.BrackBuf; bStop = b+*b; b++;
948  while ( b < bStop ) {
949  if ( *b == INDEX ) { bwild = 1; bbb = b+2; binst = b + b[1]; break; }
950  b += b[1];
951  }
952 
953  t = termin; tStopa = t + *t; i = *(t + *t -1); i = ABS(i);
954  if ( AR.PolyFun && AT.PolyAct ) tStop = termin + AT.PolyAct;
955  else tStop = tStopa - i;
956  t++;
957  if ( AR.BracketOn < 0 ) {
958  lastfun = 0;
959  while ( t < tStop && *t >= FUNCTION
960  && functions[*t-FUNCTION].commute ) {
961  b = AT.BrackBuf+1;
962  while ( b < bStop ) {
963  if ( *b == *t ) {
964  lastfun = t;
965  while ( t < tStop && *t >= FUNCTION
966  && functions[*t-FUNCTION].commute ) t += t[1];
967  goto NextNcom1;
968  }
969  b += b[1];
970  }
971  if ( bwild && *t >= FUNCTION && functions[*t-FUNCTION].spec ) {
972  s1 = t + t[1];
973  s2 = t + FUNHEAD;
974  while ( s2 < s1 ) {
975  bind = bbb;
976  while ( bind < binst ) {
977  if ( *bind == *s2 ) {
978  lastfun = t;
979  while ( t < tStop && *t >= FUNCTION
980  && functions[*t-FUNCTION].commute ) t += t[1];
981  goto NextNcom1;
982  }
983  bind++;
984  }
985  s2++;
986  }
987  }
988  t += t[1];
989  }
990 NextNcom1:
991  s1 = termin + 1;
992  if ( lastfun ) {
993  while ( s1 < lastfun ) *t2++ = *s1++;
994  while ( s1 < t ) *t1++ = *s1++;
995  }
996  else {
997  while ( s1 < t ) *t2++ = *s1++;
998  }
999 
1000  }
1001  else {
1002  lastfun = t;
1003  while ( t < tStop && *t >= FUNCTION
1004  && functions[*t-FUNCTION].commute ) {
1005  b = AT.BrackBuf+1;
1006  while ( b < bStop ) {
1007  if ( *b == *t ) { lastfun = t + t[1]; goto NextNcom; }
1008  b += b[1];
1009  }
1010  if ( bwild && *t >= FUNCTION && functions[*t-FUNCTION].spec ) {
1011  s1 = t + t[1];
1012  s2 = t + FUNHEAD;
1013  while ( s2 < s1 ) {
1014  bind = bbb;
1015  while ( bind < binst ) {
1016  if ( *bind == *s2 ) { lastfun = t + t[1]; goto NextNcom; }
1017  bind++;
1018  }
1019  s2++;
1020  }
1021  }
1022 NextNcom:
1023  t += t[1];
1024  }
1025  s1 = termin + 1;
1026  while ( s1 < lastfun ) *t1++ = *s1++;
1027  while ( s1 < t ) *t2++ = *s1++;
1028  }
1029 /*
1030  Now we have only commuting functions left. Move the b pointer to them.
1031 */
1032  b = AT.BrackBuf + 1;
1033  while ( b < bStop && *b >= FUNCTION
1034  && ( *b < FUNCTION || functions[*b-FUNCTION].commute ) ) {
1035  b += b[1];
1036  }
1037  bf = b;
1038 
1039  while ( t < tStop && ( bf < bStop || bwild ) ) {
1040  b = bf;
1041  while ( b < bStop && *b != *t ) { b += b[1]; }
1042  i = t[1];
1043  if ( *t >= FUNCTION ) { /* We are in function territory */
1044  if ( b < bStop && *b == *t ) goto FunBrac;
1045  if ( bwild && *t >= FUNCTION && functions[*t-FUNCTION].spec ) {
1046  s1 = t + t[1];
1047  s2 = t + FUNHEAD;
1048  while ( s2 < s1 ) {
1049  bind = bbb;
1050  while ( bind < binst ) {
1051  if ( *bind == *s2 ) goto FunBrac;
1052  bind++;
1053  }
1054  s2++;
1055  }
1056  }
1057  NCOPY(t2,t,i);
1058  continue;
1059 FunBrac: NCOPY(t1,t,i);
1060  continue;
1061  }
1062 /*
1063  We have left: DELTA, INDEX, VECTOR, DOTPRODUCT, SYMBOL
1064 */
1065  if ( *t == DELTA ) {
1066  if ( b < bStop && *b == DELTA ) {
1067  b += b[1];
1068  NCOPY(t1,t,i);
1069  }
1070  else { NCOPY(t2,t,i); }
1071  }
1072  else if ( *t == INDEX ) {
1073  if ( bwild ) {
1074  m1 = t1; m2 = t2;
1075  *t1++ = *t; t1++; *t2++ = *t; t2++;
1076  bind = bbb;
1077  j = t[1] -2;
1078  t += 2;
1079  while ( --j >= 0 ) {
1080  while ( *bind < *t && bind < binst ) bind++;
1081  if ( *bind == *t && bind < binst ) {
1082  *t1++ = *t++;
1083  }
1084  else *t2++ = *t++;
1085  }
1086  m1[1] = WORDDIF(t1,m1);
1087  if ( m1[1] == 2 ) t1 = m1;
1088  m2[1] = WORDDIF(t2,m2);
1089  if ( m2[1] == 2 ) t2 = m2;
1090  }
1091  else {
1092  NCOPY(t2,t,i);
1093  }
1094  }
1095  else if ( *t == VECTOR ) {
1096  if ( ( b < bStop && *b == VECTOR ) || bwild ) {
1097  if ( b < bStop && *b == VECTOR ) {
1098  bb = b + b[1]; b += 2;
1099  }
1100  else bb = b;
1101  j = t[1] - 2;
1102  m1 = t1; m2 = t2; *t1++ = *t; *t2++ = *t; t1++; t2++; t += 2;
1103  while ( j > 0 ) {
1104  j -= 2;
1105  while ( b < bb && ( *b < *t ||
1106  ( *b == *t && b[1] < t[1] ) ) ) b += 2;
1107  if ( b < bb && ( *t == *b && t[1] == b[1] ) ) {
1108  *t1++ = *t++; *t1++ = *t++; goto nextvec;
1109  }
1110  else if ( bwild ) {
1111  bind = bbb;
1112  while ( bind < binst ) {
1113  if ( *t == *bind || t[1] == *bind ) {
1114  *t1++ = *t++; *t1++ = *t++;
1115  goto nextvec;
1116  }
1117  bind++;
1118  }
1119  }
1120  *t2++ = *t++; *t2++ = *t++;
1121 nextvec:;
1122  }
1123  m1[1] = WORDDIF(t1,m1);
1124  if ( m1[1] == 2 ) t1 = m1;
1125  m2[1] = WORDDIF(t2,m2);
1126  if ( m2[1] == 2 ) t2 = m2;
1127  }
1128  else {
1129  NCOPY(t2,t,i);
1130  }
1131  }
1132  else if ( *t == DOTPRODUCT ) {
1133  if ( ( b < bStop && *b == *t ) || bwild ) {
1134  m1 = t1; *t1++ = *t; t1++;
1135  m2 = t2; *t2++ = *t; t2++;
1136  if ( b >= bStop || *b != *t ) { bb = b; s1 = b; }
1137  else {
1138  s1 = b + b[1]; bb = b + 2;
1139  }
1140  s2 = t + i; t += 2;
1141  while ( t < s2 && ( bb < s1 || bwild ) ) {
1142  while ( bb < s1 && ( *bb < *t ||
1143  ( *bb == *t && bb[1] < t[1] ) ) ) bb += 3;
1144  if ( bb < s1 && *bb == *t && bb[1] == t[1] ) {
1145  *t1++ = *t++; *t1++ = *t++; *t1++ = *t++; bb += 3;
1146  goto nextdot;
1147  }
1148  else if ( bwild ) {
1149  bind = bbb;
1150  while ( bind < binst ) {
1151  if ( *bind == *t || *bind == t[1] ) {
1152  *t1++ = *t++; *t1++ = *t++; *t1++ = *t++;
1153  goto nextdot;
1154  }
1155  bind++;
1156  }
1157  }
1158  *t2++ = *t++; *t2++ = *t++; *t2++ = *t++;
1159 nextdot:;
1160  }
1161  while ( t < s2 ) *t2++ = *t++;
1162  m1[1] = WORDDIF(t1,m1);
1163  if ( m1[1] == 2 ) t1 = m1;
1164  m2[1] = WORDDIF(t2,m2);
1165  if ( m2[1] == 2 ) t2 = m2;
1166  }
1167  else { NCOPY(t2,t,i); }
1168  }
1169  else if ( *t == SYMBOL ) {
1170  if ( b < bStop && *b == *t ) {
1171  m1 = t1; *t1++ = *t; t1++;
1172  m2 = t2; *t2++ = *t; t2++;
1173  s1 = b + b[1]; bb = b+2;
1174  s2 = t + i; t += 2;
1175  while ( bb < s1 && t < s2 ) {
1176  while ( bb < s1 && *bb < *t ) bb += 2;
1177  if ( bb >= s1 ) break;
1178  if ( *bb == *t ) { *t1++ = *t++; *t1++ = *t++; }
1179  else { *t2++ = *t++; *t2++ = *t++; }
1180  }
1181  while ( t < s2 ) *t2++ = *t++;
1182  m1[1] = WORDDIF(t1,m1);
1183  if ( m1[1] == 2 ) t1 = m1;
1184  m2[1] = WORDDIF(t2,m2);
1185  if ( m2[1] == 2 ) t2 = m2;
1186  }
1187  else { NCOPY(t2,t,i); }
1188  }
1189  else {
1190  NCOPY(t2,t,i);
1191  }
1192  }
1193  if ( ( i = WORDDIF(tStop,t) ) > 0 ) NCOPY(t2,t,i);
1194  if ( AR.BracketOn < 0 ) {
1195  s1 = t1; t1 = t2; t2 = s1;
1196  }
1197  do { *t2++ = *t++; } while ( t < (WORD *)tStopa );
1198  t = AT.WorkPointer;
1199  i = WORDDIF(t1,term1);
1200  *t++ = 4 + i + WORDDIF(t2,term2);
1201  t += i;
1202  *t++ = HAAKJE;
1203  *t++ = 3;
1204  *t++ = 0; /* This feature won't be used for a while */
1205  i = WORDDIF(t2,term2);
1206  t1 = term2;
1207  if ( i > 0 ) NCOPY(t,t1,i);
1208 
1209  AT.WorkPointer = t;
1210 
1211  return(0);
1212 }
1213 
1214 /*
1215  #] PutBracket :
1216  #[ SpecialCleanup :
1217 */
1218 
1219 VOID SpecialCleanup(PHEAD0)
1220 {
1221  GETBIDENTITY
1222  if ( AT.previousEfactor ) M_free(AT.previousEfactor,"Efactor cache");
1223  AT.previousEfactor = 0;
1224 }
1225 
1226 /*
1227  #] SpecialCleanup :
1228  #[ SetMods :
1229 */
1230 
1231 #ifndef WITHPTHREADS
1232 
1233 void SetMods()
1234 {
1235  int i, n;
1236  if ( AN.cmod != 0 ) M_free(AN.cmod,"AN.cmod");
1237  n = ABS(AN.ncmod);
1238  AN.cmod = (UWORD *)Malloc1(sizeof(WORD)*n,"AN.cmod");
1239  for ( i = 0; i < n; i++ ) AN.cmod[i] = AC.cmod[i];
1240 }
1241 
1242 #endif
1243 
1244 /*
1245  #] SetMods :
1246  #[ UnSetMods :
1247 */
1248 
1249 #ifndef WITHPTHREADS
1250 
1251 void UnSetMods()
1252 {
1253  if ( AN.cmod != 0 ) M_free(AN.cmod,"AN.cmod");
1254  AN.cmod = 0;
1255 }
1256 
1257 #endif
1258 
1259 /*
1260  #] UnSetMods :
1261  #] DoExecute :
1262  #[ Expressions :
1263  #[ ExchangeExpressions :
1264 */
1265 
1266 void ExchangeExpressions(int num1, int num2)
1267 {
1268  GETIDENTITY
1269  WORD node1, node2, namesize, TMproto[SUBEXPSIZE];
1270  INDEXENTRY *ind;
1271  EXPRESSIONS e1, e2;
1272  LONG a;
1273  SBYTE *s1, *s2;
1274  int i;
1275  e1 = Expressions + num1;
1276  e2 = Expressions + num2;
1277  node1 = e1->node;
1278  node2 = e2->node;
1279  AC.exprnames->namenode[node1].number = num2;
1280  AC.exprnames->namenode[node2].number = num1;
1281  a = e1->name; e1->name = e2->name; e2->name = a;
1282  namesize = e1->namesize; e1->namesize = e2->namesize; e2->namesize = namesize;
1283  e1->node = node2;
1284  e2->node = node1;
1285  if ( e1->status == STOREDEXPRESSION ) {
1286 /*
1287  Find the name in the index and replace by the new name
1288 */
1289  TMproto[0] = EXPRESSION;
1290  TMproto[1] = SUBEXPSIZE;
1291  TMproto[2] = num1;
1292  TMproto[3] = 1;
1293  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1294  AT.TMaddr = TMproto;
1295  ind = FindInIndex(num1,&AR.StoreData,0,0);
1296  s1 = (SBYTE *)(AC.exprnames->namebuffer+e1->name);
1297  i = e1->namesize;
1298  s2 = ind->name;
1299  NCOPY(s2,s1,i);
1300  *s2 = 0;
1301  SeekFile(AR.StoreData.Handle,&(e1->onfile),SEEK_SET);
1302  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)ind,
1303  (LONG)(sizeof(INDEXENTRY))) != sizeof(INDEXENTRY) ) {
1304  MesPrint("File error while exchanging expressions");
1305  Terminate(-1);
1306  }
1307  FlushFile(AR.StoreData.Handle);
1308  }
1309  if ( e2->status == STOREDEXPRESSION ) {
1310 /*
1311  Find the name in the index and replace by the new name
1312 */
1313  TMproto[0] = EXPRESSION;
1314  TMproto[1] = SUBEXPSIZE;
1315  TMproto[2] = num2;
1316  TMproto[3] = 1;
1317  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1318  AT.TMaddr = TMproto;
1319  ind = FindInIndex(num1,&AR.StoreData,0,0);
1320  s1 = (SBYTE *)(AC.exprnames->namebuffer+e2->name);
1321  i = e2->namesize;
1322  s2 = ind->name;
1323  NCOPY(s2,s1,i);
1324  *s2 = 0;
1325  SeekFile(AR.StoreData.Handle,&(e2->onfile),SEEK_SET);
1326  if ( WriteFile(AR.StoreData.Handle,(UBYTE *)ind,
1327  (LONG)(sizeof(INDEXENTRY))) != sizeof(INDEXENTRY) ) {
1328  MesPrint("File error while exchanging expressions");
1329  Terminate(-1);
1330  }
1331  FlushFile(AR.StoreData.Handle);
1332  }
1333 }
1334 
1335 /*
1336  #] ExchangeExpressions :
1337  #[ GetFirstBracket :
1338 */
1339 
1340 int GetFirstBracket(WORD *term, int num)
1341 {
1342 /*
1343  Gets the first bracket of the expression 'num'
1344  Puts it in term. If no brackets the answer is one.
1345  Routine should be thread-safe
1346 */
1347  GETIDENTITY
1348  POSITION position, oldposition;
1349  RENUMBER renumber;
1350  FILEHANDLE *fi;
1351  WORD type, *oldcomppointer, oldonefile, numword;
1352  WORD *t, *tstop;
1353 
1354  oldcomppointer = AR.CompressPointer;
1355  type = Expressions[num].status;
1356  if ( type == STOREDEXPRESSION ) {
1357  WORD TMproto[SUBEXPSIZE];
1358  TMproto[0] = EXPRESSION;
1359  TMproto[1] = SUBEXPSIZE;
1360  TMproto[2] = num;
1361  TMproto[3] = 1;
1362  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1363  AT.TMaddr = TMproto;
1364  PUTZERO(position);
1365  if ( ( renumber = GetTable(num,&position,0) ) == 0 ) {
1366  MesCall("GetFirstBracket");
1367  SETERROR(-1)
1368  }
1369  if ( GetFromStore(term,&position,renumber,&numword,num) < 0 ) {
1370  MesCall("GetFirstBracket");
1371  SETERROR(-1)
1372  }
1373 /*
1374 #ifdef WITHPTHREADS
1375 */
1376  if ( renumber->symb.lo != AN.dummyrenumlist )
1377  M_free(renumber->symb.lo,"VarSpace");
1378  M_free(renumber,"Renumber");
1379 /*
1380 #endif
1381 */
1382  }
1383  else { /* Active expression */
1384  oldonefile = AR.GetOneFile;
1385  if ( type == HIDDENLEXPRESSION || type == HIDDENGEXPRESSION ) {
1386  AR.GetOneFile = 2; fi = AR.hidefile;
1387  }
1388  else {
1389  AR.GetOneFile = 0; fi = AR.infile;
1390  }
1391  if ( fi->handle >= 0 ) {
1392  PUTZERO(oldposition);
1393 /*
1394  SeekFile(fi->handle,&oldposition,SEEK_CUR);
1395 */
1396  }
1397  else {
1398  SETBASEPOSITION(oldposition,fi->POfill-fi->PObuffer);
1399  }
1400  position = AS.OldOnFile[num];
1401  if ( GetOneTerm(BHEAD term,fi,&position,1) < 0
1402  || ( GetOneTerm(BHEAD term,fi,&position,1) < 0 ) ) {
1403  MLOCK(ErrorMessageLock);
1404  MesCall("GetFirstBracket");
1405  MUNLOCK(ErrorMessageLock);
1406  SETERROR(-1)
1407  }
1408  if ( fi->handle >= 0 ) {
1409 /*
1410  SeekFile(fi->handle,&oldposition,SEEK_SET);
1411  if ( ISNEGPOS(oldposition) ) {
1412  MLOCK(ErrorMessageLock);
1413  MesPrint("File error");
1414  MUNLOCK(ErrorMessageLock);
1415  SETERROR(-1)
1416  }
1417 */
1418  }
1419  else {
1420  fi->POfill = fi->PObuffer+BASEPOSITION(oldposition);
1421  }
1422  AR.GetOneFile = oldonefile;
1423  }
1424  AR.CompressPointer = oldcomppointer;
1425  if ( *term ) {
1426  tstop = term + *term; tstop -= ABS(tstop[-1]);
1427  t = term + 1;
1428  while ( t < tstop ) {
1429  if ( *t == HAAKJE ) break;
1430  t += t[1];
1431  }
1432  if ( t >= tstop ) {
1433  term[0] = 4; term[1] = 1; term[2] = 1; term[3] = 3;
1434  }
1435  else {
1436  *t++ = 1; *t++ = 1; *t++ = 3; *term = t - term;
1437  }
1438  }
1439  else {
1440  term[0] = 4; term[1] = 1; term[2] = 1; term[3] = 3;
1441  }
1442  return(*term);
1443 }
1444 
1445 /*
1446  #] GetFirstBracket :
1447  #[ GetFirstTerm :
1448 */
1449 
1450 int GetFirstTerm(WORD *term, int num)
1451 {
1452 /*
1453  Gets the first term of the expression 'num'
1454  Puts it in term.
1455  Routine should be thread-safe
1456 */
1457  GETIDENTITY
1458  POSITION position, oldposition;
1459  RENUMBER renumber;
1460  FILEHANDLE *fi;
1461  WORD type, *oldcomppointer, oldonefile, numword;
1462 
1463  oldcomppointer = AR.CompressPointer;
1464  type = Expressions[num].status;
1465  if ( type == STOREDEXPRESSION ) {
1466  WORD TMproto[SUBEXPSIZE];
1467  TMproto[0] = EXPRESSION;
1468  TMproto[1] = SUBEXPSIZE;
1469  TMproto[2] = num;
1470  TMproto[3] = 1;
1471  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1472  AT.TMaddr = TMproto;
1473  PUTZERO(position);
1474  if ( ( renumber = GetTable(num,&position,0) ) == 0 ) {
1475  MesCall("GetFirstTerm");
1476  SETERROR(-1)
1477  }
1478  if ( GetFromStore(term,&position,renumber,&numword,num) < 0 ) {
1479  MesCall("GetFirstTerm");
1480  SETERROR(-1)
1481  }
1482 /*
1483 #ifdef WITHPTHREADS
1484 */
1485  if ( renumber->symb.lo != AN.dummyrenumlist )
1486  M_free(renumber->symb.lo,"VarSpace");
1487  M_free(renumber,"Renumber");
1488 /*
1489 #endif
1490 */
1491  }
1492  else { /* Active expression */
1493  oldonefile = AR.GetOneFile;
1494  if ( type == HIDDENLEXPRESSION || type == HIDDENGEXPRESSION ) {
1495  AR.GetOneFile = 2; fi = AR.hidefile;
1496  }
1497  else {
1498  AR.GetOneFile = 0;
1499  if ( Expressions[num].replace == NEWLYDEFINEDEXPRESSION )
1500  fi = AR.outfile;
1501  else fi = AR.infile;
1502  }
1503  if ( fi->handle >= 0 ) {
1504  PUTZERO(oldposition);
1505 /*
1506  SeekFile(fi->handle,&oldposition,SEEK_CUR);
1507 */
1508  }
1509  else {
1510  SETBASEPOSITION(oldposition,fi->POfill-fi->PObuffer);
1511  }
1512  position = AS.OldOnFile[num];
1513  if ( GetOneTerm(BHEAD term,fi,&position,1) < 0
1514  || ( GetOneTerm(BHEAD term,fi,&position,1) < 0 ) ) {
1515  MLOCK(ErrorMessageLock);
1516  MesCall("GetFirstTerm");
1517  MUNLOCK(ErrorMessageLock);
1518  SETERROR(-1)
1519  }
1520  if ( fi->handle >= 0 ) {
1521 /*
1522  SeekFile(fi->handle,&oldposition,SEEK_SET);
1523  if ( ISNEGPOS(oldposition) ) {
1524  MLOCK(ErrorMessageLock);
1525  MesPrint("File error");
1526  MUNLOCK(ErrorMessageLock);
1527  SETERROR(-1)
1528  }
1529 */
1530  }
1531  else {
1532  fi->POfill = fi->PObuffer+BASEPOSITION(oldposition);
1533  }
1534  AR.GetOneFile = oldonefile;
1535  }
1536  AR.CompressPointer = oldcomppointer;
1537  return(*term);
1538 }
1539 
1540 /*
1541  #] GetFirstTerm :
1542  #[ GetContent :
1543 */
1544 
1545 int GetContent(WORD *content, int num)
1546 {
1547 /*
1548  Gets the content of the expression 'num'
1549  Puts it in content.
1550  Routine should be thread-safe
1551  The content is defined as the term that will make the expression 'num'
1552  with integer coefficients, no GCD and all common factors taken out,
1553  all negative powers removed when we divide the expression by this
1554  content.
1555 */
1556  GETIDENTITY
1557  POSITION position, oldposition;
1558  RENUMBER renumber;
1559  FILEHANDLE *fi;
1560  WORD type, *oldcomppointer, oldonefile, numword, *term, i;
1561  WORD *cbuffer = TermMalloc("GetContent");
1562  WORD *oldworkpointer = AT.WorkPointer;
1563 
1564  oldcomppointer = AR.CompressPointer;
1565  type = Expressions[num].status;
1566  if ( type == STOREDEXPRESSION ) {
1567  WORD TMproto[SUBEXPSIZE];
1568  TMproto[0] = EXPRESSION;
1569  TMproto[1] = SUBEXPSIZE;
1570  TMproto[2] = num;
1571  TMproto[3] = 1;
1572  { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1573  AT.TMaddr = TMproto;
1574  PUTZERO(position);
1575  if ( ( renumber = GetTable(num,&position,0) ) == 0 ) goto CalledFrom;
1576  if ( GetFromStore(cbuffer,&position,renumber,&numword,num) < 0 ) goto CalledFrom;
1577  for(;;) {
1578  term = oldworkpointer;
1579  AR.CompressPointer = oldcomppointer;
1580  if ( GetFromStore(term,&position,renumber,&numword,num) < 0 ) goto CalledFrom;
1581  if ( *term == 0 ) break;
1582 /*
1583  'merge' the two terms
1584 */
1585  if ( ContentMerge(BHEAD cbuffer,term) < 0 ) goto CalledFrom;
1586  }
1587 /*
1588 #ifdef WITHPTHREADS
1589 */
1590  if ( renumber->symb.lo != AN.dummyrenumlist )
1591  M_free(renumber->symb.lo,"VarSpace");
1592  M_free(renumber,"Renumber");
1593 /*
1594 #endif
1595 */
1596  }
1597  else { /* Active expression */
1598  oldonefile = AR.GetOneFile;
1599  if ( type == HIDDENLEXPRESSION || type == HIDDENGEXPRESSION ) {
1600  AR.GetOneFile = 2; fi = AR.hidefile;
1601  }
1602  else {
1603  AR.GetOneFile = 0;
1604  if ( Expressions[num].replace == NEWLYDEFINEDEXPRESSION )
1605  fi = AR.outfile;
1606  else fi = AR.infile;
1607  }
1608  if ( fi->handle >= 0 ) {
1609  PUTZERO(oldposition);
1610 /*
1611  SeekFile(fi->handle,&oldposition,SEEK_CUR);
1612 */
1613  }
1614  else {
1615  SETBASEPOSITION(oldposition,fi->POfill-fi->PObuffer);
1616  }
1617  position = AS.OldOnFile[num];
1618  if ( GetOneTerm(BHEAD cbuffer,fi,&position,1) < 0 ) goto CalledFrom;
1619  AR.CompressPointer = oldcomppointer;
1620  if ( GetOneTerm(BHEAD cbuffer,fi,&position,1) < 0 ) goto CalledFrom;
1621 /*
1622  Now go through the terms. For each term we have to test whether
1623  what is in cbuffer is also in that term. If not, we have to remove
1624  it from cbuffer. Additionally we have to accumulate the GCD of the
1625  numerators and the LCM of the denominators. This is all done in the
1626  routine ContentMerge.
1627 */
1628  for(;;) {
1629  term = oldworkpointer;
1630  AR.CompressPointer = oldcomppointer;
1631  if ( GetOneTerm(BHEAD term,fi,&position,1) < 0 ) goto CalledFrom;
1632  if ( *term == 0 ) break;
1633 /*
1634  'merge' the two terms
1635 */
1636  if ( ContentMerge(BHEAD cbuffer,term) < 0 ) goto CalledFrom;
1637  }
1638  if ( fi->handle < 0 ) {
1639  fi->POfill = fi->PObuffer+BASEPOSITION(oldposition);
1640  }
1641  AR.GetOneFile = oldonefile;
1642  }
1643  AR.CompressPointer = oldcomppointer;
1644  for ( i = 0; i < *cbuffer; i++ ) content[i] = cbuffer[i];
1645  TermFree(cbuffer,"GetContent");
1646  AT.WorkPointer = oldworkpointer;
1647  return(*content);
1648 CalledFrom:
1649  MLOCK(ErrorMessageLock);
1650  MesCall("GetContent");
1651  MUNLOCK(ErrorMessageLock);
1652  SETERROR(-1)
1653 }
1654 
1655 /*
1656  #] GetContent :
1657  #[ CleanupTerm :
1658 
1659  Removes noncommuting objects from the term
1660 */
1661 
1662 int CleanupTerm(WORD *term)
1663 {
1664  WORD *tstop, *t, *tfill, *tt;
1665  GETSTOP(term,tstop);
1666  t = term+1;
1667  while ( t < tstop ) {
1668  if ( *t >= FUNCTION && ( functions[*t-FUNCTION].commute || *t == DENOMINATOR ) ) {
1669  tfill = t; tt = t + t[1]; tstop = term + *term;
1670  while ( tt < tstop ) *tfill++ = *tt++;
1671  *term = tfill - term;
1672  tstop -= ABS(tfill[-1]);
1673  }
1674  else {
1675  t += t[1];
1676  }
1677  }
1678  return(0);
1679 }
1680 
1681 /*
1682  #] CleanupTerm :
1683  #[ ContentMerge :
1684 */
1685 
1686 WORD ContentMerge(PHEAD WORD *content, WORD *term)
1687 {
1688  GETBIDENTITY
1689  WORD *cstop, csize, crsize, sign = 1, numsize, densize, i, tnsize, tdsize;
1690  UWORD *num, *den, *tnum, *tden;
1691  WORD *outfill, *outb = TermMalloc("ContentMerge"), *ct;
1692  WORD *t, *tstop, tsize, trsize, *told;
1693  WORD *t1, *t2, *c1, *c2, i1, i2, *out1;
1694  cstop = content + *content;
1695  csize = cstop[-1];
1696  if ( csize < 0 ) { sign = -sign; csize = -csize; }
1697  cstop -= csize;
1698  numsize = densize = crsize = (csize-1)/2;
1699  num = NumberMalloc("ContentMerge");
1700  den = NumberMalloc("ContentMerge");
1701  for ( i = 0; i < numsize; i++ ) num[i] = (UWORD)(cstop[i]);
1702  for ( i = 0; i < densize; i++ ) den[i] = (UWORD)(cstop[i+crsize]);
1703  while ( num[numsize-1] == 0 ) numsize--;
1704  while ( den[densize-1] == 0 ) densize--;
1705 /*
1706  First we do the coefficient
1707 */
1708  tstop = term + *term;
1709  tsize = tstop[-1];
1710  if ( tsize < 0 ) tsize = -tsize;
1711 /* else { sign = 1; } */
1712  tstop = tstop - tsize;
1713  tnsize = tdsize = trsize = (tsize-1)/2;
1714  tnum = (UWORD *)tstop; tden = (UWORD *)(tstop + trsize);
1715  while ( tnum[tnsize-1] == 0 ) tnsize--;
1716  while ( tden[tdsize-1] == 0 ) tdsize--;
1717  GcdLong(BHEAD num, numsize, tnum, tnsize, num, &numsize);
1718  if ( LcmLong(BHEAD den, densize, tden, tdsize, den, &densize) ) goto CalledFrom;
1719  outfill = outb + 1;
1720  ct = content + 1;
1721  t = term + 1;
1722  while ( ct < cstop ) {
1723  switch ( *ct ) {
1724  case SYMBOL:
1725  t = term+1;
1726  while ( t < tstop && *t != *ct ) t += t[1];
1727  if ( t >= tstop ) break;
1728  t1 = t+2; t2 = t+t[1];
1729  c1 = ct+2; c2 = ct+ct[1];
1730  out1 = outfill; *outfill++ = *ct; outfill++;
1731  while ( c1 < c2 && t1 < t2 ) {
1732  if ( *c1 == *t1 ) {
1733  if ( t1[1] <= c1[1] ) {
1734  *outfill++ = *t1++; *outfill++ = *t1++;
1735  c1 += 2;
1736  }
1737  else {
1738  *outfill++ = *c1++; *outfill++ = *c1++;
1739  t1 += 2;
1740  }
1741  }
1742  else if ( *c1 < *t1 ) {
1743  if ( c1[1] < 0 ) {
1744  *outfill++ = *c1++; *outfill++ = *c1++;
1745  }
1746  else { c1 += 2; }
1747  }
1748  else {
1749  if ( t1[1] < 0 ) {
1750  *outfill++ = *t1++; *outfill++ = *t1++;
1751  }
1752  else t1 += 2;
1753  }
1754  }
1755  while ( c1 < c2 ) {
1756  if ( c1[1] < 0 ) { *outfill++ = c1[0]; *outfill++ = c1[1]; }
1757  c1 += 2;
1758  }
1759  while ( t1 < t2 ) {
1760  if ( t1[1] < 0 ) { *outfill++ = t1[0]; *outfill++ = t1[1]; }
1761  t1 += 2;
1762  }
1763  out1[1] = outfill - out1;
1764  if ( out1[1] == 2 ) outfill = out1;
1765  break;
1766  case DOTPRODUCT:
1767  t = term+1;
1768  while ( t < tstop && *t != *ct ) t += t[1];
1769  if ( t >= tstop ) break;
1770  t1 = t+2; t2 = t+t[1];
1771  c1 = ct+2; c2 = ct+ct[1];
1772  out1 = outfill; *outfill++ = *ct; outfill++;
1773  while ( c1 < c2 && t1 < t2 ) {
1774  if ( *c1 == *t1 && c1[1] == t1[1] ) {
1775  if ( t1[2] <= c1[2] ) {
1776  *outfill++ = *t1++; *outfill++ = *t1++; *outfill++ = *t1++;
1777  c1 += 3;
1778  }
1779  else {
1780  *outfill++ = *c1++; *outfill++ = *c1++; *outfill++ = *c1++;
1781  t1 += 3;
1782  }
1783  }
1784  else if ( *c1 < *t1 || ( *c1 == *t1 && c1[1] < t1[1] ) ) {
1785  if ( c1[2] < 0 ) {
1786  *outfill++ = *c1++; *outfill++ = *c1++; *outfill++ = *c1++;
1787  }
1788  else { c1 += 3; }
1789  }
1790  else {
1791  if ( t1[2] < 0 ) {
1792  *outfill++ = *t1++; *outfill++ = *t1++; *outfill++ = *t1++;
1793  }
1794  else t1 += 3;
1795  }
1796  }
1797  while ( c1 < c2 ) {
1798  if ( c1[2] < 0 ) { *outfill++ = c1[0]; *outfill++ = c1[1]; *outfill++ = c1[1]; }
1799  c1 += 3;
1800  }
1801  while ( t1 < t2 ) {
1802  if ( t1[2] < 0 ) { *outfill++ = t1[0]; *outfill++ = t1[1]; *outfill++ = t1[1]; }
1803  t1 += 3;
1804  }
1805  out1[1] = outfill - out1;
1806  if ( out1[1] == 2 ) outfill = out1;
1807  break;
1808  case INDEX:
1809  t = term+1;
1810  while ( t < tstop && *t != *ct ) t += t[1];
1811  if ( t >= tstop ) break;
1812  t1 = t+2; t2 = t+t[1];
1813  c1 = ct+2; c2 = ct+ct[1];
1814  out1 = outfill; *outfill++ = *ct; outfill++;
1815  while ( c1 < c2 && t1 < t2 ) {
1816  if ( *c1 == *t1 ) {
1817  *outfill++ = *c1++;
1818  t1 += 1;
1819  }
1820  else if ( *c1 < *t1 ) { c1 += 1; }
1821  else { t1 += 1; }
1822  }
1823  out1[1] = outfill - out1;
1824  if ( out1[1] == 2 ) outfill = out1;
1825  break;
1826  case VECTOR:
1827  case DELTA:
1828  t = term+1;
1829  while ( t < tstop && *t != *ct ) t += t[1];
1830  if ( t >= tstop ) break;
1831  t1 = t+2; t2 = t+t[1];
1832  c1 = ct+2; c2 = ct+ct[1];
1833  out1 = outfill; *outfill++ = *ct; outfill++;
1834  while ( c1 < c2 && t1 < t2 ) {
1835  if ( *c1 == *t1 && c1[1] && t1[1] ) {
1836  *outfill++ = *c1++; *outfill++ = *c1++;
1837  t1 += 2;
1838  }
1839  else if ( *c1 < *t1 || ( *c1 == *t1 && c1[1] < t1[1] ) ) {
1840  c1 += 2;
1841  }
1842  else {
1843  t1 += 2;
1844  }
1845  }
1846  out1[1] = outfill - out1;
1847  if ( out1[1] == 2 ) outfill = out1;
1848  break;
1849  case GAMMA:
1850  default: /* Functions */
1851  told = t;
1852  while ( *t < *ct && t < tstop ) t += t[1];
1853  if ( t >= tstop ) { t = told; }
1854  else {
1855  t1 = t; t2 = ct; i1 = t1[1]; i2 = t2[1];
1856  if ( i1 != i2 ) { t = told; }
1857  else {
1858  while ( i1 > 0 ) {
1859  if ( *t1 != *t2 ) break;
1860  t1++; t2++; i1--;
1861  }
1862  if ( i1 == 0 ) {
1863  for ( i = 0; i < i2; i++ ) { *outfill++ = *t++; }
1864  }
1865  else { t = told; }
1866  }
1867  }
1868  break;
1869  }
1870  ct += ct[1];
1871  }
1872 /*
1873  Now put the coefficient back.
1874 */
1875  if ( numsize < densize ) {
1876  for ( i = numsize; i < densize; i++ ) num[i] = 0;
1877  numsize = densize;
1878  }
1879  else if ( densize < numsize ) {
1880  for ( i = densize; i < numsize; i++ ) den[i] = 0;
1881  densize = numsize;
1882  }
1883  for ( i = 0; i < numsize; i++ ) *outfill++ = num[i];
1884  for ( i = 0; i < densize; i++ ) *outfill++ = den[i];
1885  csize = numsize+densize+1;
1886  if ( sign < 0 ) csize = -csize;
1887  *outfill++ = csize;
1888  *outb = outfill-outb;
1889  NumberFree(den,"ContentMerge");
1890  NumberFree(num,"ContentMerge");
1891  for ( i = 0; i < *outb; i++ ) content[i] = outb[i];
1892  TermFree(outb,"ContentMerge");
1893  return(*content);
1894 CalledFrom:
1895  MLOCK(ErrorMessageLock);
1896  MesCall("GetContent");
1897  MUNLOCK(ErrorMessageLock);
1898  SETERROR(-1)
1899 }
1900 
1901 /*
1902  #] ContentMerge :
1903  #[ TermsInExpression :
1904 */
1905 
1906 LONG TermsInExpression(WORD num)
1907 {
1908  LONG x = Expressions[num].counter;
1909  if ( x >= 0 ) return(x);
1910  return(-1);
1911 }
1912 
1913 /*
1914  #] TermsInExpression :
1915  #[ UpdatePositions :
1916 */
1917 
1918 void UpdatePositions()
1919 {
1920  EXPRESSIONS e = Expressions;
1921  POSITION *old;
1922  WORD *oldw;
1923  int i;
1924  if ( NumExpressions > 0 &&
1925  ( AS.OldOnFile == 0 || AS.NumOldOnFile < NumExpressions ) ) {
1926  if ( AS.OldOnFile ) {
1927  old = AS.OldOnFile;
1928  AS.OldOnFile = (POSITION *)Malloc1(NumExpressions*sizeof(POSITION),"file pointers");
1929  for ( i = 0; i < AS.NumOldOnFile; i++ ) AS.OldOnFile[i] = old[i];
1930  AS.NumOldOnFile = NumExpressions;
1931  M_free(old,"proces file pointers");
1932  }
1933  else {
1934  AS.OldOnFile = (POSITION *)Malloc1(NumExpressions*sizeof(POSITION),"file pointers");
1935  AS.NumOldOnFile = NumExpressions;
1936  }
1937  }
1938  if ( NumExpressions > 0 &&
1939  ( AS.OldNumFactors == 0 || AS.NumOldNumFactors < NumExpressions ) ) {
1940  if ( AS.OldNumFactors ) {
1941  oldw = AS.OldNumFactors;
1942  AS.OldNumFactors = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"numfactors pointers");
1943  for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.OldNumFactors[i] = oldw[i];
1944  M_free(oldw,"numfactors pointers");
1945  oldw = AS.Oldvflags;
1946  AS.Oldvflags = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"vflags pointers");
1947  for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.Oldvflags[i] = oldw[i];
1948  AS.NumOldNumFactors = NumExpressions;
1949  M_free(oldw,"vflags pointers");
1950  }
1951  else {
1952  AS.OldNumFactors = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"numfactors pointers");
1953  AS.Oldvflags = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"vflags pointers");
1954  AS.NumOldNumFactors = NumExpressions;
1955  }
1956  }
1957  for ( i = 0; i < NumExpressions; i++ ) {
1958  AS.OldOnFile[i] = e[i].onfile;
1959  AS.OldNumFactors[i] = e[i].numfactors;
1960  AS.Oldvflags[i] = e[i].vflags;
1961  }
1962 }
1963 
1964 /*
1965  #] UpdatePositions :
1966  #[ CountTerms1 : LONG CountTerms1()
1967 
1968  Counts the terms in the current deferred bracket
1969  Is mainly an adaptation of the routine Deferred in proces.c
1970 */
1971 
1972 LONG CountTerms1(PHEAD0)
1973 {
1974  GETBIDENTITY
1975  POSITION oldposition, startposition;
1976  WORD *t, *m, *mstop, decr, i, *oldwork, retval;
1977  WORD *oldipointer = AR.CompressPointer;
1978  WORD oldGetOneFile = AR.GetOneFile, olddeferflag = AR.DeferFlag;
1979  LONG numterms = 0;
1980  AR.GetOneFile = 1;
1981  oldwork = AT.WorkPointer;
1982  AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
1983  AR.DeferFlag = 0;
1984  startposition = AR.DefPosition;
1985 /*
1986  Store old position
1987 */
1988  if ( AR.infile->handle >= 0 ) {
1989  PUTZERO(oldposition);
1990 /*
1991  SeekFile(AR.infile->handle,&oldposition,SEEK_CUR);
1992 */
1993  }
1994  else {
1995  SETBASEPOSITION(oldposition,AR.infile->POfill-AR.infile->PObuffer);
1996  AR.infile->POfill = (WORD *)((UBYTE *)(AR.infile->PObuffer)
1997  +BASEPOSITION(startposition));
1998  }
1999 /*
2000  Look in the CompressBuffer where the bracket contents start
2001 */
2002  t = m = AR.CompressBuffer;
2003  t += *t;
2004  mstop = t - ABS(t[-1]);
2005  m++;
2006  while ( *m != HAAKJE && m < mstop ) m += m[1];
2007  if ( m >= mstop ) { /* No deferred action! */
2008  numterms = 1;
2009  AR.DeferFlag = olddeferflag;
2010  AT.WorkPointer = oldwork;
2011  AR.GetOneFile = oldGetOneFile;
2012  return(numterms);
2013  }
2014  mstop = m + m[1];
2015  decr = WORDDIF(mstop,AR.CompressBuffer)-1;
2016 
2017  m = AR.CompressBuffer;
2018  t = AR.CompressPointer;
2019  i = *m;
2020  NCOPY(t,m,i);
2021  AR.TePos = 0;
2022  AN.TeSuOut = 0;
2023 /*
2024  Status:
2025  First bracket content starts at mstop.
2026  Next term starts at startposition.
2027  Decompression information is in AR.CompressPointer.
2028  The outside of the bracket runs from AR.CompressBuffer+1 to mstop.
2029 */
2030  AR.CompressPointer = oldipointer;
2031  for(;;) {
2032  numterms++;
2033  retval = GetOneTerm(BHEAD AT.WorkPointer,AR.infile,&startposition,0);
2034  if ( retval <= 0 ) break;
2035 
2036  AR.CompressPointer = oldipointer;
2037  t = AR.CompressPointer;
2038  if ( *t < (1 + decr + ABS(*(t+*t-1))) ) break;
2039  t++;
2040  m = AR.CompressBuffer+1;
2041  while ( m < mstop ) {
2042  if ( *m != *t ) goto Thatsit;
2043  m++; t++;
2044  }
2045  }
2046 Thatsit:;
2047 /*
2048  Finished. Reposition the file, restore information and return.
2049 */
2050  AT.WorkPointer = oldwork;
2051  if ( AR.infile->handle >= 0 ) {
2052 /*
2053  SeekFile(AR.infile->handle,&oldposition,SEEK_SET);
2054 */
2055  }
2056  else {
2057  AR.infile->POfill = AR.infile->PObuffer + BASEPOSITION(oldposition);
2058  }
2059  AR.DeferFlag = olddeferflag;
2060  AR.GetOneFile = oldGetOneFile;
2061  return(numterms);
2062 }
2063 
2064 /*
2065  #] CountTerms1 :
2066  #[ TermsInBracket : LONG TermsInBracket(term,level)
2067 
2068  The function TermsInBracket_()
2069  Syntax:
2070  TermsInBracket_() : The current bracket in a Keep Brackets
2071  TermsInBracket_(bracket) : This bracket in the current expression
2072  TermsInBracket_(expression,bracket) : This bracket in the given expression
2073  All other specifications don't have any effect.
2074 */
2075 
2076 #define CURRENTBRACKET 1
2077 #define BRACKETCURRENTEXPR 2
2078 #define BRACKETOTHEREXPR 3
2079 #define NOBRACKETACTIVE 4
2080 
2081 LONG TermsInBracket(PHEAD WORD *term, WORD level)
2082 {
2083  WORD *t, *tstop, *b, *tt, *n1, *n2;
2084  int type = 0, i, num;
2085  LONG numterms = 0;
2086  WORD *bracketbuffer = AT.WorkPointer;
2087  t = term; GETSTOP(t,tstop);
2088  t++; b = bracketbuffer;
2089  while ( t < tstop ) {
2090  if ( *t != TERMSINBRACKET ) { t += t[1]; continue; }
2091  if ( t[1] == FUNHEAD || (
2092  t[1] == FUNHEAD+2
2093  && t[FUNHEAD] == -SNUMBER
2094  && t[FUNHEAD+1] == 0
2095  ) ) {
2096  if ( AC.ComDefer == 0 ) {
2097  type = NOBRACKETACTIVE;
2098  }
2099  else {
2100  type = CURRENTBRACKET;
2101  }
2102  *b = 0;
2103  break;
2104  }
2105  if ( t[FUNHEAD] == -EXPRESSION ) {
2106  if ( t[FUNHEAD+2] < 0 ) {
2107  if ( ( t[FUNHEAD+2] <= -FUNCTION ) && ( t[1] == FUNHEAD+3 ) ) {
2108  type = BRACKETOTHEREXPR;
2109  *b++ = FUNHEAD+4; *b++ = -t[FUNHEAD+2]; *b++ = FUNHEAD;
2110  for ( i = 2; i < FUNHEAD; i++ ) *b++ = 0;
2111  *b++ = 1; *b++ = 1; *b++ = 3;
2112  break;
2113  }
2114  else if ( ( t[FUNHEAD+2] > -FUNCTION ) && ( t[1] == FUNHEAD+4 ) ) {
2115  type = BRACKETOTHEREXPR;
2116  tt = t + FUNHEAD+2;
2117  switch ( *tt ) {
2118  case -SYMBOL:
2119  *b++ = 8; *b++ = SYMBOL; *b++ = 4; *b++ = tt[1];
2120  *b++ = 1; *b++ = 1; *b++ = 1; *b++ = 3;
2121  break;
2122  case -SNUMBER:
2123  if ( tt[1] == 1 ) {
2124  *b++ = 4; *b++ = 1; *b++ = 1; *b++ = 3;
2125  }
2126  else goto IllBraReq;
2127  break;
2128  default:
2129  goto IllBraReq;
2130  }
2131  break;
2132  }
2133  }
2134  else if ( ( t[FUNHEAD+2] == (t[1]-FUNHEAD-2) ) &&
2135  ( t[FUNHEAD+2+ARGHEAD] == (t[FUNHEAD+2]-ARGHEAD) ) ) {
2136  type = BRACKETOTHEREXPR;
2137  tt = t + FUNHEAD + ARGHEAD; num = *tt;
2138  for ( i = 0; i < num; i++ ) *b++ = *tt++;
2139  break;
2140  }
2141  }
2142  else {
2143  if ( t[FUNHEAD] < 0 ) {
2144  if ( ( t[FUNHEAD] <= -FUNCTION ) && ( t[1] == FUNHEAD+1 ) ) {
2145  type = BRACKETCURRENTEXPR;
2146  *b++ = FUNHEAD+4; *b++ = -t[FUNHEAD+2]; *b++ = FUNHEAD;
2147  for ( i = 2; i < FUNHEAD; i++ ) *b++ = 0;
2148  *b++ = 1; *b++ = 1; *b++ = 3; *b = 0;
2149  break;
2150  }
2151  else if ( ( t[FUNHEAD] > -FUNCTION ) && ( t[1] == FUNHEAD+2 ) ) {
2152  type = BRACKETCURRENTEXPR;
2153  tt = t + FUNHEAD+2;
2154  switch ( *tt ) {
2155  case -SYMBOL:
2156  *b++ = 8; *b++ = SYMBOL; *b++ = 4; *b++ = tt[1];
2157  *b++ = 1; *b++ = 1; *b++ = 1; *b++ = 3;
2158  break;
2159  case -SNUMBER:
2160  if ( tt[1] == 1 ) {
2161  *b++ = 4; *b++ = 1; *b++ = 1; *b++ = 3;
2162  }
2163  else goto IllBraReq;
2164  break;
2165  default:
2166  goto IllBraReq;
2167  }
2168  break;
2169  }
2170  }
2171  else if ( ( t[FUNHEAD] == (t[1]-FUNHEAD) ) &&
2172  ( t[FUNHEAD+ARGHEAD] == (t[FUNHEAD]-ARGHEAD) ) ) {
2173  type = BRACKETCURRENTEXPR;
2174  tt = t + FUNHEAD + ARGHEAD; num = *tt;
2175  for ( i = 0; i < num; i++ ) *b++ = *tt++;
2176  break;
2177  }
2178  else {
2179 IllBraReq:;
2180  MLOCK(ErrorMessageLock);
2181  MesPrint("Illegal bracket request in termsinbracket_ function.");
2182  MUNLOCK(ErrorMessageLock);
2183  Terminate(-1);
2184  }
2185  }
2186  t += t[1];
2187  }
2188  AT.WorkPointer = b;
2189  if ( AT.WorkPointer + *term +4 > AT.WorkTop ) {
2190  MLOCK(ErrorMessageLock);
2191  MesWork();
2192  MesPrint("Called from termsinbracket_ function.");
2193  MUNLOCK(ErrorMessageLock);
2194  return(-1);
2195  }
2196 /*
2197  We are now in the position to look for the bracket
2198 */
2199  switch ( type ) {
2200  case CURRENTBRACKET:
2201 /*
2202  The code here should be rather similar to when we pick up
2203  the contents of the bracket. In our case we only count the
2204  terms though.
2205 */
2206  numterms = CountTerms1(BHEAD0);
2207  break;
2208  case BRACKETCURRENTEXPR:
2209 /*
2210  Not implemented yet.
2211 */
2212  MLOCK(ErrorMessageLock);
2213  MesPrint("termsinbracket_ function currently only handles Keep Brackets.");
2214  MUNLOCK(ErrorMessageLock);
2215  return(-1);
2216  case BRACKETOTHEREXPR:
2217  MLOCK(ErrorMessageLock);
2218  MesPrint("termsinbracket_ function currently only handles Keep Brackets.");
2219  MUNLOCK(ErrorMessageLock);
2220  return(-1);
2221  case NOBRACKETACTIVE:
2222  numterms = 1;
2223  break;
2224  }
2225 /*
2226  Now we have the number in numterms. We replace the function by it.
2227 */
2228  n1 = term; n2 = AT.WorkPointer; tstop = n1 + *n1;
2229  while ( n1 < t ) *n2++ = *n1++;
2230  i = numterms >> BITSINWORD;
2231  if ( i == 0 ) {
2232  *n2++ = LNUMBER; *n2++ = 4; *n2++ = 1; *n2++ = (WORD)(numterms & WORDMASK);
2233  }
2234  else {
2235  *n2++ = LNUMBER; *n2++ = 5; *n2++ = 2;
2236  *n2++ = (WORD)(numterms & WORDMASK); *n2++ = i;
2237  }
2238  n1 += n1[1];
2239  while ( n1 < tstop ) *n2++ = *n1++;
2240  AT.WorkPointer[0] = n2 - AT.WorkPointer;
2241  AT.WorkPointer = n2;
2242  if ( Generator(BHEAD n1,level) < 0 ) {
2243  AT.WorkPointer = bracketbuffer;
2244  MLOCK(ErrorMessageLock);
2245  MesPrint("Called from termsinbracket_ function.");
2246  MUNLOCK(ErrorMessageLock);
2247  return(-1);
2248  }
2249 /*
2250  Finished. Reset things and return.
2251 */
2252  AT.WorkPointer = bracketbuffer;
2253  return(numterms);
2254 }
2255 /*
2256  #] TermsInBracket : LONG TermsInBracket(term,level)
2257  #] Expressions :
2258 */
int PF_BroadcastCBuf(int bufnum)
Definition: parallel.c:3146
Definition: structs.h:618
#define PHEAD
Definition: ftypes.h:56
WORD Processor()
Definition: proces.c:64
int PF_BroadcastExpFlags(void)
Definition: parallel.c:3257
WORD number
Definition: structs.h:241
int PF_BroadcastExpr(EXPRESSIONS e, FILEHANDLE *file)
Definition: parallel.c:3549
SBYTE name[MAXENAME+1]
Definition: structs.h:109
int PF_BroadcastRedefinedPreVars(void)
Definition: parallel.c:3004
WORD * renumlists
Definition: structs.h:384
int PF_CollectModifiedDollars(void)
Definition: parallel.c:2508
int MakeInverses()
Definition: reken.c:1407
WORD Generator(PHEAD WORD *, WORD)
Definition: proces.c:2865
void CleanUpSort(int)
Definition: sort.c:4361
int PF_BroadcastModifiedDollars(void)
Definition: parallel.c:2787
int handle
Definition: structs.h:646
VARRENUM symb
Definition: structs.h:180
WORD * lo
Definition: structs.h:167