~ubuntu-branches/ubuntu/lucid/graphviz/lucid-security

« back to all changes in this revision

Viewing changes to tools/expr/exparse.y

  • Committer: Bazaar Package Importer
  • Author(s): Stephen M Moraco
  • Date: 2002-02-05 18:52:12 UTC
  • Revision ID: james.westby@ubuntu.com-20020205185212-8i04c70te00rc40y
Tags: upstream-1.7.16
ImportĀ upstreamĀ versionĀ 1.7.16

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%{
 
2
 
 
3
#pragma prototyped
 
4
 
 
5
/*
 
6
 * Glenn Fowler
 
7
 * AT&T Research
 
8
 *
 
9
 * expression library grammar and compiler
 
10
 *
 
11
 * NOTE: procedure arguments not implemented yet
 
12
 */
 
13
 
 
14
#include <stdio.h>
 
15
#include <ast.h>
 
16
 
 
17
#undef  RS      /* hp.pa <signal.h> grabs this!! */
 
18
 
 
19
%}
 
20
 
 
21
%union
 
22
{
 
23
        struct Exnode_s*expr;
 
24
        double          floating;
 
25
        struct Exref_s* reference;
 
26
        struct Exid_s*  id;
 
27
        Sflong_t        integer;
 
28
        int             op;
 
29
        char*           string;
 
30
        void*           user;
 
31
        struct Exbuf_s* buffer;
 
32
}
 
33
 
 
34
%start  program
 
35
 
 
36
%token  MINTOKEN
 
37
 
 
38
%token  CHAR
 
39
%token  INT
 
40
%token  INTEGER
 
41
%token  UNSIGNED
 
42
%token  FLOATING
 
43
%token  STRING
 
44
%token  VOID
 
45
 
 
46
%token  BREAK
 
47
%token  CALL
 
48
%token  CASE
 
49
%token  CONSTANT
 
50
%token  CONTINUE
 
51
%token  DECLARE
 
52
%token  DEFAULT
 
53
%token  DYNAMIC
 
54
%token  ELSE
 
55
%token  EXIT
 
56
%token  FOR
 
57
%token  FUNCTION
 
58
%token  ITERATE
 
59
%token  ID
 
60
%token  IF
 
61
%token  LABEL
 
62
%token  MEMBER
 
63
%token  NAME
 
64
%token  POS
 
65
%token  PRAGMA
 
66
%token  PRE
 
67
%token  PRINTF
 
68
%token  PROCEDURE
 
69
%token  QUERY
 
70
%token  RETURN
 
71
%token  SPRINTF
 
72
%token  SWITCH
 
73
%token  WHILE
 
74
 
 
75
%token  F2I
 
76
%token  F2S
 
77
%token  I2F
 
78
%token  I2S
 
79
%token  S2B
 
80
%token  S2F
 
81
%token  S2I
 
82
 
 
83
%token  F2X
 
84
%token  I2X
 
85
%token  S2X
 
86
%token  X2F
 
87
%token  X2I
 
88
%token  X2S
 
89
 
 
90
%left   <op>    ','
 
91
%right  <op>    '='
 
92
%right  <op>    '?'     ':'
 
93
%left   <op>    OR
 
94
%left   <op>    AND
 
95
%left   <op>    '|'
 
96
%left   <op>    '^'
 
97
%left   <op>    '&'
 
98
%binary <op>    EQ      NE
 
99
%binary <op>    '<'     '>'     LE      GE
 
100
%left   <op>    LS      RS
 
101
%left   <op>    '+'     '-'
 
102
%left   <op>    '*'     '/'     '%'
 
103
%right  <op>    '!'     '~'     UNARY
 
104
%right  <op>    INC     DEC
 
105
%right  <op>    CAST
 
106
%left   <op>    '('
 
107
 
 
108
%type <expr>            statement       statement_list  arg_list
 
109
%type <expr>            else_opt        expr_opt        expr
 
110
%type <expr>            args            variable        assign
 
111
%type <expr>            dcl_list        dcl_item        index
 
112
%type <expr>            initialize      switch_item     constant
 
113
%type <expr>            formals         formal_list     formal_item
 
114
%type <reference>       members
 
115
%type <id>              ID              LABEL           NAME
 
116
%type <id>              CONSTANT        FUNCTION        DECLARE
 
117
%type <id>              EXIT            PRINTF          QUERY
 
118
%type <id>              SPRINTF         PROCEDURE       name
 
119
%type <id>              IF              WHILE           FOR
 
120
%type <id>              BREAK           CONTINUE        print member
 
121
%type <id>              RETURN          DYNAMIC         SWITCH
 
122
%type <floating>        FLOATING
 
123
%type <integer>         INTEGER         UNSIGNED        array
 
124
%type <string>          STRING
 
125
 
 
126
%token  MAXTOKEN
 
127
 
 
128
%{
 
129
 
 
130
#include "exgram.h"
 
131
 
 
132
%}
 
133
 
 
134
%%
 
135
 
 
136
program         :       statement_list action_list
 
