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