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