FORM v5.0.1-33-gdf7fc94
module.c
Go to the documentation of this file.
1
7/* #[ License : */
8/*
9 * Copyright (C) 1984-2026 J.A.M. Vermaseren
10 * When using this file you are requested to refer to the publication
11 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
12 * This is considered a matter of courtesy as the development was paid
13 * for by FOM the Dutch physics granting agency and we would like to
14 * be able to track its scientific use to convince FOM of its value
15 * for the community.
16 *
17 * This file is part of FORM.
18 *
19 * FORM is free software: you can redistribute it and/or modify it under the
20 * terms of the GNU General Public License as published by the Free Software
21 * Foundation, either version 3 of the License, or (at your option) any later
22 * version.
23 *
24 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
25 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
26 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
27 * details.
28 *
29 * You should have received a copy of the GNU General Public License along
30 * with FORM. If not, see <http://www.gnu.org/licenses/>.
31 */
32/* #] License : */
33/*
34 #[ Includes :
35*/
36
37#include "form3.h"
38
39/*
40 #] Includes :
41 #[ Modules :
42 #[ ModuleInstruction :
43
44 Enters after the . of .sort etc
45 We have word[[(options)][:commentary];]
46 Word is one of 'clear end global sort store'
47 Options are 'polyfun, endloopifunchanged, endloopifzero'
48 Additions for solving equations can be added to 'word'
49
50 The flag in the moduleoptions is for telling whether the current
51 option can be followed by others. If it is > 0 it cannot.
52*/
53
54static KEYWORD ModuleWords[] = {
55 {"clear", (TFUN)0, CLEARMODULE, 0}
56 ,{"end", (TFUN)0, ENDMODULE, 0}
57 ,{"global", (TFUN)0, GLOBALMODULE, 0}
58 ,{"sort", (TFUN)0, SORTMODULE, 0}
59 ,{"store", (TFUN)0, STOREMODULE, 0}
60};
61
62static KEYWORD ModuleOptions[] = {
63 {"inparallel", DoinParallel, 1, 1}
64 ,{"local", DoModLocal, MODLOCAL, 0}
65 ,{"maximum", DoModMax, MODMAX, 0}
66 ,{"minimum", DoModMin, MODMIN, 0}
67 ,{"noparallel", DoNoParallel, NOPARALLEL_USER,0}
68 ,{"notinparallel", DonotinParallel,0, 1}
69 ,{"parallel", DoParallel, PARALLELFLAG, 0}
70 ,{"polyfun", DoPolyfun, POLYFUN, 0}
71 ,{"polyratfun", DoPolyratfun, POLYFUN, 0}
72 ,{"processbucketsize", DoProcessBucket,0, 0}
73 ,{"sum", DoModSum, MODSUM, 0}
74};
75
76int ModuleInstruction(int *moduletype, int *specialtype)
77{
78 UBYTE *t, *s, *u, c;
79 KEYWORD *key;
80 int addit = 0, error = 0, i, j;
81 DUMMYUSE(specialtype);
82 LoadInstruction(0);
83 AC.firstctypemessage = 0;
84 s = AP.preStart; SKIPBLANKS(s)
85 t = EndOfToken(s); c = *t; *t = 0;
86 AC.origin = FROMPOINTINSTRUCTION;
87 key = FindKeyWord(AP.preStart,ModuleWords,sizeof(ModuleWords)/sizeof(KEYWORD));
88 if ( key == 0 ) {
89 MesPrint("@Unrecognized module terminator: %s",s);
90 error = 1;
91 key = ModuleWords;
92 while ( StrCmp((UBYTE *)key->name,(UBYTE *)"end") ) key++;
93 }
94 *t = c;
95 *moduletype = key->type;
96 SKIPBLANKS(t);
97 while ( *t == '(' ) { /* There are options */
98 s = t+1; SKIPBRA3(t)
99 if ( *t == 0 ) {
100 MesPrint("@Improper options field in . instruction");
101 error = 1;
102 }
103 else {
104 *t = 0;
105 if ( CoModOption(s) ) error = 1;
106 *t++ = ')';
107 }
108 }
109 if ( *t == ':' ) { /* There is an 'advertisement' */
110 t++;
111 SKIPBLANKS(t)
112 s = t; i = 0;
113 while ( *t && *t != ';' ) {
114 if ( *t == '\\' ) t++;
115 t++; i++;
116 }
117 u = t;
118 while ( u > s && u[-1] == ' ' ) { u--; i--; }
119 if ( *u == '\\' ) { u++; i++; }
120 for ( j = COMMERCIALSIZE-1; j >= 0; j-- ) {
121 if ( i <= 0 ) break;
122 AC.Commercial[j] = *--u; i--;
123 if ( u > s && u[-1] == '\\' ) u--;
124 }
125 for ( ; j >= 0; j-- ) AC.Commercial[j] = ' ';
126 AC.Commercial[COMMERCIALSIZE] = 0;
127 addit += 2;
128 }
129 if ( addit && *t != ';' ) {
130 MesPrint("@Improper ending of . instruction");
131 error = -1;
132 }
133 return(error);
134}
135
136/*
137 #] ModuleInstruction :
138 #[ CoModuleOption :
139
140 ModuleOption, options;
141*/
142
143int CoModuleOption(UBYTE *s)
144{
145 UBYTE *t,*tt,c;
146 KEYWORD *option;
147 int error = 0, polyflag = 0;
148 AC.origin = FROMMODULEOPTION;
149 if ( *s ) do {
150 s = ToToken(s);
151 t = EndOfToken(s);
152 c = *t; *t = 0;
153 option = FindKeyWord(s,ModuleOptions,
154 sizeof(ModuleOptions)/sizeof(KEYWORD));
155 if ( option == 0 ) {
156 if ( polyflag ) {
157 *t = c; t++; s = SkipAName(t);
158 polyflag = 0;
159 continue;
160 }
161 else {
162 MesPrint("@Unrecognized module option: %s",s);
163 error = 1;
164 polyflag = 0;
165 *t = c;
166 }
167 }
168 else {
169 *t = c;
170 SKIPBLANKS(t)
171 if ( (option->func)(t) ) error = 1;
172 }
173 if ( error ) return(error);
174 if ( StrCmp((UBYTE *)(option->name),(UBYTE *)("polyfun")) == 0
175 || StrCmp((UBYTE *)(option->name),(UBYTE *)("polyratfun")) == 0 ) {
176 polyflag = 1;
177 t++;
178 t = SkipAName(t);
179 }
180 else polyflag = 0;
181 if ( option->flags > 0 ) return(error);
182 while ( *t ) {
183 if ( *t == ',' ) {
184 tt = t+1;
185 while ( *tt == ',' ) tt++;
186 if ( *tt != '$' ) break;
187 t = tt+1;
188 }
189 if ( *t == ')' ) break;
190 if ( *t == '(' ) SKIPBRA3(t)
191 else if ( *t == '{' ) SKIPBRA2(t)
192 else if ( *t == '[' ) SKIPBRA1(t)
193 t++;
194 }
195 s = t;
196 } while ( *s == ',' );
197 if ( *s ) {
198 MesPrint("@Unrecognized module option: %s",s);
199 error = 1;
200 }
201 return(error);
202}
203
204/*
205 #] CoModuleOption :
206 #[ CoModOption :
207
208 To be called from a .instruction.
209 Only recognizes polyfun. The newer ones should be via the
210 ModuleOption statement.
211*/
212
213int CoModOption(UBYTE *s)
214{
215 UBYTE *t,c;
216 int error = 0;
217 AC.origin = FROMPOINTINSTRUCTION;
218 if ( *s ) do {
219 s = ToToken(s);
220 t = EndOfToken(s);
221 c = *t; *t = 0;
222 if ( StrICmp(s,(UBYTE *)"polyfun") == 0 ) {
223 *t = c;
224 SKIPBLANKS(t)
225 if ( DoPolyfun(t) ) error = 1;
226 }
227 else if ( StrICmp(s,(UBYTE *)"polyratfun") == 0 ) {
228 *t = c;
229 SKIPBLANKS(t)
230 if ( DoPolyratfun(t) ) error = 1;
231 }
232 else {
233 MesPrint("@Unrecognized module option in .instruction: %s",s);
234 error = 1;
235 *t = c;
236 }
237 while ( *t ) {
238 if ( *t == ',' || *t == ')' ) break;
239 if ( *t == '(' ) SKIPBRA3(t)
240 else if ( *t == '{' ) SKIPBRA2(t)
241 else if ( *t == '[' ) SKIPBRA1(t)
242 t++;
243 }
244 s = t;
245 } while ( *s == ',' );
246 if ( *s ) {
247 MesPrint("@Unrecognized module option in .instruction: %s",s);
248 error = 1;
249 }
250 return(error);
251}
252
253/*
254 #] CoModOption :
255 #[ SetSpecialMode :
256*/
257
258void SetSpecialMode(int moduletype, int specialtype)
259{
260 DUMMYUSE(moduletype); DUMMYUSE(specialtype);
261}
262
263/*
264 #] SetSpecialMode :
265 #[ MakeGlobal :
266
267void MakeGlobal()
268{
269}
270
271 #] MakeGlobal :
272 #[ ExecModule :
273*/
274
275int ExecModule(int moduletype)
276{
277/*
278 Here we check module options and other things that should
279 be done at the start of a module.
280*/
281#ifdef WITHFLOAT
282 if ( ( AC.tMaxWeight != 0 && AC.tMaxWeight != AC.MaxWeight )
283 || ( AC.tDefaultPrecision != 0 && AC.tDefaultPrecision != AC.DefaultPrecision ) ) {
284 AC.DefaultPrecision = AC.tDefaultPrecision;
285 AC.tDefaultPrecision = 0;
286 AC.MaxWeight = AC.tMaxWeight;
287 AC.tMaxWeight = 0;
288 ClearMZVTables();
289 SetupMZVTables();
290 }
291#endif
292 return(DoExecute(moduletype,0));
293}
294
295/*
296 #] ExecModule :
297 #[ ExecStore :
298*/
299
300int ExecStore(void)
301{
302 return(0);
303}
304
305/*
306 #] ExecStore :
307 #[ FullCleanUp :
308
309 Remark 27-oct-2005 by JV
310 This routine (and CleanUp in startup.c) may still need some work:
311 What to do with preprocessor variables
312 What to do with files we write to
313*/
314
315void FullCleanUp(void)
316{
317 int j;
318
319 while ( AC.CurrentStream->previous >= 0 )
320 AC.CurrentStream = CloseStream(AC.CurrentStream);
321 AP.PreSwitchLevel = AP.PreIfLevel = 0;
322
323 for ( j = NumProcedures-1; j >= 0; j-- ) {
324 if ( Procedures[j].name ) M_free(Procedures[j].name,"name of procedure");
325 if ( Procedures[j].p.buffer ) M_free(Procedures[j].p.buffer,"buffer of procedure");
326 }
327 NumProcedures = 0;
328
329 while ( NumPre > AP.gNumPre ) {
330 NumPre--;
331 M_free(PreVar[NumPre].name,"PreVar[NumPre].name");
332 PreVar[NumPre].name = PreVar[NumPre].value = 0;
333 }
334
335 AC.DidClean = 0;
336 for ( j = 0; j < NumExpressions; j++ ) {
337 AC.exprnames->namenode[Expressions[j].node].type = CDELETE;
338 AC.DidClean = 1;
339 }
340
341 CompactifyTree(AC.exprnames,EXPRNAMES);
342
343 for ( j = AO.NumDictionaries-1; j >= 0; j-- ) {
344 RemoveDictionary(AO.Dictionaries[j]);
345 M_free(AO.Dictionaries[j],"Dictionary");
346 }
347 AO.NumDictionaries = AO.gNumDictionaries = 0;
348 M_free(AO.Dictionaries,"Dictionaries");
349 AO.Dictionaries = 0;
350 AO.SizeDictionaries = 0;
351 AP.OpenDictionary = 0;
352 AO.CurrentDictionary = 0;
353
354 AP.ComChar = AP.cComChar;
355 if ( AP.procedureExtension ) M_free(AP.procedureExtension,"procedureextension");
356 AP.procedureExtension = strDup1(AP.cprocedureExtension,"procedureextension");
357
358 AC.StatsFlag = AM.gStatsFlag = AM.ggStatsFlag;
359 AC.extrasymbols = AM.gextrasymbols = AM.ggextrasymbols;
360 AC.extrasym[0] = AM.gextrasym[0] = AM.ggextrasym[0] = 'Z';
361 AC.extrasym[1] = AM.gextrasym[1] = AM.ggextrasym[1] = 0;
362 AO.NoSpacesInNumbers = AM.gNoSpacesInNumbers = AM.ggNoSpacesInNumbers;
363 AO.IndentSpace = AM.gIndentSpace = AM.ggIndentSpace;
364 AC.ThreadStats = AM.gThreadStats = AM.ggThreadStats;
365 AC.OldFactArgFlag = AM.gOldFactArgFlag = AM.ggOldFactArgFlag;
366 AC.FinalStats = AM.gFinalStats = AM.ggFinalStats;
367 AC.OldGCDflag = AM.gOldGCDflag = AM.ggOldGCDflag;
368 AC.ThreadsFlag = AM.gThreadsFlag = AM.ggThreadsFlag;
369 if ( AC.ThreadsFlag && AM.totalnumberofthreads > 1 ) AS.MultiThreaded = 1;
370 AC.ThreadBucketSize = AM.gThreadBucketSize = AM.ggThreadBucketSize;
371 AC.ThreadBalancing = AM.gThreadBalancing = AM.ggThreadBalancing;
372 AC.ThreadSortFileSynch = AM.gThreadSortFileSynch = AM.ggThreadSortFileSynch;
373 AC.ShortStatsMax = AM.gShortStatsMax = AM.ggShortStatsMax;
374 AC.SizeCommuteInSet = AM.gSizeCommuteInSet = 0;
375#ifdef WITHFLOAT
376 AC.MaxWeight = AM.gMaxWeight = AM.ggMaxWeight;
377 AC.DefaultPrecision = AM.gDefaultPrecision = AM.ggDefaultPrecision;
378#endif
379
380 NumExpressions = 0;
381 if ( DeleteStore(0) < 0 ) {
382/* INTERNAL_ERROR_EXCL_START */
383 MesPrint("!>Cannot restart the storage file");
384 Terminate(-1);
385/* INTERNAL_ERROR_EXCL_STOP */
386 }
387 RemoveDollars();
388 CleanUp(1);
389 ResetVariables(2);
390 IniVars();
391}
392
393/*
394 #] FullCleanUp :
395 #[ DoPolyfun :
396*/
397
398int DoPolyfun(UBYTE *s)
399{
400 GETIDENTITY
401 UBYTE *t, c;
402 WORD funnum, eqsign = 0;
403 if ( AC.origin == FROMPOINTINSTRUCTION ) {
404 if ( *s == 0 || *s == ',' || *s == ')' ) {
405 AR.PolyFun = 0; AR.PolyFunType = 0;
406 return(0);
407 }
408 if ( *s != '=' ) {
409 MesPrint("@Proper use in point instructions is: PolyFun[=functionname]");
410 return(-1);
411 }
412 eqsign = 1;
413 }
414 else {
415 if ( *s == 0 ) {
416 AR.PolyFun = 0; AR.PolyFunType = 0;
417 return(0);
418 }
419 if ( *s != '=' && *s != ',' ) {
420 MesPrint("@Proper use is: PolyFun[{ ,=}functionname]");
421 return(-1);
422 }
423 if ( *s == '=' ) eqsign = 1;
424 }
425 s++;
426 SKIPBLANKS(s)
427 t = EndOfToken(s);
428 c = *t; *t = 0;
429
430 if ( GetName(AC.varnames,s,&funnum,WITHAUTO) != CFUNCTION ) {
431 if ( AC.origin != FROMPOINTINSTRUCTION && eqsign == 0 ) {
432 AR.PolyFun = 0; AR.PolyFunType = 0;
433 return(0);
434 }
435 MesPrint("@ %s is not a properly declared function",s);
436 *t = c;
437 return(-1);
438 }
439 if ( functions[funnum].spec > 0 || functions[funnum].commute != 0 ) {
440 MesPrint("@The PolyFun must be a regular commuting function!");
441 *t = c;
442 return(-1);
443 }
444 AR.PolyFun = funnum+FUNCTION; AR.PolyFunType = 1;
445 *t = c;
446 SKIPBLANKS(t)
447 if ( *t && *t != ',' && *t != ')' ) {
448 t++; c = *t; *t = 0;
449 MesPrint("@Improper ending of end-of-module instruction: %s",s);
450 *t = c;
451 return(-1);
452 }
453 return(0);
454}
455
456/*
457 #] DoPolyfun :
458 #[ DoPolyratfun :
459*/
460
461int DoPolyratfun(UBYTE *s)
462{
463 GETIDENTITY
464 UBYTE *t, c;
465 WORD funnum;
466 if ( AC.origin == FROMPOINTINSTRUCTION ) {
467 if ( *s == 0 || *s == ',' || *s == ')' ) {
468 AR.PolyFun = 0; AR.PolyFunType = 0; AR.PolyFunInv = 0; AR.PolyFunExp = 0;
469 return(0);
470 }
471 if ( *s != '=' ) {
472 MesPrint("@Proper use in point instructions is: PolyRatFun[=functionname[+functionname]]");
473 return(-1);
474 }
475 }
476 else {
477 if ( *s == 0 ) {
478 AR.PolyFun = 0; AR.PolyFunType = 0; AR.PolyFunInv = 0; AR.PolyFunExp = 0;
479 return(0);
480 }
481 if ( *s != '=' && *s != ',' ) {
482 MesPrint("@Proper use is: PolyRatFun[{ ,=}functionname[+functionname]]");
483 return(-1);
484 }
485 }
486 s++;
487 SKIPBLANKS(s)
488 t = EndOfToken(s);
489 c = *t; *t = 0;
490
491 if ( GetName(AC.varnames,s,&funnum,WITHAUTO) != CFUNCTION ) {
492Error1:;
493 MesPrint("@ %s is not a properly declared function",s);
494 *t = c;
495 return(-1);
496 }
497 if ( functions[funnum].spec > 0 || functions[funnum].commute != 0 ) {
498Error2:;
499 MesPrint("@The PolyRatFun must be a regular commuting function!");
500 *t = c;
501 return(-1);
502 }
503 AR.PolyFun = funnum+FUNCTION; AR.PolyFunType = 2;
504 AR.PolyFunInv = 0;
505 AR.PolyFunExp = 0;
506 AC.PolyRatFunChanged = 1;
507 *t = c;
508 if ( *t == '+' ) {
509 t++; s = t;
510 t = EndOfToken(s);
511 c = *t; *t = 0;
512 if ( GetName(AC.varnames,s,&funnum,WITHAUTO) != CFUNCTION ) goto Error1;
513 if ( functions[funnum].spec > 0 || functions[funnum].commute != 0 ) goto Error2;
514 AR.PolyFunInv = funnum+FUNCTION;
515 *t = c;
516 }
517 SKIPBLANKS(t)
518 if ( *t && *t != ',' && *t != ')' ) {
519 t++; c = *t; *t = 0;
520 MesPrint("@Improper ending of end-of-module instruction: %s",s);
521 *t = c;
522 return(-1);
523 }
524 return(0);
525}
526
527/*
528 #] DoPolyratfun :
529 #[ DoNoParallel :
530*/
531
532int DoNoParallel(UBYTE *s)
533{
534 if ( *s == 0 || *s == ',' || *s == ')' ) {
535 AC.mparallelflag |= NOPARALLEL_USER;
536 return(0);
537 }
538 MesPrint("@NoParallel should not have extra parameters");
539 return(-1);
540}
541
542/*
543 #] DoNoParallel :
544 #[ DoParallel :
545*/
546
547int DoParallel(UBYTE *s)
548{
549 if ( *s == 0 || *s == ',' || *s == ')' ) {
550 AC.mparallelflag &= ~NOPARALLEL_USER;
551 return(0);
552 }
553 MesPrint("@Parallel should not have extra parameters");
554 return(-1);
555}
556
557/*
558 #] DoParallel :
559 #[ DoModSum :
560*/
561
562int DoModSum(UBYTE *s)
563{
564 while ( *s == ',' ) s++;
565 if ( *s != '$' ) {
566 MesPrint("@Module Sum should mention which $-variables");
567 return(-1);
568 }
569 s = DoModDollar(s,MODSUM);
570 if ( s && *s != 0 && *s != ')' ) {
571 MesPrint("@Irregular end of Sum option of Module statement");
572 return(-1);
573 }
574 return(0);
575}
576
577/*
578 #] DoModSum :
579 #[ DoModMax :
580*/
581
582int DoModMax(UBYTE *s)
583{
584 while ( *s == ',' ) s++;
585 if ( *s != '$' ) {
586 MesPrint("@Module Maximum should mention which $-variables");
587 return(-1);
588 }
589 s = DoModDollar(s,MODMAX);
590 if ( s && *s != 0 ) {
591 MesPrint("@Irregular end of Maximum option of Module statement");
592 return(-1);
593 }
594 return(0);
595}
596
597/*
598 #] DoModMax :
599 #[ DoModMin :
600*/
601
602int DoModMin(UBYTE *s)
603{
604 while ( *s == ',' ) s++;
605 if ( *s != '$' ) {
606 MesPrint("@Module Minimum should mention which $-variables");
607 return(-1);
608 }
609 s = DoModDollar(s,MODMIN);
610 if ( s && *s != 0 ) {
611 MesPrint("@Irregular end of Minimum option of Module statement");
612 return(-1);
613 }
614 return(0);
615}
616
617/*
618 #] DoModMin :
619 #[ DoModLocal :
620*/
621
622int DoModLocal(UBYTE *s)
623{
624 while ( *s == ',' ) s++;
625 if ( *s != '$' ) {
626 MesPrint("@ModuleOption Local should mention which $-variables");
627 return(-1);
628 }
629 s = DoModDollar(s,MODLOCAL);
630 if ( s && *s != 0 ) {
631 MesPrint("@Irregular end of Local option of ModuleOption statement");
632 return(-1);
633 }
634 return(0);
635}
636
637/*
638 #] DoModLocal :
639 #[ DoProcessBucket :
640*/
641
642int DoProcessBucket(UBYTE *s)
643{
644 LONG x;
645 while ( *s == ',' || *s == '=' ) s++;
646 ParseNumber(x,s)
647 if ( *s && *s != ' ' && *s != '\t' ) {
648 MesPrint("&Numerical value expected for ProcessBucketSize");
649 return(1);
650 }
651 AC.mProcessBucketSize = x;
652 return(0);
653}
654
655/*
656 #] DoProcessBucket :
657 #[ DoModDollar :
658*/
659
660UBYTE * DoModDollar(UBYTE *s, int type)
661{
662 UBYTE *name, c;
663 WORD number;
664 MODOPTDOLLAR *md;
665 int nummodopt;
666 while ( *s == '$' ) {
667/*
668 Read the name of the dollar
669 Mark the type
670*/
671 s++;
672 name = s;
673 if ( FG.cTable[*s] == 0 ) {
674 while ( FG.cTable[*s] == 0 || FG.cTable[*s] == 1 ) s++;
675 c = *s; *s = 0;
676 number = GetDollar(name);
677 if ( number < 0 ) {
678 UBYTE *s1;
679 number = AddDollar(s,0,0,0);
680 s1 = strDup1((UBYTE *)"Undefined $-variable in module option; option ignored: $","Undefined $-variable in ModuleOption");
681 s1 = AddToString(s1,name,0);
682 Warning((char *)s1);
683 M_free(s1,"Undefined $-variable in ModuleOption");
684 }
685 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
686 if ( number == ModOptdollars[nummodopt].number && type != ModOptdollars[nummodopt].type ) {
687 UBYTE *s1;
688 s1 = strDup1((UBYTE *)"Conflicting module options for $-variable; later option ignored: $","Conflicting $-variable in ModuleOption");
689 s1 = AddToString(s1,name,0);
690 Warning((char *)s1);
691 M_free(s1,"Conflicting $-variable in ModuleOption");
692 break;
693 }
694 }
695 md = (MODOPTDOLLAR *)FromList(&AC.ModOptDolList);
696 md->number = number;
697 md->type = type;
698#ifdef WITHPTHREADS
699 if ( DollarLocalCopy(type) ) {
700 int j, i;
701 DOLLARS dglobal, dlocal;
702 md->dstruct = (DOLLARS)Malloc1(
703 sizeof(struct DoLlArS)*AM.totalnumberofthreads,"Local DOLLARS");
704/*
705 Now copy the global dollar into the local copies.
706 This can be nontrivial if the value needs an allocation.
707 We don't really need the locks.
708*/
709 dglobal = Dollars + number;
710 for ( j = 0; j < AM.totalnumberofthreads; j++ ) {
711 dlocal = md->dstruct + j;
712 dlocal->index = dglobal->index;
713 dlocal->node = dglobal->node;
714 dlocal->type = dglobal->type;
715 dlocal->name = dglobal->name;
716 dlocal->size = dglobal->size;
717 dlocal->where = dglobal->where;
718 if ( dlocal->size > 0 ) {
719 dlocal->where = (WORD *)Malloc1((dlocal->size+1)*sizeof(WORD),"Local dollar value");
720 for ( i = 0; i < dlocal->size; i++ )
721 dlocal->where[i] = dglobal->where[i];
722 dlocal->where[dlocal->size] = 0;
723 }
724 INIRECLOCK(dlocal->pthreadslock);
725 dlocal->nfactors = dglobal->nfactors;
726 if ( dglobal->nfactors > 1 ) {
727 int nsize;
728 WORD *t, *m;
729 dlocal->factors = (FACDOLLAR *)Malloc1(dglobal->nfactors*sizeof(FACDOLLAR),"Dollar factors");
730 for ( i = 0; i < dglobal->nfactors; i++ ) {
731 nsize = dglobal->factors[i].size;
732 dlocal->factors[i].type = DOLUNDEFINED;
733 dlocal->factors[i].value = dglobal->factors[i].value;
734 if ( ( dlocal->factors[i].size = nsize ) > 0 ) {
735 dlocal->factors[i].where = t = (WORD *)Malloc1(sizeof(WORD)*(nsize+1),"DollarCopyFactor");
736 m = dglobal->factors[i].where;
737 NCOPY(t,m,nsize);
738 *t = 0;
739 }
740 else {
741 dlocal->factors[i].where = 0;
742 }
743 }
744 }
745 else { dlocal->factors = 0; }
746 }
747 }
748 else {
749 md->dstruct = 0;
750 }
751#endif
752 *s = c;
753 }
754 else {
755 MesPrint("&Illegal name for $-variable in module option");
756 while ( *s != ',' && *s != 0 && *s != ')' ) s++;
757 }
758 while ( *s == ',' ) s++;
759 }
760 return(s);
761}
762
763/*
764 #] DoModDollar :
765 #[ DoinParallel :
766
767 The idea is that we should have the commands
768 ModuleOption,InParallel;
769 ModuleOption,InParallel,name1,name2,...,namen;
770 ModuleOption,NotInParallel,name1,name2,...,namen;
771 The advantage over the InParallel statement is that this statement
772 comes after the definition of the expressions.
773*/
774
775int DoinParallel(UBYTE *s)
776{
777 return(DoInParallel(s,1));
778}
779
780/*
781 #] DoinParallel :
782 #[ DonotinParallel :
783*/
784
785int DonotinParallel(UBYTE *s)
786{
787 return(DoInParallel(s,0));
788}
789
790/*
791 #] DonotinParallel :
792 #] Modules :
793 #[ External :
794 #[ DoExecStatement :
795*/
796
797int DoExecStatement(void)
798{
799#ifdef WITHSYSTEM
800 FLUSHCONSOLE;
801 if ( system((char *)(AP.preStart)) ) return(-1);
802 return(0);
803#else
804 Error0("External programs not implemented on this computer/system");
805 return(-1);
806#endif
807}
808
809/*
810 #] DoExecStatement :
811 #[ DoPipeStatement :
812*/
813
814int DoPipeStatement(void)
815{
816#ifdef WITHPIPE
817 FLUSHCONSOLE;
818 if ( OpenStream(AP.preStart,PIPESTREAM,0,PRENOACTION) == 0 ) return(-1);
819 return(0);
820#else
821 Error0("Pipes not implemented on this computer/system");
822 return(-1);
823#endif
824}
825
826/*
827 #] DoPipeStatement :
828 #] External :
829*/
UBYTE * SkipAName(UBYTE *s)
Definition compiler.c:443
UBYTE * ToToken(UBYTE *)
Definition tools.c:1957
UBYTE * EndOfToken(UBYTE *)
Definition tools.c:1934