137
                {
 
138
                        if ($1 && !(expr.program->disc->flags & EX_STRICT))
 
139
                        {
 
140
                                if (expr.program->main.value && !(expr.program->disc->flags & EX_RETAIN))
 
141
                                        exfreenode(expr.program, expr.program->main.value);
 
142
                                if ($1->op == S2B)
 
143
                                {
 
144
                                        Exnode_t*       x;
 
145
 
 
146
                                        x = $1;
 
147
                                        $1 = x->data.operand.left;
 
148
                                        x->data.operand.left = 0;
 
149
                                        exfreenode(expr.program, x);
 
150
                                }
 
151
                                expr.program->main.lex = PROCEDURE;
 
152
                                expr.program->main.value = exnewnode(expr.program, PROCEDURE, 1, $1->type, NiL, $1);
 
153
                        }
 
154
                }
 
155
                ;
 
156
 
 
157
action_list     :       /* empty */
 
158
                |       action_list action
 
159
                ;
 
160
 
 
161
action          :       LABEL ':' {
 
162
                                register Dtdisc_t*      disc;
 
163
 
 
164
                                if (expr.procedure)
 
165
                                        exerror("no nested function definitions");
 
166
                                $1->lex = PROCEDURE;
 
167
                                expr.procedure = $1->value = exnewnode(expr.program, PROCEDURE, 1, $1->type, NiL, NiL);
 
168
                                expr.procedure->type = INTEGER;
 
169
                                if (!(disc = newof(0, Dtdisc_t, 1, 0)))
 
170
                                        exerror("out of space [frame discipline]");
 
171
                                disc->key = offsetof(Exid_t, name);
 
172
                                if (!(expr.procedure->data.procedure.frame = dtopen(disc, Dtset)) || !dtview(expr.procedure->data.procedure.frame, expr.program->symbols))
 
173
                                        exerror("out of space [frame table]");
 
174
                                expr.program->symbols = expr.program->frame = expr.procedure->data.procedure.frame;
 
175
                        } statement_list
 
176
                {
 
177
                        expr.procedure = 0;
 
178
                        if (expr.program->frame)
 
179
                        {
 
180
                                expr.program->symbols = expr.program->frame->view;
 
181
                                dtview(expr.program->frame, NiL);
 
182
                        }
 
183
                        if ($4 && $4->op == S2B)
 
184
                        {
 
185
                                Exnode_t*       x;
 
186
 
 
187
                                x = $4;
 
188
                                $4 = x->data.operand.left;
 
189
                                x->data.operand.left = 0;
 
190
                                exfreenode(expr.program, x);
 
191
                        }
 
192
                        $1->value->data.operand.right = excast(expr.program, $4, $1->type, NiL, 0);
 
193
                }
 
194
                ;
 
195
 
 
196
statement_list  :       /* empty */
 
197
                {
 
198
                        $$ = 0;
 
199
                }
 
200
                |       statement_list statement
 
201
                {
 
202
                        if (!$1)
 
203
                                $$ = $2;
 
204
                        else if (!$2)
 
205
                                $$ = $1;
 
206
                        else if ($1->op == CONSTANT)
 
207
                        {
 
208
                                exfreenode(expr.program, $1);
 
209
                                $$ = $2;
 
210
                        }
 
211
                        else $$ = exnewnode(expr.program, ';', 1, $2->type, $1, $2);
 
212
                }
 
213
                ;
 
214
 
 
215
statement       :       '{' statement_list '}'
 
216
                {
 
217
                        $$ = $2;
 
218
                }
 
219
                |       expr_opt ';'
 
220
                {
 
221
                        $$ = ($1 && $1->type == STRING) ? exnewnode(expr.program, S2B, 1, INTEGER, $1, NiL) : $1;
 
222
                }
 
223
                |       DECLARE {expr.declare=$1->type;} dcl_list ';'
 
224
                {
 
225
                        $$ = $3;
 
226
                }
 
227
                |       IF '(' expr ')' statement else_opt
 
228
                {
 
229
                        if ($3->type == STRING)
 
230
                                $3 = exnewnode(expr.program, S2B, 1, INTEGER, $3, NiL);
 
231
                        else if (!INTEGRAL($3->type))
 
232
                                $3 = excast(expr.program, $3, INTEGER, NiL, 0);
 
233
                        $$ = exnewnode(expr.program, $1->index, 1, INTEGER, $3, exnewnode(expr.program, ':', 1, $5 ? $5->type : 0, $5, $6));
 
234
                }
 
235
                |       FOR '(' variable ')' statement
 
236
                {
 
237
                        $$ = exnewnode(expr.program, ITERATE, 0, INTEGER, NiL, NiL);
 
238
                        $$->data.generate.array = $3;
 
239
                        if (!$3->data.variable.index || $3->data.variable.index->op != DYNAMIC)
 
240
                                exerror("simple index variable expected");
 
241
                        $$->data.generate.index = $3->data.variable.index->data.variable.symbol;
 
242
                        if ($3->op == ID && $$->data.generate.index->type != INTEGER)
 
243
                                exerror("integer index variable expected");
 
244
                        exfreenode(expr.program, $3->data.variable.index);
 
245
                        $3->data.variable.index = 0;
 
246
                        $$->data.generate.statement = $5;
 
247
                }
 
248
                |       FOR '(' expr_opt ';' expr_opt ';' expr_opt ')' statement
 
