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