FORM v5.0.1-33-gdf7fc94
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/* INTERNAL_ERROR_EXCL_START */
1118 MesPrint("!>Cannot restart the storage file");
1119 RetCode = -1;
1120/* INTERNAL_ERROR_EXCL_STOP */
1121 }
1122 else RetCode = 0;
1123 CleanUp(1);
1124 ResetVariables(2);
1125 AM.gProcessBucketSize = AM.hProcessBucketSize;
1126 AM.gparallelflag = PARALLELFLAG;
1127 AM.gnumextrasym = AM.ggnumextrasym;
1128 PruneExtraSymbols(AM.ggnumextrasym);
1129 IniVars();
1130 }
1131 ClearSpectators(par);
1132 }
1133 else {
1134 if ( CleanExpr(0) ) RetCode = -1;
1135 if ( AC.DidClean ) CompactifyTree(AC.exprnames,EXPRNAMES);
1136 ResetVariables(0);
1137 CleanUpSort(-1);
1138 }
1139 clearcbuf(AC.cbufnum);
1140 if ( AC.MultiBracketBuf != 0 ) {
1141 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
1142 if ( AC.MultiBracketBuf[i] ) {
1143 M_free(AC.MultiBracketBuf[i],"bracket buffer i");
1144 AC.MultiBracketBuf[i] = 0;
1145 }
1146 }
1147 AC.MultiBracketLevels = 0;
1148 M_free(AC.MultiBracketBuf,"multi bracket buffer");
1149 AC.MultiBracketBuf = 0;
1150 }
1151
1152 if ( AC.SortReallocateFlag ) {
1153 /* Reallocate the sort buffers to reduce resident set usage */
1154 /* AT.SS is the same as AT.S0 here */
1155 SORTING* S = AT.S0;
1156 M_free(S->lBuffer, "SortReallocate lBuffer+sBuffer");
1157 S->lBuffer = Malloc1(sizeof(*(S->lBuffer))*(S->LargeSize+S->SmallEsize), "SortReallocate lBuffer+sBuffer");
1158 S->lTop = S->lBuffer+S->LargeSize;
1159 S->sBuffer = S->lTop;
1160 if ( S->LargeSize == 0 ) { S->lBuffer = 0; S->lTop = 0; }
1161 S->sTop = S->sBuffer + S->SmallSize;
1162 S->sTop2 = S->sBuffer + S->SmallEsize;
1163 S->sHalf = S->sBuffer + (LONG)((S->SmallSize+S->SmallEsize)>>1);
1164
1165#ifdef WITHPTHREADS
1166 /* We have to re-set the pointers into master lBuffer in the SortBlocks */
1167 UpdateSortBlocks(AM.totalnumberofthreads-1);
1168
1169 /* The SortBots do not have a real sort buffer to reallocate. */
1170 /* AB[0] has been reallocated above already. */
1171 for ( i = 1; i < AM.totalnumberofthreads; i++ ) {
1172 SORTING* S = AB[i]->T.S0;
1173 M_free(S->lBuffer, "SortReallocate lBuffer+sBuffer");
1174 S->lBuffer = Malloc1(sizeof(*(S->lBuffer))*(S->LargeSize+S->SmallEsize), "SortReallocate lBuffer+sBuffer");
1175 S->lTop = S->lBuffer+S->LargeSize;
1176 S->sBuffer = S->lTop;
1177 if ( S->LargeSize == 0 ) { S->lBuffer = 0; S->lTop = 0; }
1178 S->sTop = S->sBuffer + S->SmallSize;
1179 S->sTop2 = S->sBuffer + S->SmallEsize;
1180 S->sHalf = S->sBuffer + (LONG)((S->SmallSize+S->SmallEsize)>>1);
1181 }
1182#endif
1183 }
1184 if ( AC.SortReallocateFlag == 2 ) {
1185 /* The Flag was set for a single module by the preprocessor #sortreallocate,
1186 so turn it off again. */
1187 AC.SortReallocateFlag = 0;
1188 }
1189
1190 return(RetCode);
1191}
1192
1193/*
1194 #] DoExecute :
1195 #[ PutBracket :
1196
1197 Routine uses the bracket info to split a term into two pieces:
1198 1: the part outside the bracket, and
1199 2: the part inside the bracket.
1200 These parts are separated by a subterm of type HAAKJE.
1201 This subterm looks like: HAAKJE,3,level
1202 The level is used for nestings of brackets. The print routines
1203 cannot handle this yet (31-Mar-1988).
1204
1205 The Bracket selector is in AT.BrackBuf in the form of a regular term,
1206 but without coefficient.
1207 When AR.BracketOn < 0 we have a socalled antibracket. The main effect
1208 is an exchange of the inner and outer part and where the coefficient goes.
1209
1210 Routine recoded to facilitate b p1,p2; etc for dotproducts and tensors
1211 15-oct-1991
1212*/
1213
1214int PutBracket(PHEAD WORD *termin)
1215{
1216 GETBIDENTITY
1217 WORD *t, *t1, *b, i, j, *lastfun;
1218 WORD *t2, *s1, *s2;
1219 WORD *bStop, *bb, *bf, *tStop;
1220 WORD *term1,*term2, *m1, *m2, *tStopa;
1221 WORD *bbb = 0, *bind, *binst = 0, bwild = 0, *bss = 0, *bns = 0, bset = 0;
1222 term1 = AT.WorkPointer+1;
1223 term2 = (WORD *)(((UBYTE *)(term1)) + AM.MaxTer);
1224 if ( ( (WORD *)(((UBYTE *)(term2)) + AM.MaxTer) ) > AT.WorkTop ) {
1225 MesWork();
1226 }
1227 if ( AR.BracketOn < 0 ) {
1228 t2 = term1; t1 = term2; /* AntiBracket */
1229 }
1230 else {
1231 t1 = term1; t2 = term2; /* Regular bracket */
1232 }
1233 b = AT.BrackBuf; bStop = b+*b; b++;
1234 while ( b < bStop ) {
1235 if ( *b == INDEX ) { bwild = 1; bbb = b+2; binst = b + b[1]; }
1236 if ( *b == SETSET ) { bset = 1; bss = b+2; bns = b + b[1]; }
1237 b += b[1];
1238 }
1239
1240 t = termin; tStopa = t + *t; i = *(t + *t -1); i = ABS(i);
1241 if ( AR.PolyFun && AT.PolyAct ) tStop = termin + AT.PolyAct;
1242#ifdef WITHFLOAT
1243 else if ( AT.FloatPos ) tStop = termin + AT.FloatPos;
1244#endif
1245 else tStop = tStopa - i;
1246 t++;
1247 if ( AR.BracketOn < 0 ) {
1248 lastfun = 0;
1249 while ( t < tStop && *t >= FUNCTION
1250 && functions[*t-FUNCTION].commute ) {
1251 b = AT.BrackBuf+1;
1252 while ( b < bStop ) {
1253 if ( *b == *t ) {
1254 lastfun = t;
1255 while ( t < tStop && *t >= FUNCTION
1256 && functions[*t-FUNCTION].commute ) t += t[1];
1257 goto NextNcom1;
1258 }
1259 b += b[1];
1260 }
1261 if ( bset ) {
1262 b = bss;
1263 while ( b < bns ) {
1264 if ( b[1] == CFUNCTION ) { /* Set of functions */
1265 SETS set = Sets+b[0]; WORD i;
1266 for ( i = set->first; i < set->last; i++ ) {
1267 if ( SetElements[i] == *t ) {
1268 lastfun = t;
1269 while ( t < tStop && *t >= FUNCTION
1270 && functions[*t-FUNCTION].commute ) t += t[1];
1271 goto NextNcom1;
1272 }
1273 }
1274 }
1275 b += 2;
1276 }
1277 }
1278 if ( bwild && *t >= FUNCTION && functions[*t-FUNCTION].spec ) {
1279 s1 = t + t[1];
1280 s2 = t + FUNHEAD;
1281 while ( s2 < s1 ) {
1282 bind = bbb;
1283 while ( bind < binst ) {
1284 if ( *bind == *s2 ) {
1285 lastfun = t;
1286 while ( t < tStop && *t >= FUNCTION
1287 && functions[*t-FUNCTION].commute ) t += t[1];
1288 goto NextNcom1;
1289 }
1290 bind++;
1291 }
1292 s2++;
1293 }
1294 }
1295 t += t[1];
1296 }
1297NextNcom1:
1298 s1 = termin + 1;
1299 if ( lastfun ) {
1300 while ( s1 < lastfun ) *t2++ = *s1++;
1301 while ( s1 < t ) *t1++ = *s1++;
1302 }
1303 else {
1304 while ( s1 < t ) *t2++ = *s1++;
1305 }
1306
1307 }
1308 else {
1309 lastfun = t;
1310 while ( t < tStop && *t >= FUNCTION
1311 && functions[*t-FUNCTION].commute ) {
1312 b = AT.BrackBuf+1;
1313 while ( b < bStop ) {
1314 if ( *b == *t ) { lastfun = t + t[1]; goto NextNcom; }
1315 b += b[1];
1316 }
1317 if ( bset ) {
1318 b = bss;
1319 while ( b < bns ) {
1320 if ( b[1] == CFUNCTION ) { /* Set of functions */
1321 SETS set = Sets+b[0]; WORD i;
1322 for ( i = set->first; i < set->last; i++ ) {
1323 if ( SetElements[i] == *t ) {
1324 lastfun = t + t[1];
1325 goto NextNcom;
1326 }
1327 }
1328 }
1329 b += 2;
1330 }
1331 }
1332 if ( bwild && *t >= FUNCTION && functions[*t-FUNCTION].spec ) {
1333 s1 = t + t[1];
1334 s2 = t + FUNHEAD;
1335 while ( s2 < s1 ) {
1336 bind = bbb;
1337 while ( bind < binst ) {
1338 if ( *bind == *s2 ) { lastfun = t + t[1]; goto NextNcom; }
1339 bind++;
1340 }
1341 s2++;
1342 }
1343 }
1344NextNcom:
1345 t += t[1];
1346 }
1347 s1 = termin + 1;
1348 while ( s1 < lastfun ) *t1++ = *s1++;
1349 while ( s1 < t ) *t2++ = *s1++;
1350 }
1351/*
1352 Now we have only commuting functions left. Move the b pointer to them.
1353*/
1354 b = AT.BrackBuf + 1;
1355 while ( b < bStop && *b >= FUNCTION
1356 && ( *b < FUNCTION || functions[*b-FUNCTION].commute ) ) {
1357 b += b[1];
1358 }
1359 bf = b;
1360
1361 while ( t < tStop && ( bf < bStop || bwild || bset ) ) {
1362 b = bf;
1363 while ( b < bStop && *b != *t ) { b += b[1]; }
1364 i = t[1];
1365 if ( *t >= FUNCTION ) { /* We are in function territory */
1366 if ( b < bStop && *b == *t ) goto FunBrac;
1367 if ( bset ) {
1368 b = bss;
1369 while ( b < bns ) {
1370 if ( b[1] == CFUNCTION ) { /* Set of functions */
1371 SETS set = Sets+b[0]; WORD i;
1372 for ( i = set->first; i < set->last; i++ ) {
1373 if ( SetElements[i] == *t ) goto FunBrac;
1374 }
1375 }
1376 b += 2;
1377 }
1378 }
1379 if ( bwild && *t >= FUNCTION && functions[*t-FUNCTION].spec ) {
1380 s1 = t + t[1];
1381 s2 = t + FUNHEAD;
1382 while ( s2 < s1 ) {
1383 bind = bbb;
1384 while ( bind < binst ) {
1385 if ( *bind == *s2 ) goto FunBrac;
1386 bind++;
1387 }
1388 s2++;
1389 }
1390 }
1391 NCOPY(t2,t,i);
1392 continue;
1393FunBrac: NCOPY(t1,t,i);
1394 continue;
1395 }
1396/*
1397 We have left: DELTA, INDEX, VECTOR, DOTPRODUCT, SYMBOL
1398*/
1399 if ( *t == DELTA ) {
1400 if ( b < bStop && *b == DELTA ) {
1401 b += b[1];
1402 NCOPY(t1,t,i);
1403 }
1404 else { NCOPY(t2,t,i); }
1405 }
1406 else if ( *t == INDEX ) {
1407 if ( bwild ) {
1408 m1 = t1; m2 = t2;
1409 *t1++ = *t; t1++; *t2++ = *t; t2++;
1410 bind = bbb;
1411 j = t[1] -2;
1412 t += 2;
1413 while ( --j >= 0 ) {
1414 while ( *bind < *t && bind < binst ) bind++;
1415 if ( *bind == *t && bind < binst ) {
1416 *t1++ = *t++;
1417 }
1418 else if ( bset ) {
1419 WORD *b3 = bss;
1420 while ( b3 < bns ) {
1421 if ( b3[1] == CVECTOR ) {
1422 SETS set = Sets+b3[0]; WORD i;
1423 for ( i = set->first; i < set->last; i++ ) {
1424 if ( SetElements[i] == *t ) {
1425 *t1++ = *t++;
1426 goto nextind;
1427 }
1428 }
1429 }
1430 b3 += 2;
1431 }
1432 *t2++ = *t++;
1433 }
1434 else *t2++ = *t++;
1435nextind:;
1436 }
1437 m1[1] = WORDDIF(t1,m1);
1438 if ( m1[1] == 2 ) t1 = m1;
1439 m2[1] = WORDDIF(t2,m2);
1440 if ( m2[1] == 2 ) t2 = m2;
1441 }
1442 else if ( bset ) {
1443 m1 = t1; m2 = t2;
1444 *t1++ = *t; t1++; *t2++ = *t; t2++;
1445 j = t[1] -2;
1446 t += 2;
1447 while ( --j >= 0 ) {
1448 WORD *b3 = bss;
1449 while ( b3 < bns ) {
1450 if ( b3[1] == CVECTOR ) {
1451 SETS set = Sets+b3[0]; WORD i;
1452 for ( i = set->first; i < set->last; i++ ) {
1453 if ( SetElements[i] == *t ) {
1454 *t1++ = *t++;
1455 goto nextind2;
1456 }
1457 }
1458 }
1459 b3 += 2;
1460 }
1461 *t2++ = *t++;
1462nextind2:;
1463 }
1464 m1[1] = WORDDIF(t1,m1);
1465 if ( m1[1] == 2 ) t1 = m1;
1466 m2[1] = WORDDIF(t2,m2);
1467 if ( m2[1] == 2 ) t2 = m2;
1468 }
1469 else {
1470 NCOPY(t2,t,i);
1471 }
1472 }
1473 else if ( *t == VECTOR ) {
1474 if ( ( b < bStop && *b == VECTOR ) || bwild ) {
1475 if ( b < bStop && *b == VECTOR ) {
1476 bb = b + b[1]; b += 2;
1477 }
1478 else bb = b;
1479 j = t[1] - 2;
1480 m1 = t1; m2 = t2; *t1++ = *t; *t2++ = *t; t1++; t2++; t += 2;
1481 while ( j > 0 ) {
1482 j -= 2;
1483 while ( b < bb && ( *b < *t ||
1484 ( *b == *t && b[1] < t[1] ) ) ) b += 2;
1485 if ( b < bb && ( *t == *b && t[1] == b[1] ) ) {
1486 *t1++ = *t++; *t1++ = *t++; goto nextvec;
1487 }
1488 else if ( bwild ) {
1489 bind = bbb;
1490 while ( bind < binst ) {
1491 if ( *t == *bind || t[1] == *bind ) {
1492 *t1++ = *t++; *t1++ = *t++;
1493 goto nextvec;
1494 }
1495 bind++;
1496 }
1497 }
1498 if ( bset ) {
1499 WORD *b3 = bss;
1500 while ( b3 < bns ) {
1501 if ( b3[1] == CVECTOR ) {
1502 SETS set = Sets+b3[0]; WORD i;
1503 for ( i = set->first; i < set->last; i++ ) {
1504 if ( SetElements[i] == *t ) {
1505 *t1++ = *t++; *t1++ = *t++;
1506 goto nextvec;
1507 }
1508 }
1509 }
1510 b3 += 2;
1511 }
1512 }
1513 *t2++ = *t++; *t2++ = *t++;
1514nextvec:;
1515 }
1516 m1[1] = WORDDIF(t1,m1);
1517 if ( m1[1] == 2 ) t1 = m1;
1518 m2[1] = WORDDIF(t2,m2);
1519 if ( m2[1] == 2 ) t2 = m2;
1520 }
1521 else if ( bset ) {
1522 m1 = t1; *t1++ = *t; t1++;
1523 m2 = t2; *t2++ = *t; t2++;
1524 s2 = t + i; t += 2;
1525 while ( t < s2 ) {
1526 WORD *b3 = bss;
1527 while ( b3 < bns ) {
1528 if ( b3[1] == CVECTOR ) {
1529 SETS set = Sets+b3[0]; WORD i;
1530 for ( i = set->first; i < set->last; i++ ) {
1531 if ( SetElements[i] == *t ) {
1532 *t1++ = *t++; *t1++ = *t++;
1533 goto nextvec2;
1534 }
1535 }
1536 }
1537 b3 += 2;
1538 }
1539 *t2++ = *t++; *t2++ = *t++;
1540nextvec2:;
1541 }
1542 m1[1] = WORDDIF(t1,m1);
1543 if ( m1[1] == 2 ) t1 = m1;
1544 m2[1] = WORDDIF(t2,m2);
1545 if ( m2[1] == 2 ) t2 = m2;
1546 }
1547 else {
1548 NCOPY(t2,t,i);
1549 }
1550 }
1551 else if ( *t == DOTPRODUCT ) {
1552 if ( ( b < bStop && *b == *t ) || bwild ) {
1553 m1 = t1; *t1++ = *t; t1++;
1554 m2 = t2; *t2++ = *t; t2++;
1555 if ( b >= bStop || *b != *t ) { bb = b; s1 = b; }
1556 else {
1557 s1 = b + b[1]; bb = b + 2;
1558 }
1559 s2 = t + i; t += 2;
1560 while ( t < s2 && ( bb < s1 || bwild || bset ) ) {
1561 while ( bb < s1 && ( *bb < *t ||
1562 ( *bb == *t && bb[1] < t[1] ) ) ) bb += 3;
1563 if ( bb < s1 && *bb == *t && bb[1] == t[1] ) {
1564 *t1++ = *t++; *t1++ = *t++; *t1++ = *t++; bb += 3;
1565 goto nextdot;
1566 }
1567 else if ( bwild ) {
1568 bind = bbb;
1569 while ( bind < binst ) {
1570 if ( *bind == *t || *bind == t[1] ) {
1571 *t1++ = *t++; *t1++ = *t++; *t1++ = *t++;
1572 goto nextdot;
1573 }
1574 bind++;
1575 }
1576 }
1577 if ( bset ) {
1578 WORD *b3 = bss;
1579 while ( b3 < bns ) {
1580 if ( b3[1] == CVECTOR ) {
1581 SETS set = Sets+b3[0]; WORD i;
1582 for ( i = set->first; i < set->last; i++ ) {
1583 if ( SetElements[i] == *t || SetElements[i] == t[1] ) {
1584 *t1++ = *t++; *t1++ = *t++; *t1++ = *t++;
1585 goto nextdot;
1586 }
1587 }
1588 }
1589 b3 += 2;
1590 }
1591 }
1592 *t2++ = *t++; *t2++ = *t++; *t2++ = *t++;
1593nextdot:;
1594 }
1595 while ( t < s2 ) *t2++ = *t++;
1596 m1[1] = WORDDIF(t1,m1);
1597 if ( m1[1] == 2 ) t1 = m1;
1598 m2[1] = WORDDIF(t2,m2);
1599 if ( m2[1] == 2 ) t2 = m2;
1600 }
1601 else if ( bset ) {
1602 m1 = t1; *t1++ = *t; t1++;
1603 m2 = t2; *t2++ = *t; t2++;
1604 s2 = t + i; t += 2;
1605 while ( t < s2 ) {
1606 WORD *b3 = bss;
1607 while ( b3 < bns ) {
1608 if ( b3[1] == CVECTOR ) {
1609 SETS set = Sets+b3[0]; WORD i;
1610 for ( i = set->first; i < set->last; i++ ) {
1611 if ( SetElements[i] == *t || SetElements[i] == t[1] ) {
1612 *t1++ = *t++; *t1++ = *t++; *t1++ = *t++;
1613 goto nextdot2;
1614 }
1615 }
1616 }
1617 b3 += 2;
1618 }
1619 *t2++ = *t++; *t2++ = *t++; *t2++ = *t++;
1620nextdot2:;
1621 }
1622 m1[1] = WORDDIF(t1,m1);
1623 if ( m1[1] == 2 ) t1 = m1;
1624 m2[1] = WORDDIF(t2,m2);
1625 if ( m2[1] == 2 ) t2 = m2;
1626 }
1627 else { NCOPY(t2,t,i); }
1628 }
1629 else if ( *t == SYMBOL ) {
1630 if ( b < bStop && *b == *t ) {
1631 m1 = t1; *t1++ = *t; t1++;
1632 m2 = t2; *t2++ = *t; t2++;
1633 s1 = b + b[1]; bb = b+2;
1634 s2 = t + i; t += 2;
1635 while ( bb < s1 && t < s2 ) {
1636 while ( bb < s1 && *bb < *t ) bb += 2;
1637 if ( bb >= s1 ) {
1638 if ( bset ) goto TrySymbolSet;
1639 break;
1640 }
1641 if ( *bb == *t ) { *t1++ = *t++; *t1++ = *t++; }
1642 else if ( bset ) {
1643 WORD *bbb;
1644TrySymbolSet:
1645 bbb = bss;
1646 while ( bbb < bns ) {
1647 if ( bbb[1] == CSYMBOL ) { /* Set of symbols */
1648 SETS set = Sets+bbb[0]; WORD i;
1649 for ( i = set->first; i < set->last; i++ ) {
1650 if ( SetElements[i] == *t ) {
1651 *t1++ = *t++; *t1++ = *t++;
1652 goto NextSymbol;
1653 }
1654 }
1655 }
1656 bbb += 2;
1657 }
1658 *t2++ = *t++; *t2++ = *t++;
1659 }
1660 else { *t2++ = *t++; *t2++ = *t++; }
1661NextSymbol:;
1662 }
1663 while ( t < s2 ) *t2++ = *t++;
1664 m1[1] = WORDDIF(t1,m1);
1665 if ( m1[1] == 2 ) t1 = m1;
1666 m2[1] = WORDDIF(t2,m2);
1667 if ( m2[1] == 2 ) t2 = m2;
1668 }
1669 else if ( bset ) {
1670 WORD *bbb;
1671 m1 = t1; *t1++ = *t; t1++;
1672 m2 = t2; *t2++ = *t; t2++;
1673 s2 = t + i; t += 2;
1674 while ( t < s2 ) {
1675 bbb = bss;
1676 while ( bbb < bns ) {
1677 if ( bbb[1] == CSYMBOL ) { /* Set of symbols */
1678 SETS set = Sets+bbb[0]; WORD i;
1679 for ( i = set->first; i < set->last; i++ ) {
1680 if ( SetElements[i] == *t ) {
1681 *t1++ = *t++; *t1++ = *t++;
1682 goto NextSymbol2;
1683 }
1684 }
1685 }
1686 bbb += 2;
1687 }
1688 *t2++ = *t++; *t2++ = *t++;
1689NextSymbol2:;
1690 }
1691 m1[1] = WORDDIF(t1,m1);
1692 if ( m1[1] == 2 ) t1 = m1;
1693 m2[1] = WORDDIF(t2,m2);
1694 if ( m2[1] == 2 ) t2 = m2;
1695 }
1696 else { NCOPY(t2,t,i); }
1697 }
1698 else {
1699 NCOPY(t2,t,i);
1700 }
1701 }
1702 if ( ( i = WORDDIF(tStop,t) ) > 0 ) NCOPY(t2,t,i);
1703 if ( AR.BracketOn < 0 ) {
1704 s1 = t1; t1 = t2; t2 = s1;
1705 }
1706 do { *t2++ = *t++; } while ( t < (WORD *)tStopa );
1707 t = AT.WorkPointer;
1708 i = WORDDIF(t1,term1);
1709 *t++ = 4 + i + WORDDIF(t2,term2);
1710 t += i;
1711 *t++ = HAAKJE;
1712 *t++ = 3;
1713 *t++ = 0; /* This feature won't be used for a while */
1714 i = WORDDIF(t2,term2);
1715 t1 = term2;
1716 if ( i > 0 ) NCOPY(t,t1,i);
1717
1718 AT.WorkPointer = t;
1719
1720 return(0);
1721}
1722
1723/*
1724 #] PutBracket :
1725 #[ SpecialCleanup :
1726*/
1727
1728void SpecialCleanup(PHEAD0)
1729{
1730 GETBIDENTITY
1731 if ( AT.previousEfactor ) M_free(AT.previousEfactor,"Efactor cache");
1732 AT.previousEfactor = 0;
1733}
1734
1735/*
1736 #] SpecialCleanup :
1737 #[ SetMods :
1738*/
1739
1740#ifndef WITHPTHREADS
1741
1742void SetMods(void)
1743{
1744 int i, n;
1745 if ( AN.cmod != 0 ) M_free(AN.cmod,"AN.cmod");
1746 n = ABS(AN.ncmod);
1747 AN.cmod = (UWORD *)Malloc1(sizeof(WORD)*n,"AN.cmod");
1748 for ( i = 0; i < n; i++ ) AN.cmod[i] = AC.cmod[i];
1749}
1750
1751#endif
1752
1753/*
1754 #] SetMods :
1755 #[ UnSetMods :
1756*/
1757
1758#ifndef WITHPTHREADS
1759
1760void UnSetMods(void)
1761{
1762 if ( AN.cmod != 0 ) M_free(AN.cmod,"AN.cmod");
1763 AN.cmod = 0;
1764}
1765
1766#endif
1767
1768/*
1769 #] UnSetMods :
1770 #] DoExecute :
1771 #[ Expressions :
1772 #[ ExchangeExpressions :
1773*/
1774
1775void ExchangeExpressions(int num1, int num2)
1776{
1777 GETIDENTITY
1778 WORD node1, node2, namesize, TMproto[SUBEXPSIZE];
1779 INDEXENTRY *ind;
1780 EXPRESSIONS e1, e2;
1781 LONG a;
1782 SBYTE *s1, *s2;
1783 int i;
1784 e1 = Expressions + num1;
1785 e2 = Expressions + num2;
1786 node1 = e1->node;
1787 node2 = e2->node;
1788 AC.exprnames->namenode[node1].number = num2;
1789 AC.exprnames->namenode[node2].number = num1;
1790 a = e1->name; e1->name = e2->name; e2->name = a;
1791 namesize = e1->namesize; e1->namesize = e2->namesize; e2->namesize = namesize;
1792 e1->node = node2;
1793 e2->node = node1;
1794 if ( e1->status == STOREDEXPRESSION ) {
1795/*
1796 Find the name in the index and replace by the new name
1797*/
1798 TMproto[0] = EXPRESSION;
1799 TMproto[1] = SUBEXPSIZE;
1800 TMproto[2] = num1;
1801 TMproto[3] = 1;
1802 { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1803 AT.TMaddr = TMproto;
1804 ind = FindInIndex(num1,&AR.StoreData,0,0);
1805 s1 = (SBYTE *)(AC.exprnames->namebuffer+e1->name);
1806 i = e1->namesize;
1807 s2 = ind->name;
1808 NCOPY(s2,s1,i);
1809 *s2 = 0;
1810 SeekFile(AR.StoreData.Handle,&(e1->onfile),SEEK_SET);
1811 if ( WriteFile(AR.StoreData.Handle,(UBYTE *)ind,
1812 (LONG)(sizeof(INDEXENTRY))) != sizeof(INDEXENTRY) ) {
1813/* INTERNAL_ERROR_EXCL_START */
1814 MesPrint("!>File error while exchanging expressions");
1815 Terminate(-1);
1816/* INTERNAL_ERROR_EXCL_STOP */
1817 }
1818 FlushFile(AR.StoreData.Handle);
1819 }
1820 if ( e2->status == STOREDEXPRESSION ) {
1821/*
1822 Find the name in the index and replace by the new name
1823*/
1824 TMproto[0] = EXPRESSION;
1825 TMproto[1] = SUBEXPSIZE;
1826 TMproto[2] = num2;
1827 TMproto[3] = 1;
1828 { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1829 AT.TMaddr = TMproto;
1830 ind = FindInIndex(num1,&AR.StoreData,0,0);
1831 s1 = (SBYTE *)(AC.exprnames->namebuffer+e2->name);
1832 i = e2->namesize;
1833 s2 = ind->name;
1834 NCOPY(s2,s1,i);
1835 *s2 = 0;
1836 SeekFile(AR.StoreData.Handle,&(e2->onfile),SEEK_SET);
1837 if ( WriteFile(AR.StoreData.Handle,(UBYTE *)ind,
1838 (LONG)(sizeof(INDEXENTRY))) != sizeof(INDEXENTRY) ) {
1839/* INTERNAL_ERROR_EXCL_START */
1840 MesPrint("!>File error while exchanging expressions");
1841 Terminate(-1);
1842/* INTERNAL_ERROR_EXCL_STOP */
1843 }
1844 FlushFile(AR.StoreData.Handle);
1845 }
1846}
1847
1848/*
1849 #] ExchangeExpressions :
1850 #[ GetFirstBracket :
1851*/
1852
1853int GetFirstBracket(WORD *term, int num)
1854{
1855/*
1856 Gets the first bracket of the expression 'num'
1857 Puts it in term. If no brackets the answer is one.
1858 Routine should be thread-safe
1859*/
1860 GETIDENTITY
1861 POSITION position, oldposition;
1862 RENUMBER renumber;
1863 FILEHANDLE *fi;
1864 WORD type, *oldcomppointer, oldonefile, numword;
1865 WORD *t, *tstop;
1866
1867 oldcomppointer = AR.CompressPointer;
1868 type = Expressions[num].status;
1869 if ( type == STOREDEXPRESSION ) {
1870 WORD TMproto[SUBEXPSIZE];
1871 TMproto[0] = EXPRESSION;
1872 TMproto[1] = SUBEXPSIZE;
1873 TMproto[2] = num;
1874 TMproto[3] = 1;
1875 { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1876 AT.TMaddr = TMproto;
1877 PUTZERO(position);
1878 if ( ( renumber = GetTable(num,&position,0) ) == 0 ) {
1879 MesCall("GetFirstBracket");
1880 SETERROR(-1)
1881 }
1882 if ( GetFromStore(term,&position,renumber,&numword,num) < 0 ) {
1883 MesCall("GetFirstBracket");
1884 SETERROR(-1)
1885 }
1886/*
1887#ifdef WITHPTHREADS
1888*/
1889 if ( renumber->symb.lo != AN.dummyrenumlist )
1890 M_free(renumber->symb.lo,"VarSpace");
1891 M_free(renumber,"Renumber");
1892/*
1893#endif
1894*/
1895 }
1896 else { /* Active expression */
1897 oldonefile = AR.GetOneFile;
1898 if ( type == HIDDENLEXPRESSION || type == HIDDENGEXPRESSION ) {
1899 AR.GetOneFile = 2; fi = AR.hidefile;
1900 }
1901 else {
1902 AR.GetOneFile = 0; fi = AR.infile;
1903 }
1904 if ( fi->handle >= 0 ) {
1905 PUTZERO(oldposition);
1906/*
1907 SeekFile(fi->handle,&oldposition,SEEK_CUR);
1908*/
1909 }
1910 else {
1911 SETBASEPOSITION(oldposition,fi->POfill-fi->PObuffer);
1912 }
1913 position = AS.OldOnFile[num];
1914 if ( GetOneTerm(BHEAD term,fi,&position,1) < 0
1915 || ( GetOneTerm(BHEAD term,fi,&position,1) < 0 ) ) {
1916 MLOCK(ErrorMessageLock);
1917 MesCall("GetFirstBracket");
1918 MUNLOCK(ErrorMessageLock);
1919 SETERROR(-1)
1920 }
1921 if ( fi->handle >= 0 ) {
1922/*
1923 SeekFile(fi->handle,&oldposition,SEEK_SET);
1924 if ( ISNEGPOS(oldposition) ) {
1925 MLOCK(ErrorMessageLock);
1926 MesPrint("File error");
1927 MUNLOCK(ErrorMessageLock);
1928 SETERROR(-1)
1929 }
1930*/
1931 }
1932 else {
1933 fi->POfill = fi->PObuffer+BASEPOSITION(oldposition);
1934 }
1935 AR.GetOneFile = oldonefile;
1936 }
1937 AR.CompressPointer = oldcomppointer;
1938 if ( *term ) {
1939 tstop = term + *term; tstop -= ABS(tstop[-1]);
1940 t = term + 1;
1941 while ( t < tstop ) {
1942 if ( *t == HAAKJE ) break;
1943 t += t[1];
1944 }
1945 if ( t >= tstop ) {
1946 term[0] = 4; term[1] = 1; term[2] = 1; term[3] = 3;
1947 }
1948 else {
1949 *t++ = 1; *t++ = 1; *t++ = 3; *term = t - term;
1950 }
1951 }
1952 else {
1953 term[0] = 4; term[1] = 1; term[2] = 1; term[3] = 3;
1954 }
1955 return(*term);
1956}
1957
1958/*
1959 #] GetFirstBracket :
1960 #[ GetFirstTerm :
1961*/
1962
1972int GetFirstTerm(WORD *term, int num, int pre)
1973{
1974 GETIDENTITY
1975 POSITION position, oldposition;
1976 RENUMBER renumber;
1977 FILEHANDLE *fi;
1978 WORD type, *oldcomppointer, oldonefile, numword;
1979
1980 oldcomppointer = AR.CompressPointer;
1981 type = Expressions[num].status;
1982 if ( type == STOREDEXPRESSION ) {
1983 WORD TMproto[SUBEXPSIZE];
1984 TMproto[0] = EXPRESSION;
1985 TMproto[1] = SUBEXPSIZE;
1986 TMproto[2] = num;
1987 TMproto[3] = 1;
1988 { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
1989 AT.TMaddr = TMproto;
1990 PUTZERO(position);
1991 if ( ( renumber = GetTable(num,&position,0) ) == 0 ) {
1992 MesCall("GetFirstTerm");
1993 SETERROR(-1)
1994 }
1995 if ( GetFromStore(term,&position,renumber,&numword,num) < 0 ) {
1996 MesCall("GetFirstTerm");
1997 SETERROR(-1)
1998 }
1999/*
2000#ifdef WITHPTHREADS
2001*/
2002 if ( renumber->symb.lo != AN.dummyrenumlist )
2003 M_free(renumber->symb.lo,"VarSpace");
2004 M_free(renumber,"Renumber");
2005/*
2006#endif
2007*/
2008 }
2009 else { /* Active expression */
2010 oldonefile = AR.GetOneFile;
2011 if ( type == HIDDENLEXPRESSION || type == HIDDENGEXPRESSION ) {
2012 AR.GetOneFile = 2; fi = AR.hidefile;
2013 }
2014 else {
2015 AR.GetOneFile = 0;
2016 if ( Expressions[num].replace == NEWLYDEFINEDEXPRESSION ) {
2017 /* During execution, if the expression has already been processed it
2018 will be in the outfile. If it has not, the usage is illegal according
2019 to the manual, though no error is given. */
2020 if ( pre == 0 ) { fi = AR.outfile; }
2021 /* During preprocessing, the expression certainly has not been processed
2022 yet. Print an error and terminate. */
2023 else {
2024 MesPrint("&isnumerical: expression is not yet defined!");
2025 SETERROR(-1);
2026 }
2027 }
2028 else {
2029 /* During execution, we should use the definition as stored at the end
2030 of the previous module. This is in the infile. */
2031 if ( pre == 0 ) { fi = AR.infile; }
2032 /* During preprocessing, this function is called before the RevertScratch
2033 at the beginning of this module's execution. Thus the expressions are
2034 in the outfile of the previous module. */
2035 else { fi = AR.outfile; }
2036 }
2037 }
2038 if ( fi->handle >= 0 ) {
2039 PUTZERO(oldposition);
2040/*
2041 SeekFile(fi->handle,&oldposition,SEEK_CUR);
2042*/
2043 }
2044 else {
2045 SETBASEPOSITION(oldposition,fi->POfill-fi->PObuffer);
2046 }
2047 position = AS.OldOnFile[num];
2048 if ( GetOneTerm(BHEAD term,fi,&position,1) < 0
2049 || ( GetOneTerm(BHEAD term,fi,&position,1) < 0 ) ) {
2050 MLOCK(ErrorMessageLock);
2051 MesCall("GetFirstTerm");
2052 MUNLOCK(ErrorMessageLock);
2053 SETERROR(-1)
2054 }
2055 if ( fi->handle >= 0 ) {
2056/*
2057 SeekFile(fi->handle,&oldposition,SEEK_SET);
2058 if ( ISNEGPOS(oldposition) ) {
2059 MLOCK(ErrorMessageLock);
2060 MesPrint("File error");
2061 MUNLOCK(ErrorMessageLock);
2062 SETERROR(-1)
2063 }
2064*/
2065 }
2066 else {
2067 fi->POfill = fi->PObuffer+BASEPOSITION(oldposition);
2068 }
2069 AR.GetOneFile = oldonefile;
2070 }
2071 AR.CompressPointer = oldcomppointer;
2072 return(*term);
2073}
2074
2075/*
2076 #] GetFirstTerm :
2077 #[ GetContent :
2078*/
2079
2080int GetContent(WORD *content, int num)
2081{
2082/*
2083 Gets the content of the expression 'num'
2084 Puts it in content.
2085 Routine should be thread-safe
2086 The content is defined as the term that will make the expression 'num'
2087 with integer coefficients, no GCD and all common factors taken out,
2088 all negative powers removed when we divide the expression by this
2089 content.
2090*/
2091 GETIDENTITY
2092 POSITION position, oldposition;
2093 RENUMBER renumber;
2094 FILEHANDLE *fi;
2095 WORD type, *oldcomppointer, oldonefile, numword, *term, i;
2096 WORD *cbuffer = TermMalloc("GetContent");
2097 WORD *oldworkpointer = AT.WorkPointer;
2098
2099 oldcomppointer = AR.CompressPointer;
2100 type = Expressions[num].status;
2101 if ( type == STOREDEXPRESSION ) {
2102 WORD TMproto[SUBEXPSIZE];
2103 TMproto[0] = EXPRESSION;
2104 TMproto[1] = SUBEXPSIZE;
2105 TMproto[2] = num;
2106 TMproto[3] = 1;
2107 { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
2108 AT.TMaddr = TMproto;
2109 PUTZERO(position);
2110 if ( ( renumber = GetTable(num,&position,0) ) == 0 ) goto CalledFrom;
2111 if ( GetFromStore(cbuffer,&position,renumber,&numword,num) < 0 ) goto CalledFrom;
2112 for(;;) {
2113 term = oldworkpointer;
2114 AR.CompressPointer = oldcomppointer;
2115 if ( GetFromStore(term,&position,renumber,&numword,num) < 0 ) goto CalledFrom;
2116 if ( *term == 0 ) break;
2117/*
2118 'merge' the two terms
2119*/
2120 if ( ContentMerge(BHEAD cbuffer,term) < 0 ) goto CalledFrom;
2121 }
2122/*
2123#ifdef WITHPTHREADS
2124*/
2125 if ( renumber->symb.lo != AN.dummyrenumlist )
2126 M_free(renumber->symb.lo,"VarSpace");
2127 M_free(renumber,"Renumber");
2128/*
2129#endif
2130*/
2131 }
2132 else { /* Active expression */
2133 oldonefile = AR.GetOneFile;
2134 if ( type == HIDDENLEXPRESSION || type == HIDDENGEXPRESSION ) {
2135 AR.GetOneFile = 2; fi = AR.hidefile;
2136 }
2137 else {
2138 AR.GetOneFile = 0;
2139 if ( Expressions[num].replace == NEWLYDEFINEDEXPRESSION )
2140 fi = AR.outfile;
2141 else fi = AR.infile;
2142 }
2143 if ( fi->handle >= 0 ) {
2144 PUTZERO(oldposition);
2145/*
2146 SeekFile(fi->handle,&oldposition,SEEK_CUR);
2147*/
2148 }
2149 else {
2150 SETBASEPOSITION(oldposition,fi->POfill-fi->PObuffer);
2151 }
2152 position = AS.OldOnFile[num];
2153 if ( GetOneTerm(BHEAD cbuffer,fi,&position,1) < 0 ) goto CalledFrom;
2154 AR.CompressPointer = oldcomppointer;
2155 if ( GetOneTerm(BHEAD cbuffer,fi,&position,1) < 0 ) goto CalledFrom;
2156/*
2157 Now go through the terms. For each term we have to test whether
2158 what is in cbuffer is also in that term. If not, we have to remove
2159 it from cbuffer. Additionally we have to accumulate the GCD of the
2160 numerators and the LCM of the denominators. This is all done in the
2161 routine ContentMerge.
2162*/
2163 for(;;) {
2164 term = oldworkpointer;
2165 AR.CompressPointer = oldcomppointer;
2166 if ( GetOneTerm(BHEAD term,fi,&position,1) < 0 ) goto CalledFrom;
2167 if ( *term == 0 ) break;
2168/*
2169 'merge' the two terms
2170*/
2171 if ( ContentMerge(BHEAD cbuffer,term) < 0 ) goto CalledFrom;
2172 }
2173 if ( fi->handle < 0 ) {
2174 fi->POfill = fi->PObuffer+BASEPOSITION(oldposition);
2175 }
2176 AR.GetOneFile = oldonefile;
2177 }
2178 AR.CompressPointer = oldcomppointer;
2179 for ( i = 0; i < *cbuffer; i++ ) content[i] = cbuffer[i];
2180 TermFree(cbuffer,"GetContent");
2181 AT.WorkPointer = oldworkpointer;
2182 return(*content);
2183CalledFrom:
2184 MLOCK(ErrorMessageLock);
2185 MesCall("GetContent");
2186 MUNLOCK(ErrorMessageLock);
2187 SETERROR(-1)
2188}
2189
2190/*
2191 #] GetContent :
2192 #[ CleanupTerm :
2193
2194 Removes noncommuting objects from the term
2195*/
2196
2197int CleanupTerm(WORD *term)
2198{
2199 WORD *tstop, *t, *tfill, *tt;
2200 GETSTOP(term,tstop);
2201 t = term+1;
2202 while ( t < tstop ) {
2203 if ( *t >= FUNCTION && ( functions[*t-FUNCTION].commute || *t == DENOMINATOR ) ) {
2204 tfill = t; tt = t + t[1]; tstop = term + *term;
2205 while ( tt < tstop ) *tfill++ = *tt++;
2206 *term = tfill - term;
2207 tstop -= ABS(tfill[-1]);
2208 }
2209 else {
2210 t += t[1];
2211 }
2212 }
2213 return(0);
2214}
2215
2216/*
2217 #] CleanupTerm :
2218 #[ ContentMerge :
2219*/
2220
2221WORD ContentMerge(PHEAD WORD *content, WORD *term)
2222{
2223 GETBIDENTITY
2224 WORD *cstop, csize, crsize, sign = 1, numsize, densize, i, tnsize, tdsize;
2225 UWORD *num, *den, *tnum, *tden;
2226 WORD *outfill, *outb = TermMalloc("ContentMerge"), *ct;
2227 WORD *t, *tstop, tsize, trsize, *told;
2228 WORD *t1, *t2, *c1, *c2, i1, i2, *out1;
2229 WORD didsymbol = 0, diddotp = 0, tfirst;
2230 cstop = content + *content;
2231 csize = cstop[-1];
2232 if ( csize < 0 ) { sign = -sign; csize = -csize; }
2233 cstop -= csize;
2234 numsize = densize = crsize = (csize-1)/2;
2235 num = NumberMalloc("ContentMerge");
2236 den = NumberMalloc("ContentMerge");
2237 for ( i = 0; i < numsize; i++ ) num[i] = (UWORD)(cstop[i]);
2238 for ( i = 0; i < densize; i++ ) den[i] = (UWORD)(cstop[i+crsize]);
2239 while ( num[numsize-1] == 0 ) numsize--;
2240 while ( den[densize-1] == 0 ) densize--;
2241/*
2242 First we do the coefficient
2243*/
2244 tstop = term + *term;
2245 tsize = tstop[-1];
2246 if ( tsize < 0 ) tsize = -tsize;
2247/* else { sign = 1; } */
2248 tstop = tstop - tsize;
2249 tnsize = tdsize = trsize = (tsize-1)/2;
2250 tnum = (UWORD *)tstop; tden = (UWORD *)(tstop + trsize);
2251 while ( tnum[tnsize-1] == 0 ) tnsize--;
2252 while ( tden[tdsize-1] == 0 ) tdsize--;
2253 GcdLong(BHEAD num, numsize, tnum, tnsize, num, &numsize);
2254 if ( LcmLong(BHEAD den, densize, tden, tdsize, den, &densize) ) goto CalledFrom;
2255 outfill = outb + 1;
2256 ct = content + 1;
2257 t = term + 1;
2258 while ( ct < cstop ) {
2259 switch ( *ct ) {
2260 case SYMBOL:
2261 didsymbol = 1;
2262 t = term+1;
2263 while ( t < tstop && *t != *ct ) t += t[1];
2264 if ( t >= tstop ) break;
2265 t1 = t+2; t2 = t+t[1];
2266 c1 = ct+2; c2 = ct+ct[1];
2267 out1 = outfill; *outfill++ = *ct; outfill++;
2268 while ( c1 < c2 && t1 < t2 ) {
2269 if ( *c1 == *t1 ) {
2270 if ( t1[1] <= c1[1] ) {
2271 *outfill++ = *t1++; *outfill++ = *t1++;
2272 c1 += 2;
2273 }
2274 else {
2275 *outfill++ = *c1++; *outfill++ = *c1++;
2276 t1 += 2;
2277 }
2278 }
2279 else if ( *c1 < *t1 ) {
2280 if ( c1[1] < 0 ) {
2281 *outfill++ = *c1++; *outfill++ = *c1++;
2282 }
2283 else { c1 += 2; }
2284 }
2285 else {
2286 if ( t1[1] < 0 ) {
2287 *outfill++ = *t1++; *outfill++ = *t1++;
2288 }
2289 else t1 += 2;
2290 }
2291 }
2292 while ( c1 < c2 ) {
2293 if ( c1[1] < 0 ) { *outfill++ = c1[0]; *outfill++ = c1[1]; }
2294 c1 += 2;
2295 }
2296 while ( t1 < t2 ) {
2297 if ( t1[1] < 0 ) { *outfill++ = t1[0]; *outfill++ = t1[1]; }
2298 t1 += 2;
2299 }
2300 out1[1] = outfill - out1;
2301 if ( out1[1] == 2 ) outfill = out1;
2302 break;
2303 case DOTPRODUCT:
2304 diddotp = 1;
2305 t = term+1;
2306 while ( t < tstop && *t != *ct ) t += t[1];
2307 if ( t >= tstop ) break;
2308 t1 = t+2; t2 = t+t[1];
2309 c1 = ct+2; c2 = ct+ct[1];
2310 out1 = outfill; *outfill++ = *ct; outfill++;
2311 while ( c1 < c2 && t1 < t2 ) {
2312 if ( *c1 == *t1 && c1[1] == t1[1] ) {
2313 if ( t1[2] <= c1[2] ) {
2314 *outfill++ = *t1++; *outfill++ = *t1++; *outfill++ = *t1++;
2315 c1 += 3;
2316 }
2317 else {
2318 *outfill++ = *c1++; *outfill++ = *c1++; *outfill++ = *c1++;
2319 t1 += 3;
2320 }
2321 }
2322 else if ( *c1 < *t1 || ( *c1 == *t1 && c1[1] < t1[1] ) ) {
2323 if ( c1[2] < 0 ) {
2324 *outfill++ = *c1++; *outfill++ = *c1++; *outfill++ = *c1++;
2325 }
2326 else { c1 += 3; }
2327 }
2328 else {
2329 if ( t1[2] < 0 ) {
2330 *outfill++ = *t1++; *outfill++ = *t1++; *outfill++ = *t1++;
2331 }
2332 else t1 += 3;
2333 }
2334 }
2335 while ( c1 < c2 ) {
2336 if ( c1[2] < 0 ) { *outfill++ = c1[0]; *outfill++ = c1[1]; *outfill++ = c1[1]; }
2337 c1 += 3;
2338 }
2339 while ( t1 < t2 ) {
2340 if ( t1[2] < 0 ) { *outfill++ = t1[0]; *outfill++ = t1[1]; *outfill++ = t1[1]; }
2341 t1 += 3;
2342 }
2343 out1[1] = outfill - out1;
2344 if ( out1[1] == 2 ) outfill = out1;
2345 break;
2346 case INDEX:
2347 t = term+1;
2348 while ( t < tstop && *t != *ct ) t += t[1];
2349 if ( t >= tstop ) break;
2350 t1 = t+2; t2 = t+t[1];
2351 c1 = ct+2; c2 = ct+ct[1];
2352 out1 = outfill; *outfill++ = *ct; outfill++;
2353 while ( c1 < c2 && t1 < t2 ) {
2354 if ( *c1 == *t1 ) {
2355 *outfill++ = *c1++;
2356 t1 += 1;
2357 }
2358 else if ( *c1 < *t1 ) { c1 += 1; }
2359 else { t1 += 1; }
2360 }
2361 out1[1] = outfill - out1;
2362 if ( out1[1] == 2 ) outfill = out1;
2363 break;
2364 case VECTOR:
2365 case DELTA:
2366 t = term+1;
2367 while ( t < tstop && *t != *ct ) t += t[1];
2368 if ( t >= tstop ) break;
2369 t1 = t+2; t2 = t+t[1];
2370 c1 = ct+2; c2 = ct+ct[1];
2371 out1 = outfill; *outfill++ = *ct; outfill++;
2372 while ( c1 < c2 && t1 < t2 ) {
2373 if ( *c1 == *t1 && c1[1] && t1[1] ) {
2374 *outfill++ = *c1++; *outfill++ = *c1++;
2375 t1 += 2;
2376 }
2377 else if ( *c1 < *t1 || ( *c1 == *t1 && c1[1] < t1[1] ) ) {
2378 c1 += 2;
2379 }
2380 else {
2381 t1 += 2;
2382 }
2383 }
2384 out1[1] = outfill - out1;
2385 if ( out1[1] == 2 ) outfill = out1;
2386 break;
2387 case GAMMA:
2388 default: /* Functions */
2389 told = t;
2390 t = term+1;
2391 while ( t < tstop ) {
2392 if ( *t != *ct ) { t += t[1]; continue; }
2393 if ( ct[1] != t[1] ) { t += t[1]; continue; }
2394 if ( ct[2] != t[2] ) { t += t[1]; continue; }
2395 t1 = t; t2 = ct; i1 = t1[1]; i2 = t2[1];
2396 while ( i1 > 0 ) {
2397 if ( *t1 != *t2 ) break;
2398 t1++; t2++; i1--;
2399 }
2400 if ( i1 != 0 ) { t += t[1]; continue; }
2401 t1 = t;
2402 for ( i = 0; i < i2; i++ ) { *outfill++ = *t++; }
2403/*
2404 Mark as 'used'. The flags must be different!
2405*/
2406 t1[2] |= SUBTERMUSED1;
2407 ct[2] |= SUBTERMUSED2;
2408 t = told;
2409 break;
2410 }
2411 break;
2412 }
2413 ct += ct[1];
2414 }
2415 if ( diddotp == 0 ) {
2416 t = term+1; while ( t < tstop && *t != DOTPRODUCT ) t += t[1];
2417 if ( t < tstop ) { /* now we need the negative powers */
2418 tfirst = 1; told = outfill;
2419 for ( i = 2; i < t[1]; i += 3 ) {
2420 if ( t[i+2] < 0 ) {
2421 if ( tfirst ) { *outfill++ = DOTPRODUCT; *outfill++ = 0; tfirst = 0; }
2422 *outfill++ = t[i]; *outfill++ = t[i+1]; *outfill++ = t[i+2];
2423 }
2424 }
2425 if ( outfill > told ) told[1] = outfill-told;
2426 }
2427 }
2428 if ( didsymbol == 0 ) {
2429 t = term+1; while ( t < tstop && *t != SYMBOL ) t += t[1];
2430 if ( t < tstop ) { /* now we need the negative powers */
2431 tfirst = 1; told = outfill;
2432 for ( i = 2; i < t[1]; i += 2 ) {
2433 if ( t[i+1] < 0 ) {
2434 if ( tfirst ) { *outfill++ = SYMBOL; *outfill++ = 0; tfirst = 0; }
2435 *outfill++ = t[i]; *outfill++ = t[i+1];
2436 }
2437 }
2438 if ( outfill > told ) told[1] = outfill-told;
2439 }
2440 }
2441/*
2442 Now put the coefficient back.
2443*/
2444 if ( numsize < densize ) {
2445 for ( i = numsize; i < densize; i++ ) num[i] = 0;
2446 numsize = densize;
2447 }
2448 else if ( densize < numsize ) {
2449 for ( i = densize; i < numsize; i++ ) den[i] = 0;
2450 densize = numsize;
2451 }
2452 for ( i = 0; i < numsize; i++ ) *outfill++ = num[i];
2453 for ( i = 0; i < densize; i++ ) *outfill++ = den[i];
2454 csize = numsize+densize+1;
2455 if ( sign < 0 ) csize = -csize;
2456 *outfill++ = csize;
2457 *outb = outfill-outb;
2458 NumberFree(den,"ContentMerge");
2459 NumberFree(num,"ContentMerge");
2460 for ( i = 0; i < *outb; i++ ) content[i] = outb[i];
2461 TermFree(outb,"ContentMerge");
2462/*
2463 Now we have to 'restore' the term to its original.
2464 We do not restore the content, because if anything was used the
2465 new content overwrites the old. 6-mar-2018 JV
2466*/
2467 t = term + 1;
2468 while ( t < tstop ) {
2469 if ( *t >= FUNCTION ) t[2] &= ~SUBTERMUSED1;
2470 t += t[1];
2471 }
2472 return(*content);
2473CalledFrom:
2474 MLOCK(ErrorMessageLock);
2475 MesCall("GetContent");
2476 MUNLOCK(ErrorMessageLock);
2477 SETERROR(-1)
2478}
2479
2480/*
2481 #] ContentMerge :
2482 #[ TermsInExpression :
2483*/
2484
2485LONG TermsInExpression(WORD num)
2486{
2487 LONG x = Expressions[num].counter;
2488 if ( x >= 0 ) return(x);
2489 return(-1);
2490}
2491
2492/*
2493 #] TermsInExpression :
2494 #[ SizeOfExpression :
2495*/
2496
2497LONG SizeOfExpression(WORD num)
2498{
2499 LONG x = (LONG)(DIVPOS(Expressions[num].size,sizeof(WORD)));
2500 if ( x >= 0 ) return(x);
2501 return(-1);
2502}
2503
2504/*
2505 #] SizeOfExpression :
2506 #[ UpdatePositions :
2507*/
2508
2509void UpdatePositions(void)
2510{
2511 EXPRESSIONS e = Expressions;
2512 POSITION *old;
2513 WORD *oldw;
2514 int i;
2515 if ( NumExpressions > 0 &&
2516 ( AS.OldOnFile == 0 || AS.NumOldOnFile < NumExpressions ) ) {
2517 if ( AS.OldOnFile ) {
2518 old = AS.OldOnFile;
2519 AS.OldOnFile = (POSITION *)Malloc1(NumExpressions*sizeof(POSITION),"file pointers");
2520 for ( i = 0; i < AS.NumOldOnFile; i++ ) AS.OldOnFile[i] = old[i];
2521 AS.NumOldOnFile = NumExpressions;
2522 M_free(old,"process file pointers");
2523 }
2524 else {
2525 AS.OldOnFile = (POSITION *)Malloc1(NumExpressions*sizeof(POSITION),"file pointers");
2526 AS.NumOldOnFile = NumExpressions;
2527 }
2528 }
2529 if ( NumExpressions > 0 &&
2530 ( AS.OldNumFactors == 0 || AS.NumOldNumFactors < NumExpressions ) ) {
2531 if ( AS.OldNumFactors ) {
2532 oldw = AS.OldNumFactors;
2533 AS.OldNumFactors = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"numfactors pointers");
2534 for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.OldNumFactors[i] = oldw[i];
2535 M_free(oldw,"numfactors pointers");
2536 oldw = AS.Oldvflags;
2537 AS.Oldvflags = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"vflags pointers");
2538 for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.Oldvflags[i] = oldw[i];
2539 M_free(oldw,"vflags pointers");
2540 oldw = AS.Olduflags;
2541 AS.Olduflags = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"uflags pointers");
2542 for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.Olduflags[i] = oldw[i];
2543 M_free(oldw,"uflags pointers");
2544 AS.NumOldNumFactors = NumExpressions;
2545 }
2546 else {
2547 AS.OldNumFactors = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"numfactors pointers");
2548 AS.Oldvflags = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"vflags pointers");
2549 AS.Olduflags = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"uflags pointers");
2550 AS.NumOldNumFactors = NumExpressions;
2551 }
2552 }
2553 for ( i = 0; i < NumExpressions; i++ ) {
2554 AS.OldOnFile[i] = e[i].onfile;
2555 AS.OldNumFactors[i] = e[i].numfactors;
2556 AS.Oldvflags[i] = e[i].vflags;
2557 AS.Olduflags[i] = e[i].uflags;
2558 }
2559}
2560
2561/*
2562 #] UpdatePositions :
2563 #[ CountTerms1 : LONG CountTerms1()
2564
2565 Counts the terms in the current deferred bracket
2566 Is mainly an adaptation of the routine Deferred in proces.c
2567*/
2568
2569LONG CountTerms1(PHEAD0)
2570{
2571 GETBIDENTITY
2572 POSITION oldposition, startposition;
2573 WORD *t, *m, *mstop, decr, i, *oldwork, retval;
2574 WORD *oldipointer = AR.CompressPointer;
2575 WORD oldGetOneFile = AR.GetOneFile, olddeferflag = AR.DeferFlag;
2576 LONG numterms = 0;
2577 AR.GetOneFile = 1;
2578 oldwork = AT.WorkPointer;
2579 AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
2580 AR.DeferFlag = 0;
2581 startposition = AR.DefPosition;
2582/*
2583 Store old position
2584*/
2585 if ( AR.infile->handle >= 0 ) {
2586 PUTZERO(oldposition);
2587/*
2588 SeekFile(AR.infile->handle,&oldposition,SEEK_CUR);
2589*/
2590 }
2591 else {
2592 SETBASEPOSITION(oldposition,AR.infile->POfill-AR.infile->PObuffer);
2593 AR.infile->POfill = (WORD *)((UBYTE *)(AR.infile->PObuffer)
2594 +BASEPOSITION(startposition));
2595 }
2596/*
2597 Look in the CompressBuffer where the bracket contents start
2598*/
2599 t = m = AR.CompressBuffer;
2600 t += *t;
2601 mstop = t - ABS(t[-1]);
2602 m++;
2603 while ( *m != HAAKJE && m < mstop ) m += m[1];
2604 if ( m >= mstop ) { /* No deferred action! */
2605 numterms = 1;
2606 AR.DeferFlag = olddeferflag;
2607 AT.WorkPointer = oldwork;
2608 AR.GetOneFile = oldGetOneFile;
2609 return(numterms);
2610 }
2611 mstop = m + m[1];
2612 decr = WORDDIF(mstop,AR.CompressBuffer)-1;
2613
2614 m = AR.CompressBuffer;
2615 t = AR.CompressPointer;
2616 i = *m;
2617 NCOPY(t,m,i);
2618 AR.TePos = 0;
2619 AN.TeSuOut = 0;
2620/*
2621 Status:
2622 First bracket content starts at mstop.
2623 Next term starts at startposition.
2624 Decompression information is in AR.CompressPointer.
2625 The outside of the bracket runs from AR.CompressBuffer+1 to mstop.
2626*/
2627 AR.CompressPointer = oldipointer;
2628 for(;;) {
2629 numterms++;
2630 retval = GetOneTerm(BHEAD AT.WorkPointer,AR.infile,&startposition,0);
2631 if ( retval >= 0 ) AR.CompressPointer = oldipointer;
2632 if ( retval <= 0 ) break;
2633 t = AR.CompressPointer;
2634 if ( *t < (1 + decr + ABS(*(t+*t-1))) ) break;
2635 t++;
2636 m = AR.CompressBuffer+1;
2637 while ( m < mstop ) {
2638 if ( *m != *t ) goto Thatsit;
2639 m++; t++;
2640 }
2641 }
2642Thatsit:;
2643/*
2644 Finished. Reposition the file, restore information and return.
2645*/
2646 AT.WorkPointer = oldwork;
2647 if ( AR.infile->handle >= 0 ) {
2648/*
2649 SeekFile(AR.infile->handle,&oldposition,SEEK_SET);
2650*/
2651 }
2652 else {
2653 AR.infile->POfill = AR.infile->PObuffer + BASEPOSITION(oldposition);
2654 }
2655 AR.DeferFlag = olddeferflag;
2656 AR.GetOneFile = oldGetOneFile;
2657 return(numterms);
2658}
2659
2660/*
2661 #] CountTerms1 :
2662 #[ TermsInBracket : LONG TermsInBracket(term,level)
2663
2664 The function TermsInBracket_()
2665 Syntax:
2666 TermsInBracket_() : The current bracket in a Keep Brackets
2667 TermsInBracket_(bracket) : This bracket in the current expression
2668 TermsInBracket_(expression,bracket) : This bracket in the given expression
2669 All other specifications don't have any effect.
2670*/
2671
2672#define CURRENTBRACKET 1
2673#define BRACKETCURRENTEXPR 2
2674#define BRACKETOTHEREXPR 3
2675#define NOBRACKETACTIVE 4
2676
2677LONG TermsInBracket(PHEAD WORD *term, WORD level)
2678{
2679 WORD *t, *tstop, *b, *tt, *n1, *n2;
2680 int type = 0, i, num;
2681 LONG numterms = 0;
2682 WORD *bracketbuffer = AT.WorkPointer;
2683 t = term; GETSTOP(t,tstop);
2684 t++; b = bracketbuffer;
2685 while ( t < tstop ) {
2686 if ( *t != TERMSINBRACKET ) { t += t[1]; continue; }
2687 if ( t[1] == FUNHEAD || (
2688 t[1] == FUNHEAD+2
2689 && t[FUNHEAD] == -SNUMBER
2690 && t[FUNHEAD+1] == 0
2691 ) ) {
2692 if ( AC.ComDefer == 0 ) {
2693 type = NOBRACKETACTIVE;
2694 }
2695 else {
2696 type = CURRENTBRACKET;
2697 }
2698 *b = 0;
2699 break;
2700 }
2701 if ( t[FUNHEAD] == -EXPRESSION ) {
2702 if ( t[FUNHEAD+2] < 0 ) {
2703 if ( ( t[FUNHEAD+2] <= -FUNCTION ) && ( t[1] == FUNHEAD+3 ) ) {
2704 type = BRACKETOTHEREXPR;
2705 *b++ = FUNHEAD+4; *b++ = -t[FUNHEAD+2]; *b++ = FUNHEAD;
2706 for ( i = 2; i < FUNHEAD; i++ ) *b++ = 0;
2707 *b++ = 1; *b++ = 1; *b++ = 3;
2708 break;
2709 }
2710 else if ( ( t[FUNHEAD+2] > -FUNCTION ) && ( t[1] == FUNHEAD+4 ) ) {
2711 type = BRACKETOTHEREXPR;
2712 tt = t + FUNHEAD+2;
2713 switch ( *tt ) {
2714 case -SYMBOL:
2715 *b++ = 8; *b++ = SYMBOL; *b++ = 4; *b++ = tt[1];
2716 *b++ = 1; *b++ = 1; *b++ = 1; *b++ = 3;
2717 break;
2718 case -SNUMBER:
2719 if ( tt[1] == 1 ) {
2720 *b++ = 4; *b++ = 1; *b++ = 1; *b++ = 3;
2721 }
2722 else goto IllBraReq;
2723 break;
2724 default:
2725 goto IllBraReq;
2726 }
2727 break;
2728 }
2729 }
2730 else if ( ( t[FUNHEAD+2] == (t[1]-FUNHEAD-2) ) &&
2731 ( t[FUNHEAD+2+ARGHEAD] == (t[FUNHEAD+2]-ARGHEAD) ) ) {
2732 type = BRACKETOTHEREXPR;
2733 tt = t + FUNHEAD + ARGHEAD; num = *tt;
2734 for ( i = 0; i < num; i++ ) *b++ = *tt++;
2735 break;
2736 }
2737 }
2738 else {
2739 if ( t[FUNHEAD] < 0 ) {
2740 if ( ( t[FUNHEAD] <= -FUNCTION ) && ( t[1] == FUNHEAD+1 ) ) {
2741 type = BRACKETCURRENTEXPR;
2742 *b++ = FUNHEAD+4; *b++ = -t[FUNHEAD+2]; *b++ = FUNHEAD;
2743 for ( i = 2; i < FUNHEAD; i++ ) *b++ = 0;
2744 *b++ = 1; *b++ = 1; *b++ = 3; *b = 0;
2745 break;
2746 }
2747 else if ( ( t[FUNHEAD] > -FUNCTION ) && ( t[1] == FUNHEAD+2 ) ) {
2748 type = BRACKETCURRENTEXPR;
2749 tt = t + FUNHEAD+2;
2750 switch ( *tt ) {
2751 case -SYMBOL:
2752 *b++ = 8; *b++ = SYMBOL; *b++ = 4; *b++ = tt[1];
2753 *b++ = 1; *b++ = 1; *b++ = 1; *b++ = 3;
2754 break;
2755 case -SNUMBER:
2756 if ( tt[1] == 1 ) {
2757 *b++ = 4; *b++ = 1; *b++ = 1; *b++ = 3;
2758 }
2759 else goto IllBraReq;
2760 break;
2761 default:
2762 goto IllBraReq;
2763 }
2764 break;
2765 }
2766 }
2767 else if ( ( t[FUNHEAD] == (t[1]-FUNHEAD) ) &&
2768 ( t[FUNHEAD+ARGHEAD] == (t[FUNHEAD]-ARGHEAD) ) ) {
2769 type = BRACKETCURRENTEXPR;
2770 tt = t + FUNHEAD + ARGHEAD; num = *tt;
2771 for ( i = 0; i < num; i++ ) *b++ = *tt++;
2772 break;
2773 }
2774 else {
2775IllBraReq:;
2776 MLOCK(ErrorMessageLock);
2777 MesPrint("Illegal bracket request in termsinbracket_ function.");
2778 MUNLOCK(ErrorMessageLock);
2779 Terminate(-1);
2780 }
2781 }
2782 t += t[1];
2783 }
2784 AT.WorkPointer = b;
2785 if ( AT.WorkPointer + *term +4 > AT.WorkTop ) {
2786 MLOCK(ErrorMessageLock);
2787 MesWork();
2788 MesPrint("Called from termsinbracket_ function.");
2789 MUNLOCK(ErrorMessageLock);
2790 return(-1);
2791 }
2792/*
2793 We are now in the position to look for the bracket
2794*/
2795 switch ( type ) {
2796 case CURRENTBRACKET:
2797/*
2798 The code here should be rather similar to when we pick up
2799 the contents of the bracket. In our case we only count the
2800 terms though.
2801*/
2802 numterms = CountTerms1(BHEAD0);
2803 break;
2804 case BRACKETCURRENTEXPR:
2805/*
2806 Not implemented yet.
2807*/
2808 MLOCK(ErrorMessageLock);
2809 MesPrint("termsinbracket_ function currently only handles Keep Brackets.");
2810 MUNLOCK(ErrorMessageLock);
2811 return(-1);
2812 case BRACKETOTHEREXPR:
2813 MLOCK(ErrorMessageLock);
2814 MesPrint("termsinbracket_ function currently only handles Keep Brackets.");
2815 MUNLOCK(ErrorMessageLock);
2816 return(-1);
2817 case NOBRACKETACTIVE:
2818 numterms = 1;
2819 break;
2820 }
2821/*
2822 Now we have the number in numterms. We replace the function by it.
2823*/
2824 n1 = term; n2 = AT.WorkPointer; tstop = n1 + *n1;
2825 while ( n1 < t ) *n2++ = *n1++;
2826 i = numterms >> BITSINWORD;
2827 if ( i == 0 ) {
2828 *n2++ = LNUMBER; *n2++ = 4; *n2++ = 1; *n2++ = (WORD)(numterms & WORDMASK);
2829 }
2830 else {
2831 *n2++ = LNUMBER; *n2++ = 5; *n2++ = 2;
2832 *n2++ = (WORD)(numterms & WORDMASK); *n2++ = i;
2833 }
2834 n1 += n1[1];
2835 while ( n1 < tstop ) *n2++ = *n1++;
2836 AT.WorkPointer[0] = n2 - AT.WorkPointer;
2837 AT.WorkPointer = n2;
2838 if ( Generator(BHEAD n1,level) < 0 ) {
2839 AT.WorkPointer = bracketbuffer;
2840 MLOCK(ErrorMessageLock);
2841 MesPrint("Called from termsinbracket_ function.");
2842 MUNLOCK(ErrorMessageLock);
2843 return(-1);
2844 }
2845/*
2846 Finished. Reset things and return.
2847*/
2848 AT.WorkPointer = bracketbuffer;
2849 return(numterms);
2850}
2851/*
2852 #] TermsInBracket : LONG TermsInBracket(term,level)
2853 #] Expressions :
2854*/
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:3275
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:1972
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