static format pp_child(level const & l, bool unicode, unsigned indent) {
if (is_explicit(l) || is_param(l) || is_meta(l) || is_global(l)) {
return pp(l, unicode, indent);
} else {
return paren(pp(l, unicode, indent));
}
}
void
Printer::print_sym(Sym *s)
{
if (s == NULL) {
fputs("<<null>>", out);
} else {
SymTable *st = to<SymTable>(s->get_parent());
IrObject *par = to<IrObject>(st->get_parent());
if (is_kind_of<ProcDef>(par)) {
// We make the local symbol name unique by appending
// the procedure name as a prefix.
ProcDef *pd = to<ProcDef>(par);
fprintf(out, "%s.", get_name(pd).chars());
} else {
// We assume that we aren't given nested symbol tables, and
// thus st must be a global symbol table. The symbol
// therefore is global and doesn't need a prefix.
claim(is_global(st));
#ifndef CFE_NUMERIC_SYMS_FIXED
// Symbols for literals are coming out of CFE with purely numeric names.
const char *name = get_name(s).chars();
if (isdigit(name[0]))
fprintf(out, "__anon.");
#endif
}
fprintf(out, "%s", get_name(s).chars());
}
}
static jl_value_t *expr_type(jl_value_t *e, jl_codectx_t *ctx)
{
if (jl_is_expr(e))
return ((jl_expr_t*)e)->etype;
if (jl_is_symbolnode(e))
return jl_symbolnode_type(e);
if (jl_is_quotenode(e))
return (jl_value_t*)jl_typeof(jl_fieldref(e,0));
if (jl_is_lambda_info(e))
return (jl_value_t*)jl_function_type;
if (jl_is_getfieldnode(e)) {
jl_value_t *v = static_eval(e, ctx);
if (v == NULL)
return jl_getfieldnode_type(e);
e = v;
goto type_of_constant;
}
if (jl_is_topnode(e)) {
e = jl_fieldref(e,0);
jl_binding_t *b = jl_get_binding(topmod(ctx), (jl_sym_t*)e);
if (!b || !b->value)
return jl_top_type;
if (b->constp) {
e = b->value;
goto type_of_constant;
}
else {
return (jl_value_t*)jl_any_type;
}
}
if (jl_is_symbol(e)) {
if (jl_is_symbol(e)) {
if (is_global((jl_sym_t*)e, ctx)) {
// look for static parameter
for(size_t i=0; i < jl_tuple_len(ctx->sp); i+=2) {
assert(jl_is_symbol(jl_tupleref(ctx->sp, i)));
if (e == jl_tupleref(ctx->sp, i)) {
e = jl_tupleref(ctx->sp, i+1);
goto type_of_constant;
}
}
}
else {
return (jl_value_t*)jl_any_type;
}
}
jl_binding_t *b = jl_get_binding(ctx->module, (jl_sym_t*)e);
if (!b || !b->value)
return jl_top_type;
if (b->constp)
e = b->value;
else
return (jl_value_t*)jl_any_type;
}
type_of_constant:
if (jl_is_some_tag_type(e))
return (jl_value_t*)jl_wrap_Type(e);
return (jl_value_t*)jl_typeof(e);
}
static void print_child(std::ostream & out, level const & l) {
if (is_explicit(l) || is_param(l) || is_meta(l) || is_global(l)) {
print(out, l);
} else {
out << "(";
print(out, l);
out << ")";
}
}
optional<name> get_undef_global(level const & l, environment const & env) {
optional<name> r;
for_each(l, [&](level const & l) {
if (!has_global(l) || r)
return false;
if (is_global(l) && !env.is_universe(global_id(l)))
r = global_id(l);
return true;
});
return r;
}
void set_adrs(SymTbl *tp) /* 変数・引数の番地割当 */
{
int i, size = INTSIZE;
switch (tp->nmKind) {
case varId: /* 変数 */
if (tp->aryLen > 0) size *= tp->aryLen; /* 配列ならサイズ計算 */
if (is_global()) tp->adrs = mallocG(size); /* 大域変数 */
else tp->adrs = mallocL(size); /* 局所変数 */
break;
case fncId: /* 関数 */
tp->adrs = nextCodeCt(); /* 関数入口アドレス設定 */
for (i=1; i<=tp->args; i++) {
(tp+i)->adrs = mallocL(size); /* 引数のアドレス割当 */
}
}
}
/**
* \brief Create item.
*/
void rp::zeppelin::create_item()
{
base_item* const item = m_item->clone();
item->set_top_middle( get_mark_world_position("anchor") );
item->set_global( is_global() );
entity* e = dynamic_cast<entity*>( m_item );
if ( e != NULL )
item->set_z_position(get_z_position() + 1);
new_item( *item );
m_drop_item = handle_type(item);
bear::universe::forced_tracking mvt
( item->get_center_of_mass() - get_center_of_mass() );
mvt.set_reference_point_on_center( *this );
mvt.set_auto_remove(true);
item->set_forced_movement( mvt );
} // zeppelin::create_item()
void positional_source::update_positions(unsigned int time, const display &disp)
{
if(is_global()) {
return;
}
int distance_volume = DISTANCE_SILENT;
for(std::vector<map_location>::iterator i = locations_.begin(); i != locations_.end(); ++i) {
int v = calculate_volume(*i, disp);
if(v < distance_volume) {
distance_volume = v;
}
}
if(sound::is_sound_playing(id_)) {
sound::reposition_sound(id_, distance_volume);
} else {
update(time, disp);
}
}
void
M2c::process_sym_table(SymTable *st)
{
bool st_is_private = is_private(st);
Iter<SymbolTableObject*> iter = st->get_symbol_table_object_iterator();
for (/* iter */; iter.is_valid(); iter.next()) {
SymbolTableObject *the_sto = iter.current();
if (is_kind_of<VariableSymbol>(the_sto)) {
if (is_kind_of<ParameterSymbol>(the_sto))
continue; // don't shadow an arg!
VarSym *v = to<VariableSymbol>(the_sto);
if (!is_global(st)) {
printer->print_var_def(v, false);
}
else if (v->get_definition() != NULL) {
postponed_vars.push_back(v);
printer->print_var_def(v, true);
}
else {
claim(is_external(v));
fprintf(out, "extern ");
printer->print_sym_decl(v);
fprintf(out, ";\n");
}
} else if (is_kind_of<ProcedureSymbol>(the_sto)) {
if (st_is_private) fputs("static ", out);
printer->print_proc_decl(to<ProcedureSymbol>(the_sto));
} else if (is_kind_of<Type>(the_sto)) {
if (is_kind_of<EnumeratedType>(the_sto) ||
(is_kind_of<GroupType>(the_sto) &&
to<GroupType>(the_sto)->get_is_complete())) {
printer->print_type(to<Type>(the_sto));
fprintf(out, ";\n");
}
}
}
}
/* 0 = local, 1 = global */
int is_global(symbol_table *t, char *s) {
symbol *curr;
if (t == NULL) {
err("[code_gen] undeclared variable: %s\n", s);
return 0;
}
curr = t->s;
while (curr != NULL) {
if (strcmp(curr->value,s) == 0) {
if (t->parent == NULL) {
param_words = curr->size;
return 1;
} else {
return 0;
}
}
curr = curr->up;
}
return is_global(t->parent, s);
}
Register after_save() const {
assert(is_out() || is_global(), "register not visible after save");
return is_out() ? as_Register(encoding() + (ibase - obase)) : (const Register)this;
}
Register after_restore() const {
assert(is_in() || is_global(), "register not visible after restore");
return is_in() ? as_Register(encoding() + (obase - ibase)) : (const Register)this;
}
bool is_one_placeholder(level const & e) { return is_global(e) && global_id(e) == *g_placeholder_one_name; }
bool is_placeholder(level const & e) { return is_global(e) && is_placeholder(global_id(e)); }
/* 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);
}
}
}
name const & level_id(level const & l) {
lean_assert(is_param(l) || is_global(l) || is_meta(l));
return to_param_core(l).m_id;
}
bool concurrency_aware_abstractort::broadcast_required(
goto_programt::const_targett target,
const predicatet &predicate,
goto_programt::const_targett program_location)
{
// Get targets of assignment
std::set<symbol_exprt> targets = targets_of_lvalue(target->code.op0(), target);
std::set<symbol_exprt> locations = locations_of_expression(predicate, program_location, pointer_info, concrete_model.ns);
#ifdef DEBUG_BROADCAST
std::cout << "Targets of lvalue " << from_expr(concrete_model.ns, "", target->code.op0()) << ":" << std::endl;
for(std::set<symbol_exprt>::iterator it = targets.begin(); it != targets.end(); it++)
{
std::cout << " " << from_expr(concrete_model.ns, "", *it) << " -- ";
if(is_global(concrete_model.ns.lookup(it->get(ID_identifier))))
{
std::cout << "SHARED";
} else {
assert(is_procedure_local(concrete_model.ns.lookup(it->get(ID_identifier))));
std::cout << "LOCAL";
}
std::cout << std::endl;
}
std::cout << "Locations of predicate " << from_expr(concrete_model.ns, "", predicate) << ":" << std::endl;
for(std::set<symbol_exprt>::iterator it = locations.begin(); it != locations.end(); it++)
{
std::cout << " " << from_expr(concrete_model.ns, "", *it) << " -- ";
if(is_global(concrete_model.ns.lookup(it->get(ID_identifier))))
{
std::cout << "SHARED";
} else {
assert(is_procedure_local(concrete_model.ns.lookup(it->get(ID_identifier))));
std::cout << "LOCAL";
}
std::cout << std::endl;
}
#endif
std::set<symbol_exprt> intersection_of_targets_and_locations;
std::set_intersection(targets.begin(), targets.end(), locations.begin(), locations.end(),
std::insert_iterator<std::set<symbol_exprt> >(intersection_of_targets_and_locations,intersection_of_targets_and_locations.begin()) );
#ifdef DEBUG_BROADCAST
std::cout << "Intersection:" << std::endl;
for(std::set<symbol_exprt>::iterator it = intersection_of_targets_and_locations.begin(); it != intersection_of_targets_and_locations.end(); it++)
{
std::cout << " " << from_expr(concrete_model.ns, "", *it) << " -- ";
if(is_global(concrete_model.ns.lookup(it->get(ID_identifier))))
{
std::cout << "SHARED";
} else {
assert(is_procedure_local(concrete_model.ns.lookup(it->get(ID_identifier))));
std::cout << "LOCAL";
}
std::cout << std::endl;
}
#endif
bool require_broadcast = false;
for(std::set<symbol_exprt>::iterator it = intersection_of_targets_and_locations.begin(); it != intersection_of_targets_and_locations.end(); it++)
{
if(is_global(concrete_model.ns.lookup(it->get(ID_identifier))))
{
require_broadcast = true;
break;
}
}
if(require_broadcast)
{
#ifdef DEBUG_BROADCAST
std::cout << "BROADCAST REQUIRED: predicate and l-value intersect on shared location" << std::endl;
#endif
return true;
} else {
#ifdef DEBUG_BROADCAST
std::cout << "Predicate and l-value do not intersect on shared location, so no broadcast required" << std::endl;
#endif
}
#ifdef DEBUG_BROADCAST
std::cout << std::endl;
#endif
return false;
}
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);
}
}
bool is_param_core(level const & l) { return is_param(l) || is_global(l) || is_meta(l); }
