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