|
|
1 /*
2 * LPC grammar, handles construction of parse trees and type checking.
3 * Currently there is one shift/reduce conflict, on else.
4 * The node->mod field is used to store the type of an expression. (!)
5 */
6
7 %{
8
9 # define INCLUDE_CTYPE
10 # include "comp.h"
11 # include "str.h"
12 # include "array.h"
13 # include "object.h"
14 # include "xfloat.h"
15 # include "interpret.h"
16 # include "macro.h"
17 # include "token.h"
18 # include "ppcontrol.h"
19 # include "node.h"
20 # include "compile.h"
21
22 # define yylex pp_gettok
23 # define yyerror c_error
24
25 int nerrors; /* number of errors encountered so far */
26 static int ndeclarations; /* number of declarations */
27 static int nstatements; /* number of statements in current function */
28 static bool typechecking; /* does the current function have it? */
29
30 static node *varargs P((node*, node*));
31 static void t_void P((node*));
32 static bool t_unary P((node*, char*));
33 static node *uassign P((int, node*, char*));
34 static node *cast P((node*, unsigned int));
35 static node *idx P((node*, node*));
36 static node *range P((node*, node*, node*));
37 static node *bini P((int, node*, node*, char*));
38 static node *bina P((int, node*, node*, char*));
39 static node *mult P((int, node*, node*, char*));
40 static node *mdiv P((int, node*, node*, char*));
41 static node *mod P((int, node*, node*, char*));
42 static node *add P((int, node*, node*, char*));
43 static node *sub P((int, node*, node*, char*));
44 static node *umin P((node*));
45 static node *lshift P((int, node*, node*, char*));
46 static node *rshift P((int, node*, node*, char*));
47 static node *rel P((int, node*, node*, char*));
48 static node *eq P((node*, node*));
49 static node *and P((int, node*, node*, char*));
50 static node *xor P((int, node*, node*, char*));
51 static node *or P((int, node*, node*, char*));
52 static node *land P((node*, node*));
53 static node *lor P((node*, node*));
54 static node *quest P((node*, node*, node*));
55 static node *assign P((node*, node*));
56 static node *comma P((node*, node*));
57
58 %}
59
60
61 /*
62 * Keywords. The order is determined in tokenz() in the lexical scanner.
63 */
64 %token STRING NOMASK NIL BREAK ELSE CASE WHILE DEFAULT STATIC CONTINUE INT
65 RLIMITS FLOAT FOR INHERIT VOID IF CATCH SWITCH VARARGS MAPPING PRIVATE
66 DO RETURN ATOMIC MIXED OBJECT
67
68 /*
69 * composite tokens
70 */
71 %token ARROW PLUS_PLUS MIN_MIN LSHIFT RSHIFT LE GE EQ NE LAND LOR
72 PLUS_EQ MIN_EQ MULT_EQ DIV_EQ MOD_EQ LSHIFT_EQ RSHIFT_EQ AND_EQ
73 XOR_EQ OR_EQ COLON_COLON DOT_DOT ELLIPSIS STRING_CONST IDENTIFIER
74
75 %union {
76 Int number; /* lex input */
77 xfloat real; /* lex input */
78 unsigned short type; /* internal */
79 struct _node_ *node; /* internal */
80 }
81
82 /*
83 * token types
84 */
85 %token <number> INT_CONST
86 %token <real> FLOAT_CONST
87
88 /*
89 * lexical scanner tokens
90 */
91 %token MARK HASH HASH_HASH INCL_CONST NR_TOKENS
92
93 /*
94 * rule types
95 */
96 %type <type> class_specifier_list class_specifier_list2 class_specifier
97 opt_private non_private type_specifier star_list
98 %type <node> opt_inherit_label string inherit_string formals_declaration
99 formal_declaration_list formal_declaration data_dcltr
100 function_dcltr dcltr list_dcltr dcltr_or_stmt_list dcltr_or_stmt
101 stmt compound_stmt opt_caught_stmt function_name primary_p1_exp
102 primary_p2_exp postfix_exp prefix_exp cast_exp mult_oper_exp
103 add_oper_exp shift_oper_exp rel_oper_exp equ_oper_exp
104 bitand_oper_exp bitxor_oper_exp bitor_oper_exp and_oper_exp
105 or_oper_exp cond_exp exp list_exp opt_list_exp f_list_exp
106 f_opt_list_exp arg_list opt_arg_list opt_arg_list_comma assoc_exp
107 assoc_arg_list opt_assoc_arg_list_comma ident
108
109 %%
110
111 program
112 : {
113 nerrors = 0;
114 ndeclarations = 0;
115 }
116 top_level_declarations
117 {
118 if (nerrors > 0) {
119 YYABORT;
120 }
121 }
122 ;
123
124 top_level_declarations
125 : /* empty */
126 | top_level_declarations top_level_declaration
127 {
128 if (nerrors > 0) {
129 YYABORT;
130 }
131 }
132 ;
133
134 top_level_declaration
135 : opt_private INHERIT opt_inherit_label inherit_string ';'
136 {
137 if (ndeclarations > 0) {
138 c_error("inherit must precede all declarations");
139 } else if (nerrors > 0 ||
140 !c_inherit($4->l.string->text, $3, $1 != 0)) {
141 /*
142 * The object to be inherited may have been compiled;
143 * abort this compilation and possibly restart later.
144 */
145 YYABORT;
146 }
147 }
148 | data_declaration
149 { ndeclarations++; }
150 | function_declaration
151 { ndeclarations++; }
152 ;
153
154 opt_inherit_label
155 : /* empty */
156 { $$ = (node *) NULL; }
157 | ident
158 ;
159
160 ident
161 : IDENTIFIER
162 { $$ = node_str(str_new(yytext, (long) yyleng)); }
163 ;
164
165 inherit_string
166 : string
167 | inherit_string '+' string
168 { $$ = node_str(str_add($1->l.string, $3->l.string)); }
169 | '(' inherit_string ')'
170 { $$ = $2; }
171 ;
172
173 string
174 : STRING_CONST
175 { $$ = node_str(str_new(yytext, (long) yyleng)); }
176 ;
177
178 data_declaration
179 : class_specifier_list type_specifier list_dcltr ';'
180 { c_global($1, $2, $3); }
181 ;
182
183 function_declaration
184 : class_specifier_list type_specifier function_dcltr
185 {
186 typechecking = TRUE;
187 c_function($1, $2, $3);
188 }
189 compound_stmt
190 {
191 if (nerrors == 0) {
192 c_funcbody($5);
193 }
194 }
195 | class_specifier_list ident '(' formals_declaration ')'
196 {
197 typechecking = c_typechecking();
198 c_function($1, (typechecking) ? T_VOID : T_NIL,
199 node_bin(N_FUNC, 0, $2, $4));
200 }
201 compound_stmt
202 {
203 if (nerrors == 0) {
204 c_funcbody($7);
205 }
206 }
207 ;
208
209 local_data_declaration
210 : class_specifier_list type_specifier list_dcltr ';'
211 { c_local($1, $2, $3); }
212 ;
213
214 formals_declaration
215 : /* empty */
216 { $$ = (node *) NULL; }
217 | VOID { $$ = (node *) NULL; }
218 | formal_declaration_list
219 | formal_declaration_list ELLIPSIS
220 {
221 $$ = $1;
222 if ($$->type == N_PAIR) {
223 $$->r.right->mod |= T_ELLIPSIS;
224 } else {
225 $$->mod |= T_ELLIPSIS;
226 }
227 }
228 | VARARGS formal_declaration_list
229 {
230 $$ = $2;
231 $$->flags |= F_VARARGS;
232 }
233 | VARARGS formal_declaration_list ELLIPSIS
234 {
235 $$ = $2;
236 $$->flags |= F_VARARGS;
237 if ($$->type == N_PAIR) {
238 $$->r.right->mod |= T_ELLIPSIS;
239 } else {
240 $$->mod |= T_ELLIPSIS;
241 }
242 }
243 | formal_declaration_list ',' VARARGS formal_declaration_list
244 { $$ = varargs($1, $4); }
245 | formal_declaration_list ',' VARARGS formal_declaration_list ELLIPSIS
246 {
247 $$ = varargs($1, $4);
248 $$->r.right->mod |= T_ELLIPSIS;
249 }
250 ;
251
252 formal_declaration_list
253 : formal_declaration
254 | formal_declaration_list ',' formal_declaration
255 { $$ = node_bin(N_PAIR, 0, $1, $3); }
256 ;
257
258 formal_declaration
259 : type_specifier data_dcltr
260 {
261 $$ = $2;
262 $$->mod |= $1;
263 }
264 | ident {
265 $$ = $1;
266 $$->mod = T_NIL; /* only if typechecking, though */
267 }
268 ;
269
270 class_specifier_list
271 : opt_private
272 | non_private
273 | class_specifier class_specifier_list2
274 { $$ = $1 | $2; }
275 ;
276
277 class_specifier_list2
278 : class_specifier
279 | class_specifier_list2 class_specifier
280 { $$ = $1 | $2; }
281 ;
282
283 class_specifier
284 : PRIVATE
285 { $$ = C_STATIC | C_PRIVATE; }
286 | non_private
287 ;
288
289 opt_private
290 : /* empty */
291 { $$ = 0; }
292 | PRIVATE
293 { $$ = C_STATIC | C_PRIVATE; }
294 ;
295
296 non_private
297 : STATIC
298 { $$ = C_STATIC; }
299 | ATOMIC
300 { $$ = C_ATOMIC; }
301 | NOMASK
302 { $$ = C_NOMASK; }
303 | VARARGS
304 { $$ = C_VARARGS; }
305 ;
306
307 type_specifier
308 : INT { $$ = T_INT; }
309 | FLOAT { $$ = T_FLOAT; }
310 | STRING
311 { $$ = T_STRING; }
312 | OBJECT
313 { $$ = T_OBJECT; }
314 | MAPPING
315 { $$ = T_MAPPING; }
316 | MIXED { $$ = T_MIXED; }
317 | VOID { $$ = T_VOID; }
318 ;
319
320 star_list
321 : /* empty */
322 { $$ = 0; }
323 | star_list '*'
324 {
325 $$ = $1 + 1;
326 if ($$ == 1 << (8 - REFSHIFT)) {
327 c_error("too deep indirection");
328 }
329 }
330 ;
331
332 data_dcltr
333 : star_list ident
334 {
335 $$ = $2;
336 $$->mod = ($1 << REFSHIFT) & T_REF;
337 }
338 ;
339
340 function_dcltr
341 : star_list ident '(' formals_declaration ')'
342 { $$ = node_bin(N_FUNC, ($1 << REFSHIFT) & T_REF, $2, $4); }
343 ;
344
345 dcltr
346 : data_dcltr
347 | function_dcltr
348 ;
349
350 list_dcltr
351 : dcltr
352 | list_dcltr ',' dcltr
353 { $$ = node_bin(N_PAIR, 0, $1, $3); }
354 ;
355
356 dcltr_or_stmt_list
357 : /* empty */
358 { $$ = (node *) NULL; }
359 | dcltr_or_stmt_list dcltr_or_stmt
360 { $$ = c_concat($1, $2); }
361 ;
362
363 dcltr_or_stmt
364 : local_data_declaration
365 {
366 if (nstatements > 0) {
367 c_error("declaration after statement");
368 }
369 $$ = (node *) NULL;
370 }
371 | stmt {
372 nstatements++;
373 $$ = $1;
374 }
375 | error ';'
376 {
377 if (nerrors >= MAX_ERRORS) {
378 YYABORT;
379 }
380 $$ = (node *) NULL;
381 }
382 ;
383
384 stmt
385 : list_exp ';'
386 { $$ = c_exp_stmt($1); }
387 | compound_stmt
388 | IF '(' f_list_exp ')' stmt
389 { $$ = c_if($3, $5, (node *) NULL); }
390 /* will cause shift/reduce conflict */
391 | IF '(' f_list_exp ')' stmt ELSE stmt
392 { $$ = c_if($3, $5, $7); }
393 | DO { c_loop(); }
394 stmt WHILE '(' f_list_exp ')' ';'
395 { $$ = c_do($6, $3); }
396 | WHILE '(' f_list_exp ')'
397 { c_loop(); }
398 stmt { $$ = c_while($3, $6); }
399 | FOR '(' opt_list_exp ';' f_opt_list_exp ';' opt_list_exp ')'
400 { c_loop(); }
401 stmt { $$ = c_for(c_exp_stmt($3), $5, c_exp_stmt($7), $10); }
402 | RLIMITS '(' f_list_exp ';' f_list_exp ')'
403 {
404 if (typechecking) {
405 char tnbuf[17];
406
407 if ($3->mod != T_INT && $3->mod != T_MIXED) {
408 c_error("bad type for stack rlimit (%s)",
409 i_typename(tnbuf, $3->mod));
410 }
411 if ($5->mod != T_INT && $5->mod != T_MIXED) {
412 c_error("bad type for ticks rlimit (%s)",
413 i_typename(tnbuf, $5->mod));
414 }
415 }
416 c_startrlimits();
417 }
418 compound_stmt
419 { $$ = c_endrlimits($3, $5, $8); }
420 | CATCH { c_startcatch(); }
421 compound_stmt
422 { c_endcatch(); }
423 opt_caught_stmt
424 { $$ = c_donecatch($3, $5); }
425 | SWITCH '(' f_list_exp ')'
426 { c_startswitch($3, typechecking); }
427 compound_stmt
428 { $$ = c_endswitch($3, $6); }
429 | CASE exp ':'
430 { $2 = c_case($2, (node *) NULL); }
431 stmt {
432 $$ = $2;
433 if ($$ != (node *) NULL) {
434 $$->l.left = $5;
435 } else {
436 $$ = $5;
437 }
438 }
439 | CASE exp DOT_DOT exp ':'
440 { $2 = c_case($2, $4); }
441 stmt {
442 $$ = $2;
443 if ($$ != (node *) NULL) {
444 $$->l.left = $7;
445 } else {
446 $$ = $7;
447 }
448 }
449 | DEFAULT ':'
450 { $<node>2 = c_default(); }
451 stmt {
452 $$ = $<node>2;
453 if ($$ != (node *) NULL) {
454 $$->l.left = $4;
455 } else {
456 $$ = $4;
457 }
458 }
459 | BREAK ';'
460 {
461 $$ = c_break();
462 }
463 | CONTINUE ';'
464 {
465 $$ = c_continue();
466 }
467 | RETURN f_opt_list_exp ';'
468 { $$ = c_return($2, typechecking); }
469 | ';' { $$ = (node *) NULL; }
470 ;
471
472 compound_stmt
473 : '{' {
474 nstatements = 0;
475 c_startcompound();
476 }
477 dcltr_or_stmt_list '}'
478 {
479 nstatements = 1; /* any non-zero value will do */
480 $$ = c_endcompound($3);
481 }
482 ;
483
484 opt_caught_stmt
485 : /* empty */
486 { $$ = (node *) NULL; }
487 | ':' stmt
488 { $$ = $2; }
489 ;
490
491 function_name
492 : ident { $$ = c_flookup($1, typechecking); }
493 | COLON_COLON ident
494 { $$ = c_iflookup($2, (node *) NULL); }
495 | ident COLON_COLON ident
496 { $$ = c_iflookup($3, $1); }
497 ;
498
499 primary_p1_exp
500 : INT_CONST
501 { $$ = node_int($1); }
502 | FLOAT_CONST
503 { $$ = node_float(&$1); }
504 | NIL { $$ = node_nil(); }
505 | string
506 | '(' '{' opt_arg_list_comma '}' ')'
507 { $$ = c_aggregate($3, T_MIXED | (1 << REFSHIFT)); }
508 | '(' '[' opt_assoc_arg_list_comma ']' ')'
509 { $$ = c_aggregate($3, T_MAPPING); }
510 | ident {
511 $$ = c_variable($1);
512 if (typechecking) {
513 if ($$->type == N_GLOBAL && $$->mod != T_MIXED &&
514 !conf_typechecking()) {
515 /*
516 * global vars might be modified by untypechecked
517 * functions...
518 */
519 $$ = node_mon(N_CAST, $$->mod, $$);
520 }
521 } else {
522 /* the variable could be anything */
523 $$->mod = T_MIXED;
524 }
525 }
526 | '(' list_exp ')'
527 { $$ = $2; }
528 | function_name '(' opt_arg_list ')'
529 { $$ = c_checkcall(c_funcall($1, $3), typechecking); }
530 | CATCH '(' list_exp ')'
531 { $$ = node_mon(N_CATCH, T_STRING, $3); }
532 | primary_p2_exp ARROW ident '(' opt_arg_list ')'
533 {
534 t_void($1);
535 $$ = c_checkcall(c_arrow($1, $3, $5), typechecking);
536 }
537 ;
538
539 primary_p2_exp
540 : primary_p1_exp
541 | primary_p2_exp '[' f_list_exp ']'
542 { $$ = idx($1, $3); }
543 | primary_p2_exp '[' f_opt_list_exp DOT_DOT f_opt_list_exp ']'
544 { $$ = range($1, $3, $5); }
545 ;
546
547 postfix_exp
548 : primary_p2_exp
549 | postfix_exp PLUS_PLUS
550 { $$ = uassign(N_PLUS_PLUS, $1, "++"); }
551 | postfix_exp MIN_MIN
552 { $$ = uassign(N_MIN_MIN, $1, "--"); }
553 ;
554
555 prefix_exp
556 : postfix_exp
557 | PLUS_PLUS cast_exp
558 { $$ = uassign(N_ADD_EQ_1, $2, "++"); }
559 | MIN_MIN cast_exp
560 { $$ = uassign(N_SUB_EQ_1, $2, "--"); }
561 | '-' cast_exp
562 { $$ = umin($2); }
563 | '+' cast_exp
564 { $$ = node_mon(N_UPLUS, $2->mod, $2); }
565 | '!' cast_exp
566 {
567 t_void($2);
568 $$ = c_not($2);
569 }
570 | '~' cast_exp
571 {
572 $$ = $2;
573 t_void($$);
574 if (typechecking && $$->mod != T_INT && $$->mod != T_MIXED) {
575 char tnbuf[17];
576
577 c_error("bad argument type for ~ (%s)",
578 i_typename(tnbuf, $$->mod));
579 $$->mod = T_MIXED;
580 } else {
581 $$ = xor(N_XOR, $$, node_int((Int) -1), "^");
582 }
583 }
584 ;
585
586 cast_exp
587 : prefix_exp
588 | '(' type_specifier star_list ')' cast_exp
589 { $$ = cast($5, $2 | (($3 << REFSHIFT) & T_REF)); }
590 ;
591
592 mult_oper_exp
593 : cast_exp
594 | mult_oper_exp '*' cast_exp
595 { $$ = mult(N_MULT, $1, $3, "*"); }
596 | mult_oper_exp '/' cast_exp
597 { $$ = mdiv(N_DIV, $1, $3, "/"); }
598 | mult_oper_exp '%' cast_exp
599 { $$ = mod(N_MOD, $1, $3, "%"); }
600 ;
601
602 add_oper_exp
603 : mult_oper_exp
604 | add_oper_exp '+' mult_oper_exp
605 { $$ = add(N_ADD, $1, $3, "+"); }
606 | add_oper_exp '-' mult_oper_exp
607 { $$ = sub(N_SUB, $1, $3, "-"); }
608 ;
609
610 shift_oper_exp
611 : add_oper_exp
612 | shift_oper_exp LSHIFT add_oper_exp
613 { $$ = lshift(N_LSHIFT, $1, $3, "<<"); }
614 | shift_oper_exp RSHIFT add_oper_exp
615 { $$ = rshift(N_RSHIFT, $1, $3, ">>"); }
616 ;
617
618 rel_oper_exp
619 : shift_oper_exp
620 | rel_oper_exp '<' shift_oper_exp
621 { $$ = rel(N_LT, $$, $3, "<"); }
622 | rel_oper_exp '>' shift_oper_exp
623 { $$ = rel(N_GT, $$, $3, ">"); }
624 | rel_oper_exp LE shift_oper_exp
625 { $$ = rel(N_LE, $$, $3, "<="); }
626 | rel_oper_exp GE shift_oper_exp
627 { $$ = rel(N_GE, $$, $3, ">="); }
628 ;
629
630 equ_oper_exp
631 : rel_oper_exp
632 | equ_oper_exp EQ rel_oper_exp
633 { $$ = eq($1, $3); }
634 | equ_oper_exp NE rel_oper_exp
635 { $$ = c_not(eq($1, $3)); }
636 ;
637
638 bitand_oper_exp
639 : equ_oper_exp
640 | bitand_oper_exp '&' equ_oper_exp
641 { $$ = and(N_AND, $1, $3, "&"); }
642 ;
643
644 bitxor_oper_exp
645 : bitand_oper_exp
646 | bitxor_oper_exp '^' bitand_oper_exp
647 { $$ = xor(N_XOR, $1, $3, "^"); }
648 ;
649
650 bitor_oper_exp
651 : bitxor_oper_exp
652 | bitor_oper_exp '|' bitxor_oper_exp
653 { $$ = or(N_OR, $1, $3, "|"); }
654 ;
655
656 and_oper_exp
657 : bitor_oper_exp
658 | and_oper_exp LAND bitor_oper_exp
659 { $$ = land($1, $3); }
660 ;
661
662 or_oper_exp
663 : and_oper_exp
664 | or_oper_exp LOR and_oper_exp
665 { $$ = lor($1, $3); }
666 ;
667
668 cond_exp
669 : or_oper_exp
670 | or_oper_exp '?' list_exp ':' cond_exp
671 { $$ = quest($1, $3, $5); }
672 ;
673
674 exp
675 : cond_exp
676 | cond_exp '=' exp
677 { $$ = assign(c_lvalue($1, "assignment"), $3); }
678 | cond_exp PLUS_EQ exp
679 { $$ = add(N_ADD_EQ, c_lvalue($1, "+="), $3, "+="); }
680 | cond_exp MIN_EQ exp
681 { $$ = sub(N_SUB_EQ, c_lvalue($1, "-="), $3, "-="); }
682 | cond_exp MULT_EQ exp
683 { $$ = mult(N_MULT_EQ, c_lvalue($1, "*="), $3, "*="); }
684 | cond_exp DIV_EQ exp
685 { $$ = mdiv(N_DIV_EQ, c_lvalue($1, "/="), $3, "/="); }
686 | cond_exp MOD_EQ exp
687 { $$ = mod(N_MOD_EQ, c_lvalue($1, "%="), $3, "%="); }
688 | cond_exp LSHIFT_EQ exp
689 { $$ = lshift(N_LSHIFT_EQ, c_lvalue($1, "<<="), $3, "<<="); }
690 | cond_exp RSHIFT_EQ exp
691 { $$ = rshift(N_RSHIFT_EQ, c_lvalue($1, ">>="), $3, ">>="); }
692 | cond_exp AND_EQ exp
693 { $$ = and(N_AND_EQ, c_lvalue($1, "&="), $3, "&="); }
694 | cond_exp XOR_EQ exp
695 { $$ = xor(N_XOR_EQ, c_lvalue($1, "^="), $3, "^="); }
696 | cond_exp OR_EQ exp
697 { $$ = or(N_OR_EQ, c_lvalue($1, "|="), $3, "|="); }
698 ;
699
700 list_exp
701 : exp
702 | list_exp ',' exp
703 { $$ = comma($1, $3); }
704 ;
705
706 opt_list_exp
707 : /* empty */
708 { $$ = (node *) NULL; }
709 | list_exp
710 ;
711
712 f_list_exp
713 : list_exp
714 { t_void($$ = $1); }
715 ;
716
717 f_opt_list_exp
718 : opt_list_exp
719 { t_void($$ = $1); }
720 ;
721
722 arg_list
723 : exp { t_void($$ = $1); }
724 | arg_list ',' exp
725 {
726 t_void($3);
727 $$ = node_bin(N_PAIR, 0, $1, $3);
728 }
729 ;
730
731 opt_arg_list
732 : /* empty */
733 { $$ = (node *) NULL; }
734 | arg_list
735 | arg_list ELLIPSIS
736 {
737 $$ = $1;
738 if ($$->type == N_PAIR) {
739 $$->r.right = node_mon(N_SPREAD, -1, $$->r.right);
740 } else {
741 $$ = node_mon(N_SPREAD, -1, $$);
742 }
743 }
744 ;
745
746 opt_arg_list_comma
747 : /* empty */
748 { $$ = (node *) NULL; }
749 | arg_list
750 | arg_list ','
751 { $$ = $1; }
752 ;
753
754 assoc_exp
755 : exp ':' exp
756 {
757 t_void($1);
758 t_void($3);
759 $$ = node_bin(N_COMMA, 0, $1, $3);
760 }
761 ;
762
763 assoc_arg_list
764 : assoc_exp
765 | assoc_arg_list ',' assoc_exp
766 { $$ = node_bin(N_PAIR, 0, $1, $3); }
767 ;
768
769 opt_assoc_arg_list_comma
770 : /* empty */
771 { $$ = (node *) NULL; }
772 | assoc_arg_list
773 | assoc_arg_list ','
774 { $$ = $1; }
775 ;
776
777 %%
778
779 /*
780 * NAME: varargs()
781 * DESCRIPTION: deal with varargs in a formals declaration
782 */
783 static node *varargs(n1, n2)
784 register node *n1, *n2;
785 {
786 register node *n;
787
788 if (n1->type == N_PAIR) {
789 n1->r.right->mod |= T_VARARGS;
790 } else {
791 n1->mod |= T_VARARGS;
792 }
793 if (n2->type == N_PAIR) {
794 for (n = n2; n->l.left->type == N_PAIR; n = n->l.left) ;
795 n->l.left = node_bin(N_PAIR, 0, n1, n->l.left);
796 return n2;
797 } else {
798 return node_bin(N_PAIR, 0, n1, n2);
799 }
800 }
801
802 /*
803 * NAME: t_void()
804 * DESCRIPTION: if the argument is of type void, an error will result
805 */
806 static void t_void(n)
807 register node *n;
808 {
809 if (n != (node *) NULL && n->mod == T_VOID) {
810 c_error("void value not ignored");
811 n->mod = T_MIXED;
812 }
813 }
814
815 /*
816 * NAME: t_unary()
817 * DESCRIPTION: typecheck the argument of a unary operator
818 */
819 static bool t_unary(n, name)
820 register node *n;
821 char *name;
822 {
823 char tnbuf[17];
824
825 t_void(n);
826 if (typechecking && !T_ARITHMETIC(n->mod) && n->mod != T_MIXED) {
827 c_error("bad argument type for %s (%s)", name,
828 i_typename(tnbuf, n->mod));
829 n->mod = T_MIXED;
830 return FALSE;
831 }
832 return TRUE;
833 }
834
835 /*
836 * NAME: uassign()
837 * DESCRIPTION: handle a unary assignment operator
838 */
839 static node *uassign(op, n, name)
840 int op;
841 register node *n;
842 char *name;
843 {
844 t_unary(n, name);
845 return node_mon((n->mod == T_INT) ? op + 1 : op, n->mod, c_lvalue(n, name));
846 }
847
848 /*
849 * NAME: cast()
850 * DESCRIPTION: cast an expression to a type
851 */
852 static node *cast(n, type)
853 register node *n;
854 register unsigned int type;
855 {
856 xfloat flt;
857 Int i;
858 char *p, buffer[18];
859
860 if (type != n->mod) {
861 switch (type) {
862 case T_INT:
863 switch (n->type) {
864 case N_FLOAT:
865 /* cast float constant to int */
866 NFLT_GET(n, flt);
867 return node_int(flt_ftoi(&flt));
868
869 case N_STR:
870 /* cast string to int */
871 i = strtol(n->l.string->text, &p, 10);
872 if (p == n->l.string->text + n->l.string->len) {
873 return node_int(i);
874 } else {
875 c_error("cast of invalid string constant");
876 n->mod = T_MIXED;
877 }
878 break;
879
880 case N_TOFLOAT:
881 case N_TOSTRING:
882 if (n->l.left->type == N_INT) {
883 /* (int) (float) i, (int) (string) i */
884 return n->l.left;
885 }
886 /* fall through */
887 default:
888 if (n->mod == T_FLOAT || n->mod == T_STRING ||
889 n->mod == T_MIXED) {
890 return node_mon(N_TOINT, T_INT, n);
891 }
892 break;
893 }
894 break;
895
896 case T_FLOAT:
897 switch (n->type) {
898 case N_INT:
899 /* cast int constant to float */
900 flt_itof(n->l.number, &flt);
901 return node_float(&flt);
902
903 case N_STR:
904 /* cast string to float */
905 p = n->l.string->text;
906 if (flt_atof(&p, &flt) &&
907 p == n->l.string->text + n->l.string->len) {
908 return node_float(&flt);
909 } else {
910 yyerror("cast of invalid string constant");
911 n->mod = T_MIXED;
912 }
913 break;
914
915 case N_TOSTRING:
916 if (n->l.left->mod == T_INT) {
917 return node_mon(N_TOFLOAT, T_FLOAT, n->l.left);
918 }
919 /* fall through */
920 default:
921 if (n->mod == T_INT || n->mod == T_STRING || n->mod == T_MIXED)
922 {
923 return node_mon(N_TOFLOAT, T_FLOAT, n);
924 }
925 break;
926 }
927 break;
928
929 case T_STRING:
930 switch (n->type) {
931 case N_INT:
932 /* cast int constant to string */
933 sprintf(buffer, "%ld", (long) n->l.number);
934 return node_str(str_new(buffer, (long) strlen(buffer)));
935
936 case N_FLOAT:
937 /* cast float constant to string */
938 NFLT_GET(n, flt);
939 flt_ftoa(&flt, buffer);
940 return node_str(str_new(buffer, (long) strlen(buffer)));
941
942 default:
943 if (n->mod == T_INT || n->mod == T_FLOAT || n->mod == T_MIXED) {
944 return node_mon(N_TOSTRING, T_STRING, n);
945 }
946 break;
947 }
948 break;
949 }
950
951 if ((n->mod & T_TYPE) != T_MIXED) {
952 c_error("cast of invalid type (%s)", i_typename(buffer, n->mod));
953 } else if ((type & T_TYPE) == T_VOID) {
954 c_error("cannot cast to %s", i_typename(buffer, type));
955 n->mod = T_MIXED;
956 } else if ((type & T_REF) < (n->mod & T_REF)) {
957 c_error("illegal cast of array type (%s)",
958 i_typename(buffer, n->mod));
959 } else if ((type & T_REF) == 0 || (n->mod & T_REF) == 0) {
960 return node_mon(N_CAST, type, n);
961 }
962 }
963 return n;
964 }
965
966 /*
967 * NAME: idx()
968 * DESCRIPTION: handle the [ ] operator
969 */
970 static node *idx(n1, n2)
971 register node *n1, *n2;
972 {
973 char tnbuf[17];
974 register unsigned short type;
975
976 if (n1->type == N_STR && n2->type == N_INT) {
977 /* str [ int ] */
978 if (n2->l.number < 0 || n2->l.number >= (Int) n1->l.string->len) {
979 c_error("string index out of range");
980 } else {
981 n2->l.number =
982 UCHAR(n1->l.string->text[str_index(n1->l.string,
983 (long) n2->l.number)]);
984 }
985 return n2;
986 }
987
988 if ((n1->mod & T_REF) != 0) {
989 /*
990 * array
991 */
992 if (typechecking) {
993 type = n1->mod - (1 << REFSHIFT);
994 if (n2->mod != T_INT && n2->mod != T_MIXED) {
995 c_error("bad index type (%s)", i_typename(tnbuf, n2->mod));
996 }
997 if (type != T_MIXED) {
998 /* you can't trust these arrays */
999 return node_mon(N_CAST, type, node_bin(N_INDEX, type, n1, n2));
1000 }
1001 }
1002 type = T_MIXED;
1003 } else if (n1->mod == T_STRING) {
1004 /*
1005 * string
1006 */
1007 if (typechecking && n2->mod != T_INT && n2->mod != T_MIXED) {
1008 c_error("bad index type (%s)", i_typename(tnbuf, n2->mod));
1009 }
1010 type = T_INT;
1011 } else {
1012 if (typechecking && n1->mod != T_MAPPING && n1->mod != T_MIXED) {
1013 c_error("bad indexed type (%s)", i_typename(tnbuf, n1->mod));
1014 }
1015 type = T_MIXED;
1016 }
1017 return node_bin(N_INDEX, type, n1, n2);
1018 }
1019
1020 /*
1021 * NAME: range()
1022 * DESCRIPTION: handle the [ .. ] operator
1023 */
1024 static node *range(n1, n2, n3)
1025 register node *n1, *n2, *n3;
1026 {
1027 if (n1->type == N_STR && (n2 == (node *) NULL || n2->type == N_INT) &&
1028 (n3 == (node *) NULL || n3->type == N_INT)) {
1029 Int from, to;
1030
1031 /* str [ int .. int ] */
1032 from = (n2 == (node *) NULL) ? 0 : n2->l.number;
1033 to = (n3 == (node *) NULL) ? n1->l.string->len - 1 : n3->l.number;
1034 if (from < 0 || from > to + 1 || to >= n1->l.string->len) {
1035 c_error("invalid string range");
1036 } else {
1037 return node_str(str_range(n1->l.string, (long) from, (long) to));
1038 }
1039 }
1040
1041 if (typechecking && n1->mod != T_MAPPING && n1->mod != T_MIXED) {
1042 char tnbuf[17];
1043
1044 /* indices */
1045 if (n2 != (node *) NULL && n2->mod != T_INT && n2->mod != T_MIXED) {
1046 c_error("bad index type (%s)", i_typename(tnbuf, n2->mod));
1047 }
1048 if (n3 != (node *) NULL && n3->mod != T_INT && n3->mod != T_MIXED) {
1049 c_error("bad index type (%s)", i_typename(tnbuf, n3->mod));
1050 }
1051 /* range */
1052 if ((n1->mod & T_REF) == 0 && n1->mod != T_STRING) {
1053 c_error("bad indexed type (%s)", i_typename(tnbuf, n1->mod));
1054 }
1055 }
1056
1057 return node_bin(N_RANGE, n1->mod, n1, node_bin(N_PAIR, 0, n2, n3));
1058 }
1059
1060 /*
1061 * NAME: bini()
1062 * DESCRIPTION: handle a binary int operator
1063 */
1064 static node *bini(op, n1, n2, name)
1065 int op;
1066 register node *n1, *n2;
1067 char *name;
1068 {
1069 char tnbuf1[17], tnbuf2[17];
1070
1071 t_void(n1);
1072 t_void(n2);
1073
1074 if (typechecking &&
1075 ((n1->mod != T_INT && n1->mod != T_MIXED) ||
1076 (n2->mod != T_INT && n2->mod != T_MIXED))) {
1077 c_error("bad argument types for %s (%s, %s)", name,
1078 i_typename(tnbuf1, n1->mod), i_typename(tnbuf2, n2->mod));
1079 }
1080 if (n1->mod == T_INT && n2->mod == T_INT) {
1081 op++;
1082 }
1083 return node_bin(op, T_INT, n1, n2);
1084 }
1085
1086 /*
1087 * NAME: bina()
1088 * DESCRIPTION: handle a binary arithmetic operator
1089 */
1090 static node *bina(op, n1, n2, name)
1091 int op;
1092 register node *n1, *n2;
1093 char *name;
1094 {
1095 char tnbuf1[17], tnbuf2[17];
1096 register unsigned short type;
1097
1098 t_void(n1);
1099 t_void(n2);
1100
1101 type = T_MIXED;
1102 if (typechecking &&
1103 ((n1->mod != n2->mod && n1->mod != T_MIXED && n2->mod != T_MIXED) ||
1104 (!T_ARITHMETIC(n1->mod) && n1->mod != T_MIXED) ||
1105 (!T_ARITHMETIC(n2->mod) && n2->mod != T_MIXED))) {
1106 c_error("bad argument types for %s (%s, %s)", name,
1107 i_typename(tnbuf1, n1->mod), i_typename(tnbuf2, n2->mod));
1108 } else if (n1->mod == T_INT || n2->mod == T_INT) {
1109 if (n1->mod == T_INT && n2->mod == T_INT) {
1110 op++;
1111 }
1112 type = T_INT;
1113 } else if (n1->mod == T_FLOAT || n2->mod == T_FLOAT) {
1114 type = T_FLOAT;
1115 }
1116
1117 return node_bin(op, type, n1, n2);
1118 }
1119
1120 /*
1121 * NAME: mult()
1122 * DESCRIPTION: handle the * *= operators
1123 */
1124 static node *mult(op, n1, n2, name)
1125 int op;
1126 register node *n1, *n2;
1127 char *name;
1128 {
1129 xfloat f1, f2;
1130
1131 if (n1->type == N_INT && n2->type == N_INT) {
1132 /* i * i */
1133 n1->l.number *= n2->l.number;
1134 return n1;
1135 }
1136 if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
1137 NFLT_GET(n1, f1);
1138 NFLT_GET(n2, f2);
1139 flt_mult(&f1, &f2);
1140 NFLT_PUT(n1, f1);
1141 return n1;
1142 }
1143 return bina(op, n1, n2, name);
1144 }
1145
1146 /*
1147 * NAME: mdiv()
1148 * DESCRIPTION: handle the / /= operators
1149 */
1150 static node *mdiv(op, n1, n2, name)
1151 int op;
1152 register node *n1, *n2;
1153 char *name;
1154 {
1155 xfloat f1, f2;
1156
1157 if (n1->type == N_INT && n2->type == N_INT) {
1158 register Int i, d;
1159
1160 /* i / i */
1161 i = n1->l.number;
1162 d = n2->l.number;
1163 if (d == 0) {
1164 /* i / 0 */
1165 c_error("division by zero");
1166 return n1;
1167 }
1168 if ((d | i) < 0) {
1169 Int r;
1170
1171 r = ((Uint) ((i < 0) ? -i : i)) / ((Uint) ((d < 0) ? -d : d));
1172 n1->l.number = ((i ^ d) < 0) ? -r : r;
1173 } else {
1174 n1->l.number = ((Uint) i) / ((Uint) d);
1175 }
1176 return n1;
1177 } else if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
1178 /* f / f */
1179 if (NFLT_ISZERO(n2)) {
1180 /* f / 0.0 */
1181 c_error("division by zero");
1182 return n1;
1183 }
1184 NFLT_GET(n1, f1);
1185 NFLT_GET(n2, f2);
1186 flt_div(&f1, &f2);
1187 NFLT_PUT(n1, f1);
1188 return n1;
1189 }
1190
1191 return bina(op, n1, n2, name);
1192 }
1193
1194 /*
1195 * NAME: mod()
1196 * DESCRIPTION: handle the % %= operators
1197 */
1198 static node *mod(op, n1, n2, name)
1199 int op;
1200 register node *n1, *n2;
1201 char *name;
1202 {
1203 if (n1->type == N_INT && n2->type == N_INT) {
1204 register Int i, d;
1205
1206 /* i % i */
1207 i = n1->l.number;
1208 d = n2->l.number;
1209 if (d == 0) {
1210 /* i % 0 */
1211 c_error("modulus by zero");
1212 return n1;
1213 }
1214 if ((d | i) < 0) {
1215 Int r;
1216
1217 r = ((Uint) ((i < 0) ? -i : i)) % ((Uint) ((d < 0) ? -d : d));
1218 n1->l.number = ((i ^ d) < 0) ? -r : r;
1219 } else {
1220 n1->l.number = ((Uint) i) % ((Uint) d);
1221 }
1222 return n1;
1223 }
1224
1225 return bini(op, n1, n2, name);
1226 }
1227
1228 /*
1229 * NAME: add()
1230 * DESCRIPTION: handle the + += operators, possibly rearranging the order
1231 * of the expression
1232 */
1233 static node *add(op, n1, n2, name)
1234 int op;
1235 register node *n1, *n2;
1236 char *name;
1237 {
1238 char tnbuf1[17], tnbuf2[17];
1239 xfloat f1, f2;
1240 register unsigned short type;
1241
1242 t_void(n1);
1243 t_void(n2);
1244
1245 if (n1->mod == T_STRING) {
1246 if (n2->mod == T_INT || n2->mod == T_FLOAT ||
1247 (n2->mod == T_MIXED && typechecking)) {
1248 n2 = cast(n2, T_STRING);
1249 }
1250 } else if (n2->mod == T_STRING && op == N_ADD) {
1251 if (n1->mod == T_INT || n1->mod == T_FLOAT ||
1252 (n1->mod == T_MIXED && typechecking)) {
1253 n1 = cast(n1, T_STRING);
1254 }
1255 }
1256
1257 if (n1->type == N_INT && n2->type == N_INT) {
1258 /* i + i */
1259 n1->l.number += n2->l.number;
1260 return n1;
1261 }
1262 if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
1263 /* f + f */
1264 NFLT_GET(n1, f1);
1265 NFLT_GET(n2, f2);
1266 flt_add(&f1, &f2);
1267 NFLT_PUT(n1, f1);
1268 return n1;
1269 }
1270 if (n1->type == N_STR && n2->type == N_STR) {
1271 /* s + s */
1272 return node_str(str_add(n1->l.string, n2->l.string));
1273 }
1274
1275 type = c_tmatch(n1->mod, n2->mod);
1276 if (type == T_OBJECT || type == T_NIL) {
1277 type = T_MIXED;
1278 if (typechecking) {
1279 c_error("bad argument types for %s (%s, %s)", name,
1280 i_typename(tnbuf1, n1->mod), i_typename(tnbuf2, n2->mod));
1281 }
1282 } else if (type == T_INT) {
1283 op++;
1284 } else if (op == N_ADD_EQ) {
1285 if (n1->mod == T_INT) {
1286 n2 = node_mon(N_CAST, T_INT, n2);
1287 type = T_INT;
1288 op++;
1289 } else if (n1->mod == T_FLOAT && n2->mod != T_FLOAT) {
1290 n2 = node_mon(N_CAST, T_FLOAT, n2);
1291 type = T_FLOAT;
1292 }
1293 }
1294 return node_bin(op, type, n1, n2);
1295 }
1296
1297 /*
1298 * NAME: sub()
1299 * DESCRIPTION: handle the - -= operators
1300 */
1301 static node *sub(op, n1, n2, name)
1302 int op;
1303 register node *n1, *n2;
1304 char *name;
1305 {
1306 char tnbuf1[17], tnbuf2[17];
1307 xfloat f1, f2;
1308 register unsigned short type;
1309
1310 t_void(n1);
1311 t_void(n2);
1312
1313 if (n1->type == N_INT && n2->type == N_INT) {
1314 /* i - i */
1315 n1->l.number -= n2->l.number;
1316 return n1;
1317 }
1318 if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
1319 /* f - f */
1320 NFLT_GET(n1, f1);
1321 NFLT_GET(n2, f2);
1322 flt_sub(&f1, &f2);
1323 NFLT_PUT(n1, f1);
1324 return n1;
1325 }
1326
1327 type = c_tmatch(n1->mod, n2->mod);
1328 if (type == T_STRING || type == T_OBJECT || type == T_MAPPING ||
1329 type == T_NIL) {
1330 if ((type=n1->mod) != T_MAPPING ||
1331 (n2->mod != T_MIXED && (n2->mod & T_REF) == 0)) {
1332 type = T_MIXED;
1333 if (typechecking) {
1334 c_error("bad argument types for %s (%s, %s)", name,
1335 i_typename(tnbuf1, n1->mod),
1336 i_typename(tnbuf2, n2->mod));
1337 }
1338 }
1339 } else if (type == T_INT) {
1340 op++;
1341 } else if (type == T_MIXED) {
1342 type = (n1->mod == T_MIXED) ? n2->mod : n1->mod;
1343 } else if (n1->mod == T_MIXED && (n2->mod & T_REF)) {
1344 type = T_MIXED;
1345 }
1346 return node_bin(op, type, n1, n2);
1347 }
1348
1349 /*
1350 * NAME: umin()
1351 * DESCRIPTION: handle unary minus
1352 */
1353 static node *umin(n)
1354 register node *n;
1355 {
1356 xfloat flt;
1357
1358 if (t_unary(n, "unary -")) {
1359 if (n->mod == T_FLOAT) {
1360 FLT_ZERO(flt.high, flt.low);
1361 n = sub(N_SUB, node_float(&flt), n, "-");
1362 } else {
1363 n = sub(N_SUB, node_int((Int) 0), n, "-");
1364 }
1365 }
1366 return n;
1367 }
1368
1369 /*
1370 * NAME: lshift()
1371 * DESCRIPTION: handle the << <<= operators
1372 */
1373 static node *lshift(op, n1, n2, name)
1374 int op;
1375 register node *n1, *n2;
1376 char *name;
1377 {
1378 if (n2->type == N_INT) {
1379 if (n2->l.number < 0) {
1380 c_error("negative left shift");
1381 n2->l.number = 0;
1382 }
1383 if (n1->type == N_INT) {
1384 /* i << i */
1385 n1->l.number = (n2->l.number < 32) ?
1386 (Uint) n1->l.number << n2->l.number : 0;
1387 return n1;
1388 }
1389 }
1390
1391 return bini(op, n1, n2, name);
1392 }
1393
1394 /*
1395 * NAME: rshift()
1396 * DESCRIPTION: handle the >> >>= operators
1397 */
1398 static node *rshift(op, n1, n2, name)
1399 int op;
1400 register node *n1, *n2;
1401 char *name;
1402 {
1403 if (n2->type == N_INT) {
1404 if (n2->l.number < 0) {
1405 c_error("negative right shift");
1406 n2->l.number = 0;
1407 }
1408 if (n1->type == N_INT) {
1409 /* i >> i */
1410 n1->l.number = (n2->l.number < 32) ?
1411 (Uint) n1->l.number >> n2->l.number : 0;
1412 return n1;
1413 }
1414 }
1415
1416 return bini(op, n1, n2, name);
1417 }
1418
1419 /*
1420 * NAME: rel()
1421 * DESCRIPTION: handle the < > <= >= operators
1422 */
1423 static node *rel(op, n1, n2, name)
1424 int op;
1425 register node *n1, *n2;
1426 char *name;
1427 {
1428 char tnbuf1[17], tnbuf2[17];
1429
1430 t_void(n1);
1431 t_void(n2);
1432
1433 if (n1->type == N_INT && n2->type == N_INT) {
1434 /* i . i */
1435 switch (op) {
1436 case N_GE:
1437 n1->l.number = (n1->l.number >= n2->l.number);
1438 break;
1439
1440 case N_GT:
1441 n1->l.number = (n1->l.number > n2->l.number);
1442 break;
1443
1444 case N_LE:
1445 n1->l.number = (n1->l.number <= n2->l.number);
1446 break;
1447
1448 case N_LT:
1449 n1->l.number = (n1->l.number < n2->l.number);
1450 break;
1451 }
1452 return n1;
1453 }
1454 if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
1455 xfloat f1, f2;
1456
1457 /* f . f */
1458 NFLT_GET(n1, f1);
1459 NFLT_GET(n2, f2);
1460
1461 switch (op) {
1462 case N_GE:
1463 return node_int((Int) (flt_cmp(&f1, &f2) >= 0));
1464
1465 case N_GT:
1466 return node_int((Int) (flt_cmp(&f1, &f2) > 0));
1467
1468 case N_LE:
1469 return node_int((Int) (flt_cmp(&f1, &f2) <= 0));
1470
1471 case N_LT:
1472 return node_int((Int) (flt_cmp(&f1, &f2) < 0));
1473 }
1474 return n1;
1475 }
1476 if (n1->type == N_STR && n2->type == N_STR) {
1477 /* s . s */
1478 switch (op) {
1479 case N_GE:
1480 return node_int((Int) (str_cmp(n1->l.string, n2->l.string) >= 0));
1481
1482 case N_GT:
1483 return node_int((Int) (str_cmp(n1->l.string, n2->l.string) > 0));
1484
1485 case N_LE:
1486 return node_int((Int) (str_cmp(n1->l.string, n2->l.string) <= 0));
1487
1488 case N_LT:
1489 return node_int((Int) (str_cmp(n1->l.string, n2->l.string) < 0));
1490 }
1491 }
1492
1493 if (typechecking &&
1494 ((n1->mod != n2->mod && n1->mod != T_MIXED && n2->mod != T_MIXED) ||
1495 (!T_ARITHSTR(n1->mod) && n1->mod != T_MIXED) ||
1496 (!T_ARITHSTR(n2->mod) && n2->mod != T_MIXED))) {
1497 c_error("bad argument types for %s (%s, %s)", name,
1498 i_typename(tnbuf1, n1->mod), i_typename(tnbuf2, n2->mod));
1499 } else if (n1->mod == T_INT && n2->mod == T_INT) {
1500 op++;
1501 }
1502 return node_bin(op, T_INT, n1, n2);
1503 }
1504
1505 /*
1506 * NAME: eq()
1507 * DESCRIPTION: handle the == operator
1508 */
1509 static node *eq(n1, n2)
1510 register node *n1, *n2;
1511 {
1512 char tnbuf1[17], tnbuf2[17];
1513 xfloat f1, f2;
1514 int op;
1515
1516 t_void(n1);
1517 t_void(n2);
1518
1519 switch (n1->type) {
1520 case N_INT:
1521 if (n2->type == N_INT) {
1522 /* i == i */
1523 n1->l.number = (n1->l.number == n2->l.number);
1524 return n1;
1525 }
1526 if (nil_node == N_INT && n1->l.number == 0 && n2->type == N_STR) {
1527 /* nil == str */
1528 return node_int((Int) FALSE);
1529 }
1530 break;
1531
1532 case N_FLOAT:
1533 if (n2->type == N_FLOAT) {
1534 /* f == f */
1535 NFLT_GET(n1, f1);
1536 NFLT_GET(n2, f2);
1537 return node_int((Int) (flt_cmp(&f1, &f2) == 0));
1538 }
1539 break;
1540
1541 case N_STR:
1542 if (n2->type == N_STR) {
1543 /* s == s */
1544 return node_int((Int) (str_cmp(n1->l.string, n2->l.string) == 0));
1545 }
1546 if (n2->type == nil_node && n2->l.number == 0) {
1547 /* s == nil */
1548 return node_int((Int) FALSE);
1549 }
1550 break;
1551
1552 case N_NIL:
1553 if (n2->type == N_NIL) {
1554 /* nil == nil */
1555 return node_int((Int) TRUE);
1556 }
1557 if (n2->type == N_STR) {
1558 /* nil == str */
1559 return node_int((Int) FALSE);
1560 }
1561 break;
1562 }
1563
1564 op = N_EQ;
1565 if (n1->mod != n2->mod && n1->mod != T_MIXED && n2->mod != T_MIXED &&
1566 (!c_nil(n1) || !T_POINTER(n2->mod)) &&
1567 (!c_nil(n2) || !T_POINTER(n1->mod))) {
1568 if (typechecking) {
1569 c_error("incompatible types for equality (%s, %s)",
1570 i_typename(tnbuf1, n1->mod), i_typename(tnbuf2, n2->mod));
1571 }
1572 } else if (n1->mod == T_INT && n2->mod == T_INT) {
1573 op++;
1574 }
1575 return node_bin(op, T_INT, n1, n2);
1576 }
1577
1578 /*
1579 * NAME: and()
1580 * DESCRIPTION: handle the & &= operators
1581 */
1582 static node *and(op, n1, n2, name)
1583 int op;
1584 register node *n1, *n2;
1585 char *name;
1586 {
1587 register unsigned short type;
1588
1589 if (n1->type == N_INT && n2->type == N_INT) {
1590 /* i & i */
1591 n1->l.number &= n2->l.number;
1592 return n1;
1593 }
1594 if ((((type=n1->mod) == T_MIXED || type == T_MAPPING) &&
1595 ((n2->mod & T_REF) != 0 || n2->mod == T_MIXED)) ||
1596 ((type=c_tmatch(n1->mod, n2->mod)) & T_REF) != T_NIL) {
1597 /*
1598 * possibly array & array or mapping & array
1599 */
1600 return node_bin(op, type, n1, n2);
1601 }
1602 return bini(op, n1, n2, name);
1603 }
1604
1605 /*
1606 * NAME: xor()
1607 * DESCRIPTION: handle the ^ ^= operators
1608 */
1609 static node *xor(op, n1, n2, name)
1610 int op;
1611 register node *n1, *n2;
1612 char *name;
1613 {
1614 register unsigned short type;
1615
1616 if (n1->type == N_INT && n2->type == N_INT) {
1617 /* i ^ i */
1618 n1->l.number ^= n2->l.number;
1619 return n1;
1620 }
1621 if (((type=n1->mod) == T_MIXED && n2->mod == T_MIXED) ||
1622 ((type=c_tmatch(n1->mod, n2->mod)) & T_REF) != T_NIL) {
1623 /*
1624 * possibly array ^ array
1625 */
1626 return node_bin(op, type, n1, n2);
1627 }
1628 return bini(op, n1, n2, name);
1629 }
1630
1631 /*
1632 * NAME: or()
1633 * DESCRIPTION: handle the | |= operators
1634 */
1635 static node *or(op, n1, n2, name)
1636 int op;
1637 register node *n1, *n2;
1638 char *name;
1639 {
1640 register unsigned short type;
1641
1642 if (n1->type == N_INT && n2->type == N_INT) {
1643 /* i | i */
1644 n1->l.number |= n2->l.number;
1645 return n1;
1646 }
1647 if (((type=n1->mod) == T_MIXED && n2->mod == T_MIXED) ||
1648 ((type=c_tmatch(n1->mod, n2->mod)) & T_REF) != T_NIL) {
1649 /*
1650 * possibly array | array
1651 */
1652 return node_bin(op, type, n1, n2);
1653 }
1654 return bini(op, n1, n2, name);
1655 }
1656
1657 /*
1658 * NAME: land()
1659 * DESCRIPTION: handle the && operator
1660 */
1661 static node *land(n1, n2)
1662 register node *n1, *n2;
1663 {
1664 t_void(n1);
1665 t_void(n2);
1666
1667 if ((n1->flags & F_CONST) && (n2->flags & F_CONST)) {
1668 n1 = c_tst(n1);
1669 n2 = c_tst(n2);
1670 n1->l.number &= n2->l.number;
1671 return n1;
1672 }
1673
1674 return node_bin(N_LAND, T_INT, n1, n2);
1675 }
1676
1677 /*
1678 * NAME: lor()
1679 * DESCRIPTION: handle the || operator
1680 */
1681 static node *lor(n1, n2)
1682 register node *n1, *n2;
1683 {
1684 t_void(n1);
1685 t_void(n2);
1686
1687 if ((n1->flags & F_CONST) && (n2->flags & F_CONST)) {
1688 n1 = c_tst(n1);
1689 n2 = c_tst(n2);
1690 n1->l.number |= n2->l.number;
1691 return n1;
1692 }
1693
1694 return node_bin(N_LOR, T_INT, n1, n2);
1695 }
1696
1697 /*
1698 * NAME: quest()
1699 * DESCRIPTION: handle the ? : operator
1700 */
1701 static node *quest(n1, n2, n3)
1702 register node *n1, *n2, *n3;
1703 {
1704 register unsigned short type;
1705
1706 t_void(n1);
1707
1708 if ((n2->flags & F_CONST) && n3->type == n2->type) {
1709 switch (n1->type) {
1710 case N_INT:
1711 return (n1->l.number == 0) ? n3 : n2;
1712
1713 case N_FLOAT:
1714 return (NFLT_ISZERO(n1)) ? n3 : n2;
1715
1716 case N_STR:
1717 return n2;
1718
1719 case N_NIL:
1720 return n3;
1721 }
1722 }
1723
1724 type = T_MIXED;
1725 if (c_nil(n2) && T_POINTER(n3->mod)) {
1726 /*
1727 * expr ? nil : expr
1728 */
1729 type = n3->mod;
1730 } else if (c_nil(n3) && T_POINTER(n2->mod)) {
1731 /*
1732 * expr ? expr : nil;
1733 */
1734 type = n2->mod;
1735 } else if (typechecking) {
1736 /*
1737 * typechecked
1738 */
1739 if (n2->mod == T_VOID || n3->mod == T_VOID) {
1740 /* result can never be used */
1741 type = T_VOID;
1742 } else {
1743 type = c_tmatch(n2->mod, n3->mod);
1744 if (type == T_NIL) {
1745 /* no typechecking here, just let the result be mixed */
1746 type = T_MIXED;
1747 }
1748 }
1749 }
1750
1751 return node_bin(N_QUEST, type, n1, node_bin(N_PAIR, 0, n2, n3));
1752 }
1753
1754 /*
1755 * NAME: assign()
1756 * DESCRIPTION: handle the assignment operator
1757 */
1758 static node *assign(n1, n2)
1759 register node *n1, *n2;
1760 {
1761 char tnbuf1[17], tnbuf2[17];
1762
1763 if (typechecking && (!c_nil(n2) || !T_POINTER(n1->mod))) {
1764 /*
1765 * typechecked
1766 */
1767 if (c_tmatch(n1->mod, n2->mod) == T_NIL) {
1768 c_error("incompatible types for = (%s, %s)",
1769 i_typename(tnbuf1, n1->mod), i_typename(tnbuf2, n2->mod));
1770 } else if (n1->mod != T_MIXED && n2->mod == T_MIXED) {
1771 n2 = node_mon(N_CAST, n1->mod, n2);
1772 }
1773 }
1774
1775 return node_bin(N_ASSIGN, n1->mod, n1, n2);
1776 }
1777
1778 /*
1779 * NAME: comma()
1780 * DESCRIPTION: handle the comma operator, rearranging the order of the
1781 * expression if needed
1782 */
1783 static node *comma(n1, n2)
1784 register node *n1, *n2;
1785 {
1786 if (n2->type == N_COMMA) {
1787 /* a, (b, c) --> (a, b), c */
1788 n2->l.left = comma(n1, n2->l.left);
1789 return n2;
1790 } else {
1791 return node_bin(N_COMMA, n2->mod, n1, n2);
1792 }
1793 }
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.