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