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