/* Copyright 1995, 1997 J"orn Rennecke */ #include <stdarg.h> #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> #define COMPILER_GLOBAL #include "common.h" #include "lex.h" #include "compiler.h" #include "exec.h" #include "instrs.h" #include "interpret.h" #include "object.h" #include "uid.h" #include "lang.h" struct program nil_program; int32 current_id_number; extern int pragma_optimize; extern struct ident builtin_structs[]; struct ident builtin_identifiers[] = { #define EFUN_IDENTIFIER builtin_identifiers[0] { "efun", 4, I_TYPE_GLOBAL, 0, 0,0, {{ -2, -2, -1, -1 }}, &builtin_structs[0] } }; static mp_int alloc_variable(); void *alloc_tmpnode() { struct binode *n; n = free_tmpnodes; if (!n) { return alloc_node(); } free_tmpnodes = n->node[0].p; return n; } void free_tmpnode(void *n) { ((struct binode *)n)->node[0].p = free_tmpnodes; free_tmpnodes = n; } union svalue concat_strings(register char *str, mp_int length, struct string_concat *next) { struct string_concat *l; union svalue res; register char *dest; if (length > MAX_SMALL_STRING) { res = ALLOC_LSTRING(length); if (!res.p) goto out_of_memory; dest = SV_LSTRING(res); SV_LSTRREF(res) = 0; SV_LSTRLEN(res) = length; } else { res = ALLOC_STRING(length); if (!res.p) { out_of_memory: yyerrorn(CE_NOMEM); return (union svalue)(p_int)0; } dest = SV_STRING(res); SV_STRREF(res) = 0; SV_STRLEN(res) = length; } goto first_string; do { register char c; next = l->next; str = l->start; free_tmpnode(l); first_string: c = *str; if (c != '\"') do { if (c == '\\') { c = escchars[*(unsigned char *)++str]; if (!c) { /* '\\' \0' and '\\' '\r' are considered to * have unspecified behaviour. We treat * them like '\\' '\n' . */ c = *str; if (c <= '\r') { /* '\\' '\n' , '\\' \n' '\r' or '\\' \r' \n' */ if ((c ^ '\n' ^ '\r') == str[1]) str++; continue; } else { /* octal */ unsigned char d; c -= '0'; d = str[1] - '0'; if (d <= 7) { c <<= 3; c += d; str++; d = str[1] - '0'; if (d <= 7) { c <<= 3; c += d; str++; } } /* end octal */ } } } *dest++ = c; } while ((c = *++str) != '\"'); } while(l = next); return res; } int constant_node(svalue sv, union node *nodep) { if (SV_IS_NUMBER(sv) && sv.i > -0x200 && sv.i < 0x200) { nodep->leaf.type = LN_INT; nodep->leaf.n.s = sv.i >> 1; return ((unsigned)sv.i <= 2) ? 1 : 2; } else if (sv.p == NIL_ARRAY.p) { struct binode *n; n = alloc_mnode(); nodep->p = n; n->ntype = N_UNARY; n->opr = F_ALLOCATE_ARRAY; n->line = 0; /* don't store extra line number information for this */ n->node[0].leaf.type = LN_INT; n->node[0].leaf.n.s = 0; return 2; } else if (! SV_IS_NUMBER(sv) && SV_TYPE(sv) == T_CLOSURE && SV_CLOSURE(sv).g.closure_type == CLOSURE_PROTO_LFUN && SV_CLOSURE(sv).lfun.index < CLOSURE_IDENTIFIER_OFFS) { nodep->leaf.type = LN_LFUN_CLOSURE; nodep->leaf.n.u = SV_CLOSURE(sv).lfun.index; FREE_ALLOCED_SVALUE(sv); return 3; } else { if (num_shared == max_shared) { shared = realloc(shared, sizeof(union svalue)*(max_shared <<= 1)); } nodep->leaf.n.u = num_shared; shared[num_shared++] = sv; nodep->leaf.type = LN_CONST; return num_shared > cshared_threshold ? 3 : 2; /* When generating code, test if type is array or mapping. * Reserve first shared values for shared variables, shift * shared constants up accordingly. */ } } int comp_type(union svalue sv) { if (SV_IS_NUMBER(sv)) return sv.i ? TYPE_NUMBER : TYPE_ANY; switch(SV_TYPE(sv)) { case T_STRING: case T_LSTRING: case T_GSTRING: case T_GLSTRING: case T_ISTRING: case T_ILSTRING: return TYPE_STRING; case T_MAPPING: return TYPE_MAPPING; case T_ARRAY: case T_LARRAY: /* fixme: could test if it's an array of particular type */ return TYPE__ARRAY|TYPE_ANY; case T_OBJECT: return TYPE_OBJECT; case T_DESTRUCTED: return TYPE_ANY; case T_CLOSURE: return TYPE_CLOSURE; case T_QUOTED: sv = SV_QUOTED(sv); if (SV_IS_STRING(sv)) return TYPE_SYMBOL; if (SV_GEN_TYPE(sv) == T_ARRAY) return TYPE_QUOTED_ARRAY; return TYPE_ANY; case T_FLOAT: return TYPE_FLOAT; case T_REGEXP: return TYPE_REGEXP; default: fatal("Unexpected initializer\n"); return 0; } } void constant_expression(YYSTYPE *vp) { svalue sv = vp->constant; vp->expression.vtype = comp_type(sv); vp->expression.length = constant_node(sv, &vp->expression.node); } void multiconst_multival(struct statement *mc) { struct binode *np = mc->node.p; p_int length = 0; do { np->opr = comp_type(np->node[1].sv); length += constant_node(np->node[1].sv, &np->node[1]); np = np->node[0].p; } while (np); mc->length = length; } svalue multiconst_array(struct statement *mc) { struct binode *np = mc->node.p, *next; svalue a = allocate_array(mc->length, SV_OBJECT(inter_fp->object).x.uid->self); if (a.p) { svalue *svp = SV_ARRAY(a).member; do { *svp-- = np->node[1].sv; next = np->node[0].p; free_tmpnode(np); } while (np = next); return a; } else { do { FREE_SVALUE(np->node[1].sv); next = np->node[0].p; free_tmpnode(np); } while (np = next); return SV_NULL; } } static int count_multival(union node mv) { int i = 0; while (mv.p) { mv.p = mv.p->node[0].p; i++; } return i; } svalue multiconst_mapping(struct statement *mc) { p_int length = mc->length; struct binode *kv_list, *next_kv, *kv, *vlist, *next_v; svalue m = allocate_mapping(2, length, inter_fp->object); for (kv_list = mc->node.p; kv_list; kv_list = next_kv) { kv = kv_list->node[1].p; if (m.p) { svalue key = kv->node[0].sv; svalue *start = get_map_lvalue(m, key, 1); svalue *svp = start + length; FREE_SVALUE(key); for (vlist = kv->node[1].p; vlist; vlist = next_v) { svalue sv = vlist->node[1].sv; if (svp == start) { FREE_SVALUE(sv); yyerrorn(CE_SYNTAX); } else *--svp = sv; next_v = vlist->node[0].p; free_tmpnode(vlist); } if (svp != start) { bzero(start, (char*)svp - (char *)start); yyerrorn(CE_SYNTAX); } } else { for (vlist = kv->node[1].p; vlist; vlist = next_v) { FREE_SVALUE(vlist->node[1].sv); next_v = vlist->node[0].p; free_tmpnode(vlist); } } next_kv = kv_list->node[0].p; free_tmpnode(kv_list); } return m; } void efun_call(int n, struct statement args, struct expression *rp) { struct binode *nd; int narg = count_multival(args.node); union node *np; int32 *eargtp; nd = ALLOC_NNODE(1 + narg); nd->ntype = N_EFUN; nd->line = current_line; if (narg > instrs[n].max_arg) yyerrorn(CE_MANYEPAR); if (narg < instrs[n].min_arg) { if (instrs[n].Default > 0) { struct binode *dn; struct expression subexp; struct statement subargs; subargs.node.p = 0; subargs.length = 0; efun_call(instrs[n].Default, subargs, &subexp); dn = alloc_tmpnode(); dn->node[0] = args.node; dn->node[1] = subexp.node; dn->ntype = N_MULTIVAL; dn->opr = subexp.vtype; args.node.p = dn; args.length = args.length + subexp.length; narg++; } if (narg < instrs[n].min_arg) yyerrorn(CE_FEWEPAR); } nd->node[0].efun.narg = narg; np = &nd->node[1]; eargtp = &efun_arg_types[instrs[n].arg_index+narg]; while (--narg >= 0) { np[narg] = args.node.p->node[1]; if (! (1 << args.node.p->opr & *--eargtp) && narg < instrs[n].check_arg) bad_type(narg, args.node.p->opr); args.node = args.node.p->node[0]; } if (n > LAST_INSTRUCTION_CODE) n = efun_aliases[n - LAST_INSTRUCTION_CODE - 1]; nd->node[0].efun.code = n; rp->node.p = nd; rp->length = args.length + 1 + (n > 0xff) + (instrs[n].min_arg != instrs[n].max_arg); rp->vtype = instrs[n].ret_type; } void lfun_call(int n, struct statement args, struct expression *rp) { struct binode *nd; int narg = count_multival(args.node); union node *np; nd = ALLOC_NNODE(1 + narg); nd->ntype = N_LFUN; nd->line = current_line; nd->node[0].lfun.lfun = n; nd->node[0].lfun.narg = narg; np = &nd->node[1]; while (--narg >= 0) { np[narg] = args.node.p->node[1]; if (args.node.p->opr, FUNCTION(n), 0) bad_type(narg, args.node.p->opr); args.node = args.node.p->node[0]; } rp->node.p = nd; rp->length = args.length + 4; rp->vtype = FUNCTION(n)->type; } void member_call(struct expression ob, svalue fun, struct statement args, struct expression *rp) { struct binode *nd; int narg = count_multival(args.node); union node *np; nd = ALLOC_NNODE(2 + 2 + narg); nd->ntype = N_EFUN; nd->node[0].efun.code = F_CALL_OTHER; nd->node[0].efun.narg = 2 + narg; nd->node[1] = ob.node; args.length += ob.length + constant_node(fun, &nd->node[2]); np = &nd->node[3]; /* Eerything is allowed for the arguments, so there is no point in useing the vanilla typechecking approach. */ while (--narg >= 0) { np[narg] = args.node.p->node[1]; args.node = args.node.p->node[0]; } rp->node.p = nd; rp->length = args.length + 2; rp->vtype = instrs[F_CALL_OTHER].ret_type; } svalue immediate_efun_call(int code, int num_arg) { static struct efun_closure cl = {T_CLOSURE, 1}; struct control_ret cntret; cl.closure_type = code + CLOSURE_EFUN; cl.ob = inter_fp->object; cntret = closure_frame(TO_SVALUE(&cl), inter_sp, inter_fp, num_arg, 0, IR_EXTERN); return interpreter(cntret.fp, cntret.sp); } struct function * declare_lfun(int modifier, int type, struct ident *id, struct type_list *list) { struct function *fun; struct ident_global g = { -1, -1, -1, -1}; id = NEW_IDENT(id, I_TYPE_GLOBAL, (union ident_u)g); if (id->u.global.function >= 0) { fun = FUNCTION(id->u.global.function); } else { fun = ALLOC_ANODE(*fun); id->u.global.function = store_function(fun); n_undefined_lfuns++; fun->inherited = 0; } fun->modifier = modifier; fun->type = type; fun->new_def= 0; fun->undeclared = 0; fun->num_arg = local_preallocated; fun->name.id = id; return fun; } struct ident *verify_declared_lfun(struct ident *id) { struct ident_global g = { -1, -1, -1, -1}; id = NEW_IDENT(id, I_TYPE_GLOBAL, (union ident_u)g); if (id->u.global.function < 0) { struct function *f; if (pragma_strong_types) yyerrorn(CE_VARNDECL, make_string(id->name, id->namelen)); f = ALLOC_ANODE(*f); if (f) { id->u.global.function = store_function(f); f->name.id = id; f->new_def = 0; f->undeclared = 1; f->inherited = 0; n_undefined_lfuns++; } } return id; } void declare_global_var(int modifier, int type, struct ident *id, svalue init) { struct var_decl *var, *inherited = 0; struct ident_global g = { -1, -1, -1, -1}; int ix; id = NEW_IDENT(id, I_TYPE_GLOBAL, (union ident_u)g); ix = id->u.global.variable; if (ix >= 0) { inherited = GVARIABLE(ix); if (!inherited->inherited_from) { yyerrorn(CE_VARREDEF, make_string(id->name, id->namelen)); FREE_SVALUE(init); return; } } else { id->u.global.variable = ix = alloc_variable(); } var = ALLOC_ANODE(*var); GVARIABLE(ix) = var; var->next_inherited = inherited; var->inherited_from = 0; /* FIXME: handle virtual & shared variables */ var->ix = n_globals++; var->modifier = modifier; var->type = type; var->name.id = id; } static int current_node_block; static int current_node_block_offset; struct binode *node_blocks[MAX_NODE_BLOCKS]; struct binode *alloc_node() { size_t need = sizeof (struct binode); if (current_node_block_offset < need) { node_blocks[++current_node_block] = alloc_gen(BYTES_PER_NODE_BLOCK); current_node_block_offset = BYTES_PER_NODE_BLOCK; } return (struct binode *) &node_blocks[current_node_block][current_node_block_offset -= need]; } void *alloc_nnode(size_t need) { if (current_node_block_offset < need) { node_blocks[++current_node_block] = alloc_gen(BYTES_PER_NODE_BLOCK); current_node_block_offset = BYTES_PER_NODE_BLOCK; } return &node_blocks[current_node_block][current_node_block_offset -= need]; } static void free_node_blocks() { while(current_node_block >= 0) { free_gen(node_blocks[current_node_block--]); } } mp_int store_function(struct function *f) { mp_int ix = function_ix++; if (! (ix & BLOCK_MASK) && ix) { struct function **new_block = alloc_gen(BYTES_PER_NODE_BLOCK); if (! new_block) return -1; funblocks[ix >> BLOCK_BITS] = new_block; } FUNCTION(ix) = f; return ix; } static mp_int alloc_variable() { mp_int ix = variable_ix++; if (ix >= varblock_size) { struct var_decl **new; new = alloc_gen(varblock_size * 2 * sizeof *new); memcpy(new, varblock, varblock_size * sizeof *new); varblock_size >>= 1; free_gen(varblock); varblock = new; } return ix; } uint8 *stack_adjust(uint8 *pc, int old_stack_use) { int emit = pc != 0; while (stack_use > old_stack_use) { if (emit) *pc = F_POP; pc++; stack_use--; } /* Usually stack_use will be at least as large as old_stack_use, but it might not after we passed a return. */ stack_use = old_stack_use; return pc; } p_int optimize(union node *npp) { union node nd = *npp; if (nd.i & 3) { int n = nd.leaf.n.u; switch (nd.leaf.type) { case LN_INT: return 1 + (n > 1U); case LN_LOCAL: if (n >= -0xf) { nd.leaf.type = LN_PICK; return 1; } return 2; } } else { int opr = nd.p->opr; switch (nd.p->ntype) { } } fatal("unimplemented\n"); } void prepare_compile() { num_shared = 0; max_shared = 128; shared = malloc(sizeof(svalue)*max_shared); current_node_block = -1; current_node_block_offset = 0; local_preallocated = 0; free_tmpnodes = 0; function_ix = 0; variable_ix = 0; n_fun_def = 0; n_shared_var = 0; n_param = 0; all_proto_closures = 0; cshared_threshold = 0x400; n_undefined_lfuns = 0; n_globals = 0; if (!funblocks[0]) funblocks[0] = alloc_gen(BYTES_PER_NODE_BLOCK); if (!varblock) { varblock = alloc_gen(INIT_VARBLOCK_SIZE * sizeof *varblock); varblock_size = INIT_VARBLOCK_SIZE; } } static uint8 *compile_lvalue_node(uint8 *pc, union node nd); /* void_accepted is only used to guide code generation. If there is some actual optimization that can be performed (like leaving out something altogether) it should have been done earlier. */ static uint8 *compile_value_node(uint8 *pc, union node nd, int void_accepted) { if (nd.i & 3) { int n = nd.leaf.n.u; switch (nd.leaf.type) { case LN_GLOBAL: { struct var_decl *var = GVARIABLE(n); int ix = var->ix; if (ix > 0xff) { *pc++ = F_V_GLOBAL16; STORE16(pc, ix); pc += 2; } else { *pc++ = F_V_GLOBAL; *pc++ = ix; } stack_use++; break; } case LN_PARAM: { int n2; n -= n_param; n2 = n - stack_use - local_preallocated - offsetof(struct frame, locals) / sizeof(p_int) + offsetof(struct frame, arguments[1]) / sizeof(p_int); if (n2 >= -0xf) { } if (0 && n2 >= -0xff) { *pc++ = F_V_LOCAL; *pc++ = n + 0xff; break; } *pc++ = F_V_PARAM; *pc++ = n + 0x100; stack_use++; break; } case LN_LOCAL: n -= stack_use; if (n < -0xff) { *pc++ = F_V_LOCAL; STORE16(pc, n + 0x100ff); pc += 2; } else { *pc++ = F_V_LOCAL; *pc++ = n + 0xff; } stack_use++; break; case LN_INT: if (n & 0x8000) { *pc++ = F_NCLIT; *pc++ = -n; } else if (n <= 1) { *pc++ = F_CONST0 + n; } else { *pc++ = F_CLIT; *pc++ = n; } stack_use++; break; case LN_LFUN_CLOSURE: *pc++ = F_CLOSURE; n = FUNCTION(n)->ix; STORE16(pc, n); pc += 2; stack_use++; break; case LN_CONST: n += n_shared_var; if (n < 0x400) { *pc++ = F_CSHARED0 + (n >> 8); *pc++ = n; } else { *pc++ = F_SHARED; STORE16(pc, n); pc += 2; } stack_use++; break; case LN_UNSHARED: n += n_shared_var; if (n < 0x400) { *pc++ = F_CSHARED0 + (n >> 8); *pc++ = n; } else { *pc++ = F_SHARED; STORE16(pc, n); pc += 2; } *pc++ = F_UNSHARE; stack_use++; break; case LN_SHARED: } } else { int opr = nd.p->opr; switch (nd.p->ntype) { case N_RETURN: if (nd.p->node[0].leaf.type == LN_INT && nd.p->node[0].leaf.n.s == 0) { *pc++ = F_RETURN0; } else { pc = compile_value_node(pc, nd.p->node[0], 0); *pc++ = F_RETURN; } stack_use = 0; break; case N_VOLATILE: pc = compile_value_node(pc, nd.p->node[0], 1); stack_use = 0; break; case N_UNARY: pc = compile_value_node(pc, nd.p->node[0], 0); *pc++ = opr; break; case N_BINOP: pc = compile_value_node(pc, nd.p->node[0], 0); pc = compile_value_node(pc, nd.p->node[1], 0); *pc++ = opr; stack_use--; break; case N_LV_BINOP: pc = compile_value_node(pc, nd.p->node[0], 0); pc = compile_lvalue_node(pc, nd.p->node[1]); switch (opr) { case ULV_ASSIGN: case ULV_ADD: case ULV_SUB: case ULV_AND: case ULV_OR: case ULV_XOR: case ULV_MUL: case ULV_DIV: case ULV_MOD: case ULV_RSH: case ULV_LSH: if (void_accepted) { opr++; stack_use--; } case ULV_INDEX: case ULV_RINDEX: *pc++ = opr; break; case ULV_MAP_CINDEX: *pc++ = opr; *pc++ = nd.p->node[2].leaf.n.s; break; } break; case N_LV_UNARY_CST: pc = compile_lvalue_node(pc, nd.p->node[1]); *pc++ = opr; switch (opr) { case ULV_CINDEX: case ULV_CRINDEX: *pc++ = nd.p->node[0].leaf.n.u; stack_use++; break; case ULV_SINDEX: case ULV_SRINDEX: STORE16(pc, nd.p->node[0].leaf.n.u); pc += 2; stack_use++; break; } break; case N_LV_UNARY: pc = compile_lvalue_node(pc, nd.p->node[0]); switch (opr) { case ULV_PRE_DEC: case ULV_POST_DEC: case ULV_PRE_INC: case ULV_POST_INC: if (! void_accepted) stack_use++; else opr |= 3; case ULV_DEC: case ULV_INC: *pc++ = opr; break; } break; case N_EFUN: { int n, narg = nd.p->node[0].efun.narg; for (n = 0; ++n <= narg; ) { pc = compile_value_node(pc, nd.p->node[n], 0); } n = nd.p->node[0].efun.code; if (n > 0xff) *pc++ = n >> F_ESCAPE_BITS; *pc++ = n; stack_use -= narg - (instrs[n].ret_type != TYPE_NIL); if (instrs[n].min_arg != instrs[n].max_arg) *pc++ = narg; break; } case N_LFUN: { int n, narg = nd.p->node[0].lfun.narg; for (n = 0; ++n <= narg; ) { pc = compile_value_node(pc, nd.p->node[n], 0); } n = nd.p->node[0].lfun.lfun; *pc++ = F_CALL_FUNCTION_BY_INDEX; *pc++ = narg; STORE16(pc, FUNCTION(n)->ix); pc += 2; stack_use -= narg - 1; break; } case N_SEQUENCE: { do { pc = compile_value_node(pc, nd.p->node[0], 1); nd = nd.p->node[1]; } while (nd.p); break; } case N_IF: { uint8 *branch1, *branch2; int opr = nd.p->opr; int len1 = opr >> 1 & 7; int len2 = opr >> 4 & 7; int inverted = opr & 128 ? F_BRANCH_ON_NON_ZERO - F_BRANCH_ON_ZERO : 0; int save_stack_use; pc = compile_value_node(pc, nd.p->node[0], 0); branch1 = pc; pc += len1; save_stack_use = --stack_use; pc = compile_value_node(pc, nd.p->node[1], opr & 1); if (opr & 1) pc = stack_adjust(pc, save_stack_use); branch2 = pc; pc += len2; if (len1 == 2) { branch1[0] = F_BRANCH_ON_ZERO + inverted; branch1[1] = pc - branch1 - 1; } else if (len1 == 3) { branch1[0] = F_LBRANCH_ON_ZERO + inverted; STORE16(branch1+1, pc - branch1 - 1); } else { branch1[0] = F_XLBRANCH_ON_ZERO + inverted; STORE24(branch1+1, pc - branch1 - 1); } if (len2) { stack_use = save_stack_use; pc = compile_value_node(pc, nd.p->node[2], opr & 1); if (opr & 1) pc = stack_adjust(pc, save_stack_use); if (len2 == 2) { branch2[0] = F_BRANCH; branch2[1] = pc - branch2 - 1; } else if (len2 == 3) { branch2[0] = F_LBRANCH; STORE16(branch2+1, pc - branch2 - 1); } else { branch2[0] = F_XLBRANCH; STORE24(branch2+1, pc - branch2 - 1); } } break; } case N_FOR: { int opr = nd.p->opr; int len1 = opr & 7, len2 = opr >> 3 & 7; int inverted = opr & 128 ? F_BRANCH_ON_ZERO - F_BRANCH_ON_NON_ZERO : 0; int ulv = opr & 64 ? ULV_PRE_DEC_BBRANCH - F_BRANCH_ON_NON_ZERO : 0; uint8 *branch1, *dest2; int save_stack_use; branch1 = pc; pc += len1; dest2 = pc; save_stack_use = stack_use; if (nd.p->node[0].p) pc = compile_value_node(pc, nd.p->node[0], 1); if (nd.p->node[1].p) pc = compile_value_node(pc, nd.p->node[1], 1); pc = stack_adjust(pc, save_stack_use); if (len1 == 2) { branch1[0] = F_BRANCH; branch1[1] = pc - branch1 - 1; } else if (len1 == 3) { branch1[0] = F_LBRANCH; STORE16(branch1+1, pc - branch1 - 1); } else { branch1[0] = F_XLBRANCH; STORE24(branch1+1, pc - branch1 - 1); } pc = compile_value_node(pc, nd.p->node[2], 0); if (len2 == 2) { pc[0] = F_BBRANCH_ON_NON_ZERO + inverted + ulv; pc[1] = - (dest2 - pc); } else if (len2 == 3) { pc[0] = F_LBRANCH_ON_NON_ZERO + inverted; STORE16(pc+1, dest2 - pc - 1); } else { pc[0] = F_XLBRANCH_ON_NON_ZERO + inverted; STORE24(pc+1, dest2 - pc - 1); } stack_use--; pc += len2; break; } case N_LOP: { uint8 *branch; pc = compile_value_node(pc, nd.p->node[0], 0); *pc = nd.p->opr; branch = pc; pc += 2; stack_use--; pc = compile_value_node(pc, nd.p->node[1], 0); branch[1] = pc - branch - 1; break; } case N_LLOP: { uint8 *branch; pc = compile_value_node(pc, nd.p->node[0], 0); *pc++ = F_PICK0; *pc = nd.p->opr; branch = pc; pc += 4; *pc++ = F_POP; stack_use--; pc = compile_value_node(pc, nd.p->node[1], 0); STORE24(branch+1, pc - branch - 1); break; } } } return pc; } static uint8 *compile_lvalue_node(uint8 *pc, union node nd) { if (nd.i & 3) { int n = nd.leaf.n.u; switch (nd.leaf.type) { case LN_GLOBAL: { struct var_decl *var = GVARIABLE(n); int ix = var->ix; if (ix > 0xff) { *pc++ = F_LV_GLOBAL16; STORE16(pc, ix); pc += 2; } else { *pc++ = F_LV_GLOBAL; *pc++ = ix; } break; } case LN_PARAM: { int n2; n -= n_param; n2 = n - stack_use - local_preallocated - offsetof(struct frame, locals) / sizeof(p_int) + offsetof(struct frame, arguments[1]) / sizeof(p_int); if (n2 >= -0xf) { } if (0 && n2 >= -0xff) { *pc++ = F_LV_LOCAL; *pc++ = n + 0xff; break; } *pc++ = F_LV_PARAM; *pc++ = n + 0x100; break; } case LN_LOCAL: n -= stack_use; if (n >= -0xff) { *pc++ = F_LV_LOCAL; *pc++ = n + 0xff; } else { *pc++ = F_LV_LOCAL16; STORE16(pc, n + 0x100ff); pc += 2; } break; case LN_SHARED: case LN_CONST: } } else { int opr = nd.p->opr; switch (nd.p->ntype) { case N_LV_UNARY_CST: pc = compile_lvalue_node(pc, nd.p->node[1]); opr += ULV_LV_CINDEX - ULV_CINDEX; *pc++ = opr; switch (opr) { case ULV_LV_CINDEX: case ULV_LV_CRINDEX: *pc++ = nd.p->node[0].leaf.n.u; break; case ULV_LV_SINDEX: case ULV_LV_SRINDEX: STORE16(pc, nd.p->node[0].leaf.n.u); pc += 2; break; } break; case N_LV_BINOP: pc = compile_value_node(pc, nd.p->node[0], 0); pc = compile_lvalue_node(pc, nd.p->node[1]); opr += ULV_LV_INDEX - ULV_INDEX; switch (opr) { case ULV_LV_INDEX: case ULV_LV_RINDEX: *pc++ = opr; break; case ULV_LV_MAP_CINDEX: *pc++ = opr; *pc++ = nd.p->node[2].leaf.n.s; break; } stack_use--; break; } } return pc; } static int cmp_fundef(const void *a, const void *b) { uint16 ia = *(uint16*)a, ib = *(uint16*)b; struct function *fa = FUNCTION(ia), *fb = FUNCTION(ib); p_int d; d = fb->inherited - fa->inherited; if (! d) d = fa->name.sv.i - fb->name.sv.i; if (sizeof d == sizeof (int)) return d; return d < 0 ? -1 : d > 0; } struct program *end_compile() { struct program *prog = 0; p_int size = sizeof *prog; svalue sv; int nnames; svalue *shared_start; /* Make space for narg, nlocal bytes at function start. */ total_pcode += 2 * n_fun_def; /* We don't share the F_UNDEF so that we can properly sort. But we don't need narg/nlocal bytes for these since the values don't matter. */ total_pcode += 2 * n_undefined_lfuns; if (pragma_optimize || num_shared > cshared_threshold) { int ix; for (ix = function_ix; --ix >= 0; ) { struct function *f = FUNCTION(ix); if (pragma_optimize || f->new_def && f->cshared_threshold > cshared_threshold) { stack_use = 0; total_pcode -= f->block.length; total_pcode += f->block.length = optimize(&f->block.node); } } } size += function_ix * 1; size += total_pcode; size = ALIGNI(size, p_int); size += num_shared * sizeof (p_int); size += n_fun_def * sizeof(struct new_function); size = ALIGNI(size, p_int); sv = ALLOC_TTS(T_INTERNAL, IT_PROGRAM, n_globals, size); if (sv.p) do { uint16 *fia, *fip; int ix; struct new_function *nfp; uint8 *pcode; prog = (struct program *)(sv.p - 1); prog->ref = 1; prog->load_time = current_time; prog->id_number = ++current_id_number ? current_id_number : renumber_programs(); prog->function.name = 0; pcode = &prog->virtual.function_8[function_ix]; pcode += total_pcode; prog->shared = shared_start = (svalue*)ALIGN(pcode, p_int); memcpy(shared_start, shared, num_shared * sizeof *shared); fia = (uint16 *)(shared_start + num_shared); for (fip = fia, ix = function_ix; --ix >= 0;) { struct function *f = FUNCTION(ix); if (!f->inherited) { f->name.sv = make_global_string(f->name.id->name, f->name.id->namelen); *fip++ = ix; } } qsort(fia, n_fun_def + n_undefined_lfuns, sizeof fia[0], cmp_fundef); for (ix = function_ix; --ix >= 0; ) { int ix2 = *--fip; FUNCTION(ix2)->ix = ix; } nfp = (struct new_function *)fia + n_fun_def + n_undefined_lfuns; /* end of used space is nfp */ while (all_proto_closures.p) { svalue cl = all_proto_closures; int n; SV_CLOSURE(cl).lfun.closure_type -= CLOSURE_PROTO_LFUN - CLOSURE_LFUN; n = SV_CLOSURE(cl).lfun.index; SV_CLOSURE(cl).lfun.index = FUNCTION(n)->ix; all_proto_closures = SV_CLOSURE(cl).lfun.ob; SV_CLOSURE(cl).lfun.ob = COPY_SVALUE(inter_fp->object); FREE_ALLOCED_SVALUE (cl); } for (fip += function_ix; fip != fia; ) { int ix; struct function *f; ix = *--fip; f = FUNCTION(ix); nfp--; nfp->name = f->name.sv; if (!f->new_def) { *--pcode = (uint8)F_UNDEF; *--pcode = F_ESCAPE; nfp->start = pcode - (uint8 *)prog; } else { pcode[-1] = F_RETURN0; pcode -= f->block.length; nfp->start = pcode - (uint8 *)prog; /* TYPE__STATIC is inversed */ nfp->flags = 0 ^ TYPE__STATIC; n_param = f->num_arg; stack_use = 0; compile_value_node(pcode, f->block.node, 1); *--pcode = f->num_local; *--pcode = f->num_arg; } } prog->new_function = nfp; memset(&prog->virtual, 0, n_fun_def - n_fun_redef); nnames = function_ix; sv = ALLOC_TTS(T_INTERNAL, IT_NAMETABLE, nnames, ALIGNI(sizeof(p_int) + nnames*sizeof prog->function.name[0], p_int)); if (!sv.p) break; prog->function.name = (uint16 *)(sv.p - 1 + sizeof(p_int)); for (fip = prog->function.name, ix = nnames; --ix >= 0; ) fip[ix] = ix; } while (0); lex_close(0); free_node_blocks(); if (varblock_size > INIT_VARBLOCK_SIZE) { free_gen(varblock); varblock = 0; } return prog; } struct program *compile_file(uint8 *namestart, mp_int namelen, int language) { int fd; uint8 save[3]; uint8 *suffixes[] = { ".c" }; prepare_compile(); memcpy(save, namestart+namelen, sizeof save); strcpy(namestart+namelen, suffixes[language]); fd = open(namestart, O_RDONLY); if (fd < 0) { yyerrorn(CE_SRC_NF); return 0; } memcpy(namestart+namelen, save, sizeof save); lex_open(fd, make_string(namestart, namelen)); stack_use = 0; yyparse(); return end_compile(); } void yyerrorn(int ce_errno, ...) { int nargs, i; va_list va; union svalue sv; nargs = ce_error_nargs[ce_errno]; PUSH_NUMBER(ce_errno); va_start(va, ce_errno); for (i = 0; i < nargs; i++) { *++inter_sp = va_arg(va, union svalue); } va_end(va); sv = call_hook(driver_hook[H_COMPILE_ERROR], master_ob, nargs+1); FREE_SVALUE(sv); } void bad_type(int narg, int opr) { yyerrorn(CE_BADTYPE, (p_int)narg << 1, (p_int)opr << 1); } void yyerror(char *str) { int ce_errno; if (!strcmp(str, "yacc stack overflow")) { ce_errno = CE_STACKOVERFLOW; } else if (!strcmp(str, "syntax error")) { ce_errno = CE_SYNTAX; } else { fatal("yyerror(): unknown error %s\n", str); return; } yyerrorn(ce_errno); }