void select_assign(Node var_node, Node expr_node, Symbol type_name) /*;select_assign*/ { Symbol var_name, expr_name; var_name = N_UNQ(var_node); expr_name = N_UNQ(expr_node); if (is_simple_type(type_name) && is_simple_name(var_node) && !is_renaming(var_name) ) { if ((is_simple_name(expr_node) && N_KIND(expr_node) != as_null && !is_renaming(expr_name)) || (N_KIND(expr_node) == as_selector || N_KIND(expr_node) == as_index || N_KIND(expr_node) == as_all)) { gen_address(expr_node); gen_ks(I_INDIRECT_POP, kind_of(type_name), var_name); } else { gen_value(expr_node); gen_ks(I_POP, kind_of(type_name), var_name); } } else { gen_address(var_node); select_move(expr_node, type_name); } }
static void select_move(Node node, Symbol type_name) /*;select_move*/ { if (is_simple_type(type_name)) { if ((N_KIND(node) != as_null && is_simple_name(node) && !is_renaming(N_UNQ(node))) || (N_KIND(node) == as_selector || N_KIND(node) == as_index || N_KIND(node) == as_all)) { gen_address(node); gen_k(I_INDIRECT_MOVE, kind_of(type_name)); } else { gen_value(node); gen_k(I_MOVE, kind_of(type_name)); } } else { if (is_array_type(type_name)) { gen_value(node); gen(I_ARRAY_MOVE); } else { gen_value(node); gen_s(I_RECORD_MOVE, type_name); } } }
irep_idt cpp_namet::get_base_name() const { assert(is_simple_name()); const subt &sub=get_sub(); if(sub.size()==1 && sub.front().id()==ID_name) return sub.front().get(ID_identifier); else if(sub.size()==2 && sub.front().id()==ID_operator) return "operator"+sub[1].id_string(); else if(sub.size()==2 && sub[0].id()=="~" && sub[1].id()==ID_name) return sub[0].id_string()+sub[1].get_string(ID_identifier); else assert(false); return irep_idt(); }
/* Object evaluation */ void gen_address(Node node) /*;gen_address*/ { /* * This procedure generates code for the o_expressions * or, in other words, the left-handsides. */ Node pre_node, array_node, range_node, lbd_node, ubd_node, record_node, field_node, id_node; Symbol node_name, type_name, record_name, record_type, field_name, comp_type, proc_name, return_type; int f_off, bse, off, nk; Fortup ft1; #ifdef TRACE if (debug_flag) gen_trace_node("GEN_ADDRESS", node); #endif while (N_KIND(node) == as_insert) { FORTUP(pre_node=(Node), N_LIST(node), ft1); compile(pre_node); ENDFORTUP(ft1); node = N_AST1(node); } node_name = N_UNQ(node); if (is_simple_name(node)) { type_name = get_type(node); if (is_renaming(node_name)) gen_ks(I_PUSH, mu_addr, node_name); else gen_s(I_PUSH_EFFECTIVE_ADDRESS, node_name); /* Arrays are treated in a different manner, depending on their */ /* nature: parameters, constants, variables... */ if (is_array_type(type_name)) { if (is_formal_parameter(node_name)) { type_name = assoc_symbol_get(node_name, FORMAL_TEMPLATE); } gen_s(I_PUSH_EFFECTIVE_ADDRESS, type_name); } } else { switch (nk = N_KIND(node)) { case as_raise: compile(node); break; case as_index: gen_subscript(node); break; case as_slice: array_node = N_AST1(node); range_node = N_AST2(node); /*range_name = N_UNQ(range_node); -- never used ds 7-8-85 */ /* Note: case of type simple name changed into range attribute */ /* by expander */ if (N_KIND(range_node) == as_attribute) { gen_attribute(range_node); } else { /* range */ lbd_node = N_AST1(range_node); ubd_node = N_AST2(range_node); gen_value(lbd_node); gen_value(ubd_node); } if (N_KIND(array_node) == as_attribute) { gen_attribute(array_node); } else { gen_address(array_node); } gen(I_ARRAY_SLICE); break; case as_selector: record_node = N_AST1(node); field_node = N_AST2(node); record_name = N_UNQ(record_node); record_type = get_type(record_node); field_name = N_UNQ(field_node); f_off = FIELD_OFFSET(field_name); if (f_off >= 0 && ((! has_discriminant(record_type)) || NATURE(field_name) == na_discriminant)){ if (is_simple_name(record_node) && !(is_renaming(record_name)) && is_global(record_name)) { reference_of(record_name); bse = REFERENCE_SEGMENT; off = REFERENCE_OFFSET; /* The SETL version has generate(I_PUSH_IMMEDIATE, mu_addr, * ref, field_name); * which we translate as (I_PUSH_EFFECTIVE_ADDRESS ... * ref = [bse, off+f_off]; * Replace use of explicit ref by PUSH_IMMEDIATE */ /* gen_rc(I_PUSH_IMMEDIATE, explicit_ref_new(bse, * off+f_off), ""); */ gen_kv(I_PUSH_IMMEDIATE, mu_word, int_const(bse)); gen_kv(I_PUSH_IMMEDIATE, mu_word, int_const(off+f_off)); } else { gen_address(record_node); if (f_off != 0 ) { gen_ki(I_ADD_IMMEDIATE, mu_word, f_off); } } if (is_array_type(comp_type=TYPE_OF(field_name))) { gen_s(I_PUSH_EFFECTIVE_ADDRESS, comp_type); } } else { gen_address(record_node); gen_s(I_PUSH_EFFECTIVE_ADDRESS, record_type); /* translating following assuming field_name is comment part of *-- instruction ds 7-5-86 * gen_i(I_SELECT, FIELD_NUMBER(field_name), field_name); */ gen_i(I_SELECT, (int) FIELD_NUMBER(field_name)); } break; case as_all: id_node = N_AST1(node); gen_value(id_node); if (is_array_type(N_TYPE(node))) gen_k(I_DEREF, mu_dble); break; case as_call: id_node = N_AST1(node); proc_name = N_UNQ(id_node); return_type = TYPE_OF(proc_name); gen_kc(I_DUPLICATE, kind_of(return_type), "place holder"); compile(node); /* processed from now as a procedure call */ break; case as_un_op: gen_unary(node); break; case as_op: gen_binary(node); break; case as_string_ivalue: gen_value(node); break; default: compiler_error_k("GEN_ADDRESS called with kind ", node); } } }
void gen_subscript(Node node) /*;gen_subscript*/ { Symbol comp_type; Node index_name, array_node; Node index_list_node, subscript; Tuple index_type_list, subscripts, tup; Symbol array_name, array_type; int optimized; int index, seg, offset; Fortup ft1; #ifdef TRACE if (debug_flag) gen_trace_node("GEN_SUBSCRIPT", node); #endif array_node = N_AST1(node); index_list_node = N_AST2(node); array_name = N_UNQ(array_node); array_type = get_type(array_node); tup = SIGNATURE(array_type); index_type_list = (Tuple) tup[1]; comp_type = (Symbol) tup[2]; /* need tup_copy since subscripts used in tup_fromb below */ subscripts = tup_copy(N_LIST(index_list_node)); /* * Before applying the brute force method of the 'do-it-all' instruction * "subscript", which can solve any case, some optimizations will be * attempted. * * First, we try to compute the address of the indexed element directly, * when subscripts are immediate values and the index check can be done * at compile time: */ if ((Symbol)index_type_list[1] == symbol_none) { optimized = FALSE; } else if (!(is_unconstrained(array_type))) { index = compute_index(subscripts, index_type_list); optimized = index != -1; if (optimized) { if (has_static_size(comp_type)) { index = index * size_of(comp_type); if (is_simple_name(array_node) && !is_renaming(array_name) ) { if (is_global(array_name)) { reference_of(array_name); seg = REFERENCE_SEGMENT; offset = REFERENCE_OFFSET; /*gen_todo(I_PUSH_EFFECTIVE_ADDRESS,[seg, offset+index], * array_name + '(" + str(get_ivalue(subscripts(1))) * +/ [', '+str(get_ivalue(subscripts(i))): * i in [2..#subscripts] ] * + ")' ); */ gen_rc(I_PUSH_EFFECTIVE_ADDRESS, explicit_ref_new(seg, offset+index), ""); } else { gen_s(I_PUSH_EFFECTIVE_ADDRESS, array_name); if (index != 0) gen_kic(I_ADD_IMMEDIATE, mu_word, index, "offset"); } } else { gen_address(array_node); gen_ks(I_DISCARD_ADDR, 1, array_type); if (index != 0) gen_ki(I_ADD_IMMEDIATE, mu_word, index); } } else { optimized = FALSE; } } } else { optimized = FALSE; } /* * Nothing worked, we are left with the worse case, solved by the * "subscript" instruction */ if (!optimized) { FORTUP( index_name=(Node), index_type_list, ft1); subscript = (Node) tup_fromb(subscripts); gen_value(subscript) ; ENDFORTUP(ft1); gen_address(array_node); gen(I_SUBSCRIPT); } if (is_array_type(comp_type)) { gen_s(I_PUSH_EFFECTIVE_ADDRESS, comp_type); } }