249
                {
 
250
                        if (!$5)
 
251
                        {
 
252
                                $5 = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
 
253
                                $5->data.constant.value.integer = 1;
 
254
                        }
 
255
                        else if ($5->type == STRING)
 
256
                                $5 = exnewnode(expr.program, S2B, 1, INTEGER, $5, NiL);
 
257
                        else if (!INTEGRAL($5->type))
 
258
                                $5 = excast(expr.program, $5, INTEGER, NiL, 0);
 
259
                        $$ = exnewnode(expr.program, $1->index, 1, INTEGER, $5, exnewnode(expr.program, ';', 1, 0, $7, $9));
 
260
                        if ($3)
 
261
                                $$ = exnewnode(expr.program, ';', 1, INTEGER, $3, $$);
 
262
                }
 
263
                |       WHILE '(' expr ')' statement
 
264
                {
 
265
                        if ($3->type == STRING)
 
266
                                $3 = exnewnode(expr.program, S2B, 1, INTEGER, $3, NiL);
 
267
                        else if (!INTEGRAL($3->type))
 
268
                                $3 = excast(expr.program, $3, INTEGER, NiL, 0);
 
269
                        $$ = exnewnode(expr.program, $1->index, 1, INTEGER, $3, exnewnode(expr.program, ';', 1, 0, NiL, $5));
 
270
                }
 
271
                |       SWITCH '(' expr {expr.declare=$3->type;} ')' '{' switch_list '}'
 
272
                {
 
273
                        register Switch_t*      sw = expr.swstate;
 
274
 
 
275
                        $$ = exnewnode(expr.program, $1->index, 1, INTEGER, $3, exnewnode(expr.program, DEFAULT, 1, 0, sw->defcase, sw->firstcase));
 
276
                        expr.swstate = expr.swstate->prev;
 
277
                        if (sw->base)
 
278
                                free(sw->base);
 
279
                        if (sw != &swstate)
 
280
                                free(sw);
 
281
                }
 
282
                |       BREAK expr_opt ';'
 
283
                {
 
284
                loopop:
 
285
                        if (!$2)
 
286
                        {
 
287
                                $2 = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
 
288
                                $2->data.constant.value.integer = 1;
 
289
                        }
 
290
                        else if (!INTEGRAL($2->type))
 
291
                                $2 = excast(expr.program, $2, INTEGER, NiL, 0);
 
292
                        $$ = exnewnode(expr.program, $1->index, 1, INTEGER, $2, NiL);
 
293
                }
 
294
                |       CONTINUE expr_opt ';'
 
295
                {
 
296
                        goto loopop;
 
297
                }
 
298
                |       RETURN expr_opt ';'
 
299
                {
 
300
                        if ($2)
 
301
                        {
 
302
                                if (expr.procedure && !expr.procedure->type)
 
303
                                        exerror("return in void function");
 
304
                                $2 = excast(expr.program, $2, expr.procedure ? expr.procedure->type : INTEGER, NiL, 0);
 
305
                        }
 
306
                        $$ = exnewnode(expr.program, RETURN, 1, $2 ? $2->type : 0, $2, NiL);
 
307
                }
 
308
                ;
 
309
 
 
310
switch_list     :       /* empty */
 
311
                {
 
312
                        register Switch_t*              sw;
 
313
                        int                             n;
 
314
 
 
315
                        if (expr.swstate)
 
316
                        {
 
317
                                if (!(sw = newof(0, Switch_t, 1, 0)))
 
318
                                {
 
319
                                        exerror("out of space [switch]");
 
320
                                        sw = &swstate;
 
321
                                }
 
322
                                sw->prev = expr.swstate;
 
323
                        }
 
324
                        else sw = &swstate;
 
325
                        expr.swstate = sw;
 
326
                        sw->type = expr.declare;
 
327
                        sw->firstcase = 0;
 
328
                        sw->lastcase = 0;
 
329
                        sw->defcase = 0;
 
330
                        sw->def = 0;
 
331
                        n = 8;
 
332
                        if (!(sw->base = newof(0, Extype_t*, n, 0)))
 
333
                        {
 
334
                                exerror("out of space [case]");
 
335
                                n = 0;
 
336
                        }
 
337
                        sw->cur = sw->base;
 
338
                        sw->last = sw->base + n;
 
339
                }
 
340
                |       switch_list switch_item
 
341
                ;
 
342
 
 
343
switch_item     :       case_list statement_list
 
344
                {
 
345
                        register Switch_t*      sw = expr.swstate;
 
346
                        int                     n;
 
347
 
 
348
                        $$ = exnewnode(expr.program, CASE, 1, 0, $2, NiL);
 
349
                        if (sw->cur > sw->base)
 
350
                        {
 
351
                                if (sw->lastcase)
 
352
                                        sw->lastcase->data.select.next = $$;
 
353
                                else sw->firstcase = $$;
 
354
                                sw->lastcase = $$;
 
355
                                n = sw->cur - sw->base;
 
356
                                sw->cur = sw->base;
 
357
                                $$->data.select.constant = (Extype_t**)exalloc(expr.program, (n + 1) * sizeof(Extype_t*));
 
358
                                memcpy($$->data.select.constant, sw->base, n * sizeof(Extype_t*));
 
359
                                $$->data.select.constant[n] = 0;
 
360
                        }
 
361
                        else $$->data.select.constant = 0;
 
362
                        if (sw->def)
 
363
                        {
 
364
                                sw->def = 0;
 
365
                                if (sw->defcase)
 
366
                                        exerror("duplicate default in switch");
 
367
                                else sw->defcase = $2;
 
368
                        }
 
369
                }
 
