%{
%line
/* Copyright 1995, 1997 J"orn Rennecke */
/* declarations etc */
#include <stdio.h>
#include <limits.h>
#include "common.h"
#include "alloc.h"
#include "lex.h"
#include "instrs.h"
#include "compiler.h"
#include "interpret.h"
extern int current_line;
extern int pragma_optimize;
struct {
uint32 length;
struct string_concat **link;
struct string_concat list;
} current_string;
p_int function_ix, n_fun_def, n_fun_redef, total_pcode;
struct function **funblocks[N_FUNBLOCKS];
/* nonterminal 'inherit' depends on the order */
static struct ident inheritance_qualifiers[] = {
{
"variables", 9, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }},
&inheritance_qualifiers[1]
},
{
"functions", 9, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }},
0
},
};
struct ident builtin_structs[] = {
{
"long", 4, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }},
&builtin_structs[1]
},
{
"quoted_array", 12, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }},
&builtin_structs[2]
},
{
"regexp", 6, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }},
&builtin_structs[3]
},
{
"space", 5, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }},
&builtin_structs[4]
},
{
"symbol", 6, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }},
&builtin_structs[5]
},
{
"term", 4, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }},
&inheritance_qualifiers[0]
},
};
svalue inherit_file;
static struct param {
uint8 type;
uint8 dummy[3];
struct ident *ident;
} all_param[MAX_PARAM];
#define PARAM(n) (all_param[(n)])
static struct ident *identifier_limbo = 0;
static int global_variable(struct ident *name);
char error_nargs[] =
%error_nargs
;
char ce_error_nargs[] =
%ce_error_nargs
;
%}
%efuns /* Include the tokens */
%union {
%line
struct ident *ident;
p_int number;
svalue constant;
struct counted_string string;
struct {
p_int number;
%if 0
int type;
%endif
} closure;
#ifdef COMPILER_H
struct expression expression;
struct statement statement, multival;
union node *statements;
struct binode *local;
struct { struct binode **link, *start; } scope;
struct string_concat string_concat;
#endif
struct {
struct type_list *list;
uint32 length;
} type_list;
uint8 vtype;
struct {
int32 var, fun;
} type_modifier; /* nonterminal 'inherit' casts this to inherit_types,
* and uses int32* casts */
int32 inherit_types[2];
struct function *function;
struct {
int32 modifier;
p_int basic_type;
} global_var_decl;
}
%type <type_list> type_list
%type <ident> YYF_IDENTIFIER
%type <global_var_decl> global_var_declaration
%type <function> function_signature
%type <number> YYF_PARAM
%type <ident> YYF_LOCAL
%type <number> '=' YYF_ASSIGN YYF_LOR YYF_LAND '|' '^' '&' YYF_EQUALITY '~' '!'
%type <number> YYF_COMPARE YYF_SHIFT '+' '-' YYF_DIV '*' YYF_ADDQ add_op
%type <number> YYF_BASIC_TYPE YYF_CLOSURE_DECL YYF_VOID
%type <number> basic_type opt_star no_star
%type <number> YYF_TYPE_MODIFIER YYF_VAR_TYPE_MODIFIER YYF_FUN_TYPE_MODIFIER
%type <number> YYF_VIRTUAL YYF_VARARGS
%type <type_modifier> type_modifier inherit
%type <number> opt_less
%type <number> saveuse_rparen else saveuse_semi
%type <constant> YYF_CONSTANT string constant stringified_ident
%type <string> YYF_STRING
%type <string_concat> string_concat
%type <expression> lvalue var_indexable var_expr expression comma_expr
%type <multival> multiconst m_v_constant m_kv_constant m_multiconst
%type <multival> multival m_v_val arguments
%type <expression> brac_expr for_expr for_cond local_declaration
%type <statement> block statement
%type <statements> statements
%right '=' YYF_ASSIGN
%right '?'
%left YYF_LOR
%left YYF_LAND
%left '|'
%left '^'
%left '&'
%left YYF_EQUALITY
%left YYF_COMPARE '<'
%left YYF_SHIFT
%left '+' '-'
%left YYF_DIV '*'
%right '!' '~'
%nonassoc YYF_ADDQ
%nonassoc '[' YYF_ARROW YYF_QARROW
%%
start_symbol: program;
basic_type: YYF_BASIC_TYPE | YYF_CLOSURE_DECL
| YYF_STRUCT YYF_IDENTIFIER
{
%line
struct ident *p;
unsigned n;
p = $2;
n = p - &builtin_structs[0];
if (n < NELEM(builtin_structs)) {
$$ = n + TYPE_STRUCT_BUILTIN;
} else {
/* FIXME */
}
}
;
%// type: basic_type | basic_type '*' { $$ = TYPE__ARRAY | $1; } ;
%// type: basic_type opt_star { $$ = $1 | $2; }
opt_star: { $$ = 0; } | '*' { $$ = TYPE__ARRAY; }
no_star: { $$ = 0; } | '*' { yyerrorn(CE_VOIDARR); $$ = 0; }
%// local_declaration should only be called from block.
%// $-1 accumulates *all* local declarations that are topmost in this scope.
local_declaration:
basic_type opt_star YYF_IDENTIFIER
{
struct binode *n;
struct ident *id;
union ident_u u;
%line
n = alloc_tmpnode();
*$<scope>-1.link = n;
$<scope>-1.link = &n->node[0].p;
n->ntype = N_LOCAL;
n->line = current_line;
$$.node.leaf.type = LN_NIL;
$$.length = 0;
$$.vtype = $1;
u.local.vtype = TYPE_VOID;
id = NEW_IDENT($3, I_TYPE_LOCAL, u);
n->node[1].id = id;
if (id) {
id->u.local.offset = -local_preallocated++;
id->u.local.line = current_line;
id->u.local.vtype = $1|$2;
}
}
| basic_type opt_star YYF_IDENTIFIER '=' expression
{
struct binode *n;
struct ident *id;
union ident_u u;
%line
n = alloc_tmpnode();
*$<scope>-1.link = n;
$<scope>-1.link = &n->node[0].p;
n->ntype = N_LOCAL_INIT;
n->line = current_line;
$$.node = $5.node;
$$.length = $5.length;
$$.vtype = $1;
u.local.vtype = TYPE_VOID;
id = NEW_IDENT($3, I_TYPE_LOCAL, u);
n->node[1].id = id;
if (id) {
id->u.local.offset = stack_use;
id->u.local.line = current_line;
id->u.local.vtype = $1|$2;
}
}
| local_declaration ',' opt_star YYF_IDENTIFIER
{
struct binode *n;
struct ident *id;
union ident_u u;
%line
n = alloc_tmpnode();
*$<scope>-1.link = n;
$<scope>-1.link = &n->node[0].p;
n->ntype = N_LOCAL;
n->line = current_line;
$$.node.leaf.type = LN_NIL;
$$.length = $1.length;
$$.vtype = $1.vtype;
u.local.vtype = TYPE_VOID;
id = NEW_IDENT($4, I_TYPE_LOCAL, u);
n->node[1].id = id;
if (id) {
id->u.local.offset = -local_preallocated++;
id->u.local.line = current_line;
id->u.local.vtype = $1.vtype|$3;
}
}
| local_declaration ',' opt_star YYF_IDENTIFIER '=' expression
{
%line
struct binode *n;
struct ident *id;
union ident_u u;
n = alloc_tmpnode();
*$<scope>-1.link = n;
$<scope>-1.link = &n->node[0].p;
n->ntype = N_LOCAL_INIT;
n->line = current_line;
$$.node = $6.node;
$$.length = $1.length + $6.length;
$$.vtype = $1.vtype;
u.local.vtype = TYPE_VOID;
id = NEW_IDENT($4, I_TYPE_LOCAL, u);
n->node[1].id = id;
if (id) {
id->u.local.offset = stack_use;
id->u.local.line = current_line;
id->u.local.vtype = $1.vtype|$3;
}
}
;
type_modifier: { $$.var = $$.fun = 0; }
| type_modifier YYF_TYPE_MODIFIER
{
$$.var = $1.var | $2;
$$.fun = $1.fun | $2;
}
| type_modifier YYF_VAR_TYPE_MODIFIER
{
$$.var = $1.var | $2;
$$.fun = $1.fun;
}
| type_modifier YYF_VIRTUAL
{
$$.var = $1.var | $2;
$$.fun = $1.fun;
}
| type_modifier YYF_FUN_TYPE_MODIFIER
{
$$.var = $1.var;
$$.fun = $1.fun | $2;
}
| type_modifier YYF_VARARGS
{
$$.var = $1.var;
$$.fun = $1.fun | $2;
}
;
global_var_declaration:
struct_declaration { /* FIXME */ }
| type_modifier basic_type opt_star YYF_IDENTIFIER
{
declare_global_var($1.var, $2|$3, $4, SV_NULL);
$$.modifier = $1.var;
$$.basic_type = $2;
}
| type_modifier basic_type opt_star YYF_IDENTIFIER '=' constant
{
declare_global_var($1.var, $2|$3, $4, $6);
$$.modifier = $1.var;
$$.basic_type = $2;
}
| global_var_declaration ',' opt_star YYF_IDENTIFIER
{
declare_global_var($1.modifier, $1.basic_type|$3, $4, SV_NULL);
$$ = $1;
}
| global_var_declaration ',' opt_star YYF_IDENTIFIER '=' constant
{
declare_global_var($1.modifier, $1.basic_type|$3, $4, $6);
$$ = $1;
}
;
struct_member_decl:
basic_type opt_star YYF_IDENTIFIER
| struct_member_decl ',' opt_star YYF_IDENTIFIER
{ /* FIXME */ }
;
struct_member_decls: /* empty */
| struct_member_decls struct_member_decl ';'
{ /* FIXME */ }
;
struct_declaration:
type_modifier YYF_STRUCT YYF_IDENTIFIER '{' struct_member_decls '}'
{ /* FIXME */ }
;
formal_arg:
basic_type opt_star
| YYF_VARARGS basic_type opt_star
| basic_type opt_star YYF_IDENTIFIER
{
struct ident *id = $3;
union ident_u u;
%line
if (n_param > MAX_PARAM) {
yyerrorn(CE_NPARAM, make_string(id->name, id->namelen));
break;
}
PARAM(n_param).type = $1|$2;
u.param = -1;
id = NEW_IDENT(id, I_TYPE_PARAM, u);
if (id->u.param >= 0)
yyerrorn(CE_DUPPAR, make_string(id->name, id->namelen));
id->u.param = n_param;
PARAM(n_param++).ident = id;
}
| YYF_VARARGS basic_type opt_star YYF_IDENTIFIER
{
struct ident *id = $4;
union ident_u u;
%line
if (n_param > MAX_PARAM) {
yyerrorn(CE_NPARAM, make_string(id->name, id->namelen));
break;
}
PARAM(n_param).type = $1|$2|$3;
u.param = -1;
id = NEW_IDENT(id, I_TYPE_PARAM, u);
if (id->u.param >= 0)
yyerrorn(CE_DUPPAR, make_string(id->name, id->namelen));
id->u.param = n_param;
PARAM(n_param++).ident = id;
}
;
type_list:
formal_arg
{
%line
struct type_list *tl = ALLOC_ANODE(*tl);
$$.list = tl;
$$.length = 1;
/* tl->type = $1 | $2; */
tl->next = 0;
}
| type_list ',' formal_arg
{
%line
struct type_list *tl = ALLOC_ANODE(*tl);
$$.list = tl;
$$.length = $1.length + 1;
/* tl->type = $3 | $4; */
tl->next = $1.list;
}
;
function_signature:
type_modifier YYF_VOID no_star YYF_IDENTIFIER '(' ')'
{ $$ = declare_lfun ($1.fun, $2|$3, $4, 0); }
| type_modifier basic_type opt_star YYF_IDENTIFIER '(' ')'
{ $$ = declare_lfun ($1.fun, $2|$3, $4, 0); }
| type_modifier YYF_VOID no_star YYF_IDENTIFIER '(' type_list ')'
{ $$ = declare_lfun ($1.fun, $2|$3, $4, $6.list); }
| type_modifier basic_type opt_star YYF_IDENTIFIER '(' type_list ')'
{ $$ = declare_lfun ($1.fun, $2|$3, $4, $6.list); }
add_op: '+' | '-' ;
%// The actual concatenation is suspended till we are ready with the
%// curent sequence. This way, we don't suffer quadratic time behaviour
%// when a recursive macro runs wild and we wait for the maximum macro
%// expansion count to be reached.
string_concat:
YYF_STRING YYF_STRING
{
%line
struct string_concat *l;
current_string.length = $1.len + $2.len;
current_string.list.start = $1.start;
l = alloc_tmpnode();
current_string.link = &l->next;
current_string.list.next = l;
if (l) {
l->start = $2.start;
} else {
current_string.length = $1.len;
current_string.link = ¤t_string.list.next;
}
}
| string_concat YYF_STRING
{
%line
struct string_concat *l;
l = alloc_tmpnode();
if (!l)
break;
current_string.length += $2.len;
*current_string.link = l;
current_string.link = &l->next;
l->start = $2.start;
}
;
// similar code in lex.c::cook_string()
string: YYF_STRING
{
%line
$$ = concat_strings($1.start, $1.len, 0);
}
| string_concat
{
%line
*current_string.link = 0;
$$ = concat_strings(
current_string.list.start, current_string.length,
current_string.list.next
);
}
;
constant: YYF_CONSTANT
| string
| '+' constant %prec '~' { $$ = $2; }
| '~' constant { goto const_monop; }
| '!' constant { goto const_monop; }
| '-' constant %prec '~'
{
$1 = F_NEGATE;
const_monop:
*++inter_sp = $2;
$$ = immediate_efun_call($1, 1);
}
| constant '|' constant { goto const_const_binop; }
| constant '^' constant { goto const_const_binop; }
| constant '&' constant { goto const_const_binop; }
| constant YYF_EQUALITY constant { goto const_const_binop; }
| constant YYF_COMPARE constant { goto const_const_binop; }
| constant '<' constant { goto const_const_binop; }
| constant YYF_SHIFT constant { goto const_const_binop; }
| constant YYF_DIV constant { goto const_const_binop; }
| constant '*' constant { goto const_const_binop; }
| constant add_op constant %prec '+'
{
const_const_binop:
*++inter_sp = $1;
*++inter_sp = $3;
$$ = immediate_efun_call($2, 2);
}
| '(' constant ')' { $$ = $2; }
| '(' '{' '}' ')' { ASSIGN_SVALUE_NO_FREE(&$$, NIL_ARRAY); }
| '(' '{' multiconst opt_comma '}' ')'
{
%line
$$ = multiconst_array(&$3);
}
| '(' '[' ']' ')' { $$ = allocate_mapping(0, 0, inter_fp->object); }
| '(' '[' m_multiconst opt_comma ']' ')'
{ $$ = multiconst_mapping(&$3); }
| YYF_CLOSURE_DECL function_signature block { /* FIXME */ }
;
multiconst:
constant
{
struct binode *n;
%line
n = alloc_tmpnode();
n->ntype = N_MULTICONST;
n->node[0].p = 0;
n->node[1].sv = $1;
$$.node = n;
$$.length = 1;
}
| multiconst ',' constant
{
struct binode *n;
%line
n = alloc_tmpnode();
n->ntype = N_MULTICONST;
n->node[0] = $1.node;
n->node[1].sv = $3;
$$.node = n;
$$.length = $1.length + 1;
}
;
multival:
var_expr
{
struct binode *n;
%line
n = alloc_tmpnode();
n->node[0] = 0;
n->node[1] = $1.node;
n->ntype = N_MULTIVAL;
n->opr = $1.vtype;
$$.node.p = n;
$$.length = $1.length;
}
| multiconst ',' var_expr
{
multiconst_multival(&$1);
goto concat_multival;
}
| multival ',' expression
{
struct binode *n;
%line
concat_multival:
n = alloc_tmpnode();
n->node[0] = $1.node;
n->node[1] = $3.node;
n->ntype = N_MULTIVAL;
n->opr = $3.vtype;
$$.node.p = n;
$$.length = $1.length + $3.length;
}
;
m_v_constant:
constant
{
struct binode *n;
%line
n = alloc_tmpnode();
n->ntype = N_MULTICONST;
n->node[0].p = 0;
n->node[1].sv = $1;
$$.node = n;
$$.length = 1;
}
| m_v_constant ';' constant
{
struct binode *n;
%line
n = alloc_tmpnode();
n->ntype = N_MULTICONST;
n->node[0] = $1.node;
n->node[1].sv = $3;
$$.node = n;
$$.length = $1.length + 1;
}
;
m_kv_constant:
constant
{
struct binode *n;
%line
n = alloc_tmpnode();
n->ntype = N_MULTICONST;
n->node[0].sv = $1;
n->node[1].p = 0;
$$.node = n;
$$.length = 0;
}
| constant ':' m_v_constant
{
struct binode *n;
%line
n = alloc_tmpnode();
n->ntype = N_MULTICONST;
n->node[0].sv = $1;
n->node[1] = $3.node;
$$.node = n;
$$.length = $3.length;
}
m_multiconst:
m_kv_constant
{
struct binode *n;
%line
n = alloc_tmpnode();
n->ntype = N_MULTICONST;
n->node[0].p = 0;
n->node[1] = $1.node;
$$.node = n;
$$.length = $1.length;
}
| m_multiconst ',' m_kv_constant
{
struct binode *n;
%line
n = alloc_tmpnode();
n->ntype = N_MULTICONST;
n->node[0] = $1.node;
n->node[1] = $3.node;
$$.node = n;
$$.length = $1.length;
}
m_v_val:
var_expr
{
struct binode *n;
%line
n = alloc_tmpnode();
n->node[0] = 0;
n->node[1] = $1.node;
n->ntype = N_MULTIVAL;
n->opr = $1.vtype;
$$.node.p = n;
$$.length = $1.length;
}
| m_v_constant ';' var_expr
{
multiconst_multival(&$1);
goto concat_m_v_val;
}
| m_v_val ';' expression
{
struct binode *n;
%line
concat_m_v_val:
n = alloc_tmpnode();
n->node[0] = $1.node;
n->node[1] = $3.node;
n->ntype = N_MULTIVAL;
n->opr = $3.vtype;
$$.node.p = n;
$$.length = $1.length + $3.length;
}
m_kv_val:
var_expr
| constant ':' m_v_val
{ constant_expression(&$1); goto var_k_var_v; }
| var_expr ':' m_v_constant
{
/* FIXME */
goto var_k_var_v;
}
| var_expr ':' m_v_val
{
var_k_var_v:
/* FIXME */
}
m_multival:
m_kv_val
| m_multiconst ',' m_kv_val
| m_multival ',' m_kv_constant
| m_multival ',' m_kv_val
opt_less: { $$ = 0; } | '<' { $$ = 1; } ;
opt_comma: | ',' ;
lvalue:
YYF_PARAM
{
%line
$$.node.leaf.type = LN_PARAM;
$$.node.leaf.n.u = $1;
/* the actual length can only be determined when code is generated,
* although 2 is likely.
*/
$$.length = 2;
$$.vtype = PARAM($1).type;
}
| YYF_LOCAL
{
int n = $1->u.local.offset;
%line
$$.node.leaf.type = LN_LOCAL;
$$.node.leaf.n.s = n;
n += stack_use;
$$.length = 2 + (n > 0xff);
$$.vtype = $1->u.local.vtype;
}
| YYF_IDENTIFIER
{
%line
int n = global_variable($1);
struct var_decl *var = GVARIABLE(n);
$$.node.leaf.type = LN_GLOBAL;
$$.node.leaf.n.u = n;
$$.length = 2 + (var->ix > 0xff);
$$.vtype = var->type;
}
| constant '[' opt_less constant ']' %prec '['
{ constant_expression(&$1); goto var_const_index; }
| var_indexable '[' opt_less constant ']' %prec '['
{
%line
struct binode *n;
var_const_index:
n = alloc_node();
$$.node.p = n;
if (!$3 && !($4.i & ~0x1fffe)) {
n->ntype = N_LV_UNARY_CST;
n->node[0].leaf.type = LN_INT;
n->node[0].leaf.n.u = $4.i >> 1;
if (!($4.i & ~0x1fe)) {
n->opr = ULV_CINDEX;
$$.length = $1.length + 2;
} else {
n->opr = ULV_SINDEX;
$$.length = $1.length + 3;
}
} else {
n->ntype = N_LV_BINOP;
n->opr = $3 ? ULV_RINDEX : ULV_INDEX;
$$.length = $1.length + constant_node($4, &n->node[0]) + 1;
}
n->line = current_line;
n->node[1] = $1.node;
if ($1.vtype & TYPE__ARRAY) {
$$.vtype = $1.vtype & ~TYPE__ARRAY;
} else if ($1.vtype == TYPE_STRING) {
$$.vtype = TYPE_NUMBER;
} else {
if ($$.vtype != TYPE_MAPPING)
bad_type(1, 0/*FIXME*/);
$$.vtype = TYPE_ANY;
}
}
| var_indexable '[' opt_less var_expr ']' %prec '['
{
%line
struct binode *n;
var_var_index:
n = alloc_node();
$$.node.p = n;
n->ntype = N_LV_BINOP;
n->opr = $3 ? ULV_RINDEX : ULV_INDEX;
n->line = current_line;
n->node[0] = $4.node;
n->node[1] = $1.node;
$$.length = $4.length + $1.length + 1;
if ($1.vtype & TYPE__ARRAY) {
$$.vtype = $1.vtype & ~TYPE__ARRAY;
} else if ($1.vtype == TYPE_STRING) {
$$.vtype = TYPE_NUMBER;
} else {
if ($$.vtype != TYPE_MAPPING)
bad_type(1, 0/*FIXME*/);
$$.vtype = TYPE_ANY;
}
}
| constant '[' opt_less var_expr ']' %prec '['
{ constant_expression(&$1); goto var_var_index; }
| constant '[' opt_less expression ',' expression ']' %prec '['
{ /* FIXME */ }
| var_indexable '[' opt_less expression ',' expression ']' %prec '['
{
%line
if ($3)
yyerrorn(CE_SYNTAX);
/* FIXME */
}
| constant '[' opt_less expression YYF_RANGE opt_less expression ']'
%prec '['
{ constant_expression(&$1); goto var_range; }
| var_indexable '[' opt_less expression YYF_RANGE opt_less expression
']' %prec '['
{
struct binode *nd;
int code;
%line
var_range:
if ($3)
if ($6)
code = F_RR_RANGE;
else
code = F_RN_RANGE;
else
if ($6)
code = F_NR_RANGE;
else
code = F_RANGE;
nd = ALLOC_NNODE(1 + 3);
nd->ntype = N_EFUN;
nd->line = current_line;
nd->node[0].efun.code = code;
nd->node[0].efun.narg = 3;
nd->node[1] = $1.node;
nd->node[2] = $4.node;
nd->node[3] = $7.node;
$$.node = nd;
$$.length = $1.length + $4.length +$7.length + 1 + (code > 0xff);
if (! ($1.vtype & TYPE__ARRAY) && $1.vtype != TYPE_STRING &&
$1.vtype != TYPE_ANY)
bad_type(1, code);
if ($4.vtype != TYPE_NUMBER && $4.vtype != TYPE_ANY)
bad_type(2, code);
if ($7.vtype != TYPE_NUMBER && $7.vtype != TYPE_ANY)
bad_type(3, code);
$$.vtype = $1.vtype;
}
| constant '[' opt_less expression YYF_RANGE ']' %prec '['
{ constant_expression(&$1); goto var_range2; }
| var_indexable '[' opt_less expression YYF_RANGE ']' %prec '['
{
struct binode *nd;
int code;
%line
var_range2:
if ($3)
code = F_R_RANGE2;
else
code = F_RANGE2;
nd = ALLOC_NNODE(1 + 2);
nd->ntype = N_EFUN;
nd->line = current_line;
nd->node[0].efun.code = code;
nd->node[0].efun.narg = 2;
nd->node[1] = $1.node;
nd->node[2] = $4.node;
$$.node = nd;
$$.length = $1.length + $4.length + 1 + (code > 0xff);
if (! ($1.vtype & TYPE__ARRAY) && $1.vtype != TYPE_STRING &&
$1.vtype != TYPE_ANY)
bad_type(1, code);
if ($4.vtype != TYPE_NUMBER && $4.vtype != TYPE_ANY)
bad_type(2, code);
$$.vtype = $1.vtype;
}
| constant YYF_ARROW YYF_IDENTIFIER
{
/* FIXME */
}
| var_indexable YYF_ARROW YYF_IDENTIFIER
{
/*
* Might be a member of a user defined structure. Convert it
* to an indexing with a constant index.
* For this to happen, $1 must be of a known structure type.
* Else $3 should be a visible auto variable: access to this
* variable in an object.
*/
/* FIXME */
}
;
arguments: /* empty */ { $$.node = 0; $$.length = 0; }
| multival
| multiconst { multiconst_multival(&$1); $$=$1; }
;
var_indexable:
lvalue
| '(' var_expr ')' { $$ = $2; }
| '(' comma_expr ')'
{ $$ = $2; /* FIXME: insert pops, account for their length. */ }
| '(' '{' multival opt_comma '}' ')' {}
| '(' '[' m_multival opt_comma ']' ')' {}
| YYF_IDENTIFIER '(' arguments ')'
{
struct ident *id = $1;
struct ident_global g = { -1, -1, -1, -1};
%line
id = NEW_IDENT(id, I_TYPE_GLOBAL, (union ident_u)g);
if (id->u.global.function >= 0) {
lfun_call(id->u.global.function, $3, &$$);
} else if (id->u.global.efun >= 0) {
efun_call(id->u.global.efun, $3, &$$);
} else {
id = verify_declared_lfun(id);
lfun_call(id->u.global.function, $3, &$$);
}
}
| YYF_IDENTIFIER YYF_SCOPE YYF_IDENTIFIER '(' arguments ')'
{ /* FIXME */ }
| { ASSIGN_SVALUE_NO_FREE(&$<constant>$, NIL_STRING); }
YYF_SCOPE YYF_IDENTIFIER '(' arguments ')'
{ /* FIXME */ }
| string YYF_SCOPE YYF_IDENTIFIER '(' arguments ')'
{ /* FIXME */ }
| constant YYF_ARROW stringified_ident '(' arguments ')'
{
%line
svalue ob = $1;
if (SV_IS_NUMBER(ob) ||
(SV_TYPE(ob) != TYPE_OBJECT && !SV_IS_STRING(ob)))
{
}
$<expression>1.length = constant_node(ob, &$<expression>1.node);
member_call($<expression>1, $3, $5, &$$);
}
| var_indexable YYF_ARROW stringified_ident '(' arguments ')'
{
%line
int type = $1.vtype;
if (type != TYPE_OBJECT && type != TYPE_STRING && type != TYPE_ANY)
{
}
member_call($1, $3, $5, &$$);
}
;
stringified_ident: YYF_IDENTIFIER
{
%line
$$ = make_string($1->name, $1->namelen);
if ($1->type == I_TYPE_UNKNOWN)
free_shared_identifier($1);
}
;
var_expr:
var_indexable
| '&' lvalue
{ /* FIXME */ }
| YYF_ADDQ lvalue %prec YYF_ADDQ
{
%line
struct binode *n;
if ($2.vtype != TYPE_NUMBER && $2.vtype != TYPE_ANY)
bad_type(1, $1);
n = alloc_mnode();
n->ntype = N_LV_UNARY;
n->opr = $1 + ULV_PRE_DEC - ULV_DEC;
$$.node.p = n;
$$.length = $2.length + 1;
$$.vtype = TYPE_NUMBER;
n->node[0] = $2.node;
}
| lvalue YYF_ADDQ %prec YYF_ADDQ
{
%line
struct binode *n;
if ($1.vtype != TYPE_NUMBER && $1.vtype != TYPE_ANY)
bad_type(1, $2);
n = alloc_mnode();
n->ntype = N_LV_UNARY;
n->opr = $2 + ULV_POST_DEC - ULV_DEC;
$$.node.p = n;
$$.length = $1.length + 1;
$$.vtype = TYPE_NUMBER;
n->node[0] = $1.node;
}
| '+' var_expr %prec '~' { $$ = $2; }
| '-' var_expr %prec '~'
{
$1 = F_NEGATE;
goto num_var_unary;
}
| '~' var_expr
{
%line
num_var_unary:
if ($2.vtype != TYPE_NUMBER && $2.vtype != TYPE_ANY)
bad_type(1, $1);
goto var_unary;
}
| '!' var_expr
{
%line
struct binode *n;
var_unary:
n = alloc_mnode();
n->ntype = N_UNARY;
n->opr = $1;
n->line = current_line;
n->node[0] = $2.node;
$$.node.p = n;
$$.length = $2.length + 1;
$$.vtype = TYPE_NUMBER;
}
| var_expr YYF_DIV constant { goto var_const_mul; }
| var_expr '*' constant
{
%line
struct binode *n;
p_int i;
int op;
var_const_mul:
i = $3.i;
op = $2;
if (!(i & i-1)) {
if (i > 2) {
switch(op) {
case F_MULTIPLY:
op = F_LSH;
i = ffs(i) - 2 << 1;
break;
case F_DIVIDE:
op = F_RSH;
i = ffs(i) - 2 << 1;
break;
case F_MOD:
op = F_AND;
i = i - 2;
break;
}
} else if (i == 2) {
if (op == F_MOD) {
op = F_AND;
i = 0;
} else {
$$ = $1;
break;
}
}
}
if ($1.vtype != TYPE_NUMBER && $1.vtype != TYPE_ANY)
bad_type(1, $2);
if (i & 1)
bad_type(2, $2);
n = alloc_node();
n->ntype = N_BINOP;
n->opr = op;
n->line = current_line;
n->node[0] = $1.node;
$$.vtype = TYPE_NUMBER;
$$.node.p = n;
$$.length = $1.length + 1 +
constant_node(i, &n->node[1]);
}
| constant YYF_DIV var_expr { goto const_var_binop; }
| constant '*' var_expr
{
%line
num_const_var_binop:
if (!SV_IS_NUMBER($1))
bad_type(1, $2);
if ($3.vtype != TYPE_NUMBER && $3.vtype != TYPE_ANY)
bad_type(2, $2);
$$.vtype = TYPE_NUMBER;
goto const_var_binop;
}
| var_expr YYF_DIV var_expr { goto num_var_var_binop; }
| var_expr '*' var_expr
{
%line
num_var_var_binop:
if ($1.vtype != TYPE_NUMBER && $1.vtype != TYPE_ANY)
bad_type(1, $2);
if ($3.vtype != TYPE_NUMBER && $3.vtype != TYPE_ANY)
bad_type(2, $2);
$$.vtype = TYPE_NUMBER;
goto var_var_binop;
}
| constant add_op var_expr %prec '+'
{
%line
struct binode *n;
$$.vtype = TYPE_ANY;
const_var_binop:
n = alloc_node();
$$.node.p = n;
$$.length = constant_node($1, &n->node[0]) + 1 + $3.length;
n->node[1] = $3.node;
n->opr = $2;
n->ntype = N_BINOP;
}
| var_expr add_op constant %prec '+'
{
%line
struct binode *n;
$$.vtype = TYPE_ANY;
var_const_binop:
n = alloc_node();
$$.node.p = n;
n->node[0] = $1.node;
$$.length = $1.length + 1 +
constant_node($3, &n->node[1]);
n->opr = $2;
n->ntype = N_BINOP;
}
| var_expr add_op var_expr %prec '+'
{
%line
struct binode *n;
$$.vtype = TYPE_ANY;
var_var_binop:
n = alloc_node();
$$.node.p = n;
$$.length = $1.length + 1 + $3.length;
n->node[0] = $1.node;
n->node[1] = $3.node;
n->opr = $2;
n->ntype = N_BINOP;
}
| constant YYF_SHIFT var_expr { goto num_const_var_binop; }
| var_expr YYF_SHIFT constant
{
num_var_const_binop:
if ($1.vtype != TYPE_NUMBER && $1.vtype != TYPE_ANY)
bad_type(1, $2);
if (!SV_IS_NUMBER($3))
bad_type(2, $2);
$$.vtype = TYPE_NUMBER;
goto var_const_binop;
}
| var_expr YYF_SHIFT var_expr { goto num_var_var_binop; }
| constant '<' var_expr { goto const_var_compare; }
| constant YYF_COMPARE var_expr
{ const_var_compare: constant_expression(&$1); goto var_var_compare; }
| var_expr '<' constant { goto var_const_compare; }
| var_expr YYF_COMPARE constant
{ var_const_compare: constant_expression(&$3); goto var_var_compare; }
| var_expr '<' var_expr { goto var_var_compare; }
| var_expr YYF_COMPARE var_expr
{
var_var_compare:
$$.vtype = TYPE_NUMBER;
/* FIXME: Do type checks. */
goto var_var_binop;
}
| constant YYF_EQUALITY var_expr
{
%line
$$.vtype = TYPE_NUMBER;
goto const_var_binop;
}
| var_expr YYF_EQUALITY constant
{
%line
$$.vtype = TYPE_NUMBER;
goto var_const_binop;
}
| var_expr YYF_EQUALITY var_expr
{
%line
$$.vtype = TYPE_NUMBER;
goto var_var_binop;
}
| constant '&' var_expr { goto num_const_var_binop; }
| var_expr '&' constant { goto num_var_const_binop; }
| var_expr '&' var_expr { goto num_var_var_binop; }
| constant '^' var_expr { goto num_const_var_binop; }
| var_expr '^' constant { goto num_var_const_binop; }
| var_expr '^' var_expr { goto num_var_var_binop; }
| constant '|' var_expr { goto num_const_var_binop; }
| var_expr '|' constant { goto num_var_const_binop; }
| var_expr '|' var_expr { goto num_var_var_binop; }
| constant YYF_LAND var_expr
{
%line
if ($1.i) {
FREE_SVALUE($1);
$$ = $3;
} else {
$$.node.leaf.type = LN_INT;
$$.node.leaf.n.u = 0;
$$.length = 1;
$$.vtype = TYPE_ANY;
}
}
| var_expr YYF_LAND constant
{ constant_expression(&$3); goto var_var_lop; }
| var_expr YYF_LAND var_expr
{
%line
struct binode *n;
$$.vtype = $3.vtype;
var_var_lop:
n = alloc_node();
$$.node.p = n;
$$.length = $1.length + 2 + $3.length;
n->node[0] = $1.node;
n->node[1] = $3.node;
n->opr = $2;
n->ntype = N_LOP;
if ($3.length > 254) {
$$.length += 4;
n->ntype = N_LLOP;
n->opr =
$2 == F_LAND ? F_XLBRANCH_ON_ZERO : F_XLBRANCH_ON_NON_ZERO;
}
}
| constant YYF_LOR var_expr
{
%line
svalue sv = $1;
if (sv.i) {
$$.vtype = comp_type(sv);
$$.length = constant_node(sv, &$$.node);
} else {
$$ = $3;
}
}
| var_expr YYF_LOR constant
{ constant_expression(&$3); goto var_var_lor; }
| var_expr YYF_LOR var_expr
{
%line
var_var_lor:
$$.vtype = ($1.vtype != $3.vtype) ? TYPE_ANY : $1.vtype;
goto var_var_lop;
}
| constant '?' expression ':' constant %prec '?'
{
svalue sv = $1;
%line
if (sv.i) {
$$ = $3;
FREE_SVALUE($5);
}
else {
$$.vtype = comp_type($5);
$$.length = constant_node($5, &$$.node);
}
FREE_SVALUE(sv);
}
| constant '?' expression ':' var_expr %prec '?'
{
svalue sv = $1;
%line
if (sv.i)
$$ = $3;
else
$$ = $5;
FREE_SVALUE(sv);
}
%// N_IF uses opr as a flag if expression return values should be popped.
| var_expr '?' expression ':' constant %prec '?'
{ constant_expression(&$5); goto arith_if; }
| var_expr '?' expression ':' var_expr %prec '?'
{
%line
struct binode *n;
int length, len1, len2;
arith_if:
n = ALLOC_NNODE(3);
length = $5.length;
len2 = 2 + (length > 254) + (length > 32765);
length = $3.length + len2;
len1 = 2 + (length > 254) + (length > 32765);
$$.length = $1.length + len1 + $3.length + len2 + $5.length;
$$.node.p = n;
$$.vtype = $3.vtype == $5.vtype ? $3.vtype : TYPE_ANY;
n->ntype = N_IF;
n->opr = 0 + (len1 << 1) + (len2 << 4);
n->node[0] = $1.node;
n->node[1] = $3.node;
n->node[2] = $5.node;
}
%// can't use opt_star here because this would clash with closure literals.
| '(' '{' '*' basic_type '}' ')' var_expr %prec '~'
{
$$ = $7;
/* FIXME */
}
| '(' '{' basic_type '}' ')' var_expr %prec '~'
{
$$ = $6;
/* FIXME */
}
| lvalue YYF_ASSIGN constant %prec '=' { goto constant_assignment; }
| lvalue '=' constant %prec '='
{
%line
constant_assignment:
$<expression>3.length = constant_node($3, &$<expression>3.node);
goto assignment;
}
| lvalue YYF_ASSIGN var_expr %prec '=' { goto assignment; }
| lvalue '=' var_expr %prec '='
{
%line
struct binode *n;
assignment:
n = alloc_node();
$$.node.p = n;
$$.length = $3.length + 1 + $1.length;
n->node[0] = $3.node;
n->node[1] = $1.node;
n->opr = $2;
n->ntype = N_LV_BINOP;
}
| constant YYF_QARROW YYF_IDENTIFIER { goto test_auto_var; }
| var_indexable YYF_QARROW YYF_IDENTIFIER
{
test_auto_var:
; /* FIXME */
}
;
comma_expr:
var_expr ',' constant
{
%line
struct binode *n;
n = alloc_node();
$$.node.p = n;
$$.length = $1.length + 1 + constant_node($3, &n->node[1]);
$$.vtype = comp_type($3);
n->node[0] = $1.node;
n->ntype = N_SEQUENCE;
}
| var_expr ',' var_expr
{
goto comma_expr;
}
| var_expr ',' comma_expr
{
%line
struct binode *n;
comma_expr:
n = alloc_node();
$$.node.p = n;
$$.length = $1.length + 1 + $3.length;
$$.vtype = $3.vtype;
n->node[0] = $1.node;
n->node[1] = $3.node;
n->ntype = N_SEQUENCE;
}
;
%// expression can often not be used due to a bug in precedence usage:
%// the precedence of the parent rule is ignored.
expression:
constant
{
$$.vtype = comp_type($1);
$$.length = constant_node($1, &$$.node);
}
| var_expr ;
for_cond: expression | comma_expr
| { $$.node.leaf.type = LN_INT; $$.node.leaf.n.s = 1; $$.length = 1; } ;
for_expr: var_expr | comma_expr
| constant { FREE_SVALUE($1); $$.node.p = 0; $$.length = 0; }
| /* empty */ { $$.node.p = 0; $$.length = 0; } ;
brac_expr: expression | comma_expr ;
saveuse_rparen: ')' { $$ = stack_use; }
else: YYF_ELSE { $$ = stack_use; }
saveuse_semi: ';' { $$ = stack_use; }
statement:
expression ';'
{
union node nd;
%line
expression_statement:
nd = $1.node;
if ($1.vtype != TYPE_NIL) {
if (nd.i & 3) {
nd = 0;
$1.length = 0;
} else switch(nd.p->ntype) {
case N_LV_BINOP:
switch(nd.p->opr) {
case ULV_INDEX:
case ULV_RINDEX:
case ULV_MAP_CINDEX:
stack_use++;
}
case N_LV_UNARY:
break;
default:
stack_use++;
}
}
$$.node = nd;
$$.length = $1.length;
}
| comma_expr ';'
{ /* FIXME: might need actual pops. */ goto expression_statement; }
| ';' { $$.node.p = 0; $$.length = 0; }
| block
%// N_IF uses opr as a flag if expression return values should be popped.
| YYF_IF '(' brac_expr saveuse_rparen statement
{
%line
struct binode *n;
int length, len1;
n = ALLOC_NNODE(3);
length = $5.length + (stack_adjust(0, $4) - (uint8 *)0);
len1 = 2 + (length > 254) + (length > 32765);
$$.length = $3.length + len1 + length;
$$.node = n;
n->ntype = N_IF;
n->opr = 1 + (len1 << 1);
n->node[0] = $3.node;
n->node[1] = $5.node;
n->node[2].p = 0;
}
| YYF_IF '(' brac_expr saveuse_rparen statement else statement
{
%line
struct binode *n;
int length, len1, len2;
n = ALLOC_NNODE(3);
length = $7.length += stack_adjust(0, $6) - (uint8 *)0;
len2 = (length > 0 ? 2 : 0) + (length > 254) + (length > 32765);
length = $5.length + (stack_adjust(0, $4) - (uint8 *)0) + len2;
len1 = 2 + (length > 254) + (length > 32765);
$$.length = $3.length + len1 + length + $7.length;
$$.node = n;
n->ntype = N_IF;
n->opr = 1 + (len1 << 1) + (len2 << 4);
n->node[0] = $3.node;
n->node[1] = $5.node;
n->node[2] = len2 ? $7.node : (union node)(struct binode *)0;
}
| YYF_FOR '(' for_expr ';' for_cond saveuse_semi for_expr ')' statement
{
%line
struct binode *n1, *n2, *n3;
int len1, len2, length;
/* $7 can't be simply appended to $9 because it is continue
destination. */
length = stack_adjust(0, $6) - (uint8 *)0;
length += $7.length + $9.length;
len1 = 2 + (length > 254) + (length > 32765);
length += $5.length;
len2 = 2 + (length > 255) + (length > 32767);
n1 = alloc_node();
$$.node.p = n1;
$$.length = $3.length + len1 + length + len2;
n1->ntype = N_SEQUENCE;
n1->node[0] = $3.node;
n2 = alloc_node();
n1->node[1].p = n2;
n2->ntype = N_SEQUENCE;
n2->node[1].p = 0;
n3 = ALLOC_NNODE(3);
n2->node[0].p = n3;
n3->ntype = N_FOR;
n3->opr = len1 + (len2 << 3);
n3->node[0] = $9.node;
n3->node[1] = $7.node;
n3->node[2] = $5.node;
}
| YYF_WHILE '(' brac_expr saveuse_rparen statement
{
%line
struct binode *n;
int len1, len2, length;
n = ALLOC_NNODE(3);
$$.node.p = n;
length = stack_adjust(0, $4) - (uint8 *)0;
length += $5.length;
len1 = 2 + (length > 254) + (length > 32765);
length += $3.length;
len2 = 2 + (length > 255) + (length > 32767);
$$.length = length + (length > 255 ? 8 : 4);
n->ntype = N_FOR;
n->opr = len1 + (len2 << 3);
n->node[0] = $5.node;
n->node[1].p = 0;
n->node[2] = $3.node;
}
| YYF_DO statement YYF_WHILE '(' brac_expr ')' ';'
{
%line
struct binode *n;
int length;
n = alloc_node();
$$.node.p = n;
length = $2.length + $5.length;
$$.length = length + (length > 255 ? 4 : 2);
n->ntype = N_DO;
n->node[0] = $2.node;
n->node[1] = $5.node;
}
| YYF_SWITCH '(' brac_expr ')'
{
} statement {
%line
$$ = $6;
/* FIXME */
}
| YYF_DEFAULT ':'
{
struct binode *n = alloc_mnode();
n->ntype = N_CASE_LABEL;
n->opr = CASE_DEFAULT;
$$.node = n;
$$.length = 0;
}
| local_declaration ';'
{
$$.node = $1.node;
$$.length = $1.length;
}
| YYF_RETURN ';'
{
struct binode *n;
union node v;
%line
n = alloc_mnode();
n->ntype = N_RETURN;
v.leaf.type = LN_INT;
v.leaf.n.s = 0;
n->node[0] = v;
$$.node.p = n;
$$.length = 1;
stack_use = INT_MIN;
}
| YYF_RETURN comma_expr ';' { goto return_expr; }
| YYF_RETURN expression ';'
{
struct binode *n;
union node v;
%line
return_expr:
v = $2.node;
n = alloc_mnode();
n->ntype = N_RETURN;
n->node[0] = v;
$$.node.p = n;
$$.length =
(v.leaf.type != LN_INT || v.leaf.n.s != 0) ? $2.length + 1 : 1;
stack_use = INT_MIN;
}
;
%// statements should only be used from block
%// The code generator uses tail recursion elemination for the second
%// subnode of N_SEQUENCE, thus place the larger subtree there.
%// Need empty start so that local_decalration finds the scope correctly.
statements: {} statement
{
%line
struct binode *n;
n = alloc_node();
n->ntype = N_SEQUENCE;
$<statement>-1.node = n;
$<statement>-1.length = $2.length;
n->node[0] = $2.node;
$$ = &n->node[1];
}
| statements statement
{
%line
struct binode *n;
n = alloc_node();
n->ntype = N_SEQUENCE;
$1->p = n;
$<statement>-1.length += $2.length;
n->node[0] = $2.node;
$$ = &n->node[1];
}
;
block: '{' '}' { $$.node.leaf.type = LN_NIL; $$.length = 0; }
| '{'
{
$<scope>$.link = &$<scope>2.start;
}
statements '}'
{
%line
struct binode *decl, *nxt_decl;
$3->p = 0;
*$<scope>2.link = 0;
for (decl = $<scope>2.start; decl; decl = nxt_decl) {
struct ident *id = decl->node[1].id;
if (id->u.local.offset >= 0)
stack_use++;
free_shared_identifier(id);
nxt_decl = decl->node[0].p;
free_tmpnode(decl);
}
$$ = $<statement>1;
}
;
inherit: type_modifier YYF_INHERIT
| type_modifier YYF_IDENTIFIER inherit
{
%line
#define SIZE_INDEX(v,i) *(int32*)((char *)&v + i)
struct ident *p;
unsigned n;
$$ = $3;
p = $2;
n =
((char *)p - (char *)&inheritance_qualifiers[0]) /
(sizeof *p/sizeof $1.var);
if (n < sizeof $1) {
SIZE_INDEX($$, n) |= SIZE_INDEX($1, n);
if (SIZE_INDEX($<inherit_types>$[2], -n) & TYPE__EXCL_MASK)
yyerrorn(CE_TMODMISMATCH);
} else {
yyerrorn(CE_SYNTAX);
if (p->type == I_TYPE_UNKNOWN) {
p->type = I_TYPE_LIMBO;
p->next_all = identifier_limbo;
identifier_limbo = p;
}
}
}
;
inheritance: inherit string ';'
{
struct ident *p;
while (p = identifier_limbo) {
identifier_limbo = p->next;
free_shared_identifier(p);
}
};
program:
| program inheritance
| program global_var_declaration ';'
| program function_signature ';' { free_param(); }
| program function_signature block
{
%line
struct function *f = $2;
n_fun_def++;
if (!f->inherited)
n_undefined_lfuns--;
f->new_def = 1;
f->num_arg = n_param;
f->num_local = local_preallocated;
/* Reserve one byte for a F_RETURN0 if we need it. */
if (! N_IS_VOLATILE($3.node))
$3.length++;
total_pcode += $3.length;
f->block = $3;
free_param();
local_preallocated = 0;
stack_use = 0;
}
;
%%
%line
static int global_variable(struct ident *p) {
int r;
if (p->type != I_TYPE_GLOBAL || (r = p->u.global.variable) < 0) {
/* variable not declared */
yyerrorn(CE_VARNDECL, make_string(p->name, p->namelen));
return -1;
}
return r;
}
int proxy_efun(int function, int num_arg) {
return -1;
}
static void free_param() {
int n;
for (n = n_param; n--; ) {
free_shared_identifier(PARAM(n).ident);
}
n_param = 0;
}