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