370
                ;
 
371
 
 
372
case_list       :       case_item
 
373
                |       case_list case_item
 
374
                ;
 
375
 
 
376
case_item       :       CASE constant ':'
 
377
                {
 
378
                        int     n;
 
379
 
 
380
                        if (expr.swstate->cur >= expr.swstate->last)
 
381
                        {
 
382
                                n = expr.swstate->cur - expr.swstate->base;
 
383
                                if (!(expr.swstate->base = newof(expr.swstate->base, Extype_t*, 2 * n, 0)))
 
384
                                {
 
385
                                        exerror("too many case labels for switch");
 
386
                                        n = 0;
 
387
                                }
 
388
                                expr.swstate->cur = expr.swstate->base + n;
 
389
                                expr.swstate->last = expr.swstate->base + 2 * n;
 
390
                        }
 
391
                        if (expr.swstate->cur)
 
392
                        {
 
393
                                $2 = excast(expr.program, $2, expr.swstate->type, NiL, 0);
 
394
                                *expr.swstate->cur++ = &($2->data.constant.value);
 
395
                        }
 
396
                }
 
397
                |       DEFAULT ':'
 
398
                {
 
399
                        expr.swstate->def = 1;
 
400
                }
 
401
                ;
 
402
 
 
403
dcl_list        :       dcl_item
 
404
                |       dcl_list ',' dcl_item
 
405
                {
 
406
                        if ($3)
 
407
                                $$ = $1 ? exnewnode(expr.program, ',', 1, $3->type, $1, $3) : $3;
 
408
                }
 
409
                ;
 
410
 
 
411
dcl_item        :       NAME {expr.id=$1;} array initialize
 
412
                {
 
413
                        $$ = 0;
 
414
                        $1->type = expr.declare;
 
415
                        if ($4 && $4->op == PROCEDURE)
 
416
                        {
 
417
                                $1->lex = PROCEDURE;
 
418
                                $1->value = $4;
 
419
                        }
 
420
                        else
 
421
                        {
 
422
                                $1->lex = DYNAMIC;
 
423
                                $1->value = exnewnode(expr.program, 0, 0, 0, NiL, NiL);
 
424
                                if ($3 && !$1->local.pointer)
 
425
                                {
 
426
                                        Dtdisc_t*       disc;
 
427
 
 
428
                                        if (!(disc = newof(0, Dtdisc_t, 1, 0)))
 
429
                                                exerror("out of space [associative array]");
 
430
                                        disc->key = offsetof(Exassoc_t, name);
 
431
                                        if (!($1->local.pointer = (char*)dtopen(disc, Dtoset)))
 
432
                                                exerror("%s: cannot initialize associative array", $1->name);
 
433
                                }
 
434
                                if ($4)
 
435
                                {
 
436
                                        if ($4->type != $1->type)
 
437
                                        {
 
438
                                                $4->type = $1->type;
 
439
                                                $4->data.operand.right = excast(expr.program, $4->data.operand.right, $1->type, NiL, 0);
 
440
                                        }
 
441
                                        $4->data.operand.left = exnewnode(expr.program, DYNAMIC, 0, $1->type, NiL, NiL);
 
442
                                        $4->data.operand.left->data.variable.symbol = $1;
 
443
                                        $$ = $4;
 
444
                                }
 
445
                                else if (!$3)
 
446
                                        $1->value->data.value = exzero($1->type);
 
447
                        }
 
448
                }
 
449
                ;
 
450
 
 
451
name            :       NAME
 
452
                |       DYNAMIC
 
453
                ;
 
454
 
 
455
else_opt        :       /* empty */
 
456
                {
 
457
                        $$ = 0;
 
458
                }
 
459
                |       ELSE statement
 
460
                {
 
461
                        $$ = $2;
 
462
                }
 
463
                ;
 
464
 
 
465
expr_opt        :       /* empty */
 
466
                {
 
467
                        $$ = 0;
 
468
                }
 
469
                |       expr
 
470
                ;
 
471
 
 
472
expr            :       '(' expr ')'
 
473
                {
 
474
                        $$ = $2;
 
475
                }
 
476
                |       '(' DECLARE ')' expr    %prec CAST
 
477
                {
 
478
                        $$ = ($4->type == $2->type) ? $4 : excast(expr.program, $4, $2->type, NiL, 0);
 
479
                }
 
480
                |       expr '<' expr
 
