9
* expression library grammar and compiler
11
* NOTE: procedure arguments not implemented yet
17
#undef RS /* hp.pa <signal.h> grabs this!! */
25
struct Exref_s* reference;
31
struct Exbuf_s* buffer;
99
%binary <op> '<' '>' LE GE
102
%left <op> '*' '/' '%'
103
%right <op> '!' '~' UNARY
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
136
program : statement_list action_list
138
if ($1 && !(expr.program->disc->flags & EX_STRICT))
140
if (expr.program->main.value && !(expr.program->disc->flags & EX_RETAIN))
141
exfreenode(expr.program, expr.program->main.value);
147
$1 = x->data.operand.left;
148
x->data.operand.left = 0;
149
exfreenode(expr.program, x);
151
expr.program->main.lex = PROCEDURE;
152
expr.program->main.value = exnewnode(expr.program, PROCEDURE, 1, $1->type, NiL, $1);
157
action_list : /* empty */
162
register Dtdisc_t* disc;
165
exerror("no nested function definitions");
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;
178
if (expr.program->frame)
180
expr.program->symbols = expr.program->frame->view;
181
dtview(expr.program->frame, NiL);
183
if ($4 && $4->op == S2B)
188
$4 = x->data.operand.left;
189
x->data.operand.left = 0;
190
exfreenode(expr.program, x);
192
$1->value->data.operand.right = excast(expr.program, $4, $1->type, NiL, 0);
196
statement_list : /* empty */
200
| statement_list statement
206
else if ($1->op == CONSTANT)
208
exfreenode(expr.program, $1);
211
else $$ = exnewnode(expr.program, ';', 1, $2->type, $1, $2);
215
statement : '{' statement_list '}'
221
$$ = ($1 && $1->type == STRING) ? exnewnode(expr.program, S2B, 1, INTEGER, $1, NiL) : $1;
223
| DECLARE {expr.declare=$1->type;} dcl_list ';'
227
| IF '(' expr ')' statement else_opt
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));
235
| FOR '(' variable ')' statement
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;
248
| FOR '(' expr_opt ';' expr_opt ';' expr_opt ')' statement
252
$5 = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
253
$5->data.constant.value.integer = 1;
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));
261
$$ = exnewnode(expr.program, ';', 1, INTEGER, $3, $$);
263
| WHILE '(' expr ')' statement
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));
271
| SWITCH '(' expr {expr.declare=$3->type;} ')' '{' switch_list '}'
273
register Switch_t* sw = expr.swstate;
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;
287
$2 = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
288
$2->data.constant.value.integer = 1;
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);
294
| CONTINUE expr_opt ';'
298
| RETURN expr_opt ';'
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);
306
$$ = exnewnode(expr.program, RETURN, 1, $2 ? $2->type : 0, $2, NiL);
310
switch_list : /* empty */
312
register Switch_t* sw;
317
if (!(sw = newof(0, Switch_t, 1, 0)))
319
exerror("out of space [switch]");
322
sw->prev = expr.swstate;
326
sw->type = expr.declare;
332
if (!(sw->base = newof(0, Extype_t*, n, 0)))
334
exerror("out of space [case]");
338
sw->last = sw->base + n;
340
| switch_list switch_item
343
switch_item : case_list statement_list
345
register Switch_t* sw = expr.swstate;
348
$$ = exnewnode(expr.program, CASE, 1, 0, $2, NiL);
349
if (sw->cur > sw->base)
352
sw->lastcase->data.select.next = $$;
353
else sw->firstcase = $$;
355
n = 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;
361
else $$->data.select.constant = 0;
366
exerror("duplicate default in switch");
367
else sw->defcase = $2;
372
case_list : case_item
373
| case_list case_item
376
case_item : CASE constant ':'
380
if (expr.swstate->cur >= expr.swstate->last)
382
n = expr.swstate->cur - expr.swstate->base;
383
if (!(expr.swstate->base = newof(expr.swstate->base, Extype_t*, 2 * n, 0)))
385
exerror("too many case labels for switch");
388
expr.swstate->cur = expr.swstate->base + n;
389
expr.swstate->last = expr.swstate->base + 2 * n;
391
if (expr.swstate->cur)
393
$2 = excast(expr.program, $2, expr.swstate->type, NiL, 0);
394
*expr.swstate->cur++ = &($2->data.constant.value);
399
expr.swstate->def = 1;
404
| dcl_list ',' dcl_item
407
$$ = $1 ? exnewnode(expr.program, ',', 1, $3->type, $1, $3) : $3;
411
dcl_item : NAME {expr.id=$1;} array initialize
414
$1->type = expr.declare;
415
if ($4 && $4->op == PROCEDURE)
423
$1->value = exnewnode(expr.program, 0, 0, 0, NiL, NiL);
424
if ($3 && !$1->local.pointer)
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);
436
if ($4->type != $1->type)
439
$4->data.operand.right = excast(expr.program, $4->data.operand.right, $1->type, NiL, 0);
441
$4->data.operand.left = exnewnode(expr.program, DYNAMIC, 0, $1->type, NiL, NiL);
442
$4->data.operand.left->data.variable.symbol = $1;
446
$1->value->data.value = exzero($1->type);
455
else_opt : /* empty */
465
expr_opt : /* empty */
476
| '(' DECLARE ')' expr %prec CAST
478
$$ = ($4->type == $2->type) ? $4 : excast(expr.program, $4, $2->type, NiL, 0);
493
$1->type = $3->type = rel ? STRING : INTEGER;
494
else $1->type = $3->type;
496
else if (!$3->type) $3->type = $1->type;
497
if ($1->type != $3->type)
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);
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)
513
expr.program->vc = expr.program->vm;
514
$$->data.constant.value = exeval(expr.program, $$, NiL);
515
expr.program->vc = expr.program->ve;
518
exfreenode(expr.program, $1);
519
exfreenode(expr.program, $3);
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);
597
if ($1->op == CONSTANT)
599
exfreenode(expr.program, $1);
602
else $$ = exnewnode(expr.program, ',', 1, $3->type, $1, $3);
604
| expr '?' {expr.nolabel=1;} expr ':' {expr.nolabel=0;} expr
609
$4->type = $7->type = INTEGER;
610
else $4->type = $7->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)
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);
627
if ($1->op == CONSTANT)
629
if ($1->data.constant.value.integer)
632
exfreenode(expr.program, $7);
637
exfreenode(expr.program, $4);
639
exfreenode(expr.program, $1);
641
else $$ = exnewnode(expr.program, '?', 1, $4->type, $1, exnewnode(expr.program, ':', 1, $4->type, $4, $7));
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);
651
$$ = exnewnode(expr.program, $1, 1, $2->type == UNSIGNED ? INTEGER : $2->type, $2, NiL);
652
if ($2->op == CONSTANT)
654
$$->data.constant.value = exeval(expr.program, $$, NiL);
657
exfreenode(expr.program, $2);
664
| '-' expr %prec UNARY
668
| '+' expr %prec UNARY
672
| FUNCTION '(' args ')'
674
$$ = exnewnode(expr.program, FUNCTION, 1, T($1->type), call(0, $1, $3), $3);
678
if (!INTEGRAL($3->type))
679
$3 = excast(expr.program, $3, INTEGER, NiL, 0);
680
$$ = exnewnode(expr.program, EXIT, 1, INTEGER, $3, NiL);
682
| PROCEDURE '(' args ')'
684
$$ = exnewnode(expr.program, CALL, 1, $1->type, NiL, $3);
685
$$->data.call.procedure = $1;
689
$$ = exnewnode(expr.program, $1->index, 0, $1->type, NiL, NiL);
690
if ($3 && $3->data.operand.left->type == INTEGER)
692
$$->data.print.descriptor = $3->data.operand.left;
693
$3 = $3->data.operand.right;
695
else switch ($1->index)
698
$$->data.print.descriptor = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
699
$$->data.print.descriptor->data.constant.value.integer = 2;
702
$$->data.print.descriptor = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
703
$$->data.print.descriptor->data.constant.value.integer = 1;
706
$$->data.print.descriptor = 0;
709
$$->data.print.args = preprint($3);
715
if ($1->op == ID && !expr.program->disc->setf)
716
exerror("%s: variable assignment not supported", $1->data.variable.symbol->name);
722
else if ($2->type != $1->type && $1->type >= 0200)
724
else if ($2->type != $1->type)
728
$2->data.operand.right = excast(expr.program, $2->data.operand.right, $1->type, NiL, 0);
730
$2->data.operand.left = $1;
738
if ($2->type == STRING)
739
exerror("++ and -- invalid for string variables");
740
$$ = exnewnode(expr.program, $1, 0, $2->type, $2, NiL);
746
if ($1->type == STRING)
747
exerror("++ and -- invalid for string variables");
748
$$ = exnewnode(expr.program, $2, 0, $1->type, $1, NiL);
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);
771
$$ = exnewnode(expr.program, CONSTANT, 0, FLOATING, NiL, NiL);
772
$$->data.constant.value.floating = $1;
776
$$ = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
777
$$->data.constant.value.integer = $1;
781
$$ = exnewnode(expr.program, CONSTANT, 0, STRING, NiL, NiL);
782
$$->data.constant.value.string = $1;
786
$$ = exnewnode(expr.program, CONSTANT, 0, UNSIGNED, NiL, NiL);
787
$$->data.constant.value.integer = $1;
796
variable : ID members
798
$$ = makeVar(expr.program, $1, 0, 0, $2);
800
| DYNAMIC index members
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 ==
809
exerror("%s: is%s an array", $1->name, $1->local.pointer ? "" : " not");
811
n->data.variable.dyna =exnewnode(expr.program, 0, 0, 0, NiL, NiL);
812
$$ = makeVar(expr.program, $1, $2, n, $3);
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");
854
$$ = $1->data.operand.left;
855
$1->data.operand.left = $1->data.operand.right = 0;
856
exfreenode(expr.program, $1);
860
arg_list : expr %prec ','
862
$$ = exnewnode(expr.program, ',', 1, 0, exnewnode(expr.program, ',', 1, $1->type, $1, NiL), NiL);
863
$$->data.operand.right = $$->data.operand.left;
867
$1->data.operand.right = $1->data.operand.right->data.operand.right = exnewnode(expr.program, ',', 1, $1->type, $3, NiL);
871
formals : /* empty */
879
exerror("(void) expected");
884
formal_list : formal_item
886
$$ = exnewnode(expr.program, ',', 1, $1->type, $1, NiL);
888
| formal_list ',' formal_item
890
register Exnode_t* x;
891
register Exnode_t* y;
894
for (x = $1; y = x->data.operand.right; x = y);
895
x->data.operand.right = exnewnode(expr.program, ',', 1, $3->type, $3, NiL);
899
formal_item : DECLARE {expr.declare=$1->type;} name
901
$$ = exnewnode(expr.program, ID, 0, $3->type, NiL, NiL);
902
$$->data.variable.symbol = $3;
904
$3->value = exnewnode(expr.program, 0, 0, 0, NiL, NiL);
905
expr.procedure->data.procedure.arity++;
909
members : /* empty */
911
$$ = expr.refs = expr.lastref = 0;
917
r = ALLOCATE(expr.program, Exref_t);
930
r = ALLOCATE(expr.program, Exref_t);
934
l = ALLOCATE(expr.program, Exref_t);
959
$$ = exnewnode(expr.program, '=', 1, $2->type, NiL, $2);
966
register Dtdisc_t* disc;
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;
979
expr.program->formals = 0;
980
expr.id->lex = PROCEDURE;
981
expr.id->type = expr.declare;
982
} ')' '{' statement_list '}'
986
if (expr.program->frame)
988
expr.program->symbols = expr.program->frame->view;
989
dtview(expr.program->frame, NiL);
991
$$->data.operand.left = $3;
992
$$->data.operand.right = excast(expr.program, $7, $$->type, NiL, 0);
995
* NOTE: procedure definition was slipped into the
996
* declaration initializer statement production,
997
* therefore requiring the statement terminator
1000
exunlex(expr.program, ';');