// NEEDS TO BE FINISHED WHEN PRIMITIVES ARE REDONE
static QualifiedType
returnInfoNumericUp(CallExpr* call) {
Type* t1 = call->get(1)->typeInfo();
Type* t2 = call->get(2)->typeInfo();
if (is_int_type(t1) && is_real_type(t2))
return QualifiedType(t2, QUAL_VAL);
if (is_real_type(t1) && is_int_type(t2))
return QualifiedType(t1, QUAL_VAL);
if (is_int_type(t1) && is_bool_type(t2))
return QualifiedType(t1, QUAL_VAL);
if (is_bool_type(t1) && is_int_type(t2))
return QualifiedType(t2, QUAL_VAL);
return QualifiedType(t1, QUAL_VAL);
}
// NEEDS TO BE FINISHED WHEN PRIMITIVES ARE REDONE
static Type*
returnInfoNumericUp(CallExpr* call) {
Type* t1 = call->get(1)->typeInfo();
Type* t2 = call->get(2)->typeInfo();
if (is_int_type(t1) && is_real_type(t2))
return t2;
if (is_real_type(t1) && is_int_type(t2))
return t1;
if (is_int_type(t1) && is_bool_type(t2))
return t1;
if (is_bool_type(t1) && is_int_type(t2))
return t2;
return t1;
}
IntentTag blankIntentForType(Type* t) {
if (isSyncType(t) ||
isAtomicType(t) ||
t->symbol->hasFlag(FLAG_ARRAY)) {
return INTENT_REF;
} else if (is_bool_type(t) ||
is_int_type(t) ||
is_uint_type(t) ||
is_real_type(t) ||
is_imag_type(t) ||
is_complex_type(t) ||
is_enum_type(t) ||
is_string_type(t) ||
t == dtStringC ||
t == dtStringCopy ||
isClass(t) ||
isRecord(t) ||
isUnion(t) ||
t == dtTaskID ||
t == dtFile ||
t == dtTaskList ||
t == dtNil ||
t == dtOpaque ||
t->symbol->hasFlag(FLAG_DOMAIN) ||
t->symbol->hasFlag(FLAG_DISTRIBUTION) ||
t->symbol->hasFlag(FLAG_EXTERN)) {
return constIntentForType(t);
}
INT_FATAL(t, "Unhandled type in blankIntentForType()");
return INTENT_BLANK;
}
static IntentTag constIntentForType(Type* t) {
if (isSyncType(t) ||
isRecordWrappedType(t) || // domain, array, or distribution
isRecord(t) || // may eventually want to decide based on size
is_string_type(t)) {
return INTENT_CONST_REF;
} else if (is_bool_type(t) ||
is_int_type(t) ||
is_uint_type(t) ||
is_real_type(t) ||
is_imag_type(t) ||
is_complex_type(t) ||
is_enum_type(t) ||
isClass(t) ||
isUnion(t) ||
isAtomicType(t) ||
t == dtOpaque ||
t == dtTaskID ||
t == dtFile ||
t == dtTaskList ||
t == dtNil ||
t == dtStringC ||
t == dtStringCopy ||
t->symbol->hasFlag(FLAG_EXTERN)) {
return INTENT_CONST_IN;
}
INT_FATAL(t, "Unhandled type in constIntentForType()");
return INTENT_CONST;
}
Type* type_check_logical(Expr const* e1, Expr const* e2)
{
if (is_bool_type(e1->type())) {
if (is_bool_type(e2->type()))
return get_bool_type();
else {
error("Expression not of bool type found in logical expression: ");
print(e2);
print("\n");
}
}
else {
error("Expression not of bool type found in logical expression: ");
print(e1);
print("\n");
}
return nullptr;
}
Type* type_check_not(Expr const* e1)
{
if (is_bool_type(e1->type()))
return get_bool_type();
error("Expression not of bool type found in not expression: ");
print(e1);
print("\n");
return nullptr;
}
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));
}
// Is this type OK to pass by value (e.g. it's reasonably-sized)?
static bool
passableByVal(Type* type) {
if (is_bool_type(type) ||
is_int_type(type) ||
is_uint_type(type) ||
is_real_type(type) ||
is_imag_type(type) ||
is_complex_type(type) ||
is_enum_type(type) ||
isClass(type) ||
type == dtTaskID ||
// For now, allow ranges as a special case, not records in general.
type->symbol->hasFlag(FLAG_RANGE) ||
0)
return true;
// TODO: allow reasonably-sized records. NB this-in-taskfns-in-ctors.chpl
// TODO: allow reasonably-sized tuples - heterogeneous and homogeneous.
return false;
}
IntentTag blankIntentForType(Type* t) {
IntentTag retval = INTENT_BLANK;
if (isSyncType(t) ||
isAtomicType(t) ||
t->symbol->hasFlag(FLAG_DEFAULT_INTENT_IS_REF) ||
t->symbol->hasFlag(FLAG_ARRAY)) {
retval = INTENT_REF;
} else if (is_bool_type(t) ||
is_int_type(t) ||
is_uint_type(t) ||
is_real_type(t) ||
is_imag_type(t) ||
is_complex_type(t) ||
is_enum_type(t) ||
t == dtStringC ||
t == dtStringCopy ||
t == dtCVoidPtr ||
t == dtCFnPtr ||
isClass(t) ||
isRecord(t) ||
isUnion(t) ||
t == dtTaskID ||
t == dtFile ||
t == dtNil ||
t == dtOpaque ||
t->symbol->hasFlag(FLAG_DOMAIN) ||
t->symbol->hasFlag(FLAG_DISTRIBUTION) ||
t->symbol->hasFlag(FLAG_EXTERN)) {
retval = constIntentForType(t);
} else {
INT_FATAL(t, "Unhandled type in blankIntentForType()");
}
return retval;
}
bool Type::is_bool() const
{
return is_bool_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;
}
CallExpr* ParamForLoop::foldForResolve()
{
SymExpr* idxExpr = indexExprGet();
SymExpr* lse = lowExprGet();
SymExpr* hse = highExprGet();
SymExpr* sse = strideExprGet();
if (!lse || !hse || !sse)
USR_FATAL(this, "param for loop must be defined over a bounded param range");
VarSymbol* lvar = toVarSymbol(lse->var);
VarSymbol* hvar = toVarSymbol(hse->var);
VarSymbol* svar = toVarSymbol(sse->var);
CallExpr* noop = new CallExpr(PRIM_NOOP);
if (!lvar || !hvar || !svar)
USR_FATAL(this, "param for loop must be defined over a bounded param range");
if (!lvar->immediate || !hvar->immediate || !svar->immediate)
USR_FATAL(this, "param for loop must be defined over a bounded param range");
Symbol* idxSym = idxExpr->var;
Symbol* continueSym = continueLabelGet();
Type* idxType = indexType();
IF1_int_type idxSize = (get_width(idxType) == 32) ? INT_SIZE_32 : INT_SIZE_64;
// Insert an "insertion marker" for loop unrolling
insertAfter(noop);
if (is_int_type(idxType))
{
int64_t low = lvar->immediate->to_int();
int64_t high = hvar->immediate->to_int();
int64_t stride = svar->immediate->to_int();
if (stride <= 0)
{
for (int64_t i = high; i >= low; i += stride)
{
SymbolMap map;
map.put(idxSym, new_IntSymbol(i, idxSize));
copyBodyHelper(noop, i, &map, this, continueSym);
}
}
else
{
for (int64_t i = low; i <= high; i += stride)
{
SymbolMap map;
map.put(idxSym, new_IntSymbol(i, idxSize));
copyBodyHelper(noop, i, &map, this, continueSym);
}
}
}
else
{
INT_ASSERT(is_uint_type(idxType) || is_bool_type(idxType));
uint64_t low = lvar->immediate->to_uint();
uint64_t high = hvar->immediate->to_uint();
int64_t stride = svar->immediate->to_int();
if (stride <= 0)
{
for (uint64_t i = high; i >= low; i += stride)
{
SymbolMap map;
map.put(idxSym, new_UIntSymbol(i, idxSize));
copyBodyHelper(noop, i, &map, this, continueSym);
}
}
else
{
for (uint64_t i = low; i <= high; i += stride)
{
SymbolMap map;
map.put(idxSym, new_UIntSymbol(i, idxSize));
copyBodyHelper(noop, i, &map, this, continueSym);
}
}
}
// Remove the "insertion marker"
noop->remove();
// Replace the paramLoop with the NO-OP
replace(noop);
return noop;
}
smt_astt
smt_convt::convert_byte_extract(const expr2tc &expr)
{
const byte_extract2t &data = to_byte_extract2t(expr);
assert(is_scalar_type(data.source_value) && "Byte extract now only works on "
"scalar variables");
if (!is_constant_int2t(data.source_offset)) {
expr2tc source = data.source_value;
unsigned int src_width = source->type->get_width();
if (!is_bv_type(source)) {
source = typecast2tc(get_uint_type(src_width), source);
}
// The approach: the argument is now a bitvector. Just shift it the
// appropriate amount, according to the source offset, and select out the
// bottom byte.
expr2tc offs = data.source_offset;
// Endian-ness: if we're in non-"native" endian-ness mode, then flip the
// offset distance. The rest of these calculations will still apply.
if (data.big_endian) {
auto data_size = type_byte_size(*source->type);
constant_int2tc data_size_expr(source->type, data_size - 1);
sub2tc sub(source->type, data_size_expr, offs);
offs = sub;
}
if (offs->type->get_width() != src_width)
// Z3 requires these two arguments to be the same width
offs = typecast2tc(source->type, data.source_offset);
lshr2tc shr(source->type, source, offs);
smt_astt ext = convert_ast(shr);
smt_astt res = mk_extract(ext, 7, 0, convert_sort(get_uint8_type()));
return res;
}
const constant_int2t &intref = to_constant_int2t(data.source_offset);
unsigned width;
width = data.source_value->type->get_width();
uint64_t upper, lower;
if (!data.big_endian) {
upper = ((intref.constant_value.to_long() + 1) * 8) - 1; //((i+1)*w)-1;
lower = intref.constant_value.to_long() * 8; //i*w;
} else {
uint64_t max = width - 1;
upper = max - (intref.constant_value.to_long() * 8); //max-(i*w);
lower = max - ((intref.constant_value.to_long() + 1) * 8 - 1); //max-((i+1)*w-1);
}
smt_astt source = convert_ast(data.source_value);;
if (int_encoding) {
std::cerr << "Refusing to byte extract in integer mode; re-run in "
"bitvector mode" << std::endl;
abort();
} else {
if (is_bv_type(data.source_value)) {
;
} else if (is_fixedbv_type(data.source_value)) {
;
} else if (is_bool_type(data.source_value)) {
// We cdan extract a byte from a bool -- zero or one.
typecast2tc cast(get_uint8_type(), data.source_value);
source = convert_ast(cast);
} else {
std::cerr << "Unrecognized type in operand to byte extract." << std::endl;
data.dump();
abort();
}
unsigned int sort_sz = data.source_value->type->get_width();
if (sort_sz <= upper) {
smt_sortt s = mk_sort(SMT_SORT_BV, 8, false);
return mk_smt_symbol("out_of_bounds_byte_extract", s);
} else {
return mk_extract(source, upper, lower, convert_sort(expr->type));
}
}
}