481
                {
 
482
                        int     rel;
 
483
 
 
484
                relational:
 
485
                        rel = INTEGER;
 
486
                        goto coerce;
 
487
                binary:
 
488
                        rel = 0;
 
489
                coerce:
 
490
                        if (!$1->type)
 
491
                        {
 
492
                                if (!$3->type)
 
493
                                        $1->type = $3->type = rel ? STRING : INTEGER;
 
494
                                else $1->type = $3->type;
 
495
                        }
 
496
                        else if (!$3->type) $3->type = $1->type;
 
497
                        if ($1->type != $3->type)
 
498
                        {
 
499
                                if ($1->type == STRING)
 
500
                                        $1 = excast(expr.program, $1, $3->type, $3, 0);
 
501
                                else if ($3->type == STRING)
 
502
                                        $3 = excast(expr.program, $3, $1->type, $1, 0);
 
503
                                else if ($1->type == FLOATING)
 
504
                                        $3 = excast(expr.program, $3, FLOATING, $1, 0);
 
505
                                else if ($3->type == FLOATING)
 
506
                                        $1 = excast(expr.program, $1, FLOATING, $3, 0);
 
507
                        }
 
508
                        if (!rel)
 
509
                                rel = ($1->type == STRING) ? STRING : (($1->type == UNSIGNED) ? UNSIGNED : $3->type);
 
510
                        $$ = exnewnode(expr.program, $2, 1, rel, $1, $3);
 
511
                        if (!expr.program->errors && $1->op == CONSTANT && $3->op == CONSTANT)
 
512
                        {
 
513
                                expr.program->vc = expr.program->vm;
 
514
                                $$->data.constant.value = exeval(expr.program, $$, NiL);
 
515
                                expr.program->vc = expr.program->ve;
 
516
                                $$->binary = 0;
 
517
                                $$->op = CONSTANT;
 
518
                                exfreenode(expr.program, $1);
 
519
                                exfreenode(expr.program, $3);
 
520
                        }
 
521
                }
 
522
                |       expr '-' expr
 
523
                {
 
524
                        goto binary;
 
525
                }
 
526
                |       expr '*' expr
 
527
                {
 
528
                        goto binary;
 
529
                }
 
530
                |       expr '/' expr
 
531
                {
 
532
                        goto binary;
 
533
                }
 
534
                |       expr '%' expr
 
535
                {
 
536
                        goto binary;
 
537
                }
 
538
                |       expr LS expr
 
539
                {
 
540
                        goto binary;
 
541
                }
 
542
                |       expr RS expr
 
543
                {
 
544
                        goto binary;
 
545
                }
 
546
                |       expr '>' expr
 
547
                {
 
548
                        goto relational;
 
549
                }
 
550
                |       expr LE expr
 
551
                {
 
552
                        goto relational;
 
553
                }
 
554
                |       expr GE expr
 
555
                {
 
556
                        goto relational;
 
557
                }
 
558
                |       expr EQ expr
 
559
                {
 
560
                        goto relational;
 
561
                }
 
562
                |       expr NE expr
 
563
                {
 
564
                        goto relational;
 
565
                }
 
566
                |       expr '&' expr
 
567
                {
 
568
                        goto binary;
 
569
                }
 
570
                |       expr '|' expr
 
571
                {
 
572
                        goto binary;
 
573
                }
 
574
                |       expr '^' expr
 
575
                {
 
576
                        goto binary;
 
577
                }
 
578
                |       expr '+' expr
 
579
                {
 
580
                        goto binary;
 
581
                }
 
582
                |       expr AND expr
 
583
                {
 
584
                logical:
 
585
                        if ($1->type == STRING)
 
586
                                $1 = exnewnode(expr.program, S2B, 1, INTEGER, $1, NiL);
 
587
                        if ($3->type == STRING)
 
588
                                $3 = exnewnode(expr.program, S2B, 1, INTEGER, $3, NiL);
 
589
                        goto binary;
 
590
                }
 
591
                |       expr OR expr
 
592
                {
 
593
                        goto logical;
 
594
                }
 
595
                |       expr ',' expr
 
596
                {
 
597
                        if ($1->op == CONSTANT)
 
598
                        {
 
599
                                exfreenode(expr.program, $1);
 
600
                                $$ = $3;
 
601
                        }
 
602
                        else $$ = exnewnode(expr.program, ',', 1, $3->type, $1, $3);
 
603
                }
 
604
                |       expr '?' {expr.nolabel=1;} expr ':' {expr.nolabel=0;} expr
 
605
                {
 
606
                        if (!$4->type)
 
607
                        {
 
608
                                if (!$7->type)
 
609
                                        $4->type = $7->type = INTEGER;
 
610
                                else $4->type = $7->type;
 
611
                        }
 
612
                        else if (!$7->type)
 
613
                                $7->type = $4->type;
 
614
                        if ($1->type == STRING)
 
615
                                $1 = exnewnode(expr.program, S2B, 1, INTEGER, $1, NiL);
 
616
                        else if (!INTEGRAL($1->type))
 
617
                                $1 = excast(expr.program, $1, INTEGER, NiL, 0);
 
618
                        if ($4->type != $7->type)
 
619
                        {
 
620
                                if ($4->type == STRING || $7->type == STRING)
 
621
                                        exerror("if statement string type mismatch");
 
622
                                else if ($4->type == FLOATING)
 
623
                                        $7 = excast(expr.program, $7, FLOATING, NiL, 0);
 
624
                                else if ($7->type == FLOATING)
 
625
                                        $4 = excast(expr.program, $4, FLOATING, NiL, 0);
 
626
                        }
 
627
                        if ($1->op == CONSTANT)
 
628
                        {
 
629
                                if ($1->data.constant.value.integer)
 
630
                                {
 
631
                                        $$ = $4;
 
632
                                        exfreenode(expr.program, $7);
 
633
                                }
 
634
                                else
 
635
                                {
 
636
                                        $$ = $7;
 
637
                                        exfreenode(expr.program, $4);
 
638
                                }
 
639
                                exfreenode(expr.program, $1);
 
640
                        }
 
641
                        else $$ = exnewnode(expr.program, '?', 1, $4->type, $1, exnewnode(expr.program, ':', 1, $4->type, $4, $7));
 
642
                }
 
