FORM v5.0.0-35-g6318119
pre.c
Go to the documentation of this file.
1
5/* #[ License : */
6/*
7 * Copyright (C) 1984-2026 J.A.M. Vermaseren
8 * When using this file you are requested to refer to the publication
9 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
10 * This is considered a matter of courtesy as the development was paid
11 * for by FOM the Dutch physics granting agency and we would like to
12 * be able to track its scientific use to convince FOM of its value
13 * for the community.
14 *
15 * This file is part of FORM.
16 *
17 * FORM is free software: you can redistribute it and/or modify it under the
18 * terms of the GNU General Public License as published by the Free Software
19 * Foundation, either version 3 of the License, or (at your option) any later
20 * version.
21 *
22 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
23 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
24 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
25 * details.
26 *
27 * You should have received a copy of the GNU General Public License along
28 * with FORM. If not, see <http://www.gnu.org/licenses/>.
29 */
30/* #] License : */
31/*
32 #[ Includes :
33*/
34#include "form3.h"
35#include "comtool.h"
36#ifdef WITHFLOAT
37#include "math.h"
38#endif
39
40static UBYTE pushbackchar = 0;
41static int oldmode = 0;
42static int stopdelay = 0;
43static STREAM *oldstream = 0;
44static UBYTE underscore[2] = {'_',0};
45static PREVAR *ThePreVar = 0;
46
47static int ExitDoLoops(int, const char *);
48
49static KEYWORD precommands[] = {
50 {"add" , DoPreAdd , 0, 0}
51 ,{"addseparator" , DoPreAddSeparator,0,0}
52 ,{"append" , DoPreAppend , 0, 0}
53 ,{"appendpath" , DoPreAppendPath, 0, 0}
54 ,{"assign" , DoPreAssign , 0, 0}
55 ,{"break" , DoPreBreak , 0, 0}
56 ,{"breakdo" , DoBreakDo , 0, 0}
57 ,{"call" , DoCall , 0, 0}
58 ,{"case" , DoPreCase , 0, 0}
59 ,{"clearflag" , DoClearUserFlag, 0, 0}
60 ,{"clearoptimize", DoClearOptimize, 0, 0}
61 ,{"close" , DoPreClose , 0, 0}
62 ,{"closedictionary", DoPreCloseDictionary,0,0}
63 ,{"commentchar" , DoCommentChar , 0, 0}
64 ,{"continuedo" , DoContinueDo , 0, 0}
65 ,{"create" , DoPreCreate , 0, 0}
66 ,{"debug" , DoDebug , 0, 0}
67 ,{"default" , DoPreDefault , 0, 0}
68 ,{"define" , DoDefine , 0, 0}
69 ,{"do" , DoDo , 0, 0}
70 ,{"else" , DoElse , 0, 0}
71 ,{"elseif" , DoElseif , 0, 0}
72 ,{"enddo" , DoEnddo , 0, 0}
73#ifdef WITHFLOAT
74 ,{"endfloat" , DoEndFloat , 0, 0}
75#endif
76 ,{"endif" , DoEndif , 0, 0}
77 ,{"endinside" , DoEndInside , 0, 0}
78 ,{"endnamespace" , DoEndNamespace , 0, 0}
79 ,{"endprocedure" , DoEndprocedure , 0, 0}
80 ,{"endswitch" , DoPreEndSwitch , 0, 0}
81 ,{"exchange" , DoPreExchange , 0, 0}
82 ,{"external" , DoExternal , 0, 0}
83 ,{"factdollar" , DoFactDollar , 0, 0}
84 ,{"fromexternal" , DoFromExternal , 0, 0}
85 ,{"if" , DoIf , 0, 0}
86 ,{"ifdef" , DoIfydef , 0, 0}
87 ,{"ifndef" , DoIfndef , 0, 0}
88 ,{"include" , DoInclude , 0, 0}
89 ,{"inside" , DoInside , 0, 0}
90 ,{"message" , DoMessage , 0, 0}
91 ,{"namespace" , DoNamespace , 0, 0}
92 ,{"opendictionary", DoPreOpenDictionary,0,0}
93 ,{"optimize" , DoOptimize , 0, 0}
94 ,{"pipe" , DoPipe , 0, 0}
95 ,{"preout" , DoPreOut , 0, 0}
96 ,{"prependpath" , DoPrePrependPath,0, 0}
97 ,{"printtimes" , DoPrePrintTimes, 0, 0}
98 ,{"procedure" , DoProcedure , 0, 0}
99 ,{"procedureextension" , DoPrcExtension , 0, 0}
100 ,{"prompt" , DoPrompt , 0, 0}
101 ,{"redefine" , DoRedefine , 0, 0}
102 ,{"remove" , DoPreRemove , 0, 0}
103 ,{"reset" , DoPreReset , 0, 0}
104 ,{"reverseinclude" , DoReverseInclude , 0, 0}
105 ,{"rmexternal" , DoRmExternal , 0, 0}
106 ,{"rmseparator" , DoPreRmSeparator,0, 0}
107 ,{"setexternal" , DoSetExternal , 0, 0}
108 ,{"setexternalattr" , DoSetExternalAttr , 0, 0}
109 ,{"setflag" , DoSetUserFlag , 0, 0}
110 ,{"setrandom" , DoSetRandom , 0, 0}
111 ,{"show" , DoPreShow , 0, 0}
112 ,{"skipextrasymbols" , DoSkipExtraSymbols , 0, 0}
113 ,{"sortreallocate", DoPreSortReallocate , 0, 0}
114#ifdef WITHFLOAT
115 ,{"startfloat" , DoStartFloat , 0, 0}
116#endif
117 ,{"switch" , DoPreSwitch , 0, 0}
118 ,{"system" , DoSystem , 0, 0}
119 ,{"terminate" , DoTerminate , 0, 0}
120 ,{"timeoutafter" , DoTimeOutAfter , 0, 0}
121 ,{"toexternal" , DoToExternal , 0, 0}
122 ,{"undefine" , DoUndefine , 0, 0}
123 ,{"use" , DoUse , 0, 0}
124 ,{"usedictionary", DoPreUseDictionary,0,0}
125 ,{"write" , DoPreWrite , 0, 0}
126};
127
128/*
129 #] Includes :
130 # [ PreProcessor :
131 #[ GetInput :
132
133 Gets one input character. If we reach the end of a stream
134 we pop to the previous stream and try again.
135 If there are no more streams we let this be known.
136*/
137
138UBYTE GetInput(void)
139{
140 UBYTE c;
141 while ( AC.CurrentStream ) {
142 c = GetFromStream(AC.CurrentStream);
143 if ( c != ENDOFSTREAM ) {
144#ifdef WITHMPI
145 if ( PF.me == MASTER
146 && AC.NoShowInput <= 0
147 && AC.CurrentStream->type != PREVARSTREAM )
148#else
149 if ( AC.NoShowInput <= 0 && AC.CurrentStream->type != PREVARSTREAM )
150#endif
151 CharOut(c);
152 return(c);
153 }
154 AC.CurrentStream = CloseStream(AC.CurrentStream);
155 if ( stopdelay && AC.CurrentStream == oldstream ) {
156 stopdelay = 0; AP.AllowDelay = 1;
157 }
158 }
159 return(ENDOFINPUT);
160}
161
162/*
163 #] GetInput :
164 #[ ClearPushback :
165*/
166
167void ClearPushback(void)
168{
169 pushbackchar = 0;
170}
171
172/*
173 #] ClearPushback :
174 #[ GetChar :
175
176 Reads one character. If it encounters a quote it immediately
177 takes the whole preprocessor variable and opens a stream
178 for it and starts reading the stream.
179 Note that we have to take special precautions for escaped quotes.
180 That is why we remember the previous character. We allow the
181 (dubious?) construction of ending a stream with a backslash and
182 then using it to escape an object in the parent stream.
183*/
184
185UBYTE GetChar(int level)
186{
187 UBYTE namebuf[MAXPRENAMESIZE+2], c, *s, *t;
188 static UBYTE lastchar, charinbuf = 0;
189 int i, j, raiselow, olddelay;
190 STREAM *stream;
191 if ( level > 0 ) {
192 lastchar = '`';
193 goto higherlevel;
194 }
195 if ( pushbackchar ) { c = pushbackchar; pushbackchar = 0; return(c); }
196 if ( charinbuf ) { c = charinbuf; charinbuf = 0; return(c); }
197 c = GetInput();
198 for(;;) {
199 if ( c == '\\' ) {
200 charinbuf = GetInput();
201 if ( charinbuf != LINEFEED ) {
202 pushbackchar = charinbuf;
203 charinbuf = 0;
204 break;
205 }
206 charinbuf = 0; /* Escaped linefeed -> skip leading blanks */
207 while ( ( c = GetInput() ) == ' ' || c == '\t' ) {}
208 }
209 else if ( c == '\'' || c == '`' ) {
210 if ( AP.DelayPrevar == 1 && c == '\'' ) {
211 AP.DelayPrevar = 0;
212 break;
213 }
214 lastchar = c;
215higherlevel:
216 c = GetInput();
217 if ( c == '!' && lastchar == '`' ) {
218 if ( stopdelay == 0 ) oldstream = AC.CurrentStream;
219 AP.AllowDelay = 0;
220 stopdelay = 1;
221 c = GetInput();
222 }
223 if ( c == '~' && lastchar == '`' ) {
224 if ( AP.AllowDelay ) {
225 pushbackchar = c;
226 c = lastchar;
227 AP.DelayPrevar = 1;
228 break;
229 }
230 }
231 else {
232 pushbackchar = c;
233 }
234 olddelay = AP.DelayPrevar;
235 AP.DelayPrevar = 0;
236 i = 0; lastchar = 0;
237 for (;;) {
238 if ( pushbackchar ) { c = pushbackchar; pushbackchar = 0; }
239 else { c = GetInput(); }
240 if ( c == ENDOFINPUT || ( ( c == '\'' || c == LINEFEED )
241 && lastchar != '\\' ) ) {
242 break;
243 }
244 if ( c == '{' ) { /* Try the preprocessor calculator */
245 if ( PreCalc() == 0 ) Terminate(-1);
246 c = GetInput(); /* This is either a { or a number */
247 if ( c == '{' ) {
248 MesPrint("@Illegal set inside preprocessor variable name");
249 Terminate(-1);
250 }
251 }
252 if ( c == '`' && lastchar != '\\' ) {
253 c = GetChar(1);
254 if ( c == ENDOFINPUT || ( ( c == '\'' || c == LINEFEED )
255 && lastchar != '\\' ) ) {
256 break;
257 }
258 }
259 if ( lastchar == '\\' ) { i--; lastchar = 0; }
260 else lastchar = c;
261 namebuf[i++] = c;
262 if ( i > MAXPRENAMESIZE ) {
263 namebuf[i] = 0;
264 Error1("Preprocessor variable name too long: ",namebuf);
265 }
266 }
267 namebuf[i++] = 0;
268 if ( c != '\'' ) {
269 Error1("Unmatched quotes for preprocessor variable",namebuf);
270 }
271 AP.DelayPrevar = olddelay;
272 if ( namebuf[0] == '$' ) {
273 raiselow = PRENOACTION;
274 if ( AP.PreproFlag && *AP.preStart) {
275 s = EndOfToken(AP.preStart);
276 c = *s; *s = 0;
277 if ( ( StrICmp(AP.preStart,(UBYTE *)"ifdef") == 0
278 || StrICmp(AP.preStart,(UBYTE *)"ifndef") == 0 )
279 && GetDollar(namebuf+1) < 0 ) {
280 *s = c; c = ' ';
281 break;
282 }
283 *s = c;
284 }
285 else {
286 s = EndOfToken(namebuf+1);
287 if ( *s == '[' ) { while ( *s ) s++; }
288 }
289 if ( *s == '-' && s[1] == '-' && s[2] == 0 )
290 raiselow = PRELOWERAFTER;
291 else if ( *s == '+' && s[1] == '+' && s[2] == 0 )
292 raiselow = PRERAISEAFTER;
293 c = *s; *s = 0;
294 if ( OpenStream(namebuf+1,DOLLARSTREAM,0,raiselow) == 0 ) {
295 *s = c;
296 MesPrint("@Undefined variable %s used as preprocessor variable",
297 namebuf);
298 Terminate(-1);
299 }
300 *s = c;
301 }
302 else {
303 raiselow = PRENOACTION;
304 if ( AP.PreproFlag && *AP.preStart) {
305 s = EndOfToken(AP.preStart);
306 c = *s; *s = 0;
307 if ( ( StrICmp(AP.preStart,(UBYTE *)"ifdef") == 0
308 || StrICmp(AP.preStart,(UBYTE *)"ifndef") == 0 )
309 && GetPreVar(namebuf,WITHOUTERROR) == 0 ) {
310 *s = c; c = ' ';
311 break;
312 }
313 *s = c;
314 }
315 s = EndOfToken(namebuf);
316 if ( *s == '_' ) s++;
317 if ( *s == '-' && s[1] == '-' && s[2] == 0 )
318 raiselow = PRELOWERAFTER;
319 else if ( *s == '+' && s[1] == '+' && s[2] == 0 )
320 raiselow = PRERAISEAFTER;
321 else if ( *s == '(' && namebuf[i-2] == ')' ) {
322/*
323 Now count the arguments and separate them by zeroes
324 Check on the ?var construction and if present, reset
325 some comma's.
326 Make the assignments of the variables
327 Run the macro.
328 Undefine the variables
329*/
330 int nargs = 1;
331 PREVAR *p;
332 size_t p_offset;
333 *s++ = 0; namebuf[i-2] = 0;
334 if ( StrICmp(namebuf,(UBYTE *)"random_") == 0 ) {
335 UBYTE *ranvalue;
336 ranvalue = PreRandom(s);
337 PutPreVar(namebuf,ranvalue,0,1);
338 M_free(ranvalue,"PreRandom");
339 goto dostream;
340 }
341 else if ( StrICmp(namebuf,(UBYTE *)"tolower_") == 0 ) {
342 UBYTE *ss = s;
343 while ( *ss ) { *ss = (UBYTE)(tolower(*ss)); ss++; }
344 PutPreVar(namebuf,s,0,1);
345 goto dostream;
346 }
347 else if ( StrICmp(namebuf,(UBYTE *)"toupper_") == 0 ) {
348 UBYTE *ss = s;
349 while ( *ss ) { *ss = (UBYTE)(toupper(*ss)); ss++; }
350 PutPreVar(namebuf,s,0,1);
351 goto dostream;
352 }
353 else if ( StrICmp(namebuf,(UBYTE *)"takeleft_") == 0 ) {
354 UBYTE *ss = s;
355 int x = 0, nsize;
356 while ( *ss != ',' && *ss ) ss++;
357 nsize = ss-s;
358 if ( *ss ) {
359 *ss++ = 0;
360 while ( FG.cTable[*ss] == 1 ) x = 10*x + (*ss++ - '0');
361 if ( x > nsize ) x = nsize;
362 }
363 else x = 0;
364 PutPreVar(namebuf,s+x,0,1);
365 goto dostream;
366 }
367 else if ( StrICmp(namebuf,(UBYTE *)"takeright_") == 0 ) {
368 UBYTE *ss = s;
369 int x = 0, nsize;
370 while ( *ss != ',' && *ss ) ss++;
371 nsize = ss-s;
372 if ( *ss ) {
373 *ss++ = 0;
374 while ( FG.cTable[*ss] == 1 ) x = 10*x + (*ss++ - '0');
375 if ( x > nsize ) x = nsize;
376 }
377 else x = 0;
378 x = nsize - x;
379 s[x] = 0;
380 PutPreVar(namebuf,s,0,1);
381 goto dostream;
382 }
383 else if ( StrICmp(namebuf,(UBYTE *)"keepleft_") == 0 ) {
384 UBYTE *ss = s;
385 int x = 0, nsize;
386 while ( *ss != ',' && *ss ) ss++;
387 nsize = ss-s;
388 if ( *ss ) {
389 *ss++ = 0;
390 while ( FG.cTable[*ss] == 1 ) x = 10*x + (*ss++ - '0');
391 if ( x > nsize ) x = nsize;
392 }
393 else x = nsize;
394 s[x] = 0;
395 PutPreVar(namebuf,s,0,1);
396 goto dostream;
397 }
398 else if ( StrICmp(namebuf,(UBYTE *)"keepright_") == 0 ) {
399 UBYTE *ss = s;
400 int x = 0, nsize;
401 while ( *ss != ',' && *ss ) ss++;
402 nsize = ss-s;
403 if ( *ss ) {
404 *ss++ = 0;
405 while ( FG.cTable[*ss] == 1 ) x = 10*x + (*ss++ - '0');
406 if ( x > nsize ) x = nsize;
407 }
408 else x = nsize;
409 x = nsize-x;
410 PutPreVar(namebuf,s+x,0,1);
411 goto dostream;
412 }
413 while ( *s ) {
414 if ( *s == '\\' ) s++;
415 if ( *s == ',' ) { *s = 0; nargs++; }
416 s++;
417 }
418 GetPreVar(namebuf,WITHERROR);
419 p = ThePreVar;
420 if ( p == 0 ) {
421 MesPrint("@Illegal use of arguments in preprocessor variable %s",namebuf);
422 Terminate(-1);
423 }
424 if ( p->nargs <= 0 || ( p->wildarg == 0 && nargs != p->nargs )
425 || ( p->wildarg > 0 && nargs < p->nargs-1 ) ) {
426 MesPrint("@Arguments of macro %s do not match",namebuf);
427 Terminate(-1);
428 }
429 if ( p->wildarg > 0 ) {
430/*
431 Change some zeroes into commas
432*/
433 s = namebuf;
434 for ( j = 0; j < p->wildarg; j++ ) {
435 while ( *s ) s++;
436 s++;
437 }
438 for ( j = 0; j < nargs-p->nargs; j++ ) {
439 while ( *s ) s++;
440 *s++ = ',';
441 }
442 }
443/*
444 Now we can make the assignments
445*/
446 s = namebuf;
447 while ( *s ) s++;
448 s++;
449 t = p->argnames;
450 p_offset = p - PreVar;
451 for ( j = 0; j < p->nargs; j++ ) {
452 if ( ( nargs == p->nargs-1 ) && ( *t == '?' ) ) {
453 PutPreVar(t,0,0,0);
454 }
455 else {
456 PutPreVar(t,s,0,0);
457 while ( *s ) s++;
458 s++;
459 }
460 p = PreVar + p_offset;
461 while ( *t ) t++;
462 t++;
463 }
464 }
465dostream:;
466 if ( ( stream = OpenStream(namebuf,PREVARSTREAM,0,raiselow) ) == 0 ) {
467/*
468 Eat comma before or after. This is `no value'
469*/
470 }
471 else if ( stream->inbuffer == 0 ) {
472 c = GetInput();
473 if ( level > 0 && c == '\'' ) return(c);
474 goto endofloop;
475 }
476 }
477 c = GetInput();
478 }
479 else if ( c == '{' ) { /* Try the preprocessor calculator */
480 if ( PreCalc() == 0 ) Terminate(-1);
481 c = GetInput(); /* This is either a { or a number */
482 break;
483 }
484 else break;
485endofloop:;
486 }
487 return(c);
488}
489
490/*
491 #] GetChar :
492 #[ CharOut :
493*/
494
495void CharOut(UBYTE c)
496{
497 if ( c == LINEFEED ) {
498 AM.OutBuffer[AP.InOutBuf++] = c;
499 WriteString(INPUTOUT,AM.OutBuffer,AP.InOutBuf);
500 AP.InOutBuf = 0;
501 }
502 else {
503 if ( AP.InOutBuf >= AM.OutBufSize || c == LINEFEED ) {
504 WriteString(INPUTOUT,AM.OutBuffer,AP.InOutBuf);
505 AP.InOutBuf = 0;
506 }
507 AM.OutBuffer[AP.InOutBuf++] = c;
508 }
509}
510
511/*
512 #] CharOut :
513 #[ UnsetAllowDelay :
514*/
515
516void UnsetAllowDelay(void)
517{
518 if ( ThePreVar != 0 ) {
519 if ( ThePreVar->nargs > 0 ) AP.AllowDelay = 0;
520 }
521}
522
523/*
524 #] UnsetAllowDelay :
525 #[ GetPreVar :
526
527 We use the model of a heap. If the same name has been used more
528 than once the last definition is used. This gives the impression
529 of local variables.
530
531 There are two types: The regular ones and the expression variables.
532 The last ones are like UNCHANGED_exprname and ZERO_exprname or
533 UNCHANGED_ and ZERO_.
534*/
535
536static UBYTE *yes = (UBYTE *)"1";
537static UBYTE *no = (UBYTE *)"0";
538static UBYTE numintopolynomial[12];
539#include "vector.h"
540static Vector(UBYTE, exprstr); /* Used for numactiveexprs_ and activeexprnames_. */
541
542UBYTE *GetPreVar(UBYTE *name, int flag)
543{
544 GETIDENTITY
545 int i, mode;
546 WORD number;
547 UBYTE *t, c = 0, *tt = 0;
548 t = name; while ( *t ) t++;
549 if ( t[-1] == '-' && t[-2] == '-' && t-2 > name && t[-3] != '_' ) {
550 t -= 2; c = *t; *t = 0; tt = t;
551 }
552 else if ( t[-1] == '+' && t[-2] == '+' && t-2 > name && t[-3] != '_' ) {
553 t -= 2; c = *t; *t = 0; tt = t;
554 }
555 else if ( StrICmp(name,(UBYTE *)"time_") == 0 ) {
556 UBYTE millibuf[24];
557 LONG millitime, timepart;
558 int timepart1, timepart2;
559 static char timestring[40];
560/* millitime = TimeCPU(1); */
561 millitime = GetRunningTime();
562 timepart = millitime%1000;
563 millitime /= 1000;
564 timepart /= 10;
565 timepart1 = timepart / 10;
566 timepart2 = timepart % 10;
567 NumToStr(millibuf,millitime);
568 snprintf(timestring,40,"%s.%1d%1d",millibuf,timepart1,timepart2);
569 return((UBYTE *)timestring);
570 }
571 else if ( ( StrICmp(name,(UBYTE *)"timer_") == 0 )
572 || ( StrICmp(name,(UBYTE *)"stopwatch_") == 0 ) ) {
573 static char timestring[40];
574 snprintf(timestring,40,"%ld",(long int)(GetRunningTime() - AP.StopWatchZero));
575 return((UBYTE *)timestring);
576 }
577 else if ( StrICmp(name, (UBYTE *)"numactiveexprs_") == 0 ) {
578 /* the number of active expressions */
579 int n = 0;
580 for ( i = 0; i < NumExpressions; i++ ) {
581 EXPRESSIONS e = Expressions + i;
582 switch ( e->status ) {
583 case LOCALEXPRESSION:
584 case GLOBALEXPRESSION:
585 case UNHIDELEXPRESSION:
586 case UNHIDEGEXPRESSION:
587 case INTOHIDELEXPRESSION:
588 case INTOHIDEGEXPRESSION:
589 n++;
590 break;
591 }
592 }
593 VectorReserve(exprstr, 41); /* up to 128-bit */
594 LongCopy(n, (char *)VectorPtr(exprstr));
595 return VectorPtr(exprstr);
596 }
597 else if ( StrICmp(name, (UBYTE *)"activeexprnames_") == 0 ) {
598 /* the list of active expressions separated by commas */
599 int j = 0;
600 VectorReserve(exprstr, 16); /* at least 1 character for '\0' */
601 for ( i = 0; i < NumExpressions; i++ ) {
602 UBYTE *p, *s;
603 int len, k;
604 EXPRESSIONS e = Expressions + i;
605 switch ( e->status ) {
606 case LOCALEXPRESSION:
607 case GLOBALEXPRESSION:
608 case UNHIDELEXPRESSION:
609 case UNHIDEGEXPRESSION:
610 case INTOHIDELEXPRESSION:
611 case INTOHIDEGEXPRESSION:
612 s = AC.exprnames->namebuffer + e->name;
613 len = StrLen(s);
614 VectorSize(exprstr) = j; /* j bytes must be copied in extending the buffer. */
615 VectorReserve(exprstr, j + len * 2 + 1);
616 p = VectorPtr(exprstr);
617 if ( j > 0 ) p[j++] = ',';
618 for ( k = 0; k < len; k++ ) {
619 if ( s[k] == ',' || s[k] == '|' ) p[j++] = '\\';
620 p[j++] = s[k];
621 }
622 break;
623 }
624 }
625 VectorPtr(exprstr)[j] = '\0';
626 return VectorPtr(exprstr);
627 }
628 else if ( StrICmp(name, (UBYTE *)"path_") == 0 ) {
629 /* the current FORM path (for debugging both in .c and .frm) */
630 if ( AM.Path ) {
631 return(AM.Path);
632 }
633 else {
634 return((UBYTE *)"");
635 }
636 }
637 t = name;
638 while ( *t && *t != '_' ) t++;
639 for ( i = NumPre-1; i >= 0; i-- ) {
640 if ( *t == '_' && ( StrICmp(name,PreVar[i].name) == 0 ) ) {
641 if ( c ) *tt = c;
642 ThePreVar = PreVar+i;
643 return(PreVar[i].value);
644 }
645 else if ( StrCmp(name,PreVar[i].name) == 0 ) {
646 if ( c ) *tt = c;
647 ThePreVar = PreVar+i;
648 return(PreVar[i].value);
649 }
650 }
651 if ( *t == '_' ) {
652 if ( StrICmp(name,(UBYTE *)"EXTRASYMBOLS_") == 0 ) goto extrashort;
653 *t = 0;
654 if ( StrICmp(name,(UBYTE *)"UNCHANGED") == 0 ) mode = 1;
655 else if ( StrICmp(name,(UBYTE *)"ZERO") == 0 ) mode = 0;
656 else if ( StrICmp(name,(UBYTE *)"SHOWINPUT") == 0 ) {
657 *t++ = '_';
658 if ( c ) *tt = c;
659 if ( AC.NoShowInput > 0 ) return(no);
660 else return(yes);
661 }
662 else if ( StrICmp(name,(UBYTE *)"EXTRASYMBOLS") == 0 ) {
663 *t++ = '_';
664extrashort:;
665 number = cbuf[AM.sbufnum].numrhs;
666 t = numintopolynomial;
667 NumCopy(number,t);
668 return(numintopolynomial);
669 }
670 else mode = -1;
671 *t++ = '_';
672 if ( mode >= 0 ) {
673 ThePreVar = 0;
674 if ( *t ) {
675 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
676 if ( c ) *tt = c;
677 if ( ( Expressions[number].vflags & ( 1 << mode ) ) != 0 )
678 return(yes);
679 else return(no);
680 }
681 }
682 else {
683/*
684 Here we have to test all active results.
685 These are in `negative' so the flags have to be zero.
686*/
687 if ( c ) *tt = c;
688 if ( ( AR.expflags & ( 1 << mode ) ) == 0 ) return(yes);
689 else return(no);
690 }
691 }
692 }
693 if ( ( t = (UBYTE *)(getenv((char *)(name))) ) != 0 ) {
694 if ( c ) *tt = c;
695 ThePreVar = 0;
696 return(t);
697 }
698 if ( c ) *tt = c;
699 if ( flag == WITHERROR ) {
700 Error1("Undefined preprocessor variable",name);
701 }
702 return(0);
703}
704
705/*
706 #] GetPreVar :
707 #[ PutPreVar :
708*/
709
724int PutPreVar(UBYTE *name, UBYTE *value, UBYTE *args, int mode)
725{
726 int i, ii, num = 2, nnum = 2, numargs = 0;
727 UBYTE *s, *t, *u = 0;
728 PREVAR *p;
729 if ( value == 0 && name[0] != '?' ) {
730 MesPrint("@Illegal empty value for preprocessor variable %s",name);
731 Terminate(-1);
732 }
733 if ( args ) {
734 s = args; num++;
735 while ( *s ) {
736 if ( *s != ' ' && *s != '\t' ) num++;
737 s++;
738 }
739 }
740 if ( mode == 1 ) {
741 i = NumPre;
742 while ( --i >= 0 ) {
743 if ( StrCmp(name,PreVar[i].name) == 0 ) {
744 u = PreVar[i].name;
745 break;
746 }
747 }
748 }
749 else i = -1;
750 if ( i < 0 ) { p = (PREVAR *)FromList(&AP.PreVarList); ii = p - PreVar; }
751 else { p = &(PreVar[i]); ii = i; }
752 if ( value ) {
753 s = value; while ( *s ) { s++; num++; }
754 }
755 else num = 1;
756 if ( i >= 0 ) {
757 if ( p->value ) {
758 s = p->value;
759 while ( *s ) { s++; nnum++; }
760 }
761 else nnum = 1;
762 if ( nnum >= num ) {
763/*
764 We can keep this in place
765*/
766 if ( value && p->value ) {
767 s = value;
768 t = p->value;
769 while ( *s ) *t++ = *s++;
770 *t = 0;
771 }
772 else p->value = 0;
773 return(i);
774 }
775 }
776 s = name; while ( *s ) { s++; num++; }
777 t = (UBYTE *)Malloc1(num,"PreVariable");
778 p->name = t;
779 s = name; while ( *s ) *t++ = *s++; *t++ = 0;
780 if ( value ) {
781 p->value = t;
782 s = value; while ( *s ) *t++ = *s++; *t = 0;
783 if ( AM.atstartup && t[-1] == '\n' ) t[-1] = 0;
784 }
785 else p->value = 0;
786 p->wildarg = 0;
787 if ( args ) {
788 int first = 1;
789 t++; p->argnames = t;
790 s = args;
791 while ( *s ) {
792 if ( *s == ' ' || *s == '\t' ) { s++; continue; }
793 if ( *s == ',' ) {
794 s++; *t++ = 0; numargs++;
795 while ( *s == ' ' || *s == '\t' ) s++;
796 if ( *s == '?' ) {
797 if ( p->wildarg > 0 ) {
798 Error0("More than one ?var in #define");
799 }
800 p->wildarg = numargs;
801 }
802 }
803 else if ( *s == '?' && first ) {
804 p->wildarg = 1; *t++ = *s++;
805 }
806 else { *t++ = *s++; }
807 first = 0;
808 }
809 *t = 0;
810 numargs++;
811 p->nargs = numargs;
812 }
813 else {
814 p->nargs = 0;
815 p->argnames = 0;
816 }
817 if ( u ) M_free(u,"replace PreVar value");
818 return(ii);
819}
820
821/*
822 #] PutPreVar :
823 #[ PopPreVars :
824*/
825
826void PopPreVars(int tonumber)
827{
828 PREVAR *p = &(PreVar[NumPre]);
829 while ( NumPre > tonumber ) {
830 NumPre--; p--;
831 M_free(p->name,"popping PreVar");
832 p->name = p->value = 0;
833 }
834}
835
836/*
837 #] PopPreVars :
838 #[ IniModule :
839*/
840
841void IniModule(int type)
842{
843 GETIDENTITY
844 WORD **w, i;
845 CBUF *C = cbuf+AC.cbufnum;
846 /*[05nov2003 mt]:*/
847#ifdef WITHMPI
848 /* To prevent
849 * (1) FlushOut() and PutOut() on the slaves to send a mess to the master
850 * compiling a module,
851 * (2) EndSort() called from poly_factorize_expression() on the master
852 * waits for the slaves.
853 */
854 PF.parallel=0;
855 /*BTW, this was the bug preventing usage of more than 1 expression!*/
856#endif
857
858 AR.BracketOn = 0;
859 AR.StoreData.dirtyflag = 0;
860 AC.bracketindexflag = 0;
861 AT.bracketindexflag = 0;
862
863/*[06nov2003 mt]:*/
864#ifdef WITHMPI
865 /* This flag may be set in the procedure tokenize(). */
866 AC.RhsExprInModuleFlag = 0;
867/*[20oct2009 mt]:*/
868 PF.mkSlaveInfile=0;
869 PF.slavebuf.PObuffer=NULL;
870 for(i=0; i<NumExpressions; i++)
871 Expressions[i].vflags &= ~ISINRHS;
872/*:[20oct2009 mt]*/
873#endif
874/*:[06nov2003 mt]*/
875
876 /*[19nov2003 mt]:*/
877 /*The module counter:*/
878 (AC.CModule)++;
879 /*:[19nov2003 mt]*/
880
881 if ( !type ) {
882 if ( C->rhs ) {
883 w = C->rhs; i = C->maxrhs;
884 do { *w++ = 0; } while ( --i > 0 );
885 }
886 if ( C->lhs ) {
887 w = C->lhs; i = C->maxlhs;
888 do { *w++ = 0; } while ( --i > 0 );
889 }
890 }
891 C->numlhs = C->numrhs = 0;
892 ClearTree(AC.cbufnum);
893 while ( AC.NumLabels > 0 ) {
894 AC.NumLabels--;
895 if ( AC.LabelNames[AC.NumLabels] ) M_free(AC.LabelNames[AC.NumLabels],"LabelName");
896 }
897
898 C->Pointer = C->Buffer;
899
900 AC.Commercial[0] = 0;
901
902 AC.IfStack = AC.IfHeap;
903 AC.arglevel = 0;
904 AC.termlevel = 0;
905 AC.IfLevel = 0;
906 AC.WhileLevel = 0;
907 AC.RepLevel = 0;
908 AC.insidelevel = 0;
909 AC.dolooplevel = 0;
910 AC.MustTestTable = 0;
911 AO.PrintType = 0; /* Otherwise statistics can get spoiled */
912 AC.ComDefer = 0;
913 AC.CollectFun = 0;
914 AM.S0->PolyWise = 0;
915 AC.SymChangeFlag = 0;
916 AP.lhdollarerror = 0;
917 AR.PolyFun = AC.lPolyFun;
918 AR.PolyFunInv = AC.lPolyFunInv;
919 AR.PolyFunType = AC.lPolyFunType;
920 AR.PolyFunExp = AC.lPolyFunExp;
921 AR.PolyFunVar = AC.lPolyFunVar;
922 AR.PolyFunPow = AC.lPolyFunPow;
923 AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
924 AC.inparallelflag = 0;
925 AC.mProcessBucketSize = AC.ProcessBucketSize;
926 NumPotModdollars = 0;
927 AC.topolynomialflag = 0;
928#ifdef WITHPTHREADS
929 if ( AM.totalnumberofthreads > 1 ) AS.MultiThreaded = 1;
930 else AS.MultiThreaded = 0;
931 for ( i = 1; i < AM.totalnumberofthreads; i++ ) {
932 AB[i]->T.S0->PolyWise = 0;
933 }
934#endif
935 OpenTemp();
936}
937
938/*
939 #] IniModule :
940 #[ IniSpecialModule :
941*/
942
943void IniSpecialModule(int type)
944{
945 DUMMYUSE(type);
946}
947
948/*
949 #] IniSpecialModule :
950 #[ PreProcessor :
951*/
952
953void PreProcessor(void)
954{
955 int moduletype = FIRSTMODULE;
956 int specialtype = 0;
957 int error1 = 0, error2 = 0, retcode, retval;
958 UBYTE c, *t, *s;
959 AP.StopWatchZero = GetRunningTime();
960 AC.compiletype = 0;
961 AP.PreContinuation = 0;
962 AP.PreAssignLevel = 0;
963 AP.gNumPre = NumPre;
964 AC.iPointer = AC.iBuffer;
965 AC.iPointer[0] = 0;
966
967 if ( AC.CheckpointFlag == -1 ) DoRecovery(&moduletype);
968 AC.CheckpointStamp = Timer(0);
969
970 for(;;) {
971/* if ( A.StatisticsFlag ) CharOut(LINEFEED); */
972
973 IniModule(moduletype);
974
975 /*Re-define preprocessor variable CMODULE_ as a current module number, starting from 1*/
976 /*The module counter is AC.CModule, it is incremented in IniModule*/
977 {
978 UBYTE buf[24];/*64/Log_2[10] = 19.3, this is enough for any integer*/
979 NumToStr(buf,AC.CModule);
980 PutPreVar((UBYTE *)"CMODULE_",buf,0,1);
981 }
982
983 if ( specialtype ) IniSpecialModule(specialtype);
984
985 for(;;) { /* Read a single line/statement */
986 c = GetChar(0);
987 if ( c == AP.ComChar ) { /* This line is commentary */
988 LoadInstruction(5);
989 if ( AC.CurrentStream->FoldName ) {
990 t = AP.preStart;
991 if ( *t && t[1] && t[2] == '#' && t[3] == ']' ) {
992 t += 4;
993 while ( *t == ' ' || *t == '\t' ) t++;
994 s = AC.CurrentStream->FoldName;
995 while ( *s == *t ) { s++; t++; }
996 if ( *s == 0 && ( *t == ' ' || *t == '\t'
997 || *t == ':' ) ) {
998 while ( *t == ' ' || *t == '\t' ) t++;
999 if ( *t == ':' ) {
1000 AC.CurrentStream = CloseStream(AC.CurrentStream);
1001 }
1002 }
1003 }
1004 }
1005 *AP.preStart = 0;
1006 continue;
1007 }
1008 while ( c == ' ' || c == '\t' ) c = GetChar(0);
1009 if ( c == LINEFEED ) continue;
1010 if ( c == ENDOFINPUT ) {
1011/* CharOut(LINEFEED); */
1012 Warning(".end instruction generated");
1013 moduletype = ENDMODULE; specialtype = 0;
1014 goto endmodule; /* Fake one */
1015 }
1016 if ( c == '#' ) {
1017 if ( PreProInstruction() ) { error1++; error2++; AP.preError++; }
1018 *AP.preStart = 0;
1019 }
1020 else if ( c == '.' ) {
1021 if ( ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) ||
1022 ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) ) {
1023 LoadInstruction(1);
1024 continue;
1025 }
1026 if ( ModuleInstruction(&moduletype,&specialtype) ) { error2++; AP.preError++; }
1027 if ( specialtype ) SetSpecialMode(moduletype,specialtype);
1028 if ( AP.PreInsideLevel != 0 ) {
1029 MesPrint("@end of module instructions may not be used inside");
1030 MesPrint("@the scope of a %#inside %#endinside construction.");
1031 Terminate(-1);
1032 }
1033 if ( AC.RepLevel > 0 ) {
1034 MesPrint("&EndRepeat statement(s) missing");
1035 error2++; AP.preError++;
1036 }
1037 if ( AC.tablecheck == 0 ) {
1038 AC.tablecheck = 1;
1039 if ( TestTables() ) { error2++; AP.preError++; }
1040 }
1041 if ( AP.PreContinuation ) {
1042 error1++; error2++;
1043 MesPrint("&Unfinished statement. Missing ;?");
1044 }
1045 if ( moduletype == GLOBALMODULE ) MakeGlobal();
1046 else {
1047endmodule: if ( error2 == 0 && AM.qError == 0 ) {
1048 retcode = ExecModule(moduletype);
1049#ifdef WITHMPI
1050 if(PF.slavebuf.PObuffer!=NULL){
1051 M_free(PF.slavebuf.PObuffer,"PF inbuf");
1052 PF.slavebuf.PObuffer=NULL;
1053 }
1054#endif
1055 UpdatePositions();
1056 if ( retcode < 0 ) error1++;
1057 if ( retcode ) { error2++; AP.preError++; }
1058 }
1059 else {
1060 EXPRESSIONS e;
1061 WORD j;
1062 for ( j = 0, e = Expressions; j < NumExpressions; j++, e++ ) {
1063 if ( e->replace == NEWLYDEFINEDEXPRESSION ) e->replace = REGULAREXPRESSION;
1064 }
1065 }
1066 switch ( moduletype ) {
1067 case STOREMODULE:
1068 if ( ExecStore() ) error1++;
1069 break;
1070 case CLEARMODULE:
1071 FullCleanUp();
1072 error1 = error2 = AP.preError = 0;
1073 AM.atstartup = 1;
1074 PutPreVar((UBYTE *)"DATE_",(UBYTE *)MakeDate(),0,1);
1075 AM.atstartup = 0;
1076 if ( AM.resetTimeOnClear ) {
1077#ifdef WITHPTHREADS
1078 ClearAllThreads();
1079#endif
1080 AM.SumTime += TimeCPU(1);
1081 TimeCPU(0);
1082 }
1083 AP.StopWatchZero = GetRunningTime();
1084 break;
1085 case ENDMODULE:
1086 Terminate( -( error1 | error2 ) );
1087 }
1088 }
1089 AC.tablecheck = 0;
1090 AC.compiletype = 0;
1091 if ( AC.exprfillwarning > 0 ) {
1092 AC.exprfillwarning = 0;
1093 }
1094 if ( AC.CheckpointFlag && error1 == 0 && error2 == 0 ) DoCheckpoint(moduletype);
1095 break; /* start a new module */
1096 }
1097 else {
1098 if ( ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) ||
1099 ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) ) {
1100 pushbackchar = c;
1101 LoadInstruction(5);
1102 continue;
1103 }
1104 UngetChar(c);
1105 if ( AP.PreContinuation ) {
1106 retval = LoadStatement(OLDSTATEMENT);
1107 }
1108 else {
1109 AC.CurrentStream->prevline = AC.CurrentStream->linenumber;
1110 retval = LoadStatement(NEWSTATEMENT);
1111 }
1112 if ( retval < 0 ) {
1113 error1++;
1114 if ( retval == -1 ) AP.PreContinuation = 0;
1115 else AP.PreContinuation = 1;
1116 TryRecover(0);
1117 }
1118 else if ( retval > 0 ) AP.PreContinuation = 0;
1119 else AP.PreContinuation = 1;
1120 if ( error1 == 0 && !AP.PreContinuation ) {
1121 if ( ( AP.PreDebug & PREPROONLY ) == 0 ) {
1122 int onpmd = NumPotModdollars;
1123#ifdef WITHMPI
1124 WORD oldRhsExprInModuleFlag = AC.RhsExprInModuleFlag;
1125 if ( AP.PreAssignFlag ) AC.RhsExprInModuleFlag = 0;
1126#endif
1127 if ( AP.PreOut || ( AP.PreDebug & DUMPTOCOMPILER )
1128 == DUMPTOCOMPILER )
1129 MesPrint(" %s",AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel]);
1130 retcode = CompileStatement(AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel]);
1131 if ( retcode < 0 ) error1++;
1132 if ( retcode ) { error2++; AP.preError++; }
1133 if ( AP.PreAssignFlag ) {
1134 if ( retcode == 0 ) {
1135 if ( ( retcode = CatchDollar(0) ) < 0 ) error1++;
1136 else if ( retcode > 0 ) { error2++; AP.preError++; }
1137 }
1138 else CatchDollar(-1);
1139 POPPREASSIGNLEVEL;
1140 if ( AP.PreAssignLevel <=0 )
1141 AP.PreAssignFlag = 0;
1142 NumPotModdollars = onpmd;
1143#ifdef WITHMPI
1144 AC.RhsExprInModuleFlag = oldRhsExprInModuleFlag;
1145#endif
1146 }
1147 }
1148 else {
1149 MesPrint(" %s",AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel]);
1150 }
1151 }
1152 else if ( !AP.PreContinuation ) {
1153 if ( AP.PreAssignLevel > 0 ) {
1154 POPPREASSIGNLEVEL;
1155 if ( AP.PreAssignLevel <=0 )
1156 AP.PreAssignFlag = 0;
1157 }
1158 }
1159/*
1160 if ( !AP.PreContinuation ) AP.PreAssignFlag = 0;
1161*/
1162 }
1163 }
1164 }
1165}
1166
1167/*
1168 #] PreProcessor :
1169 #[ PreProInstruction :
1170*/
1171
1172int PreProInstruction(void)
1173{
1174 UBYTE *s, *t;
1175 KEYWORD *key;
1176 AP.PreproFlag = 1;
1177 AP.preFill = 0;
1178 AP.AllowDelay = 0;
1179 AP.DelayPrevar = 0;
1180
1181 oldmode = 0;
1182 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) {
1183 LoadInstruction(3);
1184 if ( ( StrICmp(AP.preStart,(UBYTE *)"case") == 0
1185 || StrICmp(AP.preStart,(UBYTE *)"default") == 0 )
1186 && AP.PreSwitchModes[AP.PreSwitchLevel] == SEARCHINGPRECASE ) {
1187 LoadInstruction(0);
1188 }
1189 else if ( StrICmp(AP.preStart,(UBYTE *)"assign ") == 0 ) {}
1190 else { LoadInstruction(1); }
1191 }
1192 else if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) {
1193 LoadInstruction(3);
1194 if ( ( StrICmp(AP.preStart,(UBYTE *)"else") == 0
1195 || StrICmp(AP.preStart,(UBYTE *)"elseif") == 0 )
1196 && AP.PreIfStack[AP.PreIfLevel] == LOOKINGFORELSE ) {
1197 LoadInstruction(0);
1198 }
1199 else if ( StrICmp(AP.preStart,(UBYTE *)"assign ") == 0 ) {}
1200 else {
1201 LoadInstruction(1);
1202 }
1203 }
1204 else {
1205 LoadInstruction(0);
1206 }
1207 AP.PreproFlag = 0;
1208 t = AP.preStart;
1209 if ( *t == '-' ) {
1210 if ( AP.PreSwitchModes[AP.PreSwitchLevel] == EXECUTINGPRESWITCH
1211 && AP.PreIfStack[AP.PreIfLevel] == EXECUTINGIF )
1212 AC.NoShowInput = 1;
1213 }
1214 else if ( *t == '+' ) {
1215 if ( AP.PreSwitchModes[AP.PreSwitchLevel] == EXECUTINGPRESWITCH
1216 && AP.PreIfStack[AP.PreIfLevel] == EXECUTINGIF )
1217 AC.NoShowInput = 0;
1218 }
1219 else if ( *t == ':' ) {}
1220 else {
1221retry:;
1222 key = FindKeyWord(t,precommands,sizeof(precommands)/sizeof(KEYWORD));
1223 s = EndOfToken(t);
1224 if ( key == 0 ) {
1225 if ( *s == ';' ) {
1226 *s = 0; goto retry;
1227 }
1228 else {
1229 *s = 0;
1230 MesPrint("@Unrecognized preprocessor instruction: %s",t);
1231 return(-1);
1232 }
1233 }
1234 while ( *s == ' ' || *s == '\t' || *s == ',' ) s++;
1235 t = s;
1236 while ( *t ) t++;
1237 while ( ( t[-1] == ';' ) && ( t[-2] != '\\' ) ) {
1238 t--; *t = 0;
1239 }
1240 return((key->func)(s));
1241 }
1242 return(0);
1243}
1244
1245/*
1246 #] PreProInstruction :
1247 #[ LoadInstruction :
1248
1249 0: preprocessor instruction that may involve matching of brackets
1250 1: runs straight to end-of-line
1251 2: runs to ;
1252 3: only gets one word without `' interpretation.
1253 5: with pushbackchar, but inside commentary. -> 1
1254
1255To be added:
1256 In define, redefine, call and listed do we may have delayed substitution
1257 of preprocessor variables.
1258*/
1259
1260int LoadInstruction(int mode)
1261{
1262 UBYTE *s, *sstart, *t, c, cp;
1263 LONG position, fillpos = 0;
1264 int bralevel = 0, parlevel = 0, first = 1;
1265 int quotelevel = 0;
1266 if ( AP.preFill ) {
1267 s = AP.preFill;
1268 AP.preFill = 0;
1269 if ( s[1] != LINEFEED && s[1] != ENDOFINPUT ) {
1270 s[0] = s[1]; s++;
1271 }
1272 else { oldmode = mode; return(0); }
1273 }
1274 else { s = AP.preStart; }
1275 sstart = s; *s = 0;
1276 for(;;) {
1277 if ( ( mode & 1 ) == 1 ) {
1278 if ( pushbackchar && ( mode == 3 || mode == 5 ) ) {
1279 c = pushbackchar; pushbackchar = 0;
1280 }
1281 else c = GetInput();
1282 }
1283 else {
1284 c = GetChar(0);
1285 }
1286
1287 if ( mode == 2 && c == ';' ) break;
1288 if ( ( mode == 1 || mode == 5 ) && c == LINEFEED ) break;
1289 if ( mode == 3 && FG.cTable[c] != 0 ) {
1290 if ( c == '$' ) {
1291 pushbackchar = '$';
1292 *s++ = 'a'; *s++ = 's'; *s++ = 's'; *s++ = 'i';
1293 *s++ = 'g'; *s++ = 'n'; *s++ = ' '; *s = 0;
1294 }
1295 if ( c == '\'' || c == '`' ) { /* we do not expand preprocessor variables */
1296 mode = 1;
1297 }
1298 else {
1299 AP.preFill = s; *s++ = 0; *s = c;
1300 oldmode = mode;
1301 return(0);
1302 }
1303 }
1304 if ( mode == 0 && first ) {
1305 if ( c == '$' ) {
1306dodollar: s = sstart;
1307 *s++ = 'a'; *s++ = 's'; *s++ = 's'; *s++ = 'i';
1308 *s++ = 'g'; *s++ = 'n'; *s = 0;
1309 pushbackchar = c;
1310 oldmode = mode;
1311 return(0);
1312 }
1313 if ( c == ' ' || c == '\t' || c == ',' ) {}
1314 else first = 0;
1315 }
1316 else if ( mode == 1 && first && c == '$' && oldmode == 3 ) goto dodollar;
1317 if ( c == ENDOFINPUT || ( c == LINEFEED
1318/* && bralevel == 0 */
1319 && quotelevel == 0 ) ) {
1320 if ( mode == 2 && c == ENDOFINPUT ) {
1321 MesPrint("@Unexpected end of instruction");
1322 oldmode = mode;
1323 return(-1);
1324 }
1325/*
1326 if ( mode == 0 && bralevel ) {
1327 MesPrint("@Unmatched brackets");
1328 oldmode = mode;
1329 return(-1);
1330 }
1331*/
1332 if ( mode != 2 ) break;
1333 }
1334 if ( quotelevel ) {
1335 if ( c == '\\' ) {
1336 if ( ( mode == 1 ) || ( mode == 5 ) ) c = GetInput();
1337 else {
1338 c = GetChar(0);
1339 }
1340 if ( c == ENDOFINPUT ) {
1341 MesPrint("@Unmatched \"");
1342 if ( mode == 2 && c == ENDOFINPUT ) {
1343 MesPrint("@Unexpected end of instruction");
1344 }
1345/*
1346 if ( mode == 0 && bralevel ) {
1347 MesPrint("@Unmatched brackets");
1348 }
1349*/
1350 oldmode = mode;
1351 return(-1);
1352 }
1353 else if ( c == LINEFEED ) {}
1354 else if ( c == '"' ) { *s++ = '\\'; }
1355 else {
1356 *s++ = '\\';
1357 }
1358 }
1359 else if ( c == '"' ) {
1360 quotelevel = 0;
1361 AP.AllowDelay = 0;
1362 }
1363 }
1364 else if ( c == '\\' ) {
1365 if ( ( mode == 1 ) || ( mode == 5 ) ) cp = GetInput();
1366 else {
1367 cp = GetChar(0);
1368 }
1369 if ( cp == LINEFEED ) continue;
1370 if ( mode != 2 || cp != ';' ) *s++ = c;
1371 c = cp;
1372 }
1373 else if ( c == '"' ) {
1374/*
1375 Now look back in the buffer and determine what the keyword is.
1376 If it is define or redefine, put AllowDelay to 1.
1377*/
1378 t = AP.preStart;
1379 while ( FG.cTable[*t] <= 1 ) t++;
1380 cp = *t; *t = 0;
1381 if ( ( StrICmp(AP.preStart,(UBYTE *)"define") == 0 )
1382 || ( StrICmp(AP.preStart,(UBYTE *)"redefine") == 0 ) ) {
1383 AP.AllowDelay = 1;
1384 oldstream = AC.CurrentStream;
1385 }
1386 *t = cp;
1387 quotelevel = 1;
1388 }
1389 else if ( quotelevel == 0 && bralevel == 0 && c == '(' ) {
1390 t = AP.preStart;
1391 while ( FG.cTable[*t] <= 1 ) t++;
1392 cp = *t; *t = 0;
1393 if ( ( parlevel == 0 )
1394 && ( StrICmp(AP.preStart,(UBYTE *)"call") == 0 ) ) {
1395 AP.AllowDelay = 1;
1396 oldstream = AC.CurrentStream;
1397 }
1398 *t = cp;
1399 parlevel++;
1400 }
1401 else if ( quotelevel == 0 && bralevel == 0 && c == ')' ) {
1402 parlevel--;
1403 }
1404 else if ( quotelevel == 0 && parlevel == 0 && c == '{' ) {
1405 t = AP.preStart;
1406 while ( FG.cTable[*t] <= 1 ) t++;
1407 cp = *t; *t = 0;
1408 if ( ( bralevel == 0 )
1409 && ( ( StrICmp(AP.preStart,(UBYTE *)"call") == 0 )
1410 || ( StrICmp(AP.preStart,(UBYTE *)"do") == 0 ) ) ) {
1411 AP.AllowDelay = 1;
1412 oldstream = AC.CurrentStream;
1413 }
1414 *t = cp;
1415 bralevel++;
1416 }
1417 else if ( quotelevel == 0 && parlevel == 0 && c == '}' ) {
1418 bralevel--;
1419 if ( bralevel < 0 ) {
1420 if ( mode != 5 ) {
1421 MesPrint("@Unmatched brackets");
1422 oldmode = mode;
1423 return(-1);
1424 }
1425 bralevel = 0;
1426 }
1427 }
1428 if ( s >= (AP.preStop-1) ) {
1429 UBYTE **ppp;
1430 position = s - AP.preStart;
1431 if ( AP.preFill ) fillpos = AP.preFill - AP.preStart;
1432 ppp = &(AP.preStart); /* to avoid a compiler warning */
1433 if ( DoubleLList((void ***)ppp,&AP.pSize,sizeof(UBYTE),
1434 "instruction buffer") ) { *s = 0; oldmode = mode; return(-1); }
1435 AP.preStop = AP.preStart + AP.pSize-3;
1436 s = AP.preStart + position;
1437 if ( AP.preFill ) AP.preFill = fillpos + AP.preStart;
1438 }
1439 *s++ = c;
1440 }
1441 *s = 0;
1442 oldmode = mode;
1443 if ( mode == 0 ) {
1444 if ( ExpandTripleDots(1) < 0 ) return(-1);
1445 }
1446 return(0);
1447}
1448
1449/*
1450 #] LoadInstruction :
1451 #[ LoadStatement :
1452
1453 Puts the current string together in the input buffer.
1454 Does things like placing comma's where needed and expand ...
1455 We force a comma after the keyword. Before 8-sep-2009 the program might
1456 not put a comma if a + or - followed. And then the compiler ate
1457 the + or - and we needed repair code in the routines that used the
1458 + or - (Print, modulus, multiply and (a)bracket). This worked but
1459 the problem was with statements like Dimension -4; which then would
1460 be processed as Dimension 4; (JV)
1461*/
1462
1463int LoadStatement(int type)
1464{
1465 UBYTE *s, c, cp;
1466 int retval = 0, stringlevel = 0, newstatement = 0;
1467 if ( type == NEWSTATEMENT ) { AP.eat = 1; newstatement = 1;
1468 s = AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel]; }
1469 else { s = AC.iPointer; *s = 0; c = ' '; goto blank; }
1470 *s = 0;
1471 for(;;) {
1472 c = GetChar(0);
1473 if ( c == ENDOFINPUT ) { retval = -1; break; }
1474 if ( stringlevel == 0 ) {
1475 if ( c == LINEFEED ) {
1476 if ( AP.eat < 0 ) { s--; AP.eat = 0; }
1477 retval = 0; break;
1478 }
1479 if ( c == ';' ) {
1480 if ( AP.eat < 0 ) { s--; AP.eat = 0; }
1481 while ( ( c = GetChar(0) ) == ' ' || c == '\t' ) {}
1482 if ( c != LINEFEED ) UngetChar(c);
1483 retval = 1;
1484 break;
1485 }
1486 }
1487 if ( c == '\\' ) {
1488 cp = GetChar(0);
1489 if ( cp == LINEFEED ) continue;
1490 *s++ = c;
1491 c = cp;
1492 }
1493 if ( c == '"' ) {
1494 if ( stringlevel == 0 ) stringlevel = 1;
1495 else stringlevel = 0;
1496 AP.eat = 0;
1497 }
1498 else if ( stringlevel == 0 ) {
1499 if ( c == '\t' ) c = ' ';
1500 if ( c == ' ' ) {
1501blank: if ( newstatement < 0 ) newstatement = 0;
1502 if ( AP.eat && ( newstatement == 0 ) ) continue;
1503 c = ',';
1504 AP.eat = -2;
1505 if ( newstatement > 0 ) newstatement = -1;
1506 }
1507 else if ( chartype[c] <= 3 ) {
1508 AP.eat = 0;
1509 if ( newstatement < 0 ) newstatement = 0;
1510 }
1511 else if ( c == ',' ) {
1512 if ( newstatement > 0 ) {
1513 newstatement = -1;
1514 AP.eat = -2;
1515 }
1516/* else if ( AP.eat == -2 ) { s--; } */
1517 else if ( AP.eat == -2 ) { AP.eat = 1; continue; }
1518 else { goto doall; }
1519 }
1520 else {
1521doall:; if ( AP.eat < 0 ) {
1522 if ( newstatement == 0 ) s--;
1523 else { newstatement = 0; }
1524 }
1525 else if ( newstatement == 1 ) newstatement = 0;
1526 AP.eat = 1;
1527 if ( c == '*' && s > AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel] && s[-1] == '*' ) {
1528 s[-1] = '^';
1529 continue;
1530 }
1531 }
1532 }
1533 if ( s >= AC.iStop ) {
1534 if ( !AP.iBufError ) {
1535 LONG position = s - AC.iBuffer;
1536 LONG position2 = AC.iPointer - AC.iBuffer;
1537 UBYTE **ppp = &(AC.iBuffer); /* to avoid a compiler warning */
1538 if ( DoubleLList((void ***)ppp,&AC.iBufferSize
1539 ,sizeof(UBYTE),"statement buffer") ) {
1540 *s = 0; retval = -1; AP.iBufError = 1;
1541 }
1542 AC.iPointer = AC.iBuffer + position2;
1543 AC.iStop = AC.iBuffer + AC.iBufferSize-2;
1544 s = AC.iBuffer + position;
1545 }
1546 if ( AP.iBufError ) {
1547 for(;;){
1548 c = GetChar(0);
1549 if ( c == ENDOFINPUT ) { retval = -1; break; }
1550 if ( c == '"' ) {
1551 if ( stringlevel > 0 ) stringlevel = 0;
1552 else stringlevel = 1;
1553 }
1554 else if ( c == LINEFEED && !stringlevel ) { retval = -2; break; }
1555 else if ( c == ';' && !stringlevel ) {
1556 while ( ( c = GetChar(0) ) == ' ' || c == '\t' ) {}
1557 if ( c != LINEFEED ) UngetChar(c);
1558 retval = -1;
1559 break;
1560 }
1561 else if ( c == '\\' ) c = GetChar(0);
1562 }
1563 break;
1564 }
1565 }
1566 *s++ = c;
1567 }
1568 AC.iPointer = s;
1569 *s = 0;
1570 if ( stringlevel > 0 ) {
1571 MesPrint("@Unbalanced \". Runaway string");
1572 retval = -1;
1573 }
1574 if ( retval == 1 ) {
1575 if ( ExpandTripleDots(0) < 0 ) retval = -1;
1576 }
1577 return(retval);
1578}
1579
1580/*
1581 #] LoadStatement :
1582 #[ ExpandTripleDots :
1583*/
1584
1585static inline int IsSignChar(UBYTE c)
1586{
1587 return c == '+' || c == '-';
1588}
1589
1590static inline int IsAlphanumericChar(UBYTE c)
1591{
1592 return FG.cTable[c] == 0 || FG.cTable[c] == 1;
1593}
1594
1595static inline int CanParseSignedNumber(const UBYTE *s)
1596{
1597 while ( IsSignChar(*s) ) s++;
1598 return FG.cTable[*s] == 1;
1599}
1600
1601int ExpandTripleDots(int par)
1602{
1603 UBYTE *s, *s1, *s2, *n1, *n2, *t1, *t2, *startp, operator1, operator2, c, cc;
1604 UBYTE *nBuffer, *strngs, *Buffer, *Stop;
1605 LONG withquestion, x1, x2, y1, y2, number, inc, newsize, pow, fullsize;
1606 int i, error = 0, i1 ,i2, ii, *nums = 0;
1607
1608 if ( par == 0 ) {
1609 Buffer = AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel]; Stop = AC.iStop;
1610 }
1611 else {
1612 Buffer = AP.preStart; Stop = AP.preStop;
1613 }
1614 s = Buffer; while ( *s ) s++;
1615 fullsize = s - Buffer;
1616 if ( fullsize < 7 ) return(error);
1617
1618 s = Buffer+2;
1619 while ( *s ) {
1620 if ( *s != '.' || ( s[-1] != ',' && FG.cTable[s[-1]] != 5 ) )
1621 { s++; continue; }
1622 if ( s[-1] == '%' || s[-1] == '^' || s[1] != '.' || s[2] != '.' )
1623 { s++; continue; }
1624 s1 = s - 2;
1625 s += 3;
1626 if ( *s != s[-4] && ( *s != '+' || s[-4] != '-' )
1627 && ( *s != '-' || s[-4] != '+' ) ) {
1628 MesPrint("&Improper operators for ...");
1629 error = -1;
1630 }
1631 operator1 = s[-4];
1632 operator2 = *s++;
1633 if ( operator1 == ':' ) operator1 = '.';
1634 if ( operator2 == ':' ) operator2 = '.';
1635/*
1636 We have now O1...O2 (O stands for operator)
1637 Full syntax is
1638 [str]#1[?]O1...O2[str]#2[?] (Special case)
1639 in which both strings are identical and if one ? then also the other.
1640 <pattern1>O1...O2<pattern2> (General case)
1641 in which the difference in the patterns is just numerical.
1642*/
1643 s2 = s; /* the beginning of the second string */
1644 if ( *s2 != '<' || *s1 != '>' ) { /* Special case */
1645 startp = s1+1;
1646 withquestion = ( *s1 == '?' ); s1--;
1647 while ( FG.cTable[*s1] == 1 && s1 >= Buffer ) s1--;
1648 n1 = s1+1; /* Beginning of first number */
1649 if ( FG.cTable[*n1] != 1 ) {
1650 MesPrint("&No first number in ... operator");
1651 error = -1;
1652 }
1653 while ( FG.cTable[*s1] <= 1 && s1 >= Buffer ) s1--;
1654 s1++;
1655/*
1656 We have now the first string from s1 to n1, number from n1
1657*/
1658 t1 = s1; t2 = s2;
1659 while ( t1 < n1 && *t1 == *t2 ) { t1++; t2++; }
1660 n2 = t2;
1661 if ( FG.cTable[*t2] != 1 ) {
1662 MesPrint("&No second number in ... operator");
1663 error = -1;
1664 }
1665 x2 = 0;
1666 while ( FG.cTable[*t2] == 1 ) x2 = 10*x2 + *t2++ - '0';
1667 x1 = 0;
1668 while ( FG.cTable[*t1] == 1 ) x1 = 10*x1 + *t1++ - '0';
1669 if ( withquestion != ( *t2 == '?' ) ) {
1670 MesPrint("&Improper use of ? in ... operator");
1671 if ( *t2 == '?' ) t2++;
1672 error = -1;
1673 }
1674 else if ( withquestion ) t2++;
1675 if ( FG.cTable[*t2] <= 2 ) {
1676 MesPrint("&Illegal object after ... construction");
1677 error = -1;
1678 }
1679 c = *n1; *n1 = 0; s = t2;
1680 if ( error ) continue;
1681/*
1682 At this point the syntax has been fulfilled. We have
1683 str in s1.
1684 x1,x2 are #1,#2
1685 operator1,operator2 are the two operators.
1686 s points at whatever comes after.
1687 Expansion will have to be computed.
1688*/
1689 if ( x2 < x1 ) { number = x1-x2; inc = -1; y1 = x2; y2 = x1; }
1690 else { number = x2-x1; inc = 1; y1 = x1; y2 = x2; }
1691 newsize = (number+1)*(n1-s1) /* the strings */
1692 + number /* the operators */
1693 +(number+1)*(withquestion?1:0) /* questionmarks */
1694 +(number+1); /* last digits */
1695 pow = 10;
1696 for ( i = 1; i < 10; i++, pow *= 10 ) {
1697 if ( y1 >= pow ) newsize += number+1;
1698 else if ( y2 >= pow ) newsize += y2-pow+1;
1699 else break;
1700 }
1701 while ( Buffer+(fullsize+newsize-(s-s1)) >= Stop ) {
1702 LONG strpos = s1-Buffer;
1703 LONG endstr = n1-Buffer;
1704 LONG startq = startp - Buffer;
1705 LONG position = s - Buffer;
1706 UBYTE **ppp;
1707 if ( par == 0 ) {
1708 LONG position2 = AC.iPointer - AC.iBuffer;
1709 ppp = &(AC.iBuffer); /* to avoid a compiler warning */
1710 if ( DoubleLList((void ***)ppp,&AC.iBufferSize
1711 ,sizeof(UBYTE),"statement buffer") ) {
1712 Terminate(-1);
1713 }
1714 AC.iPointer = AC.iBuffer + position2;
1715 AC.iStop = AC.iBuffer + AC.iBufferSize-2;
1716 Buffer = AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel]; Stop = AC.iStop;
1717 }
1718 else {
1719 LONG fillpos = 0;
1720 if ( AP.preFill ) fillpos = AP.preFill - AP.preStart;
1721 ppp = &(AP.preStart); /* to avoid a compiler warning */
1722 if ( DoubleLList((void ***)ppp,&AP.pSize,sizeof(UBYTE),
1723 "instruction buffer") ) {
1724 Terminate(-1);
1725 }
1726 AP.preStop = AP.preStart + AP.pSize-3;
1727 if ( AP.preFill ) AP.preFill = fillpos + AP.preStart;
1728 Buffer = AP.preStart; Stop = AP.preStop;
1729 }
1730 s = Buffer + position;
1731 n1 = Buffer + endstr;
1732 s1 = Buffer + strpos;
1733 startp = Buffer + startq;
1734 }
1735/*
1736 We have space for the expansion in the buffer.
1737 There are two cases: new size > old size
1738 old size >= new size
1739 Note that whereever we move things, it will be at least startp.
1740*/
1741 if ( newsize > (s-s1) ) {
1742 t2 = Buffer + fullsize;
1743 t1 = t2 + (newsize - (s-s1));
1744 *t1 = 0;
1745 while ( t2 > s ) { *--t1 = *--t2; }
1746 }
1747 else if ( newsize < (s-s1) ) {
1748 t1 = s1 + newsize; t2 = s; s = t1;
1749 while ( *t2 ) *t1++ = *t2++;
1750 *t1 = 0;
1751 }
1752 for ( x1 += inc, t1 = startp; number > 0; number--, x1 += inc ) {
1753 *t1++ = operator1;
1754 cc = operator1; operator1 = operator2; operator2 = cc;
1755 t2 = s1; while ( *t2 ) *t1++ = *t2++;
1756 x2 = x1; n2 = t1;
1757 do {
1758 *t1++ = '0' + x2 % 10;
1759 x2 /= 10;
1760 } while ( x2 );
1761 s2 = t1 - 1;
1762 while ( s2 > n2 ) { cc = *s2; *s2 = *n2; *n2++ = cc; s2--; }
1763 if ( withquestion ) *t1++ = '?';
1764 }
1765 fullsize += newsize - ( s - s1 );
1766 *n1 = c;
1767 }
1768 else { /* General case. Find the patterns first */
1769 t1 = s1; s1--;
1770 while ( s1 > Buffer ) {
1771 if ( *s1 == '<' ) break;
1772 s1--;
1773 }
1774 t2 = s2;
1775 while ( *t2 ) {
1776 if ( *t2 == '>' ) break;
1777 t2++;
1778 }
1779 if ( *s1 != '<' || *t2 != '>' ) {
1780 MesPrint("&Illegal attempt to use ... operator");
1781 return(-1);
1782 }
1783 s1++; s2++; /* Pointers to the patterns */
1784 nums = (int *)Malloc1((t1-s1)*2*(sizeof(int)+sizeof(UBYTE))
1785 ,"Expand ...");
1786 strngs = (UBYTE *)(nums + 2*(t1-s1));
1787 n1 = s1; n2 = s2; ii = -1; i = 0;
1788 s = strngs;
1789 while ( n1 < t1 || n2 < t2 ) {
1790 /* Check the next characters can be parsed as numbers including signs. */
1791 if ( CanParseSignedNumber(n1) && CanParseSignedNumber(n2) ) {
1792 /*
1793 * Don't allow the cases that one has the sign and the other doesn't,
1794 * and the meaning changes without the sign. For example,
1795 * <f(1)>+...+<f(3)> Allowed
1796 * <f(-2)>+...+<f(2)> Allowed
1797 * <f(x-2)>+...+<f(x+2)> Allowed
1798 * <f(x-2)>+...+<f(x2)> Not allowed
1799 */
1800 int sign1 = IsSignChar(*n1);
1801 int sign2 = IsSignChar(*n2);
1802 int inword1 = s1 < n1 && IsAlphanumericChar(n1[-1]);
1803 int inword2 = s2 < n2 && IsAlphanumericChar(n2[-1]);
1804 if ( ( sign1 ^ sign2 ) && ( inword1 || inword2 ) ) break; /* Not allowed. */
1805 if ( sign1 || sign2 ) {
1806 *s++ = '+'; /* Marker indicating we need the sign. */
1807 }
1808 } else {
1809 /* If they are not numbers, they should be same. */
1810 if ( *n1 == *n2 ) { *s++ = *n1++; n2++; continue; }
1811 else break;
1812 }
1813 ParseSignedNumber(x1,n1)
1814 ParseSignedNumber(x2,n2)
1815 if ( x1 == x2 ) {
1816 if ( s != strngs && ( s[-1] == '+' || s[-1] == '-' ) ) {
1817 /* We need the sign. */
1818 s--;
1819 if ( x1 >= 0 ) {
1820 *s++ = '+';
1821 }
1822 }
1823 s = NumCopy(x1, s);
1824 }
1825 else {
1826 nums[2*i] = x1; nums[2*i+1] = x2;
1827 i++; *s++ = 0;
1828 }
1829 }
1830 if ( n1 < t1 || n2 < t2 ) {
1831 MesPrint("&Improper use of ... operator.");
1832theend: M_free(nums,"Expand ...");
1833 return(-1);
1834 }
1835 *s = 0;
1836 if ( i == 0 ) ii = 0;
1837 else {
1838 ii = nums[0] - nums[1];
1839 if ( ii < 0 ) ii = -ii;
1840 for ( x1 = 1; x1 < i; x1++ ) {
1841 x2 = nums[2*x1]-nums[2*x1+1];
1842 if ( x2 < 0 ) x2 = -x2;
1843 if ( x2 != ii ) {
1844 MesPrint("&Improper synchronization of numbers in ... operator");
1845 goto theend;
1846 }
1847 }
1848 }
1849 ii++;
1850/*
1851 We have now proper syntax.
1852 There are i+1 strings in strngs and i pairs of numbers
1853 in nums. Each time a start value and a finish value.
1854 We have ii steps. If ii <= 2, it will fit in the existing
1855 allocation. But this is hardly useful.
1856 We make a new allocation and copy from the old.
1857 Compute space.
1858*/
1859 x2 = s - strngs - i; /* -1 for end-of-string and +1 for the operator*/
1860 for ( i1 = 0; i1 < i; i1++ ) {
1861 i2 = nums[2*i1];
1862 x1 = nums[2*i1+1];
1863 if ( i2 < 0 ) i2 = -i2;
1864 if ( x1 < 0 ) x1 = -x1;
1865 if ( x1 > i2 ) i2 = x1;
1866 x1 = 2;
1867 while ( i2 > 0 ) { i2 /= 10; x1++; }
1868 x2 += x1;
1869 }
1870 x2 *= ii; /* Space for the expanded string (a bit more) */
1871 x2 += fullsize;
1872 x2 += 5; /* This will definitely hold everything */
1873 x2 += sizeof(UBYTE *);
1874 x2 = x2 - (x2 & (sizeof(UBYTE *)-1));
1875
1876 nBuffer = (UBYTE *)Malloc1(x2,"input buffer");
1877 n1 = nBuffer; s = Buffer; s1--;
1878 while ( s < s1 ) *n1++ = *s++;
1879/*
1880 Solution of the special case that no comma was generated
1881 due to the presence of < to start the pattern.
1882 We get a comma when the word before ends in an alphanumeric
1883 character, a _ or a ] and the word inside starts with an
1884 alphanumeric character, a [ (or an _ (for future considerations))
1885*/
1886 if ( ( ( n1 > nBuffer ) && ( ( FG.cTable[n1[-1]] <= 1 )
1887 || ( n1[-1] == '_' ) || ( n1[-1] == ']' ) ) ) &&
1888 ( ( FG.cTable[strngs[0]] <= 1 ) || ( strngs[0] == '[' )
1889 || ( strngs[0] == '_' ) ) ) *n1++ = ',';
1890
1891 for ( i1 = 0; i1 < ii; i1++ ) {
1892 s = strngs; while ( *s ) *n1++ = *s++;
1893 for ( i2 = 0; i2 < i; i2++ ) {
1894 if ( n1 > nBuffer && IsSignChar(n1[-1]) ) {
1895 /* We need the sign of counters. */
1896 n1--;
1897 if ( nums[2*i2] >= 0 ) {
1898 *n1++ = '+';
1899 }
1900 }
1901 n1 = NumCopy((WORD)(nums[2*i2]),n1);
1902 if ( nums[2*i2] > nums[2*i2+1] ) nums[2*i2]--;
1903 else nums[2*i2]++;
1904 s++; while ( *s ) *n1++ = *s++;
1905 }
1906 if ( ( i1 & 1 ) == 0 ) *n1++ = operator1;
1907 else *n1++ = operator2;
1908 }
1909 n1--; /* drop the trailing operator */
1910 s = t2 + 1; n2 = n1;
1911/*
1912 Similar extra comma
1913*/
1914 if ( ( ( ( FG.cTable[n1[-1]] <= 1 )
1915 || ( n1[-1] == '_' ) || ( n1[-1] == ']' ) ) ) &&
1916 ( ( FG.cTable[s[0]] <= 1 ) || ( s[0] == '[' )
1917 || ( s[0] == '_' ) ) ) *n1++ = ',';
1918
1919 while ( *s ) *n1++ = *s++;
1920 *n1 = 0;
1921 if ( par == 0 ) {
1922 LONG nnn1 = n1-nBuffer;
1923 LONG nnn2 = n2-nBuffer;
1924 LONG nnn3;
1925 while ( AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel] + x2 >= AC.iStop ) {
1926 LONG position = s-Buffer;
1927 LONG position2 = AC.iPointer - AC.iBuffer;
1928 UBYTE **ppp;
1929 ppp = &(AC.iBuffer); /* to avoid a compiler warning */
1930 if ( DoubleLList((void ***)ppp,&AC.iBufferSize
1931 ,sizeof(UBYTE),"statement buffer") ) {
1932 Terminate(-1);
1933 }
1934 AC.iPointer = AC.iBuffer + position2;
1935 AC.iStop = AC.iBuffer + AC.iBufferSize-2;
1936 Buffer = AC.iBuffer+AP.PreAssignStack[AP.PreAssignLevel]; Stop = AC.iStop;
1937 s = Buffer + position;
1938 }
1939/*
1940 This can be improved. We only have to start from the first term.
1941*/
1942 for ( nnn3 = 0; nnn3 < nnn1; nnn3++ ) Buffer[nnn3] = nBuffer[nnn3];
1943 Buffer[nnn3] = 0;
1944 n1 = Buffer + nnn1;
1945 n2 = Buffer + nnn2;
1946 M_free(nBuffer,"input buffer");
1947 M_free(nums,"Expand ...");
1948 }
1949 else { /* Comes here only inside a real preprocessor instruction */
1950 AP.preStop = nBuffer + x2 - 2;
1951 AP.pSize = x2;
1952 M_free(AP.preStart,"input buffer");
1953 M_free(nums,"Expand ...");
1954 AP.preStart = nBuffer;
1955 Buffer = AP.preStart; Stop = AP.preStop;
1956 }
1957 fullsize = n1 - Buffer;
1958 s = n2;
1959 }
1960 }
1961 return(error);
1962}
1963
1964/*
1965 #] ExpandTripleDots :
1966 #[ FindKeyWord :
1967*/
1968
1969KEYWORD *FindKeyWord(UBYTE *theword, KEYWORD *table, int size)
1970{
1971 int low,med,hi;
1972 UBYTE *s1, *s2;
1973 low = 0;
1974 hi = size-1;
1975 while ( hi >= low ) {
1976 med = (hi+low)/2;
1977 s1 = (UBYTE *)(table[med].name);
1978 s2 = theword;
1979 while ( *s1 && tolower(*s1) == tolower(*s2) ) { s1++; s2++; }
1980 if ( *s1 == 0 &&
1981/*[30apr2004 mt]:*/
1982/* The bug!:
1983 FG.cTable[*s2] != 1 && FG.cTable[*s2] != 2
1984*/
1985 FG.cTable[*s2] != 0 && FG.cTable[*s2] != 1
1986/* ( *s2 == ' ' || *s2 == '\t' || *s2 == 0 || *s2 == ',' || *s2 == '(' ) */
1987 )
1988 return(table+med);
1989 if ( tolower(*s2) > tolower(*s1) ) low = med+1;
1990 else hi = med - 1;
1991 }
1992 return(0);
1993}
1994
1995/*
1996 #] FindKeyWord :
1997 #[ FindInKeyWord :
1998*/
1999
2000KEYWORD *FindInKeyWord(UBYTE *theword, KEYWORD *table, int size)
2001{
2002 int i;
2003 UBYTE *s1, *s2;
2004 for ( i = 0; i < size; i++ ) {
2005 s1 = (UBYTE *)(table[i].name);
2006 s2 = theword;
2007 while ( *s1 && tolower(*s1) == tolower(*s2) ) { s1++; s2++; }
2008 if ( *s2 == 0 || *s2 == ' ' || *s2 == ',' || *s2 == '\t' )
2009 return(table+i);
2010 }
2011 return(0);
2012}
2013
2014/*
2015 #] FindInKeyWord :
2016 #[ TheDefine :
2017*/
2018
2030int TheDefine(UBYTE *s, int mode)
2031{
2032 UBYTE *name, *value, *valpoin, *args = 0, c;
2033 if ( ( mode & 2 ) == 0 ) {
2034 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2035 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2036 }
2037 else { mode &= ~2; }
2038 name = s;
2039 if ( chartype[*s] != 0 ) goto illname;
2040 s++;
2041 while ( chartype[*s] <= 1 ) s++;
2042 value = s;
2043 while ( *s == ' ' || *s == '\t' ) s++;
2044 c = *s; *value = 0;
2045 if ( c == 0 ) {
2046 if ( PutPreVar(name,(UBYTE *)"1",0,mode) < 0 ) return(-1);
2047 return(0);
2048 }
2049 if ( c == '(' ) { /* arguments. scan for correctness */
2050 s++; args = s;
2051 for (;;) {
2052 if ( chartype[*s] != 0 ) goto illarg;
2053 s++;
2054 while ( chartype[*s] <= 1 ) s++;
2055 while ( *s == ' ' || *s == '\t' ) s++;
2056 if ( *s == ')' ) break;
2057 if ( *s != ',' ) goto illargs;
2058 s++;
2059 while ( *s == ' ' || *s == '\t' ) s++;
2060 }
2061 *s++ = 0;
2062 while ( *s == ' ' || *s == '\t' ) s++;
2063 c = *s;
2064 }
2065 if ( c == '"' ) {
2066 s++; valpoin = value = s;
2067 while ( *s != '"' ) {
2068 if ( *s == '\\' ) {
2069 if ( s[1] == 'n' ) { *valpoin++ = LINEFEED; s += 2; }
2070 else if ( s[1] == '"' ) { *valpoin++ = '"'; s += 2; }
2071 else if ( s[1] == 0 ) goto illval;
2072 else { *valpoin++ = *s++; *valpoin++ = *s++; }
2073 }
2074 else *valpoin++ = *s++;
2075 }
2076 *valpoin = 0;
2077 if ( PutPreVar(name,value,args,mode) < 0 ) return(-1);
2078 }
2079 else {
2080 MesPrint("@Illegal string for preprocessor variable %s. Forgotten double quotes (\") ?",name);
2081 return(-1);
2082 }
2083 return(0);
2084illname:;
2085 MesPrint("@Illegally formed name of preprocessor variable");
2086 return(-1);
2087illarg:;
2088 MesPrint("@Illegally formed name of argument of preprocessor definition");
2089 return(-1);
2090illargs:;
2091 MesPrint("@Illegally formed arguments of preprocessor definition");
2092 return(-1);
2093illval:;
2094 MesPrint("@Illegal valpoin for preprocessor variable %s",name);
2095 return(-1);
2096}
2097
2098/*
2099 #] TheDefine :
2100 #[ DoCommentChar :
2101*/
2102
2103int DoCommentChar(UBYTE *s)
2104{
2105 UBYTE c;
2106 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2107 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2108 while ( *s == ' ' || *s == '\t' ) s++;
2109 if ( *s == 0 || *s == '\n' ) {
2110 MesPrint("@No valid comment character specified");
2111 return(-1);
2112 }
2113 c = *s++;
2114 while ( *s == ' ' || *s == '\t' ) s++;
2115 if ( *s != 0 && *s != '\n' ) {
2116 MesPrint("@Comment character should be a single valid character");
2117 return(-1);
2118 }
2119 AP.ComChar = c;
2120 return(0);
2121}
2122
2123/*
2124 #] DoCommentChar :
2125 #[ DoPreAssign :
2126
2127 Routine assigns a 'value' to a $variable.
2128 Syntax: #assign
2129 next line(s) a statement of the type
2130 $name = expression;
2131 Note: at the moment of the assign there cannot be an 'open' statement.
2132*/
2133
2134int DoPreAssign(UBYTE *s)
2135{
2136 int error = 0;
2137 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) {
2138 return(0);
2139 }
2140 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) {
2141 return(0);
2142 }
2143 if ( *s ) {
2144 MesPrint("@Illegal characters in %#assign instruction");
2145 error = 1;
2146 }
2147 PUSHPREASSIGNLEVEL;
2148 AP.PreAssignFlag = 1;
2149/*
2150 if ( AP.PreContinuation ) {
2151 MesPrint("@Assign instructions cannot occur inside statements");
2152 MesPrint("@Missing ; ?");
2153 AP.PreContinuation = 0;
2154 error = 1;
2155 }
2156*/
2157 return(error);
2158}
2159
2160/*
2161 #] DoPreAssign :
2162 #[ DoDefine :
2163*/
2164
2165int DoDefine(UBYTE *s)
2166{
2167 return(TheDefine(s,0));
2168}
2169
2170/*
2171 #] DoDefine :
2172 #[ DoRedefine :
2173*/
2174
2175int DoRedefine(UBYTE *s)
2176{
2177 return(TheDefine(s,1));
2178}
2179
2180/*
2181 #] DoRedefine :
2182 #[ ClearMacro :
2183
2184 Undefines the arguments of a macro after its use.
2185*/
2186
2187int ClearMacro(UBYTE *name)
2188{
2189 int i;
2190 PREVAR *p;
2191 UBYTE *s;
2192 for ( i = NumPre-1, p = &(PreVar[NumPre-1]); i >= 0; i--, p-- ) {
2193 if ( StrCmp(name,p->name) == 0 ) break;
2194 }
2195 if ( i < 0 ) return(-1);
2196 if ( p->nargs <= 0 ) return(0);
2197 s = p->argnames;
2198 for ( i = 0; i < p->nargs; i++ ) {
2199 TheUndefine(s);
2200 while ( *s ) s++;
2201 s++;
2202 }
2203 return(0);
2204}
2205
2206/*
2207 #] ClearMacro :
2208 #[ TheUndefine :
2209
2210 There is a complication here. If there are redefine statements
2211 they will be pointing at the wrong variable if their number is
2212 greater than the number of the variable we pop.
2213*/
2214
2215int TheUndefine(UBYTE *name)
2216{
2217 int i, inum, error = 0;
2218 PREVAR *p;
2219 for ( i = NumPre-1, p = &(PreVar[NumPre-1]); i >= 0; i--, p-- ) {
2220 if ( StrCmp(name,p->name) == 0 ) {
2221 M_free(p->name,"undefining PreVar");
2222 NumPre--;
2223 inum = i;
2224 while ( i < NumPre ) {
2225 p->name = p[1].name;
2226 p->value = p[1].value;
2227 p++; i++;
2228 }
2229 p->name = 0; p->value = 0;
2230 {
2231 CBUF *CC = cbuf + AC.cbufnum;
2232 int j, k;
2233 for ( j = 1; j <= CC->numlhs; j++ ) {
2234 if ( CC->lhs[j][0] == TYPEREDEFPRE ) {
2235 if ( CC->lhs[j][2] > inum ) CC->lhs[j][2]--;
2236 else if ( CC->lhs[j][2] == inum ) {
2237 for ( k = inum - 1; k >= 0; k-- )
2238 if ( StrCmp(name, PreVar[k].name) == 0 ) break;
2239 if ( k >= 0 ) CC->lhs[j][2] = k;
2240 else {
2241 MesPrint("@Conflict between undefining a preprocessor variable and a redefine statement");
2242 error = 1;
2243 }
2244 }
2245 }
2246 }
2247#ifdef PARALLELCODE
2248 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2249 if ( AC.pfirstnum[j] > inum ) AC.pfirstnum[j]--;
2250 else if ( AC.pfirstnum[j] == inum ) {
2251 for ( k = inum - 1; k >= 0; k-- )
2252 if ( StrCmp(name, PreVar[k].name) == 0 ) break;
2253 if ( k >= 0 ) AC.pfirstnum[j] = k;
2254 }
2255 }
2256#endif
2257 }
2258 break;
2259 }
2260 }
2261 return(error);
2262}
2263
2264/*
2265 #] TheUndefine :
2266 #[ DoUndefine :
2267*/
2268
2269int DoUndefine(UBYTE *s)
2270{
2271 UBYTE *name, *t;
2272 int error = 0, retval;
2273/*
2274 int i;
2275 PREVAR *p;
2276*/
2277 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2278 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2279 name = s;
2280 if ( chartype[*s] != 0 ) goto illname;
2281 s++;
2282 while ( chartype[*s] <= 1 ) s++;
2283 t = s;
2284 if ( *s && *s != ' ' && *s != '\t' ) goto illname;
2285 while ( *s == ' ' || *s == '\t' ) s++;
2286 if ( *s ) {
2287 MesPrint("@Undefine should just have a variable name");
2288 error = -1;
2289 }
2290 *t = 0;
2291 if ( ( retval = TheUndefine(name) ) != 0 ) {
2292 if ( error == 0 ) return(retval);
2293 if ( error > 0 ) error = retval;
2294 }
2295/*
2296 for ( i = NumPre-1, p = &(PreVar[NumPre-1]); i >= 0; i--, p-- ) {
2297 if ( StrCmp(name,p->name) == 0 ) {
2298 M_free(p->name,"undefining PreVar");
2299 NumPre--;
2300 while ( i < NumPre ) {
2301 p->name = p[1].name;
2302 p->value = p[1].value;
2303 p++; i++;
2304 }
2305 p->name = 0; p->value = 0;
2306 break;
2307 }
2308 }
2309*/
2310 return(error);
2311illname:;
2312 MesPrint("@Illegally formed name of preprocessor variable");
2313 return(-1);
2314}
2315
2316/*
2317 #] DoUndefine :
2318 #[ DoInclude :
2319*/
2320
2321int DoInclude(UBYTE *s) { return(Include(s,FILESTREAM)); }
2322
2323/*
2324 #] DoInclude :
2325 #[ DoReverseInclude :
2326*/
2327
2328int DoReverseInclude(UBYTE *s) { return(Include(s,REVERSEFILESTREAM)); }
2329
2330/*
2331 #] DoReverseInclude :
2332 #[ Include :
2333*/
2334
2335int Include(UBYTE *s, int type)
2336{
2337 UBYTE *name = s, *fold, *t, c, c1 = 0, c2 = 0, c3 = 0;
2338 int str1offset, withnolist = AC.NoShowInput;
2339 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2340 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2341 if ( *s == '-' || *s == '+' ) {
2342 if ( *s == '-' ) withnolist = 1;
2343 else withnolist = 0;
2344 s++;
2345 while ( *s == ' ' || *s == '\t' ) s++;
2346 name = s;
2347 }
2348 if ( *s == '"' ) {
2349 while ( *s && *s != '"' ) {
2350 if ( *s == '\\' ) s++;
2351 s++;
2352 }
2353 t = s++;
2354 }
2355 else {
2356 while ( *s && *s != ' ' && *s != '\t' ) {
2357 if ( *s == '\\' ) s++;
2358 s++;
2359 }
2360 t = s;
2361 }
2362 while ( *s == ' ' || *s == '\t' ) s++;
2363 if ( *s == '#' ) {
2364 *t = 0;
2365 s++;
2366 while ( *s == ' ' || *s == '\t' ) s++;
2367 fold = s;
2368 if ( *s == 0 ) {
2369 MesPrint("@Empty fold name");
2370 return(-1);
2371 }
2372continue_fold:
2373 while ( *s && *s != ' ' && *s != '\t' ) {
2374 if ( *s == '\\' ) s++;
2375 s++;
2376 }
2377 t = s;
2378 while ( *s == ' ' || *s == '\t' ) s++;
2379 if ( *s ) {
2380 /*
2381 * A non-whitespace character is found. Continue parsing the fold.
2382 */
2383 goto continue_fold;
2384 }
2385 }
2386 else if ( *s == 0 ) {
2387 fold = 0;
2388 }
2389 else {
2390 MesPrint("@Improper syntax for file name");
2391 return(-1);
2392 }
2393 *t = 0;
2394 if ( fold ) {
2395 fold = strDup1(fold,"foldname");
2396 }
2397/*
2398 We have the name of the file in 'name' and the fold in 'fold' (or NULL)
2399*/
2400 if ( OpenStream(name,type,0,PRENOACTION) == 0 ) {
2401 if ( fold ) { M_free(fold,"foldname"); fold = 0; }
2402 return(-1);
2403 }
2404 if ( fold ) {
2405 LONG position = -1;
2406 int foldopen = 0;
2407 LONG linenum = 0, prevline = 0;
2408 name = strDup1(name,"name of include file");
2409 AC.CurrentStream->FoldName = strDup1(fold,"name of fold");
2410 AC.NoShowInput++;
2411 for(;;) {
2412 c = GetFromStream(AC.CurrentStream);
2413 if ( c == ENDOFSTREAM ) {
2414 AC.CurrentStream = CloseStream(AC.CurrentStream);
2415 goto nofold;
2416 }
2417 if ( c == AP.ComChar ) {
2418 str1offset = AC.CurrentStream-AC.Streams;
2419 LoadInstruction(1);
2420 if ( AC.CurrentStream != str1offset+AC.Streams ) {
2421 c = ENDOFSTREAM;
2422 }
2423 else {
2424 t = AP.preStart;
2425 if ( t[2] == '#' && ( ( t[3] == '[' && !foldopen )
2426 || ( t[3] == ']' && foldopen ) ) ) {
2427 t += 4;
2428 while ( *t == ' ' || *t == '\t' ) t++;
2429 s = AC.CurrentStream->FoldName;
2430 while ( *s == *t ) { s++; t++; }
2431 if ( *s == 0 && ( *t == ' ' || *t == '\t'
2432 || *t == ':' ) ) {
2433 while ( *t == ' ' || *t == '\t' ) t++;
2434 if ( *t == ':' ) {
2435 if ( foldopen == 0 ) {
2436 foldopen = 1;
2437 position = GetStreamPosition(AC.CurrentStream);
2438 linenum = AC.CurrentStream->linenumber;
2439 prevline = AC.CurrentStream->prevline;
2440 c3 = AC.CurrentStream->isnextchar;
2441 c1 = AC.CurrentStream->nextchar[0];
2442 c2 = AC.CurrentStream->nextchar[1];
2443 }
2444 else {
2445 foldopen = 0;
2446 PositionStream(AC.CurrentStream,position);
2447 AC.CurrentStream->linenumber = linenum;
2448 AC.CurrentStream->prevline = prevline;
2449 AC.CurrentStream->eqnum = 1;
2450 AC.NoShowInput--;
2451 AC.CurrentStream->isnextchar = c3;
2452 AC.CurrentStream->nextchar[0] = c1;
2453 AC.CurrentStream->nextchar[1] = c2;
2454 break;
2455 }
2456 }
2457 }
2458 }
2459 }
2460 }
2461 else {
2462 while ( c != LINEFEED && c != ENDOFSTREAM ) {
2463 c = GetFromStream(AC.CurrentStream);
2464 if ( c == ENDOFSTREAM ) {
2465 AC.CurrentStream = CloseStream(AC.CurrentStream);
2466 break;
2467 }
2468 }
2469 }
2470 if ( c == ENDOFSTREAM ) {
2471nofold:
2472 MesPrint("@Cannot find fold %s in file %s",fold,name);
2473 UngetChar(c);
2474 AC.NoShowInput--;
2475 M_free(name,"name of include file");
2476 Terminate(-1);
2477 }
2478 }
2479 M_free(name,"name of include file");
2480 }
2481 AC.NoShowInput = withnolist;
2482 if ( fold ) { M_free(fold,"foldname"); fold = 0; }
2483 return(0);
2484}
2485
2486/*
2487 #] Include :
2488 #[ DoPreExchange :
2489
2490 Exchanges the names of expressions or the contents of dollars
2491 Syntax:
2492 #exchange expr1,expr2
2493 #exchange $var1,$var2
2494*/
2495
2496int DoPreExchange(UBYTE *s)
2497{
2498 int error = 0;
2499 UBYTE *s1, *s2;
2500 WORD num1, num2;
2501 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2502 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2503 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
2504 if ( *s == '$' ) {
2505 s++; s1 = s; while ( FG.cTable[*s] <= 1 ) s++;
2506 if ( *s != ',' && *s != ' ' && *s != '\t' ) goto syntax;
2507 *s++ = 0;
2508 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
2509 if ( *s != '$' ) goto syntax;
2510 s++; s2 = s; while ( FG.cTable[*s] <= 1 ) s++;
2511 if ( *s != 0 && *s != ';' ) goto syntax;
2512 *s = 0;
2513 if ( ( num1 = GetDollar(s1) ) <= 0 ) {
2514 MesPrint("@$%s has not been defined (yet)",s1);
2515 error = 1;
2516 }
2517 if ( ( num2 = GetDollar(s2) ) <= 0 ) {
2518 MesPrint("@$%s has not been defined (yet)",s2);
2519 error = 1;
2520 }
2521 if ( error == 0 ) {
2522 ExchangeDollars((int)num1,(int)num2);
2523 }
2524 }
2525 else {
2526 s1 = s; s = SkipAName(s);
2527 if ( *s != ',' && *s != ' ' && *s != '\t' ) goto syntax;
2528 *s++ = 0;
2529 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
2530 if ( FG.cTable[*s] != 0 && *s != '[' ) goto syntax;
2531 s2 = s; s = SkipAName(s);
2532 if ( *s != 0 && *s != ';' ) goto syntax;
2533 *s = 0;
2534 if ( GetName(AC.exprnames,s1,&num1,NOAUTO) != CEXPRESSION ) {
2535 MesPrint("@%s is not an expression",s1);
2536 error = 1;
2537 }
2538 if ( GetName(AC.exprnames,s2,&num2,NOAUTO) != CEXPRESSION ) {
2539 MesPrint("@%s is not an expression",s2);
2540 error = 1;
2541 }
2542 if ( error == 0 ) {
2543 ExchangeExpressions((int)num1,(int)num2);
2544 }
2545 }
2546 return(error);
2547syntax:
2548 MesPrint("@Proper syntax: %#exchange expr1,expr2 or %#exchange $var1,$var2");
2549 return(1);
2550}
2551
2552/*
2553 #] DoPreExchange :
2554 #[ DoCall :
2555*/
2556
2557int DoCall(UBYTE *s)
2558{
2559 UBYTE *t, *u, *v, *name, c, cp, *args1, *args2, *t1, *t2, *wild = 0;
2560 int bratype = 0, wildargs = 0, inwildargs = 0, nwildargs = 0;
2561 PROCEDURE *p;
2562 int streamoffset;
2563 int i, namesize, narg1, narg2, bralevel, numpre;
2564 LONG i1, i2;
2565 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2566 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2567/*
2568 1: Get the name of the procedure.
2569 2: Locate the procedure.
2570*/
2571 name = s; s = EndOfToken(s); c = *s; *s = 0;
2572 for ( i = NumProcedures-1; i >= 0; i-- ) {
2573 if ( StrCmp(Procedures[i].name,name) == 0 ) break;
2574 }
2575 // AP.ProcList.num = NumProcedures is incremented inside FromList
2576 p = (PROCEDURE *)FromList(&AP.ProcList);
2577 if ( i < 0 ) { /* Try to find a file */
2578 namesize = 0;
2579 t = name;
2580 while ( *t ) { t++; namesize++; }
2581 t = AP.procedureExtension;
2582 while ( *t ) { t++; namesize++; }
2583 t = p->name = (UBYTE *)Malloc1(namesize+2,"procedure");
2584 u = name;
2585 while ( *u ) *t++ = *u++;
2586 *t++ = '.';
2587 v = AP.procedureExtension;
2588 while ( *v ) *t++ = *v++;
2589 *t = 0;
2590 p->loadmode = 0; /* buffer should be freed at end */
2591 p->mustfree = 1;
2592 p->p.buffer = LoadInputFile(p->name,PROCEDUREFILE);
2593 if ( p->p.buffer == 0 ) return(-1);
2594 t[-4] = 0;
2595 }
2596 else {
2597 p->p.buffer = Procedures[i].p.buffer;
2598 p->name = Procedures[i].name;
2599 p->loadmode = 1;
2600 p->mustfree = 0; // this is just a copy of pointers to a permanently stored procedure
2601 }
2602 t = p->p.buffer;
2603 SKIPBLANKS(t)
2604 if ( *t++ != '#' ) goto wrongfile;
2605 SKIPBLANKS(t)
2606 t += 9;
2607 SKIPBLANKS(t)
2608 u = EndOfToken(t);
2609 cp = *u; *u = 0;
2610 if ( StrCmp(t,name) != 0 ) goto wrongfile;
2611 *u = cp;
2612 *s = c;
2613/*
2614 The pointer p points to the contents of the procedure (in memory)
2615 Now we have to match the arguments. u points to after the name
2616 in the 'file', s to after the name in the call statement.
2617*/
2618 bralevel = narg1 = narg2 = 0; args2 = u;
2619 SKIPBLANKS(u)
2620 if ( *u == '(' ) {
2621 u++; SKIPBLANKS(u)
2622 args2 = u;
2623 while ( *u != ')' ) {
2624 if ( *u == '?' ) { wildargs++; u++; nwildargs = narg2+1; }
2625 narg2++; u = EndOfToken(u); SKIPBLANKS(u)
2626 if ( *u == ',' ) { u++; SKIPBLANKS(u) }
2627 else if ( *u != ')' || ( wildargs > 1 ) ) {
2628 MesPrint("@Illegal argument field in procedure %s",p->name);
2629 return(-1);
2630 }
2631 }
2632 }
2633 while ( *u != LINEFEED ) u++;
2634 SKIPBLANKS(s)
2635 args1 = s+1;
2636 if ( *s == '(' ) bratype = 1;
2637 do {
2638 if ( *s == '{' && bratype == 0 ) bralevel++;
2639 else if ( *s == '(' && bratype == 1 ) bralevel++;
2640 else if ( *s == '}' && bratype == 0 ) {
2641 bralevel--;
2642 if ( bralevel == 0 ) {
2643 *s = 0; narg1++;
2644 if ( wildargs && narg1 == nwildargs ) wild = s;
2645 }
2646 }
2647 else if ( *s == ')' && bratype == 1 ) {
2648 bralevel--;
2649 if ( bralevel == 0 ) {
2650 *s = 0; narg1++;
2651 if ( wildargs && narg1 == nwildargs ) wild = s;
2652 }
2653 }
2654 /*[12dec2003 mt]:*/
2655 /*else if ( *s == ',' || *s == '|' ) {*/
2656 else if (set_in(*s,AC.separators)) {/*Function set_in see in
2657 file tools.c*/
2658 /*:[12dec2003 mt]*/
2659 *s = 0; narg1++;
2660 if ( wildargs && narg1 == nwildargs ) wild = s;
2661 }
2662 else if ( *s == '\\' ) s++;
2663 s++;
2664 } while ( bralevel > 0 );
2665 if ( wildargs && narg1 >= narg2-1 ) {
2666 inwildargs = narg1-narg2+1;
2667 if ( inwildargs == 0 ) nwildargs = 0;
2668 else {
2669 while ( inwildargs > 1 ) {
2670 *wild = ',';
2671 while ( *wild ) wild++;
2672 inwildargs--;
2673 }
2674 }
2675 }
2676 else if ( narg1 != narg2 && ( narg2 != 0 || narg1 != 1 || *args1 != 0 ) ) {
2677 MesPrint("@Arguments of procedure %s are not matching",p->name);
2678 return(-1);
2679 }
2680 numpre = -NumPre-1; /* For the stream */
2681 for ( i = 0; i < narg2; i++ ) {
2682 t = args2;
2683 if ( *t == '?' ) {
2684 args2++;
2685 }
2686 if ( *t == '?' && inwildargs == 0 ) {
2687 args2 = EndOfToken(args2); c = *args2; *args2 = 0;
2688 if ( PutPreVar(t,(UBYTE *)"",0,0) < 0 ) return(-1);
2689 }
2690 else {
2691 args2 = EndOfToken(args2); c = *args2; *args2 = 0;
2692 t1 = t2 = args1;
2693 while ( *t1 ) {
2694 if ( *t1 == '\\' ) t1++;
2695 if ( t1 != t2 ) *t2 = *t1;
2696 t2++; t1++;
2697 }
2698 *t2 = 0;
2699 if ( PutPreVar(t,args1,0,0) < 0 ) return(-1);
2700 args1 = t1+1; /* Next argument */
2701 }
2702 *args2 = c; SKIPBLANKS(args2) /* skip to next name */
2703 args2++; SKIPBLANKS(args2)
2704 }
2705 streamoffset = AC.CurrentStream - AC.Streams;
2706 args1 = AC.CurrentStream->name;
2707 AC.CurrentStream->name = p->name;
2708 i1 = AC.CurrentStream->linenumber;
2709 i2 = AC.CurrentStream->prevline;
2710 AC.CurrentStream->prevline =
2711 AC.CurrentStream->linenumber = 2;
2712 OpenStream(u+1,PREREADSTREAM3,numpre,PRENOACTION);
2713 AC.Streams[streamoffset].name = args1;
2714 AC.Streams[streamoffset].linenumber = i1;
2715 AC.Streams[streamoffset].prevline = i2;
2716 AddToPreTypes(PRETYPEPROCEDURE);
2717 return(0);
2718wrongfile:;
2719 if ( i < 0 ) MesPrint("@File %s is not a proper procedure",p->name);
2720 else MesPrint("!!!Internal error with procedure names: %s",name);
2721 return(-1);
2722}
2723
2724/*
2725 #] DoCall :
2726 #[ DoDebug :
2727*/
2728
2729int DoDebug(UBYTE *s)
2730{
2731 int x;
2732 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2733 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2734 NeedNumber(x,s,nonumber)
2735 if ( x < 0 || x >(PREPROONLY
2736 | DUMPTOCOMPILER
2737 | DUMPOUTTERMS
2738 | DUMPINTERMS
2739 | DUMPTOSORT
2740 | DUMPTOPARALLEL
2741#ifdef WITHPTHREADS
2742 | THREADSDEBUG
2743#endif
2744 ) ) goto nonumber;
2745 AP.PreDebug = 0;
2746 if ( ( x & PREPROONLY ) != 0 ) AP.PreDebug |= PREPROONLY; /* 1 */
2747 if ( ( x & DUMPTOCOMPILER ) != 0 ) AP.PreDebug |= DUMPTOCOMPILER; /* 2 */
2748 if ( ( x & DUMPOUTTERMS ) != 0 ) AP.PreDebug |= DUMPOUTTERMS; /* 4 */
2749 if ( ( x & DUMPINTERMS ) != 0 ) AP.PreDebug |= DUMPINTERMS; /* 8 */
2750 if ( ( x & DUMPTOSORT ) != 0 ) AP.PreDebug |= DUMPTOSORT; /* 16 */
2751 if ( ( x & DUMPTOPARALLEL ) != 0 ) AP.PreDebug |= DUMPTOPARALLEL; /* 32 */
2752#ifdef WITHPTHREADS
2753 if ( ( x & THREADSDEBUG ) != 0 ) AP.PreDebug |= THREADSDEBUG; /* 64 */
2754#endif
2755 return(0);
2756nonumber:
2757 MesPrint("@Illegal argument for debug instruction");
2758 return(1);
2759}
2760
2761/*
2762 #] DoDebug :
2763 #[ DoTerminate :
2764*/
2765
2766int DoTerminate(UBYTE *s)
2767{
2768 int x;
2769 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2770 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2771 if ( *s ) {
2772 NeedNumber(x,s,nonumber)
2773 Terminate(x);
2774 }
2775 else {
2776 Terminate(-1);
2777 }
2778 return(0);
2779nonumber:
2780 MesPrint("@Illegal argument for terminate instruction");
2781 return(1);
2782}
2783
2784/*
2785 #] DoTerminate :
2786 #[ DoContinueDo :
2787*/
2788
2800int DoContinueDo(UBYTE *s)
2801{
2802 DOLOOP *loop;
2803 WORD levels;
2804 int result;
2805
2806 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2807 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2808
2809 if ( NumDoLoops <= 0 ) {
2810 MesPrint("@%#continuedo without %#do");
2811 return(1);
2812 }
2813
2814 SkipSpaces(&s);
2815 if ( *s == 0 ) {
2816 levels = 1;
2817 }
2818 else if ( FG.cTable[*s] == 1 ) {
2819 ParseNumber(levels,s);
2820 SkipSpaces(&s);
2821 if ( *s != 0 ) goto improper;
2822 }
2823 else {
2824improper:
2825 MesPrint("@Improper syntax of %#continuedo instruction");
2826 return(1);
2827 }
2828
2829 if ( levels > NumDoLoops ) {
2830 MesPrint("@Too many loop levels requested in %#continuedo instruction");
2831 return(1);
2832 }
2833
2834 result = ExitDoLoops(levels-1,"continuedo");
2835 if ( result != 0 ) return(result);
2836
2837 if ( levels <= 0 ) return(0);
2838
2839 if ( AC.CurrentStream->type == PREREADSTREAM3
2840 || AP.PreTypes[AP.NumPreTypes] == PRETYPEPROCEDURE ) {
2841 MesPrint("@Trying to jump out of a procedure with a %#continuedo instruction");
2842 return(1);
2843 }
2844
2845 loop = &(DoLoops[NumDoLoops-1]);
2846 AP.NumPreTypes = loop->NumPreTypes+1;
2847 AP.PreIfLevel = loop->PreIfLevel;
2848 AP.PreSwitchLevel = loop->PreSwitchLevel;
2849
2850 return(DoEnddo(s));
2851}
2852
2853/*
2854 #] DoContinueDo :
2855 #[ DoDo :
2856
2857 The do loop has three varieties:
2858 #do i = num1,num2 [,num3]
2859 #do i = {string1,string2,....,stringn}
2860 The | as separator is also allowed for backwards compatibility
2861 #do i = expression One by one all terms of the expression
2862*/
2863
2864int DoDo(UBYTE *s)
2865{
2866 GETIDENTITY
2867 UBYTE *t, c, *u, *uu;
2868 DOLOOP *loop;
2869 WORD expnum;
2870 LONG linenum = AC.CurrentStream->linenumber;
2871 int oldNoShowInput = AC.NoShowInput, i, oldpreassignflag;
2872
2873 if ( ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH )
2874 || ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) ) {
2875 if ( PreSkip((UBYTE *)"do",(UBYTE *)"enddo",1) ) return(-1);
2876 return(0);
2877 }
2878
2879/*
2880 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2881 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2882*/
2883 AddToPreTypes(PRETYPEDO);
2884
2885 loop = (DOLOOP *)FromList(&AP.LoopList);
2886 loop->firstdollar = loop->lastdollar = loop->incdollar = -1;
2887 loop->NumPreTypes = AP.NumPreTypes-1;
2888 loop->PreIfLevel = AP.PreIfLevel;
2889 loop->PreSwitchLevel = AP.PreSwitchLevel;
2890 AC.NoShowInput = 1;
2891 if ( PreLoad(&(loop->p),(UBYTE *)"do",(UBYTE *)"enddo",1,"doloop") ) return(-1);
2892 AC.NoShowInput = oldNoShowInput;
2893 loop->NoShowInput = AC.NoShowInput;
2894/*
2895 Get now the name. We have to take great care when the name is terminated!
2896*/
2897 s = loop->p.buffer + (s - AP.preStart);
2898 SKIPBLANKS(s)
2899 loop->name = s;
2900 if ( chartype[*s] != 0 ) goto illname;
2901 s++;
2902 while ( chartype[*s] <= 1 ) s++;
2903 t = s;
2904 while ( *s == ' ' || *s == '\t' ) s++;
2905 if ( *s != '=' ) goto illdo;
2906 s++;
2907 while ( *s == ' ' || *s == '\t' ) s++;
2908 *t = 0;
2909
2910 if ( *s == '{' ) {
2911 loop->type = LISTEDLOOP;
2912 s++; loop->vars = s;
2913 loop->lastnum = 0;
2914 while ( *s != '}' && *s != 0 ) {
2915 if ( set_in(*s,AC.separators) ) { *s = 0; loop->lastnum++; }
2916 else if ( *s == '\\' ) s++;
2917 s++;
2918 }
2919 if ( *s == 0 ) goto illdo;
2920 *s++ = 0;
2921 loop->lastnum++;
2922 loop->firstnum = 0;
2923 loop->contents = s;
2924 }
2925 else if ( *s == '-' || *s == '+' || chartype[*s] == 1 || *s == '$' ) {
2926 loop->type = NUMERICALLOOP;
2927 t = s;
2928 while ( *s && *s != ',' ) s++;
2929 if ( *s == 0 ) goto illdo;
2930 if ( *t == '$' ) {
2931 c = *s; *s = 0;
2932 if ( GetName(AC.dollarnames,t+1,&loop->firstdollar,NOAUTO) != CDOLLAR ) {
2933 MesPrint("@%s is undefined in first parameter in %#do instruction",t);
2934 return(-1);
2935 }
2936 loop->firstnum = DolToLong(BHEAD loop->firstdollar);
2937 if ( AN.ErrorInDollar ) {
2938 MesPrint("@%s does not evaluate into a valid loop parameter",t);
2939 return(-1);
2940 }
2941 *s++ = c;
2942 }
2943 else {
2944 *s = '}';
2945 if ( PreEval(t,&loop->firstnum) == 0 ) goto illdo;
2946 *s++ = ',';
2947 }
2948 t = s;
2949 while ( *s && *s != ',' && *s != ';' && *s != LINEFEED ) s++;
2950 c = *s;
2951 if ( *t == '$' ) {
2952 *s = 0;
2953 if ( GetName(AC.dollarnames,t+1,&loop->lastdollar,NOAUTO) != CDOLLAR ) {
2954 MesPrint("@%s is undefined in second parameter in %#do instruction",t);
2955 return(-1);
2956 }
2957 loop->lastnum = DolToLong(BHEAD loop->lastdollar);
2958 if ( AN.ErrorInDollar ) {
2959 MesPrint("@%s does not evaluate into a valid loop parameter",t);
2960 return(-1);
2961 }
2962 *s++ = c;
2963 }
2964 else {
2965 *s = '}';
2966 if ( PreEval(t,&loop->lastnum) == 0 ) goto illdo;
2967 *s++ = c;
2968 }
2969 if ( c == ',' ) {
2970 t = s;
2971 while ( *s && *s != ';' && *s != LINEFEED ) s++;
2972 if ( *t == '$' ) {
2973 c = *s; *s = 0;
2974 if ( GetName(AC.dollarnames,t+1,&loop->incdollar,NOAUTO) != CDOLLAR ) {
2975 MesPrint("@%s is undefined in third parameter in %#do instruction",t);
2976 return(-1);
2977 }
2978 loop->incnum = DolToLong(BHEAD loop->incdollar);
2979 if ( AN.ErrorInDollar ) {
2980 MesPrint("@%s does not evaluate into a valid loop parameter",t);
2981 return(-1);
2982 }
2983 *s++ = c;
2984 }
2985 else {
2986 c = *s; *s = '}';
2987 if ( PreEval(t,&loop->incnum) == 0 ) goto illdo;
2988 *s++ = c;
2989 }
2990 }
2991 else loop->incnum = 1;
2992 loop->contents = s;
2993 }
2994 else if ( ( chartype[*s] == 0 ) || ( *s == '[' ) ) {
2995 int oldNumPotModdollars = NumPotModdollars;
2996#ifdef WITHMPI
2997 WORD oldRhsExprInModuleFlag = AC.RhsExprInModuleFlag;
2998 AC.RhsExprInModuleFlag = 0;
2999#endif
3000 t = s;
3001 if ( ( s = SkipAName(s) ) == 0 ) goto illdo;
3002 c = *s; *s = 0;
3003 if ( GetName(AC.exprnames,t,&expnum,NOAUTO) == CEXPRESSION ) {
3004 loop->type = ONEEXPRESSION;
3005/*
3006 We should remember the expression by name for when it gets
3007 renumbered!!! If it gets deleted there will be a crash or at
3008 least the loop terminates.
3009*/
3010 loop->vars = t;
3011 }
3012 else goto illdo;
3013 if ( c == ',' || c == '\t' || c == ';' ) { s++; }
3014 else if ( c != 0 && c != '\n' ) goto illdo;
3015 while ( *s == ',' || *s == '\t' || *s == ';' ) s++;
3016 if ( *s != 0 && *s != '\n' ) goto illdo;
3017 loop->firstnum = 0;
3018 s++;
3019 loop->contents = s;
3020 loop->incnum = 0;
3021/*
3022 Next determine size of statement and allocate space
3023*/
3024 while ( *t ) t++;
3025 i = t - loop->vars;
3026 t = loop->name;
3027 while ( *t ) { t++; i++; }
3028 i += 4;
3029 loop->dollarname = Malloc1((LONG)i,"do-loop instruction");
3030/*
3031 Construct the statement
3032*/
3033 u = loop->dollarname;
3034 *u++ = '$'; t = loop->name; while ( *t ) *u++ = *t++;
3035 *u++ = '_'; uu = u; *u++ = '='; t = loop->vars;
3036 while ( *t ) *u++ = *t++;
3037 *t = 0; *u = 0;
3038/*
3039 Compile and put in dollar variable.
3040 Note that we remember the dollar by name and that this name ends in _
3041*/
3042 oldpreassignflag = AP.PreAssignFlag;
3043 AP.PreAssignFlag = 2;
3044 CompileStatement(loop->dollarname);
3045 if ( CatchDollar(0) ) {
3046 MesPrint("@Cannot load expression in do loop");
3047 return(-1);
3048 }
3049 AP.PreAssignFlag = oldpreassignflag;
3050 NumPotModdollars = oldNumPotModdollars;
3051#ifdef WITHMPI
3052 AC.RhsExprInModuleFlag = oldRhsExprInModuleFlag;
3053#endif
3054 *uu = 0;
3055 }
3056 else goto illdo; /* Syntax problems */
3057 loop->errorsinloop = 0;
3058/* loop->startlinenumber = linenum+1; 5-oct-2000 One too much? */
3059 loop->startlinenumber = linenum;
3060 PutPreVar(loop->name,(UBYTE *)"0",0,0);
3061 loop->firstloopcall = 1;
3062 return(DoEnddo(s));
3063illname:;
3064 MesPrint("@Improper name for do loop variable");
3065 return(-1);
3066illdo:;
3067 MesPrint("@Improper syntax in do loop instruction");
3068 return(-1);
3069}
3070
3071/*
3072 #] DoDo :
3073 #[ DoBreakDo :
3074
3075 #breakdo [num]
3076 jumps out of num #do-loops (if there are that many) (default is 1)
3077*/
3078
3079int DoBreakDo(UBYTE *s)
3080{
3081 WORD levels;
3082
3083 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3084 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3085
3086 if ( NumDoLoops <= 0 ) {
3087 MesPrint("@%#breakdo without %#do");
3088 return(1);
3089 }
3090/*
3091 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEDO ) { MessPreNesting(4); return(-1); }
3092*/
3093 while ( *s && ( *s == ',' || *s == ' ' || *s == '\t' ) ) s++;
3094 if ( *s == 0 ) {
3095 levels = 1;
3096 }
3097 else if ( FG.cTable[*s] == 1 ) {
3098 levels = 0;
3099 while ( *s >= '0' && *s <= '9' ) { levels = 10*levels + *s++ - '0'; }
3100 if ( *s != 0 ) goto improper;
3101 }
3102 else {
3103improper:
3104 MesPrint("@Improper syntax of %#breakdo instruction");
3105 return(1);
3106 }
3107 if ( levels > NumDoLoops ) {
3108 MesPrint("@Too many loop levels requested in %#breakdo instruction");
3109 Terminate(-1);
3110 }
3111 return(ExitDoLoops(levels,"breakdo"));
3112}
3113
3121static int ExitDoLoops(int levels, const char *instruction)
3122{
3123 DOLOOP *loop;
3124 while ( levels > 0 ) {
3125 while ( AC.CurrentStream->type != PREREADSTREAM
3126 && AC.CurrentStream->type != PREREADSTREAM2
3127 && AC.CurrentStream->type != PREREADSTREAM3 ) {
3128 AC.CurrentStream = CloseStream(AC.CurrentStream);
3129 }
3130 while ( AP.PreTypes[AP.NumPreTypes] != PRETYPEDO
3131 && AP.PreTypes[AP.NumPreTypes] != PRETYPEPROCEDURE ) AP.NumPreTypes--;
3132 if ( AC.CurrentStream->type == PREREADSTREAM3
3133 || AP.PreTypes[AP.NumPreTypes] == PRETYPEPROCEDURE ) {
3134 MesPrint("@Trying to jump out of a procedure with a %#%s instruction",instruction);
3135 return(1);
3136 }
3137 loop = &(DoLoops[NumDoLoops-1]);
3138 AP.NumPreTypes = loop->NumPreTypes;
3139 AP.PreIfLevel = loop->PreIfLevel;
3140 AP.PreSwitchLevel = loop->PreSwitchLevel;
3141 NumDoLoops--;
3142 DoUndefine(loop->name);
3143 M_free(loop->p.buffer,"loop->p.buffer");
3144 loop->firstloopcall = 0;
3145
3146 AC.CurrentStream = CloseStream(AC.CurrentStream);
3147 levels--;
3148 }
3149 return(0);
3150}
3151
3152/*
3153 #] DoBreakDo :
3154 #[ DoElse :
3155*/
3156
3157int DoElse(UBYTE *s)
3158{
3159 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEIF ) {
3160 if ( AP.PreIfLevel <= 0 ) MesPrint("@%#else without corresponding %#if");
3161 else MessPreNesting(1);
3162 return(-1);
3163 }
3164 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3165 while ( *s == ' ' ) s++;
3166 if ( tolower(*s) == 'i' && tolower(s[1]) == 'f' && s[2]
3167 && FG.cTable[s[2]] > 1 && s[2] != '_' ) {
3168 s += 2;
3169 while ( *s == ' ' ) s++;
3170 return(DoElseif(s));
3171 }
3172 if ( AP.PreIfLevel <= 0 ) {
3173 MesPrint("@%#else without corresponding %#if");
3174 return(-1);
3175 }
3176 switch ( AP.PreIfStack[AP.PreIfLevel] ) {
3177 case EXECUTINGIF:
3178 AP.PreIfStack[AP.PreIfLevel] = LOOKINGFORENDIF;
3179 break;
3180 case LOOKINGFORELSE:
3181 AP.PreIfStack[AP.PreIfLevel] = EXECUTINGIF;
3182 break;
3183 case LOOKINGFORENDIF:
3184 break;
3185 }
3186 return(0);
3187}
3188
3189/*
3190 #] DoElse :
3191 #[ DoElseif :
3192*/
3193
3194int DoElseif(UBYTE *s)
3195{
3196 int condition;
3197 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEIF ) {
3198 if ( AP.PreIfLevel <= 0 ) MesPrint("@%#elseif without corresponding %#if");
3199 else MessPreNesting(2);
3200 return(-1);
3201 }
3202 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3203 if ( AP.PreIfLevel <= 0 ) {
3204 MesPrint("@%#elseif without corresponding %#if");
3205 return(-1);
3206 }
3207 switch ( AP.PreIfStack[AP.PreIfLevel] ) {
3208 case EXECUTINGIF:
3209 AP.PreIfStack[AP.PreIfLevel] = LOOKINGFORENDIF;
3210 break;
3211 case LOOKINGFORELSE:
3212 if ( ( condition = EvalPreIf(s) ) < 0 ) return(-1);
3213 AP.PreIfStack[AP.PreIfLevel] = condition;
3214 break;
3215 case LOOKINGFORENDIF:
3216 break;
3217 }
3218 return(0);
3219}
3220
3221/*
3222 #] DoElseif :
3223 #[ DoEnddo :
3224
3225 At the first call there is no stream yet.
3226 After that we have to close the stream and start a new one.
3227*/
3228
3229int DoEnddo(UBYTE *s)
3230{
3231 GETIDENTITY
3232 DOLOOP *loop;
3233 UBYTE *t, *tt, *value, numstr[16];
3234 LONG xval;
3235 int xsign, retval;
3236 DUMMYUSE(s);
3237 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3238 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3239/*
3240 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ||
3241 AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) {
3242 if ( AP.PreTypes[AP.NumPreTypes] == PRETYPEDO ) AP.NumPreTypes--;
3243 else { MessPreNesting(3); return(-1); }
3244 return(0);
3245 }
3246*/
3247 if ( NumDoLoops <= 0 ) {
3248 MesPrint("@%#enddo without %#do");
3249 return(1);
3250 }
3251 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEDO ) { MessPreNesting(4); return(-1); }
3252 loop = &(DoLoops[NumDoLoops-1]);
3253 if ( !loop->firstloopcall ) AC.CurrentStream = CloseStream(AC.CurrentStream);
3254
3255 if ( loop->errorsinloop ) {
3256 MesPrint("++++Errors in Loop");
3257 goto finish;
3258 }
3259 if ( loop->type == LISTEDLOOP ) {
3260 if ( loop->firstnum >= loop->lastnum ) goto finish;
3261 loop->firstnum++;
3262 t = value = loop->vars;
3263 while ( *value ) value++;
3264 value++;
3265 loop->vars = value;
3266 value = tt = t;
3267 while ( *value ) {
3268 if ( *value == '\\' ) value++;
3269 *tt++ = *value++;
3270 }
3271 *tt = 0;
3272 PutPreVar(loop->name,t,0,1); /* We overwrite the definition */
3273 }
3274 else if ( loop->type == NUMERICALLOOP ) {
3275
3276 if ( !loop->firstloopcall ) {
3277/*
3278 Test whether the variable was changed inside the loop into
3279 a different numerical value. If so, adjust.
3280*/
3281 t = GetPreVar(loop->name,WITHOUTERROR);
3282 if ( t ) {
3283 value = t;
3284 xsign = 1;
3285 while ( *value && ( *value == ' '
3286 || *value == '-' || *value == '+' ) ) {
3287 if ( *value == '-' ) xsign = -xsign;
3288 value++;
3289 }
3290 t = value; xval = 0;
3291 while ( *value >= '0' && *value <= '9' ) xval = 10*xval + *value++ - '0';
3292 while ( *value && *value == ' ' ) value++;
3293 if ( *value == 0 ) {
3294/*
3295 Now we may substitute the loopvalue.
3296*/
3297 if ( xsign < 0 ) xval = -xval;
3298 if ( loop->incdollar >= 0 ) {
3299 loop->incnum = DolToLong(BHEAD loop->incdollar);
3300 if ( AN.ErrorInDollar ) {
3301 MesPrint("@%s does not evaluate into a valid third loop parameter",DOLLARNAME(Dollars,loop->incdollar));
3302 return(-1);
3303 }
3304 }
3305 loop->firstnum = xval + loop->incnum;
3306 }
3307 }
3308 if ( loop->lastdollar >= 0 ) {
3309 loop->lastnum = DolToLong(BHEAD loop->lastdollar);
3310 if ( AN.ErrorInDollar ) {
3311 MesPrint("@%s does not evaluate into a valid second loop parameter",DOLLARNAME(Dollars,loop->lastdollar));
3312 return(-1);
3313 }
3314 }
3315 }
3316 if ( ( loop->incnum > 0 && loop->firstnum > loop->lastnum )
3317 || ( loop->incnum < 0 && loop->firstnum < loop->lastnum ) ) goto finish;
3318 NumToStr(numstr,loop->firstnum);
3319 t = numstr;
3320 loop->firstnum += loop->incnum;
3321 PutPreVar(loop->name,t,0,1); /* We overwrite the definition */
3322 }
3323 else if ( loop->type == ONEEXPRESSION ) {
3324/*
3325 Find the dollar expression
3326*/
3327 WORD numdollar = GetDollar(loop->dollarname+1);
3328 DOLLARS d = Dollars + numdollar;
3329 WORD *w, *dw, v, *ww;
3330 if ( (d->where) == 0 ) {
3331 d->type = DOLUNDEFINED;
3332 M_free(loop->dollarname,"do-loop instruction");
3333 goto finish;
3334 }
3335 w = d->where + loop->incnum;
3336 if ( *w == 0 ) {
3337 M_free(d->where,"dollar");
3338 d->where = 0;
3339 d->type = DOLUNDEFINED;
3340 M_free(loop->dollarname,"do-loop instruction");
3341 goto finish;
3342 }
3343 loop->incnum += *w;
3344/*
3345 Now the term has to be converted to text.
3346*/
3347 ww = w + *w; v = *ww; *ww = 0;
3348 dw = d->where; d->where = w;
3349 t = WriteDollarToBuffer(numdollar,1);
3350 d->where = dw; *ww = v;
3351 PutPreVar(loop->name,t,0,1); /* We overwrite the definition */
3352 M_free(t,"dollar");
3353 }
3354 if ( loop->firstloopcall ) OpenStream(loop->contents,PREREADSTREAM2,0,PRENOACTION);
3355 else OpenStream(loop->contents,PREREADSTREAM,0,PRENOACTION);
3356 AC.CurrentStream->prevline =
3357 AC.CurrentStream->linenumber = loop->startlinenumber;
3358 AC.CurrentStream->eqnum = 0;
3359 loop->firstloopcall = 0;
3360 return(0);
3361finish:;
3362 NumDoLoops--;
3363 retval = DoUndefine(loop->name);
3364 M_free(loop->p.buffer,"loop->p.buffer");
3365 loop->firstloopcall = 0;
3366 AP.NumPreTypes--;
3367 return(retval);
3368}
3369
3370/*
3371 #] DoEnddo :
3372 #[ DoEndif :
3373*/
3374
3375int DoEndif(UBYTE *s)
3376{
3377 DUMMYUSE(s);
3378 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEIF ) {
3379 if ( AP.PreIfLevel <= 0 ) MesPrint("@%#endif without corresponding %#if");
3380 else MessPreNesting(5);
3381 return(-1);
3382 }
3383 AP.NumPreTypes--;
3384 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3385 if ( AP.PreIfLevel <= 0 ) {
3386 MesPrint("@%#endif without corresponding %#if");
3387 return(-1);
3388 }
3389 AP.PreIfLevel--;
3390 return(0);
3391}
3392
3393/*
3394 #] DoEndif :
3395 #[ DoEndprocedure :
3396
3397 Action is simple: close the current stream if it is still
3398 the stream from which the statement came.
3399 Then pop the current procedure and all its local derivatives.
3400 if loadmode > 1 the procedure was defined locally.
3401*/
3402
3403int DoEndprocedure(UBYTE *s)
3404{
3405 DUMMYUSE(s);
3406 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEPROCEDURE ) {
3407 MessPreNesting(6);
3408 return(-1);
3409 }
3410 AP.NumPreTypes--;
3411 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3412 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3413 AC.CurrentStream = CloseStream(AC.CurrentStream);
3414
3415 do {
3416 NumProcedures--;
3417 if ( Procedures[NumProcedures].mustfree == 1 ) {
3418 M_free(Procedures[NumProcedures].p.buffer,"procedures buffer");
3419 M_free(Procedures[NumProcedures].name,"procedures name");
3420 }
3421 } while ( Procedures[NumProcedures].loadmode > 1 );
3422 return(0);
3423}
3424
3425/*
3426 #] DoEndprocedure :
3427 #[ DoIf :
3428*/
3429
3430int DoIf(UBYTE *s)
3431{
3432 int condition;
3433 AddToPreTypes(PRETYPEIF);
3434 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3435 if ( AP.PreIfStack[AP.PreIfLevel] == EXECUTINGIF ) {
3436 condition = EvalPreIf(s);
3437 if ( condition < 0 ) return(-1);
3438 }
3439 else condition = LOOKINGFORENDIF;
3440 if ( AP.PreIfLevel+1 >= AP.MaxPreIfLevel ) {
3441 int **ppp = &AP.PreIfStack; /* To avoid a compiler warning */
3442 if ( DoubleList((void ***)ppp,&AP.MaxPreIfLevel,sizeof(int),
3443 "PreIfLevels") ) return(-1);
3444 }
3445 AP.PreIfStack[++AP.PreIfLevel] = condition;
3446 return(0);
3447}
3448
3449/*
3450 #] DoIf :
3451 #[ DoIfdef :
3452*/
3453
3454int DoIfdef(UBYTE *s, int par)
3455{
3456 int condition;
3457 AddToPreTypes(PRETYPEIF);
3458 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3459 if ( AP.PreIfStack[AP.PreIfLevel] == EXECUTINGIF ) {
3460 while ( *s == ' ' || *s == '\t' ) s++;
3461 if ( ( *s == 0 ) == ( par == 1 ) ) condition = LOOKINGFORELSE;
3462 else condition = EXECUTINGIF;
3463 }
3464 else condition = LOOKINGFORENDIF;
3465 if ( AP.PreIfLevel+1 >= AP.MaxPreIfLevel ) {
3466 int **ppp = &AP.PreIfStack; /* to avoid a compiler warning */
3467 if ( DoubleList((void ***)ppp,&AP.MaxPreIfLevel,sizeof(int),
3468 "PreIfLevels") ) return(-1);
3469 }
3470 AP.PreIfStack[++AP.PreIfLevel] = condition;
3471 return(0);
3472}
3473
3474/*
3475 #] DoIfdef :
3476 #[ DoIfydef :
3477*/
3478
3479int DoIfydef(UBYTE *s)
3480{
3481 return DoIfdef(s,1);
3482}
3483
3484/*
3485 #] DoIfydef :
3486 #[ DoIfndef :
3487*/
3488
3489int DoIfndef(UBYTE *s)
3490{
3491 return DoIfdef(s,2);
3492}
3493
3494/*
3495 #] DoIfndef :
3496 #[ DoInside :
3497
3498 #inside $var1,...,$varn
3499 statements without .sort
3500 #endinside
3501
3502 executes the statements on the contents of the $ variables as if they
3503 are a module. The results are put back in the dollar variables.
3504 To do this right we need a struct with
3505 old compiler buffer
3506 list of numbers of dollars
3507 length of the list
3508 length of the array containing the list
3509 Because we need to compose statements, the statement buffer must be
3510 empty. This means that we have to test for that. Same at the end. We
3511 must have a completed statement.
3512*/
3513
3514int DoInside(UBYTE *s)
3515{
3516 GETIDENTITY
3517 int numdol, error = 0;
3518 WORD *nb, newsize, i;
3519 UBYTE *name, c;
3520 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3521 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3522 if ( AP.PreInsideLevel != 0 ) {
3523 MesPrint("@Illegal nesting of %#inside/%#endinside instructions");
3524 return(-1);
3525 }
3526/*
3527 if ( AP.PreContinuation ) {
3528 error = -1;
3529 MesPrint("@%#inside cannot be inside a regular statement");
3530 }
3531*/
3532 PUSHPREASSIGNLEVEL
3533/*
3534 Now the dollars to do
3535*/
3536 AP.inside.numdollars = 0;
3537 for(;;) {
3538 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
3539 if ( *s == 0 ) break;
3540 if ( *s != '$' ) {
3541 MesPrint("@%#inside instruction can have only $ variables for parameters");
3542 return(-1);
3543 }
3544 s++;
3545 name = s;
3546 while (chartype[*s] <= 1 ) s++;
3547 c = *s; *s = 0;
3548 if ( ( numdol = GetDollar(name) ) < 0 ) {
3549 MesPrint("@%#inside: $%s has not (yet) been defined",name);
3550 *s = c;
3551 error = -1;
3552 }
3553 else {
3554 *s = c;
3555 if ( AP.inside.numdollars >= AP.inside.size ) {
3556 if ( AP.inside.buffer == 0 ) newsize = 20;
3557 else newsize = 2*AP.inside.size;
3558 nb = (WORD *)Malloc1(newsize*sizeof(WORD),"insidebuffer");
3559 if ( AP.inside.buffer ) {
3560 for ( i = 0; i < AP.inside.size; i++ ) nb[i] = AP.inside.buffer[i];
3561 M_free(AP.inside.buffer,"insidebuffer");
3562 }
3563 AP.inside.buffer = nb;
3564 AP.inside.size = newsize;
3565 }
3566 AP.inside.buffer[AP.inside.numdollars++] = numdol;
3567 }
3568 }
3569/*
3570 We have to store the configuration of the compiler buffer, so that
3571 we know where to start executing and how to reset the buffer.
3572*/
3573 AP.inside.oldcompiletype = AC.compiletype;
3574 AP.inside.oldparallelflag = AC.mparallelflag;
3575 AP.inside.oldnumpotmoddollars = NumPotModdollars;
3576 AP.inside.oldcbuf = AC.cbufnum;
3577 AP.inside.oldrbuf = AM.rbufnum;
3578 AP.inside.oldcnumlhs = AR.Cnumlhs,
3579 AddToPreTypes(PRETYPEINSIDE);
3580 AP.PreInsideLevel = 1;
3581 AC.cbufnum = AP.inside.inscbuf;
3582 AM.rbufnum = AP.inside.inscbuf;
3583 clearcbuf(AC.cbufnum);
3584 AC.compiletype = 0;
3585 AC.mparallelflag = PARALLELFLAG;
3586#ifdef WITHMPI
3587 /*
3588 * We use AC.RhsExprInModuleFlag, PotModdollars, and AC.pfirstnum
3589 * in order to check (1) whether there are expression names in RHS,
3590 * (2) which dollar variables can be modified, and (3) which
3591 * preprocessor variables can be redefined, in #inside.
3592 * We store the current values of them, and then reset them.
3593 */
3594 PF_StoreInsideInfo();
3595 AC.RhsExprInModuleFlag = 0;
3596 NumPotModdollars = 0;
3597 AC.numpfirstnum = 0;
3598#endif
3599 return(error);
3600}
3601
3602/*
3603 #] DoInside :
3604 #[ DoEndInside :
3605*/
3606
3607int DoEndInside(UBYTE *s)
3608{
3609 GETIDENTITY
3610 WORD numdol, *oldworkpointer = AT.WorkPointer, *term, *t, j, i;
3611 DOLLARS d, nd;
3612 WORD oldbracketon = AR.BracketOn;
3613 WORD *oldcompresspointer = AR.CompressPointer;
3614 int oldmultithreaded = AS.MultiThreaded;
3615 /* int oldmparallelflag = AC.mparallelflag; */
3616 FILEHANDLE *f;
3617#ifdef WITHMPI
3618 int error = 0;
3619#endif
3620 DUMMYUSE(s);
3621 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3622 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3623 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEINSIDE ) {
3624 if ( AP.PreInsideLevel != 1 ) MesPrint("@%#endinside without corresponding %#inside");
3625 else MessPreNesting(11);
3626 return(-1);
3627 }
3628 AP.NumPreTypes--;
3629 if ( AP.PreInsideLevel != 1 ) {
3630 MesPrint("@%#endinside without corresponding %#inside");
3631 return(-1);
3632 }
3633 if ( AP.PreContinuation ) {
3634 MesPrint("@%#endinside: previous statement not terminated.");
3635 Terminate(-1);
3636 }
3637 AC.compiletype = AP.inside.oldcompiletype;
3638 AR.Cnumlhs = cbuf[AM.rbufnum].numlhs;
3639#ifdef WITHMPI
3640 /*
3641 * If the #inside...#endinside contains expressions in RHS, only the master executes it
3642 * and then broadcasts the result to the all slaves. If not, the all processes execute
3643 * it and in this case no MPI interactions are needed.
3644 */
3645 if ( PF.me == MASTER || !AC.RhsExprInModuleFlag ) {
3646#endif
3647 AR.BracketOn = 0;
3648 AS.MultiThreaded = 0;
3649 /* AC.mparallelflag = PARALLELFLAG; */
3650 if ( AR.CompressPointer == 0 ) AR.CompressPointer = AR.CompressBuffer;
3651 f = AR.infile; AR.infile = AR.outfile; AR.outfile = f;
3652/*
3653 Now we have to execute the statements on the proper dollars.
3654*/
3655 for ( i = 0; i < AP.inside.numdollars; i++ ) {
3656 numdol = AP.inside.buffer[i];
3657 nd = d = Dollars + numdol;
3658 if ( d->type != DOLZERO ) {
3659 if ( d->type != DOLTERMS ) nd = DolToTerms(BHEAD numdol);
3660 term = nd->where;
3661 NewSort(BHEAD0);
3662 NewSort(BHEAD0);
3663 AR.MaxDum = AM.IndDum;
3664 while ( *term ) {
3665 t = oldworkpointer; j = *term;
3666 NCOPY(t,term,j);
3667 AT.WorkPointer = t;
3668 AN.IndDum = AM.IndDum;
3669 AR.CurDum = ReNumber(BHEAD term);
3670 if ( Generator(BHEAD oldworkpointer,0) ) {
3671 MesPrint("@Called from %#endinside");
3672 MesPrint("@Evaluating variable $%s",DOLLARNAME(Dollars,numdol));
3673 Terminate(-1);
3674 }
3675 }
3676 AT.WorkPointer = oldworkpointer;
3677 CleanDollarFactors(d);
3678 if ( d->where ) { M_free(d->where,"dollar contents"); d->where = 0; }
3679 EndSort(BHEAD (WORD *)((void *)(&(d->where))),2);
3680 LowerSortLevel();
3681 term = d->where; while ( *term ) term += *term;
3682 d->size = term - d->where;
3683 if ( nd != d ) M_free(nd,"Copy of dollar variable");
3684 if ( d->where[0] == 0 ) {
3685 M_free(d->where,"dollar contents"); d->where = 0;
3686 d->type = DOLZERO;
3687 }
3688 }
3689 }
3690#ifdef WITHMPI
3691 }
3692 if ( AC.RhsExprInModuleFlag ) {
3693 /*
3694 * The only master executed the statements in #inside.
3695 * We need to broadcast the result to the all slaves.
3696 */
3697 for ( i = 0; i < AP.inside.numdollars; i++ ) {
3698 /*
3699 * Mark $-variables specified in the #inside instruction as modified
3700 * such that they will be broadcast.
3701 */
3702 AddPotModdollar(AP.inside.buffer[i]);
3703 }
3704 /* Now actual broadcast of modified variables. */
3705 if ( NumPotModdollars > 0 ) {
3706 error = PF_BroadcastModifiedDollars();
3707 if ( error ) goto cleanup;
3708 }
3709 if ( AC.numpfirstnum > 0 ) {
3710 error = PF_BroadcastRedefinedPreVars();
3711 if ( error ) goto cleanup;
3712 }
3713 }
3714cleanup:
3715#endif
3716 f = AR.infile; AR.infile = AR.outfile; AR.outfile = f;
3717 AC.cbufnum = AP.inside.oldcbuf;
3718 AM.rbufnum = AP.inside.oldrbuf;
3719 AR.Cnumlhs = AP.inside.oldcnumlhs;
3720 AR.BracketOn = oldbracketon;
3721 AP.PreInsideLevel = 0;
3722 AR.CompressPointer = oldcompresspointer;
3723 AS.MultiThreaded = oldmultithreaded;
3724 AC.mparallelflag = AP.inside.oldparallelflag;
3725 NumPotModdollars = AP.inside.oldnumpotmoddollars;
3726 POPPREASSIGNLEVEL
3727#ifdef WITHMPI
3728 PF_RestoreInsideInfo();
3729 if ( error ) return error;
3730#endif
3731 return(0);
3732}
3733
3734/*
3735 #] DoEndInside :
3736 #[ DoMessage :
3737*/
3738
3739int DoMessage(UBYTE *s)
3740{
3741 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3742 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3743 while ( *s == ' ' || *s == '\t' ) s++;
3744 MesPrint("~~~%s",s);
3745 return(0);
3746}
3747
3748/*
3749 #] DoMessage :
3750 #[ DoPipe :
3751*/
3752
3753int DoPipe(UBYTE *s)
3754{
3755#ifndef WITHPIPE
3756 DUMMYUSE(s);
3757#endif
3758 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3759 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3760#ifdef WITHPIPE
3761 FLUSHCONSOLE;
3762 while ( *s == ' ' || *s == '\t' ) s++;
3763 if ( OpenStream(s,PIPESTREAM,0,PRENOACTION) == 0 ) return(-1);
3764 return(0);
3765#else
3766 Error0("Pipes not implemented on this computer/system");
3767 return(-1);
3768#endif
3769}
3770
3771/*
3772 #] DoPipe :
3773 #[ DoPrcExtension :
3774*/
3775
3776int DoPrcExtension(UBYTE *s)
3777{
3778 UBYTE *t, *u, c;
3779 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3780 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3781 while ( *s == ' ' || *s == '\t' ) s++;
3782 if ( *s == 0 || *s == '\n' ) {
3783 MesPrint("@No valid procedure extension specified");
3784 return(-1);
3785 }
3786 if ( FG.cTable[*s] != 0 ) {
3787 MesPrint("@Procedure extension should be a string starting with an alphabetic character. No whitespace.");
3788 return(-1);
3789 }
3790 t = s;
3791 while ( *s && *s != '\n' && *s != ' ' && *s != '\t' ) s++;
3792 u = s;
3793 while ( *s == ' ' || *s == '\t' ) s++;
3794 if ( *s != 0 && *s != '\n' ) {
3795 MesPrint("@Too many parameters in ProcedureExtension instruction");
3796 return(-1);
3797 }
3798 c = *u; *u = 0;
3799 if ( AP.procedureExtension ) M_free(AP.procedureExtension,"ProcedureExtension");
3800 AP.procedureExtension = strDup1(t,"ProcedureExtension");
3801 *u = c;
3802 return(0);
3803}
3804
3805/*
3806 #] DoPrcExtension :
3807 #[ DoPreOut :
3808*/
3809
3810int DoPreOut(UBYTE *s)
3811{
3812 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3813 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3814 if ( tolower(*s) == 'o' ) {
3815 if ( tolower(s[1]) == 'n' && s[2] == 0 ) {
3816 AP.PreOut = 1;
3817 return(0);
3818 }
3819 if ( tolower(s[1]) == 'f' && tolower(s[2]) == 'f' && s[3] == 0 ) {
3820 AP.PreOut = 0;
3821 return(0);
3822 }
3823 }
3824 MesPrint("@Illegal option in PreOut instruction");
3825 return(-1);
3826}
3827
3828/*
3829 #] DoPreOut :
3830 #[ DoPrePrintTimes :
3831*/
3832
3833int DoPrePrintTimes(UBYTE *s)
3834{
3835 DUMMYUSE(s);
3836 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3837 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3838 PrintRunningTime();
3839 return(0);
3840}
3841
3842/*
3843 #] DoPrePrintTimes :
3844 #[ DoPreSortReallocate :
3845*/
3846
3847int DoPreSortReallocate(UBYTE *s)
3848{
3849 DUMMYUSE(s);
3850 if ( AC.SortReallocateFlag == 0 ) {
3851 /* Currently off, so set to 2. Then the reallocation code knows the flag was
3852 set here, since "On sortreallocate;" sets it to 1. */
3853 AC.SortReallocateFlag = 2;
3854 }
3855 /* If the flag is already on, do nothing. */
3856 return(0);
3857}
3858
3859/*
3860 #] DoPreSortReallocate :
3861 #[ DoPreAppend :
3862
3863 Syntax:
3864 #append <filename>
3865*/
3866
3867int DoPreAppend(UBYTE *s)
3868{
3869 UBYTE *name, *to;
3870
3871 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3872 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3873 if ( AP.preError ) return(0);
3874 while ( *s == ' ' || *s == '\t' ) s++;
3875/*
3876 Determine where to write
3877*/
3878 if ( *s == '<' ) {
3879 s++;
3880 name = to = s;
3881 while ( *s && *s != '>' ) {
3882 if ( *s == '\\' ) s++;
3883 *to++ = *s++;
3884 }
3885 if ( *s == 0 ) {
3886 MesPrint("@Improper termination of filename");
3887 return(-1);
3888 }
3889 s++;
3890 *to = 0;
3891 if ( *name ) { GetAppendChannel((char *)name); }
3892 else goto improper;
3893 }
3894 else {
3895improper:
3896 MesPrint("@Proper syntax is: %#append <filename>");
3897 return(-1);
3898 }
3899 return(0);
3900}
3901
3902/*
3903 #] DoPreAppend :
3904 #[ DoPreCreate :
3905
3906 Syntax:
3907 #create <filename>
3908*/
3909
3910int DoPreCreate(UBYTE *s)
3911{
3912 UBYTE *name, *to;
3913
3914 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3915 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3916 if ( AP.preError ) return(0);
3917 while ( *s == ' ' || *s == '\t' ) s++;
3918/*
3919 Determine where to write
3920*/
3921 if ( *s == '<' ) {
3922 s++;
3923 name = to = s;
3924 while ( *s && *s != '>' ) {
3925 if ( *s == '\\' ) s++;
3926 *to++ = *s++;
3927 }
3928 if ( *s == 0 ) {
3929 MesPrint("@Improper termination of filename");
3930 return(-1);
3931 }
3932 s++;
3933 *to = 0;
3934 if ( *name ) { GetChannel((char *)name,0); }
3935 else goto improper;
3936 }
3937 else {
3938improper:
3939 MesPrint("@Proper syntax is: %#create <filename>");
3940 return(-1);
3941 }
3942 return(0);
3943}
3944
3945/*
3946 #] DoPreCreate :
3947 #[ DoPreRemove :
3948*/
3949
3950int DoPreRemove(UBYTE *s)
3951{
3952 UBYTE *name, *to;
3953 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3954 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3955 if ( AP.preError ) return(0);
3956 while ( *s == ' ' || *s == '\t' ) s++;
3957 if ( *s == '<' ) { s++; }
3958 else {
3959 MesPrint("@Proper syntax is: %#remove <filename>");
3960 return(-1);
3961 }
3962 name = to = s;
3963 while ( *s && *s != '>' ) {
3964 if ( *s == '\\' ) s++;
3965 *to++ = *s++;
3966 }
3967 if ( *s == 0 ) {
3968 MesPrint("@Improper filename");
3969 return(-1);
3970 }
3971 s++;
3972 *to = 0;
3973 CloseChannel((char *)name);
3974 remove((char *)name);
3975 return(0);
3976}
3977
3978/*
3979 #] DoPreRemove :
3980 #[ DoPreClose :
3981*/
3982
3983int DoPreClose(UBYTE *s)
3984{
3985 UBYTE *name, *to;
3986 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3987 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3988 if ( AP.preError ) return(0);
3989 while ( *s == ' ' || *s == '\t' ) s++;
3990 if ( *s == '<' ) { s++; }
3991 else {
3992 MesPrint("@Proper syntax is: %#close <filename>");
3993 return(-1);
3994 }
3995 name = to = s;
3996 while ( *s && *s != '>' ) {
3997 if ( *s == '\\' ) s++;
3998 *to++ = *s++;
3999 }
4000 if ( *s == 0 ) {
4001 MesPrint("@Improper filename");
4002 return(-1);
4003 }
4004 s++;
4005 *to = 0;
4006 return(CloseChannel((char *)name));
4007}
4008
4009/*
4010 #] DoPreClose :
4011 #[ DoPreWrite :
4012
4013 Syntax:
4014 #write [<filename>] "formatstring" [,objects]
4015 The format string can contain the following special objects/codes
4016 \n newline
4017 \t tab
4018 \! if last entry in string: no linefeed at end
4019 \b put \ in output
4020 %$ $-variable (to be found among the objects)
4021 %e expression (name to be found among the objects)
4022 %E expression without ; (name to be found among the objects)
4023 %s string (to be found among the objects) (with or without "")
4024 %S subterms (see PrintSubtermList)
4025*/
4026
4027int DoPreWrite(UBYTE *s)
4028{
4029 HANDLERS h;
4030
4031 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
4032 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4033 if ( AP.preError ) return(0);
4034
4035#ifdef WITHMPI
4036 if ( PF.me != MASTER ) return 0;
4037#endif
4038
4039 h.oldsilent = AM.silent;
4040 h.newlogonly = h.oldlogonly = AM.FileOnlyFlag;
4041 h.newhandle = h.oldhandle = AC.LogHandle;
4042 h.oldprinttype = AO.PrintType;
4043
4044 while ( *s == ' ' || *s == '\t' ) s++;
4045/*
4046 Determine where to write
4047*/
4048 if( (s=defineChannel(s,&h))==0 ) return(-1);
4049
4050 return(writeToChannel(WRITEOUT,s,&h));
4051}
4052
4053/*
4054 #] DoPreWrite :
4055 #[ DoProcedure :
4056
4057 We have to read this procedure into a buffer.
4058 The only complications are:
4059 1: we have to seek through the file to do this efficiently
4060 the file operations under VMS cannot do this properly
4061 (unless we use the proper ANSI structs?)
4062 This is the reason why we read whole input files under VMS.
4063 2: what to do when the same name is used twice.
4064 Note that we have to do the reading without substitution of
4065 preprocessor variables.
4066*/
4067
4068int DoProcedure(UBYTE *s)
4069{
4070 UBYTE c;
4071 PROCEDURE *p;
4072 LONG i;
4073 if ( ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH )
4074 || ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) ) {
4075 if ( PreSkip((UBYTE *)"procedure",(UBYTE *)"endprocedure",1) ) return(-1);
4076 return(0);
4077 }
4078 // AP.ProcList.num = NumProcedures is incremented inside FromList
4079 p = (PROCEDURE *)FromList(&AP.ProcList);
4080 if ( PreLoad(&(p->p),(UBYTE *)"procedure",(UBYTE *)"endprocedure"
4081 ,1,(char *)"procedure") ) return(-1);
4082
4083 // If the procedure below is not local (loadmode 0) or has been called (loadmode 1), this is a
4084 // nested procedure definition. We must free its allocations when we hit its DoEndprocedure.
4085 // If it seems local (loadmode 2) but is tagged as "mustfree", it is multiply nested and we
4086 // similarly must free its allocations.
4087 if ( NumProcedures >= 2 &&
4088 ( Procedures[NumProcedures-2].loadmode != 2 || Procedures[NumProcedures-2].mustfree ) ) {
4089 p->mustfree = 1;
4090 }
4091 // Otherwise, we are defining a local procedure at "ground level", and we keep the definition
4092 // on the procedure stack until FORM terminates.
4093 else {
4094 p->mustfree = 0;
4095 }
4096
4097 p->loadmode = 2;
4098 s = p->p.buffer + 10;
4099 while ( *s == ' ' || *s == LINEFEED ) s++;
4100 if ( chartype[*s] ) {
4101 MesPrint("@Illegal name for procedure");
4102 return(-1);
4103 }
4104 p->name = s++;
4105 while ( chartype[*s] == 0 || chartype[*s] == 1 ) s++;
4106 c = *s; *s = 0;
4107 p->name = strDup1(p->name,"procedure");
4108 *s = c;
4109/*
4110 Check for double names
4111*/
4112 for ( i = NumProcedures-2; i >= 0; i-- ) {
4113 if ( StrCmp(Procedures[i].name,p->name) == 0 ) {
4114 Error1("Multiple occurrence of procedure name ",p->name);
4115 }
4116 }
4117 return(0);
4118}
4119
4120/*
4121 #] DoProcedure :
4122 #[ DoPreBreak :
4123*/
4124
4125int DoPreBreak(UBYTE *s)
4126{
4127 DUMMYUSE(s);
4128 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4129 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPESWITCH ) {
4130 if ( AP.PreSwitchLevel <= 0 )
4131 MesPrint("@Break without corresponding Switch");
4132 else MessPreNesting(7);
4133 return(-1);
4134 }
4135 if ( AP.PreSwitchLevel <= 0 ) {
4136 MesPrint("@Break without corresponding Switch");
4137 return(-1);
4138 }
4139 if ( AP.PreSwitchModes[AP.PreSwitchLevel] == EXECUTINGPRESWITCH )
4140 AP.PreSwitchModes[AP.PreSwitchLevel] = SEARCHINGPREENDSWITCH;
4141 return(0);
4142}
4143
4144/*
4145 #] DoPreBreak :
4146 #[ DoPreCase :
4147*/
4148
4149int DoPreCase(UBYTE *s)
4150{
4151 UBYTE *t;
4152 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4153 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPESWITCH ) {
4154 if ( AP.PreSwitchLevel <= 0 )
4155 MesPrint("@Case without corresponding Switch");
4156 else MessPreNesting(8);
4157 return(-1);
4158 }
4159 if ( AP.PreSwitchLevel <= 0 ) {
4160 MesPrint("@Case without corresponding Switch");
4161 return(-1);
4162 }
4163 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != SEARCHINGPRECASE ) return(0);
4164
4165 SKIPBLANKS(s)
4166 t = s;
4167 while ( *s ) { if ( *s == '\\' ) s++; s++; }
4168 while ( s > t && ( s[-1] == ' ' || s[-1] == '\t' ) && s[-2] != '\\' ) {
4169 if ( s[-2] == '\\' ) s--;
4170 s--;
4171 }
4172 if ( *t == '"' && s > t+1 && s[-1] == '"' && s[-2] != '\\' ) {
4173 t++; s--; *s = 0;
4174 }
4175 else *s = 0;
4176 s = AP.PreSwitchStrings[AP.PreSwitchLevel];
4177 while ( *t == *s && *t ) { s++; t++; }
4178 if ( *t || *s ) return(0); /* case did not match */
4179 AP.PreSwitchModes[AP.PreSwitchLevel] = EXECUTINGPRESWITCH;
4180 return(0);
4181}
4182
4183/*
4184 #] DoPreCase :
4185 #[ DoPreDefault :
4186*/
4187
4188int DoPreDefault(UBYTE *s)
4189{
4190 DUMMYUSE(s);
4191 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4192 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPESWITCH ) {
4193 if ( AP.PreSwitchLevel <= 0 )
4194 MesPrint("@Default without corresponding Switch");
4195 else MessPreNesting(9);
4196 return(-1);
4197 }
4198 if ( AP.PreSwitchLevel <= 0 ) {
4199 MesPrint("@Default without corresponding Switch");
4200 return(-1);
4201 }
4202 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != SEARCHINGPRECASE ) return(0);
4203 AP.PreSwitchModes[AP.PreSwitchLevel] = EXECUTINGPRESWITCH;
4204 return(0);
4205}
4206
4207/*
4208 #] DoPreDefault :
4209 #[ DoPreEndSwitch :
4210*/
4211
4212int DoPreEndSwitch(UBYTE *s)
4213{
4214 DUMMYUSE(s);
4215 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4216 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPESWITCH ) {
4217 if ( AP.PreSwitchLevel <= 0 )
4218 MesPrint("@EndSwitch without corresponding Switch");
4219 else MessPreNesting(10);
4220 return(-1);
4221 }
4222 AP.NumPreTypes--;
4223 if ( AP.PreSwitchLevel <= 0 ) {
4224 MesPrint("@EndSwitch without corresponding Switch");
4225 return(-1);
4226 }
4227 M_free(AP.PreSwitchStrings[AP.PreSwitchLevel--],"pre switch string");
4228 return(0);
4229}
4230
4231/*
4232 #] DoPreEndSwitch :
4233 #[ DoPreSwitch :
4234
4235 There should be a string after this.
4236 We have to store it somewhere.
4237*/
4238
4239int DoPreSwitch(UBYTE *s)
4240{
4241 UBYTE *t, *switchstring, **newstrings;
4242 int newnum, i, *newmodes;
4243 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4244 SKIPBLANKS(s)
4245 t = s;
4246 while ( *s ) { if ( *s == '\\' ) s++; s++; }
4247 while ( s > t && ( s[-1] == ' ' || s[-1] == '\t' ) && s[-2] != '\\' ) {
4248 if ( s[-2] == '\\' ) s--;
4249 s--;
4250 }
4251 if ( *t == '"' && s > t+1 && s[-1] == '"' && s[-2] != '\\' ) {
4252 t++; s--; *s = 0;
4253 }
4254 else *s = 0;
4255 switchstring = (UBYTE *)Malloc1((s-t)+1,"case string");
4256 s = switchstring;
4257 while ( *t ) {
4258 if ( *t == '\\' ) t++;
4259 *s++ = *t++;
4260 }
4261 *s = 0;
4262 if ( AP.PreSwitchLevel >= AP.NumPreSwitchStrings ) {
4263 newnum = 2*AP.NumPreSwitchStrings;
4264 newstrings = (UBYTE **)Malloc1(sizeof(UBYTE *)*(newnum+1),"case strings");
4265 newmodes = (int *)Malloc1(sizeof(int)*(newnum+1),"case strings");
4266 for ( i = 0; i < AP.NumPreSwitchStrings; i++ )
4267 newstrings[i] = AP.PreSwitchStrings[i];
4268 M_free(AP.PreSwitchStrings,"AP.PreSwitchStrings");
4269 for ( i = 0; i <= AP.NumPreSwitchStrings; i++ )
4270 newmodes[i] = AP.PreSwitchModes[i];
4271 M_free(AP.PreSwitchModes,"AP.PreSwitchModes");
4272 AP.PreSwitchStrings = newstrings;
4273 AP.PreSwitchModes = newmodes;
4274 AP.NumPreSwitchStrings = newnum;
4275 }
4276 AP.PreSwitchStrings[++AP.PreSwitchLevel] = switchstring;
4277 if ( ( AP.PreSwitchLevel > 1 )
4278 && ( AP.PreSwitchModes[AP.PreSwitchLevel-1] != EXECUTINGPRESWITCH ) )
4279 AP.PreSwitchModes[AP.PreSwitchLevel] = SEARCHINGPREENDSWITCH;
4280 else
4281 AP.PreSwitchModes[AP.PreSwitchLevel] = SEARCHINGPRECASE;
4282 AddToPreTypes(PRETYPESWITCH);
4283 return(0);
4284}
4285
4286/*
4287 #] DoPreSwitch :
4288 #[ DoPreShow :
4289
4290 Print the contents of the preprocessor variables
4291*/
4292
4293int DoPreShow(UBYTE *s)
4294{
4295 int i;
4296 UBYTE *name, c;
4297 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
4298 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4299 while ( *s == ' ' || *s == '\t' ) s++;
4300 if ( *s == 0 ) {
4301 MesPrint("%#The preprocessor variables:");
4302 for ( i = 0; i < NumPre; i++ ) {
4303 MesPrint("%d: %s = \"%s\"",i,PreVar[i].name,PreVar[i].value);
4304 }
4305 }
4306 else {
4307 while ( *s ) {
4308 name = s; while ( *s && *s != ' ' && *s != '\t' && *s != ',' ) s++;
4309 c = *s; *s = 0;
4310 for ( i = 0; i < NumPre; i++ ) {
4311 if ( StrCmp(PreVar[i].name,name) == 0 )
4312 MesPrint("%d: %s = \"%s\"",i,PreVar[i].name,PreVar[i].value);
4313 }
4314 *s = c;
4315 while ( *s == ' ' || *s == '\t' ) s++;
4316 }
4317 }
4318 return(0);
4319}
4320
4321/*
4322 #] DoPreShow :
4323 #[ DoSystem :
4324*/
4325
4326/*
4327 * A macro for translating the contents of `x' into a string after expanding.
4328 */
4329#define STRINGIFY(x) STRINGIFY__(x)
4330#define STRINGIFY__(x) #x
4331
4332int DoSystem(UBYTE *s)
4333{
4334 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
4335 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4336 if ( AP.preError ) return(0);
4337#ifdef WITHSYSTEM
4338 FLUSHCONSOLE;
4339 while ( *s == ' ' || *s == '\t' ) s++;
4340 if ( *s == '-' && s[1] == 'e' ) {
4341 LONG err;
4342 UBYTE str[24];
4343 s += 2;
4344 if ( *s != ' ' ) {
4345 MesPrint("@Syntax error in #system command.");
4346 return(-1);
4347 }
4348 while ( *s == ' ' || *s == '\t' ) s++;
4349 err = system((char *)s);
4350 NumToStr(str,err);
4351 PutPreVar((UBYTE *)"SYSTEMERROR_",str,0,1);
4352 }
4353 else if ( system((char *)s) ) {
4354 MesPrint("@System call returned with error condition");
4355 Terminate(-1);
4356 }
4357 return(0);
4358#else
4359 Error0("External programs not implemented on this computer/system");
4360 return(-1);
4361#endif
4362}
4363
4364/*
4365 #] DoSystem :
4366 #[ PreLoad :
4367
4368 Loads a loop or procedure into a special buffer.
4369 Note: The current instruction is already in the preStart buffer
4370*/
4371
4372int PreLoad(PRELOAD *p, UBYTE *start, UBYTE *stop, int mode, char *message)
4373{
4374 UBYTE *s, *t, *top, *newbuffer, c;
4375 LONG i, ppsize, linenum = AC.CurrentStream->linenumber;
4376 int size1, size2, level, com=0, last=1, strng = 0;
4377 p->size = AP.pSize;
4378 p->buffer = (UBYTE *)Malloc1(p->size+1,message);
4379 top = p->buffer + p->size - 2;
4380 t = p->buffer; *t++ = '#';
4381 s = start; size1 = size2 = 0;
4382 while ( *s ) { s++; size1++; }
4383 s = stop; while ( *s ) { s++; size2++; }
4384 s = AP.preStart; while ( *s ) *t++ = *s++; *t++ = LINEFEED;
4385 level = 1;
4386 i = 100;
4387 for (;;) {
4388 c = GetInput();
4389 if ( c == ENDOFINPUT ) {
4390 MesPrint("@Missing %#%s, Should match line %l",stop,linenum);
4391 return(-1);
4392 }
4393 if ( c == AP.ComChar && last == 1 ) com = 1;
4394 if ( c == LINEFEED ) { last = 1; com = 0; }
4395 else last = 0;
4396
4397 if ( ( c == '"' ) && ( com == 0 ) ) { strng ^= 1; }
4398
4399 if ( ( c == '#' ) && ( com == 0 ) ) i = 0;
4400 else i++;
4401
4402 if ( t >= top ) {
4403 ppsize = t - p->buffer;
4404 p->size *= 2;
4405 newbuffer = (UBYTE *)Malloc1(p->size,message);
4406 t = newbuffer; s = p->buffer;
4407 while ( --ppsize >= 0 ) *t++ = *s++;
4408 M_free(p->buffer,"loading do loop");
4409 p->buffer = newbuffer;
4410 top = p->buffer + p->size - 2;
4411 }
4412 *t++ = c;
4413 if ( strng == 0 ) {
4414 if ( ( i == size2 ) && ( com == 0 ) ) {
4415 *t = 0;
4416 if ( StrICmp(t-size2,(UBYTE *)(stop)) == 0 ) {
4417 while ( ( c = GetInput() ) != LINEFEED && c != ENDOFINPUT ) {}
4418 level--;
4419 if ( level <= 0 ) break;
4420 if ( c == ENDOFINPUT ) Error1("Missing #",stop);
4421 *t++ = LINEFEED; *t = 0; last = 1;
4422 }
4423 }
4424 if ( ( i == size1 ) && mode && ( com == 0 ) ) {
4425 *t = 0;
4426 if ( StrICmp(t-size1,(UBYTE *)(start)) == 0 ) {
4427/*
4428 while ( ( c = GetInput() ) != LINEFEED && c != ENDOFINPUT ) {}
4429 if ( c == ENDOFINPUT ) Error1("Missing #",stop);
4430*/
4431 level++;
4432 }
4433 }
4434 if ( i == 1 && t[-2] == LINEFEED ) {
4435 if ( c == '-' ) AC.NoShowInput = 1;
4436 else if ( c == '+' ) AC.NoShowInput = 0;
4437 }
4438 }
4439 }
4440 *t++ = LINEFEED;
4441 *t = 0;
4442 return(0);
4443}
4444
4445/*
4446 #] PreLoad :
4447 #[ PreSkip :
4448
4449 Skips a loop or procedure.
4450 Note: The current instruction is already in the preStart buffer
4451*/
4452
4453#define SKIPBUFSIZE 20
4454
4455int PreSkip(UBYTE *start, UBYTE *stop, int mode)
4456{
4457 UBYTE *s, *t, buffer[SKIPBUFSIZE+2], c;
4458 LONG i, linenum = AC.CurrentStream->linenumber;
4459 int size1, size2, level, com=0, last=1;
4460
4461 t = buffer; *t++ = '#';
4462 s = start; size1 = size2 = 0;
4463 while ( *s ) { s++; size1++; }
4464 s = stop; while ( *s ) { s++; size2++; }
4465 level = 1;
4466 i = 0;
4467 for (;;) {
4468 c = GetInput();
4469 if ( c == ENDOFINPUT ) {
4470 MesPrint("@Missing %#%s, Should match line %l",stop,linenum);
4471 return(-1);
4472 }
4473 if ( c == AP.ComChar && last == 1 ) com = 1;
4474 if ( c == LINEFEED ) { last = 1; com = 0; i = 0; t = buffer; }
4475 else last = 0;
4476 if ( ( c == '#' ) && ( com == 0 ) ) { i = 0; t = buffer; }
4477 else i++;
4478
4479 if ( i < SKIPBUFSIZE ) *t++ = c;
4480 if ( ( i == size2 ) && ( com == 0 ) ) {
4481 *t = 0;
4482 if ( StrICmp(t-size2,(UBYTE *)(stop)) == 0 ) {
4483 while ( ( c = GetInput() ) != LINEFEED && c != ENDOFINPUT ) {}
4484 level--;
4485 if ( level <= 0 ) {
4486 pushbackchar = LINEFEED;
4487 break;
4488 }
4489 if ( c == ENDOFINPUT ) Error1("Missing #",stop);
4490 i = 0; t = buffer;
4491 }
4492 }
4493 if ( ( i == size1 ) && mode && ( com == 0 ) ) {
4494 *t = 0;
4495 if ( StrICmp(t-size1,(UBYTE *)(start)) == 0 ) {
4496 while ( ( c = GetInput() ) != LINEFEED && c != ENDOFINPUT ) {}
4497 level++;
4498 i = 0; t = buffer;
4499 }
4500 }
4501 }
4502 return(0);
4503}
4504
4505/*
4506 #] PreSkip :
4507 #[ StartPrepro :
4508*/
4509
4510void StartPrepro(void)
4511{
4512 int **ppp;
4513 AP.MaxPreIfLevel = 2;
4514 ppp = &AP.PreIfStack;
4515 if ( DoubleList((void ***)ppp,&AP.MaxPreIfLevel,sizeof(int),
4516 "PreIfLevels") ) Terminate(-1);
4517 AP.PreIfLevel = 0; AP.PreIfStack[0] = EXECUTINGIF;
4518
4519 AP.NumPreSwitchStrings = 10;
4520 AP.PreSwitchStrings = (UBYTE **)Malloc1(sizeof(UBYTE *)*
4521 (AP.NumPreSwitchStrings+1),"case strings");
4522 AP.PreSwitchModes = (int *)Malloc1(sizeof(int)*
4523 (AP.NumPreSwitchStrings+1),"case strings");
4524 AP.PreSwitchModes[0] = EXECUTINGPRESWITCH;
4525 AP.PreSwitchLevel = 0;
4526}
4527
4528/*
4529 #] StartPrepro :
4530 #[ EvalPreIf :
4531
4532 Evaluates the condition in an if instruction.
4533 The return value is EXECUTINGIF if the condition is true.
4534 If it is false the returnvalue is LOOKINGFORELSE.
4535 An error gives a return value of -1
4536*/
4537
4538int EvalPreIf(UBYTE *s)
4539{
4540 UBYTE *t, *u;
4541 int val;
4542 t = s;
4543 while ( *t ) t++;
4544 *t++ = ')';
4545 *t = 0;
4546 if ( ( u = PreIfEval(s,&val) ) == 0 ) return(-1);
4547 if ( u < t ) {
4548 MesPrint("@Unmatched parentheses in condition");
4549 return(-1);
4550 }
4551 if ( val ) return(EXECUTINGIF);
4552 else return(LOOKINGFORELSE);
4553}
4554
4555/*
4556 #] EvalPreIf :
4557 #[ PreIfEval :
4558
4559 Used for recursions in the evaluation of a preprocessor if-condition.
4560 It determines whether the contents of () is true or false
4561 (or in error).
4562 The return value is the address of the first character after the
4563 closing parenthesis or null if there is an error.
4564 In value we find true(1) or false(0)
4565 We enter after the opening parenthesis.
4566 There are levels:
4567 0: orlevel: a || b
4568 1: andlevel: a && b
4569 2: eqlevel: a == b or a != b or a = b
4570 3: cmplevel: a > b or a >= b or a < b or a <= b or a >~ b etc
4571*/
4572
4573UBYTE *PreIfEval(UBYTE *s, int *value)
4574{
4575 int orlevel = 0, andlevel = 0, eqlevel = 0, cmplevel = 0;
4576 int type, val;
4577 LONG val2;
4578 int ortype, orval, cmptype, cmpval, eqtype, eqval, andtype, andval;
4579 UBYTE *t, *eqt, *cmpt, c;
4580 int eqop, cmpop;
4581 ortype = orval = cmptype = cmpval = eqtype = eqval = andtype = andval = 0;
4582 eqop = cmpop = 0;
4583 eqt = cmpt = 0;
4584 *value = 0;
4585 while ( *s != ')' ) {
4586 while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
4587 t = s;
4588 s = pParseObject(s,&type,&val2);
4589 if ( s == 0 ) return(0);
4590 val = val2;
4591 c = *s;
4592 *s++ = 0; /* in case the object is a string without " */
4593 while ( c == ' ' || c == '\t' || c == '\n' || c == '\r' ) {
4594 c = *s; *s++ = 0;
4595 }
4596 if ( *t == '"' ) t++;
4597 switch(c) {
4598 case '|':
4599 if ( *s != '|' ) goto illoper;
4600 s++;
4601 /* fall through */
4602 case ')':
4603 if ( cmplevel ) {
4604 if ( type == 0 || cmptype == 0 ) goto illobject;
4605 val = PreCmp(type,val,t,cmptype,cmpval,cmpt,cmpop);
4606 type = 0;
4607 cmplevel = 0;
4608 }
4609 if ( eqlevel ) {
4610 val = PreEq(type,val,t,eqtype,eqval,eqt,eqop);
4611 type = 0;
4612 eqlevel = 0;
4613 }
4614 if ( andlevel ) {
4615 if ( andtype != 0 || type != 0 ) goto illobject;
4616 val &= andval;
4617 andlevel = 0;
4618 }
4619 if ( orlevel ) {
4620 if ( ortype != 0 || type != 0 ) goto illobject;
4621 val |= orval;
4622 }
4623 if ( c == ')' ) {
4624 *value = val;
4625 return(s);
4626 }
4627 orlevel = 1;
4628 orval = val;
4629 ortype = type;
4630 break;
4631 case '&':
4632 if ( *s != '&' ) goto illoper;
4633 s++;
4634 if ( cmplevel ) {
4635 if ( type == 0 || cmptype == 0 ) goto illobject;
4636 val = PreCmp(type,val,t,cmptype,cmpval,cmpt,cmpop);
4637 type = 0;
4638 cmplevel = 0;
4639 }
4640 if ( eqlevel ) {
4641 val = PreEq(type,val,t,eqtype,eqval,eqt,eqop);
4642 type = 0;
4643 eqlevel = 0;
4644 }
4645 if ( andlevel ) {
4646 if ( andtype != 0 || type != 0 ) goto illobject;
4647 val &= andval;
4648 }
4649 andlevel = 1;
4650 andval = val;
4651 andtype = type;
4652 break;
4653 case '!':
4654 case '=':
4655 if ( eqlevel ) goto illorder;
4656 if ( cmplevel ) {
4657 if ( type == 0 || cmptype == 0 ) goto illobject;
4658 val = PreCmp(type,val,t,cmptype,cmpval,cmpt,cmpop);
4659 type = 0;
4660 cmplevel = 0;
4661 }
4662 if ( c == '!' && *s != '=' ) goto illoper;
4663 if ( *s == '=' ) s++;
4664 if ( c == '!' ) eqop = 1;
4665 else eqop = 0;
4666 eqlevel = 1; eqt = t; eqval = val; eqtype = type;
4667 break;
4668 case '>':
4669 case '<':
4670 if ( cmplevel ) goto illorder;
4671 if ( c == '<' ) cmpop = -1;
4672 else cmpop = 1;
4673 cmplevel = 1; cmpt = t; cmpval = val; cmptype = type;
4674 if ( *s == '=' ) {
4675 s++;
4676 if ( *s == '~' ) { s++; cmpop *= 4; }
4677 else cmpop *= 2;
4678 }
4679 else if ( *s == '~' ) { s++; cmpop *= 3; }
4680 break;
4681 default:
4682 goto illoper;
4683 }
4684 }
4685 return(s);
4686illorder:
4687 MesPrint("@illegal order of operators");
4688 return(0);
4689illobject:
4690 MesPrint("@illegal object for this operator");
4691 return(0);
4692illoper:
4693 MesPrint("@illegal operator");
4694 return(0);
4695}
4696
4697/*
4698 #] PreIfEval :
4699 #[ PreCmp :
4700*/
4701
4702int PreCmp(int type, int val, UBYTE *t, int type2, int val2, UBYTE *t2, int cmpop)
4703{
4704 if ( type == 2 || type2 == 2 || cmpop < -2 || cmpop > 2 ) {
4705 if ( cmpop < 0 && cmpop > -3 ) cmpop -= 2;
4706 if ( cmpop > 0 && cmpop < 3 ) cmpop += 2;
4707 if ( cmpop == 3 ) val = StrCmp(t2,t) > 0;
4708 else if ( cmpop == 4 ) val = StrCmp(t2,t) >= 0;
4709 else if ( cmpop == -3 ) val = StrCmp(t2,t) < 0;
4710 else if ( cmpop == -4 ) val = StrCmp(t2,t) <= 0;
4711 }
4712 else {
4713 if ( cmpop == 1 ) val = ( val2 > val );
4714 else if ( cmpop == 2 ) val = ( val2 >= val );
4715 else if ( cmpop == -1 ) val = ( val2 < val );
4716 else if ( cmpop == -2 ) val = ( val2 <= val );
4717 }
4718 return(val);
4719}
4720
4721/*
4722 #] PreCmp :
4723 #[ PreEq :
4724*/
4725
4726int PreEq(int type, int val, UBYTE *t, int type2, int val2, UBYTE *t2, int eqop)
4727{
4728 UBYTE str[20];
4729 if ( type == 2 || type2 == 2 ) {
4730 if ( type != 2 ) { NumToStr(str,val ); t = str; }
4731 if ( type2 != 2 ) { NumToStr(str,val2); t2 = str; }
4732 if ( eqop == 1 ) val = StrCmp(t,t2) != 0;
4733 else val = StrCmp(t,t2) == 0;
4734 }
4735 else {
4736 if ( eqop ) val = val != val2;
4737 else val = val == val2;
4738 }
4739 return(val);
4740}
4741
4742/*
4743 #] PreEq :
4744 #[ pParseObject :
4745
4746 Parses a preprocessor object. We can have:
4747 1: a number (type = 1)
4748 2: a string (type = 2)
4749 3: an expression between parentheses (type = 0)
4750 4: a special function (type = 3)
4751 If the object is not a number, an expression or a special operator
4752 we try to interpret it as a string.
4753*/
4754
4755UBYTE *pParseObject(UBYTE *s, int *type, LONG *val2)
4756{
4757 UBYTE *t, c;
4758 int sign, val = 0;
4759 LONG x;
4760 while ( *s == ' ' || *s == '\t' ) s++;
4761 if ( *s == '(' ) {
4762 s++;
4763 while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
4764 s = PreIfEval(s,&val);
4765 *type = 0;
4766 *val2 = val;
4767 return(s);
4768 }
4769 else if ( *s == '$' && s[1] == '(' ) {
4770 s += 2;
4771 while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
4772 s = PreIfDollarEval(s,&val);
4773 *type = 0; *val2 = val;
4774 return(s);
4775 }
4776 if ( *s == 0 ) {
4777illend:
4778 MesPrint("@illegal end of condition");
4779 return(0);
4780 }
4781 if ( *s == '"' ) {
4782 s++;
4783 while ( *s && *s != '"' ) {
4784 if ( *s == '\\' ) s++;
4785 s++;
4786 }
4787 if ( *s == 0 ) goto illend;
4788 else *s = 0;
4789 *type = 2;
4790 s++;
4791
4792 while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
4793
4794 return(s);
4795 }
4796 t = s; sign = 1; x = 0;
4797 if ( chartype[*t] == 0 ) { /* Special operators and strings without "" */
4798 do { t++; } while ( chartype[*t] <= 1 );
4799 if ( *t == '(' ) {
4800 WORD ttype;
4801 c = *t; *t = 0;
4802 if ( StrICmp(s,(UBYTE *)"termsin") == 0 ) {
4803 UBYTE *tt;
4804 WORD numdol, numexp;
4805 ttype = 0;
4806together:
4807 *t++ = c;
4808 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
4809 if ( *t == '$' ) {
4810 t++; tt = t; while (chartype[*tt] <= 1 ) tt++;
4811 c = *tt; *tt = 0;
4812 if ( ( numdol = GetDollar(t) ) > 0 ) {
4813 *tt = c;
4814 if ( ttype == 1 ) {
4815 x = SizeOfDollar(numdol);
4816 }
4817 else {
4818 x = TermsInDollar(numdol);
4819 }
4820 }
4821 else {
4822 MesPrint("@$%s has not (yet) been defined",t);
4823 *tt = c;
4824 Terminate(-1);
4825 }
4826 }
4827 else {
4828 tt = SkipAName(t);
4829 c = *tt; *tt = 0;
4830 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) {
4831 MesPrint("@%s has not (yet) been defined",t);
4832 *tt = c;
4833 Terminate(-1);
4834 }
4835 else {
4836 *tt = c;
4837 if ( ttype == 1 ) {
4838 x = SizeOfExpression(numexp);
4839 }
4840 else {
4841 x = TermsInExpression(numexp);
4842 }
4843 }
4844 }
4845 while ( *tt == ' ' || *tt == '\t'
4846 || *tt == '\n' || *tt == '\r' ) tt++;
4847 if ( *tt != ')' ) {
4848 MesPrint("@Improper use of terms($var) or terms(expr)");
4849 Terminate(-1);
4850 }
4851 *type = 3;
4852 s = tt+1;
4853 *val2 = x;
4854 return(s);
4855 }
4856 else if ( StrICmp(s,(UBYTE *)"sizeof") == 0 ) {
4857 ttype = 1;
4858 goto together;
4859 }
4860 else if ( StrICmp(s,(UBYTE *)"exists") == 0 ) {
4861 UBYTE *tt;
4862 WORD numdol, numexp;
4863 *t++ = c;
4864 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
4865 if ( *t == '$' ) {
4866 t++; tt = t; while (chartype[*tt] <= 1 ) tt++;
4867 c = *tt; *tt = 0;
4868 if ( ( numdol = GetDollar(t) ) >= 0 ) { x = 1; }
4869 else { x = 0; }
4870 *tt = c;
4871 }
4872 else if ( *t == '"' ) { /* see whether a file exists */
4873/* UBYTE *name, *oldname; */
4874 t++; tt = t;
4875 for (;;) {
4876 if ( *tt == '\\' ) tt++;
4877 else if ( *tt == '"' ) break;
4878 tt++;
4879 }
4880 c = *tt; *tt = 0;
4881/*
4882 Try to open the file. If possible, return 1.
4883 Afterwards close it.
4884 We do have to run through the FORMPATH. Hence we use LocateFile.
4885 This routine may change the name to the full name.
4886
4887 oldname = name = strDup1(t,"name in exists");
4888 x = LocateFile(&name,-1);
4889*/
4890 x = OpenFile((char *)t);
4891 if ( x >= 0 ) {
4892 CloseFile(x);
4893 x = 1;
4894/*
4895 if ( name != oldname ) M_free(name,"name from LocateFile");
4896*/
4897 }
4898 else x = 0;
4899/*
4900 M_free(oldname,"name in exists");
4901*/
4902 *tt++ = c;
4903 }
4904 else {
4905 tt = SkipAName(t);
4906 c = *tt; *tt = 0;
4907 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) { x = 0; }
4908 else { x = 1; }
4909 *tt = c;
4910 }
4911 while ( *tt == ' ' || *tt == '\t'
4912 || *tt == '\n' || *tt == '\r' ) tt++;
4913 if ( *tt != ')' ) {
4914 MesPrint("@Improper use of exists($var) or exists(expr)");
4915 Terminate(-1);
4916 }
4917 *type = 3;
4918 s = tt+1;
4919 *val2 = x;
4920 return(s);
4921 }
4922 else if ( StrICmp(s,(UBYTE *)"isnumerical") == 0 ) {
4923 GETIDENTITY
4924 UBYTE *tt;
4925 WORD numdol, numexp;
4926 *t++ = c;
4927 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
4928 if ( *t == '$' ) {
4929 t++; tt = t; while (chartype[*tt] <= 1 ) tt++;
4930 c = *tt; *tt = 0;
4931 if ( ( numdol = GetDollar(t) ) < 0 ) {
4932 MesPrint("@$ variable in isnumerical(%s) does not exist",t);
4933 Terminate(-1);
4934 }
4935 x = DolToLong(BHEAD numdol);
4936 if ( AN.ErrorInDollar ) {
4937 DOLLARS d = Dollars + numdol;
4938 x = 0;
4939 if ( d->type == DOLNUMBER || d->type == DOLTERMS ) {
4940 if ( d->where[0] == 0 ) x = 1;
4941 else if ( d->where[d->where[0]] == 0 ) {
4942 if ( ABS(d->where[d->where[0]-1]) == d->where[0]-1 )
4943 x = 1;
4944 }
4945 }
4946 }
4947 else x = 1;
4948 *tt = c;
4949 }
4950 else {
4951 tt = SkipAName(t);
4952 c = *tt; *tt = 0;
4953 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) {
4954 MesPrint("@expression in isnumerical(%s) does not exist",t);
4955 Terminate(-1);
4956 }
4957 x = TermsInExpression(numexp);
4958 if ( x != 1 ) x = 0;
4959 else {
4960 WORD *term = AT.WorkPointer;
4961 if ( GetFirstTerm(term,numexp,1) < 0 ) {
4962 MesPrint("@error reading expression in isnumerical(%s)",t);
4963 Terminate(-1);
4964 }
4965 if ( *term == ABS(term[*term-1])+1 ) x = 1;
4966 else x = 0;
4967 }
4968 *tt = c;
4969 }
4970 while ( *tt == ' ' || *tt == '\t'
4971 || *tt == '\n' || *tt == '\r' ) tt++;
4972 if ( *tt != ')' ) {
4973 MesPrint("@Improper use of isnumerical($var) or numerical(expr)");
4974 Terminate(-1);
4975 }
4976 *type = 3;
4977 s = tt+1;
4978 *val2 = x;
4979 return(s);
4980 }
4981 else if ( StrICmp(s,(UBYTE *)("maxpowerof")) == 0 ) {
4982 UBYTE *tt;
4983 WORD numsym;
4984 int stype;
4985 *t++ = c;
4986 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
4987 tt = SkipAName(t);
4988 c = *tt; *tt = 0;
4989 if ( ( stype = GetName(AC.varnames,t,&numsym,NOAUTO) ) == NAMENOTFOUND ) {
4990 MesPrint("@%s has not (yet) been defined",t);
4991 *tt = c;
4992 Terminate(-1);
4993 }
4994 else if ( stype != CSYMBOL ) {
4995 MesPrint("@%s should be a symbol",t);
4996 *tt = c;
4997 Terminate(-1);
4998 }
4999 else {
5000 *tt = c;
5001 x = symbols[numsym].maxpower;
5002 }
5003 while ( *tt == ' ' || *tt == '\t'
5004 || *tt == '\n' || *tt == '\r' ) tt++;
5005 if ( *tt != ')' ) {
5006 MesPrint("@Improper use of maxpowerof(symbol)");
5007 Terminate(-1);
5008 }
5009 *type = 3;
5010 s = tt+1;
5011 *val2 = x;
5012 return(s);
5013 }
5014 else if ( StrICmp(s,(UBYTE *)("minpowerof")) == 0 ) {
5015 UBYTE *tt;
5016 WORD numsym;
5017 int stype;
5018 *t++ = c;
5019 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
5020 tt = SkipAName(t);
5021 c = *tt; *tt = 0;
5022 if ( ( stype = GetName(AC.varnames,t,&numsym,NOAUTO) ) == NAMENOTFOUND ) {
5023 MesPrint("@%s has not (yet) been defined",t);
5024 *tt = c;
5025 Terminate(-1);
5026 }
5027 else if ( stype != CSYMBOL ) {
5028 MesPrint("@%s should be a symbol",t);
5029 *tt = c;
5030 Terminate(-1);
5031 }
5032 else {
5033 *tt = c;
5034 x = symbols[numsym].minpower;
5035 }
5036 while ( *tt == ' ' || *tt == '\t'
5037 || *tt == '\n' || *tt == '\r' ) tt++;
5038 if ( *tt != ')' ) {
5039 MesPrint("@Improper use of minpowerof(symbol)");
5040 Terminate(-1);
5041 }
5042 *type = 3;
5043 s = tt+1;
5044 *val2 = x;
5045 return(s);
5046 }
5047 else if ( StrICmp(s,(UBYTE *)"isfactorized") == 0 ) {
5048 UBYTE *tt;
5049 WORD numdol, numexp;
5050 *t++ = c;
5051 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
5052 if ( *t == '$' ) {
5053 t++; tt = t; while (chartype[*tt] <= 1 ) tt++;
5054 c = *tt; *tt = 0;
5055 if ( ( numdol = GetDollar(t) ) > 0 ) {
5056 if ( Dollars[numdol].factors != 0 ) x = 1;
5057 else x = 0;
5058 }
5059 else {
5060 MesPrint("@ %s should be the name of an expression or a $ variable",t-1);
5061 Terminate(-1);
5062 }
5063 *tt = c;
5064 }
5065 else {
5066 tt = SkipAName(t);
5067 c = *tt; *tt = 0;
5068 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) {
5069 MesPrint("@ %s should be the name of an expression or a $ variable",t);
5070 Terminate(-1);
5071 }
5072 else {
5073 if ( ( Expressions[numexp].vflags & ISFACTORIZED ) != 0 ) x = 1;
5074 else x = 0;
5075 }
5076 *tt = c;
5077 }
5078 while ( *tt == ' ' || *tt == '\t'
5079 || *tt == '\n' || *tt == '\r' ) tt++;
5080 if ( *tt != ')' ) {
5081 MesPrint("@Improper use of isfactorized($var) or isfactorized(expr)");
5082 Terminate(-1);
5083 }
5084 *type = 3;
5085 s = tt+1;
5086 *val2 = x;
5087 return(s);
5088 }
5089 else if ( StrICmp(s,(UBYTE *)"isdefined") == 0 ) {
5090 UBYTE *tt;
5091 *t++ = c;
5092 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
5093 tt = SkipAName(t);
5094 c = *tt; *tt = 0;
5095 if ( GetPreVar(t,WITHOUTERROR) != 0 ) x = 1;
5096 else x = 0;
5097 *tt = c;
5098 while ( *tt == ' ' || *tt == '\t'
5099 || *tt == '\n' || *tt == '\r' ) tt++;
5100 if ( *tt != ')' ) {
5101 MesPrint("@Improper use of isdefined(var)");
5102 Terminate(-1);
5103 }
5104 *type = 3;
5105 s = tt+1;
5106 *val2 = x;
5107 return(s);
5108 }
5109 else if ( StrICmp(s,(UBYTE *)"flag") == 0 ) {
5110 UBYTE *tt;
5111 WORD x = 0, numexp;
5112 {
5113 *t++ = c;
5114 while ( *t == ' ' || *t == '\t' ) t++;
5115 if ( FG.cTable[*t] != 1 ) goto flagerror;
5116 while ( FG.cTable[*t] == 1 ) x = 10*x + (*t++ - '0');
5117 if ( x < 1 || x > BITSINWORD ) {
5118 MesPrint("@Illegal number %d for flag in flag condition",x);
5119 goto flagerror;
5120 }
5121 while ( *t == ' ' || *t == '\t' ) t++;
5122 if ( *t != ',' ) goto flagerror;
5123 t++;
5124 while ( *t == ' ' || *t == '\t' ) t++;
5125 tt = SkipAName(t);
5126 c = *tt; *tt = 0;
5127 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) {
5128 MesPrint("@ %s should be the name of an expression",t);
5129 goto flagerror;
5130 }
5131 *tt = c;
5132 while ( *t == ' ' || *t == '\t' ) t++;
5133 if ( *tt != ')' ) {
5134flagerror:
5135 MesPrint("@Improper use of flag(num,expr)");
5136 Terminate(-1);
5137 return(0);
5138 }
5139 if ( ( Expressions[numexp].uflags & ( 1 << (x-1) ) ) != 0 )
5140 *val2 = 1;
5141 else *val2 = 0;
5142 *type = 3;
5143 s = tt+1;
5144 return(s);
5145 }
5146 }
5147 else *t = c;
5148 }
5149 else if ( *t == '=' || *t == '<' || *t == '>' || *t == '!'
5150 || *t == ')' || *t == ' ' || *t == '\t' || *t == 0 || *t == '\n' ) {
5151 *val2 = 0;
5152 *type = 2;
5153 return(t);
5154 }
5155 else {
5156 MesPrint("@Illegal use of string in preprocessor condition: %s",s);
5157 Terminate(-1);
5158 }
5159 }
5160 while ( *t == '-' || *t == '+' || *t == ' ' || *t == '\t' ) {
5161 if ( *t == '-' ) sign = -sign;
5162 t++;
5163 }
5164 while ( chartype[*t] == 1 ) { x = 10*x + *t++ - '0'; }
5165 while ( *t == ' ' || *t == '\t' ) t++;
5166 if ( chartype[*t] == 8 || *t == ')' || *t == '=' || *t == 0 ) {
5167 *val2 = sign > 0 ? x: -x;
5168 *type = 1;
5169 return(t);
5170 }
5171 while ( chartype[*t] != 8 && *t != ')' && *t != '=' && *t ) t++;
5172 while ( ( t > s ) && ( t[-1] == ' ' || t[-1] == '\t' ) ) t--;
5173 *type = 2;
5174 *val2 = val;
5175 return(t);
5176}
5177
5178/*
5179 #] pParseObject :
5180 #[ PreCalc :
5181
5182 To be called when a { is encountered.
5183 Action: read first till matching }. This is to be stored.
5184 Next we look whether this is a set or whether it can be
5185 evaluated. If it is a set we consider it as a new stream.
5186 The stream will have to be deallocated when read completely.
5187 If it is to be evaluated we do that and put the result in
5188 a stream.
5189*/
5190
5191UBYTE *PreCalc(void)
5192{
5193 UBYTE *buff, *s = 0, *t, *newb, c;
5194 int size, i, n, parlevel = 0, bralevel = 0;
5195 LONG answer;
5196 ULONG uanswer;
5197 size = n = 0;
5198 buff = 0; c = '{';
5199 for (;;) {
5200 if ( n >= size ) {
5201 if ( size == 0 ) size = 72;
5202 else size *= 2;
5203 if ( ( newb = (UBYTE *)Malloc1(size+2,"{}") ) == 0 ) return(0);
5204 s = newb;
5205 if ( buff ) {
5206 i = n;
5207 t = buff;
5208 NCOPYB(s,t,i);
5209 M_free(buff,"pre calc buffer");
5210 }
5211 else s = newb;
5212 buff = newb;
5213 }
5214 *s++ = c; n++;
5215 c = GetChar(0);
5216 if ( c == 0 ) {
5217 Error0("Unmatched {}");
5218 M_free(buff,"precalc buffer");
5219 return(0);
5220 }
5221 else if ( c == '{' ) { bralevel++; }
5222 else if ( c == '}' ) {
5223 if ( --bralevel < 0 ) { *s++ = c; *s = 0; break; }
5224 }
5225 else if ( c == '(' ) { parlevel++; }
5226 else if ( c == ')' ) {
5227 if ( --parlevel < 0 ) { *s++ = c; *s = 0; goto setstring; }
5228 }
5229 else if ( chartype[c] != 1 && chartype[c] != 5
5230 && chartype[c] != 6 && c != '!' && c != '&'
5231 && c != '|' && c != '\\' ) { *s++ = c; *s = 0; goto setstring; }
5232 }
5233 if ( parlevel > 0 ) goto setstring;
5234/*
5235 Try now to evaluate the string.
5236 If it works, copy the resulting value back into buff as a string.
5237*/
5238 answer = 0;
5239 if ( PreEval(buff+1,&answer) == 0 ) goto setstring;
5240 t = buff + size;
5241 s = buff;
5242 if ( answer < 0 ) { *s++ = '-'; }
5243 uanswer = LongAbs(answer);
5244 n = 0;
5245 do {
5246 *--t = ( uanswer % 10 ) + '0';
5247 uanswer /= 10;
5248 n++;
5249 } while ( uanswer > 0 );
5250 NCOPYB(s,t,n);
5251 *s = 0;
5252setstring:;
5253/*
5254 Open a stream that contains the current string.
5255 Mark it to be removed after termination.
5256*/
5257 if ( OpenStream(buff,PRECALCSTREAM,0,PRENOACTION) == 0 ) return(0);
5258 return(buff);
5259}
5260
5261/*
5262 #] PreCalc :
5263 #[ PreEval :
5264
5265 Operations are:
5266 +, -, *, /, %, &, |, ^, !, ^% (postfix 2log), ^/ (postfix sqrt)
5267*/
5268
5269UBYTE *PreEval(UBYTE *s, LONG *x)
5270{
5271 LONG y, z, a;
5272 int tobemultiplied, tobeadded = 1, expsign, i;
5273 UBYTE *t;
5274 *x = 0; a = 1;
5275 while ( *s == ' ' || *s == '\t' ) s++;
5276 for(;;){
5277 if ( *s == '+' || *s == '-' ) {
5278 if ( *s == '-' ) tobeadded = -1;
5279 else tobeadded = 1;
5280 s++;
5281 while ( *s == '-' || *s == '+' || *s == ' ' || *s == '\t' ) {
5282 if ( *s == '-' ) tobeadded = -tobeadded;
5283 s++;
5284 }
5285 }
5286 tobemultiplied = 0;
5287 for(;;){
5288 while ( *s == ' ' || *s == '\t' ) s++;
5289 if ( *s <= '9' && *s >= '0' ) {
5290 ULONG uy;
5291 ParseNumber(uy,s)
5292 y = uy; /* may cause an implementation-defined behaviour */
5293 }
5294 else if ( *s == '(' || *s == '{' ) {
5295 if ( ( t = PreEval(s+1,&y) ) == 0 ) return(0);
5296 s = t;
5297 }
5298 else return(0);
5299 while ( *s == ' ' || *s == '\t' ) s++;
5300 expsign = 1;
5301 while ( *s == '^' || *s == '!' ) {
5302 s++;
5303 if ( s[-1] == '!' ) { /* factorial of course */
5304 while ( *s == ' ' || *s == '\t' ) s++;
5305 if ( y < 0 ) {
5306 MesPrint("@Negative value in preprocessor factorial: %l",y);
5307 return(0);
5308 }
5309 else if ( y == 0 ) y = 1;
5310 else if ( y > 1 ) {
5311 z = y-1;
5312 while ( z > 0 ) { y = y*z; z--; }
5313 }
5314 continue;
5315 }
5316 else if ( *s == '%' ) { /* ^% is postfix 2log */
5317 s++;
5318 while ( *s == ' ' || *s == '\t' ) s++;
5319 z = y;
5320 if ( z <= 0 ) {
5321 MesPrint("@Illegal value in preprocessor logarithm: %l",z);
5322 return(0);
5323 }
5324 y = 0; z >>= 1;
5325 while ( z ) { y++; z >>= 1; }
5326 continue;
5327 }
5328 else if ( *s == '/' ) { /* ^/ is postfix sqrt */
5329 LONG yy, zz;
5330 s++;
5331 while ( *s == ' ' || *s == '\t' ) s++;
5332 z = y;
5333 if ( z <= 0 ) {
5334 MesPrint("@Illegal value in preprocessor square root: %l",z);
5335 return(0);
5336 }
5337 if ( z > 8 ) { /* Very crude integer square root */
5338 zz = z;
5339 yy = 0; zz >>= 1;
5340 while ( zz ) { yy++; zz >>= 1; }
5341 zz = z >> (yy/2); i = 10; y = 0;
5342 do {
5343 yy = zz/2 + z/(2*zz); i--;
5344 if ( y == yy ) break;
5345 y = zz; zz = yy;
5346 } while ( y != yy && i > 0 );
5347 while ( y*y < z ) y++;
5348 while ( y*y > z ) y--;
5349 }
5350 else if ( z >= 4 ) y = 2;
5351 else if ( z == 0 ) y = 0;
5352 else y = 1;
5353 continue;
5354 }
5355 while ( *s == ' ' || *s == '\t' ) s++;
5356 while ( *s == '-' || *s == '+' || *s == ' ' || *s == '\t' ) {
5357 if ( *s == '-' ) expsign = -expsign;
5358 }
5359 if ( *s <= '9' && *s >= '0' ) {
5360 ParseNumber(z,s)
5361 }
5362 else if ( *s == '(' || *s == '{' ) {
5363 if ( ( t = PreEval(s+1,&z) ) == 0 ) return(0);
5364 s = t;
5365 }
5366 else return(0);
5367 while ( *s == ' ' || *s == '\t' ) s++;
5368 y = iexp(y,(int)z);
5369 }
5370 if ( tobemultiplied == 0 ) {
5371 if ( expsign < 0 ) a = 1/y;
5372 else a = y;
5373 }
5374 else {
5375 if ( tobemultiplied > 2 && expsign != 1 ) {
5376 MesPrint("&Incorrect use of ^ with & or |. Use brackets!");
5377 Terminate(-1);
5378 }
5379 tobemultiplied *= expsign;
5380 if ( tobemultiplied == 1 ) a *= y;
5381 else if ( tobemultiplied == 3 ) a &= y;
5382 else if ( tobemultiplied == 4 ) a |= y;
5383 else {
5384 if ( y == 0 || tobemultiplied == -2 ) {
5385 MesPrint("@Division by zero in preprocessor calculator");
5386 Terminate(-1);
5387 }
5388 if ( tobemultiplied == 2 ) a %= y;
5389 else a /= y;
5390 }
5391 }
5392 if ( *s == '%' ) tobemultiplied = 2;
5393 else if ( *s == '*' ) tobemultiplied = 1;
5394 else if ( *s == '/' ) tobemultiplied = -1;
5395 else if ( *s == '&' ) tobemultiplied = 3;
5396 else if ( *s == '|' ) tobemultiplied = 4;
5397 else {
5398 ULONG ux, ua;
5399 ux = *x;
5400 ua = a;
5401 if ( tobeadded >= 0 ) ux += ua;
5402 else ux -= ua;
5403 *x = ULongToLong(ux);
5404 if ( *s == ')' || *s == '}' ) return(s+1);
5405 else if ( *s == '-' || *s == '+' ) { tobeadded = 1; break; }
5406 else return(0);
5407 }
5408 s++;
5409 }
5410 }
5411/* return(0); */
5412}
5413
5414/*
5415 #] PreEval :
5416 #[ AddToPreTypes :
5417*/
5418
5419void AddToPreTypes(int type)
5420{
5421 if ( AP.NumPreTypes >= AP.MaxPreTypes ) {
5422 int i, *newlist = (int *)Malloc1(sizeof(int)*(2*AP.MaxPreTypes+1)
5423 ,"preprocessor type lists");
5424 for ( i = 0; i <= AP.MaxPreTypes; i++ ) newlist[i] = AP.PreTypes[i];
5425 M_free(AP.PreTypes,"preprocessor type lists");
5426 AP.PreTypes = newlist;
5427 AP.MaxPreTypes = 2*AP.MaxPreTypes;
5428 }
5429 AP.PreTypes[++AP.NumPreTypes] = type;
5430}
5431
5432/*
5433 #] AddToPreTypes :
5434 #[ MessPreNesting :
5435*/
5436
5437void MessPreNesting(int par)
5438{
5439 MesPrint("@(%d)Illegal nesting of %#if, %#do, %#procedure and/or %#switch",par);
5440}
5441
5442/*
5443 #] MessPreNesting :
5444 #[ DoPreAddSeparator :
5445
5446 Preprocessor directives "addseparator" and "rmseparator" add/remove
5447 separator characters used to separate function arguments.
5448 Example:
5449
5450 #define QQ "a|g|a"
5451 #addseparator %
5452 *Comma must be quoted!:
5453 #rmseparator ","
5454 #rmseparator |
5455 #call H(a,a%`QQ')
5456
5457 Characters ' ', '\t' and '"' are ignored!
5458*/
5459
5460int DoPreAddSeparator(UBYTE *s)
5461{
5462 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5463 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5464 for(;*s != '\0';s++){
5465 while ( *s == ' ' || *s == '\t' || *s == '"') s++;
5466 /* Todo:
5467 if ( set_in(*s,invalidseparators) ) {
5468 MesPrint("@Invalid separator specified");
5469 return(-1);
5470 }
5471 */
5472 set_set(*s,AC.separators);
5473 }
5474 return(0);
5475}
5476
5477/*
5478 #] DoPreAddSeparator :
5479 #[ DoPreRmSeparator :
5480
5481 See commentary with DoPreAddSeparator
5482
5483 Characters ' ', '\t' and '"' are ignored!
5484*/
5485int DoPreRmSeparator(UBYTE *s)
5486{
5487 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5488 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5489 for(;*s != '\0';s++){
5490 while ( *s == ' ' || *s == '\t' || *s == '"') s++;
5491 set_del(*s,AC.separators);
5492 }
5493 return(0);
5494}
5495
5496/*
5497 #] DoPreRmSeparator :
5498 #[ DoExternal:
5499
5500 #external ["prevar"] command
5501*/
5502int DoExternal(UBYTE *s)
5503{
5504#ifdef WITHEXTERNALCHANNEL
5505 UBYTE *prevar=0;
5506 int externalD= 0;
5507#else
5508 DUMMYUSE(s);
5509#endif
5510 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5511 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5512 if ( AP.preError ) return(0);
5513
5514#ifdef WITHEXTERNALCHANNEL
5515 while ( *s == ' ' || *s == '\t' ) s++;
5516 if(*s == '"'){/*prevar to store the descriptor is defined*/
5517 prevar=++s;
5518
5519 if ( chartype[*s] == 0 )for(;*s != '"'; s++)switch(chartype[*s]){
5520 case 10:/*'\0' fits here*/
5521 MesPrint("@Can't finde closing \"");
5522 Terminate(-1);
5523 case 0:case 1: continue;
5524 default:
5525 break;
5526 }
5527 if(*s != '"'){
5528 MesPrint("@Illegal name of preprocessor variable to store external channel");
5529 return(-1);
5530 }
5531 *s='\0';
5532 for(s++; *s == ' ' || *s == '\t'; s++);
5533 }
5534
5535 if(*s == '\0'){
5536 MesPrint("@Illegal external command");
5537 return(-1);
5538 }
5539 /*here s is a command*/
5540 /*See the file extcmd.c*/
5541 /*[08may2006 mt]:*/
5542 externalD=openExternalChannel(
5543 s,
5544 AX.daemonize,
5545 AX.shellname,
5546 AX.stderrname);
5547 /*:[08may2006 mt]*/
5548 if(externalD<1){/*error?*/
5549 /*Not quite correct - terminate the program on error:*/
5550 Error1("Can't start external program",s);
5551 return(-1);
5552 }
5553 /*Now external command runs.*/
5554
5555 if(prevar){/*Store the external channel descriptor in the provided variable:*/
5556 UBYTE buf[21];/* 64/Log_2[10] = 19.3, so this is enough forever...*/
5557 NumToStr(buf,externalD);
5558 if ( PutPreVar(prevar,buf,0,1) < 0 ) return(-1);
5559 }
5560
5561 AX.currentExternalChannel=externalD;
5562 /*[08may2006 mt]:*/
5563 if(AX.currentPrompt!=0){/*Change default terminator*/
5564 if(setTerminatorForExternalChannel( (char *)AX.currentPrompt)){
5565 MesPrint("@Prompt is too long");
5566 return(-1);
5567 }
5568 }
5569 setKillModeForExternalChannel(AX.killSignal,AX.killWholeGroup);
5570 /*:[08may2006 mt]*/
5571 return(0);
5572#else /*ifdef WITHEXTERNALCHANNEL*/
5573 Error0("External channel: not implemented on this computer/system");
5574 return(-1);
5575#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5576}
5577
5578/*
5579 #] DoExternal:
5580 #[ DoPrompt:
5581 #prompt string
5582*/
5583
5584int DoPrompt(UBYTE *s)
5585{
5586#ifndef WITHEXTERNALCHANNEL
5587 DUMMYUSE(s);
5588#endif
5589 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5590 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5591
5592#ifdef WITHEXTERNALCHANNEL
5593 while ( *s == ' ' || *s == '\t' ) s++;
5594 if ( AX.currentPrompt )
5595 M_free(AX.currentPrompt,"external channel prompt");
5596 if ( *s == '\0' )
5597 AX.currentPrompt = (UBYTE *)strDup1((UBYTE *)"","external channel prompt");
5598 else
5599 AX.currentPrompt = strDup1(s,"external channel prompt");
5600 if( setTerminatorForExternalChannel( (char *)AX.currentPrompt) > 0 ){
5601 MesPrint("@Prompt is too long");
5602 return(-1);
5603 }
5604 /*else: if 0, ok; if -1, there is no current channel-ok, just prompt is stored.*/
5605 return(0);
5606#else /*ifdef WITHEXTERNALCHANNEL*/
5607 Error0("External channel: not implemented on this computer/system");
5608 return(-1);
5609#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5610}
5611/*
5612 #] DoPrompt:
5613 #[ DoSetExternal:
5614 #setexternal n
5615*/
5616
5617int DoSetExternal(UBYTE *s)
5618{
5619#ifdef WITHEXTERNALCHANNEL
5620 int n=0;
5621#else
5622 DUMMYUSE(s);
5623#endif
5624 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5625 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5626 if ( AP.preError ) return(0);
5627
5628#ifdef WITHEXTERNALCHANNEL
5629 while ( *s == ' ' || *s == '\t' ) s++;
5630 while ( chartype[*s] == 1 ) { n = 10*n + *s++ - '0'; }
5631 while ( *s == ' ' || *s == '\t' ) s++;
5632 if(*s!='\0'){
5633 MesPrint("@setexternal: number expected");
5634 return(-1);
5635 }
5636 if(selectExternalChannel(n)<0){
5637 MesPrint("@setexternal: invalid number");
5638 return(-1);
5639 }
5640 AX.currentExternalChannel=n;
5641 return(0);
5642#else /*ifdef WITHEXTERNALCHANNEL*/
5643 Error0("External channel: not implemented on this computer/system");
5644 return(-1);
5645#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5646}
5647/*
5648 #] DoSetExternal:
5649 #[ DoSetExternalAttr:
5650*/
5651
5652static FORM_INLINE UBYTE *pickupword(UBYTE *s)
5653{
5654
5655 for(;*s>' ';s++)switch(*s){
5656 case '=':
5657 case ',':
5658 case ';':
5659 return(s);
5660 }/*for(;*s>' ';s++)switch(*s)*/
5661 return(s);
5662}
5663/*Returns 0 if the first string (case insensitively) equal to
5664 the beginning of the second string (of length n):
5665*/
5666static inline int strINCmp(UBYTE *a, UBYTE *b, int n)
5667{
5668 for(;n>0;n--)if(tolower(*a++)!=tolower(*b++))
5669 return(1);
5670 return(*a != '\0');
5671}
5672
5673#define KILL "kill"
5674#define KILLALL "killall"
5675#define DAEMON "daemon"
5676#define SHELL "shell"
5677#define STDERR "stderr"
5678
5679#define TRUE_EXPR "true"
5680#define FALSE_EXPR "false"
5681#define NOSHELL "noshell"
5682#define TERMINAL "terminal"
5683
5684/*
5685 Expects comma-separated list of pairs name=value
5686*/
5687int DoSetExternalAttr(UBYTE *s)
5688{
5689#ifdef WITHEXTERNALCHANNEL
5690 int lnam,lval;
5691 UBYTE *nam,*val;
5692#else
5693 DUMMYUSE(s);
5694#endif
5695 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5696 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5697 if ( AP.preError ) return(0);
5698
5699#ifdef WITHEXTERNALCHANNEL
5700 do{
5701 /*Read the name:*/
5702 while ( *s == ' ' || *s == '\t' ) s++;
5703 s=pickupword(nam=s);
5704 lnam=s-nam;
5705 while ( *s == ' ' || *s == '\t' ) s++;
5706 if(*s++!='='){
5707 MesPrint("@External channel:'=' expected instead of %s",s-1);
5708 return(-1);
5709 }
5710 /*Read the value:*/
5711 while ( *s == ' ' || *s == '\t' ) s++;
5712 val=s;
5713
5714 for(;;){
5715 UBYTE *m;
5716 s=pickupword(s);
5717 m=s;
5718 while ( *s == ' ' || *s == '\t' ) s++;
5719 if( (*s == ',')||(*s == '\n')||(*s == ';')||(*s == '\0') ){
5720 s=m;
5721 break;
5722 }
5723 }/*for(;;)*/
5724
5725 lval=s-val;
5726 while ( *s == ' ' || *s == '\t' ) s++;
5727
5728 if(strINCmp((UBYTE *)SHELL,nam,lnam)==0){
5729 if(AX.shellname!=NULL)
5730 M_free(AX.shellname,"external channel shellname");
5731 if(strINCmp((UBYTE *)NOSHELL,val,lval)==0)
5732 AX.shellname=NULL;
5733 else{
5734 UBYTE *ch,*b;
5735 b=ch=AX.shellname=Malloc1(lval+1,"external channel shellname");
5736 while(ch-b<lval)
5737 *ch++=*val++;
5738 *ch='\0';
5739 }
5740 }else if(strINCmp((UBYTE *)DAEMON,nam,lnam)==0){
5741 if(strINCmp((UBYTE *)TRUE_EXPR,val,lval)==0)
5742 AX.daemonize = 1;
5743 else if(strINCmp((UBYTE *)FALSE_EXPR,val,lval)==0)
5744 AX.daemonize = 0;
5745 else{
5746 MesPrint("@External channel:true or false expected for %s",DAEMON);
5747 return(-1);
5748 }
5749 }else if(strINCmp((UBYTE *)KILLALL,nam,lnam)==0){
5750 if(strINCmp((UBYTE *)TRUE_EXPR,val,lval)==0)
5751 AX.killWholeGroup = 1;
5752 else if(strINCmp((UBYTE *)FALSE_EXPR,val,lval)==0)
5753 AX.killWholeGroup = 0;
5754 else{
5755 MesPrint("@External channel: true or false expected for %s",KILLALL);
5756 return(-1);
5757 }
5758 }else if(strINCmp((UBYTE *)KILL,nam,lnam)==0){
5759 int i,n=0;
5760 for(i=0;i<lval;i++) {
5761 if( *val>='0' && *val<= '9' )
5762 n = 10*n + *val++ - '0';
5763 else{
5764 MesPrint("@External channel: number expected for %s",KILL);
5765 return(-1);
5766 }
5767 }
5768 AX.killSignal=n;
5769 }else if(strINCmp((UBYTE *)STDERR,nam,lnam)==0){
5770 if( AX.stderrname != NULL ) {
5771 M_free(AX.stderrname,"external channel stderrname");
5772 }
5773 if(strINCmp((UBYTE *)TERMINAL,val,lval)==0)
5774 AX.stderrname = NULL;
5775 else{
5776 UBYTE *ch,*b;
5777 b=ch=AX.stderrname=Malloc1(lval+1,"external channel stderrname");
5778 while(ch-b<lval)
5779 *ch++=*val++;
5780 *ch='\0';
5781 }
5782 }else{
5783 nam[lnam+1]='\0';
5784 MesPrint("@External channel: unrecognized attribute",nam);
5785 return(-1);
5786 }
5787 }while(*s++ == ',');
5788 if( (*(s-1)>' ')&&(*(s-1)!=';') ){
5789 MesPrint("@External channel: syntax error: %s",s-1);
5790 return(-1);
5791 }
5792 return(0);
5793#else /*ifdef WITHEXTERNALCHANNEL*/
5794 Error0("External channel: not implemented on this computer/system");
5795 return(-1);
5796#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5797}
5798/*
5799 #] DoSetExternalAttr:
5800 #[ DoRmExternal:
5801 #rmexternal [n] (if 0, close all)
5802*/
5803
5804int DoRmExternal(UBYTE *s)
5805{
5806#ifdef WITHEXTERNALCHANNEL
5807 int n = -1;
5808#else
5809 DUMMYUSE(s);
5810#endif
5811 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5812 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5813 if ( AP.preError ) return(0);
5814
5815#ifdef WITHEXTERNALCHANNEL
5816 while ( *s == ' ' || *s == '\t' ) s++;
5817 if( chartype[*s] == 1 ){
5818 for(n=0; chartype[*s] == 1 ; s++) { n = 10*n + *s - '0'; }
5819 while ( *s == ' ' || *s == '\t' ) s++;
5820 }
5821 if(*s!='\0'){
5822 MesPrint("@rmexternal: invalid number");
5823 return(-1);
5824 }
5825 switch(n){
5826 case 0:/*Close all opened channels*/
5827 closeAllExternalChannels();
5828 AX.currentExternalChannel=0;
5829 /*Do not clean AX.currentPrompt!*/
5830 return(0);
5831 case -1:/*number is not specified - try current*/
5832 n=AX.currentExternalChannel;
5833 /* fall through */
5834 default:
5835 closeExternalChannel(n);/*No reaction for possible error*/
5836 }
5837 if (n == AX.currentExternalChannel)/*cleaned up by closeExternalChannel()*/
5838 AX.currentExternalChannel=0;
5839 return(0);
5840#else /*ifdef WITHEXTERNALCHANNEL*/
5841 Error0("External channel: not implemented on this computer/system");
5842 return(-1);
5843#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5844
5845}
5846/*
5847 #] DoRmExternal:
5848 #[ DoFromExternal :
5849 #fromexternal
5850 is used to read the text from the running external
5851 program, the syntax is similar to the #include
5852 directive.
5853 #fromexternal "varname"
5854 is used to read the text from the running external
5855 program into the preprocessor variable varname.
5856 directive.
5857 #fromexternal "varname" maxlength
5858 is used to read the text from the running external
5859 program into the preprocessor variable varname.
5860 directive. Only first maxlength characters are
5861 stored.
5862
5863 FORM continues to read the running external
5864 program output until the external program outputs a
5865 prompt.
5866
5867*/
5868
5869int DoFromExternal(UBYTE *s)
5870{
5871#ifdef WITHEXTERNALCHANNEL
5872 UBYTE *prevar=0;
5873 int lbuf=-1;
5874 int withNoList=AC.NoShowInput;
5875 int oldpreassignflag;
5876#else
5877 DUMMYUSE(s);
5878#endif
5879 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5880 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5881 if ( AP.preError ) return(0);
5882#ifdef WITHEXTERNALCHANNEL
5883
5884 FLUSHCONSOLE;
5885
5886 while ( *s == ' ' || *s == '\t' ) s++;
5887 /*[17may2006 mt]:*/
5888 if ( *s == '-' || *s == '+' ) {
5889 if ( *s == '-' )
5890 withNoList = 1;
5891 else
5892 withNoList = 0;
5893 s++;
5894 while ( *s == ' ' || *s == '\t' ) s++;
5895 }/*if ( *s == '-' || *s == '+' )*/
5896 /*:[17may2006 mt]*/
5897 /*[02feb2006 mt]:*/
5898 if(*s == '"'){/*prevar to store the output is defined*/
5899 prevar=++s;
5900
5901 if ( *s=='$' || chartype[*s] == 0 )for(;*s != '"'; s++)switch(chartype[*s]){
5902 case 10:/*'\0' fits here*/
5903 MesPrint("@Can't finde closing \"");
5904 Terminate(-1);
5905 case 0:case 1: continue;
5906 default:
5907 break;
5908 }
5909 if(*s != '"'){
5910 MesPrint("@Illegal name to store output of external channel");
5911 return(-1);
5912 }
5913 *s='\0';
5914 for(s++; *s == ' ' || *s == '\t'; s++);
5915 }/*if(*s == '"')*/
5916
5917 if(*s != '\0'){
5918 if( chartype[*s] == 1 ){
5919 for(lbuf=0; chartype[*s] == 1 ; s++) { lbuf = 10*lbuf + *s - '0'; }
5920 while ( *s == ' ' || *s == '\t' ) s++;
5921 }
5922 if( (*s!='\0')||(lbuf<0) ){
5923 MesPrint("@Illegal buffer length in fromexternal");
5924 return(-1);
5925 }
5926 }/*if(*s != '\0')*/
5927 /*:[02feb20006 mt]*/
5928 if(getCurrentExternalChannel()!=AX.currentExternalChannel)
5929 /*[08may20006 mt]:*/
5930 /*selectExternalChannel(AX.currentExternalChannel);*/
5931 if(selectExternalChannel(AX.currentExternalChannel)){
5932 MesPrint("@No current external channel");
5933 return(-1);
5934 }
5935 /*:[08may20006 mt]*/
5936
5937 /*[02feb2006 mt]:*/
5938 if(prevar!=0){/*The result must be stored into preprovar*/
5939 UBYTE *buf;
5940 int cc = 0;
5941 if(lbuf == -1){/*Unlimited buffer, everything must be stored*/
5942 int i;
5943 buf=Malloc1( (lbuf=255)+1,"Fromexternal");
5944 /*[18may20006 mt]:*/
5945 /*for(i=0;(cc=getcFromExtChannel())!=EOF;i++){*/
5946 /* May 2006: now getcFromExtChannelOk returns EOF while
5947 getcFromExtChannelFailure returns -2 (see comments in
5948 exctcmd.c):*/
5949 for(i=0;(cc=getcFromExtChannel())>0;i++){
5950 /*:[18may20006 mt]*/
5951 if(i==lbuf){
5952 int j;
5953 UBYTE *tmp=Malloc1( (lbuf*=2)+1,"Fromexternal");
5954 for(j=0;j<i;j++)tmp[j]=buf[j];
5955 M_free(buf,"Fromexternal");
5956 buf=tmp;
5957 }
5958 buf[i]=(UBYTE)(cc);
5959 }/*for(i=0;(cc=getcFromExtChannel())>0;i++)*/
5960 /*[18may20006 mt]:*/
5961 if(cc == -2){
5962 MesPrint("@No current external channel");
5963 return(-1);
5964 }
5965 lbuf=i;
5966 /*:[18may20006 mt]*/
5967 buf[i]='\0';
5968 }else{/*Fixed buffer, only lbuf chars must be stored*/
5969 int i;
5970 buf=Malloc1(lbuf+1,"Fromexternal");
5971 for(i=0; i<lbuf;i++){
5972 /*[18may20006 mt]:*/
5973 /*if( (cc=getcFromExtChannel())==EOF )*/
5974 /* May 2006: now getcFromExtChannelOk returns EOF while
5975 getcFromExtChannelFailure returns -2 (see comments in
5976 exctcmd.c):*/
5977 if( (cc=getcFromExtChannel())<1 )
5978 /*:[18may20006 mt]*/
5979 break;
5980 buf[i]=(UBYTE)(cc);
5981 }
5982 buf[i]='\0';
5983 /*[18may20006 mt]:*/
5984 /*if(cc!=EOF)
5985 while(getcFromExtChannel()!=EOF);*//*Eat the rest*/
5986 /* May 2006: now getcFromExtChannelOk returns EOF while
5987 getcFromExtChannelFailure returns -2 (see comments in
5988 exctcmd.c):*/
5989 if(cc>0)
5990 while(getcFromExtChannel()>0);/*Eat the rest*/
5991 else if(cc == -2){
5992 MesPrint("@No current external channel");
5993 return(-1);
5994 }
5995 /*:[18may20006 mt]*/
5996 }
5997 /*[18may20006 mt]:*/
5998 if(*prevar == '$'){/*Put the answer to the dollar variable*/
5999 int oldNumPotModdollars = NumPotModdollars;
6000#ifdef WITHMPI
6001 WORD oldRhsExprInModuleFlag = AC.RhsExprInModuleFlag;
6002 AC.RhsExprInModuleFlag = 0;
6003#endif
6004 /*Here lbuf is the actual length of buf!*/
6005 /*"prevar=buf'\0'":*/
6006 UBYTE *pbuf=Malloc1(StrLen(prevar)+1+lbuf+1,"Fromexternal to dollar");
6007 UBYTE *c=pbuf;
6008 UBYTE *b=prevar;
6009 while(*b!='\0'){*c++ = *b++;}
6010 *c++='=';
6011 b=buf;
6012 while( (*c++=*b++)!='\0' );
6013 oldpreassignflag = AP.PreAssignFlag;
6014 AP.PreAssignFlag = 1;
6015 if ( ( cc = CompileStatement(pbuf) ) || ( cc = CatchDollar(0) ) ) {
6016 Error1("External channel: can't asign output to dollar variable ",prevar);
6017 }
6018 AP.PreAssignFlag = oldpreassignflag;
6019 NumPotModdollars = oldNumPotModdollars;
6020#ifdef WITHMPI
6021 AC.RhsExprInModuleFlag = oldRhsExprInModuleFlag;
6022#endif
6023 M_free(pbuf,"Fromexternal to dollar");
6024 }else{
6025 cc = PutPreVar(prevar, buf, 0, 1) < 0;
6026 }
6027 /*:[18may20006 mt]*/
6028 M_free(buf,"Fromexternal");
6029 if ( cc ) return(-1);
6030 return(0);
6031 }
6032 /*:[02feb2006 mt]*/
6033 if ( OpenStream(s,EXTERNALCHANNELSTREAM,0,PRENOACTION) == 0 ) return(-1);
6034 /*[17may2006 mt]:*/
6035 AC.NoShowInput = withNoList;
6036 /*:[17may2006 mt]*/
6037 return(0);
6038#else
6039 Error0("External channel: not implemented on this computer/system");
6040 return(-1);
6041#endif
6042}
6043
6044/*
6045 #] DoFromExternal :
6046 #[ DoToExternal :
6047 #toexetrnal
6048*/
6049
6050#ifdef WITHEXTERNALCHANNEL
6051
6052/*A wrapper to writeBufToExtChannel, see the file extcmd.c:*/
6053LONG WriteToExternalChannel(int handle, UBYTE *buffer, LONG size)
6054{
6055 /*ATT! handle is not used! Actual output is performed to
6056 the current external channel, see extcmd.c!*/
6057 DUMMYUSE(handle);
6058 if(writeBufToExtChannel((char*)buffer,size))
6059 return(-1);
6060 return(size);
6061}
6062#endif /*ifdef WITHEXTERNALCHANNEL*/
6063
6064int DoToExternal(UBYTE *s)
6065{
6066#ifdef WITHEXTERNALCHANNEL
6067 HANDLERS h;
6068 LONG (*OldWrite)(int handle, UBYTE *buffer, LONG size) = WriteFile;
6069 int ret=-1;
6070#else
6071 DUMMYUSE(s);
6072#endif
6073 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
6074 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
6075 if ( AP.preError ) return(0);
6076#ifdef WITHEXTERNALCHANNEL
6077
6078 h.oldsilent=AM.silent;
6079 h.newlogonly = h.oldlogonly = AM.FileOnlyFlag;
6080 h.newhandle = h.oldhandle = AC.LogHandle;
6081 h.oldprinttype = AO.PrintType;
6082
6083 WriteFile=&WriteToExternalChannel;
6084
6085 while ( *s == ' ' || *s == '\t' ) s++;
6086
6087 if(AX.currentExternalChannel==0){
6088 MesPrint("@No current external channel");
6089 goto DoToExternalReady;
6090 }
6091
6092 if(getCurrentExternalChannel()!=AX.currentExternalChannel)
6093 selectExternalChannel(AX.currentExternalChannel);
6094
6095 ret=writeToChannel(EXTERNALCHANNELOUT,s,&h);
6096 DoToExternalReady:
6097 WriteFile=OldWrite;
6098 return(ret);
6099#else /*ifdef WITHEXTERNALCHANNEL*/
6100 Error0("External channel: not implemented on this computer/system");
6101 return(-1);
6102#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
6103
6104}
6105
6106/*
6107 #] DoToExternal :
6108 #[ defineChannel :
6109*/
6110
6111UBYTE *defineChannel(UBYTE *s, HANDLERS *h)
6112{
6113 UBYTE *name,*to;
6114
6115 if ( *s != '<' )
6116 return(s);
6117
6118 s++;
6119 name = to = s;
6120 while ( *s && *s != '>' ) {
6121 if ( *s == '\\' ) s++;
6122 *to++ = *s++;
6123 }
6124 if ( *s == 0 ) {
6125 MesPrint("@Improper termination of filename");
6126 return(0);
6127 }
6128 s++;
6129 *to = 0;
6130 if ( *name ) {
6131 h->newhandle = GetChannel((char *)name,0);
6132 h->newlogonly = 1;
6133 }
6134 else if ( AC.LogHandle >= 0 ) {
6135 h->newhandle = AC.LogHandle;
6136 h->newlogonly = 1;
6137 }
6138 return(s);
6139}
6140
6141/*
6142 #] defineChannel :
6143 #[ writeToChannel :
6144*/
6145
6146int writeToChannel(int wtype, UBYTE *s, HANDLERS *h)
6147{
6148 UBYTE *to, *fstring, *ss, *sss, *s1, c, c1;
6149 WORD num, number, nfac;
6150 WORD oldOptimizationLevel;
6151 UBYTE Out[MAXLINELENGTH+14], *stopper;
6152 int nosemi, i;
6153 int plus = 0;
6154
6155/*
6156 Now determine the format string
6157*/
6158 while ( *s == ',' || *s == ' ' ) s++;
6159 if ( *s != '"' ) {
6160 MesPrint("@No format string present");
6161 return(-1);
6162 }
6163 s++; fstring = to = s;
6164 while ( *s ) {
6165 if ( *s == '\\' ) {
6166 s++;
6167 if ( *s == '\\' ) {
6168 *to++ = *s++;
6169 if ( *s == '\\' ) *to++ = *s++;
6170 }
6171 else if ( *s == '"' ) *to++ = *s++;
6172 else { *to++ = '\\'; *to++ = *s++; }
6173 }
6174 else if ( *s == '"' ) break;
6175 else *to++ = *s++;
6176 }
6177 if ( *s != '"' ) {
6178 MesPrint("@No closing \" in format string");
6179 return(-1);
6180 }
6181 *to = 0; s++;
6182 if ( AC.LineLength > 20 && AC.LineLength <= MAXLINELENGTH ) stopper = Out + AC.LineLength;
6183 else stopper = Out + MAXLINELENGTH;
6184 to = Out;
6185/*
6186 s points now at the list of objects (if any)
6187 we can start executing the format string.
6188*/
6189 AM.silent = 0;
6190 AC.LogHandle = h->newhandle;
6191 AM.FileOnlyFlag = h->newlogonly;
6192 if ( h->newhandle >= 0 ) {
6193 AO.PrintType |= PRINTLFILE;
6194 }
6195 while ( *fstring ) {
6196 if ( to >= stopper ) {
6197 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6198 *to++ = '&';
6199 }
6200 num = to - Out;
6201 WriteString(wtype,Out,num);
6202 to = Out;
6203 if ( AC.OutputMode == FORTRANMODE
6204 || AC.OutputMode == PFORTRANMODE ) {
6205 number = 7;
6206 for ( i = 0; i < number; i++ ) *to++ = ' ';
6207 to[-2] = '&';
6208 }
6209 }
6210 if ( *fstring == '\\' ) {
6211 fstring++;
6212 if ( *fstring == 'n' ) {
6213 num = to - Out;
6214 WriteString(wtype,Out,num);
6215 to = Out;
6216 fstring++;
6217 }
6218 else if ( *fstring == 't' ) { *to++ = '\t'; fstring++; }
6219 else if ( *fstring == 'b' ) { *to++ = '\\'; fstring++; }
6220 else *to++ = *fstring++;
6221 }
6222 else if ( *fstring == '%' ) {
6223 plus = 0;
6224retry:
6225 fstring++;
6226 if ( *fstring == 'd' ) {
6227 int sign,dig;
6228 number = -1;
6229donumber:
6230 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6231 sign = 1;
6232 while ( *s == '+' || *s == '-' ) {
6233 if ( *s == '-' ) sign = -sign;
6234 s++;
6235 }
6236 dig = 0; ss = s; if ( sign < 0 ) { ss--; *ss = '-'; dig++; }
6237 while ( *s >= '0' && *s <= '9' ) { s++; dig++; }
6238 if ( number < 0 ) {
6239 while ( ss < s ) {
6240 if ( to >= stopper ) {
6241 num = to - Out;
6242 WriteString(wtype,Out,num);
6243 to = Out;
6244 }
6245 if ( *ss == '\\' ) ss++;
6246 *to++ = *ss++;
6247 }
6248 }
6249 else {
6250 if ( number < dig ) { dig = number; ss = s - dig; }
6251 while ( number > dig ) {
6252 if ( to >= stopper ) {
6253 num = to - Out;
6254 WriteString(wtype,Out,num);
6255 to = Out;
6256 }
6257 *to++ = ' '; number--;
6258 }
6259 while ( ss < s ) {
6260 if ( to >= stopper ) {
6261 num = to - Out;
6262 WriteString(wtype,Out,num);
6263 to = Out;
6264 }
6265 if ( *ss == '\\' ) ss++;
6266 *to++ = *ss++;
6267 }
6268 }
6269 fstring++;
6270 }
6271 else if ( *fstring == '$' ) {
6272 UBYTE *dolalloc;
6273 number = AO.OutSkip;
6274dodollar:
6275 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6276 if ( AC.OutputMode == FORTRANMODE
6277 || AC.OutputMode == PFORTRANMODE ) {
6278 number = 7;
6279 }
6280 if ( *s != '$' ) {
6281nodollar: MesPrint("@$-variable expected in #write instruction");
6282 AM.FileOnlyFlag = h->oldlogonly;
6283 AC.LogHandle = h->oldhandle;
6284 AO.PrintType = h->oldprinttype;
6285 AM.silent = h->oldsilent;
6286 return(-1);
6287 }
6288 s++; ss = s;
6289 while ( chartype[*s] <= 1 ) s++;
6290 if ( s == ss ) goto nodollar;
6291 c = *s; *s = 0;
6292 num = GetDollar(ss);
6293 if ( num < 0 ) {
6294 MesPrint("@#write instruction: $%s has not been defined",ss);
6295 AM.FileOnlyFlag = h->oldlogonly;
6296 AC.LogHandle = h->oldhandle;
6297 AO.PrintType = h->oldprinttype;
6298 AM.silent = h->oldsilent;
6299 return(-1);
6300 }
6301 *s = c;
6302 if ( *s == '[' ) {
6303 if ( Dollars[num].nfactors <= 0 ) {
6304 *s = 0;
6305 MesPrint("@#write instruction: $%s has not been factorized",ss);
6306 AM.FileOnlyFlag = h->oldlogonly;
6307 AC.LogHandle = h->oldhandle;
6308 AO.PrintType = h->oldprinttype;
6309 AM.silent = h->oldsilent;
6310 return(-1);
6311 }
6312/*
6313 Now get the number between the []
6314*/
6315 nfac = GetDollarNumber(&s,Dollars+num);
6316
6317 if ( Dollars[num].nfactors == 1 && nfac == 1 ) goto writewhole;
6318
6319 if ( ( dolalloc = WriteDollarFactorToBuffer(num,nfac,0) ) == 0 ) {
6320 AM.FileOnlyFlag = h->oldlogonly;
6321 AC.LogHandle = h->oldhandle;
6322 AO.PrintType = h->oldprinttype;
6323 AM.silent = h->oldsilent;
6324 return(-1);
6325 }
6326 goto writealloc;
6327 }
6328 else if ( *s && *s != ' ' && *s != ',' && *s != '\t' ) {
6329 MesPrint("@#write instruction: illegal characters after $-variable");
6330 AM.FileOnlyFlag = h->oldlogonly;
6331 AC.LogHandle = h->oldhandle;
6332 AO.PrintType = h->oldprinttype;
6333 AM.silent = h->oldsilent;
6334 return(-1);
6335 }
6336 else {
6337writewhole:
6338 if ( ( dolalloc = WriteDollarToBuffer(num,0) ) == 0 ) {
6339 AM.FileOnlyFlag = h->oldlogonly;
6340 AC.LogHandle = h->oldhandle;
6341 AO.PrintType = h->oldprinttype;
6342 AM.silent = h->oldsilent;
6343 return(-1);
6344 }
6345 else {
6346writealloc:
6347 ss = dolalloc;
6348 while ( *ss ) {
6349 if ( to >= stopper ) {
6350 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6351 *to++ = '&';
6352 }
6353 num = to - Out;
6354 WriteString(wtype,Out,num);
6355 to = Out;
6356 for ( i = 0; i < number; i++ ) *to++ = ' ';
6357 if ( AC.OutputMode == FORTRANMODE
6358 || AC.OutputMode == PFORTRANMODE ) to[-2] = '&';
6359 }
6360 if ( chartype[*ss] > 3 ) { *to++ = *ss++; }
6361 else {
6362 sss = ss; while ( chartype[*ss] <= 3 ) ss++;
6363 if ( ( to + (ss-sss) ) >= stopper ) {
6364 if ( (ss-sss) >= (stopper-Out) ) {
6365 if ( ( to - stopper ) < 10 ) {
6366 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6367 *to++ = '&';
6368 }
6369 num = to - Out;
6370 WriteString(wtype,Out,num);
6371 to = Out;
6372 for ( i = 0; i < number; i++ ) *to++ = ' ';
6373 if ( AC.OutputMode == FORTRANMODE
6374 || AC.OutputMode == PFORTRANMODE ) to[-2] = '&';
6375 }
6376 while ( (ss-sss) >= (stopper-Out) ) {
6377 while ( to < stopper-1 ) {
6378 *to++ = *sss++;
6379 }
6380 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6381 *to++ = '&';
6382 }
6383 else {
6384 *to++ = '\\';
6385 }
6386 num = to - Out;
6387 WriteString(wtype,Out,num);
6388 to = Out;
6389 if ( AC.OutputMode == FORTRANMODE
6390 || AC.OutputMode == PFORTRANMODE ) {
6391 for ( i = 0; i < number; i++ ) *to++ = ' ';
6392 to[-2] = '&';
6393 }
6394 }
6395 }
6396 else {
6397 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6398 *to++ = '&';
6399 }
6400 num = to - Out;
6401 WriteString(wtype,Out,num);
6402 to = Out;
6403 for ( i = 0; i < number; i++ ) *to++ = ' ';
6404 if ( AC.OutputMode == FORTRANMODE
6405 || AC.OutputMode == PFORTRANMODE ) to[-2] = '&';
6406 }
6407 }
6408 while ( sss < ss ) *to++ = *sss++;
6409 }
6410 }
6411 }
6412 M_free(dolalloc,"written dollar");
6413 fstring++;
6414 }
6415 }
6416 else if ( *fstring == 's' ) {
6417 fstring++;
6418 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6419 if ( *s == '"' ) {
6420 s++; ss = s;
6421 while ( *s ) {
6422 if ( *s == '\\' ) s++;
6423 else if ( *s == '"' ) break;
6424 s++;
6425 }
6426 if ( *s == 0 ) {
6427 MesPrint("@#write instruction: Missing \" in string");
6428 AM.FileOnlyFlag = h->oldlogonly;
6429 AC.LogHandle = h->oldhandle;
6430 AO.PrintType = h->oldprinttype;
6431 AM.silent = h->oldsilent;
6432 return(-1);
6433 }
6434 while ( ss < s ) {
6435 if ( to >= stopper ) {
6436 num = to - Out;
6437 WriteString(wtype,Out,num);
6438 to = Out;
6439 }
6440 if ( *ss == '\\' ) ss++;
6441 *to++ = *ss++;
6442 }
6443 s++;
6444 }
6445 else {
6446 sss = ss = s;
6447 while ( *s && *s != ',' ) {
6448 if ( *s == '\\' ) { s++; sss = s+1; }
6449 s++;
6450 }
6451 while ( s > sss+1 && ( s[-1] == ' ' || s[-1] == '\t' ) ) s--;
6452 while ( ss < s ) {
6453 if ( to >= stopper ) {
6454 num = to - Out;
6455 WriteString(wtype,Out,num);
6456 to = Out;
6457 }
6458 if ( *ss == '\\' ) ss++;
6459 *to++ = *ss++;
6460 }
6461 }
6462 }
6463 else if ( *fstring == 'X' ) {
6464 fstring++;
6465 if ( cbuf[AM.sbufnum].numrhs > 0 ) {
6466/*
6467 This should be only to the value of AM.oldnumextrasymbols
6468*/
6469 UBYTE *s = GetPreVar(AM.oldnumextrasymbols,0);
6470 WORD x = 0;
6471 while ( *s >= '0' && *s <= '9' ) x = 10*x + *s++ - '0';
6472 if ( x > 0 )
6473 PrintSubtermList(1,x);
6474 else
6475 PrintSubtermList(1,cbuf[AM.sbufnum].numrhs);
6476 }
6477 }
6478 else if ( *fstring == 'O' ) {
6479 number = AO.OutSkip;
6480dooptim:
6481 fstring++;
6482/*
6483 First test whether there is an optimization buffer
6484*/
6485 if ( AO.OptimizeResult.code == NULL && AO.OptimizationLevel != 0 ) {
6486 MesPrint("@In #write instruction: no optimization results available!");
6487 return(-1);
6488 }
6489 num = to - Out;
6490 WriteString(wtype,Out,num);
6491 to = Out;
6492 if ( AO.OptimizationLevel != 0 ) {
6493 WORD oldoutskip = AO.OutSkip;
6494 AO.OutSkip = number;
6495 optimize_print_code(0);
6496 AO.OutSkip = oldoutskip;
6497 }
6498 }
6499 else if ( *fstring == 'e' || *fstring == 'E' ) {
6500 if ( *fstring == 'E'
6501 || AC.OutputMode == FORTRANMODE
6502 || AC.OutputMode == PFORTRANMODE ) nosemi = 1;
6503 else nosemi = 0;
6504 fstring++;
6505 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6506 if ( chartype[*s] != 0 && *s != '[' ) {
6507noexpr: MesPrint("@expression name expected in #write instruction");
6508 AM.FileOnlyFlag = h->oldlogonly;
6509 AC.LogHandle = h->oldhandle;
6510 AO.PrintType = h->oldprinttype;
6511 AM.silent = h->oldsilent;
6512 return(-1);
6513 }
6514 ss = s;
6515 if ( ( s = SkipAName(ss) ) == 0 || s[-1] == '_' ) goto noexpr;
6516 s1 = s; c = c1 = *s1;
6517 if ( c1 == '(' ) {
6518 SKIPBRA3(s)
6519 if ( *s == ')' ) {
6520 AO.CurBufWrt = s1+1;
6521 c = *s; *s = 0;
6522 }
6523 else {
6524 MesPrint("@Illegal () specifier in expression name in #write");
6525 AM.FileOnlyFlag = h->oldlogonly;
6526 AC.LogHandle = h->oldhandle;
6527 AO.PrintType = h->oldprinttype;
6528 AM.silent = h->oldsilent;
6529 return(-1);
6530 }
6531 }
6532 else AO.CurBufWrt = (UBYTE *)underscore;
6533 *s1 = 0;
6534 num = to - Out;
6535 if ( num > 0 ) WriteUnfinString(wtype,Out,num);
6536 to = Out;
6537 oldOptimizationLevel = AO.OptimizationLevel;
6538 AO.OptimizationLevel = 0;
6539 if ( WriteOne(ss,(int)num,nosemi,plus) < 0 ) {
6540 AM.FileOnlyFlag = h->oldlogonly;
6541 AC.LogHandle = h->oldhandle;
6542 AO.PrintType = h->oldprinttype;
6543 AM.silent = h->oldsilent;
6544 return(-1);
6545 }
6546 AO.OptimizationLevel = oldOptimizationLevel;
6547 *s1 = c1;
6548 if ( s > s1 ) *s++ = c;
6549 }
6550/*
6551 File content
6552*/
6553 else if ( ( *fstring == 'f' ) || ( *fstring == 'F' ) ) {
6554 LONG n;
6555 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6556 ss = s;
6557 while ( *s && *s != ',' ) {
6558 if ( *s == '\\' ) s++;
6559 s++;
6560 }
6561 c = *s; *s = 0;
6562 s1 = LoadInputFile(ss,HEADERFILE);
6563 *s = c;
6564/*
6565 There should have been a way to pass the file size.
6566 Also there should be conversions for \r\n etc.
6567*/
6568 if ( s1 ) {
6569 ss = s1; while ( *ss ) ss++;
6570 n = ss-s1;
6571 WriteString(wtype,s1,n);
6572 M_free(s1,"copy file");
6573 }
6574 else if ( *fstring == 'F' ) {
6575 *s = 0;
6576 MesPrint("@Error in #write: could not open file %s",ss);
6577 *s = c;
6578 goto ReturnWithError;
6579 }
6580 fstring++;
6581 }
6582 else if ( *fstring == '%' ) {
6583 *to++ = *fstring++;
6584 }
6585 else if ( FG.cTable[*fstring] == 1 ) { /* %#S */
6586 number = 0;
6587 while ( FG.cTable[*fstring] == 1 ) {
6588 number = 10*number + *fstring++ - '0';
6589 }
6590 if ( *fstring == 'O' ) goto dooptim;
6591 else if ( *fstring == 'd' ) goto donumber;
6592 else if ( *fstring == '$' ) goto dodollar;
6593 else if ( *fstring == 't' ) { /* `tab' position */
6594 if ( number < (WORD)(stopper-Out) ) {
6595 while ( (WORD)(to-Out) < number ) *to++ = ' ';
6596 }
6597 fstring++;
6598 }
6599 else if ( *fstring == 'X' || *fstring == 'x' ) {
6600 if ( number > 0 && number <= cbuf[AM.sbufnum].numrhs ) {
6601 UBYTE buffer[80], *out, *old1, *old2, *old3;
6602 WORD *term, first;
6603 if ( *fstring == 'X' ) {
6604 out = StrCopy((UBYTE *)AC.extrasym,buffer);
6605 if ( AC.extrasymbols == 0 ) {
6606 out = NumCopy(number,out);
6607 out = StrCopy((UBYTE *)"_",out);
6608 }
6609 else if ( AC.extrasymbols == 1 ) {
6610 if ( AC.OutputMode == CMODE ) {
6611 out = StrCopy((UBYTE *)"[",out);
6612 out = NumCopy(number,out);
6613 out = StrCopy((UBYTE *)"]",out);
6614 }
6615 else {
6616 out = StrCopy((UBYTE *)"(",out);
6617 out = NumCopy(number,out);
6618 out = StrCopy((UBYTE *)")",out);
6619 }
6620 }
6621 out = StrCopy((UBYTE *)"=",out);
6622 ss = buffer;
6623 while ( ss < out ) {
6624 if ( to >= stopper ) {
6625 num = to - Out;
6626 WriteString(wtype,Out,num);
6627 to = Out;
6628 }
6629 *to++ = *ss++;
6630 }
6631 }
6632 term = cbuf[AM.sbufnum].rhs[number];
6633 first = 1;
6634 if ( *term == 0 ) {
6635 *to++ = '0';
6636 }
6637 else {
6638 old1 = AO.OutFill;
6639 old2 = AO.OutputLine;
6640 old3 = AO.OutStop;
6641 AO.OutFill = to;
6642 AO.OutputLine = Out;
6643 AO.OutStop = Out + AC.LineLength;
6644 while ( *term ) {
6645 if ( WriteInnerTerm(term,first) ) Terminate(-1);
6646 term += *term;
6647 first = 0;
6648 }
6649 to = Out + (AO.OutFill-AO.OutputLine);
6650 AO.OutFill = old1;
6651 AO.OutputLine = old2;
6652 AO.OutStop = old3;
6653 }
6654 }
6655 fstring++;
6656 }
6657 else {
6658 goto IllegControlSequence;
6659 }
6660 }
6661 else if ( *fstring == '+' ) {
6662 plus = 1; goto retry;
6663 }
6664 else if ( *fstring == 0 ) {
6665 *to++ = 0;
6666 }
6667 else {
6668IllegControlSequence:
6669 MesPrint("@Illegal control sequence in format string in #write instruction");
6670ReturnWithError:
6671 AM.FileOnlyFlag = h->oldlogonly;
6672 AC.LogHandle = h->oldhandle;
6673 AO.PrintType = h->oldprinttype;
6674 AM.silent = h->oldsilent;
6675 return(-1);
6676 }
6677 }
6678 else {
6679 *to++ = *fstring++;
6680 }
6681 }
6682/*
6683 Now flush the output
6684*/
6685 num = to - Out;
6686 /*[15apr2004 mt]:*/
6687 if(wtype==EXTERNALCHANNELOUT){
6688 if(num!=0)
6689 WriteUnfinString(wtype,Out,num);
6690 }else
6691 /*:[15apr2004 mt]*/
6692 WriteString(wtype,Out,num);
6693/*
6694 and restore original parameters
6695*/
6696 AM.FileOnlyFlag = h->oldlogonly;
6697 AC.LogHandle = h->oldhandle;
6698 AO.PrintType = h->oldprinttype;
6699 AM.silent = h->oldsilent;
6700 return(0);
6701}
6702
6703/*
6704 #] writeToChannel :
6705 #[ DoFactDollar :
6706
6707 Executes the #factdollar $var
6708 instruction
6709*/
6710
6711int DoFactDollar(UBYTE *s)
6712{
6713 GETIDENTITY
6714 WORD numdollar, *oldworkpointer;
6715
6716 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
6717 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
6718 while ( *s == ' ' || *s == '\t' ) s++;
6719 if ( *s == '$' ) {
6720 if ( GetName(AC.dollarnames,s+1,&numdollar,NOAUTO) != CDOLLAR ) {
6721 MesPrint("@%s is undefined",s);
6722 return(-1);
6723 }
6724 s = SkipAName(s+1);
6725 if ( *s != 0 ) {
6726 MesPrint("@#FactDollar should have a single $variable for its argument");
6727 return(-1);
6728 }
6729 NewSort(BHEAD0);
6730 oldworkpointer = AT.WorkPointer;
6731 if ( DollarFactorize(BHEAD numdollar) ) return(-1);
6732 AT.WorkPointer = oldworkpointer;
6733 LowerSortLevel();
6734 return(0);
6735 }
6736 else if ( ParenthesesTest(s) ) return(-1);
6737 else {
6738 MesPrint("@#FactDollar should have a single $variable for its argument");
6739 return -1;
6740 }
6741}
6742
6743/*
6744 #] DoFactDollar :
6745 #[ GetDollarNumber :
6746*/
6747
6748WORD GetDollarNumber(UBYTE **inp, DOLLARS d)
6749{
6750 UBYTE *s = *inp, c, *name;
6751 WORD number, nfac, *w;
6752 DOLLARS dd;
6753 s++;
6754 if ( *s == '$' ) {
6755 s++; name = s;
6756 while ( FG.cTable[*s] < 2 ) s++;
6757 c = *s; *s = 0;
6758 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6759 MesPrint("@dollar in #write should have been defined previously");
6760 Terminate(-1);
6761 }
6762 *s = c;
6763 dd = Dollars + number;
6764 if ( c == '[' ) {
6765 *inp = s;
6766 nfac = GetDollarNumber(inp,dd);
6767 s = *inp;
6768 if ( *s != ']' ) {
6769 MesPrint("@Illegal factor for dollar variable");
6770 Terminate(-1);
6771 }
6772 *inp = s+1;
6773 if ( nfac == 0 ) {
6774 if ( dd->nfactors > d->nfactors ) {
6775TooBig:
6776 MesPrint("@Factor number for dollar variable too large");
6777 Terminate(-1);
6778 }
6779 return(dd->nfactors);
6780 }
6781 w = dd->factors[nfac-1].where;
6782 if ( w == 0 ) {
6783 if ( dd->factors[nfac-1].value > d->nfactors ||
6784 dd->factors[nfac-1].value < 0 ) goto TooBig;
6785 return(dd->factors[nfac-1].value);
6786 }
6787 if ( *w == 4 && w[4] == 0 && w[3] == 3 && w[2] == 1
6788 && w[1] <= d->nfactors ) return(w[1]);
6789 if ( w[*w] == 0 && w[*w-1] == *w-1 ) goto TooBig;
6790IllNum:
6791 MesPrint("@Illegal factor number for dollar variable");
6792 Terminate(-1);
6793 }
6794 else { /* The dollar should be a number */
6795 if ( dd->type == DOLZERO ) {
6796 return(0);
6797 }
6798 else if ( dd->type == DOLTERMS || dd->type == DOLNUMBER ) {
6799 w = dd->where;
6800 if ( *w == 4 && w[4] == 0 && w[3] == 3 && w[2] == 1
6801 && w[1] <= d->nfactors ) return(w[1]);
6802 if ( w[*w] == 0 && w[*w-1] == *w-1 ) goto TooBig;
6803 goto IllNum;
6804 }
6805 else goto IllNum;
6806 }
6807 }
6808 else if ( FG.cTable[*s] == 1 ) {
6809 WORD x = *s++ - '0';
6810 while ( FG.cTable[*s] == 1 ) {
6811 x = 10*x + *s++ - '0';
6812 if ( x > d->nfactors ) {
6813 MesPrint("@Factor number %d for dollar variable too large",x);
6814 Terminate(-1);
6815 }
6816 }
6817 if ( *s != ']' ) {
6818 MesPrint("@Illegal factor number for dollar variable");
6819 Terminate(-1);
6820 }
6821 s++; *inp = s;
6822 return(x);
6823 }
6824 else {
6825 MesPrint("@Illegal factor indicator for dollar variable");
6826 Terminate(-1);
6827 }
6828 return(-1);
6829}
6830
6831/*
6832 #] GetDollarNumber :
6833 #[ DoSetRandom :
6834
6835 Executes the #SetRandom number
6836*/
6837
6838int DoSetRandom(UBYTE *s)
6839{
6840 ULONG x;
6841 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
6842 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
6843 while ( *s == ' ' || *s == '\t' ) s++;
6844 x = 0;
6845 while ( FG.cTable[*s] == 1 ) {
6846 x = 10*x + (*s++-'0');
6847 }
6848 while ( *s == ' ' || *s == '\t' ) s++;
6849 if ( *s == 0 ) {
6850#ifdef WITHPTHREADS
6851#ifdef WITHSORTBOTS
6852 int id, totnum = MaX(2*AM.totalnumberofthreads-3,AM.totalnumberofthreads);
6853#else
6854 int id, totnum = AM.totalnumberofthreads;
6855#endif
6856 for ( id = 0; id < totnum; id++ ) {
6857 AB[id]->R.wranfseed = x;
6858 if ( AB[id]->R.wranfia ) M_free(AB[id]->R.wranfia,"wranf");
6859 AB[id]->R.wranfia = 0;
6860 }
6861#else
6862 AR.wranfseed = x;
6863 if ( AR.wranfia ) M_free(AR.wranfia,"wranf");
6864 AR.wranfia = 0;
6865#endif
6866 return(0);
6867 }
6868 else {
6869 MesPrint("@proper syntax is #SetRandom number");
6870 return(-1);
6871 }
6872}
6873
6874/*
6875 #] DoSetRandom :
6876 #[ DoOptimize :
6877
6878 Executes the #Optimize(expr) instruction.
6879*/
6880
6881int DoOptimize(UBYTE *s)
6882{
6883 GETIDENTITY
6884 UBYTE *exprname;
6885 WORD numexpr;
6886 int error = 0, i;
6887 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
6888 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
6889 DUMMYUSE(*s)
6890 exprname = s; s = SkipAName(s);
6891 if ( *s != 0 && *s != ';' ) {
6892 MesPrint("@proper syntax is #Optimize,expression");
6893 return(-1);
6894 }
6895 *s = 0;
6896 if ( GetName(AC.exprnames,exprname,&numexpr,NOAUTO) != CEXPRESSION ) {
6897 MesPrint("@%s is not an expression",exprname);
6898 error = 1;
6899 }
6900 else if ( AP.preError == 0 ) {
6901 EXPRESSIONS e = Expressions + numexpr;
6902 POSITION position;
6903 int firstterm;
6904 WORD *term = AT.WorkPointer;
6905 ClearOptimize();
6906 if ( AO.OptimizationLevel == 0 ) return(0);
6907 switch ( e->status ) {
6908 case LOCALEXPRESSION:
6909 case GLOBALEXPRESSION:
6910 break;
6911 default:
6912 MesPrint("@Expression %s is not an active unhidden local or global expression.",exprname);
6913 Terminate(-1);
6914 break;
6915 }
6916#ifdef WITHMPI
6917 if ( PF.me == MASTER )
6918#endif
6919 RevertScratch();
6920 for ( i = NumExpressions-1; i >= 0; i-- ) {
6921 AS.OldOnFile[i] = Expressions[i].onfile;
6922 AS.OldNumFactors[i] = Expressions[i].numfactors;
6923 AS.Oldvflags[i] = Expressions[i].vflags;
6924 Expressions[i].vflags &= ~(ISUNMODIFIED|ISZERO);
6925 }
6926 for ( i = 0; i < NumExpressions; i++ ) {
6927 if ( i == numexpr ) {
6928 PutPreVar(AM.oldnumextrasymbols,
6929 GetPreVar((UBYTE *)"EXTRASYMBOLS_",0),0,1);
6930 Optimize(numexpr, 0);
6931 AO.OptimizeResult.nameofexpr = strDup1(exprname,"optimize expression name");
6932 continue;
6933 }
6934#ifdef WITHMPI
6935 if ( PF.me == MASTER ) {
6936#endif
6937 e = Expressions + i;
6938 switch ( e->status ) {
6939 case LOCALEXPRESSION:
6940 case SKIPLEXPRESSION:
6941 case DROPLEXPRESSION:
6942 case DROPPEDEXPRESSION:
6943 case GLOBALEXPRESSION:
6944 case SKIPGEXPRESSION:
6945 case DROPGEXPRESSION:
6946 case HIDELEXPRESSION:
6947 case HIDEGEXPRESSION:
6948 case DROPHLEXPRESSION:
6949 case DROPHGEXPRESSION:
6950 case INTOHIDELEXPRESSION:
6951 case INTOHIDEGEXPRESSION:
6952 break;
6953 default:
6954 continue;
6955 }
6956 AR.GetFile = 0;
6957 SetScratch(AR.infile,&(e->onfile));
6958 if ( GetTerm(BHEAD term) <= 0 ) {
6959 MesPrint("@Expression %d has problems reading from scratchfile",i);
6960 Terminate(-1);
6961 }
6962 term[3] = i;
6963 AR.DeferFlag = 0;
6964 SeekScratch(AR.outfile,&position);
6965 e->onfile = position;
6966 *AM.S0->sBuffer = 0; firstterm = -1;
6967 do {
6968 WORD *oldipointer = AR.CompressPointer;
6969 WORD *comprtop = AR.ComprTop;
6970 AR.ComprTop = AM.S0->sTop;
6971 AR.CompressPointer = AM.S0->sBuffer;
6972 if ( firstterm > 0 ) {
6973 if ( PutOut(BHEAD term,&position,AR.outfile,1) < 0 ) goto DoSerr;
6974 }
6975 else if ( firstterm < 0 ) {
6976 if ( PutOut(BHEAD term,&position,AR.outfile,0) < 0 ) goto DoSerr;
6977 firstterm++;
6978 }
6979 else {
6980 if ( PutOut(BHEAD term,&position,AR.outfile,-1) < 0 ) goto DoSerr;
6981 firstterm++;
6982 }
6983 AR.CompressPointer = oldipointer;
6984 AR.ComprTop = comprtop;
6985 } while ( GetTerm(BHEAD term) );
6986 if ( FlushOut(&position,AR.outfile,1) ) {
6987DoSerr:
6988 MesPrint("@Expression %d has problems writing to scratchfile",i);
6989 Terminate(-1);
6990 }
6991#ifdef WITHMPI
6992 }
6993#endif
6994 }
6995/*
6996 Now some administration and we are done
6997*/
6998 UpdateMaxSize();
6999 }
7000 else {
7001 ClearOptimize();
7002 }
7003 return(error);
7004
7005}
7006
7007/*
7008 #] DoOptimize :
7009 #[ DoClearOptimize :
7010
7011 Clears all relevant buffers of the output optimization
7012*/
7013
7014int DoClearOptimize(UBYTE *s)
7015{
7016 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7017 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7018 DUMMYUSE(*s);
7019 return(ClearOptimize());
7020}
7021
7022/*
7023 #] DoClearOptimize :
7024 #[ DoSkipExtraSymbols :
7025
7026 Adds the intermediate variables of the previous optimization
7027 to the list of extra symbols, provided it has not yet been erased
7028 by a #clearoptimize
7029 To remove them again one needs to use the 'delete extrasymbols;'
7030 or the 'delete extrasymbols>num;' statement in which num is the
7031 old number of extra symbols.
7032*/
7033
7034int DoSkipExtraSymbols(UBYTE *s)
7035{
7036 CBUF *C = cbuf + AM.sbufnum;
7037 WORD tt = 0, j = 0, oldval = AO.OptimizeResult.minvar;
7038 if ( AO.OptimizeResult.code == NULL ) return(0);
7039 if ( AO.OptimizationLevel == 0 ) return(0);
7040 while ( *s == ',' ) s++;
7041 if ( *s == 0 ) {
7042 AO.OptimizeResult.minvar = AO.OptimizeResult.maxvar+1;
7043 }
7044 else {
7045 while ( *s <= '9' && *s >= '0' ) j = 10*j + *s++ - '0';
7046 if ( *s ) {
7047 MesPrint("@Illegal use of #SkipExtraSymbols instruction");
7048 Terminate(-1);
7049 }
7050 AO.OptimizeResult.minvar += j;
7051 if ( AO.OptimizeResult.minvar > AO.OptimizeResult.maxvar )
7052 AO.OptimizeResult.minvar = AO.OptimizeResult.maxvar+1;
7053 }
7054 j = AO.OptimizeResult.minvar - oldval;
7055 while ( j > 0 ) {
7056 AddRHS(AM.sbufnum,1);
7057 AddNtoC(AM.sbufnum,1,&tt,16);
7058 AddToCB(C,0)
7059 InsTree(AM.sbufnum,C->numrhs);
7060 j--;
7061 }
7062 return(0);
7063}
7064
7065/*
7066 #] DoSkipExtraSymbols :
7067 #[ DoPreReset :
7068
7069 Does a reset of variables.
7070 Currently only the timer (stopwatch) of `timer_'
7071*/
7072
7073int DoPreReset(UBYTE *s)
7074{
7075 UBYTE *ss, c;
7076 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7077 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7078 while ( *s == ' ' || *s == '\t' ) s++;
7079 if ( *s == 0 ) {
7080 MesPrint("@proper syntax is #Reset variable");
7081 return(-1);
7082 }
7083 ss = s;
7084 while ( FG.cTable[*s] == 0 ) s++;
7085 c = *s; *s = 0;
7086 if ( ( StrICmp(ss,(UBYTE *)"timer") == 0 )
7087 || ( StrICmp(ss,(UBYTE *)"stopwatch") == 0 ) ) {
7088 *s = c;
7089 AP.StopWatchZero = GetRunningTime();
7090 return(0);
7091 }
7092 else {
7093 *s = c;
7094 MesPrint("@proper syntax is #Reset variable");
7095 return(-1);
7096 }
7097}
7098
7099/*
7100 #] DoPreReset :
7101 #[ DoPreAppendPath :
7102*/
7103
7104static int DoAddPath(UBYTE *s, int bPrepend)
7105{
7106 /* NOTE: this doesn't support some file systems, e.g., 0x5c with CP932. */
7107
7108 UBYTE *path, *path_end, *current_dir, *current_dir_end, *NewPath, *t;
7109 int bRelative, n;
7110
7111 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7112 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7113
7114 /* Parse the path in the input. */
7115 while ( *s == ' ' || *s == '\t' ) s++; /* skip spaces */
7116 if ( *s == '"' ) { /* the path is given by "..." */
7117 path = ++s;
7118 while ( *s && *s != '"' ) {
7119 if ( SEPARATOR != '\\' && *s == '\\' ) { /* escape character, e.g., "\\\"" */
7120 if ( !s[1] ) goto ImproperPath;
7121 s++;
7122 }
7123 s++;
7124 }
7125 if ( *s != '"' ) goto ImproperPath;
7126 path_end = s++;
7127 }
7128 else {
7129 path = s;
7130 while ( *s && *s != ' ' && *s != '\t' ) {
7131 if ( SEPARATOR != '\\' && *s == '\\' ) { /* escape character, e.g., "\\ " */
7132 if ( !s[1] ) goto ImproperPath;
7133 s++;
7134 }
7135 s++;
7136 }
7137 path_end = s;
7138 }
7139 if ( path == path_end ) goto ImproperPath; /* empty path */
7140 while ( *s == ' ' || *s == '\t' ) s++; /* skip spaces */
7141 if ( *s ) goto ImproperPath; /* extra tokens found */
7142
7143 /* Check if the path is an absolute path. */
7144 bRelative = 1;
7145 if ( path[0] == SEPARATOR ) { /* starts with the directory separator */
7146 bRelative = 0;
7147 }
7148#ifdef WINDOWS
7149 else if ( chartype[path[0]] == 0 && path[1] == ':' ) { /* starts with (drive letter): */
7150 bRelative = 0;
7151 }
7152#endif
7153
7154 /* Get the current file directory when a relative path is given. */
7155 if ( bRelative ) {
7156 if ( !AC.CurrentStream ) goto FileNameUnavailable;
7157 if ( AC.CurrentStream->type != FILESTREAM && AC.CurrentStream->type != REVERSEFILESTREAM ) goto FileNameUnavailable;
7158 if ( !AC.CurrentStream->name ) goto FileNameUnavailable;
7159 s = current_dir = current_dir_end = AC.CurrentStream->name;
7160 while ( *s ) {
7161 if ( SEPARATOR != '\\' && *s == '\\' && s[1] ) { /* escape character, e.g., "\\\"" */
7162 s += 2;
7163 continue;
7164 }
7165 if ( *s == SEPARATOR ) {
7166 current_dir_end = s;
7167 }
7168 s++;
7169 }
7170 }
7171 else {
7172 current_dir = current_dir_end = NULL;
7173 }
7174
7175 /* Allocate a buffer for new AM.Path. */
7176 n = path_end - path;
7177 if ( AM.Path ) n += StrLen(AM.Path) + 1;
7178 if ( current_dir != current_dir_end ) n+= current_dir_end - current_dir + 1;
7179 s = NewPath = (UBYTE *)Malloc1(n + 1,"add path");
7180
7181 /* Construct new FORM path. */
7182 if ( bPrepend ) {
7183 if ( current_dir != current_dir_end ) {
7184 t = current_dir;
7185 while ( t != current_dir_end ) *s++ = *t++;
7186 *s++ = SEPARATOR;
7187 }
7188 t = path;
7189 while ( t != path_end ) *s++ = *t++;
7190 if ( AM.Path ) *s++ = PATHSEPARATOR;
7191 }
7192 if ( AM.Path ) {
7193 t = AM.Path;
7194 while ( *t ) *s++ = *t++;
7195 }
7196 if ( !bPrepend ) {
7197 if ( AM.Path ) *s++ = PATHSEPARATOR;
7198 if ( current_dir != current_dir_end ) {
7199 t = current_dir;
7200 while ( t != current_dir_end ) *s++ = *t++;
7201 *s++ = SEPARATOR;
7202 }
7203 t = path;
7204 while ( t != path_end ) *s++ = *t++;
7205 }
7206 *s = '\0';
7207
7208 /* Update AM.Path. */
7209 if ( AM.Path ) M_free(AM.Path,"add path");
7210 AM.Path = NewPath;
7211
7212 return(0);
7213
7214ImproperPath:
7215 MesPrint("@Improper syntax for %#%sPath", bPrepend ? "Prepend" : "Append");
7216 return(-1);
7217
7218FileNameUnavailable:
7219 /* This may be improved in future. */
7220 MesPrint("@Sorry, %#%sPath can't resolve the current file name from here", bPrepend ? "Prepend" : "Append");
7221 return(-1);
7222}
7223
7231int DoPreAppendPath(UBYTE *s)
7232{
7233 return DoAddPath(s, 0);
7234}
7235
7236/*
7237 #] DoPreAppendPath :
7238 #[ DoPrePrependPath :
7239*/
7240
7248int DoPrePrependPath(UBYTE *s)
7249{
7250 return DoAddPath(s, 1);
7251}
7252
7253/*
7254 #] DoPrePrependPath :
7255 #[ DoTimeOutAfter :
7256
7257 Executes the #timeoutafter number
7258*/
7259
7260int DoTimeOutAfter(UBYTE *s)
7261{
7262#ifdef WITH_ALARM
7263 ULONG x;
7264#else
7265 DUMMYUSE(s);
7266#endif
7267 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7268 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7269#ifdef WITH_ALARM
7270 while ( *s == ' ' || *s == '\t' ) s++;
7271 x = 0;
7272 while ( FG.cTable[*s] == 1 ) {
7273 x = 10*x + (*s++-'0');
7274 }
7275 while ( *s == ' ' || *s == '\t' ) s++;
7276 if ( *s == 0 ) {
7277 alarm(x);
7278 return(0);
7279 }
7280 else {
7281 MesPrint("@proper syntax is #TimeoutAfter number");
7282 return(-1);
7283 }
7284#else
7285 Error0("#timeoutafter not implemented on this computer/system");
7286 return(-1);
7287#endif
7288}
7289
7290/*
7291 #] DoTimeOutAfter :
7292 #[ DoNamespace :
7293
7294 Syntax:
7295 #Namespace name
7296 .....
7297 #use variables
7298 .....
7299 #EndNamespace
7300 Effect:
7301 All variables/expressions defined inside the range of the
7302 namespace get name_ prepended.
7303 This holds also for $-variables, names of procedures and
7304 names of files.
7305 Namespaces can be used in a nested way. cf this_is_deep_x
7306 A leading _ takes the role of what is super:: in some other languages.
7307 Remarks:
7308 Names of preprocessor variables are excluded!
7309 Names of built in objects are excluded! (like sum_, d_ etc.)
7310*/
7311
7312int DoNamespace(UBYTE *s)
7313{
7314 UBYTE *s1, *s2, c;
7315 NAMESPACE *namespace;
7316 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7317 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7318 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
7319 if ( FG.cTable[*s] != 0 ) {
7320 MesPrint("@Illegal name in #namespace instruction: %s",s);
7321 return(-1);
7322 }
7323 s1 = s;
7324 while ( FG.cTable[*s1] <= 1 ) s1++;
7325 s2 = s1;
7326 while ( *s2 == ' ' || *s2 == ',' || *s2 == '\t' ) s2++;
7327 if ( *s2 != 0 ) {
7328 MesPrint("@A #namespace instruction can only have one name with only alphanumeric characters.");
7329 return(-1);
7330 }
7331 c = *s1; *s1 = 0;
7332/*
7333 Now we have the name and the statement is legal.
7334 We can proceed creating the namespace and its use tree.
7335*/
7336 namespace = (NAMESPACE *)Malloc1(sizeof(NAMESPACE),"namespace");
7337 namespace->name = strDup1(s,"namespace_name");
7338 namespace->usenames = MakeNameTree();
7339 if ( AP.firstnamespace == 0 ) {
7340 namespace->previous = 0;
7341 namespace->next = 0;
7342 AP.firstnamespace = namespace;
7343 AP.lastnamespace = namespace;
7344 }
7345 else {
7346 AP.lastnamespace->next = namespace;
7347 namespace->next = 0;
7348 namespace->previous = AP.lastnamespace;
7349 AP.lastnamespace = namespace;
7350 }
7351 *s1 = c;
7352 return(0);
7353}
7354
7355/*
7356 #] DoNamespace :
7357 #[ DoEndNamespace :
7358*/
7359
7360int DoEndNamespace(UBYTE *s)
7361{
7362 NAMESPACE *namespace;
7363 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7364 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7365 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
7366 if ( *s != 0 ) {
7367 MesPrint("@Illegal #endnamespace instruction");
7368 return(-1);
7369 }
7370 namespace = AP.lastnamespace;
7371 AP.lastnamespace = namespace->previous;
7372 M_free(namespace->name,"namespace_name");
7373 FreeNameTree(namespace->usenames);
7374 M_free(namespace,"namespace");
7375 return(0);
7376}
7377
7378/*
7379 #] DoEndNamespace :
7380 #[ SkipName :
7381*/
7382
7383UBYTE *SkipName(UBYTE *s)
7384{
7385 UBYTE *t = s, *s1, c;
7386 int num = 0, block = 0;
7387 if ( *s == '[' ) {
7388straight:
7389 SKIPBRA1(s)
7390 if ( *s == 0 ) {
7391 MesPrint("&Illegal name: '%s'",t);
7392 return(0);
7393 }
7394 s++; s1 = s;
7395 while ( FG.cTable[*s] <= 1 || *s == '_' ) s++;
7396 if ( s1 != s ) goto witherror;
7397 }
7398 else if ( *s == '$' ) {
7399 s++;
7400 while ( *s == '_' ) { s++; num++; }
7401 block = 1;
7402 while ( FG.cTable[*s] <= 1 || *s == '_' ) {
7403 if ( FG.cTable[*s] != 0 && block == 1 ) {
7404blocked:
7405 MesPrint("&Illegally formed name: %s",t);
7406 return(0);
7407 }
7408 if ( *s == '_' ) { num++; block = 1; }
7409 else block = 0;
7410 s++;
7411 }
7412 if ( s[-1] == '_' && num > 1 ) goto built;
7413 }
7414 else if ( FG.cTable[*s] == 0 ) {
7415regular:
7416 while ( FG.cTable[*s] <= 1 || *s == '_' ) {
7417 if ( FG.cTable[*s] != 0 && block == 1 ) goto blocked;
7418 if ( *s == '_' ) { block = 1; num++; }
7419 else block = 0;
7420 s++;
7421 }
7422 if ( *s == '[' ) goto straight;
7423 if ( s[-1] == '_' && num > 1 ) {
7424built:
7425 c = *s; *s = 0;
7426 MesPrint("&Built in objects cannot be part of namespaces: %s",t);
7427 *s = c;
7428 return(0);
7429 }
7430 }
7431 else if ( *s == '_' ) {
7432 while ( *s == '_' ) { s++; num++; }
7433 if ( FG.cTable[*s] == 0 ) { block = 0; goto regular; }
7434 goto witherror;
7435 }
7436 else if ( *s == '@' ) {
7437 s++; block = 1;
7438 if ( *s == '_' || FG.cTable[*s] == 1 ) {
7439 MesPrint("@Illegally formed name: %s",s-1);
7440 }
7441 goto regular;
7442 }
7443 else if ( *s == '#' ) { /* name of a procedure */
7444 s++;
7445 while ( *s == '_' ) { s++; num++; }
7446 block = 1;
7447 while ( FG.cTable[*s] <= 1 || *s == '_' ) {
7448 if ( FG.cTable[*s] != 0 && block == 1 ) goto blocked;
7449 if ( *s == '_' ) { num++; block = 1; }
7450 else block = 0;
7451 s++;
7452 }
7453 if ( s[-1] == '_' ) {
7454witherror:
7455 c = *s; *s = 0;
7456 MesPrint("&Illegally formed name: %s",t);
7457 *s = c;
7458 return(0);
7459 }
7460 }
7461 else if ( *s == '<' ) { /* name of a file. Can be anything (more or less) */
7462 s++;
7463 while ( *s && *s != '>' ) s++;
7464 if ( *s != '>' ) goto witherror;
7465 s++;
7466 }
7467 return(s);
7468}
7469
7470/*
7471 #] SkipName :
7472 #[ ConstructName :
7473
7474 Routine gets a 'raw' name and modifies it if the namespace
7475 settings ask for it. It puts the new name in a buffer that
7476 may be expanded if the names become rather long.
7477 Note that eventually that name needs to be copied, because
7478 we do not allocate new buffers for each name.
7479
7480 type tells what kind of name we look for
7481*/
7482
7483UBYTE *ConstructName(UBYTE *s,UBYTE type)
7484{
7485 int len;
7486 UBYTE *t, *u;
7487 WORD number;
7488 NAMESPACE *namespace;
7489 if ( AP.lastnamespace == 0 ) return(s);
7490 if ( *s == '@' ) return(s+1);
7491 if ( GetName(AP.lastnamespace->usenames,s,&number,NOAUTO) !=
7492 NAMENOTFOUND ) return(s);
7493/*
7494 Now the real stuff
7495 First we have to compute the size of the new name.
7496*/
7497 len = StrLen(s) + 1;
7498 namespace = AP.firstnamespace;
7499 while ( namespace ) {
7500 len += StrLen(namespace->name)+1;
7501 namespace = namespace->previous;
7502 }
7503 if ( len > AP.fullnamesize ) {
7504 while ( len > AP.fullnamesize ) AP.fullnamesize *= 2;
7505 M_free(AP.fullname,"AP.fullname");
7506 AP.fullname = (UBYTE *)Malloc1(AP.fullnamesize*sizeof(UBYTE *),"AP.fullname");
7507 }
7508 namespace = AP.firstnamespace;
7509 t = AP.fullname;
7510 switch ( type ) {
7511 case ' ':
7512 case 0:
7513 while ( namespace ) {
7514 u = namespace->name;
7515 while ( *u ) *t++ = *u++;
7516 *t++ = '_';
7517 namespace = namespace->previous;
7518 }
7519 while ( *s ) *t++ = *s++;
7520 *t = 0;
7521 break;
7522 case '$':
7523 case '#':
7524 *t++ = type;
7525 while ( namespace ) {
7526 u = namespace->name;
7527 while ( *u ) *t++ = *u++;
7528 *t++ = '_';
7529 namespace = namespace->previous;
7530 }
7531 if ( type == '$' ) s++;
7532 while ( *s ) *t++ = *s++;
7533 *t = 0;
7534 break;
7535 case '<':
7536 while ( namespace ) {
7537 u = namespace->name;
7538 while ( *u ) *t++ = *u++;
7539 *t++ = '_';
7540 namespace = namespace->previous;
7541 }
7542 s++;
7543 while ( *s ) *t++ = *s++;
7544 t--; /* strip the '>' */
7545 *t = 0;
7546 break;
7547 default:
7548 MesPrint("&Unrecognized datatype in ConstructName");
7549 *t = 0;
7550 break;
7551 }
7552 return(AP.fullname);
7553}
7554
7555/*
7556 #] ConstructName :
7557 #[ DoUse :
7558
7559 Routine makes (inside the confines of the current namespace)
7560 a list of variables that are excluded from the namespace.
7561 Once the namespace is ended, the list is removed.
7562 The list can include names of variables, dollars and procedures.
7563 Preprocessor variables are excluded from the namespace. Their
7564 inclusion would be too complicated for the input streams.
7565 Note that the preprocessor variables that are arguments in a #do
7566 or in a procedure are on a stack and should not cause problems.
7567 Names of variables can be just that.
7568 Names of $-variables are also straightforward.
7569 Names of procedures should be preceeded by a # character.
7570 Names of files (like in #include) should be enclosed by <>.
7571 The names are stored in a balanced tree. Each namespace may have
7572 its own tree. The toplevel (no namespace) does not allow a #use.
7573*/
7574
7575int DoUse(UBYTE *s)
7576{
7577 NAMESPACE *namespace;
7578 UBYTE *t, c;
7579 int number;
7580 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7581 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7582 if ( AP.lastnamespace == 0 ) {
7583 MesPrint("@It is not allowed to use #use outside the scope of a namespace.");
7584 return(-1);
7585 }
7586 namespace = AP.lastnamespace;
7587 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
7588 while ( *s ) {
7589 t = s;
7590 if ( ( s = SkipName(t) ) == 0 ) return(-1);
7591 if ( s == t ) {
7592 MesPrint("@Unrecognized object in #use instruction: %s",t);
7593 return(-1);
7594 }
7595 c = *s; *s = 0;
7596/*
7597 In usenames we only need the names to know whether they are 'protected'.
7598 We need to keep the $, # and <> to avoid potential double names.
7599*/
7600 AddName(namespace->usenames,t,0,0,&number);
7601 *s = c;
7602 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
7603 }
7604 return(0);
7605}
7606
7607/*
7608 #] DoUse :
7609 #[ UserFlags :
7610
7611 Syntax:
7612 #ClearFlag number(s),expression(s)
7613 #ClearFlag number(s)
7614 #ClearFlag expression(s)
7615 #ClearFlag
7616 #SetFlag number(s),expression(s)
7617 #SetFlag number(s)
7618 #SetFlag expression(s)
7619 #SetFlag
7620 par == 0: Clear, par == 1: Set.
7621*/
7622
7623int UserFlags(UBYTE *s,int par)
7624{
7625 int mask = 0, error = 0, i;
7626 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7627 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7628 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7629 if ( *s == 0 ) { /* Treat all flags in all active expressions */
7630allexpr:
7631 for ( i = 0; i < NumExpressions; i++ ) {
7632 switch ( Expressions[i].status ) {
7633 case UNHIDELEXPRESSION:
7634 case UNHIDEGEXPRESSION:
7635 case INTOHIDELEXPRESSION:
7636 case INTOHIDEGEXPRESSION:
7637 case LOCALEXPRESSION:
7638 case GLOBALEXPRESSION:
7639 case SKIPLEXPRESSION:
7640 case SKIPGEXPRESSION:
7641 case HIDELEXPRESSION:
7642 case HIDEGEXPRESSION:
7643 if ( par == 1 ) Expressions[i].uflags |= ~mask;
7644 else Expressions[i].uflags &= mask;
7645 break;
7646 case DROPPEDEXPRESSION:
7647 case DROPLEXPRESSION:
7648 case DROPGEXPRESSION:
7649 case DROPHLEXPRESSION:
7650 case DROPHGEXPRESSION:
7651 case STOREDEXPRESSION:
7652 case HIDDENLEXPRESSION:
7653 case HIDDENGEXPRESSION:
7654 case SPECTATOREXPRESSION:
7655 default:
7656 break;
7657 }
7658 }
7659 }
7660 else if ( FG.cTable[*s] == 1 ) {
7661 mask = (int)WORDMASK;
7662 while ( FG.cTable[*s] == 1 ) {
7663 int x = 0;
7664 while ( FG.cTable[*s] == 1 ) { x = 10*x + (*s++-'0'); }
7665 if ( x < 1 || x > BITSINWORD ) {
7666 MesPrint("@Illegal number %d for flag in #...Flag instruction",x);
7667 return(1);
7668 }
7669 mask ^= (1<<(x-1));
7670 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7671 }
7672 if ( *s == 0 ) goto allexpr;
7673 }
7674 else { /* Clear all flags in all expressions that are specified */
7675 mask = (int)WORDMASK;
7676 }
7677 while ( *s ) { /* now read the expressions */
7678 UBYTE *s1, c;
7679 WORD num1;
7680 if ( FG.cTable[*s] != 0 && *s != '[' ) goto syntax;
7681 s1 = s; s = SkipAName(s);
7682 c = *s; *s = 0;
7683 if ( GetName(AC.exprnames,s1,&num1,NOAUTO) != CEXPRESSION ) {
7684 MesPrint("@%s is not an active expression",s1);
7685 error = 1;
7686 return(error);
7687 }
7688 switch ( Expressions[num1].status ) {
7689 case UNHIDELEXPRESSION:
7690 case UNHIDEGEXPRESSION:
7691 case INTOHIDELEXPRESSION:
7692 case INTOHIDEGEXPRESSION:
7693 case LOCALEXPRESSION:
7694 case GLOBALEXPRESSION:
7695 case SKIPLEXPRESSION:
7696 case SKIPGEXPRESSION:
7697 case HIDELEXPRESSION:
7698 case HIDEGEXPRESSION:
7699 if ( par == 1 ) Expressions[num1].uflags |= ~mask;
7700 else Expressions[num1].uflags &= mask;
7701 break;
7702 case DROPPEDEXPRESSION:
7703 case DROPLEXPRESSION:
7704 case DROPGEXPRESSION:
7705 case DROPHLEXPRESSION:
7706 case DROPHGEXPRESSION:
7707 case STOREDEXPRESSION:
7708 case HIDDENLEXPRESSION:
7709 case HIDDENGEXPRESSION:
7710 case SPECTATOREXPRESSION:
7711 default:
7712 MesPrint("@%s is not an active expression",s1);
7713 error = 1;
7714 break;
7715 }
7716 *s = c;
7717 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7718 }
7719 return(error);
7720syntax:
7721 MesPrint("@Illegal name in #...Flag instruction.");
7722 return(1);
7723}
7724
7725/*
7726 #] UserFlags :
7727 #[ DoClearUserFlag :
7728*/
7729
7730int DoClearUserFlag(UBYTE *s)
7731{
7732 return(UserFlags(s,0));
7733}
7734
7735/*
7736 #] DoClearUserFlag :
7737 #[ DoSetUserFlag :
7738*/
7739
7740int DoSetUserFlag(UBYTE *s)
7741{
7742 return(UserFlags(s,1));
7743}
7744
7745/*
7746 #] DoSetUserFlag :
7747 #[ DoStartFloat :
7748
7749 If there is a number follwing, it will be the new default precision.
7750 If float has been started before, the old one will be removed first.
7751 If there are two numbers, the second one is the maximum weight for
7752 MZV's.
7753*/
7754#ifdef WITHFLOAT
7755
7756int DoStartFloat(UBYTE *s)
7757{
7758 GETIDENTITY
7759 int error = 0;
7760 LONG x;
7761 UBYTE *ss;
7762 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7763 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7764 if ( AR.PolyFun != 0 ) {
7765 MesPrint("@Simultaneous use of Poly(Rat)Fun and float_ is not allowed.");
7766 error = 1;
7767 }
7768 if ( AC.ncmod != 0 ) {
7769 MesPrint("@Simultaneous use of floating point and modulus arithmetic makes no sense.");
7770 error = 1;
7771 }
7772 if ( AT.aux_ ) { // First, we clean up any previous floating point system.
7773 ClearfFloat();
7774 ClearMZVTables();
7775 }
7776 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7777/*
7778 The first parameter is the float precision
7779*/
7780 ss = s;
7781 if ( *s >= '0' && *s <= '9' ) {
7782 x = 0;
7783 do {
7784 x = 10*x + (*s++-'0');
7785 } while ( *s >= '0' && *s <= '9' );
7786/*
7787 The precision can either be in digits or bits.
7788 AC.DefaultPrecision is always in bits.
7789*/
7790 if ( tolower(*s) == 'd' ) { AC.tDefaultPrecision = (LONG)ceil(x*log2(10.0)); s++; }
7791 else if ( tolower(*s) == 'b' ) { AC.tDefaultPrecision = x; s++; }
7792 else goto IllPar;
7793 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7794/*
7795 The second parameter is either absent, which implies zero MZV weight,
7796 or of the form MZV = <weight>
7797*/
7798 if ( tolower(*s) == 'm' && tolower(s[1]) == 'z' && tolower(s[2]) == 'v') {
7799 s+=3;
7800 while ( *s == ' ' || *s == '\t' ) s++;
7801 if ( *s != '=') goto IllPar;
7802 s++;
7803 while ( *s == ' ' || *s == '\t' ) s++;
7804 if ( *s >= '0' && *s <= '9' ) {
7805 x = 0;
7806 do {
7807 x = 10*x + (*s++ - '0');
7808 } while ( *s >= '0' && *s <= '9' );
7809 AC.tMaxWeight = x;
7810 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7811 }
7812 else goto IllPar;
7813 }
7814 else {
7815 AC.tMaxWeight = 0;
7816 }
7817 if ( *s ) goto IllPar;
7818 }
7819 else if ( *s != 0 ) {
7820IllPar:
7821 MesPrint("@Illegal parameter in %#StartFloat: %s ",ss);
7822 error = 1;
7823 }
7824 if ( error == 0 ) {
7825 if ( AC.tDefaultPrecision && ( AC.tDefaultPrecision != AC.DefaultPrecision
7826 || AT.aux_ == 0 ) ) {
7827 AC.DefaultPrecision = AC.tDefaultPrecision;
7828 AC.tDefaultPrecision = 0;
7829 }
7830 if ( AC.tMaxWeight && ( AC.tMaxWeight != AC.MaxWeight
7831 || AT.aux_ == 0 ) ) {
7832 AC.MaxWeight = AC.tMaxWeight;
7833 AC.tMaxWeight = 0;
7834 }
7835 SetFloatPrecision(AC.DefaultPrecision+AC.MaxWeight+1);
7836 SetupMPFTables();
7837 if ( AC.MaxWeight > 0 ) SetupMZVTables();
7838 SetfFloatPrecision(AC.DefaultPrecision);
7839 }
7840 else {
7841 AC.tDefaultPrecision = 0;
7842 AC.tMaxWeight = 0;
7843 }
7844 return(error);
7845}
7846
7847#endif
7848/*
7849 #] DoStartFloat :
7850 #[ DoEndFloat :
7851*/
7852#ifdef WITHFLOAT
7853
7854int DoEndFloat(UBYTE *s)
7855{
7856 int error = 0;
7857 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7858 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7859 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7860 if ( *s != 0 ) {
7861 MesPrint("@Illegal parameter in %#EndFloat instruction: %s ",s);
7862 error = 1;
7863 }
7864 if ( error == 0 ) {
7865 ClearfFloat();
7866 ClearMZVTables();
7867 }
7868 return(error);
7869}
7870
7871#endif
7872/*
7873 #] DoEndFloat :
7874 # ] PreProcessor :
7875*/
DoCheckpoint
void DoCheckpoint(int moduletype)
Definition checkpoint.c:3110
DoRecovery
int DoRecovery(int *moduletype)
Definition checkpoint.c:1402
SkipAName
UBYTE * SkipAName(UBYTE *s)
Definition compiler.c:443
AddRHS
WORD * AddRHS(int num, int type)
Definition comtool.c:214
AddNtoC
int AddNtoC(int bufnum, int n, WORD *array, int par)
Definition comtool.c:317
clearcbuf
void clearcbuf(WORD num)
Definition comtool.c:116
GetFirstTerm
int GetFirstTerm(WORD *, int, int)
Definition execute.c:1866
optimize_print_code
void optimize_print_code(int)
Definition optimize.cc:4524
AddPotModdollar
void AddPotModdollar(WORD)
Definition dollar.c:3942
PutOut
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
Definition sort.c:1171
EndSort
LONG EndSort(PHEAD WORD *, int)
Definition sort.c:454
Generator
int Generator(PHEAD WORD *, WORD)
Definition proces.c:3249
LowerSortLevel
void LowerSortLevel(void)
Definition sort.c:4661
EndOfToken
UBYTE * EndOfToken(UBYTE *)
Definition tools.c:1932
ClearOptimize
int ClearOptimize(void)
Definition optimize.cc:4974
NewSort
int NewSort(PHEAD0)
Definition sort.c:359
Optimize
int Optimize(WORD, int)
Definition optimize.cc:4637
FlushOut
int FlushOut(POSITION *, FILEHANDLE *, int)
Definition sort.c:1533
TimeCPU
LONG TimeCPU(WORD)
Definition tools.c:3487
WITHOUTERROR
#define WITHOUTERROR
Definition ftypes.h:51
PF_BroadcastRedefinedPreVars
int PF_BroadcastRedefinedPreVars(void)
Definition parallel.c:3005
PF_BroadcastModifiedDollars
int PF_BroadcastModifiedDollars(void)
Definition parallel.c:2788
DoContinueDo
int DoContinueDo(UBYTE *s)
Definition pre.c:2800
TheDefine
int TheDefine(UBYTE *s, int mode)
Definition pre.c:2030
PutPreVar
int PutPreVar(UBYTE *name, UBYTE *value, UBYTE *args, int mode)
Definition pre.c:724
DoPreAppendPath
int DoPreAppendPath(UBYTE *s)
Definition pre.c:7231
DoPrePrependPath
int DoPrePrependPath(UBYTE *s)
Definition pre.c:7248
CbUf::rhs
WORD ** rhs
Definition structs.h:975
CbUf::lhs
WORD ** lhs
Definition structs.h:974
CbUf::Buffer
WORD * Buffer
Definition structs.h:971
CbUf::Pointer
WORD * Pointer
Definition structs.h:973
DoLoOp::dollarname
UBYTE * dollarname
Definition structs.h:881
DoLoOp::p
PRELOAD p
Definition structs.h:877
DoLoOp::name
UBYTE * name
Definition structs.h:878
pReVaR::nargs
int nargs
Definition structs.h:827
Vector
#define Vector(T, X)
Definition vector.h:84
VectorReserve
#define VectorReserve(X, newcapacity)
Definition vector.h:249
VectorSize
#define VectorSize(X)
Definition vector.h:194
VectorPtr
#define VectorPtr(X)
Definition vector.h:150
Generated by doxygen 1.9.8