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