643
                |       '!' expr
 
644
                {
 
645
                iunary:
 
646
                        if ($2->type == STRING)
 
647
                                $2 = exnewnode(expr.program, S2B, 1, INTEGER, $2, NiL);
 
648
                        else if (!INTEGRAL($2->type))
 
649
                                $2 = excast(expr.program, $2, INTEGER, NiL, 0);
 
650
                unary:
 
651
                        $$ = exnewnode(expr.program, $1, 1, $2->type == UNSIGNED ? INTEGER : $2->type, $2, NiL);
 
652
                        if ($2->op == CONSTANT)
 
653
                        {
 
654
                                $$->data.constant.value = exeval(expr.program, $$, NiL);
 
655
                                $$->binary = 0;
 
656
                                $$->op = CONSTANT;
 
657
                                exfreenode(expr.program, $2);
 
658
                        }
 
659
                }
 
660
                |       '~' expr
 
661
                {
 
662
                        goto iunary;
 
663
                }
 
664
                |       '-' expr        %prec UNARY
 
665
                {
 
666
                        goto unary;
 
667
                }
 
668
                |       '+' expr        %prec UNARY
 
669
                {
 
670
                        $$ = $2;
 
671
                }
 
672
                |       FUNCTION '(' args ')'
 
673
                {
 
674
                        $$ = exnewnode(expr.program, FUNCTION, 1, T($1->type), call(0, $1, $3), $3);
 
675
                }
 
676
                |       EXIT '(' expr ')'
 
677
                {
 
678
                        if (!INTEGRAL($3->type))
 
679
                                $3 = excast(expr.program, $3, INTEGER, NiL, 0);
 
680
                        $$ = exnewnode(expr.program, EXIT, 1, INTEGER, $3, NiL);
 
681
                }
 
682
                |       PROCEDURE '(' args ')'
 
683
                {
 
684
                        $$ = exnewnode(expr.program, CALL, 1, $1->type, NiL, $3);
 
685
                        $$->data.call.procedure = $1;
 
686
                }
 
687
                |       print '(' args ')'
 
688
                {
 
689
                        $$ = exnewnode(expr.program, $1->index, 0, $1->type, NiL, NiL);
 
690
                        if ($3 && $3->data.operand.left->type == INTEGER)
 
691
                        {
 
692
                                $$->data.print.descriptor = $3->data.operand.left;
 
693
                                $3 = $3->data.operand.right;
 
694
                        }
 
695
                        else switch ($1->index)
 
696
                        {
 
697
                        case QUERY:
 
698
                                $$->data.print.descriptor = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
 
699
                                $$->data.print.descriptor->data.constant.value.integer = 2;
 
700
                                break;
 
701
                        case PRINTF:
 
702
                                $$->data.print.descriptor = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
 
703
                                $$->data.print.descriptor->data.constant.value.integer = 1;
 
704
                                break;
 
705
                        case SPRINTF:
 
706
                                $$->data.print.descriptor = 0;
 
707
                                break;
 
708
                        }
 
709
                        $$->data.print.args = preprint($3);
 
710
                }
 
711
                |       variable assign
 
712
                {
 
713
                        if ($2)
 
714
                        {
 
715
                                if ($1->op == ID && !expr.program->disc->setf)
 
716
                                        exerror("%s: variable assignment not supported", $1->data.variable.symbol->name);
 
717
                                else
 
718
                                {
 
719
                                        if (!$1->type)
 
720
                                                $1->type = $2->type;
 
721
#if 0
 
722
                                        else if ($2->type != $1->type && $1->type >= 0200)
 
723
#else
 
724
                                        else if ($2->type != $1->type)
 
725
#endif
 
726
                                        {
 
727
                                                $2->type = $1->type;
 
728
                                                $2->data.operand.right = excast(expr.program, $2->data.operand.right, $1->type, NiL, 0);
 
729
                                        }
 
730
                                        $2->data.operand.left = $1;
 
731
                                        $$ = $2;
 
732
                                }
 
733
                        }
 
734
                }
 
735
                |       INC variable
 
736
                {
 
737
                pre:
 
738
                        if ($2->type == STRING)
 
739
                                exerror("++ and -- invalid for string variables");
 
740
                        $$ = exnewnode(expr.program, $1, 0, $2->type, $2, NiL);
 
741
                        $$->subop = PRE;
 
742
                }
 
743
                |       variable INC
 
