char fortran_is_pointer_to_array_type(type_t* t) { t = no_ref(t); return is_pointer_type(t) && fortran_is_array_type(pointer_type_get_pointee_type(t)); }
type_t* fortran_update_basic_type_with_type(type_t* type_info, type_t* basic_type) { if (is_error_type(basic_type)) return basic_type; // Many functions drop the reference type, so chek it the first if (is_lvalue_reference_type(type_info)) { return get_lvalue_reference_type( fortran_update_basic_type_with_type(reference_type_get_referenced_type(type_info), basic_type)); } else if (is_pointer_type(type_info)) { return get_pointer_type( fortran_update_basic_type_with_type(pointer_type_get_pointee_type(type_info), basic_type) ); } else if (fortran_is_array_type(type_info)) { return get_array_type_bounds( fortran_update_basic_type_with_type(array_type_get_element_type(type_info), basic_type), array_type_get_array_lower_bound(type_info), array_type_get_array_upper_bound(type_info), array_type_get_array_size_expr_context(type_info)); } else if (is_function_type(type_info)) { return fortran_replace_return_type_of_function_type(type_info, basic_type); } else { return basic_type; } }
char fortran_basic_type_is_implicit_none(type_t* t) { if (t == NULL) { return 0; } else if (is_implicit_none_type(t)) { return 1; } else if (is_array_type(t)) { return fortran_basic_type_is_implicit_none(array_type_get_element_type(t)); } else if (is_function_type(t)) { return fortran_basic_type_is_implicit_none(function_type_get_return_type(t)); } else if (is_lvalue_reference_type(t)) { return fortran_basic_type_is_implicit_none(reference_type_get_referenced_type(t)); } else if (is_pointer_type(t)) { return fortran_basic_type_is_implicit_none(pointer_type_get_pointee_type(t)); } else return 0; }
char fortran_is_scalar_type(type_t* t) { return (!is_pointer_type(t) && !is_pointer_to_member_type(t) && !is_array_type(t) && !is_lvalue_reference_type(t) && !is_rvalue_reference_type(t) && !is_function_type(t) && !is_vector_type(t)); }
char fortran_is_pointer_to_character_type(type_t* t) { t = no_ref(t); if (is_pointer_type(t)) { return fortran_is_character_type(pointer_type_get_pointee_type(t)); } return 0; }
/*! \brief Validates a return statement. * * \param s * the Stmt to validate. * \param data * a pointer to a validate_arg struct. * * If \a s is a return statement, this function validates the expression * returned to make sure its type is as specified in the function's prototype. */ static void validate_return (Stmt s, void *data) { validate_arg *arg = (validate_arg *)data; FuncDcl parent_func; Type return_type, expr_type; bool return_is_multi, return_is_pointer, expr_is_multi, expr_is_pointer; Expr ret; if (P_GetStmtType (s) == ST_RETURN && (ret = P_GetStmtRet (s))) { /* Find the return's parent FuncDcl. */ parent_func = PST_GetStmtParentFunc (arg->ip_table, s); return_type = PST_GetTypeType (arg->ip_table, P_GetFuncDclType (parent_func)); expr_type = PST_ExprType (arg->ip_table, ret); return_is_multi = is_multi_type (arg->ip_table, return_type); return_is_pointer = is_pointer_type (arg->ip_table, return_type); expr_is_multi = is_multi_type (arg->ip_table, expr_type); expr_is_pointer = is_pointer_type (arg->ip_table, expr_type); if (return_is_multi && !expr_is_multi) { /* Build (t.field = cur_arg, t) */ make_struct_pointer_multi (arg->ip_table, return_type, ret); arg->must_flatten = TRUE; } else if (return_is_multi && expr_is_pointer) { /* Build (arg.field). */ ret = make_dot (arg->ip_table, ret, expr_type, PST_GetFuncDclScope (arg->ip_table, parent_func)); arg->must_flatten = TRUE; } } return; }
char fortran_is_intrinsic_type(type_t* t) { t = no_ref(t); if (is_pointer_type(t)) t = pointer_type_get_pointee_type(t); return (is_integer_type(t) || is_floating_type(t) || is_complex_type(t) || is_bool_type(t) || fortran_is_character_type(t)); }
type_t* fortran_get_rank0_type_internal(type_t* t, char ignore_pointer) { t = no_ref(t); if (ignore_pointer && is_pointer_type(t)) t = pointer_type_get_pointee_type(t); while (fortran_is_array_type(t)) { t = array_type_get_element_type(t); } return t; }
XI_CAST_FUNC(ast_pointer, tt, fe) { ast_type* t_elt = tt->element_type; // Cast from another pointer type // ------------------------------ if(is_pointer_type(fe->type)) { ast_type* f_elt = fe->type->as<ast_pointer_type>()->element_type; if(_builder.sametype(t_elt, f_elt)) return fe; // same type else return bitcast_to(tt, fe); } // Cast from an integer type // ------------------------- if(is_integer_type(fe->type)) { auto ft = fe->type->as<ast_integer_type>(); uint32_t fw = ft->bitwidth; bool fu = ft->is_unsigned; if(!fu) { return this->visit(tt, this->visit(_builder.get_integer_type(fw, true), fe)); } else { return new ast_cast(tt, ast_op::utop, fe); } } // Cast from an array type // ----------------------- if(is_array_type(fe->type)) { //TODO: check that array expression is addressable auto ft = fe->type->as<ast_array_type>(); ast_type* f_elt = ft->element_type; return new ast_addressof(tt, _builder.make_index_expr(fe, _builder.make_zero(_builder.get_size_type()))); } __throw_unhandled_ast_type(__FILE__, __LINE__, fe->type, "CAST_FUNC(ast_pointer)"); }
bool Type::is_pointer() const { return (is_pointer_type(_type_info)); }
const char* fortran_print_type_str(type_t* t) { t = no_ref(t); if (is_error_type(t)) { return "<error-type>"; } if (is_hollerith_type(t)) { return "HOLLERITH"; } const char* result = ""; char is_pointer = 0; if (is_pointer_type(t)) { is_pointer = 1; t = pointer_type_get_pointee_type(t); } struct array_spec_tag { nodecl_t lower; nodecl_t upper; char is_undefined; } array_spec_list[MCXX_MAX_ARRAY_SPECIFIER] = { { nodecl_null(), nodecl_null(), 0 } }; int array_spec_idx; for (array_spec_idx = MCXX_MAX_ARRAY_SPECIFIER - 1; fortran_is_array_type(t); array_spec_idx--) { if (array_spec_idx < 0) { internal_error("too many array dimensions %d\n", MCXX_MAX_ARRAY_SPECIFIER); } if (!array_type_is_unknown_size(t)) { array_spec_list[array_spec_idx].lower = array_type_get_array_lower_bound(t); array_spec_list[array_spec_idx].upper = array_type_get_array_upper_bound(t); } else { array_spec_list[array_spec_idx].is_undefined = 1; } t = array_type_get_element_type(t); } char is_array = (array_spec_idx != (MCXX_MAX_ARRAY_SPECIFIER - 1)); if (is_bool_type(t) || is_integer_type(t) || is_floating_type(t) || is_double_type(t) || is_complex_type(t)) { const char* type_name = NULL; char c[128] = { 0 }; if (is_bool_type(t)) { type_name = "LOGICAL"; } else if (is_integer_type(t)) { type_name = "INTEGER"; } else if (is_floating_type(t)) { type_name = "REAL"; } else if (is_complex_type(t)) { type_name = "COMPLEX"; } else { internal_error("unreachable code", 0); } size_t size = type_get_size(t); if (is_floating_type(t)) { // KIND of floats is their size in byes (using the bits as in IEEE754) size = (floating_type_get_info(t)->bits) / 8; } else if (is_complex_type(t)) { // KIND of a complex is the KIND of its component type type_t* f = complex_type_get_base_type(t); size = (floating_type_get_info(f)->bits) / 8; } snprintf(c, 127, "%s(%zd)", type_name, size); c[127] = '\0'; result = uniquestr(c); } else if (is_class_type(t)) { scope_entry_t* entry = named_type_get_symbol(t); char c[128] = { 0 }; snprintf(c, 127, "TYPE(%s)", entry->symbol_name); c[127] = '\0'; result = uniquestr(c); } else if (fortran_is_character_type(t)) { nodecl_t length = array_type_get_array_size_expr(t); char c[128] = { 0 }; snprintf(c, 127, "CHARACTER(LEN=%s)", nodecl_is_null(length) ? "*" : codegen_to_str(length, nodecl_retrieve_context(length))); c[127] = '\0'; result = uniquestr(c); } else if (is_function_type(t)) { result = "PROCEDURE"; } else { const char* non_printable = NULL; uniquestr_sprintf(&non_printable, "non-fortran type '%s'", print_declarator(t)); return non_printable; } if (is_pointer) { result = strappend(result, ", POINTER"); } if (is_array) { array_spec_idx++; result = strappend(result, ", DIMENSION("); while (array_spec_idx <= (MCXX_MAX_ARRAY_SPECIFIER - 1)) { if (!array_spec_list[array_spec_idx].is_undefined) { result = strappend(result, codegen_to_str(array_spec_list[array_spec_idx].lower, nodecl_retrieve_context(array_spec_list[array_spec_idx].lower))); result = strappend(result, ":"); result = strappend(result, codegen_to_str(array_spec_list[array_spec_idx].upper, nodecl_retrieve_context(array_spec_list[array_spec_idx].upper))); } else { result = strappend(result, ":"); } if ((array_spec_idx + 1) <= (MCXX_MAX_ARRAY_SPECIFIER - 1)) { result = strappend(result, ", "); } array_spec_idx++; } result = strappend(result, ")"); } return result; }
void goto_symext::symex_step(reachability_treet & art) { assert(!cur_state->call_stack.empty()); const goto_programt::instructiont &instruction = *cur_state->source.pc; // depth exceeded? { if (depth_limit != 0 && cur_state->depth > depth_limit) cur_state->guard.add(false_expr); cur_state->depth++; } // actually do instruction switch (instruction.type) { case SKIP: case LOCATION: // really ignore cur_state->source.pc++; break; case END_FUNCTION: symex_end_of_function(); // Potentially skip to run another function ptr target; if not, // continue if (!run_next_function_ptr_target(false)) cur_state->source.pc++; break; case GOTO: { expr2tc tmp(instruction.guard); replace_nondet(tmp); dereference(tmp, false); replace_dynamic_allocation(tmp); symex_goto(tmp); } break; case ASSUME: if (!cur_state->guard.is_false()) { expr2tc tmp = instruction.guard; replace_nondet(tmp); dereference(tmp, false); replace_dynamic_allocation(tmp); cur_state->rename(tmp); do_simplify(tmp); if (!is_true(tmp)) { expr2tc tmp2 = tmp; expr2tc tmp3 = tmp2; cur_state->guard.guard_expr(tmp2); assume(tmp2); // we also add it to the state guard cur_state->guard.add(tmp3); } } cur_state->source.pc++; break; case ASSERT: if (!cur_state->guard.is_false()) { if (!no_assertions || !cur_state->source.pc->location.user_provided() || deadlock_check) { std::string msg = cur_state->source.pc->location.comment().as_string(); if (msg == "") msg = "assertion"; expr2tc tmp = instruction.guard; replace_nondet(tmp); dereference(tmp, false); replace_dynamic_allocation(tmp); claim(tmp, msg); } } cur_state->source.pc++; break; case RETURN: if (!cur_state->guard.is_false()) { expr2tc thecode = instruction.code, assign; if (make_return_assignment(assign, thecode)) { goto_symext::symex_assign(assign); } symex_return(); } cur_state->source.pc++; break; case ASSIGN: if (!cur_state->guard.is_false()) { code_assign2tc deref_code = instruction.code; // XXX jmorse -- this is not fully symbolic. if (thrown_obj_map.find(cur_state->source.pc) != thrown_obj_map.end()) { symbol2tc thrown_obj = thrown_obj_map[cur_state->source.pc]; if (is_pointer_type(deref_code.get()->target.get()->type) && !is_pointer_type(thrown_obj.get()->type)) { expr2tc new_thrown_obj(new address_of2t(thrown_obj.get()->type, thrown_obj)); deref_code.get()->source = new_thrown_obj; } else deref_code.get()->source = thrown_obj; thrown_obj_map.erase(cur_state->source.pc); } replace_nondet(deref_code); code_assign2t &assign = to_code_assign2t(deref_code); dereference(assign.target, true); dereference(assign.source, false); replace_dynamic_allocation(deref_code); symex_assign(deref_code); } cur_state->source.pc++; break; case FUNCTION_CALL: { expr2tc deref_code = instruction.code; replace_nondet(deref_code); code_function_call2t &call = to_code_function_call2t(deref_code); if (!is_nil_expr(call.ret)) { dereference(call.ret, true); } replace_dynamic_allocation(deref_code); for (std::vector<expr2tc>::iterator it = call.operands.begin(); it != call.operands.end(); it++) if (!is_nil_expr(*it)) dereference(*it, false); // Always run intrinsics, whether guard is false or not. This is due to the // unfortunate circumstance where a thread starts with false guard due to // decision taken in another thread in this trace. In that case the // terminate intrinsic _has_ to run, or we explode. if (is_symbol2t(call.function)) { const irep_idt &id = to_symbol2t(call.function).thename; if (has_prefix(id.as_string(), "c::__ESBMC")) { cur_state->source.pc++; std::string name = id.as_string().substr(3); run_intrinsic(call, art, name); return; } else if (has_prefix(id.as_string(), "cpp::__ESBMC")) { cur_state->source.pc++; std::string name = id.as_string().substr(5); name = name.substr(0, name.find("(")); run_intrinsic(call, art, name); return; } } // Don't run a function call if the guard is false. if (!cur_state->guard.is_false()) { symex_function_call(deref_code); } else { cur_state->source.pc++; } } break; case OTHER: if (!cur_state->guard.is_false()) { symex_other(); } cur_state->source.pc++; break; case CATCH: symex_catch(); break; case THROW: if (!cur_state->guard.is_false()) { if(symex_throw()) cur_state->source.pc++; } else { cur_state->source.pc++; } break; case THROW_DECL: symex_throw_decl(); cur_state->source.pc++; break; case THROW_DECL_END: // When we reach THROW_DECL_END, we must clear any throw_decl if(stack_catch.size()) { // Get to the correct try (always the last one) goto_symex_statet::exceptiont* except=&stack_catch.top(); except->has_throw_decl=false; except->throw_list_set.clear(); } cur_state->source.pc++; break; default: std::cerr << "GOTO instruction type " << instruction.type; std::cerr << " not handled in goto_symext::symex_step" << std::endl; abort(); } }
/*! \brief Validates a function call. * * \param e * the Expr to inspect. * \param data * a pointer to a validate_arg struct. * * Validates the arguments to a function call against the called * function's param types. If a parameter is of a multi type union, * the correct field is selected. If the call has too many or too few * arguments, this is corrected */ static void validate_call (Expr e, void *data) { validate_arg *arg = (validate_arg *)data; Expr callee_expr, cur_arg, next_arg; FuncDcl func; Key func_scope_key; Type func_type, param_type, cur_arg_type; Param param; if (e && P_GetExprOpcode (e) == OP_call) { /* Get the callee function's type. */ callee_expr = P_GetExprOperands (e); func_type = PST_ExprType (arg->ip_table, P_GetExprOperands (e)); /* We can only validate direct calls of defined functions. */ if (P_IsIndirectFunctionCall (e)) { func_scope_key = PST_GetScopeFromEntryKey (arg->ip_table, func_type); /* If we have an indirect call with unspecified parameters, we * can't do anything more. */ if (PST_GetTypeParam (arg->ip_table, func_type) == NULL) return; } else if (P_IsDirectFunctionCall (e)) { func = PST_GetFuncDclEntry (arg->ip_table, P_GetExprVarKey (callee_expr)); if (!P_TstFuncDclQualifier (func, VQ_DEFINED) || \ P_TstFuncDclQualifier (func, VQ_APP_ELLIPSIS)) goto done; func_scope_key = \ PST_GetScopeFromEntryKey (arg->ip_table, P_GetExprVarKey (callee_expr)); } if (!PST_IsFunctionType (arg->ip_table, func_type)) P_punt ("validate.c:validate_call:%d e does not result in a\n" "function type (%d, %d)", __LINE__, func_type.file, func_type.sym); /* Loop through the call arguments and the function parameters to * determine if we need to do anything. */ cur_arg = P_GetExprSibling (callee_expr); param = PST_GetTypeParam (arg->ip_table, func_type); while (cur_arg && param) { bool arg_is_multi, arg_is_pointer, param_is_multi, param_is_pointer; next_arg = P_GetExprNext (cur_arg); param_type = P_GetParamKey (param); cur_arg_type = PST_ExprType (arg->ip_table, cur_arg); /* If the current param is a vararg, the call does not require * repair. */ if (PST_IsVarargType (arg->ip_table, param_type)) goto done; arg_is_multi = is_multi_type (arg->ip_table, cur_arg_type); arg_is_pointer = is_pointer_type (arg->ip_table, cur_arg_type); param_is_multi = is_multi_type (arg->ip_table, param_type); param_is_pointer = is_pointer_type (arg->ip_table, param_type); if (param_is_pointer && arg_is_pointer) { /* Build (t.field1 = cur_arg, t).field2 */ TypeDcl td = PST_GetTypeTypeDcl (arg->ip_table, param_type); Type multi_type = Plink_GetTypeDclMultiType (td); cur_arg = make_struct_pointer_multi (arg->ip_table, multi_type, cur_arg); cur_arg = make_dot (arg->ip_table, cur_arg, multi_type, func_scope_key); arg->must_flatten = TRUE; } else if (param_is_pointer && arg_is_multi) { /* Build (arg.field). */ cur_arg = make_dot (arg->ip_table, cur_arg, cur_arg_type, func_scope_key); arg->must_flatten = TRUE; } else if (param_is_multi && !arg_is_multi) { /* Build (t.field = cur_arg, t) */ make_struct_pointer_multi (arg->ip_table, param_type, cur_arg); arg->must_flatten = TRUE; } else { /* If the argument type doesn't match the parameter type, cast * it. */ if (PST_IsPointerType (arg->ip_table, param_type) && \ PST_IsIntegralType (arg->ip_table, cur_arg_type)) { Key scope_key = PST_GetExprScope (arg->ip_table, cur_arg); Expr cast = PST_ScopeNewExprWithOpcode (arg->ip_table, scope_key, OP_cast); P_ExprSwap (&cur_arg, &cast); P_AppendExprOperands (cast, cur_arg); PST_SetExprType (arg->ip_table, cast, param_type); } } cur_arg = next_arg; param = P_GetParamNext (param); } if (cur_arg || param) { if (cur_arg) { /* If there are too many arguments, we need to remove extra ones * from the end. */ e->pragma = \ P_AppendPragmaNext (e->pragma, P_NewPragmaWithSpecExpr ("PLV_REMOVE", NULL)); remove_args (arg->ip_table, e, cur_arg); arg->must_flatten = TRUE; } else if (param) { /* If there are too few arguments, we need to add extras to pad * the call. */ e->pragma = \ P_AppendPragmaNext (e->pragma, P_NewPragmaWithSpecExpr ("PLV_ADD", NULL)); add_args (arg->ip_table, e, param); } } } done: return; }