?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
forgotten commit. disabled until egl is adapted.
[AROS-Contrib.git] / regina / yaccsrc.y
blob830b60d0988b6b245e07fca8a3998a81c53aa2ab
1 %{
2
3 #ifndef lint
4 static char *RCSid = "$Id$";
5 #endif
6
7 /*
8 * The Regina Rexx Interpreter
9 * Copyright (C) 1992-1994 Anders Christensen <anders@pvv.unit.no>
10 *
11 * This library is free software; you can redistribute it and/or
12 * modify it under the terms of the GNU Library General Public
13 * License as published by the Free Software Foundation; either
14 * version 2 of the License, or (at your option) any later version.
15 *
16 * This library is distributed in the hope that it will be useful,
17 * but WITHOUT ANY WARRANTY; without even the implied warranty of
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 * Library General Public License for more details.
20 *
21 * You should have received a copy of the GNU Library General Public
22 * License along with this library; if not, write to the Free
23 * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24 */
25
26 #include "rexx.h"
27 #include <time.h>
28
29 #if defined(HAVE_MALLOC_H)
30 # include <malloc.h>
31 #endif
32
33 #if defined(HAVE_ALLOCA_H)
34 # include <alloca.h>
35 #endif
36
37 #include <stdarg.h>
38 #include <stdio.h>
39 #include <string.h>
40 #include <assert.h>
41
42 #if defined(_MSC_VER) || defined(MAC)
43 # define __STDC__ 1 /* Hack to allow const since it is not defined */
44 #endif
45
46 #define YYSTYPE nodeptr
47
48 /* locals, they are protected by regina_parser (see lexsrc.l) */
49 static int tmplno, /* lineno of current instruction */
50 tmpchr, /* character position of current instruction */
51 level, /* nested do/if/select depth */
52 start_parendepth; /* see below at parendepth */
53
54 /*
55 * parendepth regulates the action which happens detecting a comma or an
56 * empty expression. A negative values indicates an error; both a comma
57 * and an empty expression raise an error.
58 * We regulate the enumeration of arguments with this semantical flag.
59 * Look at "call subroutine args" and "function args". Function itself
60 * contains a parentheses pair, so starting with a depth of just allows
61 * the enumeration. subroutine starts with either 0 or 1. The latter one
62 * is allowed for the support request of "call subroutine(a,b,c)" which
63 * isn't allowed by ANSI but can be enabled for backward compatibility.
64 */
65 static int parendepth;
66
67 static nodeptr current, with = NULL;
68
69 static char *nullptr = NULL; /* for C++ compilation */
70
71 typedef enum { IS_UNKNOWN,
72 IS_A_NUMBER,
73 IS_NO_NUMBER,
74 IS_SIM_SYMBOL,
75 IS_COMP_SYMBOL } node_type;
76
77 typedef enum { REDUCE_CALL,
78 REDUCE_EXPR,
79 REDUCE_RIGHT,
80 REDUCE_SUBEXPR } reduce_mode;
81
82 static node_type gettypeof( nodeptr thisptr ) ;
83 static void checkconst( nodeptr thisptr ) ;
84 static nodeptr reduce_expr_list( nodeptr thisptr, reduce_mode mode );
85 static void transform( nodeptr thisptr ) ;
86 static nodeptr create_head( const char *name ) ;
87 static nodeptr makenode( int type, int numb, ... ) ;
88 static void checkdosyntax( cnodeptr thisptr ) ;
89 void newlabel( const tsd_t *TSD, internal_parser_type *ipt, nodeptr thisptr ) ;
90 static nodeptr optgluelast( nodeptr p1, nodeptr p2 );
91 static void move_labels( nodeptr front, nodeptr end, int level );
92
93 #define IS_EXPRLIST(x) ( ( (x) != NULL ) \
94 && ( ( (x)->type == X_CEXPRLIST ) \
95 || ( (x)->type == X_EXPRLIST ) ) )
96
97 #define IS_FUNCTION(x) ( ( (x) != NULL ) \
98 && ( ( (x)->type == X_EX_FUNC ) \
99 || ( (x)->type == X_IN_FUNC ) ) )
100
101 #define AUTO_REDUCE(x,y) { if ( parendepth == 1 ) \
102 { \
103 x = reduce_expr_list( x, REDUCE_EXPR ); \
104 /* detect "call s (a,b)<op>" and */ \
105 /* "call s ()<op>" */ \
106 if ( IS_EXPRLIST( x ) ) \
107 { \
108 if ( (y) != NULL ) \
109 exiterror( ERR_INVALID_EXPRESSION, 1, y ); \
110 else if ( (x)->p[0] == NULL ) \
111 exiterror( ERR_UNEXPECTED_PARAN, 0 ); \
112 else \
113 exiterror( ERR_UNEXPECTED_PARAN, 1 ); \
114 } \
115 } \
116 }
117 %}
118
119 %token ADDRESS ARG CALL DO TO BY FOR WHILE UNTIL EXIT IF THEN ELSE
120 %token ITERATE INTERPRET LEAVE NOP NUMERIC PARSE EXTERNAL SOURCE VAR
121 %token VALUE WITH PROCEDURE EXPOSE PULL PUSH QUEUE SAY RETURN SELECT
122 %token WHEN DROP OTHERWISE SIGNAL ON OFF ERROR SYNTAX HALT NOVALUE
123 %token TRACE END UPPER ASSIGNMENTVARIABLE STATSEP FOREVER DIGITS FORM
124 %token FUZZ SCIENTIFIC ENGINEERING NOT CONCATENATE MODULUS GTE GT LTE
125 %token LT DIFFERENT EQUALEQUAL NOTEQUALEQUAL OFFSET SPACE EXP XOR
126 %token PLACEHOLDER NOTREADY CONSYMBOL SIMSYMBOL EXFUNCNAME INFUNCNAME
127 %token LABEL DOVARIABLE HEXSTRING STRING VERSION LINEIN WHATEVER NAME
128 %token FAILURE BINSTRING OPTIONS ENVIRONMENT LOSTDIGITS
129 %token GTGT LTLT NOTGTGT NOTLTLT GTGTE LTLTE
130 %token INPUT OUTPUT ERROR NORMAL APPEND REPLACE STREAM STEM LIFO FIFO
131 %token LOWER CASELESS
132
133 %start start
134
135 %left '|' XOR
136 %left '&'
137 %left '=' DIFFERENT GTE GT LT LTE EQUALEQUAL NOTEQUALEQUAL GTGT LTLT NOTGTGT NOTLTLT GTGTE LTLTE
138 %left CONCATENATE SPACE CCAT
139 %left '+' '-'
140 %left '*' '/' '%' MODULUS
141 %left EXP
142 %left UMINUS UPLUS NOT /*UPLUS and UMINUS are locally used to assign precedence*/
143
144 %nonassoc THEN
145 %nonassoc ELSE
146
147 %right STATSEP
148
149 %{
150 #ifdef NDEBUG
151 # define YYDEBUG 0
152 #else
153 # define YYDEBUG 1
154 #endif
155 %}
156
157 %%
158
159 start : { level = 0;
160 if ( get_options_flag( parser_data.TSD->currlevel, EXT_CALLS_AS_FUNCS )
161 && !get_options_flag( parser_data.TSD->currlevel, EXT_STRICT_ANSI ) )
162 start_parendepth = 1;
163 else
164 start_parendepth = 0;
165 parendepth = 0; }
166 prog
167 ;
168
169 prog : nlncl stats { $$ = optgluelast( $1, $2 );
170 $$->o.last = NULL;
171 EndProg( $$ ) ; }
172 | nlncl { $$ = $1;
173 if ( $$ != NULL )
174 $$->o.last = NULL;
175 EndProg( $$ ); }
176 ;
177
178 stats : stats ystatement { /* fixes bug 579711 */
179 $$ = optgluelast( $1, $2 ); }
180 | ystatement { $$ = $1; }
181 ;
182
183 xstats : xstats statement { /* fixes bug 579711 */
184 $$ = optgluelast( $1, $2 ); }
185 | statement gruff { $$ = $1; }
186 ;
187
188 ystatement : statement { $$ = $1 ; }
189 | lonely_end { exiterror( ERR_UNMATCHED_END, 1 ); }
190 ;
191
192 lonely_end : gruff end ncl /* ncl's label's out of matter, this
193 * rule leads to an error.
194 */
195 ;
196
197 nxstats : xstats { $$ = $1; }
198 | gruff { $$ = NULL; }
199 ;
200
201 ncl : ncl STATSEP optLabels { $$ = optgluelast( $1, $3 ); }
202 | STATSEP optLabels { $$ = $2; }
203 ;
204
205 nlncl : optLabels ncl { $$ = optgluelast( $1, $2 ); }
206 | optLabels { $$ = $1; }
207 ;
208
209 optLabels : optLabels label_stat { $$ = optgluelast( $1, $2 ); }
210 | { $$ = NULL; }
211 ;
212
213 statement : mttstatement
214 | ex_when_stat
215 ;
216
217 gruff : { tmpchr=parser_data.tstart;
218 tmplno=parser_data.tline; }
219 ;
220
221 mttstatement : gruff mtstatement { $$=$2; }
222 ;
223
224 mtstatement : nclstatement ncl { $$ = optgluelast( $1, $2 ); }
225 | if_stat
226 | unexp_then
227 | unexp_else
228 ;
229
230 nclstatement : address_stat
231 | expr_stat
232 | arg_stat
233 | call_stat
234 | do_stat
235 | drop_stat
236 | exit_stat
237 | ipret_stat
238 | iterate_stat
239 | leave_stat
240 | nop_stat
241 | numeric_stat
242 | options_stat
243 | parse_stat
244 | proc_stat
245 | pull_stat
246 | push_stat
247 | queue_stat
248 | return_stat
249 | say_stat
250 | select_stat
251 | signal_stat
252 | trace_stat
253 | upper_stat
254 | assignment
255 ;
256
257 call : CALL { $$ = makenode(X_CALL,0) ;
258 $$->lineno = parser_data.tline ;
259 $$->charnr = parser_data.tstart ; }
260 ;
261 do : DO { $$ = makenode(X_DO,0) ;
262 $$->lineno = parser_data.tline ;
263 $$->charnr = parser_data.tstart ;
264 level++; }
265 ;
266 exit : EXIT { $$ = makenode(X_EXIT,0) ;
267 $$->lineno = parser_data.tline ;
268 $$->charnr = parser_data.tstart ; }
269 ;
270 if : IF { $$ = makenode(X_IF,0) ;
271 $$->lineno = parser_data.tline ;
272 $$->charnr = parser_data.tstart ;
273 level++; }
274 ;
275 iterate : ITERATE { $$ = makenode(X_ITERATE,0) ;
276 $$->lineno = parser_data.tline ;
277 $$->charnr = parser_data.tstart ; }
278 ;
279 leave : LEAVE { $$ = makenode(X_LEAVE,0) ;
280 $$->lineno = parser_data.tline ;
281 $$->charnr = parser_data.tstart ; }
282 ;
283 say : SAY { $$ = makenode(X_SAY,0) ;
284 $$->lineno = parser_data.tline ;
285 $$->charnr = parser_data.tstart ; }
286 ;
287 return : RETURN { $$ = makenode(X_RETURN,0) ;
288 $$->lineno = parser_data.tline ;
289 $$->charnr = parser_data.tstart ; }
290 ;
291 address : ADDRESS { $$ = makenode(X_ADDR_N,0) ;
292 $$->lineno = parser_data.tline ;
293 $$->charnr = parser_data.tstart ; }
294 ;
295 arg : ARG { $$ = makenode(X_PARSE_ARG,0) ;
296 $$->lineno = parser_data.tline ;
297 $$->charnr = parser_data.tstart ; }
298 ;
299 drop : DROP { $$ = makenode(X_DROP,0) ;
300 $$->lineno = parser_data.tline ;
301 $$->charnr = parser_data.tstart ; }
302 ;
303 interpret : INTERPRET { $$ = makenode(X_IPRET,0) ;
304 $$->lineno = parser_data.tline ;
305 $$->charnr = parser_data.tstart ; }
306 ;
307 label : LABEL { $$ = makenode(X_LABEL,0) ;
308 $$->lineno = parser_data.tline ;
309 $$->charnr = parser_data.tstart ; }
310 ;
311 nop : NOP { $$ = makenode(X_NULL,0) ;
312 $$->lineno = parser_data.tline ;
313 $$->charnr = parser_data.tstart ; }
314 ;
315 numeric : NUMERIC { $$ = makenode(0,0) ;
316 $$->lineno = parser_data.tline ;
317 $$->charnr = parser_data.tstart ; }
318 ;
319 options : OPTIONS { $$ = makenode(X_OPTIONS,0) ;
320 $$->lineno = parser_data.tline ;
321 $$->charnr = parser_data.tstart ; }
322 ;
323 parse : PARSE { $$ = makenode(0,0) ;
324 $$->lineno = parser_data.tline ;
325 $$->charnr = parser_data.tstart ; }
326 ;
327 proc : PROCEDURE { $$ = makenode(X_PROC,0) ;
328 $$->lineno = parser_data.tline ;
329 $$->charnr = parser_data.tstart ; }
330 ;
331 pull : PULL { $$ = makenode(X_PULL,0) ;
332 $$->lineno = parser_data.tline ;
333 $$->charnr = parser_data.tstart ; }
334 ;
335 push : PUSH { $$ = makenode(X_PUSH,0) ;
336 $$->lineno = parser_data.tline ;
337 $$->charnr = parser_data.tstart ; }
338 ;
339 queue : QUEUE { $$ = makenode(X_QUEUE,0) ;
340 $$->lineno = parser_data.tline ;
341 $$->charnr = parser_data.tstart ; }
342 ;
343 select : SELECT { $$ = makenode(X_SELECT,0) ;
344 $$->lineno = parser_data.tline ;
345 $$->charnr = parser_data.tstart ;
346 level++; }
347 ;
348 signal : SIGNAL { $$ = makenode(X_SIG_LAB,0) ;
349 $$->lineno = parser_data.tline ;
350 $$->charnr = parser_data.tstart ; }
351 ;
352 when : WHEN { $$ = makenode(X_WHEN,0) ;
353 $$->lineno = parser_data.tline ;
354 $$->charnr = parser_data.tstart ; }
355 ;
356 otherwise : OTHERWISE { $$ = makenode(X_OTHERWISE,0) ;
357 $$->lineno = parser_data.tline ;
358 $$->charnr = parser_data.tstart ; }
359 ;
360 trace : TRACE { $$ = makenode(X_TRACE,0) ;
361 $$->lineno = parser_data.tline ;
362 $$->charnr = parser_data.tstart ; }
363 ;
364 upper : UPPER { $$ = makenode(X_UPPER_VAR,0) ;
365 $$->lineno = parser_data.tline ;
366 $$->charnr = parser_data.tstart ; }
367 ;
368 address_stat : address { $$ = current = $1 ; }
369 address_stat2
370 ;
371
372 address_stat2: VALUE expr naddr_with { current->type = X_ADDR_V ;
373 current->p[0] = $2 ;
374 current->p[1] = $3 ; }
375 | addr_with { exiterror( ERR_STRING_EXPECTED, 1, __reginatext ) ;}
376 | { current->type = X_ADDR_S ; }
377 | error { exiterror( ERR_STRING_EXPECTED, 1, __reginatext ) ;}
378 naddr_with
379 | nvir nexpr naddr_with { current->name = (streng *)$1 ;
380 current->type = X_ADDR_N ;
381 current->p[0] = $2 ;
382 current->p[1] = $3 ; }
383 | '(' expr ')' nspace naddr_with { current->type = X_ADDR_V ;
384 current->p[0] = $2 ;
385 current->p[1] = $5 ;
386 current->u.nonansi = 1 ; }
387 ;
388
389 arg_stat : arg templs { $$ = makenode( X_PARSE, 2, $1, $2 );
390 $$->u.parseflags = PARSE_UPPER;
391 $$->lineno = $1->lineno;
392 $$->charnr = $1->charnr; }
393 ;
394
395 call_stat : call call_name { parendepth = start_parendepth; }
396 call_args { $$ = $1;
397 $$->p[0] = $4;
398 $$->name = (streng *) $2;
399 parendepth = 0; }
400 | call string { parendepth = start_parendepth; }
401 call_args { $$ = $1;
402 $$->type = X_EX_FUNC;
403 $$->p[0] = $4;
404 $$->name = (streng *) $2;
405 parendepth = 0; }
406 | call on error { exiterror( ERR_INV_SUBKEYWORD, 1, "ERROR FAILURE HALT NOTREADY", __reginatext ) ;}
407 | call off error { exiterror( ERR_INV_SUBKEYWORD, 2, "ERROR FAILURE HALT NOTREADY", __reginatext ) ;}
408 | call on c_action error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
409 | call on c_action namespec error { exiterror( ERR_STRING_EXPECTED, 3, __reginatext ) ;}
410 | call on c_action namespec
411 { $$ = $1 ;
412 $$->type = X_CALL_SET ;
413 $$->p[0] = $2 ;
414 $$->name = (streng *)$4 ;
415 $$->p[1] = $3 ; }
416 | call on c_action { $$ = $1 ;
417 $$->type = X_CALL_SET ;
418 $$->p[0] = $2 ;
419 $$->name = NULL ;
420 $$->p[1] = $3 ; }
421 | call off c_action error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
422 | call off c_action { $$ = $1 ;
423 $$->type = X_CALL_SET ;
424 $$->p[0] = $2 ;
425 $$->p[1] = $3 ; }
426 ;
427
428 call_name : asymbol { $$ = $1; }
429 | error { exiterror( ERR_STRING_EXPECTED, 2, __reginatext );}
430 ;
431
432 call_args : exprs {
433 /*
434 * "call_args" accepted probably with
435 * surrounding parentheses. Strip them.
436 */
437 $$ = reduce_expr_list( $1,
438 REDUCE_CALL );
439 }
440 | exprs ')' { exiterror(ERR_UNEXPECTED_PARAN, 2); }
441 ;
442
443 expr_stat : expr { $$ = makenode(X_COMMAND,0) ;
444 $$->charnr = tmpchr ;
445 $$->lineno = tmplno;
446 $$->p[0] = $1 ; }
447 ;
448
449 end_stat : END { $$ = makenode(X_END,0) ;
450 $$->lineno = parser_data.tline ;
451 $$->charnr = parser_data.tstart ;
452 level--; }
453 ;
454
455 end : end_stat simsymb { $$ = $1 ;
456 $$->name = (streng*)($2) ; }
457 | end_stat { $$ = $1 ; }
458 | end_stat simsymb error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
459 ;
460
461 do_stat : do repetitor conditional ncl nxstats end
462 { $$ = $1;
463 $$->p[0] = $2;
464 $$->p[1] = $3;
465 $$->p[2] = optgluelast( $4, $5 );
466 if ( $$->p[2] )
467 $$->p[2]->o.last = NULL;
468 $$->p[3] = $6;
469 if (($$->p[0]==NULL || $$->p[0]->name==NULL)
470 && $$->p[3]->name)
471 exiterror( ERR_UNMATCHED_END, 0 );
472 if (($$->p[0])&&($$->p[0]->name)&&
473 ($$->p[3]->name)&&
474 (($$->p[3]->name->len != $$->p[0]->name->len)||
475 (strncmp($$->p[3]->name->value,
476 $$->p[0]->name->value,
477 $$->p[0]->name->len))))
478 exiterror( ERR_UNMATCHED_END, 0 );
479 }
480 ;
481
482 repetitor : dovar '=' expr nspace tobyfor tobyfor tobyfor
483 { $$ =makenode(X_REP,4,$3,$5,$6,$7) ;
484 $$->name = (streng *)$1 ;
485 checkdosyntax($$) ; }
486 | dovar '=' expr nspace tobyfor tobyfor
487 { $$ =makenode(X_REP,3,$3,$5,$6) ;
488 $$->name = (streng *)$1 ;
489 checkdosyntax($$) ; }
490 | dovar '=' expr nspace tobyfor
491 { $$ = makenode(X_REP,2,$3,$5) ;
492 $$->name = (streng *)$1 ;
493 checkdosyntax($$) ; }
494 | dovar '=' expr nspace { $$ = makenode(X_REP,1,$3) ;
495 $$->name = (streng *)$1 ;
496 checkdosyntax($$) ; }
497 | FOREVER nspace { $$ = makenode(X_REP_FOREVER,0) ; }
498 | FOREVER error { exiterror( ERR_INV_SUBKEYWORD, 16, "WHILE UNTIL", __reginatext ) ; }
499 | expr nspace { $1 = makenode(X_DO_EXPR,1,$1) ;
500 $$ = makenode(X_REP,2,NULL,$1) ; }
501 | { $$ = NULL ; }
502 ;
503
504 nvir : CONSYMBOL { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
505 | SIMSYMBOL { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
506 | STRING { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
507 ;
508
509 naddr_with : { SymbolDetect |= SD_ADDRWITH ;
510 $$ = with = makenode(X_ADDR_WITH,0) ;
511 $$->lineno = parser_data.tline ;
512 $$->charnr = parser_data.tstart ; }
513 addr_with { with = NULL ;
514 SymbolDetect &= ~SD_ADDRWITH ; }
515 | { $$ = NULL ; }
516 ;
517
518 addr_with : WITH connection { $$ = $2; }
519 | WITH connection error { exiterror( ERR_INV_SUBKEYWORD, 5, __reginatext ) ; }
520 | WITH nspace { exiterror( ERR_INV_SUBKEYWORD, 5, __reginatext ) ; }
521 ;
522
523 connection : inputstmts
524 | outputstmts
525 | errorstmts
526 | error { exiterror( ERR_INV_SUBKEYWORD, 5, __reginatext ) ; }
527 ;
528
529 inputstmts : inputstmt
530 adeo
531 ;
532
533 outputstmts : outputstmt
534 adei
535 ;
536
537 errorstmts : errorstmt
538 adio
539 ;
540
541 adeo : outputstmt nspace
542 | outputstmt errorstmt nspace
543 | errorstmt nspace
544 | errorstmt outputstmt nspace
545 | nspace
546 ;
547
548 adei : inputstmt nspace
549 | inputstmt errorstmt nspace
550 | errorstmt nspace
551 | errorstmt inputstmt nspace
552 | nspace
553 ;
554
555 adio : inputstmt nspace
556 | inputstmt outputstmt nspace
557 | outputstmt nspace
558 | outputstmt inputstmt nspace
559 | nspace
560 ;
561
562 inputstmt : nspace INPUT nspace resourcei { with->p[0] = $4; }
563 | nspace INPUT error { exiterror( ERR_INV_SUBKEYWORD, 6, __reginatext ) ; }
564 ;
565
566 outputstmt : nspace OUTPUT nspace resourceo { with->p[1] = $4; }
567 | nspace OUTPUT error { exiterror( ERR_INV_SUBKEYWORD, 7, __reginatext ) ; }
568 ;
569
570 errorstmt : nspace ERROR nspace resourceo { with->p[2] = $4; }
571 | nspace ERROR error { exiterror( ERR_INV_SUBKEYWORD, 14, __reginatext ) ; }
572 ;
573
574 resourcei : resources { $$ = $1 ; }
575 | NORMAL { $$ = makenode(X_ADDR_WITH, 0) ;
576 $$->lineno = parser_data.tline ;
577 $$->charnr = parser_data.tstart ; }
578 ;
579
580 resourceo : resources { $$ = $1 ; }
581 | APPEND resources { $$ = $2 ;
582 $$->u.of.append = 1 ; }
583 | APPEND error { exiterror( ERR_INV_SUBKEYWORD, 8, __reginatext ) ; }
584 | REPLACE resources { $$ = $2 ; }
585 | REPLACE error { exiterror( ERR_INV_SUBKEYWORD, 9, __reginatext ) ; }
586 | NORMAL { $$ = makenode(X_ADDR_WITH, 0) ;
587 $$->lineno = parser_data.tline ;
588 $$->charnr = parser_data.tstart ; }
589 ;
590
591 resources : STREAM nnvir { /* ANSI extension: nsimsymb is
592 * used by the standard, but I think
593 * there are no reasons why using
594 * it here as a must. FGC
595 */
596 $$ = $2 ;
597 $$->u.of.awt = awtSTREAM;
598 SymbolDetect |= SD_ADDRWITH ; }
599 | STREAM error { exiterror( ERR_INVALID_OPTION, 1, __reginatext ) ; }
600 | STEM nsimsymb {
601 streng *tmp = $2->name;
602 char *p;
603
604 /*
605 * expect a single dot as the last character
606 */
607 p = (char *)memchr( tmp->value, '.', tmp->len );
608 if ( p != tmp->value + tmp->len - 1 )
609 exiterror( ERR_INVALID_OPTION, 3, __reginatext );
610 $$ = $2 ;
611 $$->u.of.awt = awtSTEM ;
612 SymbolDetect |= SD_ADDRWITH ; }
613 | STEM error { exiterror( ERR_INVALID_OPTION, 2, __reginatext ) ; }
614 | LIFO nnvir {
615 $$ = $2 ;
616 $$->u.of.awt = awtLIFO ;
617 SymbolDetect |= SD_ADDRWITH ; }
618 | LIFO error { exiterror( ERR_INVALID_OPTION, 100, __reginatext ) ; }
619 | FIFO nnvir {
620 $$ = $2 ;
621 $$->u.of.awt = awtFIFO ;
622 SymbolDetect |= SD_ADDRWITH ; }
623 | FIFO error { exiterror( ERR_INVALID_OPTION, 101, __reginatext ) ; }
624 ;
625
626 nsimsymb : { SymbolDetect &= ~SD_ADDRWITH ; }
627 nspace addrSim { $$ = $3 ; }
628 ;
629
630 nnvir : { SymbolDetect &= ~SD_ADDRWITH ; }
631 nspace addrAll { $$ = $3 ; }
632 ;
633
634 nspace : SPACE
635 |
636 ;
637
638 addrAll : addrSim { $$ = $1 ; }
639 | addrString { $$ = $1 ; }
640 ;
641
642 addrSim : xsimsymb { $$ = makenode(X_ADDR_WITH, 0) ;
643 $$->name = (streng *) $1 ;
644 $$->lineno = parser_data.tline ;
645 $$->charnr = parser_data.tstart ;
646 $$->u.of.ant = antSIMSYMBOL;
647 }
648 ;
649
650 addrString : string { $$ = makenode(X_ADDR_WITH, 0) ;
651 $$->name = (streng *) $1 ;
652 $$->lineno = parser_data.tline ;
653 $$->charnr = parser_data.tstart ;
654 $$->u.of.ant = antSTRING;
655 }
656 ;
657
658 dovar : DOVARIABLE { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
659 ;
660
661 tobyfor : TO expr nspace { $$ = makenode(X_DO_TO,1,$2) ; }
662 | FOR expr nspace { $$ = makenode(X_DO_FOR,1,$2) ; }
663 | BY expr nspace { $$ = makenode(X_DO_BY,1,$2) ; }
664 ;
665
666 conditional : WHILE expr nspace { $$ = makenode(X_WHILE,1,$2) ; }
667 | UNTIL expr nspace { $$ = makenode(X_UNTIL,1,$2) ; }
668 | { $$ = NULL ; }
669 ;
670
671 drop_stat : drop anyvars error { exiterror( ERR_SYMBOL_EXPECTED, 1, __reginatext ) ;}
672 | drop anyvars { $$ = $1 ;
673 $$->p[0] = $2 ; }
674 ;
675
676 upper_stat : upper anyvars error { exiterror( ERR_SYMBOL_EXPECTED, 1, __reginatext ) ;}
677 | upper anyvars { $$ = $1 ;
678 $$->p[0] = $2 ; }
679 ;
680
681 exit_stat : exit nexpr { $$ = $1 ;
682 $$->p[0] = $2 ; }
683 ;
684
685 if_stat : if expr nlncl THEN nlncl ystatement
686 { move_labels( $1, $6, level - 1 );
687 $$ = $1;
688 $$->p[0] = optgluelast( $2, $3 );
689 $$->p[0]->o.last = NULL;
690 $$->p[1] = optgluelast( $5, $6 );
691 $$->p[1]->o.last = NULL;
692 level--; }
693 | if expr nlncl THEN nlncl ystatement ELSE nlncl ystatement
694 { move_labels( $1, $9, level - 1 );
695 $$ = $1;
696 $$->p[0] = optgluelast( $2, $3 );
697 $$->p[0]->o.last = NULL;
698 $$->p[1] = optgluelast( $5, $6 );
699 $$->p[1]->o.last = NULL;
700 $$->p[2] = optgluelast( $8, $9 );
701 $$->p[2]->o.last = NULL;
702 level--; }
703 | if expr nlncl THEN nlncl ystatement ELSE nlncl error
704 { exiterror( ERR_INCOMPLETE_STRUCT, 4 ) ;}
705 | if expr nlncl THEN nlncl error
706 { exiterror( ERR_INCOMPLETE_STRUCT, 3 ) ;}
707 | if ncl { exiterror( ERR_INCOMPLETE_STRUCT, 0 ) ;}
708 | if expr nlncl error { exiterror( ERR_THEN_EXPECTED, 1, parser_data.if_linenr, __reginatext ) ; }
709 ;
710
711 unexp_then : gruff THEN { exiterror( ERR_THEN_UNEXPECTED, 1 ) ; }
712 ;
713
714 unexp_else : gruff ELSE { exiterror( ERR_THEN_UNEXPECTED, 2 ) ; }
715 ;
716
717 ipret_stat : interpret expr { $$ = $1 ;
718 $$->p[0] = $2 ; }
719 ;
720
721
722 iterate_stat : iterate simsymb { $$ = $1 ;
723 $$->name = (streng *) $2 ; }
724 | iterate simsymb error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
725 | iterate { $$ = $1 ; }
726 ;
727
728 label_stat : labelname { $$ = $1 ;
729 $$->u.trace_only =
730 (level == 0) ? 0 : 1;
731 newlabel( (const tsd_t *)parser_data.TSD,
732 &parser_data,
733 $1 ) ; }
734 ;
735
736 labelname : label { $$ = $1 ;
737 $$->name = Str_cre_TSD(parser_data.TSD,retvalue) ; }
738 ;
739
740 leave_stat : leave simsymb { $$ = $1 ;
741 $$->name = (streng *) $2 ; }
742 | leave simsymb error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
743 | leave { $$ = $1 ; }
744 ;
745
746 nop_stat : nop { $$ = $1 ; }
747 | nop error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
748 ;
749
750 numeric_stat : numeric DIGITS expr { $$ = $1 ;
751 $$->type = X_NUM_D ;
752 $$->p[0] = $3 ; }
753 | numeric DIGITS { $$ = $1; $$->type = X_NUM_DDEF ; }
754 | numeric FORM form_expr error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
755 | numeric FORM form_expr { $$ = $1 ;
756 $$->type = X_NUM_F ;
757 $$->p[0] = $3 ; }
758 | numeric FORM { /* NOTE! This clashes ANSI! */
759 $$ = $1 ; $$->type=X_NUM_FRMDEF ;}
760 | numeric FORM VALUE expr { $$ = $1 ; $$->type=X_NUM_V ;
761 $$->p[0] = $4 ; }
762 | numeric FORM error { exiterror( ERR_INV_SUBKEYWORD, 11, "ENGINEERING SCIENTIFIC", __reginatext ) ;}
763 | numeric FUZZ { $$ = $1; $$->type = X_NUM_FDEF ;}
764 | numeric FUZZ expr { $$ = $1 ;
765 $$->type = X_NUM_FUZZ ;
766 $$->p[0] = $3 ; }
767 | numeric error { exiterror( ERR_INV_SUBKEYWORD, 15, "DIGITS FORM FUZZ", __reginatext ) ;}
768 ;
769
770 form_expr : SCIENTIFIC { $$ = makenode(X_NUM_SCI,0) ; }
771 | ENGINEERING { $$ = makenode(X_NUM_ENG,0) ; }
772 ;
773
774 options_stat : options nexpr { ($$=$1)->p[0]=$2 ; }
775 ;
776
777 parse_stat : parse parse_flags parse_param templs
778 { $$ = $1 ;
779 $$->type = X_PARSE ;
780 $$->u.parseflags = (long) $2 ;
781 $$->p[0] = $3 ;
782 $$->p[1] = $4 ; }
783 | parse parse_param templs
784 { $$ = $1 ;
785 $$->type = X_PARSE ;
786 $$->u.parseflags = 0;
787 $$->p[0] = $2 ;
788 $$->p[1] = $3 ; }
789 | parse parse_flags error { exiterror( ERR_INV_SUBKEYWORD, 12, "ARG EXTERNAL LINEIN PULL SOURCE VAR VALUE VERSION", __reginatext ) ;}
790 | parse error { exiterror( ERR_INV_SUBKEYWORD, 12, "ARG CASELESS EXTERNAL LINEIN LOWER PULL SOURCE UPPER VAR VALUE VERSION", __reginatext ) ;}
791 ;
792
793 parse_flags : UPPER { $$ = (nodeptr) (PARSE_UPPER |
794 PARSE_NORMAL); }
795 | UPPER CASELESS { $$ = (nodeptr) (PARSE_UPPER |
796 PARSE_CASELESS); }
797 | CASELESS UPPER { $$ = (nodeptr) (PARSE_UPPER |
798 PARSE_CASELESS); }
799 | LOWER { $$ = (nodeptr) (PARSE_LOWER |
800 PARSE_NORMAL); }
801 | LOWER CASELESS { $$ = (nodeptr) (PARSE_LOWER |
802 PARSE_CASELESS); }
803 | CASELESS LOWER { $$ = (nodeptr) (PARSE_LOWER |
804 PARSE_CASELESS); }
805 | CASELESS { $$ = (nodeptr) (PARSE_NORMAL |
806 PARSE_CASELESS); }
807 ;
808
809 templs : templs ',' template { /* fixes bugs like bug 579711 */
810 $$ = optgluelast( $1, $3 ); }
811 | template { $$ = $1 ; }
812 ;
813
814 parse_param : ARG { $$ = makenode(X_PARSE_ARG,0) ; }
815 | LINEIN { $$ = makenode(X_PARSE_EXT,0) ; }
816 | EXTERNAL { $$ = makenode(X_PARSE_EXT,0) ; }
817 | VERSION { $$ = makenode(X_PARSE_VER,0) ; }
818 | PULL { $$ = makenode(X_PARSE_PULL,0) ; }
819 | SOURCE { $$ = makenode(X_PARSE_SRC,0) ; }
820 | VAR simsymb { $$ = makenode(X_PARSE_VAR,0) ;
821 $$->name = (streng *) $2 ; }
822 | VALUE nexpr WITH { $$ = makenode(X_PARSE_VAL,1,$2) ; }
823 | VALUE error { exiterror( ERR_INVALID_TEMPLATE, 3 ) ;}
824 ;
825
826 proc_stat : proc { $$ = $1 ; }
827 | proc error { exiterror( ERR_INV_SUBKEYWORD, 17, __reginatext ) ;}
828 | proc EXPOSE error { exiterror( ERR_SYMBOL_EXPECTED, 1, __reginatext ) ;}
829 | proc EXPOSE anyvars error { exiterror( ERR_SYMBOL_EXPECTED, 1, __reginatext ) ;}
830 | proc EXPOSE anyvars { $$ = $1 ;
831 $$->p[0] = $3 ; }
832 ;
833
834 pull_stat : pull template { $$ = $1 ;
835 $$->p[0] = $2 ; }
836 ;
837
838 push_stat : push nexpr { $$ = $1 ;
839 $$->p[0] = $2 ; }
840 ;
841
842 queue_stat : queue nexpr { $$ = $1 ;
843 $$->p[0] = $2 ; }
844 ;
845
846 say_stat : say nexpr { $$ = $1 ;
847 $$->p[0] = $2 ; }
848 ;
849
850 return_stat : return nexpr { $$ = $1 ;
851 $$->p[0] = $2 ; }
852 ;
853
854 sel_end : END simsymb { exiterror( ERR_UNMATCHED_END, 0 ) ;}
855 | END simsymb error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
856 | END { level--; }
857 ;
858
859 select_stat : select ncl when_stats otherwise_stat sel_end
860 { $$ = $1;
861 $$->p[0] = optgluelast( $2, $3 );
862 $$->p[0]->o.last = NULL;
863 $$->p[1] = $4; }
864 | select ncl END error { exiterror( ERR_WHEN_EXPECTED, 0 ) ;}
865 | select ncl otherwise error
866 { exiterror( ERR_WHEN_EXPECTED, 0 ) ;}
867 | select error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
868 | select ncl THEN { exiterror( ERR_THEN_UNEXPECTED, 0 ) ;}
869 | select ncl when_stats otherwise error
870 { exiterror( ERR_INCOMPLETE_STRUCT, 0 ) ;}
871 ;
872
873 when_stats : when_stats when_stat { $$ = optgluelast( $1, $2 ); }
874 | when_stat { $$ = $1 ; }
875 | error { exiterror( ERR_WHEN_EXPECTED, 0 ) ;}
876 ;
877
878 when_stat : when expr nlncl THEN nlncl statement
879 { $$ = $1; /* fixes bugs like bug 579711 */
880 $$->p[0] = optgluelast( $2, $3 );
881 $$->p[0]->o.last = NULL;
882 $$->p[1] = optgluelast( $5, $6 );
883 $$->p[1]->o.last = NULL; }
884 | when expr nlncl THEN nlncl statement THEN
885 { exiterror( ERR_THEN_UNEXPECTED, 0 ) ;}
886 | when expr { exiterror( ERR_THEN_EXPECTED, 2, parser_data.when_linenr, __reginatext ) ; }
887 | when error { exiterror( ERR_INVALID_EXPRESSION, 0 ) ;}
888 ;
889
890 when_or_other: when
891 | otherwise
892 ;
893
894 ex_when_stat : gruff when_or_other { exiterror( ERR_WHEN_UNEXPECTED, 0 ); }
895 ;
896
897 otherwise_stat : otherwise nlncl nxstats { $$ = $1;
898 $$->p[0] = optgluelast( $2, $3 );
899 if ( $$->p[0] )
900 $$->p[0]->o.last = NULL; }
901 | { $$ = makenode(X_NO_OTHERWISE,0) ;
902 $$->lineno = parser_data.tline ;
903 $$->charnr = parser_data.tstart ; }
904 ;
905
906
907 signal_stat : signal VALUE expr { $$ = $1 ;
908 $$->type = X_SIG_VAL ;
909 $$->p[0] = $3 ; }
910 | signal signal_name error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
911 | signal signal_name { $$ = $1 ;
912 $$->name = (streng *)$2 ; }
913 | signal on error { exiterror( ERR_INV_SUBKEYWORD, 3, "ERROR FAILURE HALT NOTREADY NOVALUE SYNTAX LOSTDIGITS", __reginatext ) ;}
914 | signal off error { exiterror( ERR_INV_SUBKEYWORD, 4, "ERROR FAILURE HALT NOTREADY NOVALUE SYNTAX LOSTDIGITS", __reginatext ) ;}
915 | signal on s_action error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
916 | signal on s_action namespec error { exiterror( ERR_STRING_EXPECTED, 3, __reginatext ) ;}
917 | signal on s_action namespec
918 { $$ = $1 ;
919 $$->type = X_SIG_SET ;
920 $$->p[0] = $2 ;
921 $$->name = (streng *)$4 ;
922 $$->p[1] = $3 ; }
923 | signal on s_action { $$ = $1 ;
924 $$->type = X_SIG_SET ;
925 $$->p[0] = $2 ;
926 $$->p[1] = $3 ; }
927 | signal off s_action error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
928 | signal off s_action { $$ = $1 ;
929 $$->type = X_SIG_SET ;
930 $$->p[0] = $2 ;
931 $$->p[1] = $3 ; }
932 ;
933
934 signal_name : asymbol { $$ = $1; }
935 | STRING { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
936 | error { exiterror( ERR_STRING_EXPECTED, 4, __reginatext );}
937 ;
938
939 namespec : NAME SIMSYMBOL { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue);}
940 | NAME error { exiterror( ERR_STRING_EXPECTED, 3, __reginatext ) ;}
941 ;
942
943 asymbol : CONSYMBOL { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
944 | SIMSYMBOL { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
945 ;
946
947 on : ON { $$ = makenode(X_ON,0) ; }
948 ;
949
950 off : OFF { $$ = makenode(X_OFF,0) ; }
951 ;
952
953 c_action : ERROR { $$ = makenode(X_S_ERROR,0) ; }
954 | HALT { $$ = makenode(X_S_HALT,0) ; }
955 | NOTREADY { $$ = makenode(X_S_NOTREADY,0) ; }
956 | FAILURE { $$ = makenode(X_S_FAILURE,0) ; }
957 ;
958
959 s_action : c_action { $$ = $1 ; }
960 | NOVALUE { $$ = makenode(X_S_NOVALUE,0) ; }
961 | SYNTAX { $$ = makenode(X_S_SYNTAX,0) ; }
962 | LOSTDIGITS { $$ = makenode(X_S_LOSTDIGITS,0) ; }
963 ;
964
965 trace_stat : trace VALUE expr { $$ = $1 ;
966 $$->p[0] = $3 ; }
967 | trace expr { $$ = $1 ;
968 $$->p[0] = $2 ; }
969 | trace whatever error { exiterror( ERR_EXTRA_DATA, 1, __reginatext ) ;}
970 | trace whatever { $$ = $1 ;
971 $$->name = (streng *) $2 ; }
972 ;
973
974 whatever : WHATEVER { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
975 ;
976
977
978 assignment : ass_part nexpr { $$ = $1 ;
979 $$->p[1] = $2 ;
980 /*
981 * An assignment is a numerical
982 * assignment if and only if we have
983 * to do a numerical operation, which
984 * is equivalent to the existence of
985 * one more argument to $2.
986 * This fixes bug 720166.
987 */
988 if ($2 &&
989 $2->p[0] &&
990 gettypeof($2) == IS_A_NUMBER)
991 $$->type = X_NASSIGN ; }
992 ;
993
994 ass_part : ASSIGNMENTVARIABLE { $$ = makenode(X_ASSIGN,0) ;
995 $$->charnr = parser_data.tstart ;
996 $$->lineno = parser_data.tline ;
997 $$->p[0] = (nodeptr)create_head( (const char *)retvalue ); }
998 ;
999
1000
1001 expr : '(' { /* We have to accept exprs here even
1002 * if we just want to accept
1003 * '(' expr ')' only. We do this
1004 * because we appect
1005 * "call '(' exprs ')'" too.
1006 * This kann happen only if the
1007 * related control flag parendepth is
1008 * set. But since the parentheses are
1009 * voided just for the outer ones, we
1010 * can reduce the allowness level.
1011 * We don't have to set it back,
1012 * because the outer parentheses
1013 * either is THE one we look for or
1014 * none. This allows a faster error
1015 * detection and that's a good goal.*/
1016 parendepth--; }
1017 exprs_sub { parendepth++;
1018 if ( parendepth == 1 )
1019 {
1020 /* exprs on as-is basis */
1021 $$ = $3;
1022 }
1023 else
1024 {
1025 /* Must already be a plain expr.
1026 * The nexpr part of exprs detects
1027 * mistakes. */
1028 $$ = reduce_expr_list( $3,
1029 REDUCE_EXPR );
1030 if ( $$ == $3 )
1031 exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "Reduction of `exprs' not happened." );
1032 }
1033 }
1034 | expr '+' { parendepth--; }
1035 expr { parendepth++; AUTO_REDUCE( $1, "+" );
1036 $$ = makenode( X_PLUSS, 2, $1, $4 ); }
1037 | expr '-' { parendepth--; }
1038 expr { parendepth++; AUTO_REDUCE( $1, "-" );
1039 $$ = makenode( X_MINUS, 2, $1, $4 ); }
1040 | expr '*' { parendepth--; }
1041 expr { parendepth++; AUTO_REDUCE( $1, "*" );
1042 $$ = makenode( X_MULT, 2, $1, $4 ); }
1043 | '*' { exiterror( ERR_INVALID_EXPRESSION, 1, "*" ); }
1044 | expr '/' { parendepth--; }
1045 expr { parendepth++; AUTO_REDUCE( $1, "/" );
1046 $$ = makenode( X_DEVIDE, 2, $1, $4 ); }
1047 | '/' { exiterror( ERR_INVALID_EXPRESSION, 1, "/" ); }
1048 | expr MODULUS { parendepth--; }
1049 expr { parendepth++; AUTO_REDUCE( $1, "//" );
1050 $$ = makenode( X_MODULUS, 2, $1, $4 ); }
1051 | MODULUS { exiterror( ERR_INVALID_EXPRESSION, 1, "//" ); }
1052 | expr '%' { parendepth--; }
1053 expr { parendepth++; AUTO_REDUCE( $1, "%" );
1054 $$ = makenode( X_INTDIV, 2, $1, $4 ); }
1055 | '%' { exiterror( ERR_INVALID_EXPRESSION, 1, "%" ); }
1056 | expr '|' { parendepth--; }
1057 expr { parendepth++; AUTO_REDUCE( $1, "|" );
1058 $$ = makenode( X_LOG_OR, 2, $1, $4 ); }
1059 | '|' { exiterror( ERR_INVALID_EXPRESSION, 1, "|" ); }
1060 | expr '&' { parendepth--; }
1061 expr { parendepth++; AUTO_REDUCE( $1, "&" );
1062 $$ = makenode( X_LOG_AND, 2, $1, $4 ); }
1063 | '&' { exiterror( ERR_INVALID_EXPRESSION, 1, "&" ); }
1064 | expr XOR { parendepth--; }
1065 expr { parendepth++; AUTO_REDUCE( $1, "&&" );
1066 $$ = makenode( X_LOG_XOR, 2, $1, $4 ); }
1067 | XOR { exiterror( ERR_INVALID_EXPRESSION, 1, "&&" ); }
1068 | expr EXP { parendepth--; }
1069 expr { parendepth++; AUTO_REDUCE( $1, "**" );
1070 $$ = makenode( X_EXP, 2, $1, $4 ); }
1071 | EXP { exiterror( ERR_INVALID_EXPRESSION, 1, "**" ); }
1072 | expr SPACE { parendepth--; }
1073 expr { parendepth++; AUTO_REDUCE( $1, " " );
1074 $$ = makenode( X_SPACE, 2, $1, $4 ); }
1075 | SPACE { exiterror( ERR_INVALID_EXPRESSION, 1, " " ); }
1076 | expr CONCATENATE { parendepth--; }
1077 expr { parendepth++; AUTO_REDUCE( $1, "||" );
1078 $$ = makenode( X_CONCAT, 2, $1, $4 ); }
1079 | CONCATENATE { exiterror( ERR_INVALID_EXPRESSION, 1, "||" ); }
1080 | NOT expr { AUTO_REDUCE( $2, "\\" );
1081 $$ = makenode( X_LOG_NOT, 1, $2 ); }
1082 | NOT { exiterror( ERR_INVALID_EXPRESSION, 1, "\\" ); }
1083 | expr '=' { parendepth--; }
1084 expr { parendepth++; AUTO_REDUCE( $1, "=" );
1085 $$ = makenode( X_EQUAL, 2, $1, $4 );
1086 transform( $$ ); }
1087 | '=' { exiterror( ERR_INVALID_EXPRESSION, 1, "=" ); }
1088 | expr GTE { parendepth--; }
1089 expr { parendepth++; AUTO_REDUCE( $1, ">=" );
1090 $$ = makenode( X_GTE, 2, $1, $4 );
1091 transform( $$ ) ; }
1092 | GTE { exiterror( ERR_INVALID_EXPRESSION, 1, ">=" ); }
1093 | expr LTE { parendepth--; }
1094 expr { parendepth++; AUTO_REDUCE( $1, "<=" );
1095 $$ = makenode( X_LTE, 2, $1, $4 );
1096 transform( $$ ) ; }
1097 | LTE { exiterror( ERR_INVALID_EXPRESSION, 1, "<=" ); }
1098 | expr GT { parendepth--; }
1099 expr { parendepth++; AUTO_REDUCE( $1, ">" );
1100 $$ = makenode( X_GT, 2, $1, $4 );
1101 transform( $$ ) ; }
1102 | GT { exiterror( ERR_INVALID_EXPRESSION, 1, ">" ); }
1103 | expr LT { parendepth--; }
1104 expr { parendepth++; AUTO_REDUCE( $1, "<" );
1105 $$ = makenode( X_LT, 2, $1, $4 );
1106 transform( $$ ) ; }
1107 | LT { exiterror( ERR_INVALID_EXPRESSION, 1, "<" ); }
1108 | expr DIFFERENT { parendepth--; }
1109 expr { parendepth++; AUTO_REDUCE( $1, "\\=" );
1110 $$ = makenode( X_DIFF, 2, $1, $4 );
1111 transform( $$ ) ; }
1112 | DIFFERENT { exiterror( ERR_INVALID_EXPRESSION, 1, "\\=" ); }
1113 | expr EQUALEQUAL { parendepth--; }
1114 expr { parendepth++; AUTO_REDUCE( $1, "==" );
1115 $$ = makenode( X_S_EQUAL, 2, $1, $4 ); }
1116 | EQUALEQUAL { exiterror( ERR_INVALID_EXPRESSION, 1, "==" ); }
1117 | expr NOTEQUALEQUAL { parendepth--; }
1118 expr { parendepth++; AUTO_REDUCE( $1, "\\==" );
1119 $$ = makenode( X_S_DIFF, 2, $1, $4 ); }
1120 | NOTEQUALEQUAL { exiterror( ERR_INVALID_EXPRESSION, 1, "\\==" ); }
1121 | expr GTGT { parendepth--; }
1122 expr { parendepth++; AUTO_REDUCE( $1, ">>" );
1123 $$ = makenode( X_S_GT, 2, $1, $4 ); }
1124 | GTGT { exiterror( ERR_INVALID_EXPRESSION, 1, ">>" ); }
1125 | expr LTLT { parendepth--; }
1126 expr { parendepth++; AUTO_REDUCE( $1, "<<" );
1127 $$ = makenode( X_S_LT, 2, $1, $4 ); }
1128 | LTLT { exiterror( ERR_INVALID_EXPRESSION, 1, "<<" ); }
1129 | expr NOTGTGT { parendepth--; }
1130 expr { parendepth++; AUTO_REDUCE( $1, "\\>>" );
1131 $$ = makenode( X_S_NGT, 2, $1, $4 ); }
1132 | NOTGTGT { exiterror( ERR_INVALID_EXPRESSION, 1, "\\>>" ); }
1133 | expr NOTLTLT { parendepth--; }
1134 expr { parendepth++; AUTO_REDUCE( $1, "\\<<" );
1135 $$ = makenode( X_S_NLT, 2, $1, $4 ); }
1136 | NOTLTLT { exiterror( ERR_INVALID_EXPRESSION, 1, "\\<<" ); }
1137 | expr GTGTE { parendepth--; }
1138 expr { parendepth++; AUTO_REDUCE( $1, ">>=" );
1139 $$ = makenode( X_S_GTE, 2, $1, $4 ); }
1140 | GTGTE { exiterror( ERR_INVALID_EXPRESSION, 1, ">>=" ); }
1141 | expr LTLTE { parendepth--; }
1142 expr { parendepth++; AUTO_REDUCE( $1, "<<=" );
1143 $$ = makenode( X_S_LTE, 2, $1, $4 ); }
1144 | LTLTE { exiterror( ERR_INVALID_EXPRESSION, 1, "<<=" ); }
1145 | symbtree { $$ = $1 ; }
1146 | CONSYMBOL { $$ = makenode( X_STRING, 0 );
1147 $$->name = Str_cre_TSD(parser_data.TSD,retvalue) ; }
1148 | HEXSTRING { $$ = makenode( X_STRING, 0 );
1149 $$->name = Str_make_TSD(parser_data.TSD,retlength) ;
1150 memcpy($$->name->value,retvalue,
1151 $$->name->len=retlength); }
1152 | BINSTRING { $$ = makenode( X_STRING, 0 );
1153 $$->name = Str_make_TSD(parser_data.TSD,retlength) ;
1154 memcpy($$->name->value,retvalue,
1155 $$->name->len=retlength); }
1156 | STRING { $$ = makenode( X_STRING, 0 );
1157 $$->name = Str_cre_TSD(parser_data.TSD,retvalue) ; }
1158 | function { $$ = $1 ; }
1159 | '+' expr %prec UPLUS { AUTO_REDUCE( $2, nullptr );
1160 $$ = makenode( X_U_PLUSS, 1, $2 ); }
1161 | '-' expr %prec UMINUS { AUTO_REDUCE( $2, nullptr );
1162 $$ = makenode( X_U_MINUS, 1, $2 ); }
1163 | '+' error { exiterror( ERR_INVALID_EXPRESSION, 1, __reginatext ); } /* fixes bug 1107760 */
1164 | '-' error { exiterror( ERR_INVALID_EXPRESSION, 1, __reginatext ); } /* fixes bug 1107760 */
1165 ;
1166
1167 exprs_sub : exprs ')' { $$ = $1; }
1168 | exprs error { exiterror( ERR_UNMATCHED_PARAN, 0 ); }
1169 | STATSEP { exiterror( ERR_UNMATCHED_PARAN, 0 ); }
1170 ;
1171
1172 symbtree : SIMSYMBOL { $$ = (nodeptr)create_head( (const char *)retvalue ) ; }
1173 ;
1174
1175
1176 function : extfunc func_args { $$ = makenode(X_EX_FUNC,1,$2) ;
1177 $$->name = (streng *)$1 ; }
1178 | intfunc func_args { $$ = makenode(X_IN_FUNC,1,$2) ;
1179 $$->name = (streng *)$1 ; }
1180 ;
1181
1182 func_args : { /* ugly fake preservs parendepth */
1183 $$ = (YYSTYPE) (long) parendepth;
1184 parendepth = 0; }
1185 exprs_sub { parendepth = (long) $$;
1186 $$ = $2; }
1187 ;
1188
1189 intfunc : INFUNCNAME { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
1190 ;
1191
1192 extfunc : EXFUNCNAME { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
1193 ;
1194
1195 template : pv solid template { $$ =makenode(X_TPL_SOLID,3,$1,$2,$3);}
1196 | pv { $$ =makenode(X_TPL_SOLID,1,$1) ; }
1197 | error { exiterror( ERR_INVALID_TEMPLATE, 1, __reginatext ) ;}
1198 ;
1199
1200 solid : '-' offset { $$ = makenode(X_NEG_OFFS,0) ;
1201 $$->name = (streng *) $2 ; }
1202 | '+' offset { $$ = makenode(X_POS_OFFS,0) ;
1203 $$->name = (streng *) $2 ; }
1204 | offset { $$ = makenode(X_ABS_OFFS,0) ;
1205 $$->name = (streng *) $1 ; }
1206 | '=' offset { $$ = makenode(X_ABS_OFFS,0) ;
1207 $$->name = (streng *) $2 ; }
1208 | '(' symbtree ')' { $$ = makenode(X_TPL_VAR,0) ;
1209 $$->p[0] = $2 ; }
1210 | '-' '(' symbtree ')' { $$ = makenode(X_NEG_OFFS,0) ;
1211 $$->p[0] = $3 ; }
1212 | '+' '(' symbtree ')' { $$ = makenode(X_POS_OFFS,0) ;
1213 $$->p[0] = $3 ; }
1214 | '=' '(' symbtree ')' { $$ = makenode(X_ABS_OFFS,0) ;
1215 $$->p[0] = $3 ; }
1216 | string { $$ = makenode(X_TPL_MVE,0) ;
1217 $$->name = (streng *) $1 ; }
1218 ;
1219
1220 offset : OFFSET { $$ = (nodeptr)Str_cre_TSD(parser_data.TSD,retvalue) ; }
1221 | CONSYMBOL { streng *sptr = Str_cre_TSD(parser_data.TSD,retvalue) ;
1222 if (myisnumber(parser_data.TSD, sptr))
1223 {
1224 exiterror( ERR_INVALID_INTEGER, 4, sptr->value ) ;
1225 }
1226 else
1227 exiterror( ERR_INVALID_TEMPLATE, 0 ) ;}
1228 ;
1229
1230 string : STRING { $$ = (nodeptr) Str_cre_TSD(parser_data.TSD,retvalue) ; }
1231 | HEXSTRING { streng *sptr = Str_make_TSD(parser_data.TSD,retlength) ;
1232 memcpy(sptr->value,retvalue,
1233 sptr->len=retlength) ;
1234 $$ = (nodeptr) sptr ; }
1235 | BINSTRING { streng *sptr = Str_make_TSD(parser_data.TSD,retlength) ;
1236 memcpy(sptr->value,retvalue,
1237 sptr->len=retlength) ;
1238 $$ = (nodeptr) sptr ; }
1239 ;
1240
1241 pv : PLACEHOLDER pv { $$ = makenode(X_TPL_POINT,1,$2) ; }
1242 | symbtree pv { $$ = makenode(X_TPL_SYMBOL,2,$2,$1) ; }
1243 | { $$ = NULL ; }
1244 ;
1245
1246 /*
1247 * exprs isn't for enumerating arguments
1248 * only, it has to detect missing closing
1249 * parentheses and other stuff.
1250 * parendepth regulates the behaviour.
1251 * Getting negative indicates an error.
1252 */
1253 exprs : nexpr ',' { /* detect
1254 * "x = ( a,. b )",
1255 * "x = ( ,. b )",
1256 * "x = a,. b",
1257 * "x = ,. b",
1258 * "x = f( ( x,. b ) )",
1259 * "x = f( ( ,. b ) )" */
1260 if ( parendepth < 0 )
1261 exiterror( ERR_UNEXPECTED_PARAN, 1 );
1262
1263 /* With call being the extended kind
1264 * of CALL we may have:
1265 * "x = f( (a),. b )",
1266 * "x = f( a,. b )",
1267 * "x = f( ,. b )",
1268 * "CALL s (a),. b",
1269 * "CALL s a,. b",
1270 * "CALL s ,. b",
1271 * "call s (a),. b",
1272 * "call s a,. b",
1273 * "call s ,. b",
1274 * "call s( (a),. b )",
1275 * "call s( a,. b )",
1276 * "call s( ,. b )",
1277 * "call s (a,a),. b",
1278 * "call s (a),. b",
1279 * "call s (),. b"
1280 *
1281 * detect "(a),." and transform it
1282 * to "a,." */
1283 $1 = reduce_expr_list( $1,
1284 REDUCE_EXPR );
1285
1286 /* detect "call s (a,b),. b" and
1287 * "call s (),. b", but every list on
1288 * the left side of "," is wrong, so
1289 * complain about every exprlist. */
1290 if ( IS_EXPRLIST( $1 ) )
1291 exiterror( ERR_UNEXPECTED_PARAN, 1 );
1292
1293 $1 = reduce_expr_list( $1,
1294 REDUCE_SUBEXPR );
1295 }
1296 exprs { /*
1297 * Fixes bug 961301.
1298 */
1299 nodeptr curr;
1300
1301 assert( IS_EXPRLIST( $4 ) );
1302
1303 /* detect ",()." */
1304 if ( IS_EXPRLIST( $4->p[0] )
1305 && ( $4->p[1] == NULL )
1306 && ( $4->p[0]->p[0] == NULL ) )
1307 exiterror( ERR_UNEXPECTED_PARAN, 0 );
1308
1309 /* detect ",(a,b)." */
1310 if ( IS_EXPRLIST( $4->p[0] )
1311 && ( $4->p[1] == NULL )
1312 && IS_EXPRLIST( $4->p[0]->p[1] ) )
1313 exiterror( ERR_UNEXPECTED_PARAN, 1 );
1314
1315 /* detect ",(a)." and transform it
1316 * to ",a." */
1317 $4 = reduce_expr_list( $4,
1318 REDUCE_RIGHT );
1319 assert( IS_EXPRLIST( $4 ) );
1320
1321 /* Detect something like
1322 * "call s (a,b)+1" */
1323 curr = $4->p[0];
1324 if ( ( curr != NULL )
1325 && !IS_EXPRLIST( curr )
1326 && !IS_FUNCTION( curr )
1327 && ( IS_EXPRLIST( curr->p[0] )
1328 || IS_EXPRLIST( curr->p[1] ) ) )
1329 exiterror( ERR_INVALID_EXPRESSION, 0 );
1330
1331 $$ = makenode( X_EXPRLIST, 2, $1, $4 );
1332 checkconst( $$ ); }
1333 | nexpr { /* detect
1334 * "x = ()."
1335 * "x = f(().)"
1336 * "call s (().)"
1337 * "CALL s ()." */
1338 if ( ( parendepth < 0 ) && ( $1 == NULL ) )
1339 exiterror( ERR_UNEXPECTED_PARAN, 0 );
1340
1341 /* With call being the extended kind
1342 * of CALL we may have:
1343 * "x = ( a. )",
1344 * "x = f( . )",
1345 * "x = f( ., )",
1346 * "x = f( a. )",
1347 * "x = f( a., )",
1348 * "x = f( a, . )",
1349 * "x = f( a, b. )",
1350 * "CALL s .",
1351 * "CALL s .,",
1352 * "CALL s a.,",
1353 * "CALL s a, .",
1354 * "CALL s a, b.",
1355 * "call s .",
1356 * "call s .,",
1357 * "call s a.,",
1358 * "call s a, .",
1359 * "call s a, b.",
1360 * "call s (a.)",
1361 * "call s (a)+1, .",
1362 * "call s (a), .",
1363 * "call s (a), a.",
1364 * "call s (a), (a).",
1365 * "call s ( ., )",
1366 * "call s ( a., )",
1367 * "call s ( a, . )",
1368 * "call s ( a, b. )" */
1369
1370 $1 = reduce_expr_list( $1,
1371 REDUCE_SUBEXPR );
1372 $$ = makenode( X_EXPRLIST, 1, $1 );
1373 checkconst( $$ );
1374 }
1375 ;
1376
1377 nexpr : expr { $$ = $1 ; }
1378 | { $$ = NULL ; }
1379 ;
1380
1381 anyvars : xsimsymb anyvars { $$ = makenode(X_SIM_SYMBOL,1,$2) ;
1382 $$->name = (streng *) $1 ; }
1383 | xsimsymb { $$ = makenode(X_SIM_SYMBOL,0) ;
1384 $$->name = (streng *) $1 ; }
1385 | '(' xsimsymb ')' anyvars { $$ = makenode(X_IND_SYMBOL,1,$4) ;
1386 $$->name = (streng *) $2 ; }
1387 | '(' xsimsymb ')' { $$ = makenode(X_IND_SYMBOL,0) ;
1388 $$->name = (streng *) $2 ; }
1389 ;
1390
1391 xsimsymb : SIMSYMBOL { $$ = (treenode *) Str_cre_TSD(parser_data.TSD,retvalue);}
1392 ;
1393
1394 simsymb : SIMSYMBOL { $$ = (treenode *) Str_cre_TSD(parser_data.TSD,retvalue);}
1395 | error { exiterror( ERR_SYMBOL_EXPECTED, 1, __reginatext ) ;}
1396 ;
1397
1398 %%
1399
1400 static nodeptr makenode( int type, int numb, ... )
1401 {
1402 nodeptr thisleave ;
1403 va_list argptr ;
1404 int i ;
1405
1406 assert(numb <= (int) (sizeof(thisleave->p)/sizeof(thisleave->p[0])));
1407 #ifdef REXXDEBUG
1408 printf("makenode: making new node, type: %d\n",type) ;
1409 #endif /* REXXDEBUG */
1410
1411 thisleave = FreshNode( ) ;
1412 /* thisleave is initialized to zero except for nodeindex */
1413 va_start( argptr, numb ) ;
1414 thisleave->type = type ;
1415 thisleave->lineno = -1 ;
1416 thisleave->charnr = -1 ;
1417 for (i=0;i<numb;i++)
1418 thisleave->p[i]=va_arg(argptr, nodeptr) ;
1419
1420 va_end( argptr ) ;
1421
1422 return( thisleave ) ;
1423 }
1424
1425 static char *getdokeyword( int type )
1426 {
1427 char *ptr;
1428 switch( type )
1429 {
1430 case X_DO_TO: ptr="TO";break;
1431 case X_DO_BY: ptr="BY";break;
1432 case X_DO_FOR: ptr="FOR";break;
1433 default: ptr="";break;
1434 }
1435 return ptr;
1436 }
1437
1438 static void checkdosyntax( cnodeptr thisptr )
1439 {
1440 if ((thisptr->p[1]!=NULL)&&(thisptr->p[2]!=NULL))
1441 {
1442 if ((thisptr->p[1]->type)==(thisptr->p[2]->type))
1443 {
1444 exiterror( ERR_INVALID_DO_SYNTAX, 1, getdokeyword(thisptr->p[1]->type) ) ;
1445 }
1446 }
1447 if ((thisptr->p[2]!=NULL)&&(thisptr->p[3]!=NULL))
1448 {
1449 if ((thisptr->p[2]->type)==(thisptr->p[3]->type))
1450 {
1451 exiterror( ERR_INVALID_DO_SYNTAX, 1, getdokeyword(thisptr->p[2]->type) ) ;
1452 }
1453 }
1454 if ((thisptr->p[1]!=NULL)&&(thisptr->p[3]!=NULL))
1455 {
1456 if ((thisptr->p[1]->type)==(thisptr->p[3]->type))
1457 {
1458 exiterror( ERR_INVALID_DO_SYNTAX, 1, getdokeyword(thisptr->p[1]->type) ) ;
1459 }
1460 }
1461 return ;
1462 }
1463
1464
1465 void newlabel( const tsd_t *TSD, internal_parser_type *ipt, nodeptr thisptr )
1466 {
1467 labelboxptr newptr ;
1468
1469 assert( thisptr ) ;
1470
1471 newptr = (labelboxptr)MallocTSD(sizeof(labelbox)) ;
1472
1473 newptr->next = NULL ;
1474 newptr->entry = thisptr ;
1475 if (ipt->first_label == NULL)
1476 {
1477 ipt->first_label = newptr ;
1478 ipt->last_label = newptr ; /* must be NULL, too */
1479 }
1480 else
1481 {
1482 ipt->last_label->next = newptr ;
1483 ipt->last_label = newptr ;
1484 }
1485 ipt->numlabels++;
1486 }
1487
1488 static nodeptr create_tail( const char *name )
1489 {
1490 const char *cptr ;
1491 nodeptr node ;
1492 int constant ;
1493 streng *tname ;
1494 tsd_t *TSD = parser_data.TSD;
1495
1496 if (!*name)
1497 {
1498 node = makenode( X_CTAIL_SYMBOL, 0 ) ;
1499 node->name = Str_make_TSD( parser_data.TSD, 0) ;
1500 return node ;
1501 }
1502
1503 cptr = name ;
1504 constant = rx_isdigit(*cptr) || *cptr=='.' || (!*cptr) ;
1505 node = makenode( (constant) ? X_CTAIL_SYMBOL : X_VTAIL_SYMBOL, 0 ) ;
1506
1507 for (;*cptr && *cptr!='.'; cptr++) ;
1508 node->name = Str_ncre_TSD( parser_data.TSD, name, cptr-name ) ;
1509
1510 if (*cptr)
1511 {
1512 node->p[0] = create_tail( ++cptr ) ;
1513 if (constant && node->p[0]->type==X_CTAIL_SYMBOL)
1514 {
1515 streng *first, *second ;
1516 nodeptr tptr ;
1517
1518 first = node->name ;
1519 second = node->p[0]->name ;
1520 node->name = NULL;
1521 node->p[0]->name = NULL;
1522 tname = Str_makeTSD( first->len + second->len + 1) ;
1523 memcpy( tname->value, first->value, first->len ) ;
1524 tname->value[first->len] = '.' ;
1525 memcpy( tname->value+first->len+1, second->value, second->len) ;
1526 tname->len = first->len + second->len + 1 ;
1527
1528 Free_stringTSD( first ) ;
1529 Free_stringTSD( second ) ;
1530 node->name = tname ;
1531 tptr = node->p[0] ;
1532 node->p[0] = tptr->p[0] ;
1533 RejectNode(tptr);
1534 }
1535 }
1536
1537 return node ;
1538 }
1539
1540 static nodeptr create_head( const char *name )
1541 {
1542 const char *cptr ;
1543 nodeptr node ;
1544
1545 /* Bypass reserved variables */
1546 cptr = ( *name ) ? ( name + 1 ) : name;
1547 for (; *cptr && *cptr!='.'; cptr++) ;
1548 node = makenode( X_SIM_SYMBOL, 0 ) ;
1549 node->name = Str_ncre_TSD( parser_data.TSD, name, cptr-name+(*cptr=='.')) ;
1550
1551 if (*cptr)
1552 {
1553 if (*(++cptr))
1554 node->p[0] = create_tail( cptr ) ;
1555 else
1556 node->p[0] = NULL ;
1557
1558 node->type = (node->p[0]) ? X_HEAD_SYMBOL : X_STEM_SYMBOL ;
1559 }
1560
1561 return node ;
1562 }
1563
1564
1565 static node_type gettypeof( nodeptr thisptr )
1566 {
1567 tsd_t *TSD = parser_data.TSD;
1568
1569 switch(thisptr->type)
1570 {
1571 case X_PLUSS:
1572 case X_MINUS:
1573 case X_MULT:
1574 case X_U_PLUSS:
1575 case X_U_MINUS:
1576 case X_DEVIDE:
1577 case X_INTDIV:
1578 case X_MODULUS:
1579 case X_EQUAL:
1580 case X_DIFF:
1581 case X_GTE:
1582 case X_GT:
1583 case X_LTE:
1584 case X_LT:
1585 case X_SEQUAL:
1586 case X_SDIFF:
1587 case X_SGTE:
1588 case X_SGT:
1589 case X_SLTE:
1590 case X_SLT:
1591 case X_NEQUAL:
1592 case X_NDIFF:
1593 case X_NGTE:
1594 case X_NGT:
1595 case X_NLTE:
1596 case X_NLT:
1597 return IS_A_NUMBER ;
1598
1599
1600 case X_SIM_SYMBOL:
1601 return IS_SIM_SYMBOL ;
1602
1603 case X_HEAD_SYMBOL:
1604 return IS_COMP_SYMBOL ;
1605
1606 case X_STRING:
1607 case X_CON_SYMBOL:
1608 {
1609 if (thisptr->u.number)
1610 {
1611 fprintf( stderr, "Found an internal spot of investigation of the Regina interpreter.\n"
1612 "Please inform Mark Hessling or Florian Coosmann about the\n"
1613 "circumstances and this script.\n"
1614 "\n"
1615 "Many thanks!\n"
1616 "email addresses:\n"
1617 "m.hessling@qut.edu.au\n"
1618 "florian@grosse-coosmann.de\n");
1619 /* FIXME: When does this happen?
1620 * It doesn't happen if no feedback is send until end of 2005.
1621 */
1622 return IS_A_NUMBER ;
1623 }
1624
1625 if ( ( thisptr->u.number = is_a_descr( TSD, thisptr->name ) ) != NULL )
1626 return IS_A_NUMBER;
1627 return IS_NO_NUMBER;
1628 }
1629 }
1630 return IS_UNKNOWN ;
1631 }
1632
1633
1634
1635 static void transform( nodeptr thisptr )
1636 {
1637 int type ;
1638 node_type left,rght;
1639
1640 left = gettypeof( thisptr->p[0] ) ;
1641 rght = gettypeof( thisptr->p[1] ) ;
1642 type = thisptr->type ;
1643
1644 if ( ( left == IS_A_NUMBER ) && ( rght == IS_A_NUMBER ) )
1645 {
1646 if (type==X_EQUAL)
1647 thisptr->type = X_NEQUAL ;
1648 else if (type==X_DIFF)
1649 thisptr->type = X_NDIFF ;
1650 else if (type==X_GTE)
1651 thisptr->type = X_NGTE ;
1652 else if (type==X_GT)
1653 thisptr->type = X_NGT ;
1654 else if (type==X_LTE)
1655 thisptr->type = X_NLTE ;
1656 else if (type==X_LT)
1657 thisptr->type = X_NLT ;
1658 }
1659 else if ( ( left == IS_NO_NUMBER ) || ( rght == IS_NO_NUMBER ) )
1660 {
1661 if (type==X_EQUAL)
1662 thisptr->type = X_SEQUAL ;
1663 else if (type==X_DIFF)
1664 thisptr->type = X_SDIFF ;
1665 else if (type==X_GTE)
1666 thisptr->type = X_SGTE ;
1667 else if (type==X_GT)
1668 thisptr->type = X_SGT ;
1669 else if (type==X_LTE)
1670 thisptr->type = X_SLTE ;
1671 else if (type==X_LT)
1672 thisptr->type = X_SLT ;
1673 }
1674 else
1675 {
1676 type = thisptr->p[0]->type ;
1677 if ( ( left == IS_A_NUMBER )
1678 && ( ( type == X_STRING ) || ( type == X_CON_SYMBOL ) ) )
1679 thisptr->u.flags.lnum = 1 ;
1680 else if ( left == IS_SIM_SYMBOL )
1681 thisptr->u.flags.lsvar = 1 ;
1682 else if ( left == IS_COMP_SYMBOL )
1683 thisptr->u.flags.lcvar = 1 ;
1684
1685 type = thisptr->p[1]->type ;
1686 if ( ( rght == IS_A_NUMBER )
1687 && ( ( type == X_STRING ) || ( type == X_CON_SYMBOL ) ) )
1688 thisptr->u.flags.rnum = 1 ;
1689 else if ( rght == IS_SIM_SYMBOL )
1690 thisptr->u.flags.rsvar = 1 ;
1691 else if ( rght == IS_COMP_SYMBOL )
1692 thisptr->u.flags.rcvar = 1 ;
1693 }
1694 }
1695
1696
1697 static int is_const( cnodeptr thisptr )
1698 {
1699 if (!thisptr)
1700 return 1 ;
1701
1702 switch (thisptr->type)
1703 {
1704 case X_STRING:
1705 case X_CON_SYMBOL:
1706 return 1 ;
1707
1708 #if 0
1709 Pre-evaluation is not allowed. DIGITS and FUZZ may change within loops
1710 and the resulting value may or may not be the same. Concatenation with
1711 or without spaces is the sole allowed operation.
1712
1713 NEVER ENABLE THIS AGAIN WITHOUT SOLVING THIS PROBLEMS!
1714
1715 case X_U_PLUSS:
1716 case X_U_MINUS:
1717 return is_const( thisptr->p[0] ) ;
1718
1719 case X_PLUSS:
1720 case X_MINUS:
1721 case X_MULT:
1722 /* case X_DEVIDE: Bug 20000807-41821 */
1723 case X_INTDIV:
1724 case X_MODULUS:
1725 case X_EQUAL:
1726 case X_DIFF:
1727 case X_GTE:
1728 case X_GT:
1729 case X_LTE:
1730 case X_LT:
1731 case X_SEQUAL:
1732 case X_SDIFF:
1733 case X_SGTE:
1734 case X_SGT:
1735 case X_SLTE:
1736 case X_SLT:
1737 case X_NEQUAL:
1738 case X_NDIFF:
1739 case X_NGTE:
1740 case X_NGT:
1741 case X_NLTE:
1742 case X_NLT:
1743 #endif
1744
1745 case X_SPACE:
1746 case X_CONCAT:
1747 return is_const( thisptr->p[0] ) && is_const( thisptr->p[1] ) ;
1748 }
1749 return 0 ;
1750 }
1751
1752
1753 static void checkconst( nodeptr thisptr )
1754 {
1755 tsd_t *TSD = parser_data.TSD;
1756
1757 assert( thisptr->type == X_EXPRLIST ) ;
1758 if (is_const(thisptr->p[0]))
1759 {
1760 if (thisptr->p[0])
1761 thisptr->u.strng = evaluate( TSD, thisptr->p[0], NULL ) ;
1762 else
1763 thisptr->u.strng = NULL ;
1764
1765 thisptr->type = X_CEXPRLIST ;
1766 }
1767 }
1768
1769 /*
1770 * reduce_expr_list will be invoked if the reduction of a list expression for
1771 * "call" arguments or a plain "(expr)" is needed. The reduction of the
1772 * outer parentheses of the extended CALL syntax is done with
1773 * mode==REDUCE_CALL, the reduction of a simple "(expr)" is done with
1774 * mode==REDUCE_EXPR. REDUCE_RIGHT is a synonym for REDUCE_CALL currently and
1775 * is intended to be used for reducing the right side of an expression list.
1776 *
1777 * REDUCE_SUBEXPR detect "call s (a)+1," and "call s 1+(a)," and reduces it.
1778 * Furthermore it detects "call s ()+1", "call s 1+()", "call s 1+(a,b)",
1779 * "call s (a,b)+1" and raises an error in this case.
1780 */
1781 static nodeptr reduce_expr_list( nodeptr thisptr, reduce_mode mode )
1782 {
1783 nodeptr h, retval = thisptr;
1784
1785 if ( !thisptr )
1786 return retval;
1787
1788 if ( mode == REDUCE_SUBEXPR )
1789 {
1790 if ( ( parendepth == 1 ) && !IS_FUNCTION( thisptr ) && !IS_EXPRLIST( thisptr ) )
1791 {
1792 if ( IS_EXPRLIST( thisptr->p[0] ) )
1793 {
1794 h = thisptr->p[0];
1795 if ( ( h->p[0] == NULL ) || ( h->p[1] != NULL ) )
1796 exiterror( ERR_INVALID_EXPRESSION, 0 );
1797 thisptr->p[0] = h->p[0];
1798 RejectNode( h );
1799 }
1800 if ( IS_EXPRLIST( thisptr->p[1] ) )
1801 {
1802 h = thisptr->p[1];
1803 if ( ( h->p[0] == NULL ) || ( h->p[1] != NULL ) )
1804 exiterror( ERR_INVALID_EXPRESSION, 0 );
1805 thisptr->p[1] = h->p[0];
1806 RejectNode( h );
1807 }
1808 }
1809 return retval;
1810 }
1811
1812 if ( !IS_EXPRLIST( thisptr ) )
1813 return retval;
1814
1815 if ( ( mode == REDUCE_CALL ) || ( mode == REDUCE_RIGHT ) )
1816 {
1817 if ( IS_EXPRLIST( thisptr->p[0] ) && ( thisptr->p[1] == NULL ) )
1818 {
1819 retval = thisptr->p[0];
1820 RejectNode( thisptr );
1821 }
1822 }
1823 else
1824 {
1825 /*
1826 * mode == REDUCE_EXPR
1827 */
1828 if ( ( thisptr->p[0] != NULL ) && ( thisptr->p[1] == NULL ) )
1829 {
1830 if ( !IS_EXPRLIST( thisptr->p[0] ) )
1831 {
1832 retval = thisptr->p[0];
1833 RejectNode( thisptr );
1834 }
1835 }
1836 }
1837 return retval;
1838 }
1839
1840 /*
1841 * optgluelast connect p2 as the ->next element to p1. Every element may be
1842 * NULL.
1843 * If both are non-NULL, the connection is performed using the o.last elements.
1844 * Just the o.last element of p1 remains non-NULL.
1845 *
1846 * Returns: NULL if p1 and p2 are NULL.
1847 * The non-NULL element if one argumet is NULL.
1848 * p1 otherwise.
1849 */
1850 static nodeptr optgluelast( nodeptr p1, nodeptr p2 )
1851 {
1852 nodeptr p2last;
1853
1854 if ( p1 == NULL )
1855 return p2;
1856 if ( p2 == NULL )
1857 return p1;
1858
1859 /*
1860 * This is performed very often, so keep the code fast.
1861 *
1862 * p2last is the "o.last"-element of p2 or just p2 if p2 has no next
1863 * elements. We set p1's o.last further down, but we have to ensure that
1864 * p2->o.last is NULL first. Therefore every element in the ->next chain
1865 * of p1 will have NULL as its o.last field.
1866 */
1867 if ( ( p2last = p2->o.last ) == NULL )
1868 p2last = p2;
1869 else
1870 p2->o.last = NULL;
1871
1872 if ( p1->o.last == NULL )
1873 p1->next = p2;
1874 else
1875 p1->o.last->next = p2;
1876 p1->o.last = p2last;
1877
1878 return p1;
1879 }
1880
1881 /*
1882 * justlabels returns 1, if n consists of a sequence of labels. The return
1883 * value is 0 otherwise.
1884 */
1885 static int justlabels( nodeptr n )
1886 {
1887 while ( n != NULL )
1888 {
1889 if ( n->type != X_LABEL )
1890 return 0;
1891 n = n->next;
1892 }
1893
1894 return 1;
1895 }
1896
1897 /*
1898 * move_labels move the labels from the end of "end" to the end of "front".
1899 * The labels are marked "read_only" if level is nonnull, the read-only flag
1900 * is removed if level is 0.
1901 * NOTE: At least one element of the "end" chain must contain a non-label
1902 * element.
1903 */
1904 static void move_labels( nodeptr front, nodeptr end, int level )
1905 {
1906 nodeptr oend = end;
1907 nodeptr labels;
1908
1909 assert( front != NULL );
1910 assert( !justlabels( end ) );
1911
1912 while ( !justlabels( end->next ) )
1913 end = end->next;
1914
1915 if ( ( labels = end->next ) == NULL )
1916 return;
1917
1918 /*
1919 * extract the labels.
1920 */
1921 labels->o.last = oend->o.last;
1922 end->next = NULL;
1923 if ( end == oend )
1924 oend->o.last = NULL;
1925 else
1926 oend->o.last = end;
1927
1928 if ( labels->next == NULL )
1929 labels->o.last = NULL;
1930
1931 /*
1932 * add the labels to the end of front and then re-mark the labels.
1933 */
1934 optgluelast( front, labels );
1935 while ( labels ) {
1936 labels->u.trace_only = ( level == 0 ) ? 0 : 1;
1937 labels = labels->next;
1938 }
1939 }
Mirror of AROS' Contrib svn.