744
                {
 
745
                pos:
 
746
                        if ($1->type == STRING)
 
747
                                exerror("++ and -- invalid for string variables");
 
748
                        $$ = exnewnode(expr.program, $2, 0, $1->type, $1, NiL);
 
749
                        $$->subop = POS;
 
750
                }
 
751
                |       DEC variable
 
752
                {
 
753
                        goto pre;
 
754
                }
 
755
                |       variable DEC
 
756
                {
 
757
                        goto pos;
 
758
                }
 
759
                |       constant
 
760
                ;
 
761
 
 
762
constant        :       CONSTANT
 
763
                {
 
764
                        $$ = exnewnode(expr.program, CONSTANT, 0, $1->type, NiL, NiL);
 
765
                        if (!expr.program->disc->reff)
 
766
                                exerror("%s: identifier references not supported", $1->name);
 
767
                        else $$->data.constant.value = (*expr.program->disc->reff)(expr.program, $$, $1, NiL, NiL, EX_SCALAR, expr.program->disc);
 
768
                }
 
769
                |       FLOATING
 
770
                {
 
771
                        $$ = exnewnode(expr.program, CONSTANT, 0, FLOATING, NiL, NiL);
 
772
                        $$->data.constant.value.floating = $1;
 
773
                }
 
774
                |       INTEGER
 
775
                {
 
776
                        $$ = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
 
777
                        $$->data.constant.value.integer = $1;
 
778
                }
 
779
                |       STRING
 
780
                {
 
781
                        $$ = exnewnode(expr.program, CONSTANT, 0, STRING, NiL, NiL);
 
782
                        $$->data.constant.value.string = $1;
 
783
                }
 
784
                |       UNSIGNED
 
785
                {
 
786
                        $$ = exnewnode(expr.program, CONSTANT, 0, UNSIGNED, NiL, NiL);
 
787
                        $$->data.constant.value.integer = $1;
 
788
                }
 
789
                ;
 
790
 
 
791
print           :       PRINTF
 
792
                |       QUERY
 
793
                |       SPRINTF
 
794
                ;
 
795
 
 
796
variable        :       ID members
 
797
                {
 
798
                        $$ = makeVar(expr.program, $1, 0, 0, $2);
 
799
                }
 
800
                |       DYNAMIC index members
 
801
                {
 
802
            Exnode_t*   n;
 
803
 
 
804
            n = exnewnode(expr.program, DYNAMIC, 0, $1->type, NiL, NiL);
 
805
            n->data.variable.symbol = $1;
 
806
            n->data.variable.reference = 0;
 
807
            if (((n->data.variable.index = $2) == 0) != ($1->local.pointer ==
 
808
0))
 
809
              exerror("%s: is%s an array", $1->name, $1->local.pointer ? "" : " not");
 
810
                        if ($3) {
 
811
              n->data.variable.dyna =exnewnode(expr.program, 0, 0, 0, NiL, NiL);
 
812
              $$ = makeVar(expr.program, $1, $2, n, $3);
 
813
            }
 
814
            else $$ = n;
 
815
                }
 
816
                |       NAME
 
817
                {
 
818
                        $$ = exnewnode(expr.program, ID, 0, STRING, NiL, NiL);
 
819
                        $$->data.variable.symbol = $1;
 
820
                        $$->data.variable.reference = 0;
 
821
                        $$->data.variable.index = 0;
 
822
                        $$->data.variable.dyna = 0;
 
823
                        if (!(expr.program->disc->flags & EX_UNDECLARED))
 
824
                                exerror("unknown identifier");
 
825
                }
 
826
                ;
 
827
 
 
828
array           :       /* empty */
 
829
                {
 
830
                        $$ = 0;
 
831
                }
 
832
                |       '[' ']'
 
833
                {
 
834
                        $$ = 1;
 
835
                }
 
836
                ;
 
837
 
 
838
index           :       /* empty */
 
839
                {
 
840
                        $$ = 0;
 
841
                }
 
842
                |       '[' expr ']'
 
843
                {
 
844
                        $$ = $2;
 
845
                }
 
846
                ;
 
847
 
 
848
args            :       /* empty */
 
849
                {
 
850
                        $$ = 0;
 
851
                }
 
852
                |       arg_list
 
853
                {
 
854
                        $$ = $1->data.operand.left;
 
855
                        $1->data.operand.left = $1->data.operand.right = 0;
 
856
                        exfreenode(expr.program, $1);
 
857
                }
 
858
                ;
 
859
 
 
860
arg_list        :       expr            %prec ','
 
861
                {
 
862
                        $$ = exnewnode(expr.program, ',', 1, 0, exnewnode(expr.program, ',', 1, $1->type, $1, NiL), NiL);
 
863
                        $$->data.operand.right = $$->data.operand.left;
 
864
                }
 
865
                |       arg_list ',' expr
 
866
                {
 
867
                        $1->data.operand.right = $1->data.operand.right->data.operand.right = exnewnode(expr.program, ',', 1, $1->type, $3, NiL);
 
868
                }
 
869
                ;
 
870
 
 
871
formals         :       /* empty */
 
872
                {
 
873
                        $$ = 0;
 
874
                }
 
875
                |       DECLARE
 
876
                {
 
877
                        $$ = 0;
 
878
                        if ($1->type)
 
879
                                exerror("(void) expected");
 
880
                }
 
881
                |       formal_list
 
882
                ;
 
883
 
 
884
formal_list     :       formal_item
 
885
                {
 
886
                        $$ = exnewnode(expr.program, ',', 1, $1->type, $1, NiL);
 
887
                }
 
888
                |       formal_list ',' formal_item
 
889
                {
 
890
                        register Exnode_t*      x;
 
891
                        register Exnode_t*      y;
 
892
 
 
893
                        $$ = $1;
 
894
                        for (x = $1; y = x->data.operand.right; x = y);
 
895
                        x->data.operand.right = exnewnode(expr.program, ',', 1, $3->type, $3, NiL);
 
896
                }
 
897
                ;
 
898
 
 
899
formal_item     :       DECLARE {expr.declare=$1->type;} name
 
900
                {
 
901
                        $$ = exnewnode(expr.program, ID, 0, $3->type, NiL, NiL);
 
902
                        $$->data.variable.symbol = $3;
 
903
                        $3->lex = DYNAMIC;
 
904
                        $3->value = exnewnode(expr.program, 0, 0, 0, NiL, NiL);
 
905
                        expr.procedure->data.procedure.arity++;
 
906
                }
 
907
                ;
 
908
 
 
909
members :       /* empty */
 
910
                {
 
911
                        $$ = expr.refs = expr.lastref = 0;
 
912
                }
 
913
                |       member
 
914
                {
 
915
                        Exref_t*        r;
 
916
 
 
917
                        r = ALLOCATE(expr.program, Exref_t);
 
918
                        r->symbol = $1;
 
919
                        expr.refs = r;
 
920
                        expr.lastref = r;
 
921
                        r->next = 0;
 
922
                        r->index = 0;
 
923
                        $$ = expr.refs;
 
924
                }
 
925
                |       '.' ID member
 
926
        {
 
927
                        Exref_t*        r;
 
928
                        Exref_t*        l;
 
929
 
 
930
                        r = ALLOCATE(expr.program, Exref_t);
 
931
                        r->symbol = $3;
 
932
                        r->index = 0;
 
933
                        r->next = 0;
 
934
                        l = ALLOCATE(expr.program, Exref_t);
 
935
                        l->symbol = $2;
 
936
                        l->index = 0;
 
937
                        l->next = r;
 
938
                        expr.refs = l;
 
939
                        expr.lastref = r;
 
940
                        $$ = expr.refs;
 
941
        }
 
942
                ;
 
943
 
 
944
member  :       '.' ID
 
945
                {
 
946
                        $$ = $2;
 
947
                }
 
948
                |       '.' NAME
 
949
                {
 
950
                        $$ = $2;
 
951
                }
 
952
 
 
953
assign          :       /* empty */
 
954
                {
 
955
                        $$ = 0;
 
956
                }
 
957
                |       '=' expr
 
958
                {
 
959
                        $$ = exnewnode(expr.program, '=', 1, $2->type, NiL, $2);
 
960
                        $$->subop = $1;
 
961
                }
 
962
                ;
 
963
 
 
964
initialize      :       assign
 
965
                |       '(' {
 
966
                                register Dtdisc_t*      disc;
 
967
 
 
968
                                if (expr.procedure)
 
969
                                        exerror("no nested function definitions");
 
970
                                expr.procedure = exnewnode(expr.program, PROCEDURE, 1, expr.declare, NiL, NiL);
 
971
                                if (!(disc = newof(0, Dtdisc_t, 1, 0)))
 
972
                                        exerror("out of space [frame discipline]");
 
973
                                disc->key = offsetof(Exid_t, name);
 
974
                                if (!(expr.procedure->data.procedure.frame = dtopen(disc, Dtset)) || !dtview(expr.procedure->data.procedure.frame, expr.program->symbols))
 
975
                                        exerror("out of space [frame table]");
 
976
                                expr.program->symbols = expr.program->frame = expr.procedure->data.procedure.frame;
 
977
                                expr.program->formals = 1;
 
978
                        } formals {
 
979
                                expr.program->formals = 0;
 
980
                                expr.id->lex = PROCEDURE;
 
981
                                expr.id->type = expr.declare;
 
982
                        } ')' '{' statement_list '}'
 
983
                {
 
984
                        $$ = expr.procedure;
 
985
                        expr.procedure = 0;
 
986
                        if (expr.program->frame)
 
987
                        {
 
988
                                expr.program->symbols = expr.program->frame->view;
 
989
                                dtview(expr.program->frame, NiL);
 
990
                        }
 
991
                        $$->data.operand.left = $3;
 
992
                        $$->data.operand.right = excast(expr.program, $7, $$->type, NiL, 0);
 
993
 
 
994
                        /*
 
995
                         * NOTE: procedure definition was slipped into the
 
996
                         *       declaration initializer statement production,
 
997
                         *       therefore requiring the statement terminator
 
998
                         */
 
999
 
 
1000
                        exunlex(expr.program, ';');
 
1001
                }
 
1002
                ;
 
1003
 
 
1004
%%
 
1005
 
 
1006
#include "exgram.h"