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