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