FORM v5.0.1-23-g7a8f756
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 MesPrint("!!!Internal error with procedure names: %s",name);
2730 return(-1);
2731}
2732
2733/*
2734 #] DoCall :
2735 #[ DoDebug :
2736*/
2737
2738int DoDebug(UBYTE *s)
2739{
2740 int x;
2741 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2742 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2743 NeedNumber(x,s,nonumber)
2744 if ( x < 0 || x >(PREPROONLY
2745 | DUMPTOCOMPILER
2746 | DUMPOUTTERMS
2747 | DUMPINTERMS
2748 | DUMPTOSORT
2749 | DUMPTOPARALLEL
2750#ifdef WITHPTHREADS
2751 | THREADSDEBUG
2752#endif
2753 ) ) goto nonumber;
2754 AP.PreDebug = 0;
2755 if ( ( x & PREPROONLY ) != 0 ) AP.PreDebug |= PREPROONLY; /* 1 */
2756 if ( ( x & DUMPTOCOMPILER ) != 0 ) AP.PreDebug |= DUMPTOCOMPILER; /* 2 */
2757 if ( ( x & DUMPOUTTERMS ) != 0 ) AP.PreDebug |= DUMPOUTTERMS; /* 4 */
2758 if ( ( x & DUMPINTERMS ) != 0 ) AP.PreDebug |= DUMPINTERMS; /* 8 */
2759 if ( ( x & DUMPTOSORT ) != 0 ) AP.PreDebug |= DUMPTOSORT; /* 16 */
2760 if ( ( x & DUMPTOPARALLEL ) != 0 ) AP.PreDebug |= DUMPTOPARALLEL; /* 32 */
2761#ifdef WITHPTHREADS
2762 if ( ( x & THREADSDEBUG ) != 0 ) AP.PreDebug |= THREADSDEBUG; /* 64 */
2763#endif
2764 return(0);
2765nonumber:
2766 MesPrint("@Illegal argument for debug instruction");
2767 return(1);
2768}
2769
2770/*
2771 #] DoDebug :
2772 #[ DoTerminate :
2773*/
2774
2775int DoTerminate(UBYTE *s)
2776{
2777 int x;
2778 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2779 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2780 if ( *s ) {
2781 NeedNumber(x,s,nonumber)
2782 Terminate(x);
2783 }
2784 else {
2785 Terminate(-1);
2786 }
2787 return(0);
2788nonumber:
2789 MesPrint("@Illegal argument for terminate instruction");
2790 return(1);
2791}
2792
2793/*
2794 #] DoTerminate :
2795 #[ DoContinueDo :
2796*/
2797
2809int DoContinueDo(UBYTE *s)
2810{
2811 DOLOOP *loop;
2812 WORD levels;
2813 int result;
2814
2815 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2816 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2817
2818 if ( NumDoLoops <= 0 ) {
2819 MesPrint("@%#continuedo without %#do");
2820 return(1);
2821 }
2822
2823 SkipSpaces(&s);
2824 if ( *s == 0 ) {
2825 levels = 1;
2826 }
2827 else if ( FG.cTable[*s] == 1 ) {
2828 ParseNumber(levels,s);
2829 SkipSpaces(&s);
2830 if ( *s != 0 ) goto improper;
2831 }
2832 else {
2833improper:
2834 MesPrint("@Improper syntax of %#continuedo instruction");
2835 return(1);
2836 }
2837
2838 if ( levels > NumDoLoops ) {
2839 MesPrint("@Too many loop levels requested in %#continuedo instruction");
2840 return(1);
2841 }
2842
2843 result = ExitDoLoops(levels-1,"continuedo");
2844 if ( result != 0 ) return(result);
2845
2846 if ( levels <= 0 ) return(0);
2847
2848 if ( AC.CurrentStream->type == PREREADSTREAM3
2849 || AP.PreTypes[AP.NumPreTypes] == PRETYPEPROCEDURE ) {
2850 MesPrint("@Trying to jump out of a procedure with a %#continuedo instruction");
2851 return(1);
2852 }
2853
2854 loop = &(DoLoops[NumDoLoops-1]);
2855 AP.NumPreTypes = loop->NumPreTypes+1;
2856 AP.PreIfLevel = loop->PreIfLevel;
2857 AP.PreSwitchLevel = loop->PreSwitchLevel;
2858
2859 return(DoEnddo(s));
2860}
2861
2862/*
2863 #] DoContinueDo :
2864 #[ DoDo :
2865
2866 The do loop has three varieties:
2867 #do i = num1,num2 [,num3]
2868 #do i = {string1,string2,....,stringn}
2869 The | as separator is also allowed for backwards compatibility
2870 #do i = expression One by one all terms of the expression
2871*/
2872
2873int DoDo(UBYTE *s)
2874{
2875 GETIDENTITY
2876 UBYTE *t, c, *u, *uu;
2877 DOLOOP *loop;
2878 WORD expnum;
2879 LONG linenum = AC.CurrentStream->linenumber;
2880 int oldNoShowInput = AC.NoShowInput, i, oldpreassignflag;
2881
2882 if ( ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH )
2883 || ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) ) {
2884 if ( PreSkip((UBYTE *)"do",(UBYTE *)"enddo",1) ) return(-1);
2885 return(0);
2886 }
2887
2888/*
2889 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
2890 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
2891*/
2892 AddToPreTypes(PRETYPEDO);
2893
2894 loop = (DOLOOP *)FromList(&AP.LoopList);
2895 loop->firstdollar = loop->lastdollar = loop->incdollar = -1;
2896 loop->NumPreTypes = AP.NumPreTypes-1;
2897 loop->PreIfLevel = AP.PreIfLevel;
2898 loop->PreSwitchLevel = AP.PreSwitchLevel;
2899 AC.NoShowInput = 1;
2900 if ( PreLoad(&(loop->p),(UBYTE *)"do",(UBYTE *)"enddo",1,"doloop") ) return(-1);
2901 AC.NoShowInput = oldNoShowInput;
2902 loop->NoShowInput = AC.NoShowInput;
2903/*
2904 Get now the name. We have to take great care when the name is terminated!
2905*/
2906 s = loop->p.buffer + (s - AP.preStart);
2907 SKIPBLANKS(s)
2908 loop->name = s;
2909 if ( chartype[*s] != 0 ) goto illname;
2910 s++;
2911 while ( chartype[*s] <= 1 ) s++;
2912 t = s;
2913 while ( *s == ' ' || *s == '\t' ) s++;
2914 if ( *s != '=' ) goto illdo;
2915 s++;
2916 while ( *s == ' ' || *s == '\t' ) s++;
2917 *t = 0;
2918
2919 if ( *s == '{' ) {
2920 loop->type = LISTEDLOOP;
2921 s++; loop->vars = s;
2922 loop->lastnum = 0;
2923 while ( *s != '}' && *s != 0 ) {
2924 if ( set_in(*s,AC.separators) ) { *s = 0; loop->lastnum++; }
2925 else if ( *s == '\\' ) s++;
2926 s++;
2927 }
2928 if ( *s == 0 ) goto illdo;
2929 *s++ = 0;
2930 loop->lastnum++;
2931 loop->firstnum = 0;
2932 loop->contents = s;
2933 }
2934 else if ( *s == '-' || *s == '+' || chartype[*s] == 1 || *s == '$' ) {
2935 loop->type = NUMERICALLOOP;
2936 t = s;
2937 while ( *s && *s != ',' ) s++;
2938 if ( *s == 0 ) goto illdo;
2939 if ( *t == '$' ) {
2940 c = *s; *s = 0;
2941 if ( GetName(AC.dollarnames,t+1,&loop->firstdollar,NOAUTO) != CDOLLAR ) {
2942 MesPrint("@%s is undefined in first parameter in %#do instruction",t);
2943 return(-1);
2944 }
2945 loop->firstnum = DolToLong(BHEAD loop->firstdollar);
2946 if ( AN.ErrorInDollar ) {
2947 MesPrint("@%s does not evaluate into a valid loop parameter",t);
2948 return(-1);
2949 }
2950 *s++ = c;
2951 }
2952 else {
2953 *s = '}';
2954 if ( PreEval(t,&loop->firstnum) == 0 ) goto illdo;
2955 *s++ = ',';
2956 }
2957 t = s;
2958 while ( *s && *s != ',' && *s != ';' && *s != LINEFEED ) s++;
2959 c = *s;
2960 if ( *t == '$' ) {
2961 *s = 0;
2962 if ( GetName(AC.dollarnames,t+1,&loop->lastdollar,NOAUTO) != CDOLLAR ) {
2963 MesPrint("@%s is undefined in second parameter in %#do instruction",t);
2964 return(-1);
2965 }
2966 loop->lastnum = DolToLong(BHEAD loop->lastdollar);
2967 if ( AN.ErrorInDollar ) {
2968 MesPrint("@%s does not evaluate into a valid loop parameter",t);
2969 return(-1);
2970 }
2971 *s++ = c;
2972 }
2973 else {
2974 *s = '}';
2975 if ( PreEval(t,&loop->lastnum) == 0 ) goto illdo;
2976 *s++ = c;
2977 }
2978 if ( c == ',' ) {
2979 t = s;
2980 while ( *s && *s != ';' && *s != LINEFEED ) s++;
2981 if ( *t == '$' ) {
2982 c = *s; *s = 0;
2983 if ( GetName(AC.dollarnames,t+1,&loop->incdollar,NOAUTO) != CDOLLAR ) {
2984 MesPrint("@%s is undefined in third parameter in %#do instruction",t);
2985 return(-1);
2986 }
2987 loop->incnum = DolToLong(BHEAD loop->incdollar);
2988 if ( AN.ErrorInDollar ) {
2989 MesPrint("@%s does not evaluate into a valid loop parameter",t);
2990 return(-1);
2991 }
2992 *s++ = c;
2993 }
2994 else {
2995 c = *s; *s = '}';
2996 if ( PreEval(t,&loop->incnum) == 0 ) goto illdo;
2997 *s++ = c;
2998 }
2999 }
3000 else loop->incnum = 1;
3001 loop->contents = s;
3002 }
3003 else if ( ( chartype[*s] == 0 ) || ( *s == '[' ) ) {
3004 int oldNumPotModdollars = NumPotModdollars;
3005#ifdef WITHMPI
3006 WORD oldRhsExprInModuleFlag = AC.RhsExprInModuleFlag;
3007 AC.RhsExprInModuleFlag = 0;
3008#endif
3009 t = s;
3010 if ( ( s = SkipAName(s) ) == 0 ) goto illdo;
3011 c = *s; *s = 0;
3012 if ( GetName(AC.exprnames,t,&expnum,NOAUTO) == CEXPRESSION ) {
3013 loop->type = ONEEXPRESSION;
3014/*
3015 We should remember the expression by name for when it gets
3016 renumbered!!! If it gets deleted there will be a crash or at
3017 least the loop terminates.
3018*/
3019 loop->vars = t;
3020 }
3021 else goto illdo;
3022 if ( c == ',' || c == '\t' || c == ';' ) { s++; }
3023 else if ( c != 0 && c != '\n' ) goto illdo;
3024 while ( *s == ',' || *s == '\t' || *s == ';' ) s++;
3025 if ( *s != 0 && *s != '\n' ) goto illdo;
3026 loop->firstnum = 0;
3027 s++;
3028 loop->contents = s;
3029 loop->incnum = 0;
3030/*
3031 Next determine size of statement and allocate space
3032*/
3033 while ( *t ) t++;
3034 i = t - loop->vars;
3035 t = loop->name;
3036 while ( *t ) { t++; i++; }
3037 i += 4;
3038 loop->dollarname = Malloc1((LONG)i,"do-loop instruction");
3039/*
3040 Construct the statement
3041*/
3042 u = loop->dollarname;
3043 *u++ = '$'; t = loop->name; while ( *t ) *u++ = *t++;
3044 *u++ = '_'; uu = u; *u++ = '='; t = loop->vars;
3045 while ( *t ) *u++ = *t++;
3046 *t = 0; *u = 0;
3047/*
3048 Compile and put in dollar variable.
3049 Note that we remember the dollar by name and that this name ends in _
3050*/
3051 oldpreassignflag = AP.PreAssignFlag;
3052 AP.PreAssignFlag = 2;
3053 CompileStatement(loop->dollarname);
3054 if ( CatchDollar(0) ) {
3055 MesPrint("@Cannot load expression in do loop");
3056 return(-1);
3057 }
3058 AP.PreAssignFlag = oldpreassignflag;
3059 NumPotModdollars = oldNumPotModdollars;
3060#ifdef WITHMPI
3061 AC.RhsExprInModuleFlag = oldRhsExprInModuleFlag;
3062#endif
3063 *uu = 0;
3064 }
3065 else goto illdo; /* Syntax problems */
3066 loop->errorsinloop = 0;
3067/* loop->startlinenumber = linenum+1; 5-oct-2000 One too much? */
3068 loop->startlinenumber = linenum;
3069 PutPreVar(loop->name,(UBYTE *)"0",0,0);
3070 loop->firstloopcall = 1;
3071 return(DoEnddo(s));
3072illname:;
3073 MesPrint("@Improper name for do loop variable");
3074 return(-1);
3075illdo:;
3076 MesPrint("@Improper syntax in do loop instruction");
3077 return(-1);
3078}
3079
3080/*
3081 #] DoDo :
3082 #[ DoBreakDo :
3083
3084 #breakdo [num]
3085 jumps out of num #do-loops (if there are that many) (default is 1)
3086*/
3087
3088int DoBreakDo(UBYTE *s)
3089{
3090 WORD levels;
3091
3092 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3093 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3094
3095 if ( NumDoLoops <= 0 ) {
3096 MesPrint("@%#breakdo without %#do");
3097 return(1);
3098 }
3099/*
3100 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEDO ) { MessPreNesting(4); return(-1); }
3101*/
3102 while ( *s && ( *s == ',' || *s == ' ' || *s == '\t' ) ) s++;
3103 if ( *s == 0 ) {
3104 levels = 1;
3105 }
3106 else if ( FG.cTable[*s] == 1 ) {
3107 levels = 0;
3108 while ( *s >= '0' && *s <= '9' ) { levels = 10*levels + *s++ - '0'; }
3109 if ( *s != 0 ) goto improper;
3110 }
3111 else {
3112improper:
3113 MesPrint("@Improper syntax of %#breakdo instruction");
3114 return(1);
3115 }
3116 if ( levels > NumDoLoops ) {
3117 MesPrint("@Too many loop levels requested in %#breakdo instruction");
3118 Terminate(-1);
3119 }
3120 return(ExitDoLoops(levels,"breakdo"));
3121}
3122
3130static int ExitDoLoops(int levels, const char *instruction)
3131{
3132 DOLOOP *loop;
3133 while ( levels > 0 ) {
3134 while ( AC.CurrentStream->type != PREREADSTREAM
3135 && AC.CurrentStream->type != PREREADSTREAM2
3136 && AC.CurrentStream->type != PREREADSTREAM3 ) {
3137 AC.CurrentStream = CloseStream(AC.CurrentStream);
3138 }
3139 while ( AP.PreTypes[AP.NumPreTypes] != PRETYPEDO
3140 && AP.PreTypes[AP.NumPreTypes] != PRETYPEPROCEDURE ) AP.NumPreTypes--;
3141 if ( AC.CurrentStream->type == PREREADSTREAM3
3142 || AP.PreTypes[AP.NumPreTypes] == PRETYPEPROCEDURE ) {
3143 MesPrint("@Trying to jump out of a procedure with a %#%s instruction",instruction);
3144 return(1);
3145 }
3146 loop = &(DoLoops[NumDoLoops-1]);
3147 AP.NumPreTypes = loop->NumPreTypes;
3148 AP.PreIfLevel = loop->PreIfLevel;
3149 AP.PreSwitchLevel = loop->PreSwitchLevel;
3150 NumDoLoops--;
3151 DoUndefine(loop->name);
3152 M_free(loop->p.buffer,"loop->p.buffer");
3153 loop->firstloopcall = 0;
3154
3155 AC.CurrentStream = CloseStream(AC.CurrentStream);
3156 levels--;
3157 }
3158 return(0);
3159}
3160
3161/*
3162 #] DoBreakDo :
3163 #[ DoElse :
3164*/
3165
3166int DoElse(UBYTE *s)
3167{
3168 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEIF ) {
3169 if ( AP.PreIfLevel <= 0 ) MesPrint("@%#else without corresponding %#if");
3170 else MessPreNesting(1);
3171 return(-1);
3172 }
3173 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3174 while ( *s == ' ' ) s++;
3175 if ( tolower(*s) == 'i' && tolower(s[1]) == 'f' && s[2]
3176 && FG.cTable[s[2]] > 1 && s[2] != '_' ) {
3177 s += 2;
3178 while ( *s == ' ' ) s++;
3179 return(DoElseif(s));
3180 }
3181 if ( AP.PreIfLevel <= 0 ) {
3182 MesPrint("@%#else without corresponding %#if");
3183 return(-1);
3184 }
3185 switch ( AP.PreIfStack[AP.PreIfLevel] ) {
3186 case EXECUTINGIF:
3187 AP.PreIfStack[AP.PreIfLevel] = LOOKINGFORENDIF;
3188 break;
3189 case LOOKINGFORELSE:
3190 AP.PreIfStack[AP.PreIfLevel] = EXECUTINGIF;
3191 break;
3192 case LOOKINGFORENDIF:
3193 break;
3194 }
3195 return(0);
3196}
3197
3198/*
3199 #] DoElse :
3200 #[ DoElseif :
3201*/
3202
3203int DoElseif(UBYTE *s)
3204{
3205 int condition;
3206 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEIF ) {
3207 if ( AP.PreIfLevel <= 0 ) MesPrint("@%#elseif without corresponding %#if");
3208 else MessPreNesting(2);
3209 return(-1);
3210 }
3211 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3212 if ( AP.PreIfLevel <= 0 ) {
3213 MesPrint("@%#elseif without corresponding %#if");
3214 return(-1);
3215 }
3216 switch ( AP.PreIfStack[AP.PreIfLevel] ) {
3217 case EXECUTINGIF:
3218 AP.PreIfStack[AP.PreIfLevel] = LOOKINGFORENDIF;
3219 break;
3220 case LOOKINGFORELSE:
3221 if ( ( condition = EvalPreIf(s) ) < 0 ) return(-1);
3222 AP.PreIfStack[AP.PreIfLevel] = condition;
3223 break;
3224 case LOOKINGFORENDIF:
3225 break;
3226 }
3227 return(0);
3228}
3229
3230/*
3231 #] DoElseif :
3232 #[ DoEnddo :
3233
3234 At the first call there is no stream yet.
3235 After that we have to close the stream and start a new one.
3236*/
3237
3238int DoEnddo(UBYTE *s)
3239{
3240 GETIDENTITY
3241 DOLOOP *loop;
3242 UBYTE *t, *tt, *value, numstr[16];
3243 LONG xval;
3244 int xsign, retval;
3245 DUMMYUSE(s);
3246 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3247 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3248/*
3249 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ||
3250 AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) {
3251 if ( AP.PreTypes[AP.NumPreTypes] == PRETYPEDO ) AP.NumPreTypes--;
3252 else { MessPreNesting(3); return(-1); }
3253 return(0);
3254 }
3255*/
3256 if ( NumDoLoops <= 0 ) {
3257 MesPrint("@%#enddo without %#do");
3258 return(1);
3259 }
3260 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEDO ) { MessPreNesting(4); return(-1); }
3261 loop = &(DoLoops[NumDoLoops-1]);
3262 if ( !loop->firstloopcall ) AC.CurrentStream = CloseStream(AC.CurrentStream);
3263
3264 if ( loop->errorsinloop ) {
3265 MesPrint("++++Errors in Loop");
3266 goto finish;
3267 }
3268 if ( loop->type == LISTEDLOOP ) {
3269 if ( loop->firstnum >= loop->lastnum ) goto finish;
3270 loop->firstnum++;
3271 t = value = loop->vars;
3272 while ( *value ) value++;
3273 value++;
3274 loop->vars = value;
3275 value = tt = t;
3276 while ( *value ) {
3277 if ( *value == '\\' ) value++;
3278 *tt++ = *value++;
3279 }
3280 *tt = 0;
3281 PutPreVar(loop->name,t,0,1); /* We overwrite the definition */
3282 }
3283 else if ( loop->type == NUMERICALLOOP ) {
3284
3285 if ( !loop->firstloopcall ) {
3286/*
3287 Test whether the variable was changed inside the loop into
3288 a different numerical value. If so, adjust.
3289*/
3290 t = GetPreVar(loop->name,WITHOUTERROR);
3291 if ( t ) {
3292 value = t;
3293 xsign = 1;
3294 while ( *value && ( *value == ' '
3295 || *value == '-' || *value == '+' ) ) {
3296 if ( *value == '-' ) xsign = -xsign;
3297 value++;
3298 }
3299 t = value; xval = 0;
3300 while ( *value >= '0' && *value <= '9' ) xval = 10*xval + *value++ - '0';
3301 while ( *value && *value == ' ' ) value++;
3302 if ( *value == 0 ) {
3303/*
3304 Now we may substitute the loopvalue.
3305*/
3306 if ( xsign < 0 ) xval = -xval;
3307 if ( loop->incdollar >= 0 ) {
3308 loop->incnum = DolToLong(BHEAD loop->incdollar);
3309 if ( AN.ErrorInDollar ) {
3310 MesPrint("@%s does not evaluate into a valid third loop parameter",DOLLARNAME(Dollars,loop->incdollar));
3311 return(-1);
3312 }
3313 }
3314 loop->firstnum = xval + loop->incnum;
3315 }
3316 }
3317 if ( loop->lastdollar >= 0 ) {
3318 loop->lastnum = DolToLong(BHEAD loop->lastdollar);
3319 if ( AN.ErrorInDollar ) {
3320 MesPrint("@%s does not evaluate into a valid second loop parameter",DOLLARNAME(Dollars,loop->lastdollar));
3321 return(-1);
3322 }
3323 }
3324 }
3325 if ( ( loop->incnum > 0 && loop->firstnum > loop->lastnum )
3326 || ( loop->incnum < 0 && loop->firstnum < loop->lastnum ) ) goto finish;
3327 NumToStr(numstr,loop->firstnum);
3328 t = numstr;
3329 loop->firstnum += loop->incnum;
3330 PutPreVar(loop->name,t,0,1); /* We overwrite the definition */
3331 }
3332 else if ( loop->type == ONEEXPRESSION ) {
3333/*
3334 Find the dollar expression
3335*/
3336 WORD numdollar = GetDollar(loop->dollarname+1);
3337 DOLLARS d = Dollars + numdollar;
3338 WORD *w, *dw, v, *ww;
3339 if ( (d->where) == 0 ) {
3340 d->type = DOLUNDEFINED;
3341 M_free(loop->dollarname,"do-loop instruction");
3342 goto finish;
3343 }
3344 w = d->where + loop->incnum;
3345 if ( *w == 0 ) {
3346 M_free(d->where,"dollar");
3347 d->where = 0;
3348 d->type = DOLUNDEFINED;
3349 M_free(loop->dollarname,"do-loop instruction");
3350 goto finish;
3351 }
3352 loop->incnum += *w;
3353/*
3354 Now the term has to be converted to text.
3355*/
3356 ww = w + *w; v = *ww; *ww = 0;
3357 dw = d->where; d->where = w;
3358 t = WriteDollarToBuffer(numdollar,1);
3359 d->where = dw; *ww = v;
3360 PutPreVar(loop->name,t,0,1); /* We overwrite the definition */
3361 M_free(t,"dollar");
3362 }
3363 if ( loop->firstloopcall ) OpenStream(loop->contents,PREREADSTREAM2,0,PRENOACTION);
3364 else OpenStream(loop->contents,PREREADSTREAM,0,PRENOACTION);
3365 AC.CurrentStream->prevline =
3366 AC.CurrentStream->linenumber = loop->startlinenumber;
3367 AC.CurrentStream->eqnum = 0;
3368 loop->firstloopcall = 0;
3369 return(0);
3370finish:;
3371 NumDoLoops--;
3372 retval = DoUndefine(loop->name);
3373 M_free(loop->p.buffer,"loop->p.buffer");
3374 loop->firstloopcall = 0;
3375 AP.NumPreTypes--;
3376 return(retval);
3377}
3378
3379/*
3380 #] DoEnddo :
3381 #[ DoEndif :
3382*/
3383
3384int DoEndif(UBYTE *s)
3385{
3386 DUMMYUSE(s);
3387 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEIF ) {
3388 if ( AP.PreIfLevel <= 0 ) MesPrint("@%#endif without corresponding %#if");
3389 else MessPreNesting(5);
3390 return(-1);
3391 }
3392 AP.NumPreTypes--;
3393 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3394 if ( AP.PreIfLevel <= 0 ) {
3395 MesPrint("@%#endif without corresponding %#if");
3396 return(-1);
3397 }
3398 AP.PreIfLevel--;
3399 return(0);
3400}
3401
3402/*
3403 #] DoEndif :
3404 #[ DoEndprocedure :
3405
3406 Action is simple: close the current stream if it is still
3407 the stream from which the statement came.
3408 Then pop the current procedure and all its local derivatives.
3409 if loadmode > 1 the procedure was defined locally.
3410*/
3411
3412int DoEndprocedure(UBYTE *s)
3413{
3414 DUMMYUSE(s);
3415 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEPROCEDURE ) {
3416 MessPreNesting(6);
3417 return(-1);
3418 }
3419 AP.NumPreTypes--;
3420 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3421 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3422 AC.CurrentStream = CloseStream(AC.CurrentStream);
3423
3424 do {
3425 NumProcedures--;
3426 if ( Procedures[NumProcedures].mustfree == 1 ) {
3427 M_free(Procedures[NumProcedures].p.buffer,"procedures buffer");
3428 M_free(Procedures[NumProcedures].name,"procedures name");
3429 }
3430 } while ( Procedures[NumProcedures].loadmode > 1 );
3431 return(0);
3432}
3433
3434/*
3435 #] DoEndprocedure :
3436 #[ DoIf :
3437*/
3438
3439int DoIf(UBYTE *s)
3440{
3441 int condition;
3442 AddToPreTypes(PRETYPEIF);
3443 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3444 if ( AP.PreIfStack[AP.PreIfLevel] == EXECUTINGIF ) {
3445 condition = EvalPreIf(s);
3446 if ( condition < 0 ) return(-1);
3447 }
3448 else condition = LOOKINGFORENDIF;
3449 if ( AP.PreIfLevel+1 >= AP.MaxPreIfLevel ) {
3450 int **ppp = &AP.PreIfStack; /* To avoid a compiler warning */
3451 if ( DoubleList((void ***)ppp,&AP.MaxPreIfLevel,sizeof(int),
3452 "PreIfLevels") ) return(-1);
3453 }
3454 AP.PreIfStack[++AP.PreIfLevel] = condition;
3455 return(0);
3456}
3457
3458/*
3459 #] DoIf :
3460 #[ DoIfdef :
3461*/
3462
3463int DoIfdef(UBYTE *s, int par)
3464{
3465 int condition;
3466 AddToPreTypes(PRETYPEIF);
3467 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3468 if ( AP.PreIfStack[AP.PreIfLevel] == EXECUTINGIF ) {
3469 while ( *s == ' ' || *s == '\t' ) s++;
3470 if ( ( *s == 0 ) == ( par == 1 ) ) condition = LOOKINGFORELSE;
3471 else condition = EXECUTINGIF;
3472 }
3473 else condition = LOOKINGFORENDIF;
3474 if ( AP.PreIfLevel+1 >= AP.MaxPreIfLevel ) {
3475 int **ppp = &AP.PreIfStack; /* to avoid a compiler warning */
3476 if ( DoubleList((void ***)ppp,&AP.MaxPreIfLevel,sizeof(int),
3477 "PreIfLevels") ) return(-1);
3478 }
3479 AP.PreIfStack[++AP.PreIfLevel] = condition;
3480 return(0);
3481}
3482
3483/*
3484 #] DoIfdef :
3485 #[ DoIfydef :
3486*/
3487
3488int DoIfydef(UBYTE *s)
3489{
3490 return DoIfdef(s,1);
3491}
3492
3493/*
3494 #] DoIfydef :
3495 #[ DoIfndef :
3496*/
3497
3498int DoIfndef(UBYTE *s)
3499{
3500 return DoIfdef(s,2);
3501}
3502
3503/*
3504 #] DoIfndef :
3505 #[ DoInside :
3506
3507 #inside $var1,...,$varn
3508 statements without .sort
3509 #endinside
3510
3511 executes the statements on the contents of the $ variables as if they
3512 are a module. The results are put back in the dollar variables.
3513 To do this right we need a struct with
3514 old compiler buffer
3515 list of numbers of dollars
3516 length of the list
3517 length of the array containing the list
3518 Because we need to compose statements, the statement buffer must be
3519 empty. This means that we have to test for that. Same at the end. We
3520 must have a completed statement.
3521*/
3522
3523int DoInside(UBYTE *s)
3524{
3525 GETIDENTITY
3526 int numdol, error = 0;
3527 WORD *nb, newsize, i;
3528 UBYTE *name, c;
3529 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3530 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3531 if ( AP.PreInsideLevel != 0 ) {
3532 MesPrint("@Illegal nesting of %#inside/%#endinside instructions");
3533 return(-1);
3534 }
3535/*
3536 if ( AP.PreContinuation ) {
3537 error = -1;
3538 MesPrint("@%#inside cannot be inside a regular statement");
3539 }
3540*/
3541 PUSHPREASSIGNLEVEL
3542/*
3543 Now the dollars to do
3544*/
3545 AP.inside.numdollars = 0;
3546 for(;;) {
3547 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
3548 if ( *s == 0 ) break;
3549 if ( *s != '$' ) {
3550 MesPrint("@%#inside instruction can have only $ variables for parameters");
3551 return(-1);
3552 }
3553 s++;
3554 name = s;
3555 while (chartype[*s] <= 1 ) s++;
3556 c = *s; *s = 0;
3557 if ( ( numdol = GetDollar(name) ) < 0 ) {
3558 MesPrint("@%#inside: $%s has not (yet) been defined",name);
3559 *s = c;
3560 error = -1;
3561 }
3562 else {
3563 *s = c;
3564 if ( AP.inside.numdollars >= AP.inside.size ) {
3565 if ( AP.inside.buffer == 0 ) newsize = 20;
3566 else newsize = 2*AP.inside.size;
3567 nb = (WORD *)Malloc1(newsize*sizeof(WORD),"insidebuffer");
3568 if ( AP.inside.buffer ) {
3569 for ( i = 0; i < AP.inside.size; i++ ) nb[i] = AP.inside.buffer[i];
3570 M_free(AP.inside.buffer,"insidebuffer");
3571 }
3572 AP.inside.buffer = nb;
3573 AP.inside.size = newsize;
3574 }
3575 AP.inside.buffer[AP.inside.numdollars++] = numdol;
3576 }
3577 }
3578/*
3579 We have to store the configuration of the compiler buffer, so that
3580 we know where to start executing and how to reset the buffer.
3581*/
3582 AP.inside.oldcompiletype = AC.compiletype;
3583 AP.inside.oldparallelflag = AC.mparallelflag;
3584 AP.inside.oldnumpotmoddollars = NumPotModdollars;
3585 AP.inside.oldcbuf = AC.cbufnum;
3586 AP.inside.oldrbuf = AM.rbufnum;
3587 AP.inside.oldcnumlhs = AR.Cnumlhs,
3588 AddToPreTypes(PRETYPEINSIDE);
3589 AP.PreInsideLevel = 1;
3590 AC.cbufnum = AP.inside.inscbuf;
3591 AM.rbufnum = AP.inside.inscbuf;
3592 clearcbuf(AC.cbufnum);
3593 AC.compiletype = 0;
3594 AC.mparallelflag = PARALLELFLAG;
3595#ifdef WITHMPI
3596 /*
3597 * We use AC.RhsExprInModuleFlag, PotModdollars, and AC.pfirstnum
3598 * in order to check (1) whether there are expression names in RHS,
3599 * (2) which dollar variables can be modified, and (3) which
3600 * preprocessor variables can be redefined, in #inside.
3601 * We store the current values of them, and then reset them.
3602 */
3603 PF_StoreInsideInfo();
3604 AC.RhsExprInModuleFlag = 0;
3605 NumPotModdollars = 0;
3606 AC.numpfirstnum = 0;
3607#endif
3608 return(error);
3609}
3610
3611/*
3612 #] DoInside :
3613 #[ DoEndInside :
3614*/
3615
3616int DoEndInside(UBYTE *s)
3617{
3618 GETIDENTITY
3619 WORD numdol, *oldworkpointer = AT.WorkPointer, *term, *t, j, i;
3620 DOLLARS d, nd;
3621 WORD oldbracketon = AR.BracketOn;
3622 WORD *oldcompresspointer = AR.CompressPointer;
3623 int oldmultithreaded = AS.MultiThreaded;
3624 /* int oldmparallelflag = AC.mparallelflag; */
3625 FILEHANDLE *f;
3626#ifdef WITHMPI
3627 int error = 0;
3628#endif
3629 DUMMYUSE(s);
3630 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3631 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3632 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPEINSIDE ) {
3633 if ( AP.PreInsideLevel != 1 ) MesPrint("@%#endinside without corresponding %#inside");
3634 else MessPreNesting(11);
3635 return(-1);
3636 }
3637 AP.NumPreTypes--;
3638 if ( AP.PreInsideLevel != 1 ) {
3639 MesPrint("@%#endinside without corresponding %#inside");
3640 return(-1);
3641 }
3642 if ( AP.PreContinuation ) {
3643 MesPrint("@%#endinside: previous statement not terminated.");
3644 Terminate(-1);
3645 }
3646 AC.compiletype = AP.inside.oldcompiletype;
3647 AR.Cnumlhs = cbuf[AM.rbufnum].numlhs;
3648#ifdef WITHMPI
3649 /*
3650 * If the #inside...#endinside contains expressions in RHS, only the master executes it
3651 * and then broadcasts the result to the all slaves. If not, the all processes execute
3652 * it and in this case no MPI interactions are needed.
3653 */
3654 if ( PF.me == MASTER || !AC.RhsExprInModuleFlag ) {
3655#endif
3656 AR.BracketOn = 0;
3657 AS.MultiThreaded = 0;
3658 /* AC.mparallelflag = PARALLELFLAG; */
3659 if ( AR.CompressPointer == 0 ) AR.CompressPointer = AR.CompressBuffer;
3660 f = AR.infile; AR.infile = AR.outfile; AR.outfile = f;
3661/*
3662 Now we have to execute the statements on the proper dollars.
3663*/
3664 for ( i = 0; i < AP.inside.numdollars; i++ ) {
3665 numdol = AP.inside.buffer[i];
3666 nd = d = Dollars + numdol;
3667 if ( d->type != DOLZERO ) {
3668 if ( d->type != DOLTERMS ) nd = DolToTerms(BHEAD numdol);
3669 term = nd->where;
3670 NewSort(BHEAD0);
3671 NewSort(BHEAD0);
3672 AR.MaxDum = AM.IndDum;
3673 while ( *term ) {
3674 t = oldworkpointer; j = *term;
3675 NCOPY(t,term,j);
3676 AT.WorkPointer = t;
3677 AN.IndDum = AM.IndDum;
3678 AR.CurDum = ReNumber(BHEAD term);
3679 if ( Generator(BHEAD oldworkpointer,0) ) {
3680 MesPrint("@Called from %#endinside");
3681 MesPrint("@Evaluating variable $%s",DOLLARNAME(Dollars,numdol));
3682 Terminate(-1);
3683 }
3684 }
3685 AT.WorkPointer = oldworkpointer;
3686 CleanDollarFactors(d);
3687 if ( d->where ) { M_free(d->where,"dollar contents"); d->where = 0; }
3688 EndSort(BHEAD (WORD *)((void *)(&(d->where))),2);
3689 LowerSortLevel();
3690 term = d->where; while ( *term ) term += *term;
3691 d->size = term - d->where;
3692 if ( nd != d ) M_free(nd,"Copy of dollar variable");
3693 if ( d->where[0] == 0 ) {
3694 M_free(d->where,"dollar contents"); d->where = 0;
3695 d->type = DOLZERO;
3696 }
3697 }
3698 }
3699#ifdef WITHMPI
3700 }
3701 if ( AC.RhsExprInModuleFlag ) {
3702 /*
3703 * The only master executed the statements in #inside.
3704 * We need to broadcast the result to the all slaves.
3705 */
3706 for ( i = 0; i < AP.inside.numdollars; i++ ) {
3707 /*
3708 * Mark $-variables specified in the #inside instruction as modified
3709 * such that they will be broadcast.
3710 */
3711 AddPotModdollar(AP.inside.buffer[i]);
3712 }
3713 /* Now actual broadcast of modified variables. */
3714 if ( NumPotModdollars > 0 ) {
3715 error = PF_BroadcastModifiedDollars();
3716 if ( error ) goto cleanup;
3717 }
3718 if ( AC.numpfirstnum > 0 ) {
3719 error = PF_BroadcastRedefinedPreVars();
3720 if ( error ) goto cleanup;
3721 }
3722 }
3723cleanup:
3724#endif
3725 f = AR.infile; AR.infile = AR.outfile; AR.outfile = f;
3726 AC.cbufnum = AP.inside.oldcbuf;
3727 AM.rbufnum = AP.inside.oldrbuf;
3728 AR.Cnumlhs = AP.inside.oldcnumlhs;
3729 AR.BracketOn = oldbracketon;
3730 AP.PreInsideLevel = 0;
3731 AR.CompressPointer = oldcompresspointer;
3732 AS.MultiThreaded = oldmultithreaded;
3733 AC.mparallelflag = AP.inside.oldparallelflag;
3734 NumPotModdollars = AP.inside.oldnumpotmoddollars;
3735 POPPREASSIGNLEVEL
3736#ifdef WITHMPI
3737 PF_RestoreInsideInfo();
3738 if ( error ) return error;
3739#endif
3740 return(0);
3741}
3742
3743/*
3744 #] DoEndInside :
3745 #[ DoMessage :
3746*/
3747
3748int DoMessage(UBYTE *s)
3749{
3750 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3751 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3752 while ( *s == ' ' || *s == '\t' ) s++;
3753 MesPrint("~~~%s",s);
3754 return(0);
3755}
3756
3757/*
3758 #] DoMessage :
3759 #[ DoPipe :
3760*/
3761
3762int DoPipe(UBYTE *s)
3763{
3764#ifndef WITHPIPE
3765 DUMMYUSE(s);
3766#endif
3767 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3768 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3769#ifdef WITHPIPE
3770 FLUSHCONSOLE;
3771 while ( *s == ' ' || *s == '\t' ) s++;
3772 if ( OpenStream(s,PIPESTREAM,0,PRENOACTION) == 0 ) return(-1);
3773 return(0);
3774#else
3775 Error0("Pipes not implemented on this computer/system");
3776 return(-1);
3777#endif
3778}
3779
3780/*
3781 #] DoPipe :
3782 #[ DoPrcExtension :
3783*/
3784
3785int DoPrcExtension(UBYTE *s)
3786{
3787 UBYTE *t, *u, c;
3788 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3789 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3790 while ( *s == ' ' || *s == '\t' ) s++;
3791 if ( *s == 0 || *s == '\n' ) {
3792 MesPrint("@No valid procedure extension specified");
3793 return(-1);
3794 }
3795 if ( FG.cTable[*s] != 0 ) {
3796 MesPrint("@Procedure extension should be a string starting with an alphabetic character. No whitespace.");
3797 return(-1);
3798 }
3799 t = s;
3800 while ( *s && *s != '\n' && *s != ' ' && *s != '\t' ) s++;
3801 u = s;
3802 while ( *s == ' ' || *s == '\t' ) s++;
3803 if ( *s != 0 && *s != '\n' ) {
3804 MesPrint("@Too many parameters in ProcedureExtension instruction");
3805 return(-1);
3806 }
3807 c = *u; *u = 0;
3808 if ( AP.procedureExtension ) M_free(AP.procedureExtension,"ProcedureExtension");
3809 AP.procedureExtension = strDup1(t,"ProcedureExtension");
3810 *u = c;
3811 return(0);
3812}
3813
3814/*
3815 #] DoPrcExtension :
3816 #[ DoPreOut :
3817*/
3818
3819int DoPreOut(UBYTE *s)
3820{
3821 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3822 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3823 if ( tolower(*s) == 'o' ) {
3824 if ( tolower(s[1]) == 'n' && s[2] == 0 ) {
3825 AP.PreOut = 1;
3826 return(0);
3827 }
3828 if ( tolower(s[1]) == 'f' && tolower(s[2]) == 'f' && s[3] == 0 ) {
3829 AP.PreOut = 0;
3830 return(0);
3831 }
3832 }
3833 MesPrint("@Illegal option in PreOut instruction");
3834 return(-1);
3835}
3836
3837/*
3838 #] DoPreOut :
3839 #[ DoPrePrintTimes :
3840*/
3841
3842int DoPrePrintTimes(UBYTE *s)
3843{
3844 DUMMYUSE(s);
3845 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3846 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3847 PrintRunningTime();
3848 return(0);
3849}
3850
3851/*
3852 #] DoPrePrintTimes :
3853 #[ DoPreSortReallocate :
3854*/
3855
3856int DoPreSortReallocate(UBYTE *s)
3857{
3858 DUMMYUSE(s);
3859 if ( AC.SortReallocateFlag == 0 ) {
3860 /* Currently off, so set to 2. Then the reallocation code knows the flag was
3861 set here, since "On sortreallocate;" sets it to 1. */
3862 AC.SortReallocateFlag = 2;
3863 }
3864 /* If the flag is already on, do nothing. */
3865 return(0);
3866}
3867
3868/*
3869 #] DoPreSortReallocate :
3870 #[ DoPreAppend :
3871
3872 Syntax:
3873 #append <filename>
3874*/
3875
3876int DoPreAppend(UBYTE *s)
3877{
3878 UBYTE *name, *to;
3879
3880 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3881 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3882 if ( AP.preError ) return(0);
3883 while ( *s == ' ' || *s == '\t' ) s++;
3884/*
3885 Determine where to write
3886*/
3887 if ( *s == '<' ) {
3888 s++;
3889 name = to = s;
3890 while ( *s && *s != '>' ) {
3891 if ( *s == '\\' ) s++;
3892 *to++ = *s++;
3893 }
3894 if ( *s == 0 ) {
3895 MesPrint("@Improper termination of filename");
3896 return(-1);
3897 }
3898 s++;
3899 *to = 0;
3900 if ( *name ) { GetAppendChannel((char *)name); }
3901 else goto improper;
3902 }
3903 else {
3904improper:
3905 MesPrint("@Proper syntax is: %#append <filename>");
3906 return(-1);
3907 }
3908 return(0);
3909}
3910
3911/*
3912 #] DoPreAppend :
3913 #[ DoPreCreate :
3914
3915 Syntax:
3916 #create <filename>
3917*/
3918
3919int DoPreCreate(UBYTE *s)
3920{
3921 UBYTE *name, *to;
3922
3923 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3924 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3925 if ( AP.preError ) return(0);
3926 while ( *s == ' ' || *s == '\t' ) s++;
3927/*
3928 Determine where to write
3929*/
3930 if ( *s == '<' ) {
3931 s++;
3932 name = to = s;
3933 while ( *s && *s != '>' ) {
3934 if ( *s == '\\' ) s++;
3935 *to++ = *s++;
3936 }
3937 if ( *s == 0 ) {
3938 MesPrint("@Improper termination of filename");
3939 return(-1);
3940 }
3941 s++;
3942 *to = 0;
3943 if ( *name ) { GetChannel((char *)name,0); }
3944 else goto improper;
3945 }
3946 else {
3947improper:
3948 MesPrint("@Proper syntax is: %#create <filename>");
3949 return(-1);
3950 }
3951 return(0);
3952}
3953
3954/*
3955 #] DoPreCreate :
3956 #[ DoPreRemove :
3957*/
3958
3959int DoPreRemove(UBYTE *s)
3960{
3961 UBYTE *name, *to;
3962 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3963 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3964 if ( AP.preError ) return(0);
3965 while ( *s == ' ' || *s == '\t' ) s++;
3966 if ( *s == '<' ) { s++; }
3967 else {
3968 MesPrint("@Proper syntax is: %#remove <filename>");
3969 return(-1);
3970 }
3971 name = to = s;
3972 while ( *s && *s != '>' ) {
3973 if ( *s == '\\' ) s++;
3974 *to++ = *s++;
3975 }
3976 if ( *s == 0 ) {
3977 MesPrint("@Improper filename");
3978 return(-1);
3979 }
3980 s++;
3981 *to = 0;
3982 CloseChannel((char *)name);
3983 remove((char *)name);
3984 return(0);
3985}
3986
3987/*
3988 #] DoPreRemove :
3989 #[ DoPreClose :
3990*/
3991
3992int DoPreClose(UBYTE *s)
3993{
3994 UBYTE *name, *to;
3995 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
3996 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
3997 if ( AP.preError ) return(0);
3998 while ( *s == ' ' || *s == '\t' ) s++;
3999 if ( *s == '<' ) { s++; }
4000 else {
4001 MesPrint("@Proper syntax is: %#close <filename>");
4002 return(-1);
4003 }
4004 name = to = s;
4005 while ( *s && *s != '>' ) {
4006 if ( *s == '\\' ) s++;
4007 *to++ = *s++;
4008 }
4009 if ( *s == 0 ) {
4010 MesPrint("@Improper filename");
4011 return(-1);
4012 }
4013 s++;
4014 *to = 0;
4015 return(CloseChannel((char *)name));
4016}
4017
4018/*
4019 #] DoPreClose :
4020 #[ DoPreWrite :
4021
4022 Syntax:
4023 #write [<filename>] "formatstring" [,objects]
4024 The format string can contain the following special objects/codes
4025 \n newline
4026 \t tab
4027 \! if last entry in string: no linefeed at end
4028 \b put \ in output
4029 %$ $-variable (to be found among the objects)
4030 %e expression (name to be found among the objects)
4031 %E expression without ; (name to be found among the objects)
4032 %s string (to be found among the objects) (with or without "")
4033 %S subterms (see PrintSubtermList)
4034*/
4035
4036int DoPreWrite(UBYTE *s)
4037{
4038 HANDLERS h;
4039
4040 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
4041 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4042 if ( AP.preError ) return(0);
4043
4044#ifdef WITHMPI
4045 if ( PF.me != MASTER ) return 0;
4046#endif
4047
4048 h.oldsilent = AM.silent;
4049 h.newlogonly = h.oldlogonly = AM.FileOnlyFlag;
4050 h.newhandle = h.oldhandle = AC.LogHandle;
4051 h.oldprinttype = AO.PrintType;
4052
4053 while ( *s == ' ' || *s == '\t' ) s++;
4054/*
4055 Determine where to write
4056*/
4057 if( (s=defineChannel(s,&h))==0 ) return(-1);
4058
4059 return(writeToChannel(WRITEOUT,s,&h));
4060}
4061
4062/*
4063 #] DoPreWrite :
4064 #[ DoProcedure :
4065
4066 We have to read this procedure into a buffer.
4067 The only complications are:
4068 1: we have to seek through the file to do this efficiently
4069 the file operations under VMS cannot do this properly
4070 (unless we use the proper ANSI structs?)
4071 This is the reason why we read whole input files under VMS.
4072 2: what to do when the same name is used twice.
4073 Note that we have to do the reading without substitution of
4074 preprocessor variables.
4075*/
4076
4077int DoProcedure(UBYTE *s)
4078{
4079 UBYTE c;
4080 PROCEDURE *p;
4081 LONG i;
4082 if ( ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH )
4083 || ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) ) {
4084 if ( PreSkip((UBYTE *)"procedure",(UBYTE *)"endprocedure",1) ) return(-1);
4085 return(0);
4086 }
4087 // AP.ProcList.num = NumProcedures is incremented inside FromList
4088 p = (PROCEDURE *)FromList(&AP.ProcList);
4089 if ( PreLoad(&(p->p),(UBYTE *)"procedure",(UBYTE *)"endprocedure"
4090 ,1,(char *)"procedure") ) return(-1);
4091
4092 // If the procedure below is not local (loadmode 0) or has been called (loadmode 1), this is a
4093 // nested procedure definition. We must free its allocations when we hit its DoEndprocedure.
4094 // If it seems local (loadmode 2) but is tagged as "mustfree", it is multiply nested and we
4095 // similarly must free its allocations.
4096 if ( NumProcedures >= 2 &&
4097 ( Procedures[NumProcedures-2].loadmode != 2 || Procedures[NumProcedures-2].mustfree ) ) {
4098 p->mustfree = 1;
4099 }
4100 // Otherwise, we are defining a local procedure at "ground level", and we keep the definition
4101 // on the procedure stack until FORM terminates.
4102 else {
4103 p->mustfree = 0;
4104 }
4105
4106 p->loadmode = 2;
4107 s = p->p.buffer + 10;
4108 while ( *s == ' ' || *s == LINEFEED ) s++;
4109 if ( chartype[*s] ) {
4110 MesPrint("@Illegal name for procedure");
4111 return(-1);
4112 }
4113 p->name = s++;
4114 while ( chartype[*s] == 0 || chartype[*s] == 1 ) s++;
4115 c = *s; *s = 0;
4116 p->name = strDup1(p->name,"procedure");
4117 *s = c;
4118/*
4119 Check for double names
4120*/
4121 for ( i = NumProcedures-2; i >= 0; i-- ) {
4122 if ( StrCmp(Procedures[i].name,p->name) == 0 ) {
4123 Error1("Multiple occurrence of procedure name ",p->name);
4124 }
4125 }
4126 return(0);
4127}
4128
4129/*
4130 #] DoProcedure :
4131 #[ DoPreBreak :
4132*/
4133
4134int DoPreBreak(UBYTE *s)
4135{
4136 DUMMYUSE(s);
4137 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4138 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPESWITCH ) {
4139 if ( AP.PreSwitchLevel <= 0 )
4140 MesPrint("@Break without corresponding Switch");
4141 else MessPreNesting(7);
4142 return(-1);
4143 }
4144 if ( AP.PreSwitchLevel <= 0 ) {
4145 MesPrint("@Break without corresponding Switch");
4146 return(-1);
4147 }
4148 if ( AP.PreSwitchModes[AP.PreSwitchLevel] == EXECUTINGPRESWITCH )
4149 AP.PreSwitchModes[AP.PreSwitchLevel] = SEARCHINGPREENDSWITCH;
4150 return(0);
4151}
4152
4153/*
4154 #] DoPreBreak :
4155 #[ DoPreCase :
4156*/
4157
4158int DoPreCase(UBYTE *s)
4159{
4160 UBYTE *t;
4161 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4162 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPESWITCH ) {
4163 if ( AP.PreSwitchLevel <= 0 )
4164 MesPrint("@Case without corresponding Switch");
4165 else MessPreNesting(8);
4166 return(-1);
4167 }
4168 if ( AP.PreSwitchLevel <= 0 ) {
4169 MesPrint("@Case without corresponding Switch");
4170 return(-1);
4171 }
4172 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != SEARCHINGPRECASE ) return(0);
4173
4174 SKIPBLANKS(s)
4175 t = s;
4176 while ( *s ) { if ( *s == '\\' ) s++; s++; }
4177 while ( s > t && ( s[-1] == ' ' || s[-1] == '\t' ) && s[-2] != '\\' ) {
4178 if ( s[-2] == '\\' ) s--;
4179 s--;
4180 }
4181 if ( *t == '"' && s > t+1 && s[-1] == '"' && s[-2] != '\\' ) {
4182 t++; s--; *s = 0;
4183 }
4184 else *s = 0;
4185 s = AP.PreSwitchStrings[AP.PreSwitchLevel];
4186 while ( *t == *s && *t ) { s++; t++; }
4187 if ( *t || *s ) return(0); /* case did not match */
4188 AP.PreSwitchModes[AP.PreSwitchLevel] = EXECUTINGPRESWITCH;
4189 return(0);
4190}
4191
4192/*
4193 #] DoPreCase :
4194 #[ DoPreDefault :
4195*/
4196
4197int DoPreDefault(UBYTE *s)
4198{
4199 DUMMYUSE(s);
4200 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4201 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPESWITCH ) {
4202 if ( AP.PreSwitchLevel <= 0 )
4203 MesPrint("@Default without corresponding Switch");
4204 else MessPreNesting(9);
4205 return(-1);
4206 }
4207 if ( AP.PreSwitchLevel <= 0 ) {
4208 MesPrint("@Default without corresponding Switch");
4209 return(-1);
4210 }
4211 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != SEARCHINGPRECASE ) return(0);
4212 AP.PreSwitchModes[AP.PreSwitchLevel] = EXECUTINGPRESWITCH;
4213 return(0);
4214}
4215
4216/*
4217 #] DoPreDefault :
4218 #[ DoPreEndSwitch :
4219*/
4220
4221int DoPreEndSwitch(UBYTE *s)
4222{
4223 DUMMYUSE(s);
4224 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4225 if ( AP.PreTypes[AP.NumPreTypes] != PRETYPESWITCH ) {
4226 if ( AP.PreSwitchLevel <= 0 )
4227 MesPrint("@EndSwitch without corresponding Switch");
4228 else MessPreNesting(10);
4229 return(-1);
4230 }
4231 AP.NumPreTypes--;
4232 if ( AP.PreSwitchLevel <= 0 ) {
4233 MesPrint("@EndSwitch without corresponding Switch");
4234 return(-1);
4235 }
4236 M_free(AP.PreSwitchStrings[AP.PreSwitchLevel--],"pre switch string");
4237 return(0);
4238}
4239
4240/*
4241 #] DoPreEndSwitch :
4242 #[ DoPreSwitch :
4243
4244 There should be a string after this.
4245 We have to store it somewhere.
4246*/
4247
4248int DoPreSwitch(UBYTE *s)
4249{
4250 UBYTE *t, *switchstring, **newstrings;
4251 int newnum, i, *newmodes;
4252 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4253 SKIPBLANKS(s)
4254 t = s;
4255 while ( *s ) { if ( *s == '\\' ) s++; s++; }
4256 while ( s > t && ( s[-1] == ' ' || s[-1] == '\t' ) && s[-2] != '\\' ) {
4257 if ( s[-2] == '\\' ) s--;
4258 s--;
4259 }
4260 if ( *t == '"' && s > t+1 && s[-1] == '"' && s[-2] != '\\' ) {
4261 t++; s--; *s = 0;
4262 }
4263 else *s = 0;
4264 switchstring = (UBYTE *)Malloc1((s-t)+1,"case string");
4265 s = switchstring;
4266 while ( *t ) {
4267 if ( *t == '\\' ) t++;
4268 *s++ = *t++;
4269 }
4270 *s = 0;
4271 if ( AP.PreSwitchLevel >= AP.NumPreSwitchStrings ) {
4272 newnum = 2*AP.NumPreSwitchStrings;
4273 newstrings = (UBYTE **)Malloc1(sizeof(UBYTE *)*(newnum+1),"case strings");
4274 newmodes = (int *)Malloc1(sizeof(int)*(newnum+1),"case strings");
4275 for ( i = 0; i < AP.NumPreSwitchStrings; i++ )
4276 newstrings[i] = AP.PreSwitchStrings[i];
4277 M_free(AP.PreSwitchStrings,"AP.PreSwitchStrings");
4278 for ( i = 0; i <= AP.NumPreSwitchStrings; i++ )
4279 newmodes[i] = AP.PreSwitchModes[i];
4280 M_free(AP.PreSwitchModes,"AP.PreSwitchModes");
4281 AP.PreSwitchStrings = newstrings;
4282 AP.PreSwitchModes = newmodes;
4283 AP.NumPreSwitchStrings = newnum;
4284 }
4285 AP.PreSwitchStrings[++AP.PreSwitchLevel] = switchstring;
4286 if ( ( AP.PreSwitchLevel > 1 )
4287 && ( AP.PreSwitchModes[AP.PreSwitchLevel-1] != EXECUTINGPRESWITCH ) )
4288 AP.PreSwitchModes[AP.PreSwitchLevel] = SEARCHINGPREENDSWITCH;
4289 else
4290 AP.PreSwitchModes[AP.PreSwitchLevel] = SEARCHINGPRECASE;
4291 AddToPreTypes(PRETYPESWITCH);
4292 return(0);
4293}
4294
4295/*
4296 #] DoPreSwitch :
4297 #[ DoPreShow :
4298
4299 Print the contents of the preprocessor variables
4300*/
4301
4302int DoPreShow(UBYTE *s)
4303{
4304 int i;
4305 UBYTE *name, c;
4306 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
4307 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4308 while ( *s == ' ' || *s == '\t' ) s++;
4309 if ( *s == 0 ) {
4310 MesPrint("%#The preprocessor variables:");
4311 for ( i = 0; i < NumPre; i++ ) {
4312 MesPrint("%d: %s = \"%s\"",i,PreVar[i].name,PreVar[i].value);
4313 }
4314 }
4315 else {
4316 while ( *s ) {
4317 name = s; while ( *s && *s != ' ' && *s != '\t' && *s != ',' ) s++;
4318 c = *s; *s = 0;
4319 for ( i = 0; i < NumPre; i++ ) {
4320 if ( StrCmp(PreVar[i].name,name) == 0 )
4321 MesPrint("%d: %s = \"%s\"",i,PreVar[i].name,PreVar[i].value);
4322 }
4323 *s = c;
4324 while ( *s == ' ' || *s == '\t' ) s++;
4325 }
4326 }
4327 return(0);
4328}
4329
4330/*
4331 #] DoPreShow :
4332 #[ DoSystem :
4333*/
4334
4335/*
4336 * A macro for translating the contents of `x' into a string after expanding.
4337 */
4338#define STRINGIFY(x) STRINGIFY__(x)
4339#define STRINGIFY__(x) #x
4340
4341int DoSystem(UBYTE *s)
4342{
4343 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
4344 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
4345 if ( AP.preError ) return(0);
4346#ifdef WITHSYSTEM
4347 FLUSHCONSOLE;
4348 while ( *s == ' ' || *s == '\t' ) s++;
4349 if ( *s == '-' && s[1] == 'e' ) {
4350 LONG err;
4351 UBYTE str[24];
4352 s += 2;
4353 if ( *s != ' ' ) {
4354 MesPrint("@Syntax error in #system command.");
4355 return(-1);
4356 }
4357 while ( *s == ' ' || *s == '\t' ) s++;
4358 err = system((char *)s);
4359 NumToStr(str,err);
4360 PutPreVar((UBYTE *)"SYSTEMERROR_",str,0,1);
4361 }
4362 else if ( system((char *)s) ) {
4363 MesPrint("@System call returned with error condition");
4364 Terminate(-1);
4365 }
4366 return(0);
4367#else
4368 Error0("External programs not implemented on this computer/system");
4369 return(-1);
4370#endif
4371}
4372
4373/*
4374 #] DoSystem :
4375 #[ PreLoad :
4376
4377 Loads a loop or procedure into a special buffer.
4378 Note: The current instruction is already in the preStart buffer
4379*/
4380
4381int PreLoad(PRELOAD *p, UBYTE *start, UBYTE *stop, int mode, char *message)
4382{
4383 UBYTE *s, *t, *top, *newbuffer, c;
4384 LONG i, ppsize, linenum = AC.CurrentStream->linenumber;
4385 int size1, size2, level, com=0, last=1, strng = 0;
4386 p->size = AP.pSize;
4387 p->buffer = (UBYTE *)Malloc1(p->size+1,message);
4388 top = p->buffer + p->size - 2;
4389 t = p->buffer; *t++ = '#';
4390 s = start; size1 = size2 = 0;
4391 while ( *s ) { s++; size1++; }
4392 s = stop; while ( *s ) { s++; size2++; }
4393 s = AP.preStart; while ( *s ) *t++ = *s++; *t++ = LINEFEED;
4394 level = 1;
4395 i = 100;
4396 for (;;) {
4397 c = GetInput();
4398 if ( c == ENDOFINPUT ) {
4399 MesPrint("@Missing %#%s, Should match line %l",stop,linenum);
4400 return(-1);
4401 }
4402 if ( c == AP.ComChar && last == 1 ) com = 1;
4403 if ( c == LINEFEED ) { last = 1; com = 0; }
4404 else last = 0;
4405
4406 if ( ( c == '"' ) && ( com == 0 ) ) { strng ^= 1; }
4407
4408 if ( ( c == '#' ) && ( com == 0 ) ) i = 0;
4409 else i++;
4410
4411 if ( t >= top ) {
4412 ppsize = t - p->buffer;
4413 p->size *= 2;
4414 newbuffer = (UBYTE *)Malloc1(p->size,message);
4415 t = newbuffer; s = p->buffer;
4416 while ( --ppsize >= 0 ) *t++ = *s++;
4417 M_free(p->buffer,"loading do loop");
4418 p->buffer = newbuffer;
4419 top = p->buffer + p->size - 2;
4420 }
4421 *t++ = c;
4422 if ( strng == 0 ) {
4423 if ( ( i == size2 ) && ( com == 0 ) ) {
4424 *t = 0;
4425 if ( StrICmp(t-size2,(UBYTE *)(stop)) == 0 ) {
4426 while ( ( c = GetInput() ) != LINEFEED && c != ENDOFINPUT ) {}
4427 level--;
4428 if ( level <= 0 ) break;
4429 if ( c == ENDOFINPUT ) Error1("Missing #",stop);
4430 *t++ = LINEFEED; *t = 0; last = 1;
4431 }
4432 }
4433 if ( ( i == size1 ) && mode && ( com == 0 ) ) {
4434 *t = 0;
4435 if ( StrICmp(t-size1,(UBYTE *)(start)) == 0 ) {
4436/*
4437 while ( ( c = GetInput() ) != LINEFEED && c != ENDOFINPUT ) {}
4438 if ( c == ENDOFINPUT ) Error1("Missing #",stop);
4439*/
4440 level++;
4441 }
4442 }
4443 if ( i == 1 && t[-2] == LINEFEED ) {
4444 if ( c == '-' ) AC.NoShowInput = 1;
4445 else if ( c == '+' ) AC.NoShowInput = 0;
4446 }
4447 }
4448 }
4449 *t++ = LINEFEED;
4450 *t = 0;
4451 return(0);
4452}
4453
4454/*
4455 #] PreLoad :
4456 #[ PreSkip :
4457
4458 Skips a loop or procedure.
4459 Note: The current instruction is already in the preStart buffer
4460*/
4461
4462#define SKIPBUFSIZE 20
4463
4464int PreSkip(UBYTE *start, UBYTE *stop, int mode)
4465{
4466 UBYTE *s, *t, buffer[SKIPBUFSIZE+2], c;
4467 LONG i, linenum = AC.CurrentStream->linenumber;
4468 int size1, size2, level, com=0, last=1;
4469
4470 t = buffer; *t++ = '#';
4471 s = start; size1 = size2 = 0;
4472 while ( *s ) { s++; size1++; }
4473 s = stop; while ( *s ) { s++; size2++; }
4474 level = 1;
4475 i = 0;
4476 for (;;) {
4477 c = GetInput();
4478 if ( c == ENDOFINPUT ) {
4479 MesPrint("@Missing %#%s, Should match line %l",stop,linenum);
4480 return(-1);
4481 }
4482 if ( c == AP.ComChar && last == 1 ) com = 1;
4483 if ( c == LINEFEED ) { last = 1; com = 0; i = 0; t = buffer; }
4484 else last = 0;
4485 if ( ( c == '#' ) && ( com == 0 ) ) { i = 0; t = buffer; }
4486 else i++;
4487
4488 if ( i < SKIPBUFSIZE ) *t++ = c;
4489 if ( ( i == size2 ) && ( com == 0 ) ) {
4490 *t = 0;
4491 if ( StrICmp(t-size2,(UBYTE *)(stop)) == 0 ) {
4492 while ( ( c = GetInput() ) != LINEFEED && c != ENDOFINPUT ) {}
4493 level--;
4494 if ( level <= 0 ) {
4495 pushbackchar = LINEFEED;
4496 break;
4497 }
4498 if ( c == ENDOFINPUT ) Error1("Missing #",stop);
4499 i = 0; t = buffer;
4500 }
4501 }
4502 if ( ( i == size1 ) && mode && ( com == 0 ) ) {
4503 *t = 0;
4504 if ( StrICmp(t-size1,(UBYTE *)(start)) == 0 ) {
4505 while ( ( c = GetInput() ) != LINEFEED && c != ENDOFINPUT ) {}
4506 level++;
4507 i = 0; t = buffer;
4508 }
4509 }
4510 }
4511 return(0);
4512}
4513
4514/*
4515 #] PreSkip :
4516 #[ StartPrepro :
4517*/
4518
4519void StartPrepro(void)
4520{
4521 int **ppp;
4522 AP.MaxPreIfLevel = 2;
4523 ppp = &AP.PreIfStack;
4524 if ( DoubleList((void ***)ppp,&AP.MaxPreIfLevel,sizeof(int),
4525 "PreIfLevels") ) Terminate(-1);
4526 AP.PreIfLevel = 0; AP.PreIfStack[0] = EXECUTINGIF;
4527
4528 AP.NumPreSwitchStrings = 10;
4529 AP.PreSwitchStrings = (UBYTE **)Malloc1(sizeof(UBYTE *)*
4530 (AP.NumPreSwitchStrings+1),"case strings");
4531 AP.PreSwitchModes = (int *)Malloc1(sizeof(int)*
4532 (AP.NumPreSwitchStrings+1),"case strings");
4533 AP.PreSwitchModes[0] = EXECUTINGPRESWITCH;
4534 AP.PreSwitchLevel = 0;
4535}
4536
4537/*
4538 #] StartPrepro :
4539 #[ EvalPreIf :
4540
4541 Evaluates the condition in an if instruction.
4542 The return value is EXECUTINGIF if the condition is true.
4543 If it is false the returnvalue is LOOKINGFORELSE.
4544 An error gives a return value of -1
4545*/
4546
4547int EvalPreIf(UBYTE *s)
4548{
4549 UBYTE *t, *u;
4550 int val;
4551 t = s;
4552 while ( *t ) t++;
4553 *t++ = ')';
4554 *t = 0;
4555 if ( ( u = PreIfEval(s,&val) ) == 0 ) return(-1);
4556 if ( u < t ) {
4557 MesPrint("@Unmatched parentheses in condition");
4558 return(-1);
4559 }
4560 if ( val ) return(EXECUTINGIF);
4561 else return(LOOKINGFORELSE);
4562}
4563
4564/*
4565 #] EvalPreIf :
4566 #[ PreIfEval :
4567
4568 Used for recursions in the evaluation of a preprocessor if-condition.
4569 It determines whether the contents of () is true or false
4570 (or in error).
4571 The return value is the address of the first character after the
4572 closing parenthesis or null if there is an error.
4573 In value we find true(1) or false(0)
4574 We enter after the opening parenthesis.
4575 There are levels:
4576 0: orlevel: a || b
4577 1: andlevel: a && b
4578 2: eqlevel: a == b or a != b or a = b
4579 3: cmplevel: a > b or a >= b or a < b or a <= b or a >~ b etc
4580*/
4581
4582UBYTE *PreIfEval(UBYTE *s, int *value)
4583{
4584 int orlevel = 0, andlevel = 0, eqlevel = 0, cmplevel = 0;
4585 int type, val;
4586 LONG val2;
4587 int ortype, orval, cmptype, cmpval, eqtype, eqval, andtype, andval;
4588 UBYTE *t, *eqt, *cmpt, c;
4589 int eqop, cmpop;
4590 ortype = orval = cmptype = cmpval = eqtype = eqval = andtype = andval = 0;
4591 eqop = cmpop = 0;
4592 eqt = cmpt = 0;
4593 *value = 0;
4594 while ( *s != ')' ) {
4595 while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
4596 t = s;
4597 s = pParseObject(s,&type,&val2);
4598 if ( s == 0 ) return(0);
4599 val = val2;
4600 c = *s;
4601 *s++ = 0; /* in case the object is a string without " */
4602 while ( c == ' ' || c == '\t' || c == '\n' || c == '\r' ) {
4603 c = *s; *s++ = 0;
4604 }
4605 if ( *t == '"' ) t++;
4606 switch(c) {
4607 case '|':
4608 if ( *s != '|' ) goto illoper;
4609 s++;
4610 /* fall through */
4611 case ')':
4612 if ( cmplevel ) {
4613 if ( type == 0 || cmptype == 0 ) goto illobject;
4614 val = PreCmp(type,val,t,cmptype,cmpval,cmpt,cmpop);
4615 type = 0;
4616 cmplevel = 0;
4617 }
4618 if ( eqlevel ) {
4619 val = PreEq(type,val,t,eqtype,eqval,eqt,eqop);
4620 type = 0;
4621 eqlevel = 0;
4622 }
4623 if ( andlevel ) {
4624 if ( andtype != 0 || type != 0 ) goto illobject;
4625 val &= andval;
4626 andlevel = 0;
4627 }
4628 if ( orlevel ) {
4629 if ( ortype != 0 || type != 0 ) goto illobject;
4630 val |= orval;
4631 }
4632 if ( c == ')' ) {
4633 *value = val;
4634 return(s);
4635 }
4636 orlevel = 1;
4637 orval = val;
4638 ortype = type;
4639 break;
4640 case '&':
4641 if ( *s != '&' ) goto illoper;
4642 s++;
4643 if ( cmplevel ) {
4644 if ( type == 0 || cmptype == 0 ) goto illobject;
4645 val = PreCmp(type,val,t,cmptype,cmpval,cmpt,cmpop);
4646 type = 0;
4647 cmplevel = 0;
4648 }
4649 if ( eqlevel ) {
4650 val = PreEq(type,val,t,eqtype,eqval,eqt,eqop);
4651 type = 0;
4652 eqlevel = 0;
4653 }
4654 if ( andlevel ) {
4655 if ( andtype != 0 || type != 0 ) goto illobject;
4656 val &= andval;
4657 }
4658 andlevel = 1;
4659 andval = val;
4660 andtype = type;
4661 break;
4662 case '!':
4663 case '=':
4664 if ( eqlevel ) goto illorder;
4665 if ( cmplevel ) {
4666 if ( type == 0 || cmptype == 0 ) goto illobject;
4667 val = PreCmp(type,val,t,cmptype,cmpval,cmpt,cmpop);
4668 type = 0;
4669 cmplevel = 0;
4670 }
4671 if ( c == '!' && *s != '=' ) goto illoper;
4672 if ( *s == '=' ) s++;
4673 if ( c == '!' ) eqop = 1;
4674 else eqop = 0;
4675 eqlevel = 1; eqt = t; eqval = val; eqtype = type;
4676 break;
4677 case '>':
4678 case '<':
4679 if ( cmplevel ) goto illorder;
4680 if ( c == '<' ) cmpop = -1;
4681 else cmpop = 1;
4682 cmplevel = 1; cmpt = t; cmpval = val; cmptype = type;
4683 if ( *s == '=' ) {
4684 s++;
4685 if ( *s == '~' ) { s++; cmpop *= 4; }
4686 else cmpop *= 2;
4687 }
4688 else if ( *s == '~' ) { s++; cmpop *= 3; }
4689 break;
4690 default:
4691 goto illoper;
4692 }
4693 }
4694 return(s);
4695illorder:
4696 MesPrint("@illegal order of operators");
4697 return(0);
4698illobject:
4699 MesPrint("@illegal object for this operator");
4700 return(0);
4701illoper:
4702 MesPrint("@illegal operator");
4703 return(0);
4704}
4705
4706/*
4707 #] PreIfEval :
4708 #[ PreCmp :
4709*/
4710
4711int PreCmp(int type, int val, UBYTE *t, int type2, int val2, UBYTE *t2, int cmpop)
4712{
4713 if ( type == 2 || type2 == 2 || cmpop < -2 || cmpop > 2 ) {
4714 if ( cmpop < 0 && cmpop > -3 ) cmpop -= 2;
4715 if ( cmpop > 0 && cmpop < 3 ) cmpop += 2;
4716 if ( cmpop == 3 ) val = StrCmp(t2,t) > 0;
4717 else if ( cmpop == 4 ) val = StrCmp(t2,t) >= 0;
4718 else if ( cmpop == -3 ) val = StrCmp(t2,t) < 0;
4719 else if ( cmpop == -4 ) val = StrCmp(t2,t) <= 0;
4720 }
4721 else {
4722 if ( cmpop == 1 ) val = ( val2 > val );
4723 else if ( cmpop == 2 ) val = ( val2 >= val );
4724 else if ( cmpop == -1 ) val = ( val2 < val );
4725 else if ( cmpop == -2 ) val = ( val2 <= val );
4726 }
4727 return(val);
4728}
4729
4730/*
4731 #] PreCmp :
4732 #[ PreEq :
4733*/
4734
4735int PreEq(int type, int val, UBYTE *t, int type2, int val2, UBYTE *t2, int eqop)
4736{
4737 UBYTE str[20];
4738 if ( type == 2 || type2 == 2 ) {
4739 if ( type != 2 ) { NumToStr(str,val ); t = str; }
4740 if ( type2 != 2 ) { NumToStr(str,val2); t2 = str; }
4741 if ( eqop == 1 ) val = StrCmp(t,t2) != 0;
4742 else val = StrCmp(t,t2) == 0;
4743 }
4744 else {
4745 if ( eqop ) val = val != val2;
4746 else val = val == val2;
4747 }
4748 return(val);
4749}
4750
4751/*
4752 #] PreEq :
4753 #[ pParseObject :
4754
4755 Parses a preprocessor object. We can have:
4756 1: a number (type = 1)
4757 2: a string (type = 2)
4758 3: an expression between parentheses (type = 0)
4759 4: a special function (type = 3)
4760 If the object is not a number, an expression or a special operator
4761 we try to interpret it as a string.
4762*/
4763
4764UBYTE *pParseObject(UBYTE *s, int *type, LONG *val2)
4765{
4766 UBYTE *t, c;
4767 int sign, val = 0;
4768 LONG x;
4769 while ( *s == ' ' || *s == '\t' ) s++;
4770 if ( *s == '(' ) {
4771 s++;
4772 while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
4773 s = PreIfEval(s,&val);
4774 *type = 0;
4775 *val2 = val;
4776 return(s);
4777 }
4778 else if ( *s == '$' && s[1] == '(' ) {
4779 s += 2;
4780 while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
4781 s = PreIfDollarEval(s,&val);
4782 *type = 0; *val2 = val;
4783 return(s);
4784 }
4785 if ( *s == 0 ) {
4786illend:
4787 MesPrint("@illegal end of condition");
4788 return(0);
4789 }
4790 if ( *s == '"' ) {
4791 s++;
4792 while ( *s && *s != '"' ) {
4793 if ( *s == '\\' ) s++;
4794 s++;
4795 }
4796 if ( *s == 0 ) goto illend;
4797 else *s = 0;
4798 *type = 2;
4799 s++;
4800
4801 while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
4802
4803 return(s);
4804 }
4805 t = s; sign = 1; x = 0;
4806 if ( chartype[*t] == 0 ) { /* Special operators and strings without "" */
4807 do { t++; } while ( chartype[*t] <= 1 );
4808 if ( *t == '(' ) {
4809 WORD ttype;
4810 c = *t; *t = 0;
4811 if ( StrICmp(s,(UBYTE *)"termsin") == 0 ) {
4812 UBYTE *tt;
4813 WORD numdol, numexp;
4814 ttype = 0;
4815together:
4816 *t++ = c;
4817 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
4818 if ( *t == '$' ) {
4819 t++; tt = t; while (chartype[*tt] <= 1 ) tt++;
4820 c = *tt; *tt = 0;
4821 if ( ( numdol = GetDollar(t) ) > 0 ) {
4822 *tt = c;
4823 if ( ttype == 1 ) {
4824 x = SizeOfDollar(numdol);
4825 }
4826 else {
4827 x = TermsInDollar(numdol);
4828 }
4829 }
4830 else {
4831 MesPrint("@$%s has not (yet) been defined",t);
4832 *tt = c;
4833 Terminate(-1);
4834 }
4835 }
4836 else {
4837 tt = SkipAName(t);
4838 c = *tt; *tt = 0;
4839 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) {
4840 MesPrint("@%s has not (yet) been defined",t);
4841 *tt = c;
4842 Terminate(-1);
4843 }
4844 else {
4845 *tt = c;
4846 if ( ttype == 1 ) {
4847 x = SizeOfExpression(numexp);
4848 }
4849 else {
4850 x = TermsInExpression(numexp);
4851 }
4852 }
4853 }
4854 while ( *tt == ' ' || *tt == '\t'
4855 || *tt == '\n' || *tt == '\r' ) tt++;
4856 if ( *tt != ')' ) {
4857 MesPrint("@Improper use of terms($var) or terms(expr)");
4858 Terminate(-1);
4859 }
4860 *type = 3;
4861 s = tt+1;
4862 *val2 = x;
4863 return(s);
4864 }
4865 else if ( StrICmp(s,(UBYTE *)"sizeof") == 0 ) {
4866 ttype = 1;
4867 goto together;
4868 }
4869 else if ( StrICmp(s,(UBYTE *)"exists") == 0 ) {
4870 UBYTE *tt;
4871 WORD numdol, numexp;
4872 *t++ = c;
4873 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
4874 if ( *t == '$' ) {
4875 t++; tt = t; while (chartype[*tt] <= 1 ) tt++;
4876 c = *tt; *tt = 0;
4877 if ( ( numdol = GetDollar(t) ) >= 0 ) { x = 1; }
4878 else { x = 0; }
4879 *tt = c;
4880 }
4881 else if ( *t == '"' ) { /* see whether a file exists */
4882/* UBYTE *name, *oldname; */
4883 t++; tt = t;
4884 for (;;) {
4885 if ( *tt == '\\' ) tt++;
4886 else if ( *tt == '"' ) break;
4887 tt++;
4888 }
4889 c = *tt; *tt = 0;
4890/*
4891 Try to open the file. If possible, return 1.
4892 Afterwards close it.
4893 We do have to run through the FORMPATH. Hence we use LocateFile.
4894 This routine may change the name to the full name.
4895
4896 oldname = name = strDup1(t,"name in exists");
4897 x = LocateFile(&name,-1);
4898*/
4899 x = OpenFile((char *)t);
4900 if ( x >= 0 ) {
4901 CloseFile(x);
4902 x = 1;
4903/*
4904 if ( name != oldname ) M_free(name,"name from LocateFile");
4905*/
4906 }
4907 else x = 0;
4908/*
4909 M_free(oldname,"name in exists");
4910*/
4911 *tt++ = c;
4912 }
4913 else {
4914 tt = SkipAName(t);
4915 c = *tt; *tt = 0;
4916 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) { x = 0; }
4917 else { x = 1; }
4918 *tt = c;
4919 }
4920 while ( *tt == ' ' || *tt == '\t'
4921 || *tt == '\n' || *tt == '\r' ) tt++;
4922 if ( *tt != ')' ) {
4923 MesPrint("@Improper use of exists($var) or exists(expr)");
4924 Terminate(-1);
4925 }
4926 *type = 3;
4927 s = tt+1;
4928 *val2 = x;
4929 return(s);
4930 }
4931 else if ( StrICmp(s,(UBYTE *)"isnumerical") == 0 ) {
4932 GETIDENTITY
4933 UBYTE *tt;
4934 WORD numdol, numexp;
4935 *t++ = c;
4936 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
4937 if ( *t == '$' ) {
4938 t++; tt = t; while (chartype[*tt] <= 1 ) tt++;
4939 c = *tt; *tt = 0;
4940 if ( ( numdol = GetDollar(t) ) < 0 ) {
4941 MesPrint("@$ variable in isnumerical(%s) does not exist",t);
4942 Terminate(-1);
4943 }
4944 x = DolToLong(BHEAD numdol);
4945 if ( AN.ErrorInDollar ) {
4946 DOLLARS d = Dollars + numdol;
4947 x = 0;
4948 if ( d->type == DOLNUMBER || d->type == DOLTERMS ) {
4949 if ( d->where[0] == 0 ) x = 1;
4950 else if ( d->where[d->where[0]] == 0 ) {
4951 if ( ABS(d->where[d->where[0]-1]) == d->where[0]-1 )
4952 x = 1;
4953 }
4954 }
4955 }
4956 else x = 1;
4957 *tt = c;
4958 }
4959 else {
4960 tt = SkipAName(t);
4961 c = *tt; *tt = 0;
4962 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) {
4963 MesPrint("@expression in isnumerical(%s) does not exist",t);
4964 Terminate(-1);
4965 }
4966 x = TermsInExpression(numexp);
4967 if ( x != 1 ) x = 0;
4968 else {
4969 WORD *term = AT.WorkPointer;
4970 if ( GetFirstTerm(term,numexp,1) < 0 ) {
4971 MesPrint("@error reading expression in isnumerical(%s)",t);
4972 Terminate(-1);
4973 }
4974 if ( *term == ABS(term[*term-1])+1 ) x = 1;
4975 else x = 0;
4976 }
4977 *tt = c;
4978 }
4979 while ( *tt == ' ' || *tt == '\t'
4980 || *tt == '\n' || *tt == '\r' ) tt++;
4981 if ( *tt != ')' ) {
4982 MesPrint("@Improper use of isnumerical($var) or numerical(expr)");
4983 Terminate(-1);
4984 }
4985 *type = 3;
4986 s = tt+1;
4987 *val2 = x;
4988 return(s);
4989 }
4990 else if ( StrICmp(s,(UBYTE *)("maxpowerof")) == 0 ) {
4991 UBYTE *tt;
4992 WORD numsym;
4993 int stype;
4994 *t++ = c;
4995 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
4996 tt = SkipAName(t);
4997 c = *tt; *tt = 0;
4998 if ( ( stype = GetName(AC.varnames,t,&numsym,NOAUTO) ) == NAMENOTFOUND ) {
4999 MesPrint("@%s has not (yet) been defined",t);
5000 *tt = c;
5001 Terminate(-1);
5002 }
5003 else if ( stype != CSYMBOL ) {
5004 MesPrint("@%s should be a symbol",t);
5005 *tt = c;
5006 Terminate(-1);
5007 }
5008 else {
5009 *tt = c;
5010 x = symbols[numsym].maxpower;
5011 }
5012 while ( *tt == ' ' || *tt == '\t'
5013 || *tt == '\n' || *tt == '\r' ) tt++;
5014 if ( *tt != ')' ) {
5015 MesPrint("@Improper use of maxpowerof(symbol)");
5016 Terminate(-1);
5017 }
5018 *type = 3;
5019 s = tt+1;
5020 *val2 = x;
5021 return(s);
5022 }
5023 else if ( StrICmp(s,(UBYTE *)("minpowerof")) == 0 ) {
5024 UBYTE *tt;
5025 WORD numsym;
5026 int stype;
5027 *t++ = c;
5028 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
5029 tt = SkipAName(t);
5030 c = *tt; *tt = 0;
5031 if ( ( stype = GetName(AC.varnames,t,&numsym,NOAUTO) ) == NAMENOTFOUND ) {
5032 MesPrint("@%s has not (yet) been defined",t);
5033 *tt = c;
5034 Terminate(-1);
5035 }
5036 else if ( stype != CSYMBOL ) {
5037 MesPrint("@%s should be a symbol",t);
5038 *tt = c;
5039 Terminate(-1);
5040 }
5041 else {
5042 *tt = c;
5043 x = symbols[numsym].minpower;
5044 }
5045 while ( *tt == ' ' || *tt == '\t'
5046 || *tt == '\n' || *tt == '\r' ) tt++;
5047 if ( *tt != ')' ) {
5048 MesPrint("@Improper use of minpowerof(symbol)");
5049 Terminate(-1);
5050 }
5051 *type = 3;
5052 s = tt+1;
5053 *val2 = x;
5054 return(s);
5055 }
5056 else if ( StrICmp(s,(UBYTE *)"isfactorized") == 0 ) {
5057 UBYTE *tt;
5058 WORD numdol, numexp;
5059 *t++ = c;
5060 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
5061 if ( *t == '$' ) {
5062 t++; tt = t; while (chartype[*tt] <= 1 ) tt++;
5063 c = *tt; *tt = 0;
5064 if ( ( numdol = GetDollar(t) ) > 0 ) {
5065 if ( Dollars[numdol].factors != 0 ) x = 1;
5066 else x = 0;
5067 }
5068 else {
5069 MesPrint("@ %s should be the name of an expression or a $ variable",t-1);
5070 Terminate(-1);
5071 }
5072 *tt = c;
5073 }
5074 else {
5075 tt = SkipAName(t);
5076 c = *tt; *tt = 0;
5077 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) {
5078 MesPrint("@ %s should be the name of an expression or a $ variable",t);
5079 Terminate(-1);
5080 }
5081 else {
5082 if ( ( Expressions[numexp].vflags & ISFACTORIZED ) != 0 ) x = 1;
5083 else x = 0;
5084 }
5085 *tt = c;
5086 }
5087 while ( *tt == ' ' || *tt == '\t'
5088 || *tt == '\n' || *tt == '\r' ) tt++;
5089 if ( *tt != ')' ) {
5090 MesPrint("@Improper use of isfactorized($var) or isfactorized(expr)");
5091 Terminate(-1);
5092 }
5093 *type = 3;
5094 s = tt+1;
5095 *val2 = x;
5096 return(s);
5097 }
5098 else if ( StrICmp(s,(UBYTE *)"isdefined") == 0 ) {
5099 UBYTE *tt;
5100 *t++ = c;
5101 while ( *t == ' ' || *t == '\t' || *t == '\n' || *t == '\r' ) t++;
5102 tt = SkipAName(t);
5103 c = *tt; *tt = 0;
5104 if ( GetPreVar(t,WITHOUTERROR) != 0 ) x = 1;
5105 else x = 0;
5106 *tt = c;
5107 while ( *tt == ' ' || *tt == '\t'
5108 || *tt == '\n' || *tt == '\r' ) tt++;
5109 if ( *tt != ')' ) {
5110 MesPrint("@Improper use of isdefined(var)");
5111 Terminate(-1);
5112 }
5113 *type = 3;
5114 s = tt+1;
5115 *val2 = x;
5116 return(s);
5117 }
5118 else if ( StrICmp(s,(UBYTE *)"flag") == 0 ) {
5119 UBYTE *tt;
5120 WORD x = 0, numexp;
5121 {
5122 *t++ = c;
5123 while ( *t == ' ' || *t == '\t' ) t++;
5124 if ( FG.cTable[*t] != 1 ) goto flagerror;
5125 while ( FG.cTable[*t] == 1 ) x = 10*x + (*t++ - '0');
5126 if ( x < 1 || x > BITSINWORD ) {
5127 MesPrint("@Illegal number %d for flag in flag condition",x);
5128 goto flagerror;
5129 }
5130 while ( *t == ' ' || *t == '\t' ) t++;
5131 if ( *t != ',' ) goto flagerror;
5132 t++;
5133 while ( *t == ' ' || *t == '\t' ) t++;
5134 tt = SkipAName(t);
5135 c = *tt; *tt = 0;
5136 if ( GetName(AC.exprnames,t,&numexp,NOAUTO) == NAMENOTFOUND ) {
5137 MesPrint("@ %s should be the name of an expression",t);
5138 goto flagerror;
5139 }
5140 *tt = c;
5141 while ( *t == ' ' || *t == '\t' ) t++;
5142 if ( *tt != ')' ) {
5143flagerror:
5144 MesPrint("@Improper use of flag(num,expr)");
5145 Terminate(-1);
5146 return(0);
5147 }
5148 if ( ( Expressions[numexp].uflags & ( 1 << (x-1) ) ) != 0 )
5149 *val2 = 1;
5150 else *val2 = 0;
5151 *type = 3;
5152 s = tt+1;
5153 return(s);
5154 }
5155 }
5156 else *t = c;
5157 }
5158 else if ( *t == '=' || *t == '<' || *t == '>' || *t == '!'
5159 || *t == ')' || *t == ' ' || *t == '\t' || *t == 0 || *t == '\n' ) {
5160 *val2 = 0;
5161 *type = 2;
5162 return(t);
5163 }
5164 else {
5165 MesPrint("@Illegal use of string in preprocessor condition: %s",s);
5166 Terminate(-1);
5167 }
5168 }
5169 while ( *t == '-' || *t == '+' || *t == ' ' || *t == '\t' ) {
5170 if ( *t == '-' ) sign = -sign;
5171 t++;
5172 }
5173 while ( chartype[*t] == 1 ) { x = 10*x + *t++ - '0'; }
5174 while ( *t == ' ' || *t == '\t' ) t++;
5175 if ( chartype[*t] == 8 || *t == ')' || *t == '=' || *t == 0 ) {
5176 *val2 = sign > 0 ? x: -x;
5177 *type = 1;
5178 return(t);
5179 }
5180 while ( chartype[*t] != 8 && *t != ')' && *t != '=' && *t ) t++;
5181 while ( ( t > s ) && ( t[-1] == ' ' || t[-1] == '\t' ) ) t--;
5182 *type = 2;
5183 *val2 = val;
5184 return(t);
5185}
5186
5187/*
5188 #] pParseObject :
5189 #[ PreCalc :
5190
5191 To be called when a { is encountered.
5192 Action: read first till matching }. This is to be stored.
5193 Next we look whether this is a set or whether it can be
5194 evaluated. If it is a set we consider it as a new stream.
5195 The stream will have to be deallocated when read completely.
5196 If it is to be evaluated we do that and put the result in
5197 a stream.
5198*/
5199
5200UBYTE *PreCalc(void)
5201{
5202 UBYTE *buff, *s = 0, *t, *newb, c;
5203 int size, i, n, parlevel = 0, bralevel = 0;
5204 LONG answer;
5205 ULONG uanswer;
5206 size = n = 0;
5207 buff = 0; c = '{';
5208 for (;;) {
5209 if ( n >= size ) {
5210 if ( size == 0 ) size = 72;
5211 else size *= 2;
5212 if ( ( newb = (UBYTE *)Malloc1(size+2,"{}") ) == 0 ) return(0);
5213 s = newb;
5214 if ( buff ) {
5215 i = n;
5216 t = buff;
5217 NCOPYB(s,t,i);
5218 M_free(buff,"pre calc buffer");
5219 }
5220 else s = newb;
5221 buff = newb;
5222 }
5223 *s++ = c; n++;
5224 c = GetChar(0);
5225 if ( c == 0 ) {
5226 Error0("Unmatched {}");
5227 M_free(buff,"precalc buffer");
5228 return(0);
5229 }
5230 else if ( c == '{' ) { bralevel++; }
5231 else if ( c == '}' ) {
5232 if ( --bralevel < 0 ) { *s++ = c; *s = 0; break; }
5233 }
5234 else if ( c == '(' ) { parlevel++; }
5235 else if ( c == ')' ) {
5236 if ( --parlevel < 0 ) { *s++ = c; *s = 0; goto setstring; }
5237 }
5238 else if ( chartype[c] != 1 && chartype[c] != 5
5239 && chartype[c] != 6 && c != '!' && c != '&'
5240 && c != '|' && c != '\\' ) { *s++ = c; *s = 0; goto setstring; }
5241 }
5242 if ( parlevel > 0 ) goto setstring;
5243/*
5244 Try now to evaluate the string.
5245 If it works, copy the resulting value back into buff as a string.
5246*/
5247 answer = 0;
5248 if ( PreEval(buff+1,&answer) == 0 ) goto setstring;
5249 t = buff + size;
5250 s = buff;
5251 if ( answer < 0 ) { *s++ = '-'; }
5252 uanswer = LongAbs(answer);
5253 n = 0;
5254 do {
5255 *--t = ( uanswer % 10 ) + '0';
5256 uanswer /= 10;
5257 n++;
5258 } while ( uanswer > 0 );
5259 NCOPYB(s,t,n);
5260 *s = 0;
5261setstring:;
5262/*
5263 Open a stream that contains the current string.
5264 Mark it to be removed after termination.
5265*/
5266 if ( OpenStream(buff,PRECALCSTREAM,0,PRENOACTION) == 0 ) return(0);
5267 return(buff);
5268}
5269
5270/*
5271 #] PreCalc :
5272 #[ PreEval :
5273
5274 Operations are:
5275 +, -, *, /, %, &, |, ^, !, ^% (postfix 2log), ^/ (postfix sqrt)
5276*/
5277
5278UBYTE *PreEval(UBYTE *s, LONG *x)
5279{
5280 LONG y, z, a;
5281 int tobemultiplied, tobeadded = 1, expsign, i;
5282 UBYTE *t;
5283 *x = 0; a = 1;
5284 while ( *s == ' ' || *s == '\t' ) s++;
5285 for(;;){
5286 if ( *s == '+' || *s == '-' ) {
5287 if ( *s == '-' ) tobeadded = -1;
5288 else tobeadded = 1;
5289 s++;
5290 while ( *s == '-' || *s == '+' || *s == ' ' || *s == '\t' ) {
5291 if ( *s == '-' ) tobeadded = -tobeadded;
5292 s++;
5293 }
5294 }
5295 tobemultiplied = 0;
5296 for(;;){
5297 while ( *s == ' ' || *s == '\t' ) s++;
5298 if ( *s <= '9' && *s >= '0' ) {
5299 ULONG uy;
5300 ParseNumber(uy,s)
5301 y = uy; /* may cause an implementation-defined behaviour */
5302 }
5303 else if ( *s == '(' || *s == '{' ) {
5304 if ( ( t = PreEval(s+1,&y) ) == 0 ) return(0);
5305 s = t;
5306 }
5307 else return(0);
5308 while ( *s == ' ' || *s == '\t' ) s++;
5309 expsign = 1;
5310 while ( *s == '^' || *s == '!' ) {
5311 s++;
5312 if ( s[-1] == '!' ) { /* factorial of course */
5313 while ( *s == ' ' || *s == '\t' ) s++;
5314 if ( y < 0 ) {
5315 MesPrint("@Negative value in preprocessor factorial: %l",y);
5316 return(0);
5317 }
5318 else if ( y == 0 ) y = 1;
5319 else if ( y > 1 ) {
5320 z = y-1;
5321 while ( z > 0 ) { y = y*z; z--; }
5322 }
5323 continue;
5324 }
5325 else if ( *s == '%' ) { /* ^% is postfix 2log */
5326 s++;
5327 while ( *s == ' ' || *s == '\t' ) s++;
5328 z = y;
5329 if ( z <= 0 ) {
5330 MesPrint("@Illegal value in preprocessor logarithm: %l",z);
5331 return(0);
5332 }
5333 y = 0; z >>= 1;
5334 while ( z ) { y++; z >>= 1; }
5335 continue;
5336 }
5337 else if ( *s == '/' ) { /* ^/ is postfix sqrt */
5338 LONG yy, zz;
5339 s++;
5340 while ( *s == ' ' || *s == '\t' ) s++;
5341 z = y;
5342 if ( z <= 0 ) {
5343 MesPrint("@Illegal value in preprocessor square root: %l",z);
5344 return(0);
5345 }
5346 if ( z > 8 ) { /* Very crude integer square root */
5347 zz = z;
5348 yy = 0; zz >>= 1;
5349 while ( zz ) { yy++; zz >>= 1; }
5350 zz = z >> (yy/2); i = 10; y = 0;
5351 do {
5352 yy = zz/2 + z/(2*zz); i--;
5353 if ( y == yy ) break;
5354 y = zz; zz = yy;
5355 } while ( y != yy && i > 0 );
5356 while ( y*y < z ) y++;
5357 while ( y*y > z ) y--;
5358 }
5359 else if ( z >= 4 ) y = 2;
5360 else if ( z == 0 ) y = 0;
5361 else y = 1;
5362 continue;
5363 }
5364 while ( *s == ' ' || *s == '\t' ) s++;
5365 while ( *s == '-' || *s == '+' || *s == ' ' || *s == '\t' ) {
5366 if ( *s == '-' ) expsign = -expsign;
5367 }
5368 if ( *s <= '9' && *s >= '0' ) {
5369 ParseNumber(z,s)
5370 }
5371 else if ( *s == '(' || *s == '{' ) {
5372 if ( ( t = PreEval(s+1,&z) ) == 0 ) return(0);
5373 s = t;
5374 }
5375 else return(0);
5376 while ( *s == ' ' || *s == '\t' ) s++;
5377 y = iexp(y,(int)z);
5378 }
5379 if ( tobemultiplied == 0 ) {
5380 if ( expsign < 0 ) a = 1/y;
5381 else a = y;
5382 }
5383 else {
5384 if ( tobemultiplied > 2 && expsign != 1 ) {
5385 MesPrint("&Incorrect use of ^ with & or |. Use brackets!");
5386 Terminate(-1);
5387 }
5388 tobemultiplied *= expsign;
5389 if ( tobemultiplied == 1 ) a *= y;
5390 else if ( tobemultiplied == 3 ) a &= y;
5391 else if ( tobemultiplied == 4 ) a |= y;
5392 else {
5393 if ( y == 0 || tobemultiplied == -2 ) {
5394 MesPrint("@Division by zero in preprocessor calculator");
5395 Terminate(-1);
5396 }
5397 if ( tobemultiplied == 2 ) a %= y;
5398 else a /= y;
5399 }
5400 }
5401 if ( *s == '%' ) tobemultiplied = 2;
5402 else if ( *s == '*' ) tobemultiplied = 1;
5403 else if ( *s == '/' ) tobemultiplied = -1;
5404 else if ( *s == '&' ) tobemultiplied = 3;
5405 else if ( *s == '|' ) tobemultiplied = 4;
5406 else {
5407 ULONG ux, ua;
5408 ux = *x;
5409 ua = a;
5410 if ( tobeadded >= 0 ) ux += ua;
5411 else ux -= ua;
5412 *x = ULongToLong(ux);
5413 if ( *s == ')' || *s == '}' ) return(s+1);
5414 else if ( *s == '-' || *s == '+' ) { tobeadded = 1; break; }
5415 else return(0);
5416 }
5417 s++;
5418 }
5419 }
5420/* return(0); */
5421}
5422
5423/*
5424 #] PreEval :
5425 #[ AddToPreTypes :
5426*/
5427
5428void AddToPreTypes(int type)
5429{
5430 if ( AP.NumPreTypes >= AP.MaxPreTypes ) {
5431 int i, *newlist = (int *)Malloc1(sizeof(int)*(2*AP.MaxPreTypes+1)
5432 ,"preprocessor type lists");
5433 for ( i = 0; i <= AP.MaxPreTypes; i++ ) newlist[i] = AP.PreTypes[i];
5434 M_free(AP.PreTypes,"preprocessor type lists");
5435 AP.PreTypes = newlist;
5436 AP.MaxPreTypes = 2*AP.MaxPreTypes;
5437 }
5438 AP.PreTypes[++AP.NumPreTypes] = type;
5439}
5440
5441/*
5442 #] AddToPreTypes :
5443 #[ MessPreNesting :
5444*/
5445
5446void MessPreNesting(int par)
5447{
5448 MesPrint("@(%d)Illegal nesting of %#if, %#do, %#procedure and/or %#switch",par);
5449}
5450
5451/*
5452 #] MessPreNesting :
5453 #[ DoPreAddSeparator :
5454
5455 Preprocessor directives "addseparator" and "rmseparator" add/remove
5456 separator characters used to separate function arguments.
5457 Example:
5458
5459 #define QQ "a|g|a"
5460 #addseparator %
5461 *Comma must be quoted!:
5462 #rmseparator ","
5463 #rmseparator |
5464 #call H(a,a%`QQ')
5465
5466 Characters ' ', '\t' and '"' are ignored!
5467*/
5468
5469int DoPreAddSeparator(UBYTE *s)
5470{
5471 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5472 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5473 for(;*s != '\0';s++){
5474 while ( *s == ' ' || *s == '\t' || *s == '"') s++;
5475 /* Todo:
5476 if ( set_in(*s,invalidseparators) ) {
5477 MesPrint("@Invalid separator specified");
5478 return(-1);
5479 }
5480 */
5481 set_set(*s,AC.separators);
5482 }
5483 return(0);
5484}
5485
5486/*
5487 #] DoPreAddSeparator :
5488 #[ DoPreRmSeparator :
5489
5490 See commentary with DoPreAddSeparator
5491
5492 Characters ' ', '\t' and '"' are ignored!
5493*/
5494int DoPreRmSeparator(UBYTE *s)
5495{
5496 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5497 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5498 for(;*s != '\0';s++){
5499 while ( *s == ' ' || *s == '\t' || *s == '"') s++;
5500 set_del(*s,AC.separators);
5501 }
5502 return(0);
5503}
5504
5505/*
5506 #] DoPreRmSeparator :
5507 #[ DoExternal:
5508
5509 #external ["prevar"] command
5510*/
5511int DoExternal(UBYTE *s)
5512{
5513#ifdef WITHEXTERNALCHANNEL
5514 UBYTE *prevar=0;
5515 int externalD= 0;
5516#else
5517 DUMMYUSE(s);
5518#endif
5519 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5520 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5521 if ( AP.preError ) return(0);
5522
5523#ifdef WITHEXTERNALCHANNEL
5524 while ( *s == ' ' || *s == '\t' ) s++;
5525 if(*s == '"'){/*prevar to store the descriptor is defined*/
5526 prevar=++s;
5527
5528 if ( chartype[*s] == 0 )for(;*s != '"'; s++)switch(chartype[*s]){
5529 case 10:/*'\0' fits here*/
5530 MesPrint("@Can't finde closing \"");
5531 Terminate(-1);
5532 case 0:case 1: continue;
5533 default:
5534 break;
5535 }
5536 if(*s != '"'){
5537 MesPrint("@Illegal name of preprocessor variable to store external channel");
5538 return(-1);
5539 }
5540 *s='\0';
5541 for(s++; *s == ' ' || *s == '\t'; s++);
5542 }
5543
5544 if(*s == '\0'){
5545 MesPrint("@Illegal external command");
5546 return(-1);
5547 }
5548 /*here s is a command*/
5549 /*See the file extcmd.c*/
5550 /*[08may2006 mt]:*/
5551 externalD=openExternalChannel(
5552 s,
5553 AX.daemonize,
5554 AX.shellname,
5555 AX.stderrname);
5556 /*:[08may2006 mt]*/
5557 if(externalD<1){/*error?*/
5558 /*Not quite correct - terminate the program on error:*/
5559 Error1("Can't start external program",s);
5560 return(-1);
5561 }
5562 /*Now external command runs.*/
5563
5564 if(prevar){/*Store the external channel descriptor in the provided variable:*/
5565 UBYTE buf[21];/* 64/Log_2[10] = 19.3, so this is enough forever...*/
5566 NumToStr(buf,externalD);
5567 if ( PutPreVar(prevar,buf,0,1) < 0 ) return(-1);
5568 }
5569
5570 AX.currentExternalChannel=externalD;
5571 /*[08may2006 mt]:*/
5572 if(AX.currentPrompt!=0){/*Change default terminator*/
5573 if(setTerminatorForExternalChannel( (char *)AX.currentPrompt)){
5574 MesPrint("@Prompt is too long");
5575 return(-1);
5576 }
5577 }
5578 setKillModeForExternalChannel(AX.killSignal,AX.killWholeGroup);
5579 /*:[08may2006 mt]*/
5580 return(0);
5581#else /*ifdef WITHEXTERNALCHANNEL*/
5582 Error0("External channel: not implemented on this computer/system");
5583 return(-1);
5584#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5585}
5586
5587/*
5588 #] DoExternal:
5589 #[ DoPrompt:
5590 #prompt string
5591*/
5592
5593int DoPrompt(UBYTE *s)
5594{
5595#ifndef WITHEXTERNALCHANNEL
5596 DUMMYUSE(s);
5597#endif
5598 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5599 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5600
5601#ifdef WITHEXTERNALCHANNEL
5602 while ( *s == ' ' || *s == '\t' ) s++;
5603 if ( AX.currentPrompt )
5604 M_free(AX.currentPrompt,"external channel prompt");
5605 if ( *s == '\0' )
5606 AX.currentPrompt = (UBYTE *)strDup1((UBYTE *)"","external channel prompt");
5607 else
5608 AX.currentPrompt = strDup1(s,"external channel prompt");
5609 if( setTerminatorForExternalChannel( (char *)AX.currentPrompt) > 0 ){
5610 MesPrint("@Prompt is too long");
5611 return(-1);
5612 }
5613 /*else: if 0, ok; if -1, there is no current channel-ok, just prompt is stored.*/
5614 return(0);
5615#else /*ifdef WITHEXTERNALCHANNEL*/
5616 Error0("External channel: not implemented on this computer/system");
5617 return(-1);
5618#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5619}
5620/*
5621 #] DoPrompt:
5622 #[ DoSetExternal:
5623 #setexternal n
5624*/
5625
5626int DoSetExternal(UBYTE *s)
5627{
5628#ifdef WITHEXTERNALCHANNEL
5629 int n=0;
5630#else
5631 DUMMYUSE(s);
5632#endif
5633 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5634 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5635 if ( AP.preError ) return(0);
5636
5637#ifdef WITHEXTERNALCHANNEL
5638 while ( *s == ' ' || *s == '\t' ) s++;
5639 while ( chartype[*s] == 1 ) { n = 10*n + *s++ - '0'; }
5640 while ( *s == ' ' || *s == '\t' ) s++;
5641 if(*s!='\0'){
5642 MesPrint("@setexternal: number expected");
5643 return(-1);
5644 }
5645 if(selectExternalChannel(n)<0){
5646 MesPrint("@setexternal: invalid number");
5647 return(-1);
5648 }
5649 AX.currentExternalChannel=n;
5650 return(0);
5651#else /*ifdef WITHEXTERNALCHANNEL*/
5652 Error0("External channel: not implemented on this computer/system");
5653 return(-1);
5654#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5655}
5656/*
5657 #] DoSetExternal:
5658 #[ DoSetExternalAttr:
5659*/
5660
5661static FORM_INLINE UBYTE *pickupword(UBYTE *s)
5662{
5663
5664 for(;*s>' ';s++)switch(*s){
5665 case '=':
5666 case ',':
5667 case ';':
5668 return(s);
5669 }/*for(;*s>' ';s++)switch(*s)*/
5670 return(s);
5671}
5672/*Returns 0 if the first string (case insensitively) equal to
5673 the beginning of the second string (of length n):
5674*/
5675static inline int strINCmp(UBYTE *a, UBYTE *b, int n)
5676{
5677 for(;n>0;n--)if(tolower(*a++)!=tolower(*b++))
5678 return(1);
5679 return(*a != '\0');
5680}
5681
5682#define KILL "kill"
5683#define KILLALL "killall"
5684#define DAEMON "daemon"
5685#define SHELL "shell"
5686#define STDERR "stderr"
5687
5688#define TRUE_EXPR "true"
5689#define FALSE_EXPR "false"
5690#define NOSHELL "noshell"
5691#define TERMINAL "terminal"
5692
5693/*
5694 Expects comma-separated list of pairs name=value
5695*/
5696int DoSetExternalAttr(UBYTE *s)
5697{
5698#ifdef WITHEXTERNALCHANNEL
5699 int lnam,lval;
5700 UBYTE *nam,*val;
5701#else
5702 DUMMYUSE(s);
5703#endif
5704 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5705 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5706 if ( AP.preError ) return(0);
5707
5708#ifdef WITHEXTERNALCHANNEL
5709 do{
5710 /*Read the name:*/
5711 while ( *s == ' ' || *s == '\t' ) s++;
5712 s=pickupword(nam=s);
5713 lnam=s-nam;
5714 while ( *s == ' ' || *s == '\t' ) s++;
5715 if(*s++!='='){
5716 MesPrint("@External channel:'=' expected instead of %s",s-1);
5717 return(-1);
5718 }
5719 /*Read the value:*/
5720 while ( *s == ' ' || *s == '\t' ) s++;
5721 val=s;
5722
5723 for(;;){
5724 UBYTE *m;
5725 s=pickupword(s);
5726 m=s;
5727 while ( *s == ' ' || *s == '\t' ) s++;
5728 if( (*s == ',')||(*s == '\n')||(*s == ';')||(*s == '\0') ){
5729 s=m;
5730 break;
5731 }
5732 }/*for(;;)*/
5733
5734 lval=s-val;
5735 while ( *s == ' ' || *s == '\t' ) s++;
5736
5737 if(strINCmp((UBYTE *)SHELL,nam,lnam)==0){
5738 if(AX.shellname!=NULL)
5739 M_free(AX.shellname,"external channel shellname");
5740 if(strINCmp((UBYTE *)NOSHELL,val,lval)==0)
5741 AX.shellname=NULL;
5742 else{
5743 UBYTE *ch,*b;
5744 b=ch=AX.shellname=Malloc1(lval+1,"external channel shellname");
5745 while(ch-b<lval)
5746 *ch++=*val++;
5747 *ch='\0';
5748 }
5749 }else if(strINCmp((UBYTE *)DAEMON,nam,lnam)==0){
5750 if(strINCmp((UBYTE *)TRUE_EXPR,val,lval)==0)
5751 AX.daemonize = 1;
5752 else if(strINCmp((UBYTE *)FALSE_EXPR,val,lval)==0)
5753 AX.daemonize = 0;
5754 else{
5755 MesPrint("@External channel:true or false expected for %s",DAEMON);
5756 return(-1);
5757 }
5758 }else if(strINCmp((UBYTE *)KILLALL,nam,lnam)==0){
5759 if(strINCmp((UBYTE *)TRUE_EXPR,val,lval)==0)
5760 AX.killWholeGroup = 1;
5761 else if(strINCmp((UBYTE *)FALSE_EXPR,val,lval)==0)
5762 AX.killWholeGroup = 0;
5763 else{
5764 MesPrint("@External channel: true or false expected for %s",KILLALL);
5765 return(-1);
5766 }
5767 }else if(strINCmp((UBYTE *)KILL,nam,lnam)==0){
5768 int i,n=0;
5769 for(i=0;i<lval;i++) {
5770 if( *val>='0' && *val<= '9' )
5771 n = 10*n + *val++ - '0';
5772 else{
5773 MesPrint("@External channel: number expected for %s",KILL);
5774 return(-1);
5775 }
5776 }
5777 AX.killSignal=n;
5778 }else if(strINCmp((UBYTE *)STDERR,nam,lnam)==0){
5779 if( AX.stderrname != NULL ) {
5780 M_free(AX.stderrname,"external channel stderrname");
5781 }
5782 if(strINCmp((UBYTE *)TERMINAL,val,lval)==0)
5783 AX.stderrname = NULL;
5784 else{
5785 UBYTE *ch,*b;
5786 b=ch=AX.stderrname=Malloc1(lval+1,"external channel stderrname");
5787 while(ch-b<lval)
5788 *ch++=*val++;
5789 *ch='\0';
5790 }
5791 }else{
5792 nam[lnam+1]='\0';
5793 MesPrint("@External channel: unrecognized attribute",nam);
5794 return(-1);
5795 }
5796 }while(*s++ == ',');
5797 if( (*(s-1)>' ')&&(*(s-1)!=';') ){
5798 MesPrint("@External channel: syntax error: %s",s-1);
5799 return(-1);
5800 }
5801 return(0);
5802#else /*ifdef WITHEXTERNALCHANNEL*/
5803 Error0("External channel: not implemented on this computer/system");
5804 return(-1);
5805#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5806}
5807/*
5808 #] DoSetExternalAttr:
5809 #[ DoRmExternal:
5810 #rmexternal [n] (if 0, close all)
5811*/
5812
5813int DoRmExternal(UBYTE *s)
5814{
5815#ifdef WITHEXTERNALCHANNEL
5816 int n = -1;
5817#else
5818 DUMMYUSE(s);
5819#endif
5820 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5821 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5822 if ( AP.preError ) return(0);
5823
5824#ifdef WITHEXTERNALCHANNEL
5825 while ( *s == ' ' || *s == '\t' ) s++;
5826 if( chartype[*s] == 1 ){
5827 for(n=0; chartype[*s] == 1 ; s++) { n = 10*n + *s - '0'; }
5828 while ( *s == ' ' || *s == '\t' ) s++;
5829 }
5830 if(*s!='\0'){
5831 MesPrint("@rmexternal: invalid number");
5832 return(-1);
5833 }
5834 switch(n){
5835 case 0:/*Close all opened channels*/
5836 closeAllExternalChannels();
5837 AX.currentExternalChannel=0;
5838 /*Do not clean AX.currentPrompt!*/
5839 return(0);
5840 case -1:/*number is not specified - try current*/
5841 n=AX.currentExternalChannel;
5842 /* fall through */
5843 default:
5844 closeExternalChannel(n);/*No reaction for possible error*/
5845 }
5846 if (n == AX.currentExternalChannel)/*cleaned up by closeExternalChannel()*/
5847 AX.currentExternalChannel=0;
5848 return(0);
5849#else /*ifdef WITHEXTERNALCHANNEL*/
5850 Error0("External channel: not implemented on this computer/system");
5851 return(-1);
5852#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
5853
5854}
5855/*
5856 #] DoRmExternal:
5857 #[ DoFromExternal :
5858 #fromexternal
5859 is used to read the text from the running external
5860 program, the syntax is similar to the #include
5861 directive.
5862 #fromexternal "varname"
5863 is used to read the text from the running external
5864 program into the preprocessor variable varname.
5865 directive.
5866 #fromexternal "varname" maxlength
5867 is used to read the text from the running external
5868 program into the preprocessor variable varname.
5869 directive. Only first maxlength characters are
5870 stored.
5871
5872 FORM continues to read the running external
5873 program output until the external program outputs a
5874 prompt.
5875
5876*/
5877
5878int DoFromExternal(UBYTE *s)
5879{
5880#ifdef WITHEXTERNALCHANNEL
5881 UBYTE *prevar=0;
5882 int lbuf=-1;
5883 int withNoList=AC.NoShowInput;
5884 int oldpreassignflag;
5885#else
5886 DUMMYUSE(s);
5887#endif
5888 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
5889 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
5890 if ( AP.preError ) return(0);
5891#ifdef WITHEXTERNALCHANNEL
5892
5893 FLUSHCONSOLE;
5894
5895 while ( *s == ' ' || *s == '\t' ) s++;
5896 /*[17may2006 mt]:*/
5897 if ( *s == '-' || *s == '+' ) {
5898 if ( *s == '-' )
5899 withNoList = 1;
5900 else
5901 withNoList = 0;
5902 s++;
5903 while ( *s == ' ' || *s == '\t' ) s++;
5904 }/*if ( *s == '-' || *s == '+' )*/
5905 /*:[17may2006 mt]*/
5906 /*[02feb2006 mt]:*/
5907 if(*s == '"'){/*prevar to store the output is defined*/
5908 prevar=++s;
5909
5910 if ( *s=='$' || chartype[*s] == 0 )for(;*s != '"'; s++)switch(chartype[*s]){
5911 case 10:/*'\0' fits here*/
5912 MesPrint("@Can't finde closing \"");
5913 Terminate(-1);
5914 case 0:case 1: continue;
5915 default:
5916 break;
5917 }
5918 if(*s != '"'){
5919 MesPrint("@Illegal name to store output of external channel");
5920 return(-1);
5921 }
5922 *s='\0';
5923 for(s++; *s == ' ' || *s == '\t'; s++);
5924 }/*if(*s == '"')*/
5925
5926 if(*s != '\0'){
5927 if( chartype[*s] == 1 ){
5928 for(lbuf=0; chartype[*s] == 1 ; s++) { lbuf = 10*lbuf + *s - '0'; }
5929 while ( *s == ' ' || *s == '\t' ) s++;
5930 }
5931 if( (*s!='\0')||(lbuf<0) ){
5932 MesPrint("@Illegal buffer length in fromexternal");
5933 return(-1);
5934 }
5935 }/*if(*s != '\0')*/
5936 /*:[02feb20006 mt]*/
5937 if(getCurrentExternalChannel()!=AX.currentExternalChannel)
5938 /*[08may20006 mt]:*/
5939 /*selectExternalChannel(AX.currentExternalChannel);*/
5940 if(selectExternalChannel(AX.currentExternalChannel)){
5941 MesPrint("@No current external channel");
5942 return(-1);
5943 }
5944 /*:[08may20006 mt]*/
5945
5946 /*[02feb2006 mt]:*/
5947 if(prevar!=0){/*The result must be stored into preprovar*/
5948 UBYTE *buf;
5949 int cc = 0;
5950 if(lbuf == -1){/*Unlimited buffer, everything must be stored*/
5951 int i;
5952 buf=Malloc1( (lbuf=255)+1,"Fromexternal");
5953 /*[18may20006 mt]:*/
5954 /*for(i=0;(cc=getcFromExtChannel())!=EOF;i++){*/
5955 /* May 2006: now getcFromExtChannelOk returns EOF while
5956 getcFromExtChannelFailure returns -2 (see comments in
5957 exctcmd.c):*/
5958 for(i=0;(cc=getcFromExtChannel())>0;i++){
5959 /*:[18may20006 mt]*/
5960 if(i==lbuf){
5961 int j;
5962 UBYTE *tmp=Malloc1( (lbuf*=2)+1,"Fromexternal");
5963 for(j=0;j<i;j++)tmp[j]=buf[j];
5964 M_free(buf,"Fromexternal");
5965 buf=tmp;
5966 }
5967 buf[i]=(UBYTE)(cc);
5968 }/*for(i=0;(cc=getcFromExtChannel())>0;i++)*/
5969 /*[18may20006 mt]:*/
5970 if(cc == -2){
5971 MesPrint("@No current external channel");
5972 return(-1);
5973 }
5974 lbuf=i;
5975 /*:[18may20006 mt]*/
5976 buf[i]='\0';
5977 }else{/*Fixed buffer, only lbuf chars must be stored*/
5978 int i;
5979 buf=Malloc1(lbuf+1,"Fromexternal");
5980 for(i=0; i<lbuf;i++){
5981 /*[18may20006 mt]:*/
5982 /*if( (cc=getcFromExtChannel())==EOF )*/
5983 /* May 2006: now getcFromExtChannelOk returns EOF while
5984 getcFromExtChannelFailure returns -2 (see comments in
5985 exctcmd.c):*/
5986 if( (cc=getcFromExtChannel())<1 )
5987 /*:[18may20006 mt]*/
5988 break;
5989 buf[i]=(UBYTE)(cc);
5990 }
5991 buf[i]='\0';
5992 /*[18may20006 mt]:*/
5993 /*if(cc!=EOF)
5994 while(getcFromExtChannel()!=EOF);*//*Eat the rest*/
5995 /* May 2006: now getcFromExtChannelOk returns EOF while
5996 getcFromExtChannelFailure returns -2 (see comments in
5997 exctcmd.c):*/
5998 if(cc>0)
5999 while(getcFromExtChannel()>0);/*Eat the rest*/
6000 else if(cc == -2){
6001 MesPrint("@No current external channel");
6002 return(-1);
6003 }
6004 /*:[18may20006 mt]*/
6005 }
6006 /*[18may20006 mt]:*/
6007 if(*prevar == '$'){/*Put the answer to the dollar variable*/
6008 int oldNumPotModdollars = NumPotModdollars;
6009#ifdef WITHMPI
6010 WORD oldRhsExprInModuleFlag = AC.RhsExprInModuleFlag;
6011 AC.RhsExprInModuleFlag = 0;
6012#endif
6013 /*Here lbuf is the actual length of buf!*/
6014 /*"prevar=buf'\0'":*/
6015 UBYTE *pbuf=Malloc1(StrLen(prevar)+1+lbuf+1,"Fromexternal to dollar");
6016 UBYTE *c=pbuf;
6017 UBYTE *b=prevar;
6018 while(*b!='\0'){*c++ = *b++;}
6019 *c++='=';
6020 b=buf;
6021 while( (*c++=*b++)!='\0' );
6022 oldpreassignflag = AP.PreAssignFlag;
6023 AP.PreAssignFlag = 1;
6024 if ( ( cc = CompileStatement(pbuf) ) || ( cc = CatchDollar(0) ) ) {
6025 Error1("External channel: can't asign output to dollar variable ",prevar);
6026 }
6027 AP.PreAssignFlag = oldpreassignflag;
6028 NumPotModdollars = oldNumPotModdollars;
6029#ifdef WITHMPI
6030 AC.RhsExprInModuleFlag = oldRhsExprInModuleFlag;
6031#endif
6032 M_free(pbuf,"Fromexternal to dollar");
6033 }else{
6034 cc = PutPreVar(prevar, buf, 0, 1) < 0;
6035 }
6036 /*:[18may20006 mt]*/
6037 M_free(buf,"Fromexternal");
6038 if ( cc ) return(-1);
6039 return(0);
6040 }
6041 /*:[02feb2006 mt]*/
6042 if ( OpenStream(s,EXTERNALCHANNELSTREAM,0,PRENOACTION) == 0 ) return(-1);
6043 /*[17may2006 mt]:*/
6044 AC.NoShowInput = withNoList;
6045 /*:[17may2006 mt]*/
6046 return(0);
6047#else
6048 Error0("External channel: not implemented on this computer/system");
6049 return(-1);
6050#endif
6051}
6052
6053/*
6054 #] DoFromExternal :
6055 #[ DoToExternal :
6056 #toexetrnal
6057*/
6058
6059#ifdef WITHEXTERNALCHANNEL
6060
6061/*A wrapper to writeBufToExtChannel, see the file extcmd.c:*/
6062LONG WriteToExternalChannel(int handle, UBYTE *buffer, LONG size)
6063{
6064 /*ATT! handle is not used! Actual output is performed to
6065 the current external channel, see extcmd.c!*/
6066 DUMMYUSE(handle);
6067 if(writeBufToExtChannel((char*)buffer,size))
6068 return(-1);
6069 return(size);
6070}
6071#endif /*ifdef WITHEXTERNALCHANNEL*/
6072
6073int DoToExternal(UBYTE *s)
6074{
6075#ifdef WITHEXTERNALCHANNEL
6076 HANDLERS h;
6077 LONG (*OldWrite)(int handle, UBYTE *buffer, LONG size) = WriteFile;
6078 int ret=-1;
6079#else
6080 DUMMYUSE(s);
6081#endif
6082 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
6083 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
6084 if ( AP.preError ) return(0);
6085#ifdef WITHEXTERNALCHANNEL
6086
6087 h.oldsilent=AM.silent;
6088 h.newlogonly = h.oldlogonly = AM.FileOnlyFlag;
6089 h.newhandle = h.oldhandle = AC.LogHandle;
6090 h.oldprinttype = AO.PrintType;
6091
6092 WriteFile=&WriteToExternalChannel;
6093
6094 while ( *s == ' ' || *s == '\t' ) s++;
6095
6096 if(AX.currentExternalChannel==0){
6097 MesPrint("@No current external channel");
6098 goto DoToExternalReady;
6099 }
6100
6101 if(getCurrentExternalChannel()!=AX.currentExternalChannel)
6102 selectExternalChannel(AX.currentExternalChannel);
6103
6104 ret=writeToChannel(EXTERNALCHANNELOUT,s,&h);
6105 DoToExternalReady:
6106 WriteFile=OldWrite;
6107 return(ret);
6108#else /*ifdef WITHEXTERNALCHANNEL*/
6109 Error0("External channel: not implemented on this computer/system");
6110 return(-1);
6111#endif /*ifdef WITHEXTERNALCHANNEL ... else*/
6112
6113}
6114
6115/*
6116 #] DoToExternal :
6117 #[ defineChannel :
6118*/
6119
6120UBYTE *defineChannel(UBYTE *s, HANDLERS *h)
6121{
6122 UBYTE *name,*to;
6123
6124 if ( *s != '<' )
6125 return(s);
6126
6127 s++;
6128 name = to = s;
6129 while ( *s && *s != '>' ) {
6130 if ( *s == '\\' ) s++;
6131 *to++ = *s++;
6132 }
6133 if ( *s == 0 ) {
6134 MesPrint("@Improper termination of filename");
6135 return(0);
6136 }
6137 s++;
6138 *to = 0;
6139 if ( *name ) {
6140 h->newhandle = GetChannel((char *)name,0);
6141 h->newlogonly = 1;
6142 }
6143 else if ( AC.LogHandle >= 0 ) {
6144 h->newhandle = AC.LogHandle;
6145 h->newlogonly = 1;
6146 }
6147 return(s);
6148}
6149
6150/*
6151 #] defineChannel :
6152 #[ writeToChannel :
6153*/
6154
6155int writeToChannel(int wtype, UBYTE *s, HANDLERS *h)
6156{
6157 UBYTE *to, *fstring, *ss, *sss, *s1, c, c1;
6158 WORD num, number, nfac;
6159 WORD oldOptimizationLevel;
6160 UBYTE Out[MAXLINELENGTH+14], *stopper;
6161 int nosemi, i;
6162 int plus = 0;
6163
6164/*
6165 Now determine the format string
6166*/
6167 while ( *s == ',' || *s == ' ' ) s++;
6168 if ( *s != '"' ) {
6169 MesPrint("@No format string present");
6170 return(-1);
6171 }
6172 s++; fstring = to = s;
6173 while ( *s ) {
6174 if ( *s == '\\' ) {
6175 s++;
6176 if ( *s == '\\' ) {
6177 *to++ = *s++;
6178 if ( *s == '\\' ) *to++ = *s++;
6179 }
6180 else if ( *s == '"' ) *to++ = *s++;
6181 else { *to++ = '\\'; *to++ = *s++; }
6182 }
6183 else if ( *s == '"' ) break;
6184 else *to++ = *s++;
6185 }
6186 if ( *s != '"' ) {
6187 MesPrint("@No closing \" in format string");
6188 return(-1);
6189 }
6190 *to = 0; s++;
6191 if ( AC.LineLength > 20 && AC.LineLength <= MAXLINELENGTH ) stopper = Out + AC.LineLength;
6192 else stopper = Out + MAXLINELENGTH;
6193 to = Out;
6194/*
6195 s points now at the list of objects (if any)
6196 we can start executing the format string.
6197*/
6198 AM.silent = 0;
6199 AC.LogHandle = h->newhandle;
6200 AM.FileOnlyFlag = h->newlogonly;
6201 if ( h->newhandle >= 0 ) {
6202 AO.PrintType |= PRINTLFILE;
6203 }
6204 while ( *fstring ) {
6205 if ( to >= stopper ) {
6206 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6207 *to++ = '&';
6208 }
6209 num = to - Out;
6210 WriteString(wtype,Out,num);
6211 to = Out;
6212 if ( AC.OutputMode == FORTRANMODE
6213 || AC.OutputMode == PFORTRANMODE ) {
6214 number = 7;
6215 for ( i = 0; i < number; i++ ) *to++ = ' ';
6216 to[-2] = '&';
6217 }
6218 }
6219 if ( *fstring == '\\' ) {
6220 fstring++;
6221 if ( *fstring == 'n' ) {
6222 num = to - Out;
6223 WriteString(wtype,Out,num);
6224 to = Out;
6225 fstring++;
6226 }
6227 else if ( *fstring == 't' ) { *to++ = '\t'; fstring++; }
6228 else if ( *fstring == 'b' ) { *to++ = '\\'; fstring++; }
6229 else *to++ = *fstring++;
6230 }
6231 else if ( *fstring == '%' ) {
6232 plus = 0;
6233retry:
6234 fstring++;
6235 if ( *fstring == 'd' ) {
6236 int sign,dig;
6237 number = -1;
6238donumber:
6239 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6240 sign = 1;
6241 while ( *s == '+' || *s == '-' ) {
6242 if ( *s == '-' ) sign = -sign;
6243 s++;
6244 }
6245 dig = 0; ss = s; if ( sign < 0 ) { ss--; *ss = '-'; dig++; }
6246 while ( *s >= '0' && *s <= '9' ) { s++; dig++; }
6247 if ( number < 0 ) {
6248 while ( ss < s ) {
6249 if ( to >= stopper ) {
6250 num = to - Out;
6251 WriteString(wtype,Out,num);
6252 to = Out;
6253 }
6254 if ( *ss == '\\' ) ss++;
6255 *to++ = *ss++;
6256 }
6257 }
6258 else {
6259 if ( number < dig ) { dig = number; ss = s - dig; }
6260 while ( number > dig ) {
6261 if ( to >= stopper ) {
6262 num = to - Out;
6263 WriteString(wtype,Out,num);
6264 to = Out;
6265 }
6266 *to++ = ' '; number--;
6267 }
6268 while ( ss < s ) {
6269 if ( to >= stopper ) {
6270 num = to - Out;
6271 WriteString(wtype,Out,num);
6272 to = Out;
6273 }
6274 if ( *ss == '\\' ) ss++;
6275 *to++ = *ss++;
6276 }
6277 }
6278 fstring++;
6279 }
6280 else if ( *fstring == '$' ) {
6281 UBYTE *dolalloc;
6282 number = AO.OutSkip;
6283dodollar:
6284 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6285 if ( AC.OutputMode == FORTRANMODE
6286 || AC.OutputMode == PFORTRANMODE ) {
6287 number = 7;
6288 }
6289 if ( *s != '$' ) {
6290nodollar: MesPrint("@$-variable expected in #write instruction");
6291 AM.FileOnlyFlag = h->oldlogonly;
6292 AC.LogHandle = h->oldhandle;
6293 AO.PrintType = h->oldprinttype;
6294 AM.silent = h->oldsilent;
6295 return(-1);
6296 }
6297 s++; ss = s;
6298 while ( chartype[*s] <= 1 ) s++;
6299 if ( s == ss ) goto nodollar;
6300 c = *s; *s = 0;
6301 num = GetDollar(ss);
6302 if ( num < 0 ) {
6303 MesPrint("@#write instruction: $%s has not been defined",ss);
6304 AM.FileOnlyFlag = h->oldlogonly;
6305 AC.LogHandle = h->oldhandle;
6306 AO.PrintType = h->oldprinttype;
6307 AM.silent = h->oldsilent;
6308 return(-1);
6309 }
6310 *s = c;
6311 if ( *s == '[' ) {
6312 if ( Dollars[num].nfactors <= 0 ) {
6313 *s = 0;
6314 MesPrint("@#write instruction: $%s has not been factorized",ss);
6315 AM.FileOnlyFlag = h->oldlogonly;
6316 AC.LogHandle = h->oldhandle;
6317 AO.PrintType = h->oldprinttype;
6318 AM.silent = h->oldsilent;
6319 return(-1);
6320 }
6321/*
6322 Now get the number between the []
6323*/
6324 nfac = GetDollarNumber(&s,Dollars+num);
6325
6326 if ( Dollars[num].nfactors == 1 && nfac == 1 ) goto writewhole;
6327
6328 if ( ( dolalloc = WriteDollarFactorToBuffer(num,nfac,0) ) == 0 ) {
6329 AM.FileOnlyFlag = h->oldlogonly;
6330 AC.LogHandle = h->oldhandle;
6331 AO.PrintType = h->oldprinttype;
6332 AM.silent = h->oldsilent;
6333 return(-1);
6334 }
6335 goto writealloc;
6336 }
6337 else if ( *s && *s != ' ' && *s != ',' && *s != '\t' ) {
6338 MesPrint("@#write instruction: illegal characters after $-variable");
6339 AM.FileOnlyFlag = h->oldlogonly;
6340 AC.LogHandle = h->oldhandle;
6341 AO.PrintType = h->oldprinttype;
6342 AM.silent = h->oldsilent;
6343 return(-1);
6344 }
6345 else {
6346writewhole:
6347 if ( ( dolalloc = WriteDollarToBuffer(num,0) ) == 0 ) {
6348 AM.FileOnlyFlag = h->oldlogonly;
6349 AC.LogHandle = h->oldhandle;
6350 AO.PrintType = h->oldprinttype;
6351 AM.silent = h->oldsilent;
6352 return(-1);
6353 }
6354 else {
6355writealloc:
6356 ss = dolalloc;
6357 while ( *ss ) {
6358 if ( to >= stopper ) {
6359 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6360 *to++ = '&';
6361 }
6362 num = to - Out;
6363 WriteString(wtype,Out,num);
6364 to = Out;
6365 for ( i = 0; i < number; i++ ) *to++ = ' ';
6366 if ( AC.OutputMode == FORTRANMODE
6367 || AC.OutputMode == PFORTRANMODE ) to[-2] = '&';
6368 }
6369 if ( chartype[*ss] > 3 ) { *to++ = *ss++; }
6370 else {
6371 sss = ss; while ( chartype[*ss] <= 3 ) ss++;
6372 if ( ( to + (ss-sss) ) >= stopper ) {
6373 if ( (ss-sss) >= (stopper-Out) ) {
6374 if ( ( to - stopper ) < 10 ) {
6375 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6376 *to++ = '&';
6377 }
6378 num = to - Out;
6379 WriteString(wtype,Out,num);
6380 to = Out;
6381 for ( i = 0; i < number; i++ ) *to++ = ' ';
6382 if ( AC.OutputMode == FORTRANMODE
6383 || AC.OutputMode == PFORTRANMODE ) to[-2] = '&';
6384 }
6385 while ( (ss-sss) >= (stopper-Out) ) {
6386 while ( to < stopper-1 ) {
6387 *to++ = *sss++;
6388 }
6389 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6390 *to++ = '&';
6391 }
6392 else {
6393 *to++ = '\\';
6394 }
6395 num = to - Out;
6396 WriteString(wtype,Out,num);
6397 to = Out;
6398 if ( AC.OutputMode == FORTRANMODE
6399 || AC.OutputMode == PFORTRANMODE ) {
6400 for ( i = 0; i < number; i++ ) *to++ = ' ';
6401 to[-2] = '&';
6402 }
6403 }
6404 }
6405 else {
6406 if ( AC.OutputMode == FORTRANMODE && AC.IsFortran90 == ISFORTRAN90 ) {
6407 *to++ = '&';
6408 }
6409 num = to - Out;
6410 WriteString(wtype,Out,num);
6411 to = Out;
6412 for ( i = 0; i < number; i++ ) *to++ = ' ';
6413 if ( AC.OutputMode == FORTRANMODE
6414 || AC.OutputMode == PFORTRANMODE ) to[-2] = '&';
6415 }
6416 }
6417 while ( sss < ss ) *to++ = *sss++;
6418 }
6419 }
6420 }
6421 M_free(dolalloc,"written dollar");
6422 fstring++;
6423 }
6424 }
6425 else if ( *fstring == 's' ) {
6426 fstring++;
6427 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6428 if ( *s == '"' ) {
6429 s++; ss = s;
6430 while ( *s ) {
6431 if ( *s == '\\' ) s++;
6432 else if ( *s == '"' ) break;
6433 s++;
6434 }
6435 if ( *s == 0 ) {
6436 MesPrint("@#write instruction: Missing \" in string");
6437 AM.FileOnlyFlag = h->oldlogonly;
6438 AC.LogHandle = h->oldhandle;
6439 AO.PrintType = h->oldprinttype;
6440 AM.silent = h->oldsilent;
6441 return(-1);
6442 }
6443 while ( ss < s ) {
6444 if ( to >= stopper ) {
6445 num = to - Out;
6446 WriteString(wtype,Out,num);
6447 to = Out;
6448 }
6449 if ( *ss == '\\' ) ss++;
6450 *to++ = *ss++;
6451 }
6452 s++;
6453 }
6454 else {
6455 sss = ss = s;
6456 while ( *s && *s != ',' ) {
6457 if ( *s == '\\' ) { s++; sss = s+1; }
6458 s++;
6459 }
6460 while ( s > sss+1 && ( s[-1] == ' ' || s[-1] == '\t' ) ) s--;
6461 while ( ss < s ) {
6462 if ( to >= stopper ) {
6463 num = to - Out;
6464 WriteString(wtype,Out,num);
6465 to = Out;
6466 }
6467 if ( *ss == '\\' ) ss++;
6468 *to++ = *ss++;
6469 }
6470 }
6471 }
6472 else if ( *fstring == 'X' ) {
6473 fstring++;
6474 if ( cbuf[AM.sbufnum].numrhs > 0 ) {
6475/*
6476 This should be only to the value of AM.oldnumextrasymbols
6477*/
6478 UBYTE *s = GetPreVar(AM.oldnumextrasymbols,0);
6479 WORD x = 0;
6480 while ( *s >= '0' && *s <= '9' ) x = 10*x + *s++ - '0';
6481 if ( x > 0 )
6482 PrintSubtermList(1,x);
6483 else
6484 PrintSubtermList(1,cbuf[AM.sbufnum].numrhs);
6485 }
6486 }
6487 else if ( *fstring == 'O' ) {
6488 number = AO.OutSkip;
6489dooptim:
6490 fstring++;
6491/*
6492 First test whether there is an optimization buffer
6493*/
6494 if ( AO.OptimizeResult.code == NULL && AO.OptimizationLevel != 0 ) {
6495 MesPrint("@In #write instruction: no optimization results available!");
6496 return(-1);
6497 }
6498 num = to - Out;
6499 WriteString(wtype,Out,num);
6500 to = Out;
6501 if ( AO.OptimizationLevel != 0 ) {
6502 WORD oldoutskip = AO.OutSkip;
6503 AO.OutSkip = number;
6504 optimize_print_code(0);
6505 AO.OutSkip = oldoutskip;
6506 }
6507 }
6508 else if ( *fstring == 'e' || *fstring == 'E' ) {
6509 if ( *fstring == 'E'
6510 || AC.OutputMode == FORTRANMODE
6511 || AC.OutputMode == PFORTRANMODE ) nosemi = 1;
6512 else nosemi = 0;
6513 fstring++;
6514 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6515 if ( chartype[*s] != 0 && *s != '[' ) {
6516noexpr: MesPrint("@expression name expected in #write instruction");
6517 AM.FileOnlyFlag = h->oldlogonly;
6518 AC.LogHandle = h->oldhandle;
6519 AO.PrintType = h->oldprinttype;
6520 AM.silent = h->oldsilent;
6521 return(-1);
6522 }
6523 ss = s;
6524 if ( ( s = SkipAName(ss) ) == 0 || s[-1] == '_' ) goto noexpr;
6525 s1 = s; c = c1 = *s1;
6526 if ( c1 == '(' ) {
6527 SKIPBRA3(s)
6528 if ( *s == ')' ) {
6529 AO.CurBufWrt = s1+1;
6530 c = *s; *s = 0;
6531 }
6532 else {
6533 MesPrint("@Illegal () specifier in expression name in #write");
6534 AM.FileOnlyFlag = h->oldlogonly;
6535 AC.LogHandle = h->oldhandle;
6536 AO.PrintType = h->oldprinttype;
6537 AM.silent = h->oldsilent;
6538 return(-1);
6539 }
6540 }
6541 else AO.CurBufWrt = (UBYTE *)underscore;
6542 *s1 = 0;
6543 num = to - Out;
6544 if ( num > 0 ) WriteUnfinString(wtype,Out,num);
6545 to = Out;
6546 oldOptimizationLevel = AO.OptimizationLevel;
6547 AO.OptimizationLevel = 0;
6548 if ( WriteOne(ss,(int)num,nosemi,plus) < 0 ) {
6549 AM.FileOnlyFlag = h->oldlogonly;
6550 AC.LogHandle = h->oldhandle;
6551 AO.PrintType = h->oldprinttype;
6552 AM.silent = h->oldsilent;
6553 return(-1);
6554 }
6555 AO.OptimizationLevel = oldOptimizationLevel;
6556 *s1 = c1;
6557 if ( s > s1 ) *s++ = c;
6558 }
6559/*
6560 File content
6561*/
6562 else if ( ( *fstring == 'f' ) || ( *fstring == 'F' ) ) {
6563 LONG n;
6564 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
6565 ss = s;
6566 while ( *s && *s != ',' ) {
6567 if ( *s == '\\' ) s++;
6568 s++;
6569 }
6570 c = *s; *s = 0;
6571 s1 = LoadInputFile(ss,HEADERFILE);
6572 *s = c;
6573/*
6574 There should have been a way to pass the file size.
6575 Also there should be conversions for \r\n etc.
6576*/
6577 if ( s1 ) {
6578 ss = s1; while ( *ss ) ss++;
6579 n = ss-s1;
6580 WriteString(wtype,s1,n);
6581 M_free(s1,"copy file");
6582 }
6583 else if ( *fstring == 'F' ) {
6584 *s = 0;
6585 MesPrint("@Error in #write: could not open file %s",ss);
6586 *s = c;
6587 goto ReturnWithError;
6588 }
6589 fstring++;
6590 }
6591 else if ( *fstring == '%' ) {
6592 *to++ = *fstring++;
6593 }
6594 else if ( FG.cTable[*fstring] == 1 ) { /* %#S */
6595 number = 0;
6596 while ( FG.cTable[*fstring] == 1 ) {
6597 number = 10*number + *fstring++ - '0';
6598 }
6599 if ( *fstring == 'O' ) goto dooptim;
6600 else if ( *fstring == 'd' ) goto donumber;
6601 else if ( *fstring == '$' ) goto dodollar;
6602 else if ( *fstring == 't' ) { /* `tab' position */
6603 if ( number < (WORD)(stopper-Out) ) {
6604 while ( (WORD)(to-Out) < number ) *to++ = ' ';
6605 }
6606 fstring++;
6607 }
6608 else if ( *fstring == 'X' || *fstring == 'x' ) {
6609 if ( number > 0 && number <= cbuf[AM.sbufnum].numrhs ) {
6610 UBYTE buffer[80], *out, *old1, *old2, *old3;
6611 WORD *term, first;
6612 if ( *fstring == 'X' ) {
6613 out = StrCopy((UBYTE *)AC.extrasym,buffer);
6614 if ( AC.extrasymbols == 0 ) {
6615 out = NumCopy(number,out);
6616 out = StrCopy((UBYTE *)"_",out);
6617 }
6618 else if ( AC.extrasymbols == 1 ) {
6619 if ( AC.OutputMode == CMODE ) {
6620 out = StrCopy((UBYTE *)"[",out);
6621 out = NumCopy(number,out);
6622 out = StrCopy((UBYTE *)"]",out);
6623 }
6624 else {
6625 out = StrCopy((UBYTE *)"(",out);
6626 out = NumCopy(number,out);
6627 out = StrCopy((UBYTE *)")",out);
6628 }
6629 }
6630 out = StrCopy((UBYTE *)"=",out);
6631 ss = buffer;
6632 while ( ss < out ) {
6633 if ( to >= stopper ) {
6634 num = to - Out;
6635 WriteString(wtype,Out,num);
6636 to = Out;
6637 }
6638 *to++ = *ss++;
6639 }
6640 }
6641 term = cbuf[AM.sbufnum].rhs[number];
6642 first = 1;
6643 if ( *term == 0 ) {
6644 *to++ = '0';
6645 }
6646 else {
6647 old1 = AO.OutFill;
6648 old2 = AO.OutputLine;
6649 old3 = AO.OutStop;
6650 AO.OutFill = to;
6651 AO.OutputLine = Out;
6652 AO.OutStop = Out + AC.LineLength;
6653 while ( *term ) {
6654 if ( WriteInnerTerm(term,first) ) Terminate(-1);
6655 term += *term;
6656 first = 0;
6657 }
6658 to = Out + (AO.OutFill-AO.OutputLine);
6659 AO.OutFill = old1;
6660 AO.OutputLine = old2;
6661 AO.OutStop = old3;
6662 }
6663 }
6664 fstring++;
6665 }
6666 else {
6667 goto IllegControlSequence;
6668 }
6669 }
6670 else if ( *fstring == '+' ) {
6671 plus = 1; goto retry;
6672 }
6673 else if ( *fstring == 0 ) {
6674 *to++ = 0;
6675 }
6676 else {
6677IllegControlSequence:
6678 MesPrint("@Illegal control sequence in format string in #write instruction");
6679ReturnWithError:
6680 AM.FileOnlyFlag = h->oldlogonly;
6681 AC.LogHandle = h->oldhandle;
6682 AO.PrintType = h->oldprinttype;
6683 AM.silent = h->oldsilent;
6684 return(-1);
6685 }
6686 }
6687 else {
6688 *to++ = *fstring++;
6689 }
6690 }
6691/*
6692 Now flush the output
6693*/
6694 num = to - Out;
6695 /*[15apr2004 mt]:*/
6696 if(wtype==EXTERNALCHANNELOUT){
6697 if(num!=0)
6698 WriteUnfinString(wtype,Out,num);
6699 }else
6700 /*:[15apr2004 mt]*/
6701 WriteString(wtype,Out,num);
6702/*
6703 and restore original parameters
6704*/
6705 AM.FileOnlyFlag = h->oldlogonly;
6706 AC.LogHandle = h->oldhandle;
6707 AO.PrintType = h->oldprinttype;
6708 AM.silent = h->oldsilent;
6709 return(0);
6710}
6711
6712/*
6713 #] writeToChannel :
6714 #[ DoFactDollar :
6715
6716 Executes the #factdollar $var
6717 instruction
6718*/
6719
6720int DoFactDollar(UBYTE *s)
6721{
6722 GETIDENTITY
6723 WORD numdollar, *oldworkpointer;
6724
6725 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
6726 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
6727 while ( *s == ' ' || *s == '\t' ) s++;
6728 if ( *s == '$' ) {
6729 if ( GetName(AC.dollarnames,s+1,&numdollar,NOAUTO) != CDOLLAR ) {
6730 MesPrint("@%s is undefined",s);
6731 return(-1);
6732 }
6733 s = SkipAName(s+1);
6734 if ( *s != 0 ) {
6735 MesPrint("@#FactDollar should have a single $variable for its argument");
6736 return(-1);
6737 }
6738 NewSort(BHEAD0);
6739 oldworkpointer = AT.WorkPointer;
6740 if ( DollarFactorize(BHEAD numdollar) ) return(-1);
6741 AT.WorkPointer = oldworkpointer;
6742 LowerSortLevel();
6743 return(0);
6744 }
6745 else if ( ParenthesesTest(s) ) return(-1);
6746 else {
6747 MesPrint("@#FactDollar should have a single $variable for its argument");
6748 return -1;
6749 }
6750}
6751
6752/*
6753 #] DoFactDollar :
6754 #[ GetDollarNumber :
6755*/
6756
6757WORD GetDollarNumber(UBYTE **inp, DOLLARS d)
6758{
6759 UBYTE *s = *inp, c, *name;
6760 WORD number, nfac, *w;
6761 DOLLARS dd;
6762 s++;
6763 if ( *s == '$' ) {
6764 s++; name = s;
6765 while ( FG.cTable[*s] < 2 ) s++;
6766 c = *s; *s = 0;
6767 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6768 MesPrint("@dollar in #write should have been defined previously");
6769 Terminate(-1);
6770 }
6771 *s = c;
6772 dd = Dollars + number;
6773 if ( c == '[' ) {
6774 *inp = s;
6775 nfac = GetDollarNumber(inp,dd);
6776 s = *inp;
6777 if ( *s != ']' ) {
6778 MesPrint("@Illegal factor for dollar variable");
6779 Terminate(-1);
6780 }
6781 *inp = s+1;
6782 if ( nfac == 0 ) {
6783 if ( dd->nfactors > d->nfactors ) {
6784TooBig:
6785 MesPrint("@Factor number for dollar variable too large");
6786 Terminate(-1);
6787 }
6788 return(dd->nfactors);
6789 }
6790 w = dd->factors[nfac-1].where;
6791 if ( w == 0 ) {
6792 if ( dd->factors[nfac-1].value > d->nfactors ||
6793 dd->factors[nfac-1].value < 0 ) goto TooBig;
6794 return(dd->factors[nfac-1].value);
6795 }
6796 if ( *w == 4 && w[4] == 0 && w[3] == 3 && w[2] == 1
6797 && w[1] <= d->nfactors ) return(w[1]);
6798 if ( w[*w] == 0 && w[*w-1] == *w-1 ) goto TooBig;
6799IllNum:
6800 MesPrint("@Illegal factor number for dollar variable");
6801 Terminate(-1);
6802 }
6803 else { /* The dollar should be a number */
6804 if ( dd->type == DOLZERO ) {
6805 return(0);
6806 }
6807 else if ( dd->type == DOLTERMS || dd->type == DOLNUMBER ) {
6808 w = dd->where;
6809 if ( *w == 4 && w[4] == 0 && w[3] == 3 && w[2] == 1
6810 && w[1] <= d->nfactors ) return(w[1]);
6811 if ( w[*w] == 0 && w[*w-1] == *w-1 ) goto TooBig;
6812 goto IllNum;
6813 }
6814 else goto IllNum;
6815 }
6816 }
6817 else if ( FG.cTable[*s] == 1 ) {
6818 WORD x = *s++ - '0';
6819 while ( FG.cTable[*s] == 1 ) {
6820 x = 10*x + *s++ - '0';
6821 if ( x > d->nfactors ) {
6822 MesPrint("@Factor number %d for dollar variable too large",x);
6823 Terminate(-1);
6824 }
6825 }
6826 if ( *s != ']' ) {
6827 MesPrint("@Illegal factor number for dollar variable");
6828 Terminate(-1);
6829 }
6830 s++; *inp = s;
6831 return(x);
6832 }
6833 else {
6834 MesPrint("@Illegal factor indicator for dollar variable");
6835 Terminate(-1);
6836 }
6837 return(-1);
6838}
6839
6840/*
6841 #] GetDollarNumber :
6842 #[ DoSetRandom :
6843
6844 Executes the #SetRandom number
6845*/
6846
6847int DoSetRandom(UBYTE *s)
6848{
6849 ULONG x;
6850 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
6851 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
6852 while ( *s == ' ' || *s == '\t' ) s++;
6853 x = 0;
6854 while ( FG.cTable[*s] == 1 ) {
6855 x = 10*x + (*s++-'0');
6856 }
6857 while ( *s == ' ' || *s == '\t' ) s++;
6858 if ( *s == 0 ) {
6859#ifdef WITHPTHREADS
6860#ifdef WITHSORTBOTS
6861 int id, totnum = MaX(2*AM.totalnumberofthreads-3,AM.totalnumberofthreads);
6862#else
6863 int id, totnum = AM.totalnumberofthreads;
6864#endif
6865 for ( id = 0; id < totnum; id++ ) {
6866 AB[id]->R.wranfseed = x;
6867 if ( AB[id]->R.wranfia ) M_free(AB[id]->R.wranfia,"wranf");
6868 AB[id]->R.wranfia = 0;
6869 }
6870#else
6871 AR.wranfseed = x;
6872 if ( AR.wranfia ) M_free(AR.wranfia,"wranf");
6873 AR.wranfia = 0;
6874#endif
6875 return(0);
6876 }
6877 else {
6878 MesPrint("@proper syntax is #SetRandom number");
6879 return(-1);
6880 }
6881}
6882
6883/*
6884 #] DoSetRandom :
6885 #[ DoOptimize :
6886
6887 Executes the #Optimize(expr) instruction.
6888*/
6889
6890int DoOptimize(UBYTE *s)
6891{
6892 GETIDENTITY
6893 UBYTE *exprname;
6894 WORD numexpr;
6895 int error = 0, i;
6896 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
6897 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
6898 DUMMYUSE(*s)
6899 exprname = s; s = SkipAName(s);
6900 if ( *s != 0 && *s != ';' ) {
6901 MesPrint("@proper syntax is #Optimize,expression");
6902 return(-1);
6903 }
6904 *s = 0;
6905 if ( GetName(AC.exprnames,exprname,&numexpr,NOAUTO) != CEXPRESSION ) {
6906 MesPrint("@%s is not an expression",exprname);
6907 error = 1;
6908 }
6909 else if ( AP.preError == 0 ) {
6910 EXPRESSIONS e = Expressions + numexpr;
6911 POSITION position;
6912 int firstterm;
6913 WORD *term = AT.WorkPointer;
6914 ClearOptimize();
6915 if ( AO.OptimizationLevel == 0 ) return(0);
6916 switch ( e->status ) {
6917 case LOCALEXPRESSION:
6918 case GLOBALEXPRESSION:
6919 break;
6920 default:
6921 MesPrint("@Expression %s is not an active unhidden local or global expression.",exprname);
6922 Terminate(-1);
6923 break;
6924 }
6925#ifdef WITHMPI
6926 if ( PF.me == MASTER )
6927#endif
6928 RevertScratch();
6929 for ( i = NumExpressions-1; i >= 0; i-- ) {
6930 AS.OldOnFile[i] = Expressions[i].onfile;
6931 AS.OldNumFactors[i] = Expressions[i].numfactors;
6932 AS.Oldvflags[i] = Expressions[i].vflags;
6933 Expressions[i].vflags &= ~(ISUNMODIFIED|ISZERO);
6934 }
6935 for ( i = 0; i < NumExpressions; i++ ) {
6936 if ( i == numexpr ) {
6937 PutPreVar(AM.oldnumextrasymbols,
6938 GetPreVar((UBYTE *)"EXTRASYMBOLS_",0),0,1);
6939 Optimize(numexpr, 0);
6940 AO.OptimizeResult.nameofexpr = strDup1(exprname,"optimize expression name");
6941 continue;
6942 }
6943#ifdef WITHMPI
6944 if ( PF.me == MASTER ) {
6945#endif
6946 e = Expressions + i;
6947 switch ( e->status ) {
6948 case LOCALEXPRESSION:
6949 case SKIPLEXPRESSION:
6950 case DROPLEXPRESSION:
6951 case DROPPEDEXPRESSION:
6952 case GLOBALEXPRESSION:
6953 case SKIPGEXPRESSION:
6954 case DROPGEXPRESSION:
6955 case HIDELEXPRESSION:
6956 case HIDEGEXPRESSION:
6957 case DROPHLEXPRESSION:
6958 case DROPHGEXPRESSION:
6959 case INTOHIDELEXPRESSION:
6960 case INTOHIDEGEXPRESSION:
6961 break;
6962 default:
6963 continue;
6964 }
6965 AR.GetFile = 0;
6966 SetScratch(AR.infile,&(e->onfile));
6967 if ( GetTerm(BHEAD term) <= 0 ) {
6968 MesPrint("@Expression %d has problems reading from scratchfile",i);
6969 Terminate(-1);
6970 }
6971 term[3] = i;
6972 AR.DeferFlag = 0;
6973 SeekScratch(AR.outfile,&position);
6974 e->onfile = position;
6975 *AM.S0->sBuffer = 0; firstterm = -1;
6976 do {
6977 WORD *oldipointer = AR.CompressPointer;
6978 WORD *comprtop = AR.ComprTop;
6979 AR.ComprTop = AM.S0->sTop;
6980 AR.CompressPointer = AM.S0->sBuffer;
6981 if ( firstterm > 0 ) {
6982 if ( PutOut(BHEAD term,&position,AR.outfile,1) < 0 ) goto DoSerr;
6983 }
6984 else if ( firstterm < 0 ) {
6985 if ( PutOut(BHEAD term,&position,AR.outfile,0) < 0 ) goto DoSerr;
6986 firstterm++;
6987 }
6988 else {
6989 if ( PutOut(BHEAD term,&position,AR.outfile,-1) < 0 ) goto DoSerr;
6990 firstterm++;
6991 }
6992 AR.CompressPointer = oldipointer;
6993 AR.ComprTop = comprtop;
6994 } while ( GetTerm(BHEAD term) );
6995 if ( FlushOut(&position,AR.outfile,1) ) {
6996DoSerr:
6997 MesPrint("@Expression %d has problems writing to scratchfile",i);
6998 Terminate(-1);
6999 }
7000#ifdef WITHMPI
7001 }
7002#endif
7003 }
7004/*
7005 Now some administration and we are done
7006*/
7007 UpdateMaxSize();
7008 }
7009 else {
7010 ClearOptimize();
7011 }
7012 return(error);
7013
7014}
7015
7016/*
7017 #] DoOptimize :
7018 #[ DoClearOptimize :
7019
7020 Clears all relevant buffers of the output optimization
7021*/
7022
7023int DoClearOptimize(UBYTE *s)
7024{
7025 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7026 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7027 DUMMYUSE(*s);
7028 return(ClearOptimize());
7029}
7030
7031/*
7032 #] DoClearOptimize :
7033 #[ DoSkipExtraSymbols :
7034
7035 Adds the intermediate variables of the previous optimization
7036 to the list of extra symbols, provided it has not yet been erased
7037 by a #clearoptimize
7038 To remove them again one needs to use the 'delete extrasymbols;'
7039 or the 'delete extrasymbols>num;' statement in which num is the
7040 old number of extra symbols.
7041*/
7042
7043int DoSkipExtraSymbols(UBYTE *s)
7044{
7045 CBUF *C = cbuf + AM.sbufnum;
7046 WORD tt = 0, j = 0, oldval = AO.OptimizeResult.minvar;
7047 if ( AO.OptimizeResult.code == NULL ) return(0);
7048 if ( AO.OptimizationLevel == 0 ) return(0);
7049 while ( *s == ',' ) s++;
7050 if ( *s == 0 ) {
7051 AO.OptimizeResult.minvar = AO.OptimizeResult.maxvar+1;
7052 }
7053 else {
7054 while ( *s <= '9' && *s >= '0' ) j = 10*j + *s++ - '0';
7055 if ( *s ) {
7056 MesPrint("@Illegal use of #SkipExtraSymbols instruction");
7057 Terminate(-1);
7058 }
7059 AO.OptimizeResult.minvar += j;
7060 if ( AO.OptimizeResult.minvar > AO.OptimizeResult.maxvar )
7061 AO.OptimizeResult.minvar = AO.OptimizeResult.maxvar+1;
7062 }
7063 j = AO.OptimizeResult.minvar - oldval;
7064 while ( j > 0 ) {
7065 AddRHS(AM.sbufnum,1);
7066 AddNtoC(AM.sbufnum,1,&tt,16);
7067 AddToCB(C,0)
7068 InsTree(AM.sbufnum,C->numrhs);
7069 j--;
7070 }
7071 return(0);
7072}
7073
7074/*
7075 #] DoSkipExtraSymbols :
7076 #[ DoPreReset :
7077
7078 Does a reset of variables.
7079 Currently only the timer (stopwatch) of `timer_'
7080*/
7081
7082int DoPreReset(UBYTE *s)
7083{
7084 UBYTE *ss, c;
7085 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7086 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7087 while ( *s == ' ' || *s == '\t' ) s++;
7088 if ( *s == 0 ) {
7089 MesPrint("@proper syntax is #Reset variable");
7090 return(-1);
7091 }
7092 ss = s;
7093 while ( FG.cTable[*s] == 0 ) s++;
7094 c = *s; *s = 0;
7095 if ( ( StrICmp(ss,(UBYTE *)"timer") == 0 )
7096 || ( StrICmp(ss,(UBYTE *)"stopwatch") == 0 ) ) {
7097 *s = c;
7098 AP.StopWatchZero = GetRunningTime();
7099 return(0);
7100 }
7101 else {
7102 *s = c;
7103 MesPrint("@proper syntax is #Reset variable");
7104 return(-1);
7105 }
7106}
7107
7108/*
7109 #] DoPreReset :
7110 #[ DoPreAppendPath :
7111*/
7112
7113static int DoAddPath(UBYTE *s, int bPrepend)
7114{
7115 /* NOTE: this doesn't support some file systems, e.g., 0x5c with CP932. */
7116
7117 UBYTE *path, *path_end, *current_dir, *current_dir_end, *NewPath, *t;
7118 int bRelative, n;
7119
7120 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7121 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7122
7123 /* Parse the path in the input. */
7124 while ( *s == ' ' || *s == '\t' ) s++; /* skip spaces */
7125 if ( *s == '"' ) { /* the path is given by "..." */
7126 path = ++s;
7127 while ( *s && *s != '"' ) {
7128 if ( SEPARATOR != '\\' && *s == '\\' ) { /* escape character, e.g., "\\\"" */
7129 if ( !s[1] ) goto ImproperPath;
7130 s++;
7131 }
7132 s++;
7133 }
7134 if ( *s != '"' ) goto ImproperPath;
7135 path_end = s++;
7136 }
7137 else {
7138 path = s;
7139 while ( *s && *s != ' ' && *s != '\t' ) {
7140 if ( SEPARATOR != '\\' && *s == '\\' ) { /* escape character, e.g., "\\ " */
7141 if ( !s[1] ) goto ImproperPath;
7142 s++;
7143 }
7144 s++;
7145 }
7146 path_end = s;
7147 }
7148 if ( path == path_end ) goto ImproperPath; /* empty path */
7149 while ( *s == ' ' || *s == '\t' ) s++; /* skip spaces */
7150 if ( *s ) goto ImproperPath; /* extra tokens found */
7151
7152 /* Check if the path is an absolute path. */
7153 bRelative = 1;
7154 if ( path[0] == SEPARATOR ) { /* starts with the directory separator */
7155 bRelative = 0;
7156 }
7157#ifdef WINDOWS
7158 else if ( chartype[path[0]] == 0 && path[1] == ':' ) { /* starts with (drive letter): */
7159 bRelative = 0;
7160 }
7161#endif
7162
7163 /* Get the current file directory when a relative path is given. */
7164 if ( bRelative ) {
7165 if ( !AC.CurrentStream ) goto FileNameUnavailable;
7166 if ( AC.CurrentStream->type != FILESTREAM && AC.CurrentStream->type != REVERSEFILESTREAM ) goto FileNameUnavailable;
7167 if ( !AC.CurrentStream->name ) goto FileNameUnavailable;
7168 s = current_dir = current_dir_end = AC.CurrentStream->name;
7169 while ( *s ) {
7170 if ( SEPARATOR != '\\' && *s == '\\' && s[1] ) { /* escape character, e.g., "\\\"" */
7171 s += 2;
7172 continue;
7173 }
7174 if ( *s == SEPARATOR ) {
7175 current_dir_end = s;
7176 }
7177 s++;
7178 }
7179 }
7180 else {
7181 current_dir = current_dir_end = NULL;
7182 }
7183
7184 /* Allocate a buffer for new AM.Path. */
7185 n = path_end - path;
7186 if ( AM.Path ) n += StrLen(AM.Path) + 1;
7187 if ( current_dir != current_dir_end ) n+= current_dir_end - current_dir + 1;
7188 s = NewPath = (UBYTE *)Malloc1(n + 1,"add path");
7189
7190 /* Construct new FORM path. */
7191 if ( bPrepend ) {
7192 if ( current_dir != current_dir_end ) {
7193 t = current_dir;
7194 while ( t != current_dir_end ) *s++ = *t++;
7195 *s++ = SEPARATOR;
7196 }
7197 t = path;
7198 while ( t != path_end ) *s++ = *t++;
7199 if ( AM.Path ) *s++ = PATHSEPARATOR;
7200 }
7201 if ( AM.Path ) {
7202 t = AM.Path;
7203 while ( *t ) *s++ = *t++;
7204 }
7205 if ( !bPrepend ) {
7206 if ( AM.Path ) *s++ = PATHSEPARATOR;
7207 if ( current_dir != current_dir_end ) {
7208 t = current_dir;
7209 while ( t != current_dir_end ) *s++ = *t++;
7210 *s++ = SEPARATOR;
7211 }
7212 t = path;
7213 while ( t != path_end ) *s++ = *t++;
7214 }
7215 *s = '\0';
7216
7217 /* Update AM.Path. */
7218 if ( AM.Path ) M_free(AM.Path,"add path");
7219 AM.Path = NewPath;
7220
7221 return(0);
7222
7223ImproperPath:
7224 MesPrint("@Improper syntax for %#%sPath", bPrepend ? "Prepend" : "Append");
7225 return(-1);
7226
7227FileNameUnavailable:
7228 /* This may be improved in future. */
7229 MesPrint("@Sorry, %#%sPath can't resolve the current file name from here", bPrepend ? "Prepend" : "Append");
7230 return(-1);
7231}
7232
7240int DoPreAppendPath(UBYTE *s)
7241{
7242 return DoAddPath(s, 0);
7243}
7244
7245/*
7246 #] DoPreAppendPath :
7247 #[ DoPrePrependPath :
7248*/
7249
7257int DoPrePrependPath(UBYTE *s)
7258{
7259 return DoAddPath(s, 1);
7260}
7261
7262/*
7263 #] DoPrePrependPath :
7264 #[ DoTimeOutAfter :
7265
7266 Executes the #timeoutafter number
7267*/
7268
7269int DoTimeOutAfter(UBYTE *s)
7270{
7271#ifdef WITH_ALARM
7272 ULONG x;
7273#else
7274 DUMMYUSE(s);
7275#endif
7276 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7277 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7278#ifdef WITH_ALARM
7279 while ( *s == ' ' || *s == '\t' ) s++;
7280 x = 0;
7281 while ( FG.cTable[*s] == 1 ) {
7282 x = 10*x + (*s++-'0');
7283 }
7284 while ( *s == ' ' || *s == '\t' ) s++;
7285 if ( *s == 0 ) {
7286 alarm(x);
7287 return(0);
7288 }
7289 else {
7290 MesPrint("@proper syntax is #TimeoutAfter number");
7291 return(-1);
7292 }
7293#else
7294 Error0("#timeoutafter not implemented on this computer/system");
7295 return(-1);
7296#endif
7297}
7298
7299/*
7300 #] DoTimeOutAfter :
7301 #[ DoNamespace :
7302
7303 Syntax:
7304 #Namespace name
7305 .....
7306 #use variables
7307 .....
7308 #EndNamespace
7309 Effect:
7310 All variables/expressions defined inside the range of the
7311 namespace get name_ prepended.
7312 This holds also for $-variables, names of procedures and
7313 names of files.
7314 Namespaces can be used in a nested way. cf this_is_deep_x
7315 A leading _ takes the role of what is super:: in some other languages.
7316 Remarks:
7317 Names of preprocessor variables are excluded!
7318 Names of built in objects are excluded! (like sum_, d_ etc.)
7319*/
7320/* UNFINISHED_FEATURE_EXCL_START */
7321int DoNamespace(UBYTE *s)
7322{
7323 UBYTE *s1, *s2, c;
7324 NAMESPACE *namespace;
7325 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7326 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7327 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
7328 if ( FG.cTable[*s] != 0 ) {
7329 MesPrint("@Illegal name in #namespace instruction: %s",s);
7330 return(-1);
7331 }
7332 s1 = s;
7333 while ( FG.cTable[*s1] <= 1 ) s1++;
7334 s2 = s1;
7335 while ( *s2 == ' ' || *s2 == ',' || *s2 == '\t' ) s2++;
7336 if ( *s2 != 0 ) {
7337 MesPrint("@A #namespace instruction can only have one name with only alphanumeric characters.");
7338 return(-1);
7339 }
7340 c = *s1; *s1 = 0;
7341/*
7342 Now we have the name and the statement is legal.
7343 We can proceed creating the namespace and its use tree.
7344*/
7345 namespace = (NAMESPACE *)Malloc1(sizeof(NAMESPACE),"namespace");
7346 namespace->name = strDup1(s,"namespace_name");
7347 namespace->usenames = MakeNameTree();
7348 if ( AP.firstnamespace == 0 ) {
7349 namespace->previous = 0;
7350 namespace->next = 0;
7351 AP.firstnamespace = namespace;
7352 AP.lastnamespace = namespace;
7353 }
7354 else {
7355 AP.lastnamespace->next = namespace;
7356 namespace->next = 0;
7357 namespace->previous = AP.lastnamespace;
7358 AP.lastnamespace = namespace;
7359 }
7360 *s1 = c;
7361 return(0);
7362}
7363/* UNFINISHED_FEATURE_EXCL_STOP */
7364/*
7365 #] DoNamespace :
7366 #[ DoEndNamespace :
7367*/
7368/* UNFINISHED_FEATURE_EXCL_START */
7369int DoEndNamespace(UBYTE *s)
7370{
7371 NAMESPACE *namespace;
7372 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7373 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7374 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
7375 if ( *s != 0 ) {
7376 MesPrint("@Illegal #endnamespace instruction");
7377 return(-1);
7378 }
7379 namespace = AP.lastnamespace;
7380 AP.lastnamespace = namespace->previous;
7381 M_free(namespace->name,"namespace_name");
7382 FreeNameTree(namespace->usenames);
7383 M_free(namespace,"namespace");
7384 return(0);
7385}
7386/* UNFINISHED_FEATURE_EXCL_STOP */
7387/*
7388 #] DoEndNamespace :
7389 #[ SkipName :
7390*/
7391
7392UBYTE *SkipName(UBYTE *s)
7393{
7394 UBYTE *t = s, *s1, c;
7395 int num = 0, block = 0;
7396 if ( *s == '[' ) {
7397straight:
7398 SKIPBRA1(s)
7399 if ( *s == 0 ) {
7400 MesPrint("&Illegal name: '%s'",t);
7401 return(0);
7402 }
7403 s++; s1 = s;
7404 while ( FG.cTable[*s] <= 1 || *s == '_' ) s++;
7405 if ( s1 != s ) goto witherror;
7406 }
7407 else if ( *s == '$' ) {
7408 s++;
7409 while ( *s == '_' ) { s++; num++; }
7410 block = 1;
7411 while ( FG.cTable[*s] <= 1 || *s == '_' ) {
7412 if ( FG.cTable[*s] != 0 && block == 1 ) {
7413blocked:
7414 MesPrint("&Illegally formed name: %s",t);
7415 return(0);
7416 }
7417 if ( *s == '_' ) { num++; block = 1; }
7418 else block = 0;
7419 s++;
7420 }
7421 if ( s[-1] == '_' && num > 1 ) goto built;
7422 }
7423 else if ( FG.cTable[*s] == 0 ) {
7424regular:
7425 while ( FG.cTable[*s] <= 1 || *s == '_' ) {
7426 if ( FG.cTable[*s] != 0 && block == 1 ) goto blocked;
7427 if ( *s == '_' ) { block = 1; num++; }
7428 else block = 0;
7429 s++;
7430 }
7431 if ( *s == '[' ) goto straight;
7432 if ( s[-1] == '_' && num > 1 ) {
7433built:
7434 c = *s; *s = 0;
7435 MesPrint("&Built in objects cannot be part of namespaces: %s",t);
7436 *s = c;
7437 return(0);
7438 }
7439 }
7440 else if ( *s == '_' ) {
7441 while ( *s == '_' ) { s++; num++; }
7442 if ( FG.cTable[*s] == 0 ) { block = 0; goto regular; }
7443 goto witherror;
7444 }
7445 else if ( *s == '@' ) {
7446 s++; block = 1;
7447 if ( *s == '_' || FG.cTable[*s] == 1 ) {
7448 MesPrint("@Illegally formed name: %s",s-1);
7449 }
7450 goto regular;
7451 }
7452 else if ( *s == '#' ) { /* name of a procedure */
7453 s++;
7454 while ( *s == '_' ) { s++; num++; }
7455 block = 1;
7456 while ( FG.cTable[*s] <= 1 || *s == '_' ) {
7457 if ( FG.cTable[*s] != 0 && block == 1 ) goto blocked;
7458 if ( *s == '_' ) { num++; block = 1; }
7459 else block = 0;
7460 s++;
7461 }
7462 if ( s[-1] == '_' ) {
7463witherror:
7464 c = *s; *s = 0;
7465 MesPrint("&Illegally formed name: %s",t);
7466 *s = c;
7467 return(0);
7468 }
7469 }
7470 else if ( *s == '<' ) { /* name of a file. Can be anything (more or less) */
7471 s++;
7472 while ( *s && *s != '>' ) s++;
7473 if ( *s != '>' ) goto witherror;
7474 s++;
7475 }
7476 return(s);
7477}
7478
7479/*
7480 #] SkipName :
7481 #[ ConstructName :
7482
7483 Routine gets a 'raw' name and modifies it if the namespace
7484 settings ask for it. It puts the new name in a buffer that
7485 may be expanded if the names become rather long.
7486 Note that eventually that name needs to be copied, because
7487 we do not allocate new buffers for each name.
7488
7489 type tells what kind of name we look for
7490*/
7491
7492UBYTE *ConstructName(UBYTE *s,UBYTE type)
7493{
7494 int len;
7495 UBYTE *t, *u;
7496 WORD number;
7497 NAMESPACE *namespace;
7498 if ( AP.lastnamespace == 0 ) return(s);
7499 if ( *s == '@' ) return(s+1);
7500 if ( GetName(AP.lastnamespace->usenames,s,&number,NOAUTO) !=
7501 NAMENOTFOUND ) return(s);
7502/*
7503 Now the real stuff
7504 First we have to compute the size of the new name.
7505*/
7506 len = StrLen(s) + 1;
7507 namespace = AP.firstnamespace;
7508 while ( namespace ) {
7509 len += StrLen(namespace->name)+1;
7510 namespace = namespace->previous;
7511 }
7512 if ( len > AP.fullnamesize ) {
7513 while ( len > AP.fullnamesize ) AP.fullnamesize *= 2;
7514 M_free(AP.fullname,"AP.fullname");
7515 AP.fullname = (UBYTE *)Malloc1(AP.fullnamesize*sizeof(UBYTE *),"AP.fullname");
7516 }
7517 namespace = AP.firstnamespace;
7518 t = AP.fullname;
7519 switch ( type ) {
7520 case ' ':
7521 case 0:
7522 while ( namespace ) {
7523 u = namespace->name;
7524 while ( *u ) *t++ = *u++;
7525 *t++ = '_';
7526 namespace = namespace->previous;
7527 }
7528 while ( *s ) *t++ = *s++;
7529 *t = 0;
7530 break;
7531 case '$':
7532 case '#':
7533 *t++ = type;
7534 while ( namespace ) {
7535 u = namespace->name;
7536 while ( *u ) *t++ = *u++;
7537 *t++ = '_';
7538 namespace = namespace->previous;
7539 }
7540 if ( type == '$' ) s++;
7541 while ( *s ) *t++ = *s++;
7542 *t = 0;
7543 break;
7544 case '<':
7545 while ( namespace ) {
7546 u = namespace->name;
7547 while ( *u ) *t++ = *u++;
7548 *t++ = '_';
7549 namespace = namespace->previous;
7550 }
7551 s++;
7552 while ( *s ) *t++ = *s++;
7553 t--; /* strip the '>' */
7554 *t = 0;
7555 break;
7556 default:
7557 MesPrint("&Unrecognized datatype in ConstructName");
7558 *t = 0;
7559 break;
7560 }
7561 return(AP.fullname);
7562}
7563
7564/*
7565 #] ConstructName :
7566 #[ DoUse :
7567
7568 Routine makes (inside the confines of the current namespace)
7569 a list of variables that are excluded from the namespace.
7570 Once the namespace is ended, the list is removed.
7571 The list can include names of variables, dollars and procedures.
7572 Preprocessor variables are excluded from the namespace. Their
7573 inclusion would be too complicated for the input streams.
7574 Note that the preprocessor variables that are arguments in a #do
7575 or in a procedure are on a stack and should not cause problems.
7576 Names of variables can be just that.
7577 Names of $-variables are also straightforward.
7578 Names of procedures should be preceeded by a # character.
7579 Names of files (like in #include) should be enclosed by <>.
7580 The names are stored in a balanced tree. Each namespace may have
7581 its own tree. The toplevel (no namespace) does not allow a #use.
7582*/
7583/* UNFINISHED_FEATURE_EXCL_START */
7584int DoUse(UBYTE *s)
7585{
7586 NAMESPACE *namespace;
7587 UBYTE *t, c;
7588 int number;
7589 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7590 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7591 if ( AP.lastnamespace == 0 ) {
7592 MesPrint("@It is not allowed to use #use outside the scope of a namespace.");
7593 return(-1);
7594 }
7595 namespace = AP.lastnamespace;
7596 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
7597 while ( *s ) {
7598 t = s;
7599 if ( ( s = SkipName(t) ) == 0 ) return(-1);
7600 if ( s == t ) {
7601 MesPrint("@Unrecognized object in #use instruction: %s",t);
7602 return(-1);
7603 }
7604 c = *s; *s = 0;
7605/*
7606 In usenames we only need the names to know whether they are 'protected'.
7607 We need to keep the $, # and <> to avoid potential double names.
7608*/
7609 AddName(namespace->usenames,t,0,0,&number);
7610 *s = c;
7611 while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
7612 }
7613 return(0);
7614}
7615/* UNFINISHED_FEATURE_EXCL_STOP */
7616/*
7617 #] DoUse :
7618 #[ UserFlags :
7619
7620 Syntax:
7621 #ClearFlag number(s),expression(s)
7622 #ClearFlag number(s)
7623 #ClearFlag expression(s)
7624 #ClearFlag
7625 #SetFlag number(s),expression(s)
7626 #SetFlag number(s)
7627 #SetFlag expression(s)
7628 #SetFlag
7629 par == 0: Clear, par == 1: Set.
7630*/
7631/* UNFINISHED_FEATURE_EXCL_START */
7632int UserFlags(UBYTE *s,int par)
7633{
7634 int mask = 0, error = 0, i;
7635 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7636 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7637 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7638 if ( *s == 0 ) { /* Treat all flags in all active expressions */
7639allexpr:
7640 for ( i = 0; i < NumExpressions; i++ ) {
7641 switch ( Expressions[i].status ) {
7642 case UNHIDELEXPRESSION:
7643 case UNHIDEGEXPRESSION:
7644 case INTOHIDELEXPRESSION:
7645 case INTOHIDEGEXPRESSION:
7646 case LOCALEXPRESSION:
7647 case GLOBALEXPRESSION:
7648 case SKIPLEXPRESSION:
7649 case SKIPGEXPRESSION:
7650 case HIDELEXPRESSION:
7651 case HIDEGEXPRESSION:
7652 if ( par == 1 ) Expressions[i].uflags |= ~mask;
7653 else Expressions[i].uflags &= mask;
7654 break;
7655 case DROPPEDEXPRESSION:
7656 case DROPLEXPRESSION:
7657 case DROPGEXPRESSION:
7658 case DROPHLEXPRESSION:
7659 case DROPHGEXPRESSION:
7660 case STOREDEXPRESSION:
7661 case HIDDENLEXPRESSION:
7662 case HIDDENGEXPRESSION:
7663 case SPECTATOREXPRESSION:
7664 default:
7665 break;
7666 }
7667 }
7668 }
7669 else if ( FG.cTable[*s] == 1 ) {
7670 mask = (int)WORDMASK;
7671 while ( FG.cTable[*s] == 1 ) {
7672 int x = 0;
7673 while ( FG.cTable[*s] == 1 ) { x = 10*x + (*s++-'0'); }
7674 if ( x < 1 || x > BITSINWORD ) {
7675 MesPrint("@Illegal number %d for flag in #...Flag instruction",x);
7676 return(1);
7677 }
7678 mask ^= (1<<(x-1));
7679 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7680 }
7681 if ( *s == 0 ) goto allexpr;
7682 }
7683 else { /* Clear all flags in all expressions that are specified */
7684 mask = (int)WORDMASK;
7685 }
7686 while ( *s ) { /* now read the expressions */
7687 UBYTE *s1, c;
7688 WORD num1;
7689 if ( FG.cTable[*s] != 0 && *s != '[' ) goto syntax;
7690 s1 = s; s = SkipAName(s);
7691 c = *s; *s = 0;
7692 if ( GetName(AC.exprnames,s1,&num1,NOAUTO) != CEXPRESSION ) {
7693 MesPrint("@%s is not an active expression",s1);
7694 error = 1;
7695 return(error);
7696 }
7697 switch ( Expressions[num1].status ) {
7698 case UNHIDELEXPRESSION:
7699 case UNHIDEGEXPRESSION:
7700 case INTOHIDELEXPRESSION:
7701 case INTOHIDEGEXPRESSION:
7702 case LOCALEXPRESSION:
7703 case GLOBALEXPRESSION:
7704 case SKIPLEXPRESSION:
7705 case SKIPGEXPRESSION:
7706 case HIDELEXPRESSION:
7707 case HIDEGEXPRESSION:
7708 if ( par == 1 ) Expressions[num1].uflags |= ~mask;
7709 else Expressions[num1].uflags &= mask;
7710 break;
7711 case DROPPEDEXPRESSION:
7712 case DROPLEXPRESSION:
7713 case DROPGEXPRESSION:
7714 case DROPHLEXPRESSION:
7715 case DROPHGEXPRESSION:
7716 case STOREDEXPRESSION:
7717 case HIDDENLEXPRESSION:
7718 case HIDDENGEXPRESSION:
7719 case SPECTATOREXPRESSION:
7720 default:
7721 MesPrint("@%s is not an active expression",s1);
7722 error = 1;
7723 break;
7724 }
7725 *s = c;
7726 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7727 }
7728 return(error);
7729syntax:
7730 MesPrint("@Illegal name in #...Flag instruction.");
7731 return(1);
7732}
7733/* UNFINISHED_FEATURE_EXCL_STOP */
7734/*
7735 #] UserFlags :
7736 #[ DoClearUserFlag :
7737*/
7738/* UNFINISHED_FEATURE_EXCL_START */
7739int DoClearUserFlag(UBYTE *s)
7740{
7741 return(UserFlags(s,0));
7742}
7743/* UNFINISHED_FEATURE_EXCL_STOP */
7744/*
7745 #] DoClearUserFlag :
7746 #[ DoSetUserFlag :
7747*/
7748/* UNFINISHED_FEATURE_EXCL_START */
7749int DoSetUserFlag(UBYTE *s)
7750{
7751 return(UserFlags(s,1));
7752}
7753/* UNFINISHED_FEATURE_EXCL_STOP */
7754/*
7755 #] DoSetUserFlag :
7756 #[ DoStartFloat :
7757
7758 If there is a number follwing, it will be the new default precision.
7759 If float has been started before, the old one will be removed first.
7760 If there are two numbers, the second one is the maximum weight for
7761 MZV's.
7762*/
7763#ifdef WITHFLOAT
7764
7765int DoStartFloat(UBYTE *s)
7766{
7767 GETIDENTITY
7768 int error = 0;
7769 LONG x;
7770 UBYTE *ss;
7771 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7772 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7773 if ( AR.PolyFun != 0 ) {
7774 MesPrint("@Simultaneous use of Poly(Rat)Fun and float_ is not allowed.");
7775 error = 1;
7776 }
7777 if ( AC.ncmod != 0 ) {
7778 MesPrint("@Simultaneous use of floating point and modulus arithmetic makes no sense.");
7779 error = 1;
7780 }
7781 if ( AT.aux_ ) { // First, we clean up any previous floating point system.
7782 ClearfFloat();
7783 ClearMZVTables();
7784 }
7785 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7786/*
7787 The first parameter is the float precision
7788*/
7789 ss = s;
7790 if ( *s >= '0' && *s <= '9' ) {
7791 x = 0;
7792 do {
7793 x = 10*x + (*s++-'0');
7794 } while ( *s >= '0' && *s <= '9' );
7795/*
7796 The precision can either be in digits or bits.
7797 AC.DefaultPrecision is always in bits.
7798*/
7799 if ( tolower(*s) == 'd' ) { AC.tDefaultPrecision = (LONG)ceil(x*log2(10.0)); s++; }
7800 else if ( tolower(*s) == 'b' ) { AC.tDefaultPrecision = x; s++; }
7801 else goto IllPar;
7802 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7803/*
7804 The second parameter is either absent, which implies zero MZV weight,
7805 or of the form MZV = <weight>
7806*/
7807 if ( tolower(*s) == 'm' && tolower(s[1]) == 'z' && tolower(s[2]) == 'v') {
7808 s+=3;
7809 while ( *s == ' ' || *s == '\t' ) s++;
7810 if ( *s != '=') goto IllPar;
7811 s++;
7812 while ( *s == ' ' || *s == '\t' ) s++;
7813 if ( *s >= '0' && *s <= '9' ) {
7814 x = 0;
7815 do {
7816 x = 10*x + (*s++ - '0');
7817 } while ( *s >= '0' && *s <= '9' );
7818 AC.tMaxWeight = x;
7819 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7820 }
7821 else goto IllPar;
7822 }
7823 else {
7824 AC.tMaxWeight = 0;
7825 }
7826 if ( *s ) goto IllPar;
7827 }
7828 else if ( *s != 0 ) {
7829IllPar:
7830 MesPrint("@Illegal parameter in %#StartFloat: %s ",ss);
7831 error = 1;
7832 }
7833 if ( error == 0 ) {
7834 if ( AC.tDefaultPrecision && ( AC.tDefaultPrecision != AC.DefaultPrecision
7835 || AT.aux_ == 0 ) ) {
7836 AC.DefaultPrecision = AC.tDefaultPrecision;
7837 AC.tDefaultPrecision = 0;
7838 }
7839 if ( AC.tMaxWeight && ( AC.tMaxWeight != AC.MaxWeight
7840 || AT.aux_ == 0 ) ) {
7841 AC.MaxWeight = AC.tMaxWeight;
7842 AC.tMaxWeight = 0;
7843 }
7844 SetFloatPrecision(AC.DefaultPrecision+AC.MaxWeight+1);
7845 SetupMPFTables();
7846 if ( AC.MaxWeight > 0 ) SetupMZVTables();
7847 SetfFloatPrecision(AC.DefaultPrecision);
7848 }
7849 else {
7850 AC.tDefaultPrecision = 0;
7851 AC.tMaxWeight = 0;
7852 }
7853 return(error);
7854}
7855
7856#endif
7857/*
7858 #] DoStartFloat :
7859 #[ DoEndFloat :
7860*/
7861#ifdef WITHFLOAT
7862
7863int DoEndFloat(UBYTE *s)
7864{
7865 int error = 0;
7866 if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0);
7867 if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0);
7868 while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
7869 if ( *s != 0 ) {
7870 MesPrint("@Illegal parameter in %#EndFloat instruction: %s ",s);
7871 error = 1;
7872 }
7873 if ( error == 0 ) {
7874 ClearfFloat();
7875 ClearMZVTables();
7876 }
7877 return(error);
7878}
7879
7880#endif
7881/*
7882 #] DoEndFloat :
7883 # ] PreProcessor :
7884*/
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:214
AddNtoC
int AddNtoC(int bufnum, int n, WORD *array, int par)
Definition comtool.c:317
clearcbuf
void clearcbuf(WORD num)
Definition comtool.c:116
GetFirstTerm
int GetFirstTerm(WORD *, int, int)
Definition execute.c:1966
optimize_print_code
void optimize_print_code(int)
Definition optimize.cc:4524
AddPotModdollar
void AddPotModdollar(WORD)
Definition dollar.c:3940
PutOut
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
Definition sort.c:1203
EndSort
LONG EndSort(PHEAD WORD *, int)
Definition sort.c:486
Generator
int Generator(PHEAD WORD *, WORD)
Definition proces.c:3255
LowerSortLevel
void LowerSortLevel(void)
Definition sort.c:4703
EndOfToken
UBYTE * EndOfToken(UBYTE *)
Definition tools.c:1934
ClearOptimize
int ClearOptimize(void)
Definition optimize.cc:4974
NewSort
int NewSort(PHEAD0)
Definition sort.c:395
Optimize
int Optimize(WORD, int)
Definition optimize.cc:4637
FlushOut
int FlushOut(POSITION *, FILEHANDLE *, int)
Definition sort.c:1565
TimeCPU
LONG TimeCPU(WORD)
Definition tools.c:3489
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:2809
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:7240
DoPrePrependPath
int DoPrePrependPath(UBYTE *s)
Definition pre.c:7257
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