static void print_array_type_cmp(FILE *code_file, char *type, int index)
{
fprintf(code_file,
"\tif (field_array_%s_cmp(t1->match_types[%d], t2->match_types[%d],\n"
"\t\t\tt1->value%d, t2->value%d, %d) == FALSE)\n"
"\t\treturn FALSE;\n",
get_basic_type(type), index, index, index, index,
get_array_length(type));
}
void print_field_type(FILE *code_file, char *type)
{
char *upper;
if (strchr(type, '[')) {
upper = strtoupper(get_basic_type(type));
fprintf(code_file, "\t\tTYPE_%s | TYPE_ARRAY,\n", upper);
}
else {
upper = strtoupper(type);
fprintf(code_file, "\t\tTYPE_%s,\n", upper);
}
free(upper);
}
static char * align_type(char *field_type)
{
if (strchr(field_type, '['))
return get_basic_type(field_type);
if (strcmp(field_type, "char") == 0)
return "uint16_t";
if (strcmp(field_type, "uint8_t") == 0)
return "uint16_t";
if (strcmp(field_type, "byte") == 0)
return "uint16_t";
if (strcmp(field_type, "bool") == 0)
return "uint16_t";
if (strcmp(field_type, "rssi") == 0)
return "uint16_t";
if (strcmp(field_type, "lqi") == 0)
return "uint16_t";
return field_type;
}
static TYPE_DESC
get_intrinsic_return_type(intrinsic_entry *ep, expv args, expv kindV) {
BASIC_DATA_TYPE bType = TYPE_UNKNOWN;
TYPE_DESC bTypeDsc = NULL;
TYPE_DESC ret = NULL;
expv a = NULL;
if (INTR_RETURN_TYPE(ep) == INTR_TYPE_NONE) {
return NULL;
}
if (INTR_RETURN_TYPE_SAME_AS(ep) >= 0) {
/* return type is in args. */
a = expr_list_get_n(args, INTR_RETURN_TYPE_SAME_AS(ep));
if (!(isValidTypedExpv(a))) {
return NULL;
}
ret = EXPV_TYPE(a);
} else {
switch (INTR_RETURN_TYPE_SAME_AS(ep)) {
case -1 /* if not dynamic return type,
argument is scalar/array and
return type is scalar/array */ :
case -6 /* if not dynamic return type,
argument is scalar/array, return
return type is scalar */ : {
if (!(INTR_IS_RETURN_TYPE_DYNAMIC(ep)) &&
(INTR_RETURN_TYPE(ep) != INTR_TYPE_ALL_NUMERICS &&
INTR_RETURN_TYPE(ep) != INTR_TYPE_NUMERICS)) {
bType = intr_type_to_basic_type(INTR_RETURN_TYPE(ep));
if (bType == TYPE_UNKNOWN) {
fatal("invalid intrinsic return type (case -1/-6).");
/* not reached. */
return NULL;
} else {
if (kindV == NULL) {
ret = (bType != TYPE_CHAR) ? type_basic(bType) :
type_char(1);
} else {
/*
* Don't use BASIC_TYPE_DESC(bType) very
* here, since we need to set a kind to
* the TYPE_DESC.
*/
ret = type_basic(bType);
TYPE_KIND(ret) = kindV;
}
}
ret = intr_convert_to_dimension_ifneeded(
ep, args, ret);
} else {
expv shape = list0(LIST);
TYPE_DESC tp;
switch (INTR_OP(ep)) {
case INTR_ALL:
case INTR_ANY:
case INTR_MAXVAL:
case INTR_MINVAL:
case INTR_PRODUCT:
case INTR_SUM:
case INTR_COUNT:
{
/* intrinsic arguments */
expv array, dim;
array = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(array))) {
return NULL;
}
tp = EXPV_TYPE(array);
dim = expr_list_get_n(args, 1);
if (!(isValidTypedExpv(dim))) {
return NULL;
}
/* set basic type of array type */
switch (INTR_OP(ep)) {
case INTR_ALL:
case INTR_ANY:
bType = TYPE_LOGICAL;
break;
case INTR_COUNT:
bType = TYPE_INT;
break;
default:
bType = get_basic_type(tp);
break;
}
if (kindV == NULL) {
bTypeDsc = BASIC_TYPE_DESC(bType);
} else {
bTypeDsc = type_basic(bType);
TYPE_KIND(bTypeDsc) = kindV;
}
dim = expv_reduce(dim, FALSE);
if(EXPV_CODE(dim) == INT_CONSTANT) {
int nDim;
nDim = (int)EXPV_INT_VALUE(dim);
if(nDim > TYPE_N_DIM(tp) || nDim <= 0) {
error("value DIM of intrinsic %s "
"out of range.", INTR_NAME(ep));
return NULL;
}
generate_contracted_shape_expr(
tp, shape, TYPE_N_DIM(tp) - nDim);
} else {
generate_assumed_shape_expr(
shape, TYPE_N_DIM(tp) - 1);
}
}
break;
case INTR_SPREAD:
{
/* intrinsic arguments */
expv array, dim, ncopies;
array = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(array))) {
return NULL;
}
dim = expr_list_get_n(args, 1);
if (!(isValidTypedExpv(dim))) {
return NULL;
}
ncopies = expr_list_get_n(args, 2);
if (!(isValidTypedExpv(ncopies))) {
return NULL;
}
tp = EXPV_TYPE(array);
bType = get_basic_type(tp);
if (kindV == NULL) {
bTypeDsc = BASIC_TYPE_DESC(bType);
} else {
bTypeDsc = type_basic(bType);
TYPE_KIND(bTypeDsc) = kindV;
}
dim = expv_reduce(dim, FALSE);
if(EXPR_CODE(dim) == INT_CONSTANT) {
int nDim;
nDim = (int)EXPV_INT_VALUE(dim);
if(nDim > (TYPE_N_DIM(tp) + 1) || nDim <= 0) {
error("value DIM of intrinsic %s "
"out of range.", INTR_NAME(ep));
return NULL;
}
generate_expand_shape_expr(
tp, shape, ncopies, TYPE_N_DIM(tp) + 1 - nDim);
} else {
generate_assumed_shape_expr(
shape, TYPE_N_DIM(tp) - 1);
}
}
break;
case INTR_RESHAPE:
{
/* intrinsic arguments */
expv source, arg_shape;
source = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(source))) {
return NULL;
}
arg_shape = expr_list_get_n(args, 1);
if (!(isValidTypedExpv(arg_shape))) {
return NULL;
}
tp = EXPV_TYPE(source);
bType = get_basic_type(tp);
if (kindV == NULL) {
bTypeDsc = BASIC_TYPE_DESC(bType);
} else {
bTypeDsc = type_basic(bType);
TYPE_KIND(bTypeDsc) = kindV;
}
tp = EXPV_TYPE(arg_shape);
if (TYPE_N_DIM(tp) != 1) {
error("SHAPE argument of intrinsic "
"RESHAPE is not vector.");
return NULL;
}
/*
* We can't determine # of the elements in
* this array that represents dimension of the
* return type, which is identical to the
* reshaped array. In order to express this,
* we introduce a special TYPE_DESC, which is
* having a flag to specify that the type is
* generated by the reshape() intrinsic.
*/
/*
* dummy one dimensional assumed array.
*/
generate_assumed_shape_expr(shape, 2);
ret = compile_dimensions(bTypeDsc, shape);
fix_array_dimensions(ret);
TYPE_IS_RESHAPED(ret) = TRUE;
return ret;
}
break;
case INTR_MATMUL:
{
expv m1 = expr_list_get_n(args, 0);
expv m2 = expr_list_get_n(args, 1);
TYPE_DESC t1 = EXPV_TYPE(m1);
TYPE_DESC t2 = EXPV_TYPE(m2);
expv s1 = list0(LIST);
expv s2 = list0(LIST);
/*
* FIXME:
* Should we use
* get_binary_numeric_intrinsic_operation_type()
* instead of max_type()? I think so but
* not sure at this moment.
*/
bType = get_basic_type(max_type(t1, t2));
if (kindV == NULL) {
bTypeDsc = BASIC_TYPE_DESC(bType);
} else {
bTypeDsc = type_basic(bType);
TYPE_KIND(bTypeDsc) = kindV;
}
generate_shape_expr(t1, s1);
generate_shape_expr(t2, s2);
if (TYPE_N_DIM(t1) == 2 &&
TYPE_N_DIM(t2) == 2) {
/*
* (n, m) * (m, k) => (n, k).
*/
shape = list2(LIST,
EXPR_ARG1(s1), EXPR_ARG2(s2));
} else if (TYPE_N_DIM(t1) == 2 &&
TYPE_N_DIM(t2) == 1) {
/*
* (n, m) * (m) => (n).
*/
shape = list1(LIST, EXPR_ARG1(s1));
} else if (TYPE_N_DIM(t1) == 1 &&
TYPE_N_DIM(t2) == 2) {
/*
* (m) * (m, k) => (k).
*/
shape = list1(LIST, EXPR_ARG2(s2));
} else {
error("an invalid dimension combination for "
"matmul(), %d and %d.",
TYPE_N_DIM(t1), TYPE_N_DIM(t2));
return NULL;
}
ret = compile_dimensions(bTypeDsc, shape);
fix_array_dimensions(ret);
return ret;
}
break;
case INTR_DOT_PRODUCT:
{
expv m1 = expr_list_get_n(args, 0);
expv m2 = expr_list_get_n(args, 1);
TYPE_DESC t1 = EXPV_TYPE(m1);
TYPE_DESC t2 = EXPV_TYPE(m2);
if (TYPE_N_DIM(t1) == 1 &&
TYPE_N_DIM(t2) == 1) {
TYPE_DESC tp =
get_binary_numeric_intrinsic_operation_type(
t1, t2);
return array_element_type(tp);
} else {
error("argument(s) is not a one-dimensional "
"array.");
return NULL;
}
}
break;
case INTR_PACK:
{
if (INTR_N_ARGS(ep) == 3){
expv v = expr_list_get_n(args, 2);
return EXPV_TYPE(v);
}
else {
a = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(a))) {
return NULL;
}
bType = get_basic_type(EXPV_TYPE(a));
bTypeDsc = BASIC_TYPE_DESC(bType);
expr dims = list1(LIST, NULL);
ret = compile_dimensions(bTypeDsc, dims);
fix_array_dimensions(ret);
return ret;
}
}
break;
case INTR_UNPACK:
{
a = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(a))) {
return NULL;
}
bType = get_basic_type(EXPV_TYPE(a));
bTypeDsc = BASIC_TYPE_DESC(bType);
a = expr_list_get_n(args, 1);
if (!(isValidTypedExpv(a))) {
return NULL;
}
TYPE_DESC tp = EXPV_TYPE(a);
ret = copy_dimension(tp, bTypeDsc);
fix_array_dimensions(ret);
return ret;
}
break;
default:
{
/* not reached ! */
ret = BASIC_TYPE_DESC(TYPE_GNUMERIC_ALL);
}
}
ret = compile_dimensions(bTypeDsc, shape);
fix_array_dimensions(ret);
}
break;
}
case -2: {
/*
* Returns BASIC_TYPE of the first arg.
*/
a = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(a))) {
return NULL;
}
bType = get_basic_type(EXPV_TYPE(a));
if (kindV == NULL) {
ret = BASIC_TYPE_DESC(bType);
} else {
ret = type_basic(bType);
TYPE_KIND(ret) = kindV;
}
break;
}
case -3: {
/*
* Returns single dimension array of integer having
* elemnets that equals to the first arg's dimension.
*/
/*
* FIXME:
* No need to check kindV?? I believe we don't, though.
*/
bTypeDsc = BASIC_TYPE_DESC(TYPE_INT);
TYPE_DESC tp = NULL;
expr dims = NULL;
int nDims = 0;
a = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(a))) {
return NULL;
}
bTypeDsc = BASIC_TYPE_DESC(TYPE_INT);
tp = EXPV_TYPE(a);
nDims = TYPE_N_DIM(tp);
dims = list1(LIST, make_int_enode(nDims));
ret = compile_dimensions(bTypeDsc, dims);
fix_array_dimensions(ret);
break;
}
case -4:{
/*
* Returns transpose of the first arg (matrix).
*/
TYPE_DESC tp = NULL;
expr dims = list0(LIST);
a = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(a))) {
return NULL;
}
tp = EXPV_TYPE(a);
bType = get_basic_type(tp);
if (kindV == NULL) {
bTypeDsc = BASIC_TYPE_DESC(bType);
} else {
bTypeDsc = type_basic(bType);
TYPE_KIND(bTypeDsc) = kindV;
}
if (TYPE_N_DIM(tp) != 2) {
error("Dimension is not two.");
return NULL;
}
generate_reverse_dimension_expr(tp, dims);
ret = compile_dimensions(bTypeDsc, dims);
fix_array_dimensions(ret);
break;
}
case -5: {
/*
* -5 : BASIC_TYPE of return type is 'returnType' and
* kind of return type is same as first arg.
*/
int nDims = 0;
TYPE_DESC tp = NULL;
a = expr_list_get_n(args, 0);
if (!(isValidTypedExpv(a))) {
return NULL;
}
tp = EXPV_TYPE(a);
switch (INTR_OP(ep)) {
case INTR_AIMAG: case INTR_DIMAG: {
bType = get_basic_type(tp);
if (bType != TYPE_COMPLEX &&
bType != TYPE_DCOMPLEX) {
error("argument is not a complex type.");
return NULL;
}
bType = (bType == TYPE_COMPLEX) ?
TYPE_REAL : TYPE_DREAL;
break;
}
default: {
bType = intr_type_to_basic_type(INTR_RETURN_TYPE(ep));
break;
}
}
if (bType == TYPE_UNKNOWN) {
fatal("invalid intrinsic return type (case -5).");
/* not reached. */
return NULL;
}
bTypeDsc = type_basic(bType);
TYPE_KIND(bTypeDsc) = TYPE_KIND(tp);
if ((nDims = TYPE_N_DIM(tp)) > 0) {
ret = copy_dimension(tp, bTypeDsc);
fix_array_dimensions(ret);
} else {
ret = bTypeDsc;
}
break;
}
case -7: {
TYPE_DESC lhsTp = new_type_desc();
TYPE_BASIC_TYPE(lhsTp) = TYPE_LHS;
TYPE_ATTR_FLAGS(lhsTp) |= TYPE_ATTR_TARGET;
ret = lhsTp;
break;
}
case -8: {
bType = intr_type_to_basic_type(INTR_RETURN_TYPE(ep));
if (bType == TYPE_UNKNOWN) {
fatal("invalid intrinsic return type (case -8).");
return NULL;
} else {
ret = type_basic(bType);
}
TYPE_SET_EXTERNAL(ret);
break;
}
case -9: {
bType = intr_type_to_basic_type(INTR_RETURN_TYPE(ep));
ret = type_basic(bType);
break;
}
default: {
fatal("%s: Unknown return type specification.", __func__);
break;
}
}
}
return ret;
}
void OpenMPTransform::adf_task_postorder(PragmaCustomConstruct adf_construct)
{
PragmaCustomClause exit_condition_clause = adf_construct.get_clause("exit_condition");
PragmaCustomClause trigger_set = adf_construct.get_clause("trigger_set");
PragmaCustomClause group_name_clause = adf_construct.get_clause("name");
bool group_name_given = group_name_clause.is_defined();
std::string group_name = "default";
if (group_name_given)
{
group_name = group_name_clause.get_expression_list()[0].prettyprint();
}
Source main_code_layout;
AST_t inner_tree, exit_condition_placeholder, trigger_set_placeholder;
main_code_layout
<< "{"
<< "Transaction * __t = createtx(\"" << adf_construct.get_ast().get_file()
<< "\"," << adf_construct.get_ast().get_line() <<");"
<< "addTransactionToADFGroup(\"" << group_name << "\", __t);"
<< statement_placeholder(trigger_set_placeholder)
<< "while(1)"
<< "{"
<< "starttx(__t);"
<< "if (__t->status == 18 /*TS_ADF_FINISH*/) "
<< " break; "
<< statement_placeholder(exit_condition_placeholder)
<< "if((__t->nestingLevel > 0) || (0 == setjmp(__t->context)))"
<< "{"
<< statement_placeholder(inner_tree)
<< "if (committx(__t) == 0)"
<< "{"
<< "retrytx(__t);"
<< "break;"
<< "}"
<< "}"
<< "}"
<< "destroytx(__t);"
<< "}"
;
AST_t code_layout_tree = main_code_layout.parse_statement(
adf_construct.get_ast(),
adf_construct.get_scope_link());
// empty
ObjectList<Symbol> unmanaged_symbols;
ObjectList<Symbol> local_symbols;
// XXX - Currently using /dev/null as the filter and log files
std::fstream stm_log_file;
stm_log_file.open("/dev/null", std::ios_base::out | std::ios_base::trunc);
STMExpressionReplacement expression_replacement(unmanaged_symbols, local_symbols,
"/dev/null", "normal",
"/dev/null", "normal",
stm_log_file);
// STMize exit condition
if (exit_condition_clause.is_defined())
{
Expression exit_condition = exit_condition_clause.get_expression_list()[0];
// Duplicate but by means of parsing (this updates the semantic information)
Source src = exit_condition.prettyprint();
AST_t tree = src.parse_expression(inner_tree, adf_construct.get_scope_link());
Expression expr(tree, adf_construct.get_scope_link());
expression_replacement.replace_expression(expr);
Source exit_condition_src;
exit_condition_src
<< "if (" << expr.prettyprint() << ")"
<< "break;"
;
AST_t exit_condition_tree = exit_condition_src.parse_statement(exit_condition_placeholder,
adf_construct.get_scope_link());
exit_condition_placeholder.replace(exit_condition_tree);
}
// Main code
{
// Duplicate with new contextual info
Source src = adf_construct.get_statement().prettyprint();
AST_t task_tree = src.parse_statement(inner_tree,
adf_construct.get_scope_link());
ObjectList<AST_t> expressions = task_tree.depth_subtrees(Expression::predicate, AST_t::NON_RECURSIVE);
for (ObjectList<AST_t>::iterator it = expressions.begin();
it != expressions.end();
it++)
{
Expression expression(*it, scope_link);
expression_replacement.replace_expression(expression);
}
inner_tree.replace(task_tree);
}
// Trigger set registration due to 'exit_condition'
Source trigger_set_registration;
bool have_some_trigger_set = false;
if (exit_condition_clause.is_defined())
{
ObjectList<IdExpression> id_expression_list = exit_condition_clause.id_expressions();
for (ObjectList<IdExpression>::iterator it = id_expression_list.begin();
it != id_expression_list.end();
it++)
{
Symbol sym = it->get_symbol();
Type type = sym.get_type();
if (!type.is_array())
{
trigger_set_registration
<< "add_scalar_to_trigger_set(__t, "
<< "&" << it->prettyprint() << ", "
<< "sizeof(" << it->prettyprint() << ")"
<< ");"
;
}
else
{
std::cerr
<< it->get_ast().get_locus() << ": error: exit condition expression '"
<< it->prettyprint()
<< "' involves an array. This is not yet supported"
<< std::endl;
}
have_some_trigger_set = true;
}
// Trigger set registration due to 'trigger_set'
if (trigger_set.is_defined())
{
ObjectList<Expression> trigger_set_expr = trigger_set.get_expression_list();
for (ObjectList<Expression>::iterator it = trigger_set_expr.begin();
it != trigger_set_expr.end();
it++)
{
Expression &trigger_expr(*it);
// This should be improved to handle cases like 'a[2]'
if (trigger_expr.is_id_expression())
{
trigger_set_registration
<< "add_scalar_to_trigger_set(__t, "
<< "&" << trigger_expr.prettyprint() << ", "
<< "sizeof(" << trigger_expr.prettyprint() << ")"
<< ");"
;
}
else if (trigger_expr.is_array_section_range())
{
ObjectList<Expression> lower_bounds;
ObjectList<Expression> upper_bounds;
Expression basic_expr = compute_bounds_of_sectioned_expression(trigger_expr, lower_bounds, upper_bounds);
// FIXME - Do not be so restrictive, pointers to arrays are useful as well :)
if (!basic_expr.is_id_expression())
{
std::cerr << basic_expr.get_ast().get_locus()
<< ": error: invalid trigger set specification '" << trigger_expr.prettyprint()
<< "' since the basic expression '" << basic_expr.prettyprint() << "' is not an id-expression"
<< std::endl;
set_phase_status(PHASE_STATUS_ERROR);
return;
}
IdExpression id_expression = basic_expr.get_id_expression();
Symbol sym = id_expression.get_symbol();
if (!sym.is_valid())
{
std::cerr << id_expression.get_ast().get_locus()
<< ": error: unknown entity '" << id_expression.prettyprint() << "'" << std::endl;
set_phase_status(PHASE_STATUS_ERROR);
return;
}
Type type = sym.get_type();
ObjectList<AST_t> array_dimensions = compute_array_dimensions_of_type(type);
if (array_dimensions.size() != lower_bounds.size()
|| lower_bounds.size() != upper_bounds.size())
{
std::cerr << id_expression.get_ast().get_locus()
<< ": error: mismatch between array type and array section" << std::endl;
set_phase_status(PHASE_STATUS_ERROR);
return;
}
trigger_set_registration
<< "add_range_to_trigger_set(__t, " << basic_expr.prettyprint() << ","
<< array_dimensions.size() << ","
<< "sizeof(" << get_basic_type(type).get_declaration(sym.get_scope(), "") << ")"
;
// First add dimensions
for (ObjectList<AST_t>::iterator it = array_dimensions.begin();
it != array_dimensions.end();
it++)
{
trigger_set_registration << "," << it->prettyprint();
}
// Now lower and upper bounds
{
ObjectList<Expression>::iterator it_l = lower_bounds.begin();
ObjectList<Expression>::iterator it_u = upper_bounds.begin();
while (it_l != lower_bounds.end())
{
trigger_set_registration << "," << it_l->prettyprint();
trigger_set_registration << "," << it_u->prettyprint();
it_u++;
it_l++;
}
}
// Final parenthesis and semicolon
trigger_set_registration
<< ");"
;
}
have_some_trigger_set = true;
}
}
}
if (have_some_trigger_set)
{
AST_t trigger_registration_tree = trigger_set_registration.parse_statement(trigger_set_placeholder,
adf_construct.get_scope_link());
trigger_set_placeholder.replace(trigger_registration_tree);
}
// Replace it all
adf_construct.get_ast().replace(code_layout_tree);
}
