From 648831061af1448de4cafbc84261aab79a3e365d Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Tue, 17 Nov 2020 13:18:22 +0100 Subject: [PATCH 01/16] getting started :-) --- src/libsac2c/codegen/compile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index 0c27aed91..fd6c63d8a 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -314,7 +314,7 @@ With3Folds (node *ids, node *ops) ******************************************************************************/ static const char * -GetBasetypeStr (types *type) +GetBasetypeStr (ntype *type) { simpletype basetype; const char *str; -- GitLab From 9eeedd67ce236f69af7c1087106746a14681b004 Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Wed, 18 Nov 2020 15:51:06 +0100 Subject: [PATCH 02/16] added full support for nested types in the typechecker actually not much was missing here. However, the treatment of T_hidden received a massive conceptual overhaul. This was triggered by the observation that SACarg needs to be treated like a nested data structure..... When ironing that out in compile.c we can equally well make sure we add proper support for nesting throughout.... --- src/libsac2c/codegen/compile.c | 2 +- src/libsac2c/scanparse/parser.c | 8 +++++ src/libsac2c/serialize/deserialize.c | 3 +- src/libsac2c/typecheck/ct_prf.c | 24 +++++++++++--- src/libsac2c/typecheck/new_types.c | 27 +++++++++------- src/libsac2c/typecheck/resolvesymboltypes.c | 6 ++-- src/libsac2c/typecheck/type_utils.c | 22 ++++++------- src/libsac2c/typecheck/user_types.c | 36 +++++++++++++++------ src/libsac2c/typecheck/user_types.h | 2 +- src/libsac2c/xml/ast.xml | 1 + 10 files changed, 87 insertions(+), 44 deletions(-) diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index fd6c63d8a..0c27aed91 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -314,7 +314,7 @@ With3Folds (node *ids, node *ops) ******************************************************************************/ static const char * -GetBasetypeStr (ntype *type) +GetBasetypeStr (types *type) { simpletype basetype; const char *str; diff --git a/src/libsac2c/scanparse/parser.c b/src/libsac2c/scanparse/parser.c index 2833b6d89..3ec965d78 100644 --- a/src/libsac2c/scanparse/parser.c +++ b/src/libsac2c/scanparse/parser.c @@ -5346,6 +5346,7 @@ handle_typedef (struct parser *parser) tok = parser_get_token (parser); if (token_is_keyword (tok, EXTERN)) { extern_p = true; + nested = true; if (parser_expect_tval (parser, TYPEDEF)) /* eat TYPEDEF and save its location. */ loc = token_location (parser_get_token (parser)); @@ -5397,6 +5398,9 @@ handle_typedef (struct parser *parser) if (!extern_p && !builtin_p && is_type (parser)) { type = handle_type (parser); + if (!TUshapeKnown (type)) { + nested = true; + } if (type == error_type_node) goto skip_error; } @@ -5454,6 +5458,10 @@ handle_typedef (struct parser *parser) tt = TYmakeAKS (TYmakeHiddenSimpleType (UT_NOT_DEFINED), SHmakeShape (0)); ret = TBmakeTypedef (name, NULL, component_name, tt, NULL, NULL); + if (nested == true) { + TYPEDEF_ISNESTED (ret) = true; + } + TYPEDEF_ISEXTERNAL (ret) = true; TYPEDEF_PRAGMA (ret) = pragmas; } else { ret = TBmakeTypedef (name, NULL, component_name, type, NULL, NULL); diff --git a/src/libsac2c/serialize/deserialize.c b/src/libsac2c/serialize/deserialize.c index 1f3650652..1e966df0f 100644 --- a/src/libsac2c/serialize/deserialize.c +++ b/src/libsac2c/serialize/deserialize.c @@ -238,7 +238,8 @@ InsertIntoState (node *item, module_t *module) udt = UTaddUserType (STRcpy (TYPEDEF_NAME (item)), NSdupNamespace (TYPEDEF_NS (item)), TYcopyType (TYPEDEF_NTYPE (item)), NULL, - NODE_LINE (item), item, TYPEDEF_ISNESTED (item)); + NODE_LINE (item), item, TYPEDEF_ISNESTED (item), + TYPEDEF_ISEXTERNAL (item)); } /* diff --git a/src/libsac2c/typecheck/ct_prf.c b/src/libsac2c/typecheck/ct_prf.c index 2bfcd1370..d60eb1d07 100644 --- a/src/libsac2c/typecheck/ct_prf.c +++ b/src/libsac2c/typecheck/ct_prf.c @@ -11,6 +11,8 @@ #include "constants.h" #include "ctinfo.h" #include "globals.h" +#include "str.h" +#include "memory.h" static constant * ApplyCF (te_info *info, ntype *args) @@ -159,13 +161,16 @@ NTCCTprf_cast (te_info *info, ntype *elems) ntype *cast_t, *cast_bt, *expr_t, *expr_bt; ntype *res, *res_bt; shape *shp, *d_shp, *s_shp; + char *cast_str, *expr_str; char *err_msg; DBUG_ENTER (); cast_t = TYgetProductMember (elems, 0); + cast_str = TYtype2String (cast_t, FALSE, 0); cast_bt = TYeliminateUser (cast_t); expr_t = TYgetProductMember (elems, 1); + expr_str = TYtype2String (expr_t, FALSE, 0); expr_bt = TYeliminateUser (expr_t); /* @@ -173,7 +178,10 @@ NTCCTprf_cast (te_info *info, ntype *elems) * instantly bail out, as we do not support ant kind of basetype * polymorphism and thus the program is incorrect no matter what. */ - TEassureSameScalarType ("cast-type", cast_bt, "expr-type", expr_bt); + TEassureSameScalarType ( STRcatn (3, "the cast-type \"", + cast_str, "\""), cast_bt, + STRcatn (3, "the expr-type \"", + expr_str, "\""), expr_bt); err_msg = TEfetchErrors (); if (err_msg != NULL) { CTIerror ("%s", err_msg); @@ -187,10 +195,16 @@ NTCCTprf_cast (te_info *info, ntype *elems) * * The actual error processing can be found further below... */ - res_bt = TEassureSameShape ("cast-type", cast_bt, "expr-type", expr_bt); + res_bt = TEassureSameShape ( STRcatn (3, "the cast-type \"", + cast_str, "\""), cast_bt, + STRcatn (3, "the expr-type \"", + expr_str, "\""), expr_bt); cast_bt = TYfreeType (cast_bt); expr_bt = TYfreeType (expr_bt); + cast_str = MEMfree (cast_str); + expr_str = MEMfree (expr_str); + /* * Unfortunately, this TEassureSameShape in certain situations does not detect * incompatibilities. The problem arises from the application of @@ -221,7 +235,7 @@ NTCCTprf_cast (te_info *info, ntype *elems) if (!SHcompareShapes (d_shp, s_shp)) { CTIerrorLine (global.linenum, "Cast type %s does not match expression type %s " - "as \"%s\" is defined as %s", + "as \"%s\" relates to %s", TYtype2String (cast_t, FALSE, 0), TYtype2String (expr_t, FALSE, 0), UTgetName (TYgetUserType (TYgetScalar (cast_t))), @@ -237,7 +251,7 @@ NTCCTprf_cast (te_info *info, ntype *elems) if (!SHcompareShapes (d_shp, s_shp)) { CTIerrorLine (global.linenum, "Cast type %s does not match expression type %s " - "as \"%s\" is defined as %s", + "as \"%s\" relates to %s", TYtype2String (cast_t, FALSE, 0), TYtype2String (expr_t, FALSE, 0), UTgetName (TYgetUserType (TYgetScalar (expr_t))), @@ -261,7 +275,7 @@ NTCCTprf_cast (te_info *info, ntype *elems) d_shp)) { CTIerrorLine (global.linenum, "Cast type %s does not match expression type %s " - "as \"%s\" is defined as %s whereas \"%s\" is defined as " + "as \"%s\" relates to %s whereas \"%s\" relates to " "%s", TYtype2String (cast_t, FALSE, 0), TYtype2String (expr_t, FALSE, 0), diff --git a/src/libsac2c/typecheck/new_types.c b/src/libsac2c/typecheck/new_types.c index d8e1027e3..3edcd50af 100644 --- a/src/libsac2c/typecheck/new_types.c +++ b/src/libsac2c/typecheck/new_types.c @@ -4297,16 +4297,6 @@ TYeliminateUser (ntype *t1) */ udt = UTgetUnAliasedType (USER_TYPE (TYgetScalar (t1))); res = TYnestTypes (t1, UTgetBaseType (udt)); - if (TUisHidden (res)) { - /** - * Here, we need to make sure that we keep - * the usertype for hidden types! - * Note here, that we deliberately ignore the - * modified return value as we want to utilize the - * side effect! - */ - TYsetHiddenUserType (TYgetScalar (res), udt); - } } else { res = TYcopyType (t1); } @@ -4775,6 +4765,7 @@ ScalarType2String (ntype *type) { static str_buf *buf = NULL; char *res; + usertype udt; DBUG_ENTER (); @@ -4784,9 +4775,21 @@ ScalarType2String (ntype *type) switch (NTYPE_CON (type)) { case TC_simple: - buf = SBUFprintf (buf, "%s", global.mdb_type[SIMPLE_TYPE (type)]); if (SIMPLE_TYPE (type) == T_hidden) { - buf = SBUFprintf (buf, "(%d)", SIMPLE_HIDDEN_UDT (type)); + udt = SIMPLE_HIDDEN_UDT (type); + if (udt == UT_NOT_DEFINED) { + buf = SBUFprintf (buf, "hidden"); + } else { + if (UTgetNamespace (udt) == NULL) { + buf = SBUFprintf (buf, "enclosed(%s)", UTgetName (udt)); + } else { + buf = SBUFprintf (buf, "enclosed(%s::%s)", + NSgetName (UTgetNamespace (udt)), + UTgetName (udt)); + } + } + } else { + buf = SBUFprintf (buf, "%s", global.mdb_type[SIMPLE_TYPE (type)]); } break; case TC_symbol: diff --git a/src/libsac2c/typecheck/resolvesymboltypes.c b/src/libsac2c/typecheck/resolvesymboltypes.c index e21560fcd..efdccfab2 100644 --- a/src/libsac2c/typecheck/resolvesymboltypes.c +++ b/src/libsac2c/typecheck/resolvesymboltypes.c @@ -200,7 +200,9 @@ RSTtypedef (node *arg_node, info *arg_info) UTaddUserType (STRcpy (TYPEDEF_NAME (arg_node)), NSdupNamespace (TYPEDEF_NS (arg_node)), TYcopyType (TYPEDEF_NTYPE (arg_node)), NULL, - NODE_LINE (arg_node), arg_node, TYPEDEF_ISNESTED (arg_node)); + NODE_LINE (arg_node), arg_node, + TYPEDEF_ISNESTED (arg_node), + TYPEDEF_ISEXTERNAL (arg_node)); } DBUG_EXECUTE_TAG ("UDT", tmp_str = MEMfree (tmp_str)); @@ -370,7 +372,7 @@ RSTdoResolveSymbolTypes (node *syntax_tree) TRAVpop (); - DBUG_EXECUTE_TAG ("UDT_PRINT", UTprintRepository (stderr)); + DBUG_EXECUTE (UTprintRepository (stderr)); DBUG_RETURN (syntax_tree); } diff --git a/src/libsac2c/typecheck/type_utils.c b/src/libsac2c/typecheck/type_utils.c index 77767a4e4..35d9f5964 100644 --- a/src/libsac2c/typecheck/type_utils.c +++ b/src/libsac2c/typecheck/type_utils.c @@ -1500,27 +1500,25 @@ TUcheckUdtAndSetBaseType (usertype udt, int *visited) base = UTgetBaseType (udt); if (base == NULL) { base = UTgetTypedef (udt); - if (!TYisAKS (base)) { + if (UTisNested (udt)) { /* - * Try to handle non AKS UDT's + * Since this is a nested type, the basetype needs to + * be a scalar hidden type of itself! */ - if (TYisAKD (base) || UTisNested (udt)) { - if (visited != NULL) { - visited = MEMfree (visited); - } - } else { - CTIerrorLine (global.linenum, - "Typedef of %s::%s is illegal; should be either" - " scalar type or array type of fixed shape", - NSgetName (UTgetNamespace (udt)), UTgetName (udt)); + base_elem = TYmakeHiddenSimpleType (udt); + base = TYmakeAKS (base_elem, SHmakeShape (0)); + if (visited != NULL) { + visited = MEMfree (visited); } } else { /* * Here, we know that we are either dealing with * AKS{ User{}}, AKS{ Symb{}}, or AKS{ Simple{}}. */ + DBUG_ASSERT ((TYisAKS (base)), "non AKS type in non-nested" + "typedef for \"%s\" found", UTgetName (udt)); + base_elem = TYgetScalar (base); if (TYisAKSUdt (base) || TYisAKSSymb (base)) { - base_elem = TYgetScalar (base); inner_udt = TYisAKSUdt (base) ? TYgetUserType (base_elem) : UTfindUserType (TYgetName (base_elem), diff --git a/src/libsac2c/typecheck/user_types.c b/src/libsac2c/typecheck/user_types.c index 49da9b69c..89bf9767e 100644 --- a/src/libsac2c/typecheck/user_types.c +++ b/src/libsac2c/typecheck/user_types.c @@ -132,7 +132,7 @@ InsertIntoRepository (udt_entry *entry) usertype UTaddUserType (char *name, namespace_t *ns, ntype *type, ntype *base, size_t lineno, - node *tdef, bool nested) + node *tdef, bool nested, bool external) { udt_entry *entry; usertype result; @@ -154,6 +154,10 @@ UTaddUserType (char *name, namespace_t *ns, ntype *type, ntype *base, size_t lin result = InsertIntoRepository (entry); + if (external) { + TYsetHiddenUserType (TYgetScalar (type), result); // self ref for external types! + } + DBUG_RETURN (result); } @@ -493,23 +497,35 @@ UTisNested (usertype udt) * ******************************************************************************/ -#define UTPRINT_FORMAT "| %-10.10s | %-10.10s | %-20.20s | %-20.20s |" +// module name def-type base-type +#define UTPRINT_FORMAT "| %-10.10s | %-10.10s | %-25.25s | %-35.35s |" void UTprintRepository (FILE *outfile) { - int i; + int i, alias; DBUG_ENTER (); - fprintf (outfile, "\n %4.4s " UTPRINT_FORMAT " %6s | %9s | %7s\n", "udt:", "module:", - "name:", "defining type:", "base type:", "line:", "def node:", "alias:"); + fprintf (outfile, "\n %4.4s " UTPRINT_FORMAT " %10s | %-7s | %-7s | %-14s \n", "udt:", "module:", + "name:", "defining type:", "base type:", "alias udt:", "nested:", "line", "def node:"); for (i = 0; i < udt_no; i++) { - fprintf (outfile, " %4d " UTPRINT_FORMAT " %6zu | %8p | %7d\n", i, - NSgetName (UTgetNamespace (i)), UTgetName (i), - TYtype2String (UTgetTypedef (i), TRUE, 0), - TYtype2String (UTgetBaseType (i), TRUE, 0), UTgetLine (i), - (void *)UTgetTdef (i), UTgetAlias (i)); + alias = UTgetAlias (i); + if (alias == UT_NOT_DEFINED) { + fprintf (outfile, " %4d " UTPRINT_FORMAT " %-10s | %-7s | %-7zu | %-14p \n", i, + NSgetName (UTgetNamespace (i)), UTgetName (i), + TYtype2String (UTgetTypedef (i), TRUE, 0), + TYtype2String (UTgetBaseType (i), TRUE, 0), + "---", (UTisNested (i)?"yes":""), UTgetLine (i), + (void *)UTgetTdef (i)); + } else { + fprintf (outfile, " %4d " UTPRINT_FORMAT " %-10d | %-7s | %-7zu | %-14p \n", i, + NSgetName (UTgetNamespace (i)), UTgetName (i), + TYtype2String (UTgetTypedef (i), TRUE, 0), + TYtype2String (UTgetBaseType (i), TRUE, 0), + UTgetAlias (i), (UTisNested (i)?"yes":""), UTgetLine (i), + (void *)UTgetTdef (i)); + } } DBUG_RETURN (); diff --git a/src/libsac2c/typecheck/user_types.h b/src/libsac2c/typecheck/user_types.h index 6040a1fb7..734ef52b6 100644 --- a/src/libsac2c/typecheck/user_types.h +++ b/src/libsac2c/typecheck/user_types.h @@ -25,7 +25,7 @@ #define UT_NOT_DEFINED -1 extern usertype UTaddUserType (char *name, namespace_t *ns, ntype *type, ntype *base, - size_t lineno, node *tdef, bool nested); + size_t lineno, node *tdef, bool nested, bool external); extern usertype UTaddAlias (char *name, namespace_t *ns, usertype alias, size_t lineno, node *tdef); extern usertype UTfindUserType (const char *name, const namespace_t *ns); diff --git a/src/libsac2c/xml/ast.xml b/src/libsac2c/xml/ast.xml index ac5388f85..db25445fa 100644 --- a/src/libsac2c/xml/ast.xml +++ b/src/libsac2c/xml/ast.xml @@ -4982,6 +4982,7 @@ N_tfarg : + -- GitLab From a06b114ae79500745a4cf0a94e507436bda28699 Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Thu, 19 Nov 2020 11:54:28 +0100 Subject: [PATCH 03/16] properly separated nested and external! This is important since the additions of Rouland do not allow for eexternals to be nested without screwing the code generation up...... We can tackle this later! --- src/libsac2c/scanparse/parser.c | 1 - src/libsac2c/typecheck/user_types.c | 34 ++++++++++++++++++++++++----- src/libsac2c/typecheck/user_types.h | 1 + 3 files changed, 29 insertions(+), 7 deletions(-) diff --git a/src/libsac2c/scanparse/parser.c b/src/libsac2c/scanparse/parser.c index 3ec965d78..d00b459a4 100644 --- a/src/libsac2c/scanparse/parser.c +++ b/src/libsac2c/scanparse/parser.c @@ -5346,7 +5346,6 @@ handle_typedef (struct parser *parser) tok = parser_get_token (parser); if (token_is_keyword (tok, EXTERN)) { extern_p = true; - nested = true; if (parser_expect_tval (parser, TYPEDEF)) /* eat TYPEDEF and save its location. */ loc = token_location (parser_get_token (parser)); diff --git a/src/libsac2c/typecheck/user_types.c b/src/libsac2c/typecheck/user_types.c index 89bf9767e..afe1a8736 100644 --- a/src/libsac2c/typecheck/user_types.c +++ b/src/libsac2c/typecheck/user_types.c @@ -41,6 +41,7 @@ typedef struct UDT_ENTRY { usertype alias; size_t line; node *tdef; + bool external; bool nested; } udt_entry; @@ -57,6 +58,7 @@ typedef struct UDT_ENTRY { #define ENTRY_LINE(e) ((e)->line) #define ENTRY_TDEF(e) ((e)->tdef) #define ENTRY_NESTED(e) ((e)->nested) +#define ENTRY_EXTERNAL(e) ((e)->external) /* * We use a global datastructure "udt_rep", in order to keep all the information @@ -151,6 +153,7 @@ UTaddUserType (char *name, namespace_t *ns, ntype *type, ntype *base, size_t lin ENTRY_TDEF (entry) = tdef; ENTRY_ALIAS (entry) = UT_NOT_DEFINED; ENTRY_NESTED (entry) = nested; + ENTRY_EXTERNAL (entry) = external; result = InsertIntoRepository (entry); @@ -487,6 +490,23 @@ UTisNested (usertype udt) DBUG_RETURN (ENTRY_NESTED (udt_rep[udt])); } +/** + * @fn bool UTisExternal( usertype udt) + * + * @brief checks whether the passed udt is an external type + * + * @param udt + * + * @return + ******************************************************************************/ +bool +UTisExternal (usertype udt) +{ + DBUG_ENTER (); + + DBUG_RETURN (ENTRY_EXTERNAL (udt_rep[udt])); +} + /****************************************************************************** * * function: @@ -507,23 +527,25 @@ UTprintRepository (FILE *outfile) DBUG_ENTER (); - fprintf (outfile, "\n %4.4s " UTPRINT_FORMAT " %10s | %-7s | %-7s | %-14s \n", "udt:", "module:", - "name:", "defining type:", "base type:", "alias udt:", "nested:", "line", "def node:"); + fprintf (outfile, "\n %4.4s " UTPRINT_FORMAT " %10s | %-7s | %-7s | %-7s | %-14s \n", "udt:", "module:", + "name:", "defining type:", "base type:", "alias udt:", "nested:", "extern:", "line", "def node:"); for (i = 0; i < udt_no; i++) { alias = UTgetAlias (i); if (alias == UT_NOT_DEFINED) { - fprintf (outfile, " %4d " UTPRINT_FORMAT " %-10s | %-7s | %-7zu | %-14p \n", i, + fprintf (outfile, " %4d " UTPRINT_FORMAT " %-10s | %-7s | %-7s | %-7zu | %-14p \n", i, NSgetName (UTgetNamespace (i)), UTgetName (i), TYtype2String (UTgetTypedef (i), TRUE, 0), TYtype2String (UTgetBaseType (i), TRUE, 0), - "---", (UTisNested (i)?"yes":""), UTgetLine (i), + "---", (UTisNested (i)?"yes":""), + (UTisExternal (i)?"yes":""), UTgetLine (i), (void *)UTgetTdef (i)); } else { - fprintf (outfile, " %4d " UTPRINT_FORMAT " %-10d | %-7s | %-7zu | %-14p \n", i, + fprintf (outfile, " %4d " UTPRINT_FORMAT " %-10d | %-7s | %-7s | %-7zu | %-14p \n", i, NSgetName (UTgetNamespace (i)), UTgetName (i), TYtype2String (UTgetTypedef (i), TRUE, 0), TYtype2String (UTgetBaseType (i), TRUE, 0), - UTgetAlias (i), (UTisNested (i)?"yes":""), UTgetLine (i), + UTgetAlias (i), (UTisNested (i)?"yes":""), + (UTisExternal (i)?"yes":""), UTgetLine (i), (void *)UTgetTdef (i)); } } diff --git a/src/libsac2c/typecheck/user_types.h b/src/libsac2c/typecheck/user_types.h index 734ef52b6..ec483072a 100644 --- a/src/libsac2c/typecheck/user_types.h +++ b/src/libsac2c/typecheck/user_types.h @@ -50,6 +50,7 @@ extern bool UTeq (usertype udt1, usertype udt2); extern bool UTisAlias (usertype udt); extern bool UTisNested (usertype udt); +extern bool UTisExternal (usertype udt); extern void UTprintRepository (FILE *outfile); -- GitLab From 9e012501d6262c1321549fab0ddac029a10f8dee Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Thu, 19 Nov 2020 14:53:37 +0100 Subject: [PATCH 04/16] started refactoring compile.c funs done: MakeArgNode MakeBasetypeArg --- src/libsac2c/codegen/compile.c | 162 ++++++++++++++++----------------- 1 file changed, 80 insertions(+), 82 deletions(-) diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index 0c27aed91..9fd6ddda8 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -306,7 +306,7 @@ With3Folds (node *ids, node *ops) /** * - * @fn char *GetBasetypeStr( types *type) + * @fn char *GetBasetypeStr( ntype *type) * * @brief Returns the basetype string of the given type, i.e. "TYPES_NAME" if * type represents a user-defined type and "TYPES_BASETYPE" otherwise. @@ -314,43 +314,46 @@ With3Folds (node *ids, node *ops) ******************************************************************************/ static const char * -GetBasetypeStr (types *type) +GetBasetypeStr (ntype *type) { simpletype basetype; const char *str; DBUG_ENTER (); - basetype = TCgetBasetype (type); - - if (basetype == T_user) { - str = TYPES_NAME (type); + if (TUisArrayOfUser (type)) { + str = UTgetName (TYgetUserType (type)); DBUG_ASSERT (str != NULL, "Name of user-defined type not found"); - } else if (basetype == T_bool_dev) { - str = "bool"; - } else if (basetype == T_int_dev || basetype == T_int_shmem) { - str = "int"; - } else if (basetype == T_long_dev || basetype == T_long_shmem) { - str = "long"; - } else if (basetype == T_longlong_dev || basetype == T_longlong_shmem) { - str = "long long"; - } else if (basetype == T_float_dev || basetype == T_float_shmem) { - str = "float"; - } else if (basetype == T_double_dev || basetype == T_double_shmem - || basetype == T_double) { - /* If the enforce_float flag is set, - * we change all doubles to floats */ - if (global.enforce_float) { + } else { + DBUG_ASSERT (TUisArrayOfSimple (type), "Expected either array of User or Simple type."); + basetype = TUgetBaseSimpleType (type); + + if (basetype == T_bool_dev) { + str = "bool"; + } else if (basetype == T_int_dev || basetype == T_int_shmem) { + str = "int"; + } else if (basetype == T_long_dev || basetype == T_long_shmem) { + str = "long"; + } else if (basetype == T_longlong_dev || basetype == T_longlong_shmem) { + str = "long long"; + } else if (basetype == T_float_dev || basetype == T_float_shmem) { str = "float"; + } else if (basetype == T_double_dev || basetype == T_double_shmem + || basetype == T_double) { + /* If the enforce_float flag is set, + * we change all doubles to floats */ + if (global.enforce_float) { + str = "float"; + } else { + str = "double"; + } + } else if (basetype == T_int_dist || basetype == T_long_dist + || basetype == T_longlong_dist || basetype == T_float_dist + || basetype == T_double_dist) { + str = "struct dist_var"; } else { - str = "double"; + str = global.type_string[basetype]; } - } else if (basetype == T_int_dist || basetype == T_long_dist - || basetype == T_longlong_dist || basetype == T_float_dist - || basetype == T_double_dist) { - str = "struct dist_var"; - } else { - str = global.type_string[basetype]; } DBUG_RETURN (str); @@ -366,7 +369,7 @@ GetBasetypeStr (types *type) ******************************************************************************/ static node * -MakeBasetypeArg (types *type) +MakeBasetypeArg (ntype *type) { node *ret_node; const char *str; @@ -416,7 +419,7 @@ MakeBasetypeArg_NT (types *type) ******************************************************************************/ static node * -MakeTypeArgs (char *name, types *type, bool add_type, bool add_dim, bool add_shape, +MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_shape, node *exprs) { int dim; @@ -955,7 +958,7 @@ MakeDecRcIcm (char *name, types *type, int num, node *assigns) ******************************************************************************/ static node * -MakeAllocIcm (char *name, types *type, int rc, node *get_dim, node *set_shape_icm, +MakeAllocIcm (char *name, ntype *type, int rc, node *get_dim, node *set_shape_icm, node *pragma, node *assigns) { node *typeArg; @@ -1130,7 +1133,7 @@ MakeCheckReuseIcm (char *name, types *type, node *reuse_id, node *assigns) ******************************************************************************/ static node * -MakeReAllocIcm (char *name, types *type, char *sname, types *stype, int rc, node *get_dim, +MakeReAllocIcm (char *name, ntype *type, char *sname, types *stype, int rc, node *get_dim, node *set_shape_icm, node *pragma, node *assigns) { DBUG_ENTER (); @@ -1723,37 +1726,35 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) ******************************************************************************/ static node * -MakeArgNode (size_t idx, types *arg_type, bool thread) +MakeArgNode (size_t idx, ntype *arg_type, bool thread) { node *id; char *name; - types *type; + ntype *type; DBUG_ENTER (); - type = DUPdupAllTypes (arg_type); + type = TYcopyType (arg_type); /* Set usage tag of arg */ if (thread) { - TYPES_MUTC_USAGE (type) = MUTC_US_THREADPARAM; + type = TYsetMutcUsage (type, MUTC_US_THREADPARAM); } else { - TYPES_MUTC_USAGE (type) = MUTC_US_FUNPARAM; + type = TYsetMutcUsage (type, MUTC_US_FUNPARAM); } name = (char *)MEMmalloc (20 * sizeof (char)); sprintf (name, "SAC_arg_%zu", idx); if (type != NULL) { - id = TCmakeIdCopyStringNt (name, type); + id = TCmakeIdCopyStringNtNew (name, type); } else { -#if 1 id = TCmakeIdCopyString (name); -#endif } name = MEMfree (name); - type = FREEfreeAllTypes (type); + type = TYfreeType (type); DBUG_RETURN (id); } @@ -1787,18 +1788,18 @@ MakeFunctionArgsSpmd (node *fundef) for (i = argtab->size - 1; i >= 1; i--) { char *name; node *id; - types *type; + ntype *type; if (argtab->ptr_in[i] != NULL) { DBUG_ASSERT (NODE_TYPE (argtab->ptr_in[i]) == N_arg, "no N_arg node found in argtab"); name = ARG_NAME (argtab->ptr_in[i]); - type = ARG_TYPE (argtab->ptr_in[i]); + type = ARG_NTYPE (argtab->ptr_in[i]); id = TCmakeIdCopyStringNt (STRonNull ("", name), type); } else { DBUG_ASSERT (argtab->ptr_out[i] != NULL, "argtab is uncompressed!"); - type = TYtype2OldType (RET_TYPE (argtab->ptr_out[i])); + type = RET_TYPE (argtab->ptr_out[i]); id = MakeArgNode (i, type, FALSE); } @@ -1811,8 +1812,8 @@ MakeFunctionArgsSpmd (node *fundef) /* return value */ DBUG_ASSERT (argtab->ptr_in[0] == NULL, "argtab is inconsistent!"); if (argtab->ptr_out[0] != NULL) { - types *type; - type = TYtype2OldType (RET_TYPE (argtab->ptr_out[0])); + ntype *type; + type = RET_TYPE (argtab->ptr_out[0]); icm_args = TBmakeExprs (TCmakeIdCopyString (global.argtag_string[argtab->tag[0]]), TBmakeExprs (MakeBasetypeArg (type), TBmakeExprs (MakeArgNode (0, type, FALSE), @@ -1855,7 +1856,7 @@ MakeFunctionArgsCuda (node *fundef) for (i = argtab->size - 1; i >= 1; i--) { char *name; node *id; - types *type; + ntype *type; if (argtab->ptr_in[i] != NULL) { DBUG_ASSERT (NODE_TYPE (argtab->ptr_in[i]) == N_arg, @@ -1866,7 +1867,7 @@ MakeFunctionArgsCuda (node *fundef) id = TCmakeIdCopyStringNt (STRonNull ("", name), type); } else { DBUG_ASSERT (argtab->ptr_out[i] != NULL, "argtab is uncompressed!"); - type = TYtype2OldType (RET_TYPE (argtab->ptr_out[i])); + type = RET_TYPE (argtab->ptr_out[i]); id = MakeArgNode (i, type, FALSE); } @@ -1882,8 +1883,8 @@ MakeFunctionArgsCuda (node *fundef) /* return value */ DBUG_ASSERT (argtab->ptr_in[0] == NULL, "argtab is inconsistent!"); if (argtab->ptr_out[0] != NULL) { - types *type; - type = TYtype2OldType (RET_TYPE (argtab->ptr_out[0])); + ntype *type; + type = RET_TYPE (argtab->ptr_out[0]); icm_args = TBmakeExprs (TCmakeIdCopyString (global.argtag_string[argtab->tag[0]]), TBmakeExprs (MakeBasetypeArg (type), @@ -1936,7 +1937,7 @@ MakeFunctionArgs (node *fundef) /* arguments */ for (i = argtab->size - 1; i >= 1; i--) { argtag_t tag; - types *type; + ntype *type; char *name; node *id; @@ -1945,7 +1946,7 @@ MakeFunctionArgs (node *fundef) "no N_arg node found in argtab"); tag = argtab->tag[i]; - type = ARG_TYPE (argtab->ptr_in[i]); + type = ARG_NTYPE (argtab->ptr_in[i]); name = ARG_NAME (argtab->ptr_in[i]); if (name != NULL) { id = TCmakeIdCopyStringNt (name, type); @@ -1955,7 +1956,7 @@ MakeFunctionArgs (node *fundef) } else { DBUG_ASSERT (argtab->ptr_out[i] != NULL, "argtab is uncompressed!"); tag = argtab->tag[i]; - type = TYtype2OldType (RET_TYPE (argtab->ptr_out[i])); + type = RET_TYPE (argtab->ptr_out[i]); id = MakeArgNode (i, type, FUNDEF_ISTHREADFUN (fundef)); } @@ -3340,7 +3341,7 @@ COMPfundef (node *arg_node, info *arg_info) if (FUNDEF_CONTAINSSPAWN (arg_node) && !FUNDEF_ISSLOWCLONE (arg_node)) { node *livevars; node *avis; - types *type; + ntype *type; livevars = FUNDEF_LIVEVARS (arg_node); @@ -3348,9 +3349,7 @@ COMPfundef (node *arg_node, info *arg_info) // TODO: print the type as well avis = LIVEVARS_AVIS (livevars); - type = NODE_TYPE (AVIS_DECL (avis)) == N_vardec - ? VARDEC_TYPE (AVIS_DECL (avis)) - : ARG_TYPE (AVIS_DECL (avis)); + type = AVIS_TYPE (avis); INFO_FPFRAME (arg_info) = TCmakeAssignIcm2 ("FP_FRAME_LIVEVAR", MakeBasetypeArg (type), @@ -3650,8 +3649,7 @@ MakeFunRetArgs (node *arg_node, info *arg_info) new_args = TBmakeExprs (TCmakeIdCopyString (global.argtag_string[argtab->tag[i]]), TBmakeExprs (MakeArgNode (i, - TYtype2OldType ( - RET_TYPE (argtab->ptr_out[i])), + RET_TYPE (argtab->ptr_out[i]), FUNDEF_ISTHREADFUN (fundef)), TBmakeExprs (DUPdupIdNt ( EXPRS_EXPR (ret_exprs)), @@ -3731,7 +3729,7 @@ MakeFunRetArgsSpmd (node *arg_node, info *arg_info) node *icm_args = NULL; node *last_arg = NULL; node *vardecs; - types *type; + ntype *type; node *val_nt; node *foldfun_tag; node *foldfun_name; @@ -3768,7 +3766,7 @@ MakeFunRetArgsSpmd (node *arg_node, info *arg_info) DBUG_ASSERT ((foldfun == NULL) || (NODE_TYPE (foldfun) == N_fundef), "Wrong fold function detected"); - type = ID_TYPE (EXPRS_EXPR (ret_exprs)); + type = ID_NTYPE (EXPRS_EXPR (ret_exprs)); DBUG_ASSERT (vardecs != NULL, "Too few vardecs in SPMD function"); @@ -5052,7 +5050,7 @@ static node * COMPprfToUnq (node *arg_node, info *arg_info) { node *let_ids; - types *lhs_type, *rhs_type; + ntype *lhs_type, *rhs_type; node *icm_args; node *ret_node, *arg; @@ -5074,8 +5072,8 @@ COMPprfToUnq (node *arg_node, info *arg_info) * C-function. */ - lhs_type = IDS_TYPE (let_ids); - rhs_type = ID_TYPE (arg); + lhs_type = IDS_NTYPE (let_ids); + rhs_type = ID_NTYPE (arg); DBUG_ASSERT (!TCisUnique (rhs_type), "to_unq() with unique RHS found!"); icm_args @@ -5127,7 +5125,7 @@ static node * COMPprfDisclose (node *arg_node, info *arg_info) { node *let_ids; - types *lhs_type, *rhs_type; + ntype *lhs_type, *rhs_type; node *icm_args; node *ret_node, *arg; @@ -5137,8 +5135,8 @@ COMPprfDisclose (node *arg_node, info *arg_info) arg = PRF_ARG3 (arg_node); - lhs_type = IDS_TYPE (let_ids); - rhs_type = ID_TYPE (arg); + lhs_type = IDS_NTYPE (let_ids); + rhs_type = ID_NTYPE (arg); icm_args = MakeTypeArgs (IDS_NAME (let_ids), lhs_type, FALSE, TRUE, FALSE, @@ -6367,7 +6365,7 @@ COMPprfCopy (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm4 ("CUDA_COPY__ARRAY", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), - MakeBasetypeArg (ID_TYPE (PRF_ARG1 (arg_node))), + MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TCmakeIdCopyString ( GenericFun (GF_copy, ID_TYPE (PRF_ARG1 (arg_node)))), NULL); @@ -7047,7 +7045,7 @@ COMPprfIdxModarray_AxSxA (node *arg_node, info *arg_info) MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), FALSE, TRUE, FALSE, NULL)), DUPdupNodeNt (arg2), DUPdupNodeNt (arg3), - MakeBasetypeArg (ID_TYPE (arg1)), NULL); + MakeBasetypeArg (ID_NTYPE (arg1)), NULL); } else { ret_node = TCmakeAssignIcm4 ("ND_PRF_IDX_MODARRAY_AxSxA__DATA", @@ -8293,7 +8291,7 @@ COMPprfUnshare (node *arg_node, info *arg_info) TRUE, FALSE, NULL), MakeTypeArgs (ID_NAME (iv_id), ID_TYPE (iv_id), FALSE, TRUE, FALSE, NULL), - MakeBasetypeArg (ID_TYPE (iv_id)), + MakeBasetypeArg (ID_NTYPE (iv_id)), TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (iv_id))), ret_node); } @@ -9052,7 +9050,7 @@ COMPprfPrefetch2Host (node *arg_node, info *arg_info) /* and precede this by the actual prefetch ICM call */ ret_node = TCmakeAssignIcm3 ("CUDA_MEM_PREFETCH", DUPdupIdNt (PRF_ARG1 (arg_node)), - MakeBasetypeArg (ID_TYPE (PRF_ARG1 (arg_node))), + MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TBmakeNum (-1), ret_node); DBUG_RETURN (ret_node); @@ -9081,7 +9079,7 @@ COMPprfPrefetch2Device (node *arg_node, info *arg_info) /* and precede this by the actual prefetch ICM call */ ret_node = TCmakeAssignIcm3 ("CUDA_MEM_PREFETCH", DUPdupIdNt (PRF_ARG1 (arg_node)), - MakeBasetypeArg (ID_TYPE (PRF_ARG1 (arg_node))), + MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TBmakeNum (0), ret_node); DBUG_RETURN (ret_node); @@ -9099,7 +9097,7 @@ COMPprfDevice2Host (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm4 ("CUDA_MEM_TRANSFER", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), - MakeBasetypeArg (ID_TYPE (PRF_ARG1 (arg_node))), + MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TCmakeIdCopyString ("cudaMemcpyDeviceToHost"), NULL); DBUG_RETURN (ret_node); @@ -9117,7 +9115,7 @@ COMPprfHost2Device (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm4 ("CUDA_MEM_TRANSFER", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), - MakeBasetypeArg (ID_TYPE (PRF_ARG1 (arg_node))), + MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TCmakeIdCopyString ("cudaMemcpyHostToDevice"), NULL); DBUG_RETURN (ret_node); @@ -9135,7 +9133,7 @@ COMPprfDevice2HostStart (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm4 ("CUDA_MEM_TRANSFER_START", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), - MakeBasetypeArg (ID_TYPE (PRF_ARG1 (arg_node))), + MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TCmakeIdCopyString ("cudaMemcpyDeviceToHost"), NULL); DBUG_RETURN (ret_node); @@ -9153,7 +9151,7 @@ COMPprfHost2DeviceStart (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm4 ("CUDA_MEM_TRANSFER_START", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), - MakeBasetypeArg (ID_TYPE (PRF_ARG1 (arg_node))), + MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TCmakeIdCopyString ("cudaMemcpyHostToDevice"), NULL); DBUG_RETURN (ret_node); @@ -9211,7 +9209,7 @@ COMPprfDevice2Device (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm4 ("CUDA_MEM_TRANSFER", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), - MakeBasetypeArg (ID_TYPE (PRF_ARG1 (arg_node))), + MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TCmakeIdCopyString ("cudaMemcpyDeviceToDevice"), NULL); DBUG_RETURN (ret_node); @@ -9526,7 +9524,7 @@ COMPprfDist2Host_Rel (node *arg_node, info *arg_info) DUPdupNodeNt (PRF_ARG2 (arg_node)), DUPdupNodeNt (PRF_ARG3 (arg_node)), DUPdupNodeNt (PRF_ARG4 (arg_node)), - MakeBasetypeArg (IDS_TYPE (let_ids)), NULL); + MakeBasetypeArg (IDS_NTYPE (let_ids)), NULL); DBUG_RETURN (ret_node); } @@ -9546,7 +9544,7 @@ COMPprfDist2Dev_Rel (node *arg_node, info *arg_info) DUPdupNodeNt (PRF_ARG2 (arg_node)), DUPdupNodeNt (PRF_ARG3 (arg_node)), DUPdupIdNt (PRF_ARG4 (arg_node)), - MakeBasetypeArg (IDS_TYPE (let_ids)), NULL); + MakeBasetypeArg (IDS_NTYPE (let_ids)), NULL); DBUG_RETURN (ret_node); } @@ -9566,7 +9564,7 @@ COMPprfDist2Host_Abs (node *arg_node, info *arg_info) DUPdupNodeNt (PRF_ARG2 (arg_node)), DUPdupNodeNt (PRF_ARG3 (arg_node)), DUPdupNodeNt (PRF_ARG4 (arg_node)), - MakeBasetypeArg (IDS_TYPE (let_ids)), NULL); + MakeBasetypeArg (IDS_NTYPE (let_ids)), NULL); DBUG_RETURN (ret_node); } @@ -9586,7 +9584,7 @@ COMPprfDist2Dev_Abs (node *arg_node, info *arg_info) DUPdupNodeNt (PRF_ARG2 (arg_node)), DUPdupNodeNt (PRF_ARG3 (arg_node)), DUPdupIdNt (PRF_ARG4 (arg_node)), - MakeBasetypeArg (IDS_TYPE (let_ids)), NULL); + MakeBasetypeArg (IDS_NTYPE (let_ids)), NULL); DBUG_RETURN (ret_node); } @@ -9608,7 +9606,7 @@ COMPprfDist2Dev_Avail (node *arg_node, info *arg_info) DUPdupIdNt (PRF_ARG4 (arg_node)), DUPdupIdNt (PRF_ARG5 (arg_node)), DUPdupIdNt (PRF_ARG6 (arg_node)), - MakeBasetypeArg (IDS_TYPE (let_ids)), NULL); + MakeBasetypeArg (IDS_NTYPE (let_ids)), NULL); DBUG_RETURN (ret_node); } -- GitLab From c96c4272d20ac3afd5a657dfe0afcf6e29a0f99c Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Fri, 20 Nov 2020 16:37:24 +0100 Subject: [PATCH 05/16] done a few more statics in compile --- src/libsac2c/arrayopt/polyhedral_utilities.c | 4 +- src/libsac2c/codegen/compile.c | 657 +++++++++---------- src/libsac2c/typecheck/type_utils.c | 39 +- src/libsac2c/typecheck/type_utils.h | 81 ++- 4 files changed, 427 insertions(+), 354 deletions(-) diff --git a/src/libsac2c/arrayopt/polyhedral_utilities.c b/src/libsac2c/arrayopt/polyhedral_utilities.c index 644df33f0..cb5789eca 100644 --- a/src/libsac2c/arrayopt/polyhedral_utilities.c +++ b/src/libsac2c/arrayopt/polyhedral_utilities.c @@ -263,7 +263,7 @@ Node2Value (node *arg_node) if (NULL != z) { if (TYisAKV (AVIS_TYPE (z))) { if (TUisIntScalar (AVIS_TYPE (z))) { - z = TBmakeNum (TUtype2Int (AVIS_TYPE (z))); + z = TBmakeNum (TUakvScalInt2Int (AVIS_TYPE (z))); } else { if (TUisBoolScalar (AVIS_TYPE (z))) { con = TYgetValue (AVIS_TYPE (z)); // con is NOT a copy! @@ -1739,7 +1739,7 @@ HandleNumber (node *arg_node, node *rhs, node *fundef, lut_t *varlut, node *res) DBUG_PRINT ("HandleNumber for lhs=%s", AVIS_NAME (arg_node)); if ((NULL == rhs) && TYisAKV (AVIS_TYPE (arg_node))) { AVIS_ISLCLASS (arg_node) = AVIS_ISLCLASSEXISTENTIAL; - rhs = TBmakeNum (TUtype2Int (AVIS_TYPE (arg_node))); + rhs = TBmakeNum (TUakvScalInt2Int (AVIS_TYPE (arg_node))); } z = BuildIslSimpleConstraint (arg_node, F_eq_SxS, rhs, NOPRFOP, NULL); res = TCappendExprs (res, z); diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index 9fd6ddda8..91a5d6609 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -361,7 +361,7 @@ GetBasetypeStr (ntype *type) /** * - * @fn node *MakeBasetypeArg( types *type) + * @fn node *MakeBasetypeArg( ntype *type) * * @brief Creates a new N_id node containing the basetype string of the given * type. @@ -385,7 +385,7 @@ MakeBasetypeArg (ntype *type) /** * - * @fn node *MakeBasetypeArg_NT( types *type) + * @fn node *MakeBasetypeArg_NT( ntype *type) * * @brief Creates a new N_id node containing the basetype string of the given * type. @@ -393,7 +393,7 @@ MakeBasetypeArg (ntype *type) ******************************************************************************/ static node * -MakeBasetypeArg_NT (types *type) +MakeBasetypeArg_NT (ntype *type) { node *ret_node; const char *str; @@ -402,14 +402,14 @@ MakeBasetypeArg_NT (types *type) str = GetBasetypeStr (type); - ret_node = TCmakeIdCopyStringNt (str, type); + ret_node = TCmakeIdCopyStringNtNew (str, type); DBUG_RETURN (ret_node); } /** * - * @fn node *MakeTypeArgs( char *name, types *type, + * @fn node *MakeTypeArgs( char *name, ntype *type, * bool add_type, bool add_dim, bool add_shape, * node *exprs) * @@ -423,9 +423,12 @@ MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_sha node *exprs) { int dim; + ntype *itype; DBUG_ENTER (); + itype = TUcomputeImplementationType(type); + dim = TUgetDimEncoding (itype); dim = TCgetShapeDim (type); /* @@ -434,17 +437,8 @@ MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_sha * otherwise the VARINT-interpretation of the shape-args would fail * during icm2c!! */ - if (add_shape) { - if (dim == 0) { - /* SCL */ - } else if (dim > 0) { - /* AKS */ - exprs = TCappendExprs (TCtype2Exprs (type), exprs); - } else if (dim < KNOWN_DIM_OFFSET) { - /* AKD */ - } else { - /* AUD */ - } + if (add_shape && (dim > 0)) { // at least AKS + exprs = SHshape2Exprs (TYgetShape (itype)); } if (add_dim) { @@ -455,7 +449,7 @@ MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_sha exprs = TBmakeExprs (MakeBasetypeArg (type), exprs); } - exprs = TBmakeExprs (TCmakeIdCopyStringNt (name, type), exprs); + exprs = TBmakeExprs (TCmakeIdCopyStringNtNew (name, type), exprs); DBUG_RETURN (exprs); } @@ -478,7 +472,7 @@ MakeDimArg (node *arg, bool int_only) DBUG_ENTER (); if (NODE_TYPE (arg) == N_id) { - int dim = TCgetDim (ID_TYPE (arg)); + int dim = TCgetDim (ID_NTYPE (arg)); if (dim >= 0) { ret = TBmakeNum (dim); } else if (int_only) { @@ -526,7 +520,7 @@ MakeSizeArg (node *arg, bool int_only) DBUG_ENTER (); if (NODE_TYPE (arg) == N_id) { - types *type = ID_TYPE (arg); + types *type = ID_NTYPE (arg); if (TCgetShapeDim (type) >= 0) { ret = TBmakeNum (TCgetTypesLength (type)); } else if (int_only) { @@ -557,7 +551,7 @@ MakeSizeArg (node *arg, bool int_only) /** * - * @fn char *GenericFun( generic_fun_t which, types *type) + * @fn char *GenericFun( generic_fun_t which, ntype *type) * * @brief Returns the name of the specified generic function for the given * type. @@ -567,7 +561,7 @@ MakeSizeArg (node *arg, bool int_only) ******************************************************************************/ static char * -GenericFun (generic_fun_t which, types *type) +GenericFun (generic_fun_t which, ntype *type) { node *tdef; char *ret = NULL; @@ -589,11 +583,9 @@ GenericFun (generic_fun_t which, types *type) DBUG_ASSERT (type != NULL, "no type found!"); - if (TYPES_BASETYPE (type) == T_user) { - tdef = TYPES_TDEF (type); - DBUG_ASSERT (tdef != NULL, "Failed attempt to look up typedef"); + if (TYisUser (type)) { - utype = UTfindUserType (TYPEDEF_NAME (tdef), TYPEDEF_NS (tdef)); + utype = TYgetUserType (type); DBUG_ASSERT ((utype != UT_NOT_DEFINED) && (!TYisUser (TYgetScalar (UTgetBaseType (utype)))), @@ -602,10 +594,10 @@ GenericFun (generic_fun_t which, types *type) if (TYgetSimpleType (TYgetScalar (UTgetBaseType (utype))) == T_hidden) { switch (which) { case GF_copy: - ret = TYPEDEF_COPYFUN (tdef); + ret = TYPEDEF_COPYFUN (UTgetTypedef (utype)); break; case GF_free: - ret = TYPEDEF_FREEFUN (tdef); + ret = TYPEDEF_FREEFUN (UTgetTypedef (utype)); break; } } @@ -735,7 +727,7 @@ DupExpr_NT_AddReadIcms (node *expr) new_expr = TBmakePrf (PRF_PRF (expr), DupExprs_NT_AddReadIcms (PRF_ARGS (expr))); } else if (NODE_TYPE (expr) == N_id) { new_expr = DUPdupIdNt (expr); - if (TCgetShapeDim (ID_TYPE (expr)) == SCALAR) { + if (TCgetShapeDim (ID_NTYPE (expr)) == SCALAR) { new_expr = TCmakeIcm2 ("ND_READ", new_expr, TBmakeNum (0)); } } else { @@ -885,7 +877,7 @@ MakeSetRcIcm (char *name, types *type, int rc, node *assigns) /** * - * @fn node *MakeIncRcIcm( char *name, types *type, int num, + * @fn node *MakeIncRcIcm( char *name, ntype *type, int num, * node *assigns) * * @brief Builds a ND_INC_RC( name, num) icm if needed. @@ -893,14 +885,14 @@ MakeSetRcIcm (char *name, types *type, int rc, node *assigns) ******************************************************************************/ static node * -MakeIncRcIcm (char *name, types *type, int num, node *assigns) +MakeIncRcIcm (char *name, ntype *type, int num, node *assigns) { DBUG_ENTER (); DBUG_ASSERT (num >= 0, "increment for rc must be >= 0."); if (num > 0) { - assigns = TCmakeAssignIcm2 ("ND_INC_RC", TCmakeIdCopyStringNt (name, type), + assigns = TCmakeAssignIcm2 ("ND_INC_RC", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (num), assigns); } @@ -909,7 +901,7 @@ MakeIncRcIcm (char *name, types *type, int num, node *assigns) /** * - * @fn node *MakeDecRcIcm( char *name, types *type, int num, + * @fn node *MakeDecRcIcm( char *name, ntype *type, int num, * node *assigns) * * @brief According to 'type', 'rc' and 'num', builds a @@ -919,27 +911,32 @@ MakeIncRcIcm (char *name, types *type, int num, node *assigns) ******************************************************************************/ static node * -MakeDecRcIcm (char *name, types *type, int num, node *assigns) +MakeDecRcIcm (char *name, ntype *type, int num, node *assigns) { const char *icm; + ntype *itype; + simpletype elem_type; DBUG_ENTER (); DBUG_ASSERT (num >= 0, "decrement for rc must be >= 0."); + if (num > 0) { - if (TCgetBasetype (type) == T_int_dist || TCgetBasetype (type) == T_long_dist - || TCgetBasetype (type) == T_longlong_dist - || TCgetBasetype (type) == T_float_dist - || TCgetBasetype (type) == T_double_dist) { + itype = TUcomputeImplementationType (type); + elem_type = TYgetSimpleType (itype); + if (elem_type == T_int_dist || elem_type == T_long_dist + || elem_type == T_longlong_dist + || elem_type == T_float_dist + || elem_type == T_double_dist) { icm = "DIST_DEC_RC_FREE"; - } else if (CUisDeviceTypeOld (type)) { + } else if (CUisDeviceTypeNew (type)) { icm = "CUDA_DEC_RC_FREE"; } else { icm = "ND_DEC_RC_FREE"; } assigns - = TCmakeAssignIcm3 (icm, TCmakeIdCopyStringNt (name, type), TBmakeNum (num), + = TCmakeAssignIcm3 (icm, TCmakeIdCopyStringNtNew (name, type), TBmakeNum (num), TCmakeIdCopyString (GenericFun (GF_free, type)), assigns); } @@ -1094,7 +1091,7 @@ MakeAllocIcm_IncRc (char *name, types *type, int rc, node *get_dim, node *set_sh /** * - * @fn node *MakeCheckReuseIcm( char *name, types *type, node *reuse_id, + * @fn node *MakeCheckReuseIcm( char *name, ntype *type, node *reuse_id, * node *assigns); * * @brief Builds a CHECK_REUSE icm which checks whether reuse_id can be @@ -1104,7 +1101,7 @@ MakeAllocIcm_IncRc (char *name, types *type, int rc, node *get_dim, node *set_sh ******************************************************************************/ static node * -MakeCheckReuseIcm (char *name, types *type, node *reuse_id, node *assigns) +MakeCheckReuseIcm (char *name, ntype *type, node *reuse_id, node *assigns) { DBUG_ENTER (); @@ -1112,9 +1109,9 @@ MakeCheckReuseIcm (char *name, types *type, node *reuse_id, node *assigns) = TCmakeAssignIcm2 ("ND_CHECK_REUSE", MakeTypeArgs (name, type, FALSE, TRUE, FALSE, MakeTypeArgs (ID_NAME (reuse_id), - ID_TYPE (reuse_id), FALSE, TRUE, + ID_NTYPE (reuse_id), FALSE, TRUE, FALSE, NULL)), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (reuse_id))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (reuse_id))), assigns); DBUG_RETURN (assigns); @@ -1204,15 +1201,15 @@ MakeCheckResizeIcm (char *name, types *type, node *reuse_id, int rc, node *get_d assigns = TCmakeAssignIcm1 ("SAC_IS_LASTREF__BLOCK_ELSE", - TCmakeIdCopyStringNt (ID_NAME (reuse_id), ID_TYPE (reuse_id)), + TCmakeIdCopyStringNt (ID_NAME (reuse_id), ID_NTYPE (reuse_id)), assigns); - assigns = MakeReAllocIcm (name, type, ID_NAME (reuse_id), ID_TYPE (reuse_id), rc, + assigns = MakeReAllocIcm (name, type, ID_NAME (reuse_id), ID_NTYPE (reuse_id), rc, get_dim, set_shape_icm, NULL, assigns); assigns = TCmakeAssignIcm1 ("SAC_IS_LASTREF__BLOCK_BEGIN", - TCmakeIdCopyStringNt (ID_NAME (reuse_id), ID_TYPE (reuse_id)), + TCmakeIdCopyStringNt (ID_NAME (reuse_id), ID_NTYPE (reuse_id)), assigns); DBUG_RETURN (assigns); @@ -1322,10 +1319,10 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) */ set_shape = TCmakeIcm1 ("ND_COPY__SHAPE", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, MakeTypeArgs (ID_NAME (arg_node), - ID_TYPE (arg_node), FALSE, + ID_NTYPE (arg_node), FALSE, TRUE, FALSE, NULL))); break; @@ -1356,7 +1353,7 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) if (ARRAY_AELEMS (arg_node) != NULL) { if (NODE_TYPE (EXPRS_EXPR (ARRAY_AELEMS (arg_node))) == N_id) { val0_sdim = TCgetShapeDim ( - ID_TYPE (EXPRS_EXPR (ARRAY_AELEMS (arg_node)))); + ID_NTYPE (EXPRS_EXPR (ARRAY_AELEMS (arg_node)))); } else { val0_sdim = 0; } @@ -1366,7 +1363,7 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) set_shape = TCmakeIcm3 ("ND_CREATE__ARRAY__SHAPE", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, icm_args2), icm_args, TBmakeNum (val0_sdim)); } @@ -1391,12 +1388,12 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) "2nd arg of F_cat_VxV is no N_id!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, MakeTypeArgs (ID_NAME (arg2), - ID_TYPE (arg2), + ID_NTYPE (arg2), FALSE, TRUE, FALSE, NULL))); @@ -1421,9 +1418,9 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) "2nd arg of F_drop_SxV is no N_id!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupNodeNt (arg1), NULL))); @@ -1449,9 +1446,9 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) "2nd arg of F_take_SxV is no N_id!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupNodeNt (arg1), NULL))); @@ -1473,9 +1470,9 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) node *icm_args; icm_args = MakeTypeArgs ( - IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, FALSE, + IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, MakeTypeArgs ( - ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, FALSE, + ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (MakeSizeArg (arg1, TRUE), TCappendExprs (DupExprs_NT_AddReadIcms ( ARRAY_AELEMS (arg1)), @@ -1494,15 +1491,15 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) { node *icm_args; - DBUG_ASSERT ((TCgetBasetype (ID_TYPE (arg1)) == T_int), + DBUG_ASSERT ((TCgetBasetype (ID_NTYPE (arg1)) == T_int), "1st arg of F_sel_VxA is a illegal indexing " "var!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, MakeTypeArgs (ID_NAME (arg2), - ID_TYPE (arg2), FALSE, TRUE, + ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupIdNt ( arg1), @@ -1537,12 +1534,12 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) "2nd arg of F_idx_sel is no N_id!"); icm_args - = MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, + = MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupNodeNt (arg1), NULL)); set_shape = TCmakeIcm1 ("ND_PRF_IDX_SEL__SHAPE", MakeTypeArgs (IDS_NAME (let_ids), - IDS_TYPE (let_ids), FALSE, + IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, icm_args)); } break; @@ -1559,7 +1556,7 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) set_shape = TCmakeIcm1 ("ND_PRF_RESHAPE_VxA__SHAPE_arr", MakeTypeArgs (IDS_NAME (let_ids), - IDS_TYPE (let_ids), FALSE, TRUE, + IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, TBmakeExprs (MakeSizeArg (arg1, TRUE), @@ -1576,7 +1573,7 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) set_shape = TCmakeIcm1 ("ND_PRF_RESHAPE_VxA__SHAPE_id", MakeTypeArgs (IDS_NAME (let_ids), - IDS_TYPE (let_ids), FALSE, TRUE, + IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupIdNt (arg1), NULL))); @@ -1600,12 +1597,12 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) set_shape = TCmakeIcm1 ("ND_WL_GENARRAY__SHAPE_id_id", MakeTypeArgs (IDS_NAME (let_ids), - IDS_TYPE (let_ids), FALSE, TRUE, + IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupIdNt (arg1), MakeTypeArgs (ID_NAME ( arg2), - ID_TYPE ( + ID_NTYPE ( arg2), FALSE, TRUE, @@ -1620,11 +1617,11 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) set_shape = TCmakeIcm4 ("ND_WL_GENARRAY__SHAPE_arr_id", MakeTypeArgs (IDS_NAME (let_ids), - IDS_TYPE (let_ids), FALSE, TRUE, + IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, NULL), MakeSizeArg (arg1, TRUE), DupExprs_NT_AddReadIcms (ARRAY_AELEMS (arg1)), - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, NULL)); break; default: @@ -1675,7 +1672,7 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) */ set_shape = TCmakeIcm4 ("ND_WL_GENARRAY__SHAPE_id_arr", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, NULL), DUPdupIdNt (arg1), MakeSizeArg (arg2, TRUE), DupExprs_NT_AddReadIcms (ARRAY_AELEMS (arg2))); @@ -1976,8 +1973,7 @@ MakeFunctionArgs (node *fundef) if (argtab->ptr_out[0] == NULL) { icm_args = TBmakeExprs (TCmakeIdCopyString (NULL), icm_args); } else { - icm_args = TBmakeExprs (MakeBasetypeArg_NT ( - TYtype2OldType (RET_TYPE (argtab->ptr_out[0]))), + icm_args = TBmakeExprs (MakeBasetypeArg_NT (RET_TYPE (argtab->ptr_out[0])), icm_args); } @@ -2063,9 +2059,9 @@ MakeFunApArgIdsNt (node *ids) node *icm, *id = NULL; DBUG_ENTER (); - if (TYPES_MUTC_USAGE (IDS_TYPE (ids)) == MUTC_US_FUNPARAM) { + if (TYPES_MUTC_USAGE (IDS_NTYPE (ids)) == MUTC_US_FUNPARAM) { id = TCmakeIdCopyString ("FPA"); - } else if (TYPES_MUTC_USAGE (IDS_TYPE (ids)) == MUTC_US_THREADPARAM) { + } else if (TYPES_MUTC_USAGE (IDS_NTYPE (ids)) == MUTC_US_THREADPARAM) { id = TCmakeIdCopyString ("FTA"); } else { id = TCmakeIdCopyString ("FAG"); @@ -2091,7 +2087,7 @@ MakeFunApArgIdsNtThread (node *ids) node *icm, *id = NULL; DBUG_ENTER (); - if (TYPES_MUTC_USAGE (IDS_TYPE (ids)) == MUTC_US_THREADPARAM) { + if (TYPES_MUTC_USAGE (IDS_NTYPE (ids)) == MUTC_US_THREADPARAM) { id = TCmakeIdCopyString ("TPA"); } else { id = TCmakeIdCopyString ("TAG"); @@ -2116,9 +2112,9 @@ MakeFunApArgIdNt (node *id) node *icm, *st = NULL; DBUG_ENTER (); - if (TYPES_MUTC_USAGE (ID_TYPE (id)) == MUTC_US_FUNPARAM) { + if (TYPES_MUTC_USAGE (ID_NTYPE (id)) == MUTC_US_FUNPARAM) { st = TCmakeIdCopyString ("FPA"); - } else if (TYPES_MUTC_USAGE (ID_TYPE (id)) == MUTC_US_THREADPARAM) { + } else if (TYPES_MUTC_USAGE (ID_NTYPE (id)) == MUTC_US_THREADPARAM) { st = TCmakeIdCopyString ("FTA"); } else { st = TCmakeIdCopyString ("FAG"); @@ -2143,7 +2139,7 @@ MakeFunApArgIdNtThread (node *id) node *icm, *st = NULL; DBUG_ENTER (); - if (TYPES_MUTC_USAGE (ID_TYPE (id)) == MUTC_US_THREADPARAM) { + if (TYPES_MUTC_USAGE (ID_NTYPE (id)) == MUTC_US_THREADPARAM) { st = TCmakeIdCopyString ("TPA"); } else { st = TCmakeIdCopyString ("TAG"); @@ -2202,8 +2198,8 @@ MakeFunApArgs (node *ap, info *arg_info) if (FUNDEF_RTSPECID (fundef) != NULL && global.config.rtspec && ((fundef_in_current_namespace && FUNDEF_ISEXPORTED (fundef)) || !fundef_in_current_namespace)) { - shape = NTUgetShapeClassFromTypes (IDS_TYPE (argtab->ptr_out[i])); - dim = TCgetDim (IDS_TYPE (argtab->ptr_out[i])); + shape = NTUgetShapeClassFromTypes (IDS_NTYPE (argtab->ptr_out[i])); + dim = TCgetDim (IDS_NTYPE (argtab->ptr_out[i])); exprs = TBmakeExprs (TBmakeNum (shape), exprs); exprs = TBmakeExprs (TBmakeNum (dim), exprs); } @@ -2216,7 +2212,7 @@ MakeFunApArgs (node *ap, info *arg_info) exprs = TBmakeExprs (TCmakeIdCopyString ( GetBaseTypeFromExpr (argtab->ptr_out[i])), TBmakeExprs (TBmakeNum (TYPES_DIM ( - IDS_TYPE (argtab->ptr_out[i]))), + IDS_NTYPE (argtab->ptr_out[i]))), exprs)); } @@ -2250,8 +2246,8 @@ MakeFunApArgs (node *ap, info *arg_info) && ((fundef_in_current_namespace && FUNDEF_ISEXPORTED (fundef)) || !fundef_in_current_namespace)) { shape = NTUgetShapeClassFromTypes ( - ID_TYPE (EXPRS_EXPR (argtab->ptr_in[i]))); - dim = TCgetDim (ID_TYPE (EXPRS_EXPR (argtab->ptr_in[i]))); + ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); + dim = TCgetDim (ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); exprs = TBmakeExprs (TBmakeNum (shape), exprs); exprs = TBmakeExprs (TBmakeNum (dim), exprs); } @@ -2264,7 +2260,7 @@ MakeFunApArgs (node *ap, info *arg_info) } else { exprs = TBmakeExprs (TCmakeIdCopyString ( GetBaseTypeFromExpr (argtab->ptr_in[i])), - TBmakeExprs (TBmakeNum (TYPES_DIM (ID_TYPE ( + TBmakeExprs (TBmakeNum (TYPES_DIM (ID_NTYPE ( EXPRS_EXPR (argtab->ptr_in[i])))), exprs)); } @@ -2298,8 +2294,8 @@ MakeFunApArgs (node *ap, info *arg_info) && ((fundef_in_current_namespace && FUNDEF_ISEXPORTED (fundef)) || !fundef_in_current_namespace)) { shape = NTUgetShapeClassFromTypes ( - ID_TYPE (EXPRS_EXPR (argtab->ptr_in[i]))); - dim = TCgetDim (ID_TYPE (EXPRS_EXPR (argtab->ptr_in[i]))); + ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); + dim = TCgetDim (ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); exprs = TBmakeExprs (TBmakeNum (shape), exprs); exprs = TBmakeExprs (TBmakeNum (dim), exprs); } @@ -2351,8 +2347,7 @@ MakeFunApArgs (node *ap, info *arg_info) if (fundef_argtab->ptr_out[0] == NULL) { icm_args = TBmakeExprs (TCmakeIdCopyString (NULL), icm_args); } else { - icm_args = TBmakeExprs (MakeBasetypeArg_NT (TYtype2OldType ( - RET_TYPE (fundef_argtab->ptr_out[0]))), + icm_args = TBmakeExprs (MakeBasetypeArg_NT (RET_TYPE (fundef_argtab->ptr_out[0])), icm_args); } } @@ -2614,24 +2609,24 @@ RhsId (node *arg_node, info *arg_info) && (FUNDEF_ISCUDAGLOBALFUN (fundef) || FUNDEF_ISCUDASTGLOBALFUN (fundef))) { ret_node = TCmakeAssignIcm2 ("CUDA_ASSIGN", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, MakeTypeArgs (ID_NAME (arg_node), - ID_TYPE (arg_node), FALSE, + ID_NTYPE (arg_node), FALSE, TRUE, FALSE, NULL)), TCmakeIdCopyString ( - GenericFun (GF_copy, ID_TYPE (arg_node))), + GenericFun (GF_copy, ID_NTYPE (arg_node))), ret_node); } else { ret_node = TCmakeAssignIcm2 ("ND_ASSIGN", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, MakeTypeArgs (ID_NAME (arg_node), - ID_TYPE (arg_node), FALSE, + ID_NTYPE (arg_node), FALSE, TRUE, FALSE, NULL)), TCmakeIdCopyString ( - GenericFun (GF_copy, ID_TYPE (arg_node))), + GenericFun (GF_copy, ID_NTYPE (arg_node))), ret_node); } } else { @@ -2961,7 +2956,7 @@ COMPtypedef (node *arg_node, info *arg_info) icm = TCmakeIcm1 ("ND_TYPEDEF", MakeTypeArgs (TYPEDEF_NAME (arg_node), - TYtype2OldType (TYPEDEF_NTYPE (arg_node)), + TYPEDEF_NTYPE (arg_node), TRUE, FALSE, FALSE, NULL)); TYPEDEF_ICM (arg_node) = icm; @@ -2993,12 +2988,12 @@ COMPobjdef (node *arg_node, info *arg_info) if (!OBJDEF_ISLOCAL (arg_node)) { icm = TCmakeIcm1 ("ND_OBJDEF_EXTERN", MakeTypeArgs (OBJDEF_NAME (arg_node), - TYtype2OldType (OBJDEF_TYPE (arg_node)), TRUE, + OBJDEF_TYPE (arg_node), TRUE, TRUE, FALSE, NULL)); } else { icm = TCmakeIcm1 ("ND_OBJDEF", MakeTypeArgs (OBJDEF_NAME (arg_node), - TYtype2OldType (OBJDEF_TYPE (arg_node)), TRUE, + OBJDEF_TYPE (arg_node), TRUE, TRUE, TRUE, NULL)); } OBJDEF_ICM (arg_node) = icm; @@ -3055,7 +3050,7 @@ COMPFundefArgs (node *fundef, info *arg_info) * AND IN FRONT OF THE DECLARATION ICMs!!! */ assigns = TCmakeAssignIcm1 ("ND_DECL__MIRROR_PARAM", - MakeTypeArgs (ARG_NAME (arg), ARG_TYPE (arg), + MakeTypeArgs (ARG_NAME (arg), ARG_NTYPE (arg), FALSE, TRUE, TRUE, NULL), assigns); @@ -3066,7 +3061,7 @@ COMPFundefArgs (node *fundef, info *arg_info) if (argtab->tag[i] == ATG_inout) { assigns = TCmakeAssignIcm1 ("ND_DECL_PARAM_inout", - MakeTypeArgs (ARG_NAME (arg), ARG_TYPE (arg), + MakeTypeArgs (ARG_NAME (arg), ARG_NTYPE (arg), TRUE, FALSE, FALSE, NULL), assigns); } @@ -3085,7 +3080,7 @@ AddDescParams (node *ops, node *params) if (ops != NULL) { if (WITHOP_SUB (ops) != NULL) { shape_class_t shapeClass - = NTUgetShapeClassFromTypes (ID_TYPE (WITHOP_SUB (ops))); + = NTUgetShapeClassFromTypes (ID_NTYPE (WITHOP_SUB (ops))); if (shapeClass == C_akd || shapeClass == C_aud) { node *arg2 = TBmakeExprs (TCmakeIcm2 ("SET_NT_USG", TCmakeIdCopyString ("TPA"), @@ -3422,20 +3417,20 @@ COMPvardec (node *arg_node, info *arg_info) && TCgetShapeDim (VARDEC_TYPE (arg_node)) > 0) { VARDEC_ICM (arg_node) = TCmakeIcm1 ("CUDA_DECL_KERNEL_ARRAY", - MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_TYPE (arg_node), + MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), TRUE, TRUE, TRUE, NULL)); } else if (FUNDEF_ISCUDAGLOBALFUN (INFO_FUNDEF (arg_info)) && CUisShmemTypeOld (VARDEC_TYPE (arg_node)) && TCgetShapeDim (VARDEC_TYPE (arg_node)) != 0) { VARDEC_ICM (arg_node) = TCmakeIcm1 ("CUDA_DECL_SHMEM_ARRAY", - MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_TYPE (arg_node), + MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), TRUE, TRUE, TRUE, NULL)); } else { if (VARDEC_INIT (arg_node) != NULL) { VARDEC_ICM (arg_node) = TCmakeIcm2 ("ND_DECL_CONST__DATA", - MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_TYPE (arg_node), + MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), TRUE, FALSE, FALSE, NULL), VARDEC_INIT (arg_node)); VARDEC_INIT (arg_node) = NULL; @@ -3443,18 +3438,18 @@ COMPvardec (node *arg_node, info *arg_info) && TYPEDEF_ISNESTED (TYPES_TDEF (VARDEC_TYPE (arg_node)))) { VARDEC_ICM (arg_node) = TCmakeIcm1 ("ND_DECL_NESTED", - MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_TYPE (arg_node), + MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), TRUE, TRUE, TRUE, NULL)); } else if (global.backend == BE_distmem && AVIS_DISTMEMSUBALLOC (VARDEC_AVIS (arg_node))) { VARDEC_ICM (arg_node) = TCmakeIcm1 ("ND_DSM_DECL", - MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_TYPE (arg_node), + MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), TRUE, TRUE, TRUE, NULL)); } else { VARDEC_ICM (arg_node) = TCmakeIcm1 ("ND_DECL", - MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_TYPE (arg_node), + MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), TRUE, TRUE, TRUE, NULL)); } } @@ -3464,7 +3459,7 @@ COMPvardec (node *arg_node, info *arg_info) INFO_VARDEC_INIT (arg_info) = TCmakeAssignIcm1 ("MUTC_INIT_SUBALLOC_DESC", MakeTypeArgs (VARDEC_NAME (arg_node), - VARDEC_TYPE (arg_node), FALSE, FALSE, FALSE, + VARDEC_NTYPE (arg_node), FALSE, FALSE, FALSE, NULL), INFO_VARDEC_INIT (arg_info)); } @@ -3953,14 +3948,14 @@ COMPApIds (node *ap, info *arg_info) if (global.argtag_is_out[tag]) { /* it is an out- (but no inout-) parameter */ if (!global.argtag_has_rc[tag]) { /* function does no refcounting */ - ret_node = MakeSetRcIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), 1, + ret_node = MakeSetRcIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), 1, ret_node); } } ret_node = TCmakeAssignIcm1 ("ND_REFRESH__MIRROR", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, NULL), ret_node); @@ -3968,7 +3963,7 @@ COMPApIds (node *ap, info *arg_info) if (!global.argtag_has_shp[tag]) { /* function sets no shape information */ shape_class_t sc = NTUgetShapeClassFromTypes ( - IDS_TYPE (((node *)argtab->ptr_out[i]))); + IDS_NTYPE (((node *)argtab->ptr_out[i]))); DBUG_ASSERT (sc != C_unknowns, "illegal data class found!"); if ((sc == C_akd) || (sc == C_aud)) { CTIabortLine (global.linenum, @@ -3982,7 +3977,7 @@ COMPApIds (node *ap, info *arg_info) if (!global.argtag_has_desc[tag]) { /* function uses no descriptor at all */ ret_node - = MakeAllocDescIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), 1, + = MakeAllocDescIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), 1, /* dim should be statically known: */ NULL, ret_node); } @@ -4041,7 +4036,7 @@ AddDescArgs (node *ops, node *args) if (ops != NULL) { if (WITHOP_SUB (ops) != NULL) { shape_class_t shapeClass - = NTUgetShapeClassFromTypes (ID_TYPE (WITHOP_SUB (ops))); + = NTUgetShapeClassFromTypes (ID_NTYPE (WITHOP_SUB (ops))); if (shapeClass == C_akd || shapeClass == C_aud) { node *newArg = TBmakeExprs (TCmakeIdCopyString ("in_justdesc"), @@ -4879,7 +4874,7 @@ COMPprfSyncIn (node *arg_node, info *arg_info) if (global.backend == BE_mutc) { ret_node = TCmakeAssignIcm1 ("ND_REFRESH__MIRROR", MakeTypeArgs (IDS_NAME (INFO_LASTIDS (arg_info)), - IDS_TYPE (INFO_LASTIDS (arg_info)), + IDS_NTYPE (INFO_LASTIDS (arg_info)), FALSE, TRUE, FALSE, NULL), ret_node); @@ -5012,9 +5007,9 @@ COMPprfFromUnq (node *arg_node, info *arg_info) * C-function!! */ - lhs_type = IDS_TYPE (let_ids); + lhs_type = IDS_NTYPE (let_ids); DBUG_ASSERT (!TCisUnique (lhs_type), "from_unq() with unique LHS found!"); - rhs_type = ID_TYPE (arg); + rhs_type = ID_NTYPE (arg); if (!TCisUnique (rhs_type)) { /* @@ -5025,11 +5020,11 @@ COMPprfFromUnq (node *arg_node, info *arg_info) } else { ret_node = TCmakeAssignIcm1 ("ND_ASSIGN", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, TRUE, FALSE, NULL)), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg)))); + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg)))); } DBUG_RETURN (ret_node); @@ -5097,7 +5092,7 @@ static node * COMPprfEnclose (node *arg_node, info *arg_info) { node *let_ids; - types *lhs_type, *rhs_type; + ntype *lhs_type, *rhs_type; node *icm_args; node *ret_node, *arg; @@ -5107,8 +5102,8 @@ COMPprfEnclose (node *arg_node, info *arg_info) arg = PRF_ARG3 (arg_node); - lhs_type = IDS_TYPE (let_ids); - rhs_type = ID_TYPE (arg); + lhs_type = IDS_NTYPE (let_ids); + rhs_type = ID_NTYPE (arg); icm_args = MakeTypeArgs (IDS_NAME (let_ids), lhs_type, FALSE, TRUE, TRUE, @@ -5116,7 +5111,7 @@ COMPprfEnclose (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm1 ("ND_ENCLOSE", icm_args, NULL); - ret_node = MakeIncRcIcm (ID_NAME (arg), ID_TYPE (arg), 1, ret_node); + ret_node = MakeIncRcIcm (ID_NAME (arg), ID_NTYPE (arg), 1, ret_node); DBUG_RETURN (ret_node); } @@ -5539,7 +5534,7 @@ COMParray (node *arg_node, info *arg_info) if (ARRAY_AELEMS (arg_node) != NULL) { node *val0 = EXPRS_EXPR (ARRAY_AELEMS (arg_node)); if (NODE_TYPE (val0) == N_id) { - copyfun = GenericFun (GF_copy, ID_TYPE (val0)); + copyfun = GenericFun (GF_copy, ID_NTYPE (val0)); } else { copyfun = NULL; } @@ -5553,7 +5548,7 @@ COMParray (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm2 ("ND_CREATE__ARRAY__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, DUPdoDupTree (icm_args)), TCmakeIdCopyString (copyfun), ret_node); } @@ -5617,7 +5612,7 @@ static node * COMPprfIncRC (node *arg_node, info *arg_info) { char *name; - types *type; + ntype *type; node *ret_node = NULL; int num; @@ -5626,7 +5621,7 @@ COMPprfIncRC (node *arg_node, info *arg_info) switch (NODE_TYPE (PRF_ARG1 (arg_node))) { case N_id: name = ID_NAME (PRF_ARG1 (arg_node)); - type = ID_TYPE (PRF_ARG1 (arg_node)); + type = ID_NTYPE (PRF_ARG1 (arg_node)); num = NUM_VAL (PRF_ARG2 (arg_node)); ret_node = MakeIncRcIcm (name, type, num, NULL); @@ -5634,12 +5629,12 @@ COMPprfIncRC (node *arg_node, info *arg_info) case N_globobj: name = OBJDEF_NAME (GLOBOBJ_OBJDEF (PRF_ARG1 (arg_node))); - type = TYtype2OldType (OBJDEF_TYPE (GLOBOBJ_OBJDEF (PRF_ARG1 (arg_node)))); + type = OBJDEF_TYPE (GLOBOBJ_OBJDEF (PRF_ARG1 (arg_node))); num = NUM_VAL (PRF_ARG2 (arg_node)); ret_node = MakeIncRcIcm (name, type, num, NULL); - type = FREEfreeAllTypes (type); + type = TYfreeType (type); break; default: DBUG_UNREACHABLE ("1. Argument of inc_rc has wrong node type."); @@ -5664,7 +5659,7 @@ static node * COMPprfDecRC (node *arg_node, info *arg_info) { char *name; - types *type; + ntype *type; node *ret_node = NULL; int num; @@ -5673,7 +5668,7 @@ COMPprfDecRC (node *arg_node, info *arg_info) switch (NODE_TYPE (PRF_ARG1 (arg_node))) { case N_id: name = ID_NAME (PRF_ARG1 (arg_node)); - type = ID_TYPE (PRF_ARG1 (arg_node)); + type = ID_NTYPE (PRF_ARG1 (arg_node)); num = NUM_VAL (PRF_ARG2 (arg_node)); ret_node = MakeDecRcIcm (name, type, num, NULL); @@ -5681,12 +5676,12 @@ COMPprfDecRC (node *arg_node, info *arg_info) case N_globobj: name = OBJDEF_NAME (GLOBOBJ_OBJDEF (PRF_ARG1 (arg_node))); - type = TYtype2OldType (OBJDEF_TYPE (GLOBOBJ_OBJDEF (PRF_ARG1 (arg_node)))); + type = OBJDEF_TYPE (GLOBOBJ_OBJDEF (PRF_ARG1 (arg_node))); num = NUM_VAL (PRF_ARG2 (arg_node)); ret_node = MakeDecRcIcm (name, type, num, NULL); - type = FREEfreeAllTypes (type); + type = TYfreeType (type); break; default: DBUG_UNREACHABLE ("1. Argument of dec_rc has wrong node type."); @@ -5779,7 +5774,7 @@ COMPprf2asyncrc (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm1 ("ND_REFRESH__MIRROR", MakeTypeArgs (IDS_NAME (INFO_LASTIDS (arg_info)), - IDS_TYPE (INFO_LASTIDS (arg_info)), FALSE, + IDS_NTYPE (INFO_LASTIDS (arg_info)), FALSE, TRUE, FALSE, NULL), ret_node); @@ -5825,7 +5820,7 @@ COMPprfAlloc (node *arg_node, info *arg_info) get_dim = MakeGetDimIcm (PRF_ARG2 (arg_node)); set_shape = MakeSetShapeIcm (PRF_ARG3 (arg_node), let_ids); - ret_node = MakeAllocIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), rc, get_dim, + ret_node = MakeAllocIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), rc, get_dim, set_shape, NULL, NULL); DBUG_RETURN (ret_node); @@ -5862,12 +5857,12 @@ COMPprfAllocOrReuse (node *arg_node, info *arg_info) get_dim = MakeGetDimIcm (PRF_ARG2 (arg_node)); set_shape = MakeSetShapeIcm (PRF_ARG3 (arg_node), let_ids); - ret_node = MakeAllocIcm_IncRc (IDS_NAME (let_ids), IDS_TYPE (let_ids), rc, get_dim, + ret_node = MakeAllocIcm_IncRc (IDS_NAME (let_ids), IDS_NTYPE (let_ids), rc, get_dim, set_shape, NULL, NULL); cand = EXPRS_EXPRS4 (PRF_ARGS (arg_node)); while (cand != NULL) { - ret_node = MakeCheckReuseIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), + ret_node = MakeCheckReuseIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), EXPRS_EXPR (cand), ret_node); cand = EXPRS_NEXT (cand); } @@ -5910,8 +5905,8 @@ COMPprfResize (node *arg_node, info *arg_info) DBUG_ASSERT (resizecand != NULL, "no source for resize found!"); ret_node - = MakeReAllocIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), ID_NAME (resizecand), - ID_TYPE (resizecand), rc, get_dim, set_shape, NULL, NULL); + = MakeReAllocIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), ID_NAME (resizecand), + ID_NTYPE (resizecand), rc, get_dim, set_shape, NULL, NULL); DBUG_RETURN (ret_node); } @@ -5952,21 +5947,21 @@ COMPprfAllocOrResize (node *arg_node, info *arg_info) * We have to do the incrc explicitly, as we do not know whether * we use the allocated or resized data. */ - ret_node = MakeIncRcIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), rc, ret_node); + ret_node = MakeIncRcIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), rc, ret_node); if (cand != NULL) { ret_node = TCmakeAssignIcm1 ("SAC_IS_LASTREF__BLOCK_END", TCmakeIdCopyStringNt (ID_NAME (EXPRS_EXPR (cand)), - ID_TYPE (EXPRS_EXPR (cand))), + ID_NTYPE (EXPRS_EXPR (cand))), ret_node); } - ret_node = MakeAllocIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), + ret_node = MakeAllocIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), 0, /* done by explicit incrc */ get_dim, set_shape, NULL, ret_node); while (cand != NULL) { - ret_node = MakeCheckResizeIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), + ret_node = MakeCheckResizeIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), EXPRS_EXPR (cand), rc, DUPdoDupTree (get_dim), DUPdoDupTree (set_shape), ret_node); cand = EXPRS_NEXT (cand); @@ -5997,7 +5992,7 @@ COMPprfFree (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (PRF_ARG1 (arg_node)) != N_globobj, "Application of F_free to N_globobj detected!"); - ret_node = MakeSetRcIcm (ID_NAME (PRF_ARG1 (arg_node)), ID_TYPE (PRF_ARG1 (arg_node)), + ret_node = MakeSetRcIcm (ID_NAME (PRF_ARG1 (arg_node)), ID_NTYPE (PRF_ARG1 (arg_node)), 0, NULL); DBUG_RETURN (ret_node); @@ -6029,16 +6024,16 @@ COMPprfSuballoc (node *arg_node, info *arg_info) let_ids = INFO_LASTIDS (arg_info); mem_id = PRF_ARG1 (arg_node); - sc = NTUgetShapeClassFromTypes (IDS_TYPE (let_ids)); + sc = NTUgetShapeClassFromTypes (IDS_NTYPE (let_ids)); DBUG_ASSERT (sc != C_scl, "scalars cannot be suballocated\n"); if (INFO_WITHLOOP (arg_info) != NULL && WITH_CUDARIZABLE (INFO_WITHLOOP (arg_info))) { ret_node = TCmakeAssignIcm5 ("CUDA_WL_SUBALLOC", DUPdupIdsIdNt (let_ids), - TBmakeNum (TCgetShapeDim (IDS_TYPE (let_ids))), + TBmakeNum (TCgetShapeDim (IDS_NTYPE (let_ids))), DUPdupIdNt (PRF_ARG1 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG1 (arg_node)))), + TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG1 (arg_node)))), DUPdupIdNt (PRF_ARG2 (arg_node)), NULL); } else if (global.backend == BE_distmem) { ret_node = TCmakeAssignIcm3 ("WL_DISTMEM_SUBALLOC", DUPdupIdsIdNt (let_ids), @@ -6075,7 +6070,7 @@ COMPprfSuballoc (node *arg_node, info *arg_info) * information always has to be present! */ if (TCcountExprs (PRF_ARGS (arg_node)) >= 4) { - if (!KNOWN_SHAPE (TCgetShapeDim (IDS_TYPE (let_ids)))) { + if (!KNOWN_SHAPE (TCgetShapeDim (IDS_NTYPE (let_ids)))) { #if 0 /* Still may be present if not canonical */ DBUG_ASSERT (PRF_ARG4( arg_node) != NULL, "missing shape information for suballoc"); #endif @@ -6090,7 +6085,7 @@ COMPprfSuballoc (node *arg_node, info *arg_info) * * Allocate the desc local as it will not go out of scope */ - ret_node = MakeMutcLocalAllocDescIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), 1, + ret_node = MakeMutcLocalAllocDescIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), 1, sub_get_dim, ret_node); #if FREE_LOCAL /* Do not free local alloced stuff */ /* @@ -6100,7 +6095,7 @@ COMPprfSuballoc (node *arg_node, info *arg_info) INFO_POSTFUN (arg_info) = TCmakeAssignIcm1 ("ND_FREE__DESC", TCmakeIdCopyStringNt (IDS_NAME (let_ids), - IDS_TYPE (let_ids)), + IDS_NTYPE (let_ids)), INFO_POSTFUN (arg_info)); #endif } @@ -6137,16 +6132,16 @@ COMPprfWLAssign (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm6 ("WL_ASSIGN", MakeTypeArgs (ID_NAME (PRF_ARG1 (arg_node)), - ID_TYPE (PRF_ARG1 (arg_node)), FALSE, TRUE, FALSE, + ID_NTYPE (PRF_ARG1 (arg_node)), FALSE, TRUE, FALSE, NULL), MakeTypeArgs (ID_NAME (PRF_ARG2 (arg_node)), - ID_TYPE (PRF_ARG2 (arg_node)), FALSE, TRUE, FALSE, + ID_NTYPE (PRF_ARG2 (arg_node)), FALSE, TRUE, FALSE, NULL), arg3, TBmakeExprs (MakeSizeArg (PRF_ARG3 (arg_node), TRUE), NULL), DUPdupIdNt (PRF_ARG4 (arg_node)), TCmakeIdCopyString ( - GenericFun (GF_copy, ID_TYPE (PRF_ARG1 (arg_node)))), + GenericFun (GF_copy, ID_NTYPE (PRF_ARG1 (arg_node)))), NULL); DBUG_RETURN (ret_node); @@ -6174,10 +6169,10 @@ COMPprfCUDAWLAssign (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm3 ("CUDA_WL_ASSIGN", MakeTypeArgs (ID_NAME (PRF_ARG1 (arg_node)), - ID_TYPE (PRF_ARG1 (arg_node)), FALSE, TRUE, + ID_NTYPE (PRF_ARG1 (arg_node)), FALSE, TRUE, FALSE, NULL), MakeTypeArgs (ID_NAME (PRF_ARG2 (arg_node)), - ID_TYPE (PRF_ARG2 (arg_node)), FALSE, TRUE, + ID_NTYPE (PRF_ARG2 (arg_node)), FALSE, TRUE, FALSE, NULL), DUPdupIdNt (PRF_ARG3 (arg_node)), NULL); @@ -6240,10 +6235,10 @@ COMPprfCUDAWLIdxs (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm4 ("CUDA_WLIDXS", MakeTypeArgs (ID_NAME (PRF_ARG1 (arg_node)), - ID_TYPE (PRF_ARG1 (arg_node)), FALSE, TRUE, FALSE, + ID_NTYPE (PRF_ARG1 (arg_node)), FALSE, TRUE, FALSE, NULL), MakeTypeArgs (ID_NAME (PRF_ARG2 (arg_node)), - ID_TYPE (PRF_ARG2 (arg_node)), FALSE, FALSE, + ID_NTYPE (PRF_ARG2 (arg_node)), FALSE, FALSE, FALSE, NULL), TBmakeNum (array_dim), DupExprs_NT_AddReadIcms (EXPRS_EXPRS4 (PRF_ARGS (arg_node))), @@ -6271,10 +6266,10 @@ COMPprfCUDAWLIds (node *arg_node, info *arg_info) dim_pos = NUM_VAL (PRF_ARG1 (arg_node)); ret_node = TCmakeAssignIcm5 ("CUDA_WLIDS", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, NULL), TBmakeNum (array_dim), TBmakeNum (dim_pos), - MakeTypeArgs (ID_NAME (iv), ID_TYPE (iv), FALSE, FALSE, FALSE, + MakeTypeArgs (ID_NAME (iv), ID_NTYPE (iv), FALSE, FALSE, FALSE, NULL), TBmakeBool (FUNDEF_HASSTEPWIDTHARGS (INFO_FUNDEF (arg_info))), NULL); @@ -6319,7 +6314,7 @@ COMPprfWLBreak (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm3 ("ND_ASSIGN__DATA", DUPdupIdNt (PRF_ARG2 (arg_node)), DUPdupIdNt (PRF_ARG1 (arg_node)), TCmakeIdCopyString ( - GenericFun (GF_copy, ID_TYPE (PRF_ARG1 (arg_node)))), + GenericFun (GF_copy, ID_NTYPE (PRF_ARG1 (arg_node)))), NULL); DBUG_RETURN (ret_node); @@ -6353,13 +6348,13 @@ COMPprfCopy (node *arg_node, info *arg_info) = TCmakeAssignIcm3 ("ND_COPY__DATA", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), TCmakeIdCopyString ( - GenericFun (GF_copy, ID_TYPE (PRF_ARG1 (arg_node)))), + GenericFun (GF_copy, ID_NTYPE (PRF_ARG1 (arg_node)))), NULL); } else { - src_basetype = TCgetBasetype (ID_TYPE (PRF_ARG1 (arg_node))); - dst_basetype = TCgetBasetype (IDS_TYPE (let_ids)); + src_basetype = TCgetBasetype (ID_NTYPE (PRF_ARG1 (arg_node))); + dst_basetype = TCgetBasetype (IDS_NTYPE (let_ids)); - if (CUisDeviceTypeOld (ID_TYPE (PRF_ARG1 (arg_node))) + if (CUisDeviceTypeOld (ID_NTYPE (PRF_ARG1 (arg_node))) && (src_basetype == dst_basetype) && !FUNDEF_ISCUDAGLOBALFUN (INFO_FUNDEF (arg_info))) { ret_node @@ -6367,14 +6362,14 @@ COMPprfCopy (node *arg_node, info *arg_info) DUPdupIdNt (PRF_ARG1 (arg_node)), MakeBasetypeArg (ID_NTYPE (PRF_ARG1 (arg_node))), TCmakeIdCopyString ( - GenericFun (GF_copy, ID_TYPE (PRF_ARG1 (arg_node)))), + GenericFun (GF_copy, ID_NTYPE (PRF_ARG1 (arg_node)))), NULL); } else { ret_node = TCmakeAssignIcm3 ("ND_COPY__DATA", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), TCmakeIdCopyString ( - GenericFun (GF_copy, ID_TYPE (PRF_ARG1 (arg_node)))), + GenericFun (GF_copy, ID_NTYPE (PRF_ARG1 (arg_node)))), NULL); } } @@ -6439,9 +6434,9 @@ COMPprfDim (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg) == N_id, "arg of F_dim_A is no N_id!"); ret_node = TCmakeAssignIcm1 ("ND_PRF_DIM_A__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, TRUE, FALSE, NULL)), NULL); @@ -6476,9 +6471,9 @@ COMPprfIsDist (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg) == N_id, "arg of F_isDist_A is no N_id!"); ret_node = TCmakeAssignIcm1 ("ND_PRF_IS_DIST_A__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, FALSE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, FALSE, FALSE, NULL)), NULL); @@ -6513,9 +6508,9 @@ COMPprfFirstElems (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg) == N_id, "arg of F_firstElems_A is no N_id!"); ret_node = TCmakeAssignIcm1 ("ND_PRF_FIRST_ELEMS_A__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, FALSE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, FALSE, FALSE, NULL)), NULL); @@ -6550,9 +6545,9 @@ COMPprfLocalFrom (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg) == N_id, "arg of F_localFrom_A is no N_id!"); ret_node = TCmakeAssignIcm1 ("ND_PRF_LOCAL_FROM_A__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, FALSE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, FALSE, FALSE, NULL)), NULL); @@ -6587,9 +6582,9 @@ COMPprfLocalCount (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg) == N_id, "arg of F_localCount_A is no N_id!"); ret_node = TCmakeAssignIcm1 ("ND_PRF_LOCAL_COUNT_A__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, FALSE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, FALSE, FALSE, NULL)), NULL); @@ -6624,9 +6619,9 @@ COMPprfOffs (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg) == N_id, "arg of F_offs_A is no N_id!"); ret_node = TCmakeAssignIcm1 ("ND_PRF_OFFS_A__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, FALSE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, FALSE, FALSE, NULL)), NULL); @@ -6661,9 +6656,9 @@ COMPprfShape (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg) == N_id, "arg of F_shape_A is no N_id!"); ret_node = TCmakeAssignIcm1 ("ND_PRF_SHAPE_A__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, TRUE, FALSE, NULL)), NULL); @@ -6698,9 +6693,9 @@ COMPprfSize (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg) == N_id, "arg of F_size_A is no N_id!"); ret_node = TCmakeAssignIcm1 ("ND_PRF_SIZE_A__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg), ID_TYPE (arg), + MakeTypeArgs (ID_NAME (arg), ID_NTYPE (arg), FALSE, TRUE, FALSE, NULL)), NULL); @@ -6762,11 +6757,11 @@ COMPprfReshape (node *arg_node, info *arg_info) #if 1 /* Is this correct? Or do we have to take the rhs instead? */ - copyfun = GenericFun (GF_copy, IDS_TYPE (let_ids)); + copyfun = GenericFun (GF_copy, IDS_NTYPE (let_ids)); #endif ret_node - = MakeSetRcIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), rc, + = MakeSetRcIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), rc, TBmakeAssign (set_shape_icm, TCmakeAssignIcm3 ("ND_ASSIGN__DATA", DUPdupIdsIdNt (let_ids), @@ -6774,8 +6769,8 @@ COMPprfReshape (node *arg_node, info *arg_info) TCmakeIdCopyString (copyfun), ret_node))); - dim_new = TCgetDim (IDS_TYPE (let_ids)); - dim_old = TCgetDim (ID_TYPE (PRF_ARG4 (arg_node))); + dim_new = TCgetDim (IDS_NTYPE (let_ids)); + dim_old = TCgetDim (ID_NTYPE (PRF_ARG4 (arg_node))); if ((dim_new >= 0) && (dim_old >= 0) && (dim_new <= dim_old)) { /* @@ -6785,7 +6780,7 @@ COMPprfReshape (node *arg_node, info *arg_info) DUPdupIdNt (PRF_ARG4 (arg_node)), ret_node); } else if (global.backend == BE_distmem) { ret_node = MakeAllocDescIcm ( - IDS_NAME (let_ids), IDS_TYPE (let_ids), rc, MakeGetDimIcm (PRF_ARG2 (arg_node)), + IDS_NAME (let_ids), IDS_NTYPE (let_ids), rc, MakeGetDimIcm (PRF_ARG2 (arg_node)), TCmakeAssignIcm2 ("ND_COPY__DESC_DIS_FIELDS", DUPdupIdNt (PRF_ARG4 (arg_node)), DUPdupIdsIdNt (let_ids), TCmakeAssignIcm1 ("ND_FREE__DESC", @@ -6797,7 +6792,7 @@ COMPprfReshape (node *arg_node, info *arg_info) ret_node)))); } else { ret_node - = MakeAllocDescIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), rc, + = MakeAllocDescIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), rc, MakeGetDimIcm (PRF_ARG2 (arg_node)), TCmakeAssignIcm1 ("ND_FREE__DESC", DUPdupIdNt (PRF_ARG4 (arg_node)), @@ -6846,10 +6841,10 @@ COMPprfAllocOrReshape (node *arg_node, info *arg_info) "IS_LASTREF__BLOCK_BEGIN", DUPdupIdNt (PRF_ARG4 (arg_node)), TCappendAssign ( COMPprfReshape (arg_node, arg_info), - MakeIncRcIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), rc, + MakeIncRcIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), rc, TCmakeAssignIcm1 ( "IS_LASTREF__BLOCK_ELSE", DUPdupIdNt (PRF_ARG4 (arg_node)), - MakeAllocIcm (IDS_NAME (let_ids), IDS_TYPE (let_ids), rc, get_dim, + MakeAllocIcm (IDS_NAME (let_ids), IDS_NTYPE (let_ids), rc, get_dim, set_shape_icm, NULL, TCmakeAssignIcm1 ("IS_LASTREF__BLOCK_END", DUPdupIdNt (PRF_ARG4 (arg_node)), @@ -6894,11 +6889,11 @@ COMPprfIdxSel (node *arg_node, info *arg_info) "1st arg of F_idx_sel is neither N_id nor N_num, N_prf!"); DBUG_ASSERT (NODE_TYPE (arg2) == N_id, "2nd arg of F_idx_sel is no N_id!"); - icm_args = MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, FALSE, + icm_args = MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupNodeNt (arg1), NULL)); /* idx_sel() works only for arrays with known dimension!!! */ - dim = TCgetDim (IDS_TYPE (let_ids)); + dim = TCgetDim (IDS_NTYPE (let_ids)); DBUG_ASSERT (dim >= 0, "unknown dimension found!"); /* The ICM depends on whether we use the distributed memory backend @@ -6910,9 +6905,9 @@ COMPprfIdxSel (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm2 (icm_name, - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, DUPdoDupTree (icm_args)), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg2))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg2))), NULL); DBUG_RETURN (ret_node); @@ -6954,39 +6949,39 @@ COMPprfIdxModarray_AxSxS (node *arg_node, info *arg_info) || (NODE_TYPE (arg2) == N_prf)), "2nd arg of F_idx_modarray_AxSxS is neither N_id nor N_num, N_prf!"); DBUG_ASSERT (((NODE_TYPE (arg2) != N_id) - || (TCgetBasetype (ID_TYPE (arg2)) == T_int)), + || (TCgetBasetype (ID_NTYPE (arg2)) == T_int)), "2nd arg of F_idx_modarray_AxSxS is a illegal indexing var!"); DBUG_ASSERT (NODE_TYPE (arg3) != N_array, "3rd arg of F_idx_modarray_AxSxS is a N_array!"); /* if( global.backend == BE_cuda && - ( TCgetBasetype( ID_TYPE( arg1)) == T_float_dev || - TCgetBasetype( ID_TYPE( arg1)) == T_int_dev) && + ( TCgetBasetype( ID_NTYPE( arg1)) == T_float_dev || + TCgetBasetype( ID_NTYPE( arg1)) == T_int_dev) && !FUNDEF_ISCUDAGLOBALFUN( INFO_FUNDEF( arg_info))) { ret_node = TCmakeAssignIcm4( "CUDA_PRF_IDX_MODARRAY_AxSxS__DATA", MakeTypeArgs( IDS_NAME( let_ids), - IDS_TYPE( let_ids), + IDS_NTYPE( let_ids), FALSE, TRUE, FALSE, MakeTypeArgs( ID_NAME( arg1), - ID_TYPE( arg1), + ID_NTYPE( arg1), FALSE, TRUE, FALSE, NULL)), DUPdupNodeNt( arg2), DUPdupNodeNt( arg3), - MakeBasetypeArg( ID_TYPE(arg1)), + MakeBasetypeArg( ID_NTYPE(arg1)), NULL); } else { */ ret_node = TCmakeAssignIcm4 ("ND_PRF_IDX_MODARRAY_AxSxS__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, NULL)), DUPdupNodeNt (arg2), DUPdupNodeNt (arg3), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg1))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg1))), NULL); /* } @@ -7030,31 +7025,31 @@ COMPprfIdxModarray_AxSxA (node *arg_node, info *arg_info) || (NODE_TYPE (arg2) == N_prf)), "2nd arg of F_idx_modarray_AxSxA is neither N_id nor N_num, N_prf!"); DBUG_ASSERT (((NODE_TYPE (arg2) != N_id) - || (TCgetBasetype (ID_TYPE (arg2)) == T_int)), + || (TCgetBasetype (ID_NTYPE (arg2)) == T_int)), "2nd arg of F_idx_modarray_AxSxA is a illegal indexing var!"); DBUG_ASSERT (NODE_TYPE (arg3) != N_array, "3rd arg of F_idx_modarray_AxSxA is a N_array!"); if ((global.backend == BE_cuda || global.backend == BE_cudahybrid) - && CUisDeviceTypeOld (ID_TYPE (arg1)) && CUisDeviceTypeOld (ID_TYPE (arg3)) + && CUisDeviceTypeOld (ID_NTYPE (arg1)) && CUisDeviceTypeOld (ID_NTYPE (arg3)) && !FUNDEF_ISCUDAGLOBALFUN (INFO_FUNDEF (arg_info))) { ret_node = TCmakeAssignIcm4 ("CUDA_PRF_IDX_MODARRAY_AxSxA__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, NULL)), DUPdupNodeNt (arg2), DUPdupNodeNt (arg3), MakeBasetypeArg (ID_NTYPE (arg1)), NULL); } else { ret_node = TCmakeAssignIcm4 ("ND_PRF_IDX_MODARRAY_AxSxA__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, NULL)), DUPdupNodeNt (arg2), DUPdupNodeNt (arg3), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg1))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg1))), NULL); } @@ -7091,9 +7086,9 @@ COMPprfIdxShapeSel (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg2) == N_id, "2nd arg of F_idx_shape_sel is no N_id!"); ret_node = TCmakeAssignIcm3 ("ND_PRF_IDX_SHAPE_SEL__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, NULL), - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, NULL), TBmakeExprs (DUPdupNodeNt (arg1), NULL), NULL); @@ -7145,12 +7140,12 @@ COMPprfSel (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg2) == N_id, "2nd arg of F_sel_VxA is no N_id!"); if (NODE_TYPE (arg1) == N_id) { - DBUG_ASSERT (TCgetBasetype (ID_TYPE (arg1)) == T_int, + DBUG_ASSERT (TCgetBasetype (ID_NTYPE (arg1)) == T_int, "1st arg of F_sel_VxA is a illegal indexing var!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupIdNt (arg1), NULL))); /* The ICM depends on whether we use the distributed memory backend @@ -7162,7 +7157,7 @@ COMPprfSel (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm3 (icm_name, DUPdoDupTree (icm_args), MakeSizeArg (arg1, TRUE), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg2))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg2))), NULL); } else { node *type_args; @@ -7171,12 +7166,12 @@ COMPprfSel (node *arg_node, info *arg_info) "1st arg of F_sel_VxA is neither N_id nor N_array!"); type_args - = MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, FALSE, + = MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (MakeSizeArg (arg1, TRUE), TCappendExprs (DUPdupExprsNt (ARRAY_AELEMS (arg1)), NULL))); - icm_args = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, + icm_args = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, type_args); /* The ICM depends on whether we use the distributed memory backend @@ -7188,7 +7183,7 @@ COMPprfSel (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm2 (icm_name, DUPdoDupTree (icm_args), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg2))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg2))), NULL); } @@ -7237,18 +7232,18 @@ COMPsimd_prfSel (node *arg_node, info *arg_info) base_type_node = TCmakeIdCopyString (GetBaseTypeFromExpr (arg2)); if (NODE_TYPE (arg1) == N_id) { - DBUG_ASSERT (TCgetBasetype (ID_TYPE (arg1)) == T_int, + DBUG_ASSERT (TCgetBasetype (ID_NTYPE (arg1)) == T_int, "1st arg of F_sel_VxA is a illegal indexing var!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupIdNt (arg1), NULL))); ret_node = TCmakeAssignIcm5 ("ND_PRF_SIMD_SEL_VxA__DATA_id", DUPdoDupTree (icm_args), MakeSizeArg (arg1, TRUE), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg2))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg2))), simd_length, base_type_node, NULL); } else { node *type_args; @@ -7257,17 +7252,17 @@ COMPsimd_prfSel (node *arg_node, info *arg_info) "1st arg of F_sel_VxA is neither N_id nor N_array!"); type_args - = MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, FALSE, + = MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (MakeSizeArg (arg1, TRUE), TCappendExprs (DUPdupExprsNt (ARRAY_AELEMS (arg1)), NULL))); - icm_args = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, + icm_args = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, type_args); ret_node = TCmakeAssignIcm4 ("ND_PRF_SIMD_SEL_VxA__DATA_arr", DUPdoDupTree (icm_args), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg2))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg2))), simd_length, base_type_node, NULL); } @@ -7369,18 +7364,18 @@ COMPprfSelI (node *arg_node, info *arg_info) arg2 = PRF_ARG2 (arg_node); if (NODE_TYPE (arg1) == N_id) { - DBUG_ASSERT ((TCgetBasetype (ID_TYPE (arg1)) == T_int), + DBUG_ASSERT ((TCgetBasetype (ID_NTYPE (arg1)) == T_int), "1st arg of F_sel_VxA is a illegal indexing var!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupIdNt (arg1), NULL))); ret_node = TCmakeAssignIcm3 ("ND_PRF_SEL_VxIA__DATA_id", DUPdoDupTree (icm_args), MakeSizeArg (arg1, TRUE), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg2))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg2))), NULL); } else { ret_node = (node *)NULL; @@ -7436,18 +7431,18 @@ COMPprfModarray_AxVxS (node *arg_node, info *arg_info) "3rd arg of F_modarray_AxVxS is a N_array!"); if (NODE_TYPE (arg2) == N_id) { - DBUG_ASSERT ((TCgetBasetype (ID_TYPE (arg2)) == T_int), + DBUG_ASSERT ((TCgetBasetype (ID_NTYPE (arg2)) == T_int), "2nd arg of F_modarray_AxVxS is a illegal indexing var!"); ret_node = TCmakeAssignIcm5 ("ND_PRF_MODARRAY_AxVxS__DATA_id", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, NULL)), DUPdupNodeNt (arg2), MakeSizeArg (arg2, TRUE), DUPdupNodeNt (arg3), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg1))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg1))), NULL); } else { DBUG_ASSERT (NODE_TYPE (arg2) == N_array, @@ -7455,13 +7450,13 @@ COMPprfModarray_AxVxS (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm5 ("ND_PRF_MODARRAY_AxVxS__DATA_arr", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, NULL)), MakeSizeArg (arg2, TRUE), DUPdupExprsNt (ARRAY_AELEMS (arg2)), DUPdupNodeNt (arg3), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg1))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg1))), NULL); } @@ -7502,18 +7497,18 @@ COMPprfModarray_AxVxA (node *arg_node, info *arg_info) "3rd arg of F_modarray_AxVxA is a N_array!"); if (NODE_TYPE (arg2) == N_id) { - DBUG_ASSERT ((TCgetBasetype (ID_TYPE (arg2)) == T_int), + DBUG_ASSERT ((TCgetBasetype (ID_NTYPE (arg2)) == T_int), "2nd arg of F_modarray_AxVxA is a illegal indexing var!"); ret_node = TCmakeAssignIcm5 ("ND_PRF_MODARRAY_AxVxA__DATA_id", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, NULL)), DUPdupNodeNt (arg2), MakeSizeArg (arg2, TRUE), DUPdupNodeNt (arg3), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg1))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg1))), NULL); } else { DBUG_ASSERT (NODE_TYPE (arg2) == N_array, @@ -7521,13 +7516,13 @@ COMPprfModarray_AxVxA (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm5 ("ND_PRF_MODARRAY_AxVxA__DATA_arr", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, NULL)), MakeSizeArg (arg2, TRUE), DUPdupExprsNt (ARRAY_AELEMS (arg2)), DUPdupNodeNt (arg3), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg1))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg1))), NULL); } @@ -7599,13 +7594,13 @@ COMPprfTake (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg2) == N_id, "2nd arg of F_take_SxV is no N_id!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, FALSE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupNodeNt (arg1), NULL))); ret_node = TCmakeAssignIcm2 ("ND_PRF_TAKE_SxV__DATA", DUPdoDupTree (icm_args), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg2))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg2))), NULL); DBUG_RETURN (ret_node); @@ -7643,13 +7638,13 @@ COMPprfDrop (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg2) == N_id, "2nd arg of F_drop_SxV is no N_id!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, TRUE, FALSE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupNodeNt (arg1), NULL))); ret_node = TCmakeAssignIcm2 ("ND_PRF_DROP_SxV__DATA", DUPdoDupTree (icm_args), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (arg2))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (arg2))), NULL); DBUG_RETURN (ret_node); @@ -7687,13 +7682,13 @@ COMPprfCat (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg2) == N_id, "2nd arg of F_cat_VxV is no N_id!"); icm_args - = MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg1), ID_TYPE (arg1), FALSE, TRUE, FALSE, - MakeTypeArgs (ID_NAME (arg2), ID_TYPE (arg2), FALSE, + = MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, + MakeTypeArgs (ID_NAME (arg1), ID_NTYPE (arg1), FALSE, TRUE, FALSE, + MakeTypeArgs (ID_NAME (arg2), ID_NTYPE (arg2), FALSE, TRUE, FALSE, NULL))); - copyfun1 = GenericFun (GF_copy, ID_TYPE (arg1)); - copyfun2 = GenericFun (GF_copy, ID_TYPE (arg2)); + copyfun1 = GenericFun (GF_copy, ID_NTYPE (arg1)); + copyfun2 = GenericFun (GF_copy, ID_NTYPE (arg2)); DBUG_ASSERT ((((copyfun1 == NULL) && (copyfun2 == NULL)) || STReq (copyfun1, copyfun2)), "F_cat_VxV: different copyfuns found!"); @@ -7731,7 +7726,7 @@ COMPprfOp_S (node *arg_node, info *arg_info) /* assure that the prf has exactly one argument */ DBUG_ASSERT (PRF_EXPRS2 (arg_node) == NULL, "more than a single argument found!"); - DBUG_ASSERT (NODE_TYPE (arg) != N_id || TCgetShapeDim (ID_TYPE (arg)) == SCALAR, + DBUG_ASSERT (NODE_TYPE (arg) != N_id || TCgetShapeDim (ID_NTYPE (arg)) == SCALAR, "non-scalar argument `%s' found!", global.prf_name[PRF_PRF (arg_node)]); /* If enforce float flag is set, we change all tods to tofs */ @@ -7848,12 +7843,12 @@ COMPprfOp_SxS (node *arg_node, info *arg_info) arg2 = PRF_ARG2 (arg_node); DBUG_ASSERT (((NODE_TYPE (arg1) != N_id) - || (TCgetShapeDim (ID_TYPE (arg1)) == SCALAR)), + || (TCgetShapeDim (ID_NTYPE (arg1)) == SCALAR)), "%s: non-scalar first argument found!", global.prf_name[PRF_PRF (arg_node)]); DBUG_ASSERT (((NODE_TYPE (arg2) != N_id) - || (TCgetShapeDim (ID_TYPE (arg2)) == SCALAR)), + || (TCgetShapeDim (ID_NTYPE (arg2)) == SCALAR)), "%s: non-scalar second argument found!", global.prf_name[PRF_PRF (arg_node)]); @@ -7887,7 +7882,7 @@ COMPprfOp_SxS (node *arg_node, info *arg_info) } else if (NODE_TYPE (arg1) == N_double) { ty_str = "T_double"; } else if (NODE_TYPE (arg1) == N_id) { - stype = TCgetBasetype (ID_TYPE (arg1)); + stype = TCgetBasetype (ID_NTYPE (arg1)); if (stype == T_int) { ty_str = "T_int"; } else if (stype == T_float) { @@ -7941,7 +7936,7 @@ COMPprfOp_SxV (node *arg_node, info *arg_info) arg2 = PRF_ARG2 (arg_node); DBUG_ASSERT (((NODE_TYPE (arg1) != N_id) - || (TCgetShapeDim (ID_TYPE (arg1)) == SCALAR)), + || (TCgetShapeDim (ID_NTYPE (arg1)) == SCALAR)), "%s: non-scalar first argument found!", global.prf_name[PRF_PRF (arg_node)]); @@ -7984,7 +7979,7 @@ COMPprfOp_VxS (node *arg_node, info *arg_info) arg2 = PRF_ARG2 (arg_node); DBUG_ASSERT (((NODE_TYPE (arg2) != N_id) - || (TCgetShapeDim (ID_TYPE (arg2)) == SCALAR)), + || (TCgetShapeDim (ID_NTYPE (arg2)) == SCALAR)), "%s: non-scalar second argument found!", global.prf_name[PRF_PRF (arg_node)]); ret_node = TCmakeAssignIcm3 ("ND_PRF_VxS__DATA", DUPdupIdsIdNt (let_ids), @@ -8287,12 +8282,12 @@ COMPprfUnshare (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm4 ("ND_UNSHARE", /* C-ICM */ - MakeTypeArgs (ID_NAME (accu_id), ID_TYPE (accu_id), FALSE, + MakeTypeArgs (ID_NAME (accu_id), ID_NTYPE (accu_id), FALSE, TRUE, FALSE, NULL), - MakeTypeArgs (ID_NAME (iv_id), ID_TYPE (iv_id), FALSE, TRUE, + MakeTypeArgs (ID_NAME (iv_id), ID_NTYPE (iv_id), FALSE, TRUE, FALSE, NULL), MakeBasetypeArg (ID_NTYPE (iv_id)), - TCmakeIdCopyString (GenericFun (GF_copy, ID_TYPE (iv_id))), + TCmakeIdCopyString (GenericFun (GF_copy, ID_NTYPE (iv_id))), ret_node); } @@ -8403,13 +8398,13 @@ COMPprfArrayVect2Offset (node *arg_node, info *arg_info) "First argument of F_array_vect2offset must be an N_id Node!"); icm = TCmakeIcm5 ("ND_ARRAY_VECT2OFFSET_id", DUPdupIdsIdNt (let_ids), - TBmakeNum (TCgetTypesLength (ID_TYPE (iv_vect))), + TBmakeNum (TCgetTypesLength (ID_NTYPE (iv_vect))), DUPdupIdNt (iv_vect), MakeDimArg (PRF_ARG1 (arg_node), TRUE), DUPdupIdNt (PRF_ARG1 (arg_node))); /* icm = TCmakeIcm5( "ND_VECT2OFFSET_id", DUPdupIdsIdNt( let_ids), - TBmakeNum( TCgetTypesLength( ID_TYPE( iv_vect))), + TBmakeNum( TCgetTypesLength( ID_NTYPE( iv_vect))), DUPdupIdNt( iv_vect), MakeSizeArg( PRF_ARG1( arg_node), TRUE), DUPdupIdNt( PRF_ARG1( arg_node))); @@ -8444,12 +8439,12 @@ COMPprfVect2Offset (node *arg_node, info *arg_info) */ if (NODE_TYPE (PRF_ARG1 (arg_node)) == N_array) { icm = TCmakeIcm5 ("ND_VECT2OFFSET_arr", DUPdupIdsIdNt (let_ids), - TBmakeNum (TCgetTypesLength (ID_TYPE (iv_vect))), + TBmakeNum (TCgetTypesLength (ID_NTYPE (iv_vect))), DUPdupIdNt (iv_vect), MakeSizeArg (PRF_ARG1 (arg_node), TRUE), DupExprs_NT_AddReadIcms (ARRAY_AELEMS (PRF_ARG1 (arg_node)))); } else if (NODE_TYPE (PRF_ARG1 (arg_node)) == N_id) { icm = TCmakeIcm5 ("ND_VECT2OFFSET_id", DUPdupIdsIdNt (let_ids), - TBmakeNum (TCgetTypesLength (ID_TYPE (iv_vect))), + TBmakeNum (TCgetTypesLength (ID_NTYPE (iv_vect))), DUPdupIdNt (iv_vect), MakeSizeArg (PRF_ARG1 (arg_node), TRUE), DUPdupIdNt (PRF_ARG1 (arg_node))); #ifndef DBUG_OFF @@ -8490,10 +8485,10 @@ COMPprfRunMtGenarray (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm3 ("ND_PRF_RUNMT_GENARRAY__DATA", /* result of the test: bool scalar */ - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, FALSE, FALSE, NULL), /* N_id from GENARRAY_MEM: */ - MakeTypeArgs (ID_NAME (mem_id), ID_TYPE (mem_id), FALSE, + MakeTypeArgs (ID_NAME (mem_id), ID_NTYPE (mem_id), FALSE, FALSE, FALSE, NULL), /* minimal parallel size. This is just global.min_parallel_size */ @@ -8530,10 +8525,10 @@ COMPprfRunMtModarray (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm3 ("ND_PRF_RUNMT_MODARRAY__DATA", /* result of the test: bool scalar */ - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, FALSE, FALSE, NULL), /* N_id from MODARRAY_MEM: */ - MakeTypeArgs (ID_NAME (mem_id), ID_TYPE (mem_id), FALSE, + MakeTypeArgs (ID_NAME (mem_id), ID_NTYPE (mem_id), FALSE, FALSE, FALSE, NULL), /* minimal parallel size. This is just global.min_parallel_size */ @@ -8567,7 +8562,7 @@ COMPprfRunMtFold (node *arg_node, info *arg_info) let_ids = INFO_LASTIDS (arg_info); ret_node = TCmakeAssignIcm1 ("ND_PRF_RUNMT_FOLD__DATA", - MakeTypeArgs (IDS_NAME (let_ids), IDS_TYPE (let_ids), + MakeTypeArgs (IDS_NAME (let_ids), IDS_NTYPE (let_ids), FALSE, TRUE, FALSE, NULL), NULL); @@ -8846,9 +8841,9 @@ COMPprfSameShape (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm5 ("ND_PRF_SAME_SHAPE", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG1 (arg_node)))), + TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG1 (arg_node)))), DUPdupIdNt (PRF_ARG2 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG2 (arg_node)))), + TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG2 (arg_node)))), NULL); DBUG_RETURN (ret_node); @@ -8937,7 +8932,7 @@ COMPprfValLtShape (node *arg_node, info *arg_info) = TCmakeAssignIcm4 ("ND_PRF_VAL_LT_SHAPE_VxA", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), DUPdupIdNt (PRF_ARG2 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG2 (arg_node)))), + TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG2 (arg_node)))), NULL); DBUG_RETURN (ret_node); @@ -9028,7 +9023,7 @@ COMPprfProdMatchesProdShape (node *arg_node, info *arg_info) = TCmakeAssignIcm4 ("ND_PRF_PROD_MATCHES_PROD_SHAPE", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), DUPdupIdNt (PRF_ARG2 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG2 (arg_node)))), + TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG2 (arg_node)))), NULL); DBUG_RETURN (ret_node); @@ -9714,7 +9709,7 @@ COMPprfSyncIds (node *ids, node *chain) if (ids != NULL) { chain = COMPprfSyncIds (IDS_NEXT (ids), chain); chain = TCmakeAssignIcm1 ("ND_REFRESH__MIRROR", - MakeTypeArgs (IDS_NAME (ids), IDS_TYPE (ids), FALSE, + MakeTypeArgs (IDS_NAME (ids), IDS_NTYPE (ids), FALSE, TRUE, FALSE, NULL), chain); } @@ -10037,7 +10032,7 @@ MakeIcmArgs_WL_OP1 (node *arg_node, node *_ids) DBUG_ENTER (); args - = MakeTypeArgs (IDS_NAME (_ids), IDS_TYPE (_ids), FALSE, TRUE, FALSE, + = MakeTypeArgs (IDS_NAME (_ids), IDS_NTYPE (_ids), FALSE, TRUE, FALSE, TBmakeExprs (DUPdupIdNt (WITH2_VEC (wlnode)), TBmakeExprs (TBmakeNum (WITH2_DIMS (wlnode)), NULL))); @@ -10208,7 +10203,7 @@ MakeIcm_GETVAR_ifNeeded (node *arg_node) if (NODE_TYPE (arg_node) == N_id) { node *res = TCmakeIcm2 ("SAC_ND_GETVAR", - TCmakeIdCopyStringNt (ID_NAME (arg_node), ID_TYPE (arg_node)), + TCmakeIdCopyStringNt (ID_NAME (arg_node), ID_NTYPE (arg_node)), TCmakeIdCopyString (ID_NAME (arg_node))); arg_node = FREEdoFreeTree (arg_node); arg_node = res; @@ -10332,7 +10327,7 @@ MakeIcm_WL_SET_OFFSET (node *arg_node, node *assigns) * full range (== -1, if the segment's domain equals the full index * vector space) */ - shape = TYPES_SHPSEG (IDS_TYPE (tmp_ids)); + shape = TYPES_SHPSEG (IDS_NTYPE (tmp_ids)); d = dims - 1; d_u = d; while (d >= 0) { @@ -10470,11 +10465,11 @@ COMPwith (node *arg_node, info *arg_info) if (isfold) { icm_chain = TCmakeAssignIcm3 ("AUD_WL_FOLD_END", - TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_TYPE (idx_id)), + TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_NTYPE (idx_id)), TCmakeIdCopyStringNt (ID_NAME (lower_id), - ID_TYPE (lower_id)), + ID_NTYPE (lower_id)), TCmakeIdCopyStringNt (ID_NAME (upper_id), - ID_TYPE (upper_id)), + ID_NTYPE (upper_id)), icm_chain); icm_chain = TCmakeAssignIcm0 ("AUD_WL_COND_END", icm_chain); icm_chain = TCappendAssign (body_icms, icm_chain); @@ -10482,11 +10477,11 @@ COMPwith (node *arg_node, info *arg_info) icm_chain = TCappendAssign (generator_icms, icm_chain); icm_chain = TCmakeAssignIcm3 ("AUD_WL_FOLD_BEGIN", - TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_TYPE (idx_id)), + TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_NTYPE (idx_id)), TCmakeIdCopyStringNt (ID_NAME (lower_id), - ID_TYPE (lower_id)), + ID_NTYPE (lower_id)), TCmakeIdCopyStringNt (ID_NAME (upper_id), - ID_TYPE (upper_id)), + ID_NTYPE (upper_id)), icm_chain); if (NODE_TYPE (WITH_WITHOP (arg_node)) == N_fold) { @@ -10509,7 +10504,7 @@ COMPwith (node *arg_node, info *arg_info) node *sub_id = WITHOP_SUB (WITH_WITHOP (arg_node)); icm_chain = TCmakeAssignIcm1 ("ND_FREE__DESC", TCmakeIdCopyStringNt (ID_NAME (sub_id), - ID_TYPE (sub_id)), + ID_NTYPE (sub_id)), icm_chain); } @@ -10523,10 +10518,10 @@ COMPwith (node *arg_node, info *arg_info) icm_chain = TCmakeAssignIcm3 ("AUD_WL_END", - TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_TYPE (idx_id)), - TCmakeIdCopyStringNt (ID_NAME (offs_id), ID_TYPE (offs_id)), + TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_NTYPE (idx_id)), + TCmakeIdCopyStringNt (ID_NAME (offs_id), ID_NTYPE (offs_id)), TCmakeIdCopyStringNt (IDS_NAME (res_ids), - IDS_TYPE (res_ids)), + IDS_NTYPE (res_ids)), icm_chain); icm_chain = TCmakeAssignIcm0 ("AUD_WL_COND_END", icm_chain); icm_chain = TCappendAssign (default_icms, icm_chain); @@ -10536,10 +10531,10 @@ COMPwith (node *arg_node, info *arg_info) icm_chain = TCappendAssign (generator_icms, icm_chain); icm_chain = TCmakeAssignIcm3 ("AUD_WL_BEGIN", - TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_TYPE (idx_id)), - TCmakeIdCopyStringNt (ID_NAME (offs_id), ID_TYPE (offs_id)), + TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_NTYPE (idx_id)), + TCmakeIdCopyStringNt (ID_NAME (offs_id), ID_NTYPE (offs_id)), TCmakeIdCopyStringNt (IDS_NAME (res_ids), - IDS_TYPE (res_ids)), + IDS_NTYPE (res_ids)), icm_chain); if (WITHOP_SUB (WITH_WITHOP (arg_node)) != NULL) { @@ -10558,17 +10553,17 @@ COMPwith (node *arg_node, info *arg_info) = TCmakeIcm2 (prf_ccode_tab[F_sub_SxS], TCmakeIcm1 ("ND_A_DIM", TCmakeIdCopyStringNt (IDS_NAME (res_ids), - IDS_TYPE (res_ids))), + IDS_NTYPE (res_ids))), TCmakeIcm1 ("ND_A_SIZE", TCmakeIdCopyStringNt (ID_NAME (idx_id), - ID_TYPE (idx_id)))); + ID_NTYPE (idx_id)))); /* * Annotate shape of subarray if default present * (genarray only) */ if ((NODE_TYPE (WITH_WITHOP (arg_node)) == N_genarray) - && (!KNOWN_SHAPE (TCgetShapeDim (ID_TYPE (sub_id))))) { + && (!KNOWN_SHAPE (TCgetShapeDim (ID_NTYPE (sub_id))))) { if (GENARRAY_DEFAULT (WITH_WITHOP (arg_node)) != NULL) { DBUG_PRINT ("creating COPY__SHAPE for SUBALLOC var"); /* @@ -10576,13 +10571,13 @@ COMPwith (node *arg_node, info *arg_info) */ sub_set_shape = TCmakeIcm1 ("ND_COPY__SHAPE", - MakeTypeArgs (ID_NAME (sub_id), ID_TYPE (sub_id), + MakeTypeArgs (ID_NAME (sub_id), ID_NTYPE (sub_id), FALSE, TRUE, FALSE, MakeTypeArgs (ID_NAME ( GENARRAY_DEFAULT ( WITH_WITHOP ( arg_node))), - ID_TYPE ( + ID_NTYPE ( GENARRAY_DEFAULT ( WITH_WITHOP ( arg_node))), @@ -10596,7 +10591,7 @@ COMPwith (node *arg_node, info *arg_info) "cannot create subvar shape"); } } else if ((NODE_TYPE (WITH_WITHOP (arg_node)) == N_modarray) - && (!KNOWN_SHAPE (TCgetShapeDim (ID_TYPE (sub_id))))) { + && (!KNOWN_SHAPE (TCgetShapeDim (ID_NTYPE (sub_id))))) { DBUG_PRINT ("creating WL_MODARRAY_SUBSHAPE for SUBALLOC var"); /* * set shape in modarray case based upon result @@ -10604,9 +10599,9 @@ COMPwith (node *arg_node, info *arg_info) */ sub_set_shape = TCmakeIcm4 ("WL_MODARRAY_SUBSHAPE", - TCmakeIdCopyStringNt (ID_NAME (sub_id), ID_TYPE (sub_id)), + TCmakeIdCopyStringNt (ID_NAME (sub_id), ID_NTYPE (sub_id)), DUPdupIdNt (WITHID_VEC (WITH_WITHID (arg_node))), - TBmakeNum (TCgetDim (ID_TYPE (sub_id))), + TBmakeNum (TCgetDim (ID_NTYPE (sub_id))), DUPdupIdsIdNt (res_ids)); icm_chain = TBmakeAssign (sub_set_shape, icm_chain); } @@ -10614,7 +10609,7 @@ COMPwith (node *arg_node, info *arg_info) /* * Allocate descriptor of subarray */ - icm_chain = MakeAllocDescIcm (ID_NAME (sub_id), ID_TYPE (sub_id), 1, + icm_chain = MakeAllocDescIcm (ID_NAME (sub_id), ID_NTYPE (sub_id), 1, sub_get_dim, icm_chain); } } @@ -10704,28 +10699,28 @@ COMPgenerator (node *arg_node, info *arg_info) INFO_ICMCHAIN (arg_info) = TCmakeAssignIcm3 ((INFO_ISFOLD (arg_info) ? "AUD_WL_FOLD_LU_GEN" : "AUD_WL_LU_GEN"), - TCmakeIdCopyStringNt (ID_NAME (lower), ID_TYPE (lower)), - TCmakeIdCopyStringNt (ID_NAME (idx), ID_TYPE (idx)), - TCmakeIdCopyStringNt (ID_NAME (upper), ID_TYPE (upper)), + TCmakeIdCopyStringNt (ID_NAME (lower), ID_NTYPE (lower)), + TCmakeIdCopyStringNt (ID_NAME (idx), ID_NTYPE (idx)), + TCmakeIdCopyStringNt (ID_NAME (upper), ID_NTYPE (upper)), NULL); } else if (width == NULL) { INFO_ICMCHAIN (arg_info) = TCmakeAssignIcm4 ((INFO_ISFOLD (arg_info) ? "AUD_WL_FOLD_LUS_GEN" : "AUD_WL_LUS_GEN"), - TCmakeIdCopyStringNt (ID_NAME (lower), ID_TYPE (lower)), - TCmakeIdCopyStringNt (ID_NAME (idx), ID_TYPE (idx)), - TCmakeIdCopyStringNt (ID_NAME (upper), ID_TYPE (upper)), - TCmakeIdCopyStringNt (ID_NAME (step), ID_TYPE (step)), + TCmakeIdCopyStringNt (ID_NAME (lower), ID_NTYPE (lower)), + TCmakeIdCopyStringNt (ID_NAME (idx), ID_NTYPE (idx)), + TCmakeIdCopyStringNt (ID_NAME (upper), ID_NTYPE (upper)), + TCmakeIdCopyStringNt (ID_NAME (step), ID_NTYPE (step)), NULL); } else { INFO_ICMCHAIN (arg_info) = TCmakeAssignIcm5 ((INFO_ISFOLD (arg_info) ? "AUD_WL_FOLD_LUSW_GEN" : "AUD_WL_LUSW_GEN"), - TCmakeIdCopyStringNt (ID_NAME (lower), ID_TYPE (lower)), - TCmakeIdCopyStringNt (ID_NAME (idx), ID_TYPE (idx)), - TCmakeIdCopyStringNt (ID_NAME (upper), ID_TYPE (upper)), - TCmakeIdCopyStringNt (ID_NAME (step), ID_TYPE (step)), - TCmakeIdCopyStringNt (ID_NAME (width), ID_TYPE (width)), + TCmakeIdCopyStringNt (ID_NAME (lower), ID_NTYPE (lower)), + TCmakeIdCopyStringNt (ID_NAME (idx), ID_NTYPE (idx)), + TCmakeIdCopyStringNt (ID_NAME (upper), ID_NTYPE (upper)), + TCmakeIdCopyStringNt (ID_NAME (step), ID_NTYPE (step)), + TCmakeIdCopyStringNt (ID_NAME (width), ID_NTYPE (width)), NULL); } DBUG_RETURN (arg_node); @@ -10802,14 +10797,14 @@ COMPwith2 (node *arg_node, info *arg_info) if (WITHOP_IDX (withop) != NULL) { shpfac_decl_icms = TCmakeAssignIcm3 ("WL_DECLARE_SHAPE_FACTOR", - MakeTypeArgs (IDS_NAME (tmp_ids), IDS_TYPE (tmp_ids), + MakeTypeArgs (IDS_NAME (tmp_ids), IDS_NTYPE (tmp_ids), FALSE, TRUE, FALSE, NULL), DUPdupIdNt (WITH2_VEC (wlnode)), TBmakeNum (WITH2_DIMS (arg_node)), shpfac_decl_icms); shpfac_def_icms = TCmakeAssignIcm3 ("WL_DEFINE_SHAPE_FACTOR", - MakeTypeArgs (IDS_NAME (tmp_ids), IDS_TYPE (tmp_ids), + MakeTypeArgs (IDS_NAME (tmp_ids), IDS_NTYPE (tmp_ids), FALSE, TRUE, FALSE, NULL), DUPdupIdNt (WITH2_VEC (wlnode)), TBmakeNum (WITH2_DIMS (arg_node)), shpfac_def_icms); @@ -10855,7 +10850,7 @@ COMPwith2 (node *arg_node, info *arg_info) * (genarray only) */ if ((NODE_TYPE (withop) == N_genarray) - && (!KNOWN_SHAPE (TCgetShapeDim (ID_TYPE (sub_id))))) { + && (!KNOWN_SHAPE (TCgetShapeDim (ID_NTYPE (sub_id))))) { if (GENARRAY_DEFAULT (withop) != NULL) { DBUG_PRINT ("creating COPY__SHAPE for SUBALLOC var"); /* @@ -10863,12 +10858,12 @@ COMPwith2 (node *arg_node, info *arg_info) */ sub_set_shape = TCmakeIcm1 ("ND_COPY__SHAPE", - MakeTypeArgs (ID_NAME (sub_id), ID_TYPE (sub_id), + MakeTypeArgs (ID_NAME (sub_id), ID_NTYPE (sub_id), FALSE, TRUE, FALSE, MakeTypeArgs (ID_NAME ( GENARRAY_DEFAULT ( withop)), - ID_TYPE ( + ID_NTYPE ( GENARRAY_DEFAULT ( withop)), FALSE, TRUE, FALSE, @@ -10881,7 +10876,7 @@ COMPwith2 (node *arg_node, info *arg_info) "cannot create subvar shape"); } } else if ((NODE_TYPE (withop) == N_modarray) - && (!KNOWN_SHAPE (TCgetShapeDim (ID_TYPE (sub_id))))) { + && (!KNOWN_SHAPE (TCgetShapeDim (ID_NTYPE (sub_id))))) { DBUG_PRINT ("creating WL_MODARRAY_SUBSHAPE for SUBALLOC var"); /* * set shape in modarray case based upon result @@ -10890,9 +10885,9 @@ COMPwith2 (node *arg_node, info *arg_info) sub_set_shape = TCmakeIcm4 ("WL_MODARRAY_SUBSHAPE", TCmakeIdCopyStringNt (ID_NAME (sub_id), - ID_TYPE (sub_id)), + ID_NTYPE (sub_id)), DUPdupIdNt (WITHID_VEC (WITH2_WITHID (arg_node))), - TBmakeNum (TCgetDim (ID_TYPE (sub_id))), + TBmakeNum (TCgetDim (ID_NTYPE (sub_id))), DUPdupIdsIdNt (tmp_ids)); alloc_icms = TBmakeAssign (sub_set_shape, alloc_icms); @@ -10901,7 +10896,7 @@ COMPwith2 (node *arg_node, info *arg_info) /* * Allocate descriptor of subarray */ - alloc_icms = MakeAllocDescIcm (ID_NAME (sub_id), ID_TYPE (sub_id), 1, + alloc_icms = MakeAllocDescIcm (ID_NAME (sub_id), ID_NTYPE (sub_id), 1, sub_get_dim, alloc_icms); /* @@ -10909,7 +10904,7 @@ COMPwith2 (node *arg_node, info *arg_info) */ free_icms = TCmakeAssignIcm1 ("ND_FREE__DESC", TCmakeIdCopyStringNt (ID_NAME (sub_id), - ID_TYPE (sub_id)), + ID_NTYPE (sub_id)), free_icms); } } @@ -11009,7 +11004,7 @@ COMPwith2 (node *arg_node, info *arg_info) begin_icm = TCmakeAssignIcm3 ("WL_DIST_SCHEDULE__BEGIN", icm_args, TBmakeBool (is_distributable), - MakeTypeArgs (IDS_NAME (wlids), IDS_TYPE (wlids), + MakeTypeArgs (IDS_NAME (wlids), IDS_NTYPE (wlids), TRUE, FALSE, FALSE, NULL), NULL); @@ -11058,16 +11053,16 @@ COMPwith3AllocDesc (node *ops, node **pre, node **post) || ((NODE_TYPE (ops) == N_modarray) && (MODARRAY_SUB (ops) != NULL))) { node *sub = NODE_TYPE (ops) == N_genarray ? GENARRAY_SUB (ops) : MODARRAY_SUB (ops); - int dim = TCgetDim (ID_TYPE (WITHOP_MEM (ops))); + int dim = TCgetDim (ID_NTYPE (WITHOP_MEM (ops))); DBUG_ASSERT (dim >= 0, "Can only handle AKD or better"); - *pre = MakeMutcLocalAllocDescIcm (ID_NAME (sub), ID_TYPE (sub), 1, + *pre = MakeMutcLocalAllocDescIcm (ID_NAME (sub), ID_NTYPE (sub), 1, TBmakeNum (dim), *pre); *pre = TCmakeAssignIcm2 ("ND_DECL__DESC", - TCmakeIdCopyStringNt (ID_NAME (sub), ID_TYPE (sub)), + TCmakeIdCopyStringNt (ID_NAME (sub), ID_NTYPE (sub)), TCmakeIdCopyString (""), *pre); #if FREE_LOCAL *post = TCmakeAssignIcm1 ("ND_FREE__DESC", - TCmakeIdCopyStringNt (ID_NAME (sub), ID_TYPE (sub)), + TCmakeIdCopyStringNt (ID_NAME (sub), ID_NTYPE (sub)), *post); #endif } @@ -11225,7 +11220,7 @@ COMPrange (node *arg_node, info *arg_info) save = TCmakeAssignIcm1 ("SAC_MUTC_SAVE", TCmakeIdCopyStringNt (IDS_NAME ( INFO_WITH3_FOLDS (arg_info)), - IDS_TYPE (INFO_WITH3_FOLDS ( + IDS_NTYPE (INFO_WITH3_FOLDS ( arg_info))), NULL); family = TCappendAssign (family, save); diff --git a/src/libsac2c/typecheck/type_utils.c b/src/libsac2c/typecheck/type_utils.c index 35d9f5964..2cb540d13 100644 --- a/src/libsac2c/typecheck/type_utils.c +++ b/src/libsac2c/typecheck/type_utils.c @@ -1679,7 +1679,7 @@ TUgetBaseSimpleType (ntype *type) /** * - * @fn int TUtype2Int( ntype *ty) + * @fn int TUakvScalInt2Int( ntype *ty) * * @brief: Extract integer scalar constant from an AKV integer scalar ntype * @@ -1689,7 +1689,7 @@ TUgetBaseSimpleType (ntype *type) * ******************************************************************************/ int -TUtype2Int (ntype *ty) +TUakvScalInt2Int (ntype *ty) { int z; constant *con = NULL; @@ -1703,4 +1703,39 @@ TUtype2Int (ntype *ty) DBUG_RETURN (z); } +/** + * + * @fn int TUgetDimEncoding( ntype *type) + * + * @brief: produces the array info encoding needed by the backend: + * >= 0 : AKS with result == DIM + * < -2: AKD with result == -2 - DIM + * == -1: AUSGZ + * == -2: AUD + * + * + * @param: type: ntype + * + * @return the encoding of the dimensionality. + * + ******************************************************************************/ +int TUgetDimEncoding (ntype *type) +{ + int res; + + DBUG_ENTER (); + + if (TYisAUDGZ (type)) { + res = -1; + } else if (TYisAUD (type)) { + res = -2; + } else if (TYisAKD (type)) { + res = -2 - TYgetDim (type); + } else { + res = TYgetDim (type); + } + + DBUG_RETURN (res); +} + #undef DBUG_PREFIX diff --git a/src/libsac2c/typecheck/type_utils.h b/src/libsac2c/typecheck/type_utils.h index d4ab466d6..0c5c21f35 100644 --- a/src/libsac2c/typecheck/type_utils.h +++ b/src/libsac2c/typecheck/type_utils.h @@ -3,33 +3,83 @@ #include "types.h" +/** + * Function types: + */ extern ntype *TUcreateFuntype (node *fundef); extern ntype *TUcreateFuntypeIgnoreArtificials (node *fundef); +extern char *TUtypeSignature2String (node *fundef); +extern bool TUsignatureMatches (node *formal, ntype *actual_prod_type, bool exact); + +/** + * User types: + */ +extern ntype *TUcheckUdtAndSetBaseType (usertype udt, int *visited); +extern simpletype TUgetBaseSimpleType (ntype *type); + +/** + * AKV types: + */ +extern int TUakvScalInt2Int (ntype *ty); +/** + * dispatch-wrapper related: + */ extern ntype *TUrebuildWrapperTypeAlphaFix (ntype *); extern ntype *TUrebuildWrapperTypeAlpha (ntype *); -extern node *TUcreateTmpVardecsFromRets (node *rets); + +/** + * N_arg related: + */ extern ntype *TUmakeProductTypeFromArgs (node *args); +extern node *TUargtypes2unknownAUD (node *args); +extern ntype *TUactualArgs2Ntype (node *actual); + +/** + * N_ret related: + */ extern ntype *TUmakeProductTypeFromRets (node *rets); +extern node *TUcreateTmpVardecsFromRets (node *rets); extern node *TUmakeTypeExprsFromRets (node *rets); -extern node *TUreplaceRetTypes (node *rets, ntype *prodt); extern node *TUrettypes2unknownAUD (node *rets); -extern node *TUargtypes2unknownAUD (node *rets); -extern ntype *TUtype2alphaMax (ntype *type); -extern ntype *TUtype2alphaAUDMax (ntype *type); +extern node *TUreplaceRetTypes (node *rets, ntype *prodt); extern node *TUrettypes2alpha (node *rets); extern node *TUrettypes2alphaFix (node *rets); extern node *TUalphaRettypes2bottom (node *rets, const char *msg); extern node *TUrettypes2alphaMax (node *rets); extern node *TUrettypes2alphaAUDMax (node *rets); +extern bool TUretsContainBottom (node *rets); +extern bool TUretsAreConstant (node *rets); + +/** + * general type computations: + */ +extern ntype *TUtype2alphaMax (ntype *type); +extern ntype *TUtype2alphaAUDMax (ntype *type); +extern ntype *TUstripImplicitNestingOperations (ntype *poly); +extern ntype *TUcomputeImplementationType (ntype *ty); + +/** + * dealing with bottom types: + */ +extern ntype *TUcombineBottom (ntype *left, ntype *right); +extern ntype *TUcombineBottoms (ntype *prod); +extern ntype *TUcombineBottomsFromRets (node *rets); +extern ntype *TUspreadBottoms (ntype *prod); + +/** + * advanced inspection functions: + */ extern bool TUdimKnown (ntype *ty); extern bool TUshapeKnown (ntype *ty); + extern bool TUisBoolScalar (ntype *ty); extern bool TUisIntScalar (ntype *ty); extern bool TUisIntVect (ntype *ty); extern bool TUisEmptyVect (ntype *ty); extern bool TUisScalar (ntype *ty); extern bool TUisVector (ntype *ty); + extern bool TUhasBasetype (ntype *ty, simpletype smpl); extern bool TUisUniqueUserType (ntype *type); extern bool TUisArrayOfUser (ntype *type); @@ -38,23 +88,16 @@ extern bool TUisHidden (ntype *type); extern bool TUisNested (ntype *type); extern bool TUisBoxed (ntype *type); extern bool TUisPolymorphic (ntype *type); + +extern int TUgetDimEncoding (ntype *type): // specifically needed for the backend + +/** + * type relations: + */ extern bool TUeqShapes (ntype *a, ntype *b); extern bool TUleShapeInfo (ntype *a, ntype *b); extern bool TUeqElementSize (ntype *a, ntype *b); extern bool TUravelsHaveSameStructure (ntype *a, ntype *b); -extern ntype *TUstripImplicitNestingOperations (ntype *poly); -extern ntype *TUcomputeImplementationType (ntype *ty); -extern char *TUtypeSignature2String (node *fundef); -extern ntype *TUactualArgs2Ntype (node *actual); -extern bool TUsignatureMatches (node *formal, ntype *actual_prod_type, bool exact); -extern bool TUretsContainBottom (node *rets); -extern bool TUretsAreConstant (node *rets); -extern ntype *TUcombineBottom (ntype *left, ntype *right); -extern ntype *TUcombineBottoms (ntype *prod); -extern ntype *TUcombineBottomsFromRets (node *rets); -extern ntype *TUspreadBottoms (ntype *prod); -extern ntype *TUcheckUdtAndSetBaseType (usertype udt, int *visited); -extern simpletype TUgetBaseSimpleType (ntype *type); -extern int TUtype2Int (ntype *ty); + #endif /* _SAC_TYPE_UTILS_H_*/ -- GitLab From 96109281042c49e5dfcfb515d915be805cbcb9a8 Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sat, 21 Nov 2020 17:02:55 +0100 Subject: [PATCH 06/16] finished compile and adjusted just enough to be able to compile again --- src/libsac2c/arrayopt/lacfun_utilities.c | 3 +- src/libsac2c/codegen/compile.c | 511 +++++++++----------- src/libsac2c/global/NameTuplesUtils.c | 80 ++- src/libsac2c/global/NameTuplesUtils.h | 1 + src/libsac2c/global/phase_sac2c.mac | 2 + src/libsac2c/precompile/renameidentifiers.c | 15 +- src/libsac2c/print/convert.c | 153 +++--- src/libsac2c/print/convert.h | 2 +- src/libsac2c/print/print.c | 26 +- src/libsac2c/tree/DupTree.c | 18 +- src/libsac2c/tree/check_lib.c | 3 +- src/libsac2c/typecheck/new_types.c | 6 + src/libsac2c/typecheck/type_utils.c | 87 +++- src/libsac2c/typecheck/type_utils.h | 8 +- src/libsac2c/xml/ast.xml | 10 +- 15 files changed, 513 insertions(+), 412 deletions(-) diff --git a/src/libsac2c/arrayopt/lacfun_utilities.c b/src/libsac2c/arrayopt/lacfun_utilities.c index 696566c2e..90c7af14e 100644 --- a/src/libsac2c/arrayopt/lacfun_utilities.c +++ b/src/libsac2c/arrayopt/lacfun_utilities.c @@ -932,8 +932,7 @@ LFUfindFundefReturn (node *arg_node) DBUG_ENTER (); - if ((!FUNDEF_ISWRAPPERFUN (arg_node)) && (global.compiler_anyphase >= PH_ptc_l2f) - && (global.compiler_anyphase < PH_cg_ctr)) { + if ((!FUNDEF_ISWRAPPERFUN (arg_node)) && (global.compiler_anyphase >= PH_ptc_l2f)) { assgn = FUNDEF_BODY (arg_node); if (NULL != assgn) { /* Some fns do not have a body. Weird... */ assgn = BLOCK_ASSIGNS (assgn); diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index 91a5d6609..52896c633 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -37,6 +37,7 @@ #include "wl_bounds.h" #include "new_types.h" #include "user_types.h" +#include "type_utils.h" #include "shape.h" #include "LookUpTable.h" #include "convert.h" @@ -428,8 +429,7 @@ MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_sha DBUG_ENTER (); itype = TUcomputeImplementationType(type); - dim = TUgetDimEncoding (itype); - dim = TCgetShapeDim (type); + dim = TUgetFullDimEncoding (itype); /* * CAUTION: @@ -450,6 +450,7 @@ MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_sha } exprs = TBmakeExprs (TCmakeIdCopyStringNtNew (name, type), exprs); + itype = TYfreeType (itype); DBUG_RETURN (exprs); } @@ -472,7 +473,7 @@ MakeDimArg (node *arg, bool int_only) DBUG_ENTER (); if (NODE_TYPE (arg) == N_id) { - int dim = TCgetDim (ID_NTYPE (arg)); + int dim = TUgetDimEncoding (ID_NTYPE (arg)); if (dim >= 0) { ret = TBmakeNum (dim); } else if (int_only) { @@ -520,9 +521,9 @@ MakeSizeArg (node *arg, bool int_only) DBUG_ENTER (); if (NODE_TYPE (arg) == N_id) { - types *type = ID_NTYPE (arg); - if (TCgetShapeDim (type) >= 0) { - ret = TBmakeNum (TCgetTypesLength (type)); + ntype *type = ID_NTYPE (arg); + if (TUshapeKnown (type)) { + ret = TBmakeNum (SHgetUnrLen (TYgetShape (type))); } else if (int_only) { ret = TBmakeNum (-1); } else { @@ -563,7 +564,6 @@ MakeSizeArg (node *arg, bool int_only) static char * GenericFun (generic_fun_t which, ntype *type) { - node *tdef; char *ret = NULL; #ifndef DBUG_OFF char *tmp; @@ -594,10 +594,10 @@ GenericFun (generic_fun_t which, ntype *type) if (TYgetSimpleType (TYgetScalar (UTgetBaseType (utype))) == T_hidden) { switch (which) { case GF_copy: - ret = TYPEDEF_COPYFUN (UTgetTypedef (utype)); + ret = TYPEDEF_COPYFUN (UTgetTdef (utype)); break; case GF_free: - ret = TYPEDEF_FREEFUN (UTgetTypedef (utype)); + ret = TYPEDEF_FREEFUN (UTgetTdef (utype)); break; } } @@ -727,7 +727,7 @@ DupExpr_NT_AddReadIcms (node *expr) new_expr = TBmakePrf (PRF_PRF (expr), DupExprs_NT_AddReadIcms (PRF_ARGS (expr))); } else if (NODE_TYPE (expr) == N_id) { new_expr = DUPdupIdNt (expr); - if (TCgetShapeDim (ID_NTYPE (expr)) == SCALAR) { + if (TUgetFullDimEncoding (ID_NTYPE (expr)) == SCALAR) { new_expr = TCmakeIcm2 ("ND_READ", new_expr, TBmakeNum (0)); } } else { @@ -764,7 +764,7 @@ DupExprs_NT_AddReadIcms (node *exprs) /** * - * @fn node *MakeAnAllocDescIcm( char *name, types *type, int rc, + * @fn node *MakeAnAllocDescIcm( char *name, ntype *type, int rc, * node *get_dim, * node *assigns) * @@ -772,7 +772,7 @@ DupExprs_NT_AddReadIcms (node *exprs) * *****************************************************************************/ static node * -MakeAnAllocDescIcm (char *name, types *type, int rc, node *get_dim, node *assigns, +MakeAnAllocDescIcm (char *name, ntype *type, int rc, node *get_dim, node *assigns, char *icm) { int dim; @@ -782,19 +782,19 @@ MakeAnAllocDescIcm (char *name, types *type, int rc, node *get_dim, node *assign if (RC_IS_ACTIVE (rc)) { if (get_dim == NULL) { - dim = TCgetDim (type); + dim = TYgetDim (type); DBUG_ASSERT (dim >= 0, "dimension undefined -> size of descriptor unknown"); get_dim = TBmakeNum (dim); } assigns - = TCmakeAssignIcm2 (icm, TCmakeIdCopyStringNt (name, type), get_dim, assigns); + = TCmakeAssignIcm2 (icm, TCmakeIdCopyStringNtNew (name, type), get_dim, assigns); } DBUG_RETURN (assigns); } /** * - * @fn node *MakeAllocDescIcm( char *name, types *type, int rc, + * @fn node *MakeAllocDescIcm( char *name, ntype *type, int rc, * node *get_dim, * node *assigns) * @@ -803,7 +803,7 @@ MakeAnAllocDescIcm (char *name, types *type, int rc, node *get_dim, node *assign *****************************************************************************/ static node * -MakeAllocDescIcm (char *name, types *type, int rc, node *get_dim, node *assigns) +MakeAllocDescIcm (char *name, ntype *type, int rc, node *get_dim, node *assigns) { DBUG_ENTER (); assigns = MakeAnAllocDescIcm (name, type, rc, get_dim, assigns, "ND_ALLOC__DESC"); @@ -811,7 +811,7 @@ MakeAllocDescIcm (char *name, types *type, int rc, node *get_dim, node *assigns) } /** * - * @fn node *MakeMutcLocalAllocDescIcm( char *name, types *type, int rc, + * @fn node *MakeMutcLocalAllocDescIcm( char *name, ntype *type, int rc, * node *get_dim, * node *assigns) * @@ -819,7 +819,7 @@ MakeAllocDescIcm (char *name, types *type, int rc, node *get_dim, node *assigns) * *****************************************************************************/ static node * -MakeMutcLocalAllocDescIcm (char *name, types *type, int rc, node *get_dim, node *assigns) +MakeMutcLocalAllocDescIcm (char *name, ntype *type, int rc, node *get_dim, node *assigns) { DBUG_ENTER (); @@ -830,14 +830,14 @@ MakeMutcLocalAllocDescIcm (char *name, types *type, int rc, node *get_dim, node /** * - * @fn node *MakeSetRcIcm( char *name, types *type, int rc, node *assigns) + * @fn node *MakeSetRcIcm( char *name, ntype *type, int rc, node *assigns) * * @brief Builds a ND_SET__RC( name, num) icm if needed. * ******************************************************************************/ static node * -MakeSetRcIcm (char *name, types *type, int rc, node *assigns) +MakeSetRcIcm (char *name, ntype *type, int rc, node *assigns) { simpletype basetype; @@ -847,25 +847,25 @@ MakeSetRcIcm (char *name, types *type, int rc, node *assigns) if (RC_IS_ACTIVE (rc)) { if (RC_IS_VITAL (rc)) { - assigns = TCmakeAssignIcm2 ("ND_SET__RC", TCmakeIdCopyStringNt (name, type), + assigns = TCmakeAssignIcm2 ("ND_SET__RC", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), assigns); } else { - basetype = TCgetBasetype (type); - if (CUisDeviceTypeOld (type)) { + basetype = TUgetSimpleImplementationType (type); + if (CUisDeviceTypeNew (type)) { assigns - = TCmakeAssignIcm2 ("CUDA_FREE", TCmakeIdCopyStringNt (name, type), + = TCmakeAssignIcm2 ("CUDA_FREE", TCmakeIdCopyStringNtNew (name, type), TCmakeIdCopyString (GenericFun (GF_free, type)), assigns); } else if (basetype == T_int_dist || basetype == T_long_dist || basetype == T_longlong_dist || basetype == T_float_dist || basetype == T_double_dist) { assigns - = TCmakeAssignIcm2 ("DIST_FREE", TCmakeIdCopyStringNt (name, type), + = TCmakeAssignIcm2 ("DIST_FREE", TCmakeIdCopyStringNtNew (name, type), TCmakeIdCopyString (GenericFun (GF_free, type)), assigns); } else { assigns - = TCmakeAssignIcm2 ("ND_FREE", TCmakeIdCopyStringNt (name, type), + = TCmakeAssignIcm2 ("ND_FREE", TCmakeIdCopyStringNtNew (name, type), TCmakeIdCopyString (GenericFun (GF_free, type)), assigns); } @@ -914,7 +914,6 @@ static node * MakeDecRcIcm (char *name, ntype *type, int num, node *assigns) { const char *icm; - ntype *itype; simpletype elem_type; DBUG_ENTER (); @@ -923,8 +922,7 @@ MakeDecRcIcm (char *name, ntype *type, int num, node *assigns) if (num > 0) { - itype = TUcomputeImplementationType (type); - elem_type = TYgetSimpleType (itype); + elem_type = TUgetSimpleImplementationType (type); if (elem_type == T_int_dist || elem_type == T_long_dist || elem_type == T_longlong_dist || elem_type == T_float_dist @@ -945,7 +943,7 @@ MakeDecRcIcm (char *name, ntype *type, int num, node *assigns) /** * - * @fn node *MakeAllocIcm( char *name, types *type, int rc, + * @fn node *MakeAllocIcm( char *name, ntype *type, int rc, * node *get_dim, node *set_shape_icm, * node *pragma, node *assign) * @@ -970,22 +968,22 @@ MakeAllocIcm (char *name, ntype *type, int rc, node *get_dim, node *set_shape_ic if (RC_IS_ACTIVE (rc)) { if (pragma == NULL) { + baseType = TUgetSimpleImplementationType (type); - baseType = TCgetBasetype (type); /* This is an array that should be allocated on the device */ - if (CUisDeviceTypeOld (type)) { + if (CUisDeviceTypeNew (type)) { #if USE_COMPACT_ALLOC assigns - = TCmakeAssignIcm3 ("ND_ALLOC", TCmakeIdCopyStringNt (name, type), + = TCmakeAssignIcm3 ("ND_ALLOC", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), get_dim, set_shape_icm, assigns); #else typeArg = MakeBasetypeArg (type); assigns = TCmakeAssignIcm4 ( - "CUDA_ALLOC_BEGIN", TCmakeIdCopyStringNt (name, type), TBmakeNum (rc), + "CUDA_ALLOC_BEGIN", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), get_dim, typeArg, TBmakeAssign (set_shape_icm, TCmakeAssignIcm4 ("CUDA_ALLOC_END", - TCmakeIdCopyStringNt (name, type), + TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), DUPdoDupTree (get_dim), DUPdoDupNode (typeArg), assigns))); #endif @@ -1015,21 +1013,21 @@ MakeAllocIcm (char *name, ntype *type, int rc, node *get_dim, node *set_shape_ic break; } assigns - = TCmakeAssignIcm4 ("DIST_ALLOC", TCmakeIdCopyStringNt (name, type), + = TCmakeAssignIcm4 ("DIST_ALLOC", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), get_dim, typeArg, NULL); FREEdoFreeTree (set_shape_icm); } else { #if USE_COMPACT_ALLOC assigns - = TCmakeAssignIcm3 ("ND_ALLOC", TCmakeIdCopyStringNt (name, type), + = TCmakeAssignIcm3 ("ND_ALLOC", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), get_dim, set_shape_icm, assigns); #else assigns = TCmakeAssignIcm4 ( - "ND_ALLOC_BEGIN", TCmakeIdCopyStringNt (name, type), TBmakeNum (rc), + "ND_ALLOC_BEGIN", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), get_dim, MakeBasetypeArg (type), TBmakeAssign (set_shape_icm, TCmakeAssignIcm4 ("ND_ALLOC_END", - TCmakeIdCopyStringNt (name, type), + TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), DUPdoDupTree (get_dim), MakeBasetypeArg (type), assigns))); #endif @@ -1039,7 +1037,7 @@ MakeAllocIcm (char *name, ntype *type, int rc, node *get_dim, node *set_shape_ic * ALLOC_PLACE does not seem to be implemented somewhere */ assigns - = TCmakeAssignIcm5 ("ND_ALLOC_PLACE", TCmakeIdCopyStringNt (name, type), + = TCmakeAssignIcm5 ("ND_ALLOC_PLACE", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), DUPdoDupNode (AP_ARG1 (PRAGMA_APL (pragma))), DUPdoDupNode (AP_ARG2 (PRAGMA_APL (pragma))), @@ -1055,7 +1053,7 @@ MakeAllocIcm (char *name, ntype *type, int rc, node *get_dim, node *set_shape_ic /** * - * @fn node *MakeAllocIcm_IncRc( char *name, types *type, int rc, + * @fn node *MakeAllocIcm_IncRc( char *name, ntype *type, int rc, * node *get_dim, node *set_shape_icm, * node *pragma, node *assigns) * @@ -1067,7 +1065,7 @@ MakeAllocIcm (char *name, ntype *type, int rc, node *get_dim, node *set_shape_ic ******************************************************************************/ static node * -MakeAllocIcm_IncRc (char *name, types *type, int rc, node *get_dim, node *set_shape_icm, +MakeAllocIcm_IncRc (char *name, ntype *type, int rc, node *get_dim, node *set_shape_icm, node *pragma, node *assigns) { node *new_assigns; @@ -1082,7 +1080,7 @@ MakeAllocIcm_IncRc (char *name, types *type, int rc, node *get_dim, node *set_sh DBUG_ASSERT (RC_IS_VITAL (rc), "INC_RC(rc) with (rc <= 0) found!"); assigns = TCappendAssign (new_assigns, TCmakeAssignIcm2 ("ND_INC_RC", - TCmakeIdCopyStringNt (name, type), + TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), assigns)); } @@ -1119,8 +1117,8 @@ MakeCheckReuseIcm (char *name, ntype *type, node *reuse_id, node *assigns) /** * - * @fn node *MakeReAllocIcm( char *name, types *type, - * char *sname, types *stype, int rc, + * @fn node *MakeReAllocIcm( char *name, ntype *type, + * char *sname, ntype *stype, int rc, * node *get_dim, node *set_shape_icm, * node *pragma, node *assign) * @@ -1130,7 +1128,7 @@ MakeCheckReuseIcm (char *name, ntype *type, node *reuse_id, node *assigns) ******************************************************************************/ static node * -MakeReAllocIcm (char *name, ntype *type, char *sname, types *stype, int rc, node *get_dim, +MakeReAllocIcm (char *name, ntype *type, char *sname, ntype *stype, int rc, node *get_dim, node *set_shape_icm, node *pragma, node *assigns) { DBUG_ENTER (); @@ -1143,33 +1141,33 @@ MakeReAllocIcm (char *name, ntype *type, char *sname, types *stype, int rc, node if (RC_IS_ACTIVE (rc)) { /* This is an array that should be allocated on the device */ - if (CUisDeviceTypeOld (type)) { + if (CUisDeviceTypeNew (type)) { #if USE_COMPACT_ALLOC - assigns = TCmakeAssignIcm3 ("ND_ALLOC", TCmakeIdCopyStringNt (name, type), + assigns = TCmakeAssignIcm3 ("ND_ALLOC", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), get_dim, set_shape_icm, assigns); #else assigns = TCmakeAssignIcm4 ( - "CUDA_ALLOC_BEGIN", TCmakeIdCopyStringNt (name, type), TBmakeNum (rc), + "CUDA_ALLOC_BEGIN", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), get_dim, MakeBasetypeArg (type), TBmakeAssign (set_shape_icm, TCmakeAssignIcm4 ("CUDA_ALLOC_END", - TCmakeIdCopyStringNt (name, type), + TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), DUPdoDupTree (get_dim), MakeBasetypeArg (type), assigns))); #endif } else { #if USE_COMPACT_ALLOC - assigns = TCmakeAssignIcm3 ("ND_ALLOC", TCmakeIdCopyStringNt (name, type), + assigns = TCmakeAssignIcm3 ("ND_ALLOC", TCmakeIdCopyStringNtNew (name, type), TBmakeNum (rc), get_dim, set_shape_icm, assigns); #else assigns = TCmakeAssignIcm5 ( - "ND_REALLOC_BEGIN", TCmakeIdCopyStringNt (name, type), - TCmakeIdCopyStringNt (sname, stype), TBmakeNum (rc), get_dim, + "ND_REALLOC_BEGIN", TCmakeIdCopyStringNtNew (name, type), + TCmakeIdCopyStringNtNew (sname, stype), TBmakeNum (rc), get_dim, MakeBasetypeArg (type), TBmakeAssign (set_shape_icm, TCmakeAssignIcm5 ("ND_REALLOC_END", - TCmakeIdCopyStringNt (name, type), - TCmakeIdCopyStringNt (sname, stype), + TCmakeIdCopyStringNtNew (name, type), + TCmakeIdCopyStringNtNew (sname, stype), TBmakeNum (rc), DUPdoDupTree (get_dim), MakeBasetypeArg (type), assigns))); #endif @@ -1184,7 +1182,7 @@ MakeReAllocIcm (char *name, ntype *type, char *sname, types *stype, int rc, node /** * - * @fn node *MakeCheckResizeIcm( char *name, types *type, node *reuse_id, + * @fn node *MakeCheckResizeIcm( char *name, ntype *type, node *reuse_id, * node *assigns); * * @brief Builds a CHECK_RESIZE icm which checks whether reuse_id can be @@ -1194,14 +1192,14 @@ MakeReAllocIcm (char *name, ntype *type, char *sname, types *stype, int rc, node ******************************************************************************/ static node * -MakeCheckResizeIcm (char *name, types *type, node *reuse_id, int rc, node *get_dim, +MakeCheckResizeIcm (char *name, ntype *type, node *reuse_id, int rc, node *get_dim, node *set_shape_icm, node *assigns) { DBUG_ENTER (); assigns = TCmakeAssignIcm1 ("SAC_IS_LASTREF__BLOCK_ELSE", - TCmakeIdCopyStringNt (ID_NAME (reuse_id), ID_NTYPE (reuse_id)), + TCmakeIdCopyStringNtNew (ID_NAME (reuse_id), ID_NTYPE (reuse_id)), assigns); assigns = MakeReAllocIcm (name, type, ID_NAME (reuse_id), ID_NTYPE (reuse_id), rc, @@ -1209,7 +1207,7 @@ MakeCheckResizeIcm (char *name, types *type, node *reuse_id, int rc, node *get_d assigns = TCmakeAssignIcm1 ("SAC_IS_LASTREF__BLOCK_BEGIN", - TCmakeIdCopyStringNt (ID_NAME (reuse_id), ID_NTYPE (reuse_id)), + TCmakeIdCopyStringNtNew (ID_NAME (reuse_id), ID_NTYPE (reuse_id)), assigns); DBUG_RETURN (assigns); @@ -1352,7 +1350,7 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) if (ARRAY_AELEMS (arg_node) != NULL) { if (NODE_TYPE (EXPRS_EXPR (ARRAY_AELEMS (arg_node))) == N_id) { - val0_sdim = TCgetShapeDim ( + val0_sdim = TUgetFullDimEncoding ( ID_NTYPE (EXPRS_EXPR (ARRAY_AELEMS (arg_node)))); } else { val0_sdim = 0; @@ -1491,7 +1489,7 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) { node *icm_args; - DBUG_ASSERT ((TCgetBasetype (ID_NTYPE (arg1)) == T_int), + DBUG_ASSERT ((TUgetSimpleImplementationType (ID_NTYPE (arg1)) == T_int), "1st arg of F_sel_VxA is a illegal indexing " "var!"); @@ -1715,7 +1713,7 @@ MakeSetShapeIcm (node *arg_node, node *let_ids) /** * - * @fn node *MakeArgNode( int idx, types *type, bool thread) + * @fn node *MakeArgNode( int idx, ntype *type, bool thread) * * @brief ... * bool thread is this arg a mutc thread fun arg? @@ -1793,7 +1791,7 @@ MakeFunctionArgsSpmd (node *fundef) name = ARG_NAME (argtab->ptr_in[i]); type = ARG_NTYPE (argtab->ptr_in[i]); - id = TCmakeIdCopyStringNt (STRonNull ("", name), type); + id = TCmakeIdCopyStringNtNew (STRonNull ("", name), type); } else { DBUG_ASSERT (argtab->ptr_out[i] != NULL, "argtab is uncompressed!"); type = RET_TYPE (argtab->ptr_out[i]); @@ -1860,8 +1858,8 @@ MakeFunctionArgsCuda (node *fundef) "no N_arg node found in argtab"); name = ARG_NAME (argtab->ptr_in[i]); - type = ARG_TYPE (argtab->ptr_in[i]); - id = TCmakeIdCopyStringNt (STRonNull ("", name), type); + type = ARG_NTYPE (argtab->ptr_in[i]); + id = TCmakeIdCopyStringNtNew (STRonNull ("", name), type); } else { DBUG_ASSERT (argtab->ptr_out[i] != NULL, "argtab is uncompressed!"); type = RET_TYPE (argtab->ptr_out[i]); @@ -1872,7 +1870,7 @@ MakeFunctionArgsCuda (node *fundef) = TBmakeExprs (TCmakeIdCopyString (global.argtag_string[argtab->tag[i]]), TBmakeExprs (MakeBasetypeArg (type), TBmakeExprs (id, TBmakeExprs (TBmakeNum ( - TYPES_DIM (type)), + TUgetFullDimEncoding (type)), icm_args)))); } size = argtab->size - 1; @@ -1887,7 +1885,7 @@ MakeFunctionArgsCuda (node *fundef) TBmakeExprs (MakeBasetypeArg (type), TBmakeExprs (MakeArgNode (0, type, FALSE), TBmakeExprs (TBmakeNum ( - TYPES_DIM (type)), + TUgetFullDimEncoding (type)), icm_args)))); size++; } @@ -1946,7 +1944,7 @@ MakeFunctionArgs (node *fundef) type = ARG_NTYPE (argtab->ptr_in[i]); name = ARG_NAME (argtab->ptr_in[i]); if (name != NULL) { - id = TCmakeIdCopyStringNt (name, type); + id = TCmakeIdCopyStringNtNew (name, type); } else { id = MakeArgNode (i, type, FUNDEF_ISTHREADFUN (fundef)); } @@ -1992,7 +1990,7 @@ MakeFunctionArgs (node *fundef) static char * GetBaseTypeFromAvis (node *in) { - types *type = NULL; + ntype *type = NULL; DBUG_ENTER (); DBUG_ASSERT (in != NULL, "no node found!"); @@ -2000,9 +1998,9 @@ GetBaseTypeFromAvis (node *in) in = AVIS_DECL (in); if (NODE_TYPE (in) == N_vardec) { - type = VARDEC_TYPE (in); + type = VARDEC_NTYPE (in); } else if (NODE_TYPE (in) == N_arg) { - type = ARG_TYPE (in); + type = ARG_NTYPE (in); } else { DBUG_UNREACHABLE ("Illegal node type found!"); } @@ -2037,7 +2035,7 @@ GetBaseTypeFromExpr (node *in) ret = GetBaseTypeFromAvis (in); } else if (NODE_TYPE (in) == N_globobj) { in = GLOBOBJ_OBJDEF (in); - ret = GetBasetypeStr (TYtype2OldType (OBJDEF_TYPE (in))); + ret = GetBasetypeStr (OBJDEF_TYPE (in)); } else { DBUG_UNREACHABLE ("Unexpected node type found!"); } @@ -2059,9 +2057,9 @@ MakeFunApArgIdsNt (node *ids) node *icm, *id = NULL; DBUG_ENTER (); - if (TYPES_MUTC_USAGE (IDS_NTYPE (ids)) == MUTC_US_FUNPARAM) { + if (TYgetMutcUsage (IDS_NTYPE (ids)) == MUTC_US_FUNPARAM) { id = TCmakeIdCopyString ("FPA"); - } else if (TYPES_MUTC_USAGE (IDS_NTYPE (ids)) == MUTC_US_THREADPARAM) { + } else if (TYgetMutcUsage (IDS_NTYPE (ids)) == MUTC_US_THREADPARAM) { id = TCmakeIdCopyString ("FTA"); } else { id = TCmakeIdCopyString ("FAG"); @@ -2087,7 +2085,7 @@ MakeFunApArgIdsNtThread (node *ids) node *icm, *id = NULL; DBUG_ENTER (); - if (TYPES_MUTC_USAGE (IDS_NTYPE (ids)) == MUTC_US_THREADPARAM) { + if (TYgetMutcUsage (IDS_NTYPE (ids)) == MUTC_US_THREADPARAM) { id = TCmakeIdCopyString ("TPA"); } else { id = TCmakeIdCopyString ("TAG"); @@ -2112,9 +2110,9 @@ MakeFunApArgIdNt (node *id) node *icm, *st = NULL; DBUG_ENTER (); - if (TYPES_MUTC_USAGE (ID_NTYPE (id)) == MUTC_US_FUNPARAM) { + if (TYgetMutcUsage (ID_NTYPE (id)) == MUTC_US_FUNPARAM) { st = TCmakeIdCopyString ("FPA"); - } else if (TYPES_MUTC_USAGE (ID_NTYPE (id)) == MUTC_US_THREADPARAM) { + } else if (TYgetMutcUsage (ID_NTYPE (id)) == MUTC_US_THREADPARAM) { st = TCmakeIdCopyString ("FTA"); } else { st = TCmakeIdCopyString ("FAG"); @@ -2139,7 +2137,7 @@ MakeFunApArgIdNtThread (node *id) node *icm, *st = NULL; DBUG_ENTER (); - if (TYPES_MUTC_USAGE (ID_NTYPE (id)) == MUTC_US_THREADPARAM) { + if (TYgetMutcUsage (ID_NTYPE (id)) == MUTC_US_THREADPARAM) { st = TCmakeIdCopyString ("TPA"); } else { st = TCmakeIdCopyString ("TAG"); @@ -2198,8 +2196,8 @@ MakeFunApArgs (node *ap, info *arg_info) if (FUNDEF_RTSPECID (fundef) != NULL && global.config.rtspec && ((fundef_in_current_namespace && FUNDEF_ISEXPORTED (fundef)) || !fundef_in_current_namespace)) { - shape = NTUgetShapeClassFromTypes (IDS_NTYPE (argtab->ptr_out[i])); - dim = TCgetDim (IDS_NTYPE (argtab->ptr_out[i])); + shape = NTUgetShapeClassFromNType (IDS_NTYPE (argtab->ptr_out[i])); + dim = TUgetDimEncoding (IDS_NTYPE (argtab->ptr_out[i])); exprs = TBmakeExprs (TBmakeNum (shape), exprs); exprs = TBmakeExprs (TBmakeNum (dim), exprs); } @@ -2211,7 +2209,7 @@ MakeFunApArgs (node *ap, info *arg_info) } else { exprs = TBmakeExprs (TCmakeIdCopyString ( GetBaseTypeFromExpr (argtab->ptr_out[i])), - TBmakeExprs (TBmakeNum (TYPES_DIM ( + TBmakeExprs (TBmakeNum (TUgetFullDimEncoding ( IDS_NTYPE (argtab->ptr_out[i]))), exprs)); } @@ -2226,7 +2224,7 @@ MakeFunApArgs (node *ap, info *arg_info) = TBmakeExprs (MakeFunApArgIdNt (EXPRS_EXPR (argtab->ptr_in[i])), icm_args); } else { - if ((ARG_TYPE (FUNDEF_ARGTAB (fundef)->ptr_in[i]))->scope + if (TYgetMutcScope (ARG_NTYPE (FUNDEF_ARGTAB (fundef)->ptr_in[i])) == MUTC_SHARED) { shared = TRUE; exprs @@ -2245,9 +2243,9 @@ MakeFunApArgs (node *ap, info *arg_info) if (FUNDEF_RTSPECID (fundef) != NULL && global.config.rtspec && ((fundef_in_current_namespace && FUNDEF_ISEXPORTED (fundef)) || !fundef_in_current_namespace)) { - shape = NTUgetShapeClassFromTypes ( + shape = NTUgetShapeClassFromNType ( ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); - dim = TCgetDim (ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); + dim = TUgetDimEncoding (ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); exprs = TBmakeExprs (TBmakeNum (shape), exprs); exprs = TBmakeExprs (TBmakeNum (dim), exprs); } @@ -2260,7 +2258,7 @@ MakeFunApArgs (node *ap, info *arg_info) } else { exprs = TBmakeExprs (TCmakeIdCopyString ( GetBaseTypeFromExpr (argtab->ptr_in[i])), - TBmakeExprs (TBmakeNum (TYPES_DIM (ID_NTYPE ( + TBmakeExprs (TBmakeNum (TUgetFullDimEncoding (ID_NTYPE ( EXPRS_EXPR (argtab->ptr_in[i])))), exprs)); } @@ -2293,9 +2291,9 @@ MakeFunApArgs (node *ap, info *arg_info) if (FUNDEF_RTSPECID (fundef) != NULL && global.config.rtspec && ((fundef_in_current_namespace && FUNDEF_ISEXPORTED (fundef)) || !fundef_in_current_namespace)) { - shape = NTUgetShapeClassFromTypes ( + shape = NTUgetShapeClassFromNType ( ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); - dim = TCgetDim (ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); + dim = TUgetDimEncoding (ID_NTYPE (EXPRS_EXPR (argtab->ptr_in[i]))); exprs = TBmakeExprs (TBmakeNum (shape), exprs); exprs = TBmakeExprs (TBmakeNum (dim), exprs); } @@ -3080,7 +3078,7 @@ AddDescParams (node *ops, node *params) if (ops != NULL) { if (WITHOP_SUB (ops) != NULL) { shape_class_t shapeClass - = NTUgetShapeClassFromTypes (ID_NTYPE (WITHOP_SUB (ops))); + = NTUgetShapeClassFromNType (ID_NTYPE (WITHOP_SUB (ops))); if (shapeClass == C_akd || shapeClass == C_aud) { node *arg2 = TBmakeExprs (TCmakeIcm2 ("SET_NT_USG", TCmakeIdCopyString ("TPA"), @@ -3384,13 +3382,17 @@ COMPfundef (node *arg_node, info *arg_info) node * COMPvardec (node *arg_node, info *arg_info) { +#ifndef DBUG_OFF + char *tmp_str = NULL; +#endif + DBUG_ENTER (); - /* if( TYisUser( AVIS_DECLTYPE( VARDEC_AVIS( arg_node)))) { - DBUG_PRINT( "COMP", ("Sync!!!")); - } */ + DBUG_EXECUTE (tmp_str = TYtype2DebugString (VARDEC_NTYPE (arg_node), FALSE, 0); ); + DBUG_PRINT (" var \"%s\" of type %s", VARDEC_NAME (arg_node), tmp_str); + DBUG_EXECUTE (tmp_str = MEMfree (tmp_str);); - if (TCgetBasetype (VARDEC_TYPE (arg_node)) == T_sync) { + if (TUgetSimpleImplementationType (VARDEC_NTYPE (arg_node)) == T_sync) { if (global.backend != BE_mutc) { DBUG_PRINT ("Removing sync vardec"); @@ -3412,16 +3414,16 @@ COMPvardec (node *arg_node, info *arg_info) VARDEC_ICM (arg_node) = TCmakeIcm1 ("SAC_MUTC_DECL_INDEX", TCmakeIdCopyString (VARDEC_NAME (arg_node))); } else if (FUNDEF_ISCUDAGLOBALFUN (INFO_FUNDEF (arg_info)) && - /* !CUisDeviceTypeOld( VARDEC_TYPE( arg_node)) && */ + /* !CUisDeviceTypeNew( VARDEC_NTYPE( arg_node)) && */ AVIS_ISCUDALOCAL (VARDEC_AVIS (arg_node)) - && TCgetShapeDim (VARDEC_TYPE (arg_node)) > 0) { + && TUgetFullDimEncoding (VARDEC_NTYPE (arg_node)) > 0) { VARDEC_ICM (arg_node) = TCmakeIcm1 ("CUDA_DECL_KERNEL_ARRAY", MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), TRUE, TRUE, TRUE, NULL)); } else if (FUNDEF_ISCUDAGLOBALFUN (INFO_FUNDEF (arg_info)) - && CUisShmemTypeOld (VARDEC_TYPE (arg_node)) - && TCgetShapeDim (VARDEC_TYPE (arg_node)) != 0) { + && CUisShmemTypeNew (VARDEC_NTYPE (arg_node)) + && TUgetFullDimEncoding (VARDEC_NTYPE (arg_node)) != 0) { VARDEC_ICM (arg_node) = TCmakeIcm1 ("CUDA_DECL_SHMEM_ARRAY", MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), @@ -3434,8 +3436,7 @@ COMPvardec (node *arg_node, info *arg_info) TRUE, FALSE, FALSE, NULL), VARDEC_INIT (arg_node)); VARDEC_INIT (arg_node) = NULL; - } else if (TYPES_TDEF (VARDEC_TYPE (arg_node)) != NULL - && TYPEDEF_ISNESTED (TYPES_TDEF (VARDEC_TYPE (arg_node)))) { + } else if (TUisNested (VARDEC_NTYPE (arg_node)) ) { VARDEC_ICM (arg_node) = TCmakeIcm1 ("ND_DECL_NESTED", MakeTypeArgs (VARDEC_NAME (arg_node), VARDEC_NTYPE (arg_node), @@ -3513,10 +3514,12 @@ COMPblock (node *arg_node, info *arg_info) ASSIGN_NEXT (assign)); } + DBUG_PRINT (" traversing assignments..."); if (BLOCK_ASSIGNS (arg_node) != NULL) { BLOCK_ASSIGNS (arg_node) = TRAVopt (BLOCK_ASSIGNS (arg_node), arg_info); } + DBUG_PRINT (" traversing vardecs..."); if (BLOCK_VARDECS (arg_node) != NULL) { BLOCK_VARDECS (arg_node) = TRAVdo (BLOCK_VARDECS (arg_node), arg_info); } @@ -3644,7 +3647,7 @@ MakeFunRetArgs (node *arg_node, info *arg_info) new_args = TBmakeExprs (TCmakeIdCopyString (global.argtag_string[argtab->tag[i]]), TBmakeExprs (MakeArgNode (i, - RET_TYPE (argtab->ptr_out[i]), + TYcopyType (RET_TYPE (argtab->ptr_out[i])), FUNDEF_ISTHREADFUN (fundef)), TBmakeExprs (DUPdupIdNt ( EXPRS_EXPR (ret_exprs)), @@ -3766,7 +3769,7 @@ MakeFunRetArgsSpmd (node *arg_node, info *arg_info) DBUG_ASSERT (vardecs != NULL, "Too few vardecs in SPMD function"); val_nt = TBmakeId (VARDEC_AVIS (vardecs)); - ID_NT_TAG (val_nt) = NTUcreateNtTag (ID_NAME (val_nt), VARDEC_TYPE (vardecs)); + ID_NT_TAG (val_nt) = NTUcreateNtTagFromNType (ID_NAME (val_nt), VARDEC_NTYPE (vardecs)); vardecs = VARDEC_NEXT (vardecs); if (foldfun == NULL) { @@ -3962,7 +3965,7 @@ COMPApIds (node *ap, info *arg_info) if (global.argtag_is_out[tag]) { /* it is an out- (but no inout-) parameter */ if (!global.argtag_has_shp[tag]) { /* function sets no shape information */ - shape_class_t sc = NTUgetShapeClassFromTypes ( + shape_class_t sc = NTUgetShapeClassFromNType ( IDS_NTYPE (((node *)argtab->ptr_out[i]))); DBUG_ASSERT (sc != C_unknowns, "illegal data class found!"); if ((sc == C_akd) || (sc == C_aud)) { @@ -4036,7 +4039,7 @@ AddDescArgs (node *ops, node *args) if (ops != NULL) { if (WITHOP_SUB (ops) != NULL) { shape_class_t shapeClass - = NTUgetShapeClassFromTypes (ID_NTYPE (WITHOP_SUB (ops))); + = NTUgetShapeClassFromNType (ID_NTYPE (WITHOP_SUB (ops))); if (shapeClass == C_akd || shapeClass == C_aud) { node *newArg = TBmakeExprs (TCmakeIdCopyString ("in_justdesc"), @@ -4730,46 +4733,6 @@ COMPid (node *arg_node, info *arg_info) DBUG_RETURN (ret_node); } -/** - * - * @fn types *GetType( node *arg_node) - * - * @brief Return the type of an id or ids. - * - *****************************************************************************/ - -/* - * This code is very bad style!!!!! - * Because of the way types are handled in this phases it is needed :( - * Hopfully with the removal of old types this can also be removed. - */ -static types * -GetType (node *arg_node) -{ - types *type = NULL; - node *decl = NULL; - - DBUG_ENTER (); - - if (NODE_TYPE (arg_node) == N_ids) { - decl = IDS_DECL (arg_node); - } else if (NODE_TYPE (arg_node) == N_id) { - decl = ID_DECL (arg_node); - } else { - DBUG_UNREACHABLE ("Unexpected node type\n"); - } - - if (NODE_TYPE (decl) == N_vardec) { - type = VARDEC_TYPE (decl); - } else if (NODE_TYPE (decl) == N_arg) { - type = ARG_TYPE (decl); - } else { - DBUG_UNREACHABLE ("Unexpected node type\n"); - } - - DBUG_RETURN (type); -} - /** * * @fn node *MakeIcm_PRF_TYPE_CONV_AKD( node *let_ids, node *id, @@ -4788,25 +4751,24 @@ MakeIcm_PRF_TYPE_CONV_AKD (char *error, node *let_ids, node *id) ret_node = TCmakeAssignIcm3 ("SAC_ND_PRF_TYPE_CONV__AKD_END", TBmakeStr (STRcpy (error)), - TCmakeIdCopyStringNt (AVIS_NAME (IDS_AVIS (let_ids)), - GetType (let_ids)), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (id)), GetType (id)), + TCmakeIdCopyStringNtNew (IDS_NAME (let_ids), IDS_NTYPE (let_ids)), + TCmakeIdCopyStringNtNew (ID_NAME (id), ID_NTYPE (id)), ret_node); - for (i = DIM_NO_OFFSET (TCgetShapeDim (GetType (let_ids))) - 1; i >= 0; i--) { + for (i = DIM_NO_OFFSET (TUgetFullDimEncoding (IDS_NTYPE (let_ids))) - 1; i >= 0; i--) { ret_node = TCmakeAssignIcm3 ("SAC_ND_PRF_TYPE_CONV__AKD_SHAPE", TBmakeNum (i), - TCmakeIdCopyStringNt (AVIS_NAME (IDS_AVIS (let_ids)), - GetType (let_ids)), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (id)), - GetType (id)), + TCmakeIdCopyStringNtNew (IDS_NAME (let_ids), + IDS_NTYPE (let_ids)), + TCmakeIdCopyStringNtNew (ID_NAME (id), + ID_NTYPE (id)), ret_node); } ret_node = TCmakeAssignIcm3 ("SAC_ND_PRF_TYPE_CONV__AKD_START", TBmakeStr (STRcpy (error)), - TCmakeIdCopyStringNt (AVIS_NAME (IDS_AVIS (let_ids)), - GetType (let_ids)), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (id)), GetType (id)), + TCmakeIdCopyStringNtNew (IDS_NAME (let_ids), + IDS_NTYPE (let_ids)), + TCmakeIdCopyStringNtNew (ID_NAME (id), ID_NTYPE (id)), ret_node); DBUG_RETURN (ret_node); @@ -4830,25 +4792,24 @@ MakeIcm_PRF_TYPE_CONV_AKS (char *error, node *let_ids, node *id) ret_node = TCmakeAssignIcm3 ("SAC_ND_PRF_TYPE_CONV__AKS_END", TBmakeStr (STRcpy (error)), - TCmakeIdCopyStringNt (AVIS_NAME (IDS_AVIS (let_ids)), - GetType (let_ids)), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (id)), GetType (id)), + TCmakeIdCopyStringNtNew (IDS_NAME (let_ids), IDS_NTYPE (let_ids)), + TCmakeIdCopyStringNtNew (ID_NAME (id), ID_NTYPE (id)), ret_node); - for (i = DIM_NO_OFFSET (TCgetShapeDim (GetType (let_ids))) - 1; i >= 0; i--) { + for (i = DIM_NO_OFFSET (TUgetFullDimEncoding (IDS_NTYPE (let_ids))) - 1; i >= 0; i--) { ret_node = TCmakeAssignIcm3 ("SAC_ND_PRF_TYPE_CONV__AKS_COND", TBmakeNum (i), - TCmakeIdCopyStringNt (AVIS_NAME (IDS_AVIS (let_ids)), - GetType (let_ids)), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (id)), - GetType (id)), + TCmakeIdCopyStringNtNew (IDS_NAME (let_ids), + IDS_NTYPE (let_ids)), + TCmakeIdCopyStringNtNew (ID_NAME (id), + ID_NTYPE (id)), ret_node); } ret_node = TCmakeAssignIcm3 ("SAC_ND_PRF_TYPE_CONV__AKS_START", TBmakeStr (STRcpy (error)), - TCmakeIdCopyStringNt (AVIS_NAME (IDS_AVIS (let_ids)), - GetType (let_ids)), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (id)), GetType (id)), + TCmakeIdCopyStringNtNew (IDS_NAME (let_ids), + IDS_NTYPE (let_ids)), + TCmakeIdCopyStringNtNew (ID_NAME (id), ID_NTYPE (id)), ret_node); DBUG_RETURN (ret_node); @@ -4937,8 +4898,8 @@ COMPprfTypeConv (node *arg_node, info *arg_info) let_ids = INFO_LASTIDS (arg_info); id = EXPRS_EXPR (EXPRS_NEXT (PRF_ARGS (arg_node))); - lhs_type_string = CVtype2String (GetType (let_ids), 0, FALSE); - rhs_type_string = CVtype2String (GetType (id), 0, FALSE); + lhs_type_string = CVtype2String (IDS_NTYPE (let_ids), 0, FALSE); + rhs_type_string = CVtype2String (ID_NTYPE (id), 0, FALSE); error_len = STRlen (fmt) - (2 * 6) + STRlen (NODE_FILE (arg_node)) + STRsizeInt () + STRlen (rhs_type_string) + STRlen (AVIS_NAME (ID_AVIS (id))) @@ -4948,24 +4909,24 @@ COMPprfTypeConv (node *arg_node, info *arg_info) sprintf (error, fmt, NODE_FILE (arg_node), NODE_LINE (arg_node), rhs_type_string, AVIS_NAME (ID_AVIS (id)), lhs_type_string, AVIS_NAME (IDS_AVIS (let_ids))); - if ((SCALAR != TCgetShapeDim (GetType (let_ids))) - && (KNOWN_SHAPE (TCgetShapeDim (GetType (let_ids))) + if ((SCALAR != TUgetFullDimEncoding (IDS_NTYPE (let_ids))) + && (KNOWN_SHAPE (TUgetFullDimEncoding (IDS_NTYPE (let_ids))) && (global.min_array_rep <= MAR_scl_aks))) { /* ASK needs the mirror */ ret_node = MakeIcm_PRF_TYPE_CONV_AKS (error, let_ids, id); - } else if (SCALAR != TCgetShapeDim (GetType (let_ids)) - && KNOWN_DIMENSION (TCgetShapeDim (GetType (let_ids))) + } else if (SCALAR != TUgetFullDimEncoding (IDS_NTYPE (let_ids)) + && KNOWN_DIMENSION (TUgetFullDimEncoding (IDS_NTYPE (let_ids))) && (global.min_array_rep <= MAR_scl_akd)) { /* ASK needs the mirror */ ret_node = MakeIcm_PRF_TYPE_CONV_AKD (error, let_ids, id); } else { ret_node = TCmakeAssignIcm3 ("SAC_ND_PRF_TYPE_CONV", TBmakeStr (STRcpy (error)), - TCmakeIdCopyStringNt (AVIS_NAME (IDS_AVIS (let_ids)), - GetType (let_ids)), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (id)), - GetType (id)), + TCmakeIdCopyStringNtNew (AVIS_NAME (IDS_AVIS (let_ids)), + IDS_NTYPE (let_ids)), + TCmakeIdCopyStringNtNew (AVIS_NAME (ID_AVIS (id)), + ID_NTYPE (id)), NULL); } MEMfree (lhs_type_string); @@ -4989,7 +4950,7 @@ static node * COMPprfFromUnq (node *arg_node, info *arg_info) { node *let_ids; - types *lhs_type, *rhs_type; + ntype *lhs_type, *rhs_type; node *ret_node, *arg; DBUG_ENTER (); @@ -5008,10 +4969,10 @@ COMPprfFromUnq (node *arg_node, info *arg_info) */ lhs_type = IDS_NTYPE (let_ids); - DBUG_ASSERT (!TCisUnique (lhs_type), "from_unq() with unique LHS found!"); + DBUG_ASSERT (!TUisUniqueUserType (lhs_type), "from_unq() with unique LHS found!"); rhs_type = ID_NTYPE (arg); - if (!TCisUnique (rhs_type)) { + if (!TUisUniqueUserType (rhs_type)) { /* * non-unique type * -> ignore from_unq() in order to get a simpler ICM code @@ -5069,7 +5030,7 @@ COMPprfToUnq (node *arg_node, info *arg_info) lhs_type = IDS_NTYPE (let_ids); rhs_type = ID_NTYPE (arg); - DBUG_ASSERT (!TCisUnique (rhs_type), "to_unq() with unique RHS found!"); + DBUG_ASSERT (!TUisUniqueUserType (rhs_type), "to_unq() with unique RHS found!"); icm_args = MakeTypeArgs (IDS_NAME (let_ids), lhs_type, FALSE, TRUE, FALSE, @@ -5714,11 +5675,11 @@ COMPprfRestorerc (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm2 ("ND_PRF_RESTORERC", - TCmakeIdCopyStringNt (AVIS_NAME ( - IDS_AVIS (INFO_LASTIDS (arg_info))), - GetType (INFO_LASTIDS (arg_info))), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (PRF_ARG1 (arg_node))), - GetType (PRF_ARG1 (arg_node))), + TCmakeIdCopyStringNtNew (AVIS_NAME ( + IDS_AVIS (INFO_LASTIDS (arg_info))), + IDS_NTYPE (INFO_LASTIDS (arg_info))), + TCmakeIdCopyStringNtNew (AVIS_NAME (ID_AVIS (PRF_ARG1 (arg_node))), + ID_NTYPE (PRF_ARG1 (arg_node))), NULL); DBUG_RETURN (ret_node); @@ -5744,11 +5705,10 @@ COMPprf2norc (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm2 ("ND_PRF_2NORC", - TCmakeIdCopyStringNt (AVIS_NAME ( - IDS_AVIS (INFO_LASTIDS (arg_info))), - GetType (INFO_LASTIDS (arg_info))), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (PRF_ARG1 (arg_node))), - GetType (PRF_ARG1 (arg_node))), + TCmakeIdCopyStringNtNew (IDS_NAME (INFO_LASTIDS (arg_info)), + IDS_NTYPE (INFO_LASTIDS (arg_info))), + TCmakeIdCopyStringNtNew (ID_NAME (PRF_ARG1 (arg_node)), + ID_NTYPE (PRF_ARG1 (arg_node))), NULL); DBUG_RETURN (ret_node); @@ -5780,11 +5740,10 @@ COMPprf2asyncrc (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm2 ("ND_PRF_2ASYNC", - TCmakeIdCopyStringNt (AVIS_NAME ( - IDS_AVIS (INFO_LASTIDS (arg_info))), - GetType (INFO_LASTIDS (arg_info))), - TCmakeIdCopyStringNt (AVIS_NAME (ID_AVIS (PRF_ARG1 (arg_node))), - GetType (PRF_ARG1 (arg_node))), + TCmakeIdCopyStringNtNew (IDS_NAME (INFO_LASTIDS (arg_info)), + IDS_NTYPE (INFO_LASTIDS (arg_info))), + TCmakeIdCopyStringNtNew (ID_NAME (PRF_ARG1 (arg_node)), + ID_NTYPE (PRF_ARG1 (arg_node))), ret_node); DBUG_RETURN (ret_node); @@ -5951,7 +5910,7 @@ COMPprfAllocOrResize (node *arg_node, info *arg_info) if (cand != NULL) { ret_node = TCmakeAssignIcm1 ("SAC_IS_LASTREF__BLOCK_END", - TCmakeIdCopyStringNt (ID_NAME (EXPRS_EXPR (cand)), + TCmakeIdCopyStringNtNew (ID_NAME (EXPRS_EXPR (cand)), ID_NTYPE (EXPRS_EXPR (cand))), ret_node); } @@ -6024,16 +5983,16 @@ COMPprfSuballoc (node *arg_node, info *arg_info) let_ids = INFO_LASTIDS (arg_info); mem_id = PRF_ARG1 (arg_node); - sc = NTUgetShapeClassFromTypes (IDS_NTYPE (let_ids)); + sc = NTUgetShapeClassFromNType (IDS_NTYPE (let_ids)); DBUG_ASSERT (sc != C_scl, "scalars cannot be suballocated\n"); if (INFO_WITHLOOP (arg_info) != NULL && WITH_CUDARIZABLE (INFO_WITHLOOP (arg_info))) { ret_node = TCmakeAssignIcm5 ("CUDA_WL_SUBALLOC", DUPdupIdsIdNt (let_ids), - TBmakeNum (TCgetShapeDim (IDS_NTYPE (let_ids))), + TBmakeNum (TUgetFullDimEncoding (IDS_NTYPE (let_ids))), DUPdupIdNt (PRF_ARG1 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG1 (arg_node)))), + TBmakeNum (TUgetFullDimEncoding (ID_NTYPE (PRF_ARG1 (arg_node)))), DUPdupIdNt (PRF_ARG2 (arg_node)), NULL); } else if (global.backend == BE_distmem) { ret_node = TCmakeAssignIcm3 ("WL_DISTMEM_SUBALLOC", DUPdupIdsIdNt (let_ids), @@ -6070,7 +6029,7 @@ COMPprfSuballoc (node *arg_node, info *arg_info) * information always has to be present! */ if (TCcountExprs (PRF_ARGS (arg_node)) >= 4) { - if (!KNOWN_SHAPE (TCgetShapeDim (IDS_NTYPE (let_ids)))) { + if (!KNOWN_SHAPE (TUgetFullDimEncoding (IDS_NTYPE (let_ids)))) { #if 0 /* Still may be present if not canonical */ DBUG_ASSERT (PRF_ARG4( arg_node) != NULL, "missing shape information for suballoc"); #endif @@ -6094,7 +6053,7 @@ COMPprfSuballoc (node *arg_node, info *arg_info) */ INFO_POSTFUN (arg_info) = TCmakeAssignIcm1 ("ND_FREE__DESC", - TCmakeIdCopyStringNt (IDS_NAME (let_ids), + TCmakeIdCopyStringNtNew (IDS_NAME (let_ids), IDS_NTYPE (let_ids)), INFO_POSTFUN (arg_info)); #endif @@ -6351,10 +6310,10 @@ COMPprfCopy (node *arg_node, info *arg_info) GenericFun (GF_copy, ID_NTYPE (PRF_ARG1 (arg_node)))), NULL); } else { - src_basetype = TCgetBasetype (ID_NTYPE (PRF_ARG1 (arg_node))); - dst_basetype = TCgetBasetype (IDS_NTYPE (let_ids)); + src_basetype = TUgetSimpleImplementationType (ID_NTYPE (PRF_ARG1 (arg_node))); + dst_basetype = TUgetSimpleImplementationType (IDS_NTYPE (let_ids)); - if (CUisDeviceTypeOld (ID_NTYPE (PRF_ARG1 (arg_node))) + if (CUisDeviceTypeNew (ID_NTYPE (PRF_ARG1 (arg_node))) && (src_basetype == dst_basetype) && !FUNDEF_ISCUDAGLOBALFUN (INFO_FUNDEF (arg_info))) { ret_node @@ -6769,8 +6728,8 @@ COMPprfReshape (node *arg_node, info *arg_info) TCmakeIdCopyString (copyfun), ret_node))); - dim_new = TCgetDim (IDS_NTYPE (let_ids)); - dim_old = TCgetDim (ID_NTYPE (PRF_ARG4 (arg_node))); + dim_new = TUgetDimEncoding (IDS_NTYPE (let_ids)); + dim_old = TUgetDimEncoding (ID_NTYPE (PRF_ARG4 (arg_node))); if ((dim_new >= 0) && (dim_old >= 0) && (dim_new <= dim_old)) { /* @@ -6893,7 +6852,7 @@ COMPprfIdxSel (node *arg_node, info *arg_info) TBmakeExprs (DUPdupNodeNt (arg1), NULL)); /* idx_sel() works only for arrays with known dimension!!! */ - dim = TCgetDim (IDS_NTYPE (let_ids)); + dim = TUgetDimEncoding (IDS_NTYPE (let_ids)); DBUG_ASSERT (dim >= 0, "unknown dimension found!"); /* The ICM depends on whether we use the distributed memory backend @@ -6949,7 +6908,7 @@ COMPprfIdxModarray_AxSxS (node *arg_node, info *arg_info) || (NODE_TYPE (arg2) == N_prf)), "2nd arg of F_idx_modarray_AxSxS is neither N_id nor N_num, N_prf!"); DBUG_ASSERT (((NODE_TYPE (arg2) != N_id) - || (TCgetBasetype (ID_NTYPE (arg2)) == T_int)), + || (TUgetSimpleImplementationType (ID_NTYPE (arg2)) == T_int)), "2nd arg of F_idx_modarray_AxSxS is a illegal indexing var!"); DBUG_ASSERT (NODE_TYPE (arg3) != N_array, "3rd arg of F_idx_modarray_AxSxS is a N_array!"); @@ -7025,13 +6984,13 @@ COMPprfIdxModarray_AxSxA (node *arg_node, info *arg_info) || (NODE_TYPE (arg2) == N_prf)), "2nd arg of F_idx_modarray_AxSxA is neither N_id nor N_num, N_prf!"); DBUG_ASSERT (((NODE_TYPE (arg2) != N_id) - || (TCgetBasetype (ID_NTYPE (arg2)) == T_int)), + || (TUgetSimpleImplementationType (ID_NTYPE (arg2)) == T_int)), "2nd arg of F_idx_modarray_AxSxA is a illegal indexing var!"); DBUG_ASSERT (NODE_TYPE (arg3) != N_array, "3rd arg of F_idx_modarray_AxSxA is a N_array!"); if ((global.backend == BE_cuda || global.backend == BE_cudahybrid) - && CUisDeviceTypeOld (ID_NTYPE (arg1)) && CUisDeviceTypeOld (ID_NTYPE (arg3)) + && CUisDeviceTypeNew (ID_NTYPE (arg1)) && CUisDeviceTypeNew (ID_NTYPE (arg3)) && !FUNDEF_ISCUDAGLOBALFUN (INFO_FUNDEF (arg_info))) { ret_node = TCmakeAssignIcm4 ("CUDA_PRF_IDX_MODARRAY_AxSxA__DATA", @@ -7140,7 +7099,7 @@ COMPprfSel (node *arg_node, info *arg_info) DBUG_ASSERT (NODE_TYPE (arg2) == N_id, "2nd arg of F_sel_VxA is no N_id!"); if (NODE_TYPE (arg1) == N_id) { - DBUG_ASSERT (TCgetBasetype (ID_NTYPE (arg1)) == T_int, + DBUG_ASSERT (TUgetSimpleImplementationType (ID_NTYPE (arg1)) == T_int, "1st arg of F_sel_VxA is a illegal indexing var!"); icm_args @@ -7232,7 +7191,7 @@ COMPsimd_prfSel (node *arg_node, info *arg_info) base_type_node = TCmakeIdCopyString (GetBaseTypeFromExpr (arg2)); if (NODE_TYPE (arg1) == N_id) { - DBUG_ASSERT (TCgetBasetype (ID_NTYPE (arg1)) == T_int, + DBUG_ASSERT (TUgetSimpleImplementationType (ID_NTYPE (arg1)) == T_int, "1st arg of F_sel_VxA is a illegal indexing var!"); icm_args @@ -7364,7 +7323,7 @@ COMPprfSelI (node *arg_node, info *arg_info) arg2 = PRF_ARG2 (arg_node); if (NODE_TYPE (arg1) == N_id) { - DBUG_ASSERT ((TCgetBasetype (ID_NTYPE (arg1)) == T_int), + DBUG_ASSERT ((TUgetSimpleImplementationType (ID_NTYPE (arg1)) == T_int), "1st arg of F_sel_VxA is a illegal indexing var!"); icm_args @@ -7431,7 +7390,7 @@ COMPprfModarray_AxVxS (node *arg_node, info *arg_info) "3rd arg of F_modarray_AxVxS is a N_array!"); if (NODE_TYPE (arg2) == N_id) { - DBUG_ASSERT ((TCgetBasetype (ID_NTYPE (arg2)) == T_int), + DBUG_ASSERT ((TUgetSimpleImplementationType (ID_NTYPE (arg2)) == T_int), "2nd arg of F_modarray_AxVxS is a illegal indexing var!"); ret_node @@ -7497,7 +7456,7 @@ COMPprfModarray_AxVxA (node *arg_node, info *arg_info) "3rd arg of F_modarray_AxVxA is a N_array!"); if (NODE_TYPE (arg2) == N_id) { - DBUG_ASSERT ((TCgetBasetype (ID_NTYPE (arg2)) == T_int), + DBUG_ASSERT ((TUgetSimpleImplementationType (ID_NTYPE (arg2)) == T_int), "2nd arg of F_modarray_AxVxA is a illegal indexing var!"); ret_node @@ -7726,7 +7685,7 @@ COMPprfOp_S (node *arg_node, info *arg_info) /* assure that the prf has exactly one argument */ DBUG_ASSERT (PRF_EXPRS2 (arg_node) == NULL, "more than a single argument found!"); - DBUG_ASSERT (NODE_TYPE (arg) != N_id || TCgetShapeDim (ID_NTYPE (arg)) == SCALAR, + DBUG_ASSERT (NODE_TYPE (arg) != N_id || TUgetFullDimEncoding (ID_NTYPE (arg)) == SCALAR, "non-scalar argument `%s' found!", global.prf_name[PRF_PRF (arg_node)]); /* If enforce float flag is set, we change all tods to tofs */ @@ -7793,14 +7752,14 @@ is_simd_type (node *n) if (NODE_TYPE (n) == N_id) { node *av = AVIS_DECL (ID_AVIS (n)); - types *type = NULL; + ntype *type = NULL; if (NODE_TYPE (av) == N_vardec) - type = VARDEC_TYPE (av); + type = VARDEC_NTYPE (av); else if (NODE_TYPE (av) == N_arg) - type = ARG_TYPE (av); + type = ARG_NTYPE (av); else DBUG_UNREACHABLE ("unexpected node type of avis"); - return TCgetBasetype (type) == T_floatvec; + return TUgetSimpleImplementationType (type) == T_floatvec; } DBUG_ASSERT (NODE_TYPE (n) != N_ids, "N_ids in binary prf -- WTF? O_o"); @@ -7843,12 +7802,12 @@ COMPprfOp_SxS (node *arg_node, info *arg_info) arg2 = PRF_ARG2 (arg_node); DBUG_ASSERT (((NODE_TYPE (arg1) != N_id) - || (TCgetShapeDim (ID_NTYPE (arg1)) == SCALAR)), + || (TUgetFullDimEncoding (ID_NTYPE (arg1)) == SCALAR)), "%s: non-scalar first argument found!", global.prf_name[PRF_PRF (arg_node)]); DBUG_ASSERT (((NODE_TYPE (arg2) != N_id) - || (TCgetShapeDim (ID_NTYPE (arg2)) == SCALAR)), + || (TUgetFullDimEncoding (ID_NTYPE (arg2)) == SCALAR)), "%s: non-scalar second argument found!", global.prf_name[PRF_PRF (arg_node)]); @@ -7882,7 +7841,7 @@ COMPprfOp_SxS (node *arg_node, info *arg_info) } else if (NODE_TYPE (arg1) == N_double) { ty_str = "T_double"; } else if (NODE_TYPE (arg1) == N_id) { - stype = TCgetBasetype (ID_NTYPE (arg1)); + stype = TUgetSimpleImplementationType (ID_NTYPE (arg1)); if (stype == T_int) { ty_str = "T_int"; } else if (stype == T_float) { @@ -7936,7 +7895,7 @@ COMPprfOp_SxV (node *arg_node, info *arg_info) arg2 = PRF_ARG2 (arg_node); DBUG_ASSERT (((NODE_TYPE (arg1) != N_id) - || (TCgetShapeDim (ID_NTYPE (arg1)) == SCALAR)), + || (TUgetFullDimEncoding (ID_NTYPE (arg1)) == SCALAR)), "%s: non-scalar first argument found!", global.prf_name[PRF_PRF (arg_node)]); @@ -7979,7 +7938,7 @@ COMPprfOp_VxS (node *arg_node, info *arg_info) arg2 = PRF_ARG2 (arg_node); DBUG_ASSERT (((NODE_TYPE (arg2) != N_id) - || (TCgetShapeDim (ID_NTYPE (arg2)) == SCALAR)), + || (TUgetFullDimEncoding (ID_NTYPE (arg2)) == SCALAR)), "%s: non-scalar second argument found!", global.prf_name[PRF_PRF (arg_node)]); ret_node = TCmakeAssignIcm3 ("ND_PRF_VxS__DATA", DUPdupIdsIdNt (let_ids), @@ -8398,13 +8357,13 @@ COMPprfArrayVect2Offset (node *arg_node, info *arg_info) "First argument of F_array_vect2offset must be an N_id Node!"); icm = TCmakeIcm5 ("ND_ARRAY_VECT2OFFSET_id", DUPdupIdsIdNt (let_ids), - TBmakeNum (TCgetTypesLength (ID_NTYPE (iv_vect))), + TBmakeNum (SHgetUnrLen (TYgetShape (ID_NTYPE (iv_vect)))), DUPdupIdNt (iv_vect), MakeDimArg (PRF_ARG1 (arg_node), TRUE), DUPdupIdNt (PRF_ARG1 (arg_node))); /* icm = TCmakeIcm5( "ND_VECT2OFFSET_id", DUPdupIdsIdNt( let_ids), - TBmakeNum( TCgetTypesLength( ID_NTYPE( iv_vect))), + TBmakeNum( SHgetUnrLen (TYgetShape( ID_NTYPE( iv_vect)))), DUPdupIdNt( iv_vect), MakeSizeArg( PRF_ARG1( arg_node), TRUE), DUPdupIdNt( PRF_ARG1( arg_node))); @@ -8439,12 +8398,12 @@ COMPprfVect2Offset (node *arg_node, info *arg_info) */ if (NODE_TYPE (PRF_ARG1 (arg_node)) == N_array) { icm = TCmakeIcm5 ("ND_VECT2OFFSET_arr", DUPdupIdsIdNt (let_ids), - TBmakeNum (TCgetTypesLength (ID_NTYPE (iv_vect))), + TBmakeNum (SHgetUnrLen (TYgetShape (ID_NTYPE (iv_vect)))), DUPdupIdNt (iv_vect), MakeSizeArg (PRF_ARG1 (arg_node), TRUE), DupExprs_NT_AddReadIcms (ARRAY_AELEMS (PRF_ARG1 (arg_node)))); } else if (NODE_TYPE (PRF_ARG1 (arg_node)) == N_id) { icm = TCmakeIcm5 ("ND_VECT2OFFSET_id", DUPdupIdsIdNt (let_ids), - TBmakeNum (TCgetTypesLength (ID_NTYPE (iv_vect))), + TBmakeNum (SHgetUnrLen (TYgetShape (ID_NTYPE (iv_vect)))), DUPdupIdNt (iv_vect), MakeSizeArg (PRF_ARG1 (arg_node), TRUE), DUPdupIdNt (PRF_ARG1 (arg_node))); #ifndef DBUG_OFF @@ -8841,9 +8800,9 @@ COMPprfSameShape (node *arg_node, info *arg_info) ret_node = TCmakeAssignIcm5 ("ND_PRF_SAME_SHAPE", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG1 (arg_node)))), + TBmakeNum (TUgetFullDimEncoding (ID_NTYPE (PRF_ARG1 (arg_node)))), DUPdupIdNt (PRF_ARG2 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG2 (arg_node)))), + TBmakeNum (TUgetFullDimEncoding (ID_NTYPE (PRF_ARG2 (arg_node)))), NULL); DBUG_RETURN (ret_node); @@ -8932,7 +8891,7 @@ COMPprfValLtShape (node *arg_node, info *arg_info) = TCmakeAssignIcm4 ("ND_PRF_VAL_LT_SHAPE_VxA", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), DUPdupIdNt (PRF_ARG2 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG2 (arg_node)))), + TBmakeNum (TUgetFullDimEncoding (ID_NTYPE (PRF_ARG2 (arg_node)))), NULL); DBUG_RETURN (ret_node); @@ -9023,7 +8982,7 @@ COMPprfProdMatchesProdShape (node *arg_node, info *arg_info) = TCmakeAssignIcm4 ("ND_PRF_PROD_MATCHES_PROD_SHAPE", DUPdupIdsIdNt (let_ids), DUPdupIdNt (PRF_ARG1 (arg_node)), DUPdupIdNt (PRF_ARG2 (arg_node)), - TBmakeNum (TCgetShapeDim (ID_NTYPE (PRF_ARG2 (arg_node)))), + TBmakeNum (TUgetFullDimEncoding (ID_NTYPE (PRF_ARG2 (arg_node)))), NULL); DBUG_RETURN (ret_node); @@ -10203,7 +10162,7 @@ MakeIcm_GETVAR_ifNeeded (node *arg_node) if (NODE_TYPE (arg_node) == N_id) { node *res = TCmakeIcm2 ("SAC_ND_GETVAR", - TCmakeIdCopyStringNt (ID_NAME (arg_node), ID_NTYPE (arg_node)), + TCmakeIdCopyStringNtNew (ID_NAME (arg_node), ID_NTYPE (arg_node)), TCmakeIdCopyString (ID_NAME (arg_node))); arg_node = FREEdoFreeTree (arg_node); arg_node = res; @@ -10275,7 +10234,7 @@ MakeIcm_WL_SET_OFFSET (node *arg_node, node *assigns) node *idx_min, *idx_max; int d; size_t d_u; - shpseg *shape; + shape *shp; int icm_dim = (-1); node *withop; node *tmp_ids; @@ -10327,7 +10286,7 @@ MakeIcm_WL_SET_OFFSET (node *arg_node, node *assigns) * full range (== -1, if the segment's domain equals the full index * vector space) */ - shape = TYPES_SHPSEG (IDS_NTYPE (tmp_ids)); + shp = TYgetShape (IDS_NTYPE (tmp_ids)); d = dims - 1; d_u = d; while (d >= 0) { @@ -10337,8 +10296,8 @@ MakeIcm_WL_SET_OFFSET (node *arg_node, node *assigns) if ((NODE_TYPE (idx_min) == N_num) && (NODE_TYPE (idx_max) == N_num) && (((NUM_VAL (idx_min) == 0) && (NUM_VAL (idx_max) == IDX_SHAPE)) - || ((shape != NULL) - && (NUM_VAL (idx_max) == SHPSEG_SHAPE (shape, d_u))))) { + || ((shp != NULL) + && (NUM_VAL (idx_max) == SHgetExtent (shp, d_u))))) { d--; d_u--; } else { @@ -10465,10 +10424,10 @@ COMPwith (node *arg_node, info *arg_info) if (isfold) { icm_chain = TCmakeAssignIcm3 ("AUD_WL_FOLD_END", - TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_NTYPE (idx_id)), - TCmakeIdCopyStringNt (ID_NAME (lower_id), + TCmakeIdCopyStringNtNew (ID_NAME (idx_id), ID_NTYPE (idx_id)), + TCmakeIdCopyStringNtNew (ID_NAME (lower_id), ID_NTYPE (lower_id)), - TCmakeIdCopyStringNt (ID_NAME (upper_id), + TCmakeIdCopyStringNtNew (ID_NAME (upper_id), ID_NTYPE (upper_id)), icm_chain); icm_chain = TCmakeAssignIcm0 ("AUD_WL_COND_END", icm_chain); @@ -10477,10 +10436,10 @@ COMPwith (node *arg_node, info *arg_info) icm_chain = TCappendAssign (generator_icms, icm_chain); icm_chain = TCmakeAssignIcm3 ("AUD_WL_FOLD_BEGIN", - TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_NTYPE (idx_id)), - TCmakeIdCopyStringNt (ID_NAME (lower_id), + TCmakeIdCopyStringNtNew (ID_NAME (idx_id), ID_NTYPE (idx_id)), + TCmakeIdCopyStringNtNew (ID_NAME (lower_id), ID_NTYPE (lower_id)), - TCmakeIdCopyStringNt (ID_NAME (upper_id), + TCmakeIdCopyStringNtNew (ID_NAME (upper_id), ID_NTYPE (upper_id)), icm_chain); @@ -10503,7 +10462,7 @@ COMPwith (node *arg_node, info *arg_info) if (WITHOP_SUB (WITH_WITHOP (arg_node)) != NULL) { node *sub_id = WITHOP_SUB (WITH_WITHOP (arg_node)); icm_chain = TCmakeAssignIcm1 ("ND_FREE__DESC", - TCmakeIdCopyStringNt (ID_NAME (sub_id), + TCmakeIdCopyStringNtNew (ID_NAME (sub_id), ID_NTYPE (sub_id)), icm_chain); } @@ -10518,9 +10477,9 @@ COMPwith (node *arg_node, info *arg_info) icm_chain = TCmakeAssignIcm3 ("AUD_WL_END", - TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_NTYPE (idx_id)), - TCmakeIdCopyStringNt (ID_NAME (offs_id), ID_NTYPE (offs_id)), - TCmakeIdCopyStringNt (IDS_NAME (res_ids), + TCmakeIdCopyStringNtNew (ID_NAME (idx_id), ID_NTYPE (idx_id)), + TCmakeIdCopyStringNtNew (ID_NAME (offs_id), ID_NTYPE (offs_id)), + TCmakeIdCopyStringNtNew (IDS_NAME (res_ids), IDS_NTYPE (res_ids)), icm_chain); icm_chain = TCmakeAssignIcm0 ("AUD_WL_COND_END", icm_chain); @@ -10531,9 +10490,9 @@ COMPwith (node *arg_node, info *arg_info) icm_chain = TCappendAssign (generator_icms, icm_chain); icm_chain = TCmakeAssignIcm3 ("AUD_WL_BEGIN", - TCmakeIdCopyStringNt (ID_NAME (idx_id), ID_NTYPE (idx_id)), - TCmakeIdCopyStringNt (ID_NAME (offs_id), ID_NTYPE (offs_id)), - TCmakeIdCopyStringNt (IDS_NAME (res_ids), + TCmakeIdCopyStringNtNew (ID_NAME (idx_id), ID_NTYPE (idx_id)), + TCmakeIdCopyStringNtNew (ID_NAME (offs_id), ID_NTYPE (offs_id)), + TCmakeIdCopyStringNtNew (IDS_NAME (res_ids), IDS_NTYPE (res_ids)), icm_chain); @@ -10552,10 +10511,10 @@ COMPwith (node *arg_node, info *arg_info) sub_get_dim = TCmakeIcm2 (prf_ccode_tab[F_sub_SxS], TCmakeIcm1 ("ND_A_DIM", - TCmakeIdCopyStringNt (IDS_NAME (res_ids), + TCmakeIdCopyStringNtNew (IDS_NAME (res_ids), IDS_NTYPE (res_ids))), TCmakeIcm1 ("ND_A_SIZE", - TCmakeIdCopyStringNt (ID_NAME (idx_id), + TCmakeIdCopyStringNtNew (ID_NAME (idx_id), ID_NTYPE (idx_id)))); /* @@ -10563,7 +10522,7 @@ COMPwith (node *arg_node, info *arg_info) * (genarray only) */ if ((NODE_TYPE (WITH_WITHOP (arg_node)) == N_genarray) - && (!KNOWN_SHAPE (TCgetShapeDim (ID_NTYPE (sub_id))))) { + && (!KNOWN_SHAPE (TUgetFullDimEncoding (ID_NTYPE (sub_id))))) { if (GENARRAY_DEFAULT (WITH_WITHOP (arg_node)) != NULL) { DBUG_PRINT ("creating COPY__SHAPE for SUBALLOC var"); /* @@ -10591,7 +10550,7 @@ COMPwith (node *arg_node, info *arg_info) "cannot create subvar shape"); } } else if ((NODE_TYPE (WITH_WITHOP (arg_node)) == N_modarray) - && (!KNOWN_SHAPE (TCgetShapeDim (ID_NTYPE (sub_id))))) { + && (!KNOWN_SHAPE (TUgetFullDimEncoding (ID_NTYPE (sub_id))))) { DBUG_PRINT ("creating WL_MODARRAY_SUBSHAPE for SUBALLOC var"); /* * set shape in modarray case based upon result @@ -10599,9 +10558,9 @@ COMPwith (node *arg_node, info *arg_info) */ sub_set_shape = TCmakeIcm4 ("WL_MODARRAY_SUBSHAPE", - TCmakeIdCopyStringNt (ID_NAME (sub_id), ID_NTYPE (sub_id)), + TCmakeIdCopyStringNtNew (ID_NAME (sub_id), ID_NTYPE (sub_id)), DUPdupIdNt (WITHID_VEC (WITH_WITHID (arg_node))), - TBmakeNum (TCgetDim (ID_NTYPE (sub_id))), + TBmakeNum (TUgetDimEncoding (ID_NTYPE (sub_id))), DUPdupIdsIdNt (res_ids)); icm_chain = TBmakeAssign (sub_set_shape, icm_chain); } @@ -10699,28 +10658,28 @@ COMPgenerator (node *arg_node, info *arg_info) INFO_ICMCHAIN (arg_info) = TCmakeAssignIcm3 ((INFO_ISFOLD (arg_info) ? "AUD_WL_FOLD_LU_GEN" : "AUD_WL_LU_GEN"), - TCmakeIdCopyStringNt (ID_NAME (lower), ID_NTYPE (lower)), - TCmakeIdCopyStringNt (ID_NAME (idx), ID_NTYPE (idx)), - TCmakeIdCopyStringNt (ID_NAME (upper), ID_NTYPE (upper)), + TCmakeIdCopyStringNtNew (ID_NAME (lower), ID_NTYPE (lower)), + TCmakeIdCopyStringNtNew (ID_NAME (idx), ID_NTYPE (idx)), + TCmakeIdCopyStringNtNew (ID_NAME (upper), ID_NTYPE (upper)), NULL); } else if (width == NULL) { INFO_ICMCHAIN (arg_info) = TCmakeAssignIcm4 ((INFO_ISFOLD (arg_info) ? "AUD_WL_FOLD_LUS_GEN" : "AUD_WL_LUS_GEN"), - TCmakeIdCopyStringNt (ID_NAME (lower), ID_NTYPE (lower)), - TCmakeIdCopyStringNt (ID_NAME (idx), ID_NTYPE (idx)), - TCmakeIdCopyStringNt (ID_NAME (upper), ID_NTYPE (upper)), - TCmakeIdCopyStringNt (ID_NAME (step), ID_NTYPE (step)), + TCmakeIdCopyStringNtNew (ID_NAME (lower), ID_NTYPE (lower)), + TCmakeIdCopyStringNtNew (ID_NAME (idx), ID_NTYPE (idx)), + TCmakeIdCopyStringNtNew (ID_NAME (upper), ID_NTYPE (upper)), + TCmakeIdCopyStringNtNew (ID_NAME (step), ID_NTYPE (step)), NULL); } else { INFO_ICMCHAIN (arg_info) = TCmakeAssignIcm5 ((INFO_ISFOLD (arg_info) ? "AUD_WL_FOLD_LUSW_GEN" : "AUD_WL_LUSW_GEN"), - TCmakeIdCopyStringNt (ID_NAME (lower), ID_NTYPE (lower)), - TCmakeIdCopyStringNt (ID_NAME (idx), ID_NTYPE (idx)), - TCmakeIdCopyStringNt (ID_NAME (upper), ID_NTYPE (upper)), - TCmakeIdCopyStringNt (ID_NAME (step), ID_NTYPE (step)), - TCmakeIdCopyStringNt (ID_NAME (width), ID_NTYPE (width)), + TCmakeIdCopyStringNtNew (ID_NAME (lower), ID_NTYPE (lower)), + TCmakeIdCopyStringNtNew (ID_NAME (idx), ID_NTYPE (idx)), + TCmakeIdCopyStringNtNew (ID_NAME (upper), ID_NTYPE (upper)), + TCmakeIdCopyStringNtNew (ID_NAME (step), ID_NTYPE (step)), + TCmakeIdCopyStringNtNew (ID_NAME (width), ID_NTYPE (width)), NULL); } DBUG_RETURN (arg_node); @@ -10850,7 +10809,7 @@ COMPwith2 (node *arg_node, info *arg_info) * (genarray only) */ if ((NODE_TYPE (withop) == N_genarray) - && (!KNOWN_SHAPE (TCgetShapeDim (ID_NTYPE (sub_id))))) { + && (!KNOWN_SHAPE (TUgetFullDimEncoding (ID_NTYPE (sub_id))))) { if (GENARRAY_DEFAULT (withop) != NULL) { DBUG_PRINT ("creating COPY__SHAPE for SUBALLOC var"); /* @@ -10876,7 +10835,7 @@ COMPwith2 (node *arg_node, info *arg_info) "cannot create subvar shape"); } } else if ((NODE_TYPE (withop) == N_modarray) - && (!KNOWN_SHAPE (TCgetShapeDim (ID_NTYPE (sub_id))))) { + && (!KNOWN_SHAPE (TUgetFullDimEncoding (ID_NTYPE (sub_id))))) { DBUG_PRINT ("creating WL_MODARRAY_SUBSHAPE for SUBALLOC var"); /* * set shape in modarray case based upon result @@ -10884,10 +10843,10 @@ COMPwith2 (node *arg_node, info *arg_info) */ sub_set_shape = TCmakeIcm4 ("WL_MODARRAY_SUBSHAPE", - TCmakeIdCopyStringNt (ID_NAME (sub_id), + TCmakeIdCopyStringNtNew (ID_NAME (sub_id), ID_NTYPE (sub_id)), DUPdupIdNt (WITHID_VEC (WITH2_WITHID (arg_node))), - TBmakeNum (TCgetDim (ID_NTYPE (sub_id))), + TBmakeNum (TUgetDimEncoding (ID_NTYPE (sub_id))), DUPdupIdsIdNt (tmp_ids)); alloc_icms = TBmakeAssign (sub_set_shape, alloc_icms); @@ -10903,7 +10862,7 @@ COMPwith2 (node *arg_node, info *arg_info) * Free descriptor of subarray */ free_icms = TCmakeAssignIcm1 ("ND_FREE__DESC", - TCmakeIdCopyStringNt (ID_NAME (sub_id), + TCmakeIdCopyStringNtNew (ID_NAME (sub_id), ID_NTYPE (sub_id)), free_icms); } @@ -11053,16 +11012,16 @@ COMPwith3AllocDesc (node *ops, node **pre, node **post) || ((NODE_TYPE (ops) == N_modarray) && (MODARRAY_SUB (ops) != NULL))) { node *sub = NODE_TYPE (ops) == N_genarray ? GENARRAY_SUB (ops) : MODARRAY_SUB (ops); - int dim = TCgetDim (ID_NTYPE (WITHOP_MEM (ops))); + int dim = TUgetDimEncoding (ID_NTYPE (WITHOP_MEM (ops))); DBUG_ASSERT (dim >= 0, "Can only handle AKD or better"); *pre = MakeMutcLocalAllocDescIcm (ID_NAME (sub), ID_NTYPE (sub), 1, TBmakeNum (dim), *pre); *pre = TCmakeAssignIcm2 ("ND_DECL__DESC", - TCmakeIdCopyStringNt (ID_NAME (sub), ID_NTYPE (sub)), + TCmakeIdCopyStringNtNew (ID_NAME (sub), ID_NTYPE (sub)), TCmakeIdCopyString (""), *pre); #if FREE_LOCAL *post = TCmakeAssignIcm1 ("ND_FREE__DESC", - TCmakeIdCopyStringNt (ID_NAME (sub), ID_NTYPE (sub)), + TCmakeIdCopyStringNtNew (ID_NAME (sub), ID_NTYPE (sub)), *post); #endif } @@ -11218,7 +11177,7 @@ COMPrange (node *arg_node, info *arg_info) DBUG_ASSERT (IDS_NEXT (INFO_WITH3_FOLDS (arg_info)) == NULL, "Only single fold with3 loops supported"); save = TCmakeAssignIcm1 ("SAC_MUTC_SAVE", - TCmakeIdCopyStringNt (IDS_NAME ( + TCmakeIdCopyStringNtNew (IDS_NAME ( INFO_WITH3_FOLDS (arg_info)), IDS_NTYPE (INFO_WITH3_FOLDS ( arg_info))), diff --git a/src/libsac2c/global/NameTuplesUtils.c b/src/libsac2c/global/NameTuplesUtils.c index 81810aeb8..7e40fe14c 100644 --- a/src/libsac2c/global/NameTuplesUtils.c +++ b/src/libsac2c/global/NameTuplesUtils.c @@ -354,6 +354,35 @@ NTUgetDistributedFromTypes (types *type) DBUG_RETURN (d); } +/****************************************************************************** + * + * function: + * distributed_class_t NTUgetDistributedFromNType( ntype *type) + * + * description: + * + ******************************************************************************/ + +distributed_class_t +NTUgetDistributedFromNType (ntype *type) +{ + distributed_class_t d; + + DBUG_ENTER (); + + DBUG_ASSERT (type != NULL, "No type found!"); + + if (TYgetDistributed (type) == distmem_dis_dis) { + d = C_distr; + } else if (TYgetDistributed (type) == distmem_dis_dsm) { + d = C_distmem; + } else { + d = C_notdistr; + } + + DBUG_RETURN (d); +} + /****************************************************************************** * * function: @@ -398,6 +427,42 @@ NTUgetCBasetypeFromTypes (types *type) DBUG_RETURN (b); } +/****************************************************************************** + * + * function: + * cbasetype_class_t NTUgetCBasetypeFromNType( ntype *type) + * + * description: + * + * Note: This has to be kept in sync with GetBasetypeStr + * (compile.c) !!! + * + ******************************************************************************/ + +cbasetype_class_t +NTUgetCBasetypeFromNType (ntype *type) +{ + cbasetype_class_t b; + simpletype basetype; + + DBUG_ENTER (); + + DBUG_ASSERT (type != NULL, "No type found!"); + + basetype = TUgetSimpleImplementationType (type); + b = global.type_cbasetype[basetype]; + + /* + * If the enforce_float flag is set, + * we change all doubles to floats. + */ + if (b == C_btdouble && global.enforce_float) { + b = C_btfloat; + } + + DBUG_RETURN (b); +} + /****************************************************************************** * * function: @@ -813,6 +878,8 @@ NTUcreateNtTagFromNType (const char *name, ntype *ntype) mutc_scope_class_t scope; mutc_usage_class_t usage; bitarray_class_t bitarray; + distributed_class_t distr; + cbasetype_class_t cbasetype; DBUG_ENTER (); @@ -828,20 +895,27 @@ NTUcreateNtTagFromNType (const char *name, ntype *ntype) bitarray = NTUgetBitarrayFromNType (ntype); + distr = NTUgetDistributedFromNType (ntype); + + cbasetype = NTUgetCBasetypeFromNType (ntype); + res = (char *)MEMmalloc ( (STRlen (name) + STRlen (global.nt_shape_string[sc]) + STRlen (global.nt_hidden_string[hc]) + STRlen (global.nt_unique_string[uc]) + STRlen (global.nt_mutc_storage_class_string[storage]) + STRlen (global.nt_mutc_scope_string[scope]) + STRlen (global.nt_mutc_usage_string[usage]) - + STRlen (global.nt_bitarray_string[bitarray]) + (8 * 4) + 1) + + STRlen (global.nt_bitarray_string[bitarray]) + + STRlen (global.nt_distributed_string[distr]) + + STRlen (global.nt_cbasetype_string[cbasetype]) + (10 * 4) + 1) * sizeof (char)); - sprintf (res, "(%s, (%s, (%s, (%s, (%s, (%s, (%s, (%s, ))))))))", name, + sprintf (res, "(%s, (%s, (%s, (%s, (%s, (%s, (%s, (%s, (%s, (%s, ))))))))))", name, global.nt_shape_string[sc], global.nt_hidden_string[hc], global.nt_unique_string[uc], global.nt_mutc_storage_class_string[storage], global.nt_mutc_scope_string[scope], global.nt_mutc_usage_string[usage], - global.nt_bitarray_string[bitarray]); + global.nt_bitarray_string[bitarray], global.nt_distributed_string[distr], + global.nt_cbasetype_string[cbasetype]); DBUG_RETURN (res); } diff --git a/src/libsac2c/global/NameTuplesUtils.h b/src/libsac2c/global/NameTuplesUtils.h index df579a441..61a8bb67e 100644 --- a/src/libsac2c/global/NameTuplesUtils.h +++ b/src/libsac2c/global/NameTuplesUtils.h @@ -33,5 +33,6 @@ extern mutc_storage_class_class_t NTUgetMutcStorageClassFromNType (ntype *ntype) extern mutc_scope_class_t NTUgetMutcScopeFromNType (ntype *ntype); extern mutc_usage_class_t NTUgetMutcUsageFromNType (ntype *ntype); extern bitarray_class_t NTUgetBitarrayFromNtype (ntype *ntype); +extern distributed_class_t NTUgetDistributedFromNType (ntype *type); #endif /* _SAC_NAMETUPLESUTILS_H_ */ diff --git a/src/libsac2c/global/phase_sac2c.mac b/src/libsac2c/global/phase_sac2c.mac index 3c3ff687a..4879eba61 100644 --- a/src/libsac2c/global/phase_sac2c.mac +++ b/src/libsac2c/global/phase_sac2c.mac @@ -1509,8 +1509,10 @@ PHASE (cg, "Generating Code", !global.on_demand_lib) SUBPHASE (tp, "Tag preparation", TPdoTagPreparation, ALWAYS, cg) +#if 0 SUBPHASE (ctr, "Converting to old type representation", CTRdoConvertToOldTypes, ALWAYS, cg) +#endif SUBPHASE (cpl, "Creating intermediate code macros", COMPdoCompile, ALWAYS, cg) diff --git a/src/libsac2c/precompile/renameidentifiers.c b/src/libsac2c/precompile/renameidentifiers.c index 8decc7e59..61b5a398a 100644 --- a/src/libsac2c/precompile/renameidentifiers.c +++ b/src/libsac2c/precompile/renameidentifiers.c @@ -8,7 +8,7 @@ #include "renameidentifiers.h" #include "tree_basic.h" -#define DBUG_PREFIX "PREC" +#define DBUG_PREFIX "RID" #include "debug.h" #include "traverse.h" @@ -401,11 +401,15 @@ RIDfundef (node *arg_node, info *arg_info) { DBUG_ENTER (); + DBUG_PRINT ("processing function \"%s\"", CTIitemName (arg_node)); + if (FUNDEF_ARGS (arg_node) != NULL) { + DBUG_PRINT (" processing args ..."); FUNDEF_ARGS (arg_node) = TRAVdo (FUNDEF_ARGS (arg_node), arg_info); } if (FUNDEF_BODY (arg_node) != NULL) { + DBUG_PRINT (" processing body ..."); FUNDEF_BODY (arg_node) = TRAVdo (FUNDEF_BODY (arg_node), arg_info); } @@ -431,7 +435,7 @@ RIDfundef (node *arg_node, info *arg_info) node * RIDarg (node *arg_node, info *arg_info) { - types *ot; + ntype *type; DBUG_ENTER (); @@ -444,13 +448,12 @@ RIDarg (node *arg_node, info *arg_info) */ if (AVIS_DECLTYPE (ARG_AVIS (arg_node)) != NULL) { - ot = TYtype2OldType (AVIS_DECLTYPE (ARG_AVIS (arg_node))); + type = AVIS_DECLTYPE (ARG_AVIS (arg_node)); } else { - ot = TYtype2OldType (AVIS_TYPE (ARG_AVIS (arg_node))); + type = AVIS_TYPE (ARG_AVIS (arg_node)); } - ARG_TYPESTRING (arg_node) = CVtype2String (ot, 2, TRUE); - ot = FREEfreeOneTypes (ot); + ARG_TYPESTRING (arg_node) = CVtype2String (type, 2, TRUE); arg_node = TRAVcont (arg_node, arg_info); diff --git a/src/libsac2c/print/convert.c b/src/libsac2c/print/convert.c index 24e54d16d..71f2e10a4 100644 --- a/src/libsac2c/print/convert.c +++ b/src/libsac2c/print/convert.c @@ -29,6 +29,10 @@ static char *rename_type[] = { #include "free.h" #include "constants_internal.h" #include "globals.h" +#include "new_types.h" +#include "user_types.h" +#include "type_utils.h" +#include "namespaces.h" #include "str.h" #include "memory.h" @@ -135,9 +139,10 @@ CVdouble2String (double val) */ char * -CVtype2String (types *type, int flag, bool all) +CVtype2String (ntype *type, int flag, bool all) { char *tmp_string; + usertype udt; DBUG_ENTER (); @@ -147,106 +152,88 @@ CVtype2String (types *type, int flag, bool all) if (type == NULL) { strcat (tmp_string, "(null)"); } else { - do { - if (TYPES_BASETYPE (type) == T_user) { - if ((flag != 3) && (TYPES_MOD (type) != NULL)) { - strcat (tmp_string, TYPES_MOD (type)); - if (global.compiler_phase >= PH_pc) { - strcat (tmp_string, "__"); - } else { - strcat (tmp_string, ":"); - } + if (TUisArrayOfUser (type)) { + udt = TYgetUserType (TYgetScalar (type)); + if ((flag != 3) && (UTgetNamespace (udt) != NULL)) { + strcat (tmp_string, NSgetModule (UTgetNamespace (udt))); + if (global.compiler_phase >= PH_pc) { + strcat (tmp_string, "__"); + } else { + strcat (tmp_string, ":"); } - strcat (tmp_string, TYPES_NAME (type)); + } + strcat (tmp_string, UTgetName (udt)); + } else { + if (flag == 2) { + strcat (tmp_string, rename_type[TYgetSimpleType (TYgetScalar (type))]); } else { + strcat (tmp_string, type_string[TYgetSimpleType (TYgetScalar (type))]); + } + } + + if (!TUisScalar (type)) { + if (TYisAUDGZ (type)) { if (flag == 2) { - strcat (tmp_string, rename_type[TYPES_BASETYPE (type)]); + strcat (tmp_string, "_P"); } else { - strcat (tmp_string, type_string[TYPES_BASETYPE (type)]); + strcat (tmp_string, "[+]"); } - } - - if (TYPES_DIM (type) != 0) { - if (TYPES_DIM (type) == UNKNOWN_SHAPE) { - if (flag == 2) { - strcat (tmp_string, "_P"); - } else { - strcat (tmp_string, "[+]"); - } + } else if (TYisAUD (type)) { + if (flag == 2) { + strcat (tmp_string, "_S"); } else { - if (ARRAY_OR_SCALAR == TYPES_DIM (type)) { + strcat (tmp_string, "[*]"); + } + } else { + int i, dim; + static char int_string[INT_STRING_LENGTH]; + if (flag == 2) { + strcat (tmp_string, "_"); + } else { + strcat (tmp_string, "["); + } + dim = TYgetDim (type); + + for (i = 0; i < dim; i++) { + if (i != (dim - 1)) { if (flag == 2) { - strcat (tmp_string, "_S"); + if (TYisAKS (type)) { + sprintf (int_string, "%d_", + SHgetExtent (TYgetShape (type), i)); + } else { + sprintf (int_string, "X_"); + } } else { - strcat (tmp_string, "[*]"); + if (TYisAKS (type)) { + sprintf (int_string, "%d,", + SHgetExtent (TYgetShape (type), i)); + } else { + sprintf (int_string, ".,"); + } } + strcat (tmp_string, int_string); } else { - int i, dim; - static char int_string[INT_STRING_LENGTH]; - int known_shape = 1; if (flag == 2) { - strcat (tmp_string, "_"); - } else { - strcat (tmp_string, "["); - } - if (KNOWN_DIM_OFFSET > TYPES_DIM (type)) { - dim = KNOWN_DIM_OFFSET - TYPES_DIM (type); - known_shape = 0; + if (TYisAKS (type)) { + sprintf (int_string, "%d", + SHgetExtent (TYgetShape (type), i)); + } else { + sprintf (int_string, "X"); + } } else { - dim = TYPES_DIM (type); - } - - for (i = 0; i < dim; i++) { - if (i != (dim - 1)) { - if (flag == 2) { - if (known_shape == 1) { - sprintf (int_string, "%d_", - TYPES_SHAPE (type, i)); - } else { - sprintf (int_string, "X_"); - } - } else { - if (known_shape == 1) { - sprintf (int_string, "%d,", - TYPES_SHAPE (type, i)); - } else { - sprintf (int_string, ".,"); - } - } - strcat (tmp_string, int_string); + if (TYisAKS (type)) { + sprintf (int_string, "%d]", + SHgetExtent (TYgetShape (type), i)); } else { - if (flag == 2) { - if (known_shape == 1) { - sprintf (int_string, "%d", TYPES_SHAPE (type, i)); - } else { - sprintf (int_string, "X"); - } - } else { - if (1 == known_shape) { - sprintf (int_string, "%d]", - TYPES_SHAPE (type, i)); - } else { - sprintf (int_string, ".]"); - } - } - - strcat (tmp_string, int_string); + sprintf (int_string, ".]"); } } + + strcat (tmp_string, int_string); } } } - - type = TYPES_NEXT (type); - - if (!all) { /* break after first type in list */ - type = NULL; - } - - if (type != NULL) { - strcat (tmp_string, ", "); - } - } while (type != NULL); + } } DBUG_RETURN (tmp_string); diff --git a/src/libsac2c/print/convert.h b/src/libsac2c/print/convert.h index 62bf4d931..45a321861 100644 --- a/src/libsac2c/print/convert.h +++ b/src/libsac2c/print/convert.h @@ -4,7 +4,7 @@ #include "types.h" extern char *CVfloatvec2String (floatvec val); -extern char *CVtype2String (types *type, int flag, bool all); +extern char *CVtype2String (ntype *type, int flag, bool all); extern char *CVdouble2String (double); extern char *CVfloat2String (float); extern char *CVfloatvec2String (floatvec val); diff --git a/src/libsac2c/print/print.c b/src/libsac2c/print/print.c index 236e85476..6f10ac3ac 100644 --- a/src/libsac2c/print/print.c +++ b/src/libsac2c/print/print.c @@ -1859,8 +1859,6 @@ PrintDispatchFun (node *fundef, void *arg_info) static void PrintFunctionHeader (node *arg_node, info *arg_info, bool in_comment) { - types *ret_types; - char *type_str; bool print_sac = TRUE; bool print_c = FALSE; bool print_argtab = FALSE; @@ -1939,17 +1937,7 @@ PrintFunctionHeader (node *arg_node, info *arg_info, bool in_comment) /* * Print old types. */ - ret_types = FUNDEF_TYPES (arg_node); - while (ret_types != NULL) { - type_str = CVtype2String (ret_types, 0, FALSE); - fprintf (global.outfile, "%s", type_str); - type_str = MEMfree (type_str); - - ret_types = TYPES_NEXT (ret_types); - if (ret_types != NULL) { - fprintf (global.outfile, ", "); - } - } + DBUG_ASSERT( FALSE, "encountered old types on fundef!"); } else { /* * We do have new types ! @@ -2479,7 +2467,8 @@ PRTarg (node *arg_node, info *arg_info) if (ARG_NTYPE (arg_node) != NULL) { type_str = TYtype2String (ARG_NTYPE (arg_node), FALSE, 0); } else { - type_str = CVtype2String (ARG_TYPE (arg_node), 0, TRUE); + DBUG_ASSERT (FALSE, "encountered old types on args"); + type_str = NULL; } fprintf (global.outfile, " %s ", type_str); type_str = MEMfree (type_str); @@ -2682,9 +2671,7 @@ PRTvardec (node *arg_node, info *arg_info) fprintf (global.outfile, "; "); if (VARDEC_TYPE (arg_node) != NULL) { - type_str = CVtype2String (VARDEC_TYPE (arg_node), 0, TRUE); - fprintf (global.outfile, "/* %s */", type_str); - type_str = MEMfree (type_str); + DBUG_ASSERT (FALSE, "encountered old types on vardec!"); } if (AVIS_DECLTYPE (VARDEC_AVIS (arg_node)) != NULL) { @@ -3530,6 +3517,10 @@ PRTid (node *arg_node, info *arg_info) fprintf (global.outfile, "%s", text); + DBUG_EXECUTE_TAG ("PRINT_TAGS", if (ID_NT_TAG (arg_node) != NULL) { + fprintf (global.outfile, " /* tag: %s */", ID_NT_TAG (arg_node)); + }); + if (global.print.avis) { if (ID_AVIS (arg_node) != NULL) { fprintf (global.outfile, "/* avis: %p */", (void *)ID_AVIS (arg_node)); @@ -4236,6 +4227,7 @@ PRTicm (node *arg_node, info *arg_info) if ((global.compiler_subphase == PH_cg_prt) || (global.compiler_subphase == PH_ccg_prt)) { + #define ICM_ALL #define ICM_DEF(prf, trf) \ if (STReq (ICM_NAME (arg_node), #prf)) { \ diff --git a/src/libsac2c/tree/DupTree.c b/src/libsac2c/tree/DupTree.c index 3dafa5ff3..73d2d5f94 100644 --- a/src/libsac2c/tree/DupTree.c +++ b/src/libsac2c/tree/DupTree.c @@ -3709,8 +3709,8 @@ DUPdupIdsIdNt (node *arg_ids) new_id = DUPdupIdsId (arg_ids); - DBUG_ASSERT (IDS_TYPE (arg_ids) != NULL, "NT_TAG: no type found!"); - ID_NT_TAG (new_id) = NTUcreateNtTag (IDS_NAME (arg_ids), IDS_TYPE (arg_ids)); + DBUG_ASSERT (IDS_NTYPE (arg_ids) != NULL, "NT_TAG: no type found!"); + ID_NT_TAG (new_id) = NTUcreateNtTagFromNType (IDS_NAME (arg_ids), IDS_NTYPE (arg_ids)); DBUG_RETURN (new_id); } @@ -3736,19 +3736,9 @@ DUPdupIdNt (node *arg_id) DBUG_ASSERT (NODE_TYPE (arg_id) == N_id, "DupId_NT: no N_id node found!"); new_id = DUPdoDupNode (arg_id); - DBUG_ASSERT (ID_TYPE (arg_id) != NULL, "NT_TAG: no type found!"); + DBUG_ASSERT (ID_NTYPE (arg_id) != NULL, "NT_TAG: no type found!"); - /* - if((ID_TYPE( arg_id) != NULL)) - { - printf("NOT NULL\n"); - } - else - { - printf("NULL\n"); - } - */ - ID_NT_TAG (new_id) = NTUcreateNtTag (ID_NAME (arg_id), ID_TYPE (arg_id)); + ID_NT_TAG (new_id) = NTUcreateNtTagFromNType (ID_NAME (arg_id), ID_NTYPE (arg_id)); DBUG_RETURN (new_id); } diff --git a/src/libsac2c/tree/check_lib.c b/src/libsac2c/tree/check_lib.c index cd5af7441..f767a9771 100644 --- a/src/libsac2c/tree/check_lib.c +++ b/src/libsac2c/tree/check_lib.c @@ -593,8 +593,7 @@ CHKfundefReturn (node *arg_node) DBUG_ENTER (); - if ((!FUNDEF_ISWRAPPERFUN (arg_node)) && (global.compiler_anyphase >= PH_ptc_l2f) - && (global.compiler_anyphase < PH_cg_ctr)) { + if ((!FUNDEF_ISWRAPPERFUN (arg_node)) && (global.compiler_anyphase >= PH_ptc_l2f)) { assgn = FUNDEF_BODY (arg_node); if (NULL != assgn) { /* Some fns do not have a body. Weird... */ assgn = BLOCK_ASSIGNS (assgn); diff --git a/src/libsac2c/typecheck/new_types.c b/src/libsac2c/typecheck/new_types.c index 3edcd50af..34c362d2c 100644 --- a/src/libsac2c/typecheck/new_types.c +++ b/src/libsac2c/typecheck/new_types.c @@ -5936,10 +5936,12 @@ TYoldType2ScalarType (types *old) DBUG_UNREACHABLE ("TYoldType2Type applied to illegal type"); } +#if 0 DBUG_EXECUTE (tmp = CVtype2String (old, 3, TRUE); tmp2 = TYtype2DebugString (res, TRUE, 0)); DBUG_PRINT ("base type of %s converted into : %s\n", tmp, tmp2); DBUG_EXECUTE (tmp = MEMfree (tmp); tmp2 = MEMfree (tmp2)); +#endif DBUG_RETURN (res); } @@ -5988,10 +5990,12 @@ TYoldType2Type (types *old) } } +#if 0 DBUG_EXECUTE (tmp = CVtype2String (old, 3, TRUE); tmp2 = TYtype2DebugString (res, TRUE, 0)); DBUG_PRINT ("%s converted into : %s\n", tmp, tmp2); DBUG_EXECUTE (tmp = MEMfree (tmp); tmp2 = MEMfree (tmp2)); +#endif DBUG_RETURN (res); } @@ -6168,10 +6172,12 @@ TYtype2OldType (ntype *xnew) res = Type2OldType (xnew); +#if 0 DBUG_EXECUTE (tmp_str2 = CVtype2String (res, 0, TRUE)); DBUG_PRINT ("... result is %s", tmp_str2); DBUG_EXECUTE (tmp_str = MEMfree (tmp_str)); DBUG_EXECUTE (tmp_str2 = MEMfree (tmp_str2)); +#endif DBUG_RETURN (res); } diff --git a/src/libsac2c/typecheck/type_utils.c b/src/libsac2c/typecheck/type_utils.c index 2cb540d13..e4cc55657 100644 --- a/src/libsac2c/typecheck/type_utils.c +++ b/src/libsac2c/typecheck/type_utils.c @@ -845,6 +845,28 @@ TUisArrayOfUser (ntype *type) DBUG_RETURN (res); } +/** + * + * @fn bool TUisArrayOfUser( ntype *ty) + * + * @brief + * @param + * @return + * + ******************************************************************************/ + +bool +TUisArrayOfSimple (ntype *type) +{ + bool res; + + DBUG_ENTER (); + + res = (TYisArray (type) && TYisSimple (TYgetScalar (type))); + + DBUG_RETURN (res); +} + /** * * @fn bool TUcontainsUser( ntype *ty) @@ -1705,7 +1727,7 @@ TUakvScalInt2Int (ntype *ty) /** * - * @fn int TUgetDimEncoding( ntype *type) + * @fn int TUgetFullDimEncoding( ntype *type) * * @brief: produces the array info encoding needed by the backend: * >= 0 : AKS with result == DIM @@ -1719,7 +1741,7 @@ TUakvScalInt2Int (ntype *ty) * @return the encoding of the dimensionality. * ******************************************************************************/ -int TUgetDimEncoding (ntype *type) +int TUgetFullDimEncoding (ntype *type) { int res; @@ -1738,4 +1760,65 @@ int TUgetDimEncoding (ntype *type) DBUG_RETURN (res); } +/** + * + * @fn int TUgetDimEncoding( ntype *type) + * + * @brief: produces the array info encoding needed by the backend: + * >= 0 : AKS / AKD with result == DIM + * == -1: AUSGZ + * == -2: AUD + * + * + * @param: type: ntype + * + * @return the encoding of the dimensionality. + * + ******************************************************************************/ +int TUgetDimEncoding (ntype *type) +{ + int res; + + DBUG_ENTER (); + + if (TYisAUDGZ (type)) { + res = -1; + } else if (TYisAUD (type)) { + res = -2; + } else { + res = TYgetDim (type); + } + + DBUG_RETURN (res); +} + +/** + * + * @fn simpletype TUgetSimpleImplementationType (ntype *type) + * + * @brief: computes the implementation type and picks the element type of + * it. This should always be a SimpleType since all User-types are + * being followed through to their base. + * + * @param: type: ntype + * + * @return the simpletype in the implementation (can be T-hidden if nested + * or external. + * + ******************************************************************************/ +simpletype TUgetSimpleImplementationType (ntype *type) +{ + ntype *itype; + simpletype res; + + DBUG_ENTER (); + + itype = TUcomputeImplementationType (type); + res = TYgetSimpleType (TYgetScalar (itype)); + itype = TYfreeType (itype); + + DBUG_RETURN (res); +} + + #undef DBUG_PREFIX diff --git a/src/libsac2c/typecheck/type_utils.h b/src/libsac2c/typecheck/type_utils.h index 0c5c21f35..17c5323bf 100644 --- a/src/libsac2c/typecheck/type_utils.h +++ b/src/libsac2c/typecheck/type_utils.h @@ -83,13 +83,19 @@ extern bool TUisVector (ntype *ty); extern bool TUhasBasetype (ntype *ty, simpletype smpl); extern bool TUisUniqueUserType (ntype *type); extern bool TUisArrayOfUser (ntype *type); +extern bool TUisArrayOfSimple (ntype *type); extern bool TUcontainsUser (ntype *type); extern bool TUisHidden (ntype *type); extern bool TUisNested (ntype *type); extern bool TUisBoxed (ntype *type); extern bool TUisPolymorphic (ntype *type); -extern int TUgetDimEncoding (ntype *type): // specifically needed for the backend +/** + * functions mainly needed for code generation: + */ +extern int TUgetFullDimEncoding (ntype *type); +extern int TUgetDimEncoding (ntype *type); +extern simpletype TUgetSimpleImplementationType (ntype *type); /** * type relations: diff --git a/src/libsac2c/xml/ast.xml b/src/libsac2c/xml/ast.xml index db25445fa..95160cfba 100644 --- a/src/libsac2c/xml/ast.xml +++ b/src/libsac2c/xml/ast.xml @@ -5389,7 +5389,7 @@ N_tfarg : - + @@ -5413,7 +5413,7 @@ N_tfarg : - + @@ -6092,7 +6092,7 @@ N_tfarg : - + @@ -6468,7 +6468,7 @@ N_tfarg : - + @@ -8675,7 +8675,7 @@ N_tfarg : - + -- GitLab From 8ed05a497ef2e712b4abb5c23aaa7264c8fd01da Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sat, 21 Nov 2020 20:03:36 +0100 Subject: [PATCH 07/16] minor fix --- src/libsac2c/codegen/compile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index 52896c633..aa732bdda 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -323,7 +323,7 @@ GetBasetypeStr (ntype *type) DBUG_ENTER (); if (TUisArrayOfUser (type)) { - str = UTgetName (TYgetUserType (type)); + str = UTgetName (TYgetUserType (TYgetScalar (type))); DBUG_ASSERT (str != NULL, "Name of user-defined type not found"); } else { DBUG_ASSERT (TUisArrayOfSimple (type), "Expected either array of User or Simple type."); -- GitLab From b9c6f640a372188695186cdb4d53bbb790bb8cec Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sun, 22 Nov 2020 00:38:08 +0100 Subject: [PATCH 08/16] final fixes; stdlib compiles. --- src/libsac2c/codegen/compile.c | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index aa732bdda..2e2fb0ec1 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -428,7 +428,7 @@ MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_sha DBUG_ENTER (); - itype = TUcomputeImplementationType(type); + itype = TUcomputeImplementationType (type); dim = TUgetFullDimEncoding (itype); /* @@ -438,7 +438,7 @@ MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_sha * during icm2c!! */ if (add_shape && (dim > 0)) { // at least AKS - exprs = SHshape2Exprs (TYgetShape (itype)); + exprs = TCappendExprs (SHshape2Exprs (TYgetShape (itype)), exprs); } if (add_dim) { @@ -446,10 +446,10 @@ MakeTypeArgs (char *name, ntype *type, bool add_type, bool add_dim, bool add_sha } if (add_type) { - exprs = TBmakeExprs (MakeBasetypeArg (type), exprs); + exprs = TBmakeExprs (MakeBasetypeArg (itype), exprs); } - exprs = TBmakeExprs (TCmakeIdCopyStringNtNew (name, type), exprs); + exprs = TBmakeExprs (TCmakeIdCopyStringNtNew (name, itype), exprs); itype = TYfreeType (itype); DBUG_RETURN (exprs); @@ -2946,11 +2946,16 @@ COMPmodule (node *arg_node, info *arg_info) node * COMPtypedef (node *arg_node, info *arg_info) { +#ifndef DBUG_OFF + char *tmp_str = NULL; +#endif node *icm = NULL; DBUG_ENTER (); - DBUG_PRINT ("compiling typedef '%s'", TYPEDEF_NAME (arg_node)); + DBUG_EXECUTE (tmp_str = TYtype2DebugString (TYPEDEF_NTYPE (arg_node), FALSE, 0); ); + DBUG_PRINT ("compiling typedef \"%s\"::%s", TYPEDEF_NAME (arg_node), tmp_str); + DBUG_EXECUTE (tmp_str = MEMfree (tmp_str);); icm = TCmakeIcm1 ("ND_TYPEDEF", MakeTypeArgs (TYPEDEF_NAME (arg_node), @@ -2961,6 +2966,8 @@ COMPtypedef (node *arg_node, info *arg_info) if (TYPEDEF_NEXT (arg_node) != NULL) { TYPEDEF_NEXT (arg_node) = TRAVdo (TYPEDEF_NEXT (arg_node), arg_info); + } else { + DBUG_EXECUTE (UTprintRepository (stderr);); } DBUG_RETURN (arg_node); -- GitLab From 60caad40dfcd84ac6be5f6ab089396a75906ed8b Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sun, 22 Nov 2020 09:26:40 +0100 Subject: [PATCH 09/16] chucking CTR (convert to old types) out --- .../codegen/convert_type_representation.c | 254 ------------------ .../codegen/convert_type_representation.h | 14 - src/libsac2c/global/phase_sac2c.mac | 5 - src/libsac2c/global/phase_sac4c.mac | 3 - src/libsac2c/xml/ast.xml | 9 - 5 files changed, 285 deletions(-) delete mode 100644 src/libsac2c/codegen/convert_type_representation.c delete mode 100644 src/libsac2c/codegen/convert_type_representation.h diff --git a/src/libsac2c/codegen/convert_type_representation.c b/src/libsac2c/codegen/convert_type_representation.c deleted file mode 100644 index 1f4dd0ad9..000000000 --- a/src/libsac2c/codegen/convert_type_representation.c +++ /dev/null @@ -1,254 +0,0 @@ -/***************************************************************************** - * - * file: convert_type_representation.c - * - * prefix: CTR - * - * description: - * - * This module restores all types-structures from ntype-structures. - * All ntype-structures will be removed. - * - * - *****************************************************************************/ - -#define DBUG_PREFIX "UNDEFINED" -#include "debug.h" - -#include "convert_type_representation.h" -#include "types.h" -#include "tree_basic.h" -#include "tree_compound.h" -#include "new_types.h" -#include "node_basic.h" -#include "str.h" -#include "memory.h" -#include "traverse.h" -#include "free.h" -#include "type_utils.h" - -/** - * INFO structure - */ -struct INFO { - types *oldtypes; -}; - -/** - * INFO macros - */ -#define INFO_TYPES(n) (n->oldtypes) - -/** - * INFO functions - */ -static info * -MakeInfo (void) -{ - info *result; - - DBUG_ENTER (); - - result = (info *)MEMmalloc (sizeof (info)); - - INFO_TYPES (result) = NULL; - - DBUG_RETURN (result); -} - -static info * -FreeInfo (info *info) -{ - DBUG_ENTER (); - - info = MEMfree (info); - - DBUG_RETURN (info); -} - -/** - * - * @fn node *CTRvardec( node *arg_node, node *arg_info) - * - * @brief traverse vardecs only! - * @param - * @return - * - ******************************************************************************/ - -node * -CTRvardec (node *arg_node, info *arg_info) -{ - ntype *type; - - DBUG_ENTER (); - - type = AVIS_TYPE (VARDEC_AVIS (arg_node)); - DBUG_ASSERT (type != NULL, "missing ntype information"); - - VARDEC_TYPE (arg_node) = TYtype2OldType (type); - - AVIS_TYPE (VARDEC_AVIS (arg_node)) = TYfreeType (type); - - if (VARDEC_NEXT (arg_node) != NULL) { - VARDEC_NEXT (arg_node) = TRAVdo (VARDEC_NEXT (arg_node), arg_info); - } - - DBUG_RETURN (arg_node); -} - -/** - * - * @fn node *CTRarg( node *arg_node, node *arg_info) - * - * @brief traverse vardecs only! - * @param - * @return - * - ******************************************************************************/ - -node * -CTRarg (node *arg_node, info *arg_info) -{ - ntype *type; - - DBUG_ENTER (); - - type = AVIS_TYPE (ARG_AVIS (arg_node)); - DBUG_ASSERT (type != NULL, "missing ntype information"); - - if (ARG_TYPE (arg_node) != NULL) - ARG_TYPE (arg_node) = FREEfreeAllTypes (ARG_TYPE (arg_node)); - - ARG_TYPE (arg_node) = TYtype2OldType (type); - - AVIS_TYPE (ARG_AVIS (arg_node)) = TYfreeType (type); - - if (ARG_NEXT (arg_node) != NULL) { - ARG_NEXT (arg_node) = TRAVdo (ARG_NEXT (arg_node), arg_info); - } - - DBUG_RETURN (arg_node); -} - -/** - * - * @fn node *CTRblock( node *arg_node, node *arg_info) - * - * @brief traverse vardecs only! - * @param - * @return - * - ******************************************************************************/ - -node * -CTRblock (node *arg_node, info *arg_info) -{ - - DBUG_ENTER (); - - if (BLOCK_VARDECS (arg_node) != NULL) { - BLOCK_VARDECS (arg_node) = TRAVdo (BLOCK_VARDECS (arg_node), arg_info); - } - - DBUG_RETURN (arg_node); -} - -/** - * - * @fn node *CTRfundef( node *arg_node, node *arg_info) - * - * @brief - * @param - * @return - * - ******************************************************************************/ - -node * -CTRfundef (node *arg_node, info *arg_info) -{ - DBUG_ENTER (); - - if (FUNDEF_ARGS (arg_node) != NULL) { - FUNDEF_ARGS (arg_node) = TRAVdo (FUNDEF_ARGS (arg_node), arg_info); - } - - if (FUNDEF_BODY (arg_node) != NULL) { - FUNDEF_BODY (arg_node) = TRAVdo (FUNDEF_BODY (arg_node), arg_info); - } - - if (FUNDEF_RETS (arg_node) != NULL) { - FUNDEF_RETS (arg_node) = TRAVdo (FUNDEF_RETS (arg_node), arg_info); - } - - FUNDEF_TYPES (arg_node) = INFO_TYPES (arg_info); - INFO_TYPES (arg_info) = NULL; - - if (FUNDEF_NEXT (arg_node) != NULL) { - FUNDEF_NEXT (arg_node) = TRAVdo (FUNDEF_NEXT (arg_node), arg_info); - } - - DBUG_RETURN (arg_node); -} - -/** - * - * @fn node *CTRret( node *arg_node, node *arg_info) - * - * @brief - * @param - * @return - * - ******************************************************************************/ - -node * -CTRret (node *arg_node, info *arg_info) -{ - ntype *type; - types *old_type; - - DBUG_ENTER (); - - type = RET_TYPE (arg_node); - DBUG_ASSERT (type != NULL, "missing ntype in N_ret!"); - - if (RET_NEXT (arg_node) != NULL) { - RET_NEXT (arg_node) = TRAVdo (RET_NEXT (arg_node), arg_info); - } - - old_type = TYtype2OldType (type); - TYPES_NEXT (old_type) = INFO_TYPES (arg_info); - INFO_TYPES (arg_info) = old_type; - - DBUG_RETURN (arg_node); -} - -/** - * - * @fn node *CTRdoConvertToOldTypes( node *arg_node) - * - * @brief replaces "ntype" info by "types" info - * @param - * @return - * - ******************************************************************************/ - -node * -CTRdoConvertToOldTypes (node *syntax_tree) -{ - info *arg_info; - - DBUG_ENTER (); - - TRAVpush (TR_ctr); - - arg_info = MakeInfo (); - syntax_tree = TRAVdo (syntax_tree, arg_info); - arg_info = FreeInfo (arg_info); - - TRAVpop (); - - DBUG_RETURN (syntax_tree); -} - -#undef DBUG_PREFIX diff --git a/src/libsac2c/codegen/convert_type_representation.h b/src/libsac2c/codegen/convert_type_representation.h deleted file mode 100644 index d76d99f4e..000000000 --- a/src/libsac2c/codegen/convert_type_representation.h +++ /dev/null @@ -1,14 +0,0 @@ -#ifndef _SAC_CONVERT_TYPE_REPRESENTATION_H_ -#define _SAC_CONVERT_TYPE_REPRESENTATION_H_ - -#include "types.h" - -extern node *CTRdoConvertToOldTypes (node *syntax_tree); - -extern node *CTRfundef (node *arg_node, info *arg_info); -extern node *CTRarg (node *arg_node, info *arg_info); -extern node *CTRblock (node *arg_node, info *arg_info); -extern node *CTRvardec (node *arg_node, info *arg_info); -extern node *CTRret (node *arg_node, info *arg_info); - -#endif /* _SAC_CONVERT_TYPE_REPRESENTATION_H_ */ diff --git a/src/libsac2c/global/phase_sac2c.mac b/src/libsac2c/global/phase_sac2c.mac index 4879eba61..18dc80ecb 100644 --- a/src/libsac2c/global/phase_sac2c.mac +++ b/src/libsac2c/global/phase_sac2c.mac @@ -1509,11 +1509,6 @@ PHASE (cg, "Generating Code", !global.on_demand_lib) SUBPHASE (tp, "Tag preparation", TPdoTagPreparation, ALWAYS, cg) -#if 0 -SUBPHASE (ctr, "Converting to old type representation", CTRdoConvertToOldTypes, ALWAYS, - cg) -#endif - SUBPHASE (cpl, "Creating intermediate code macros", COMPdoCompile, ALWAYS, cg) SUBPHASE (pds, "Prepare distributed with-loop schedulers", diff --git a/src/libsac2c/global/phase_sac4c.mac b/src/libsac2c/global/phase_sac4c.mac index ca75f9f9c..a72725efc 100644 --- a/src/libsac2c/global/phase_sac4c.mac +++ b/src/libsac2c/global/phase_sac4c.mac @@ -119,9 +119,6 @@ ENDPHASE (cpc) PHASE (ccg, "Generating Code", ALWAYS) -SUBPHASE (ctr, "Converting to old type representation", CTRdoConvertToOldTypes, ALWAYS, - ccg) - SUBPHASE (cpl, "Creating intermediate code macros", COMPdoCompile, ALWAYS, ccg) SUBPHASE (prt, "Generating C file(s)", PRTdoPrint, ALWAYS, ccg) diff --git a/src/libsac2c/xml/ast.xml b/src/libsac2c/xml/ast.xml index 95160cfba..9ae160222 100644 --- a/src/libsac2c/xml/ast.xml +++ b/src/libsac2c/xml/ast.xml @@ -995,15 +995,6 @@ - - - - - - - - - -- GitLab From 85bd54bbf204b0de68294602a357306baf85dd08 Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sun, 22 Nov 2020 12:46:00 +0100 Subject: [PATCH 10/16] stripped NameTulesUtils --- src/libsac2c/CMakeLists.txt | 1 - src/libsac2c/codegen/gen_startup_code.c | 18 +- src/libsac2c/global/NameTuplesUtils.c | 463 ------------------------ src/libsac2c/global/NameTuplesUtils.h | 13 - src/libsac2c/tree/tree_compound.c | 13 - src/libsac2c/tree/tree_compound.h | 1 - 6 files changed, 10 insertions(+), 499 deletions(-) diff --git a/src/libsac2c/CMakeLists.txt b/src/libsac2c/CMakeLists.txt index 9352eb4ca..7abd16451 100644 --- a/src/libsac2c/CMakeLists.txt +++ b/src/libsac2c/CMakeLists.txt @@ -158,7 +158,6 @@ ${CMAKE_CURRENT_SOURCE_DIR}/cinterface/load_module_contents.c ${CMAKE_CURRENT_SOURCE_DIR}/cinterface/print_ccflags.c ${CMAKE_CURRENT_SOURCE_DIR}/cinterface/print_ldflags.c ${CMAKE_CURRENT_SOURCE_DIR}/codegen/compile.c -${CMAKE_CURRENT_SOURCE_DIR}/codegen/convert_type_representation.c ${CMAKE_CURRENT_SOURCE_DIR}/codegen/gen_startup_code.c ${CMAKE_CURRENT_SOURCE_DIR}/codegen/icm2c.c ${CMAKE_CURRENT_SOURCE_DIR}/codegen/icm2c_basic.c diff --git a/src/libsac2c/codegen/gen_startup_code.c b/src/libsac2c/codegen/gen_startup_code.c index 041429e26..41d8d49c1 100644 --- a/src/libsac2c/codegen/gen_startup_code.c +++ b/src/libsac2c/codegen/gen_startup_code.c @@ -38,6 +38,8 @@ #include "memory.h" #include "renameidentifiers.h" #include "namespaces.h" +#include "new_types.h" +#include "shape.h" #include "rtspec_modes.h" /****************************************************************************** @@ -761,7 +763,7 @@ static void GSCprintMainC99 (void) { char *res_NT; - types *tmp_type; + ntype *tmp_type; bool print_thread_id, run_mt, run_mt_pthread, run_mt_lpel, run_mt_omp; DBUG_ENTER (); @@ -793,9 +795,9 @@ GSCprintMainC99 (void) INDENT; fprintf (global.outfile, "SAC_MT_DECL_MYTHREAD()\n"); } - tmp_type = TBmakeTypes1 (T_int); - res_NT = NTUcreateNtTag ("SAC_res", tmp_type); - tmp_type = FREEfreeAllTypes (tmp_type); + tmp_type = TYmakeAKS (TYmakeSimpleType (T_int), SHmakeShape (0)); + res_NT = NTUcreateNtTagFromNType ("SAC_res", tmp_type); + tmp_type = TYfreeType (tmp_type); ICMCompileND_DECL (res_NT, "int", 0, NULL); /* create ND_DECL icm */ GSCprintMainBegin (); @@ -866,7 +868,7 @@ GSCprintMainMuTC (void) { #if 0 char *res_NT; - types *tmp_type; + ntype *tmp_type; #endif DBUG_ENTER (); @@ -876,9 +878,9 @@ GSCprintMainMuTC (void) INDENT; fprintf( global.outfile, "{\n"); global.indent++; - tmp_type = TBmakeTypes1( T_int); - res_NT = NTUcreateNtTag( "SAC_res", tmp_type); - tmp_type = FREEfreeAllTypes( tmp_type); + tmp_type = TYmakeAKS (TYmakeSimpleType (T_int), SHmakeShape (0)); + res_NT = NTUcreateNtTagFromNType( "SAC_res", tmp_type); + tmp_type = TYfreeType (tmp_type); ICMCompileND_DECL( res_NT, "int", 0, NULL); /* create ND_DECL icm */ GSCprintMainBegin(); diff --git a/src/libsac2c/global/NameTuplesUtils.c b/src/libsac2c/global/NameTuplesUtils.c index 7e40fe14c..0efc51488 100644 --- a/src/libsac2c/global/NameTuplesUtils.c +++ b/src/libsac2c/global/NameTuplesUtils.c @@ -43,317 +43,6 @@ simpletype2mutcStorageClass (simpletype st) DBUG_RETURN (ret); } -/****************************************************************************** - * - * function: - * shape_class_t NTUgetShapeClassFromTypes( types *type) - * - * description: - * Returns the Shape Class of an object (usually an array) from its type. - * - ******************************************************************************/ - -shape_class_t -NTUgetShapeClassFromTypes (types *type) -{ - shape_class_t z; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - if ((TYPES_BASETYPE (type) == T_user) && (TYPES_TDEF (type) == NULL)) { - /* - * the TC has probably not been called yet :-( - */ - DBUG_UNREACHABLE ("illegal data class found!"); - z = C_unknowns; - } else { - int dim = TCgetShapeDim (type); - - if ((dim == SCALAR) - && ((global.min_array_rep <= MAR_scl_aud) || TCisHidden (type))) { - /* - * C_scl can not be deactivated for hidden objects in order to prevent - * inconsistency with the implementation of the hidden type. - */ - z = C_scl; - } else if (KNOWN_SHAPE (dim) && (global.min_array_rep <= MAR_scl_aks)) { - z = C_aks; - } else if (KNOWN_DIMENSION (dim) && (global.min_array_rep <= MAR_scl_akd)) { - z = C_akd; - } else { - z = C_aud; - } - } - - DBUG_RETURN (z); -} - -/****************************************************************************** - * - * function: - * hidden_class_t NTUgetHiddenClassFromTypes( types *type) - * - * description: - * Returns the Hiddenness Class of an object (usually an array) from - * its type. - * - ******************************************************************************/ - -hidden_class_t -NTUgetHiddenClassFromTypes (types *type) -{ - hidden_class_t z; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - if ((TYPES_BASETYPE (type) == T_user) && (TYPES_TDEF (type) == NULL)) { - /* - * the TC has probably not been called yet :-( - */ - DBUG_UNREACHABLE ("illegal data class found!"); - z = C_unknownh; - } else if (TCisNested (type)) { - z = C_hns; - } else if (TCisHidden (type)) { - z = C_hid; - } else { - z = C_nhd; - } - - DBUG_RETURN (z); -} - -/****************************************************************************** - * - * function: - * unique_class_t NTUgetUniqueClassFromTypes( types *type) - * - * description: - * Returns the Uniqueness Class of an object (usually an array) from - * its type. - * - ******************************************************************************/ - -unique_class_t -NTUgetUniqueClassFromTypes (types *type) -{ - unique_class_t z; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - if ((TYPES_BASETYPE (type) == T_user) && (TYPES_TDEF (type) == NULL)) { - /* - * the TC has probably not been called yet :-( - */ - DBUG_UNREACHABLE ("illegal data class found!"); - z = C_unknownu; - } else if (TCisUnique (type)) { - z = C_unq; - } else if (TYPES_UNIQUE (type)) { - z = C_unq; - } else { - z = C_nuq; - } - - DBUG_RETURN (z); -} - -/****************************************************************************** - * - * function: - * mutc_storage_class_class_t NTUMutcgetStorageClassFromTypes( types *type) - * - * description: - * - ******************************************************************************/ - -mutc_storage_class_class_t -NTUgetMutcStorageClassFromTypes (types *type) -{ - mutc_storage_class_class_t z; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - if ((TYPES_BASETYPE (type) == T_user) && (TYPES_TDEF (type) == NULL)) { - /* - * the TC has probably not been called yet :-( - */ - DBUG_UNREACHABLE ("illegal data class found!"); - z = C_unknownc; - } else { - switch (simpletype2mutcStorageClass (TYPES_BASETYPE (type))) { - case MUTC_SC_INT: - z = C_int; - break; - case MUTC_SC_FLOAT: - z = C_float; - break; - default: - z = C_unknownc; - } - } - - DBUG_RETURN (z); -} - -/****************************************************************************** - * - * function: - * mutc_scope_class_t NTUMutcgetScopeFromTypes( types *type) - * - * description: - * - ******************************************************************************/ - -mutc_scope_class_t -NTUgetMutcScopeFromTypes (types *type) -{ - mutc_scope_class_t z; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - if ((TYPES_BASETYPE (type) == T_user) && (TYPES_TDEF (type) == NULL)) { - /* - * the TC has probably not been called yet :-( - */ - DBUG_UNREACHABLE ("illegal scope found!"); - z = C_unknowno; - } else { - switch (TYPES_MUTC_SCOPE (type)) { - case MUTC_SHARED: - z = C_shared; - break; - default: - z = C_global; - } - } - - DBUG_RETURN (z); -} - -/****************************************************************************** - * - * function: - * mutc_usage_class_t NTUgetMutcUsageFromTypes( types *type) - * - * description: - * - ******************************************************************************/ - -mutc_usage_class_t -NTUgetMutcUsageFromTypes (types *type) -{ - mutc_usage_class_t z; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - if ((TYPES_BASETYPE (type) == T_user) && (TYPES_TDEF (type) == NULL)) { - /* - * the TC has probably not been called yet :-( - */ - DBUG_UNREACHABLE ("illegal usage found!"); - z = C_unknowna; - } else { - switch (TYPES_MUTC_USAGE (type)) { - case MUTC_US_THREADPARAMIO: - z = C_threadparamio; - break; - case MUTC_US_THREADPARAM: - z = C_threadparam; - break; - case MUTC_US_FUNPARAMIO: - z = C_funparamio; - break; - case MUTC_US_FUNPARAM: - z = C_funparam; - break; - case MUTC_US_FUNARG: - z = C_funarg; - break; - default: - z = C_none; - break; - } - } - - DBUG_RETURN (z); -} - -/****************************************************************************** - * - * function: - * bitarray_class_t NTUgetBitarrayFromTypes( types *type) - * - * description: - * - ******************************************************************************/ - -bitarray_class_t -NTUgetBitarrayFromTypes (types *type) -{ -#ifdef DBUG_OFF - (void)type; -#endif - bitarray_class_t z; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - z = C_sparse; - - DBUG_RETURN (z); -} - -/****************************************************************************** - * - * function: - * distributed_class_t NTUgetDistributedFromTypes( types *type) - * - * description: - * - ******************************************************************************/ - -distributed_class_t -NTUgetDistributedFromTypes (types *type) -{ - distributed_class_t d; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - if ((TYPES_BASETYPE (type) == T_user) && (TYPES_TDEF (type) == NULL)) { - /* - * the TC has probably not been called yet :-( - */ - DBUG_UNREACHABLE ("illegal distributed attribute found!"); - d = C_unknownd; - } else { - if (TYPES_DISTRIBUTED (type) == distmem_dis_dis) { - d = C_distr; - } else if (TYPES_DISTRIBUTED (type) == distmem_dis_dsm) { - d = C_distmem; - } else { - d = C_notdistr; - } - } - - DBUG_RETURN (d); -} - /****************************************************************************** * * function: @@ -383,50 +72,6 @@ NTUgetDistributedFromNType (ntype *type) DBUG_RETURN (d); } -/****************************************************************************** - * - * function: - * cbasetype_class_t NTUgetCBasetypeFromTypes( types *type) - * - * description: - * - * Note: This has to be kept in sync with GetBasetypeStr - * (compile.c) !!! - * - ******************************************************************************/ - -cbasetype_class_t -NTUgetCBasetypeFromTypes (types *type) -{ - cbasetype_class_t b; - simpletype basetype; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - if ((TYPES_BASETYPE (type) == T_user) && (TYPES_TDEF (type) == NULL)) { - /* - * the TC has probably not been called yet :-( - */ - DBUG_UNREACHABLE ("illegal C basetype attribute found!"); - b = C_unknownt; - } else { - basetype = TCgetBasetype (type); - b = global.type_cbasetype[basetype]; - - /* - * If the enforce_float flag is set, - * we change all doubles to floats. - */ - if (b == C_btdouble && global.enforce_float) { - b = C_btfloat; - } - } - - DBUG_RETURN (b); -} - /****************************************************************************** * * function: @@ -463,114 +108,6 @@ NTUgetCBasetypeFromNType (ntype *type) DBUG_RETURN (b); } -/****************************************************************************** - * - * function: - * char *NTUcreateNtTag( const char *name, types *type) - * - * description: - * Creates the tag of an object (usually an array) from its type. - * - ******************************************************************************/ - -char * -NTUcreateNtTag (const char *name, types *type) -{ - shape_class_t sc; - hidden_class_t hc; - unique_class_t uc; - mutc_storage_class_class_t storage; - mutc_scope_class_t scope; - mutc_usage_class_t usage; - bitarray_class_t bitarray; - distributed_class_t distr; - cbasetype_class_t cbasetype; - char *res; - - DBUG_ENTER (); - - DBUG_ASSERT (type != NULL, "No type found!"); - - sc = NTUgetShapeClassFromTypes (type); - hc = NTUgetHiddenClassFromTypes (type); - uc = NTUgetUniqueClassFromTypes (type); - - storage = NTUgetMutcStorageClassFromTypes (type); - scope = NTUgetMutcScopeFromTypes (type); - usage = NTUgetMutcUsageFromTypes (type); - - bitarray = NTUgetBitarrayFromTypes (type); - - distr = NTUgetDistributedFromTypes (type); - - cbasetype = NTUgetCBasetypeFromTypes (type); - - /* - * Allocate enough space for the textual representation of the type tuple. - * The total length is the length of all textual representations combined - * plus some space for administration: - * - * - 10 is the number of elements (including the name) - * - 4 is the number of chars each element takes aside of its name: "( ,)" - * - 1 is the terminating \0 byte. - */ - res = (char *)MEMmalloc ( - (STRlen (name) + STRlen (global.nt_shape_string[sc]) - + STRlen (global.nt_hidden_string[hc]) + STRlen (global.nt_unique_string[uc]) - + STRlen (global.nt_mutc_storage_class_string[storage]) - + STRlen (global.nt_mutc_scope_string[scope]) - + STRlen (global.nt_mutc_usage_string[usage]) - + STRlen (global.nt_bitarray_string[bitarray]) - + STRlen (global.nt_distributed_string[distr]) - + STRlen (global.nt_cbasetype_string[cbasetype]) + (10 * 4 + 1)) - * sizeof (char)); - - sprintf (res, "(%s, (%s, (%s, (%s, (%s, (%s, (%s, (%s, (%s, (%s, ))))))))))", name, - global.nt_shape_string[sc], global.nt_hidden_string[hc], - global.nt_unique_string[uc], global.nt_mutc_storage_class_string[storage], - global.nt_mutc_scope_string[scope], global.nt_mutc_usage_string[usage], - global.nt_bitarray_string[bitarray], global.nt_distributed_string[distr], - global.nt_cbasetype_string[cbasetype]); - - DBUG_RETURN (res); -} - -/****************************************************************************** - * - * function: - * node *NTUaddNtTag( node *id) - * - * description: - * Creates the tag of a N_id node. - * - ******************************************************************************/ - -node * -NTUaddNtTag (node *id) -{ - node *avis; - - DBUG_ENTER (); - - avis = ID_AVIS (id); - - DBUG_ASSERT (avis != NULL, "no avis found!"); - - switch (NODE_TYPE (AVIS_DECL (avis))) { - case N_vardec: - ID_NT_TAG (id) - = NTUcreateNtTag (AVIS_NAME (avis), VARDEC_TYPE (AVIS_DECL (avis))); - break; - case N_arg: - ID_NT_TAG (id) = NTUcreateNtTag (AVIS_NAME (avis), ARG_TYPE (AVIS_DECL (avis))); - break; - default: - DBUG_UNREACHABLE ("illegal decl in avis node"); - } - - DBUG_RETURN (id); -} - /****************************************************************************** * * Name Tuples Utils diff --git a/src/libsac2c/global/NameTuplesUtils.h b/src/libsac2c/global/NameTuplesUtils.h index 61a8bb67e..9f1943f3e 100644 --- a/src/libsac2c/global/NameTuplesUtils.h +++ b/src/libsac2c/global/NameTuplesUtils.h @@ -11,19 +11,6 @@ * *****************************************************************************/ -extern char *NTUcreateNtTag (const char *name, types *type); - -extern node *NTUaddNtTag (node *id); - -extern shape_class_t NTUgetShapeClassFromTypes (types *type); -extern hidden_class_t NTUgetHiddenClassFromTypes (types *type); -extern unique_class_t NTUgetUniqueClassFromTypes (types *type); -extern mutc_storage_class_class_t NTUMutcgetStorageClassFromTypes (types *type); -extern mutc_scope_class_t NTUgetMutcScopeFromTypes (types *type); -extern mutc_usage_class_t NTUgetMutcUsageFromTypes (types *type); -extern bitarray_class_t NTUgetBitarrayFromTypes (types *type); -extern distributed_class_t NTUgetDistributedFromTypes (types *type); - extern char *NTUcreateNtTagFromNType (const char *name, ntype *ntype); extern shape_class_t NTUgetShapeClassFromNType (ntype *ntype); diff --git a/src/libsac2c/tree/tree_compound.c b/src/libsac2c/tree/tree_compound.c index a6bcbb361..11017115f 100644 --- a/src/libsac2c/tree/tree_compound.c +++ b/src/libsac2c/tree/tree_compound.c @@ -3009,19 +3009,6 @@ TCmakeIdCopyString (const char *str) DBUG_RETURN (result); } -node * -TCmakeIdCopyStringNt (const char *str, types *type) -{ - node *result; - - DBUG_ENTER (); - - result = TCmakeIdCopyString (str); - ID_NT_TAG (result) = NTUcreateNtTag (str, type); - - DBUG_RETURN (result); -} - /** * * @fn node *TCmakeIdCopyStringNtNew( const char *str, ntype *type) diff --git a/src/libsac2c/tree/tree_compound.h b/src/libsac2c/tree/tree_compound.h index a583d1b9d..6adae0939 100644 --- a/src/libsac2c/tree/tree_compound.h +++ b/src/libsac2c/tree/tree_compound.h @@ -894,7 +894,6 @@ extern node *TCids2ExprsNt (node *ids_arg); #define ID_NAME_OR_ICMTEXT(n) ((ID_AVIS (n) != NULL) ? ID_NAME (n) : ID_ICMTEXT (n)) extern node *TCmakeIdCopyString (const char *str); -extern node *TCmakeIdCopyStringNt (const char *str, types *type); extern node *TCmakeIdCopyStringNtNew (const char *str, ntype *type); /*************************************************************************** -- GitLab From 412015657932a2c7ef46b0e199037cde6ca4e84a Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sun, 22 Nov 2020 17:30:28 +0100 Subject: [PATCH 11/16] stripped new_types, tree_compound and adjusted padding inference code to new types --- src/libsac2c/arrayopt/pad_collect.c | 52 +- src/libsac2c/arrayopt/pad_infer.c | 279 ++++++----- src/libsac2c/arrayopt/pad_info.c | 195 ++++---- src/libsac2c/arrayopt/pad_info.h | 33 +- src/libsac2c/codegen/compile.c | 4 +- src/libsac2c/codegen/icm_comment.c | 2 +- src/libsac2c/constants/shape.c | 30 -- src/libsac2c/constants/shape.h | 1 - src/libsac2c/cuda/cuda_utils.c | 14 - src/libsac2c/cuda/cuda_utils.h | 2 - src/libsac2c/multithread/tag_executionmode.c | 38 +- src/libsac2c/tree/DataFlowMaskUtils.c | 42 -- src/libsac2c/tree/DataFlowMaskUtils.h | 1 - src/libsac2c/tree/free_attribs.c | 2 +- src/libsac2c/tree/tree_basic.c | 2 +- src/libsac2c/tree/tree_basic.h | 2 +- src/libsac2c/tree/tree_compound.c | 498 ------------------- src/libsac2c/tree/tree_compound.h | 36 -- src/libsac2c/typecheck/new_types.c | 315 ------------ src/libsac2c/typecheck/new_types.h | 5 - src/libsac2c/typecheck/specialize.c | 8 +- src/libsac2c/types/types.h | 28 +- 22 files changed, 317 insertions(+), 1272 deletions(-) diff --git a/src/libsac2c/arrayopt/pad_collect.c b/src/libsac2c/arrayopt/pad_collect.c index 2543b727d..cf8a33430 100644 --- a/src/libsac2c/arrayopt/pad_collect.c +++ b/src/libsac2c/arrayopt/pad_collect.c @@ -27,6 +27,7 @@ #include "str.h" #include "memory.h" #include "new_types.h" +#include "type_utils.h" #include "new_typecheck.h" #include "pad_info.h" @@ -129,7 +130,7 @@ APCdoCollect (node *arg_node) /***************************************************************************** * * function: - * static shpseg* AccessClass2Group(accessclass_t class, int dim) + * static shape* AccessClass2Group(accessclass_t class, int dim) * * description: * convert access class into vector of integer factors @@ -140,11 +141,11 @@ APCdoCollect (node *arg_node) * *****************************************************************************/ -static shpseg * +static shape * AccessClass2Group (accessclass_t xclass, int dim) { - shpseg *vector; + shape *vector; int element; int i; @@ -166,10 +167,10 @@ AccessClass2Group (accessclass_t xclass, int dim) /* supported access class */ - vector = TBmakeShpseg (NULL); + vector = SHmakeShape (dim); for (i = 0; i < dim; i++) { - SHPSEG_SHAPE (vector, i) = element; + vector = SHsetExtent (vector, i, element); } } else { @@ -201,11 +202,11 @@ CollectAccessPatterns (node *arg_node) collection_t *col_next_ptr; access_t *access_ptr; pattern_t *pt_ptr; - shpseg *group_vect; - shpseg *offset; + shape *group_vect; + shape *offset; simpletype type; int dim; - shpseg *shape; + shape *shp; pattern_t *patterns; accessdir_t direction; @@ -257,7 +258,7 @@ CollectAccessPatterns (node *arg_node) col_ptr = collection; } - offset = DUPdupShpseg (ACCESS_OFFSET (access_ptr)); + offset = SHcopyShape (ACCESS_OFFSET (access_ptr)); pt_ptr = PIconcatPatterns (pt_ptr, offset); COL_PATTERNS (col_ptr) = pt_ptr; break; @@ -273,12 +274,12 @@ CollectAccessPatterns (node *arg_node) col_ptr = collection; while (col_ptr != NULL) { type = TYPES_BASETYPE (VARDEC_TYPE (COL_ARRAY (col_ptr))); - dim = TYPES_DIM (VARDEC_TYPE (COL_ARRAY (col_ptr))); - shape = DUPdupShpseg (TYPES_SHPSEG (VARDEC_TYPE (COL_ARRAY (col_ptr)))); + dim = TYgetDim (VARDEC_NTYPE (COL_ARRAY (col_ptr))); + shp = SHcopyShape (TYgetShape (VARDEC_NTYPE (COL_ARRAY (col_ptr)))); group_vect = AccessClass2Group (COL_CLASS (col_ptr), dim); direction = COL_DIR (col_ptr); patterns = COL_PATTERNS (col_ptr); - PIaddAccessPattern (type, dim, shape, group_vect, direction, patterns); + PIaddAccessPattern (type, dim, shp, group_vect, direction, patterns); col_ptr = COL_NEXT (col_ptr); } @@ -296,7 +297,7 @@ CollectAccessPatterns (node *arg_node) /***************************************************************************** * * function: - * static node* AddUnsupported(node* arg_info, types* array_type) + * static node* AddUnsupported(node* arg_info, ntype* array_type) * * description: * wrapper to simplify adding an unsupported shape @@ -305,7 +306,7 @@ CollectAccessPatterns (node *arg_node) *****************************************************************************/ static void -AddUnsupported (info *arg_info, types *array_type) +AddUnsupported (info *arg_info, ntype *array_type) { DBUG_ENTER (); @@ -313,10 +314,10 @@ AddUnsupported (info *arg_info, types *array_type) INFO_APC_UNSUPPORTED (arg_info) = TRUE; /* only non-scalar types will be added to list of unsupported shapes! - * scalar types do not have a shpseg! + * scalar types do not have a shape! */ - if (TYPES_DIM (array_type) > 0) { - if (PIaddUnsupportedShape (DUPdupAllTypes (array_type))) { + if (TUgetFullDimEncoding (array_type) > 0) { + if (PIaddUnsupportedShape (TYcopyType (array_type))) { INFO_APC_COUNT_CHANGES (arg_info)++; } } @@ -338,18 +339,15 @@ node * APCarray (node *arg_node, info *arg_info) { ntype *atype; - types *otype; DBUG_ENTER (); DBUG_PRINT ("array-node detected"); atype = NTCnewTypeCheck_Expr (arg_node); - otype = TYtype2OldType (atype); - AddUnsupported (arg_info, otype); + AddUnsupported (arg_info, atype); - otype = FREEfreeOneTypes (otype); atype = TYfreeType (atype); DBUG_RETURN (arg_node); @@ -445,7 +443,7 @@ APCid (node *arg_node, info *arg_info) DBUG_PRINT ("id-node detected"); if (INFO_APC_UNSUPPORTED (arg_info)) { - AddUnsupported (arg_info, ID_TYPE (arg_node)); + AddUnsupported (arg_info, ID_NTYPE (arg_node)); } DBUG_RETURN (arg_node); @@ -547,7 +545,7 @@ APClet (node *arg_node, info *arg_info) if (INFO_APC_UNSUPPORTED (arg_info)) { ids_ptr = LET_IDS (arg_node); while (ids_ptr != NULL) { - AddUnsupported (arg_info, VARDEC_OR_ARG_TYPE (IDS_DECL (ids_ptr))); /* TODO */ + AddUnsupported (arg_info, IDS_NTYPE (ids_ptr)); ids_ptr = IDS_NEXT (ids_ptr); } } @@ -572,7 +570,7 @@ APCgenarray (node *arg_node, info *arg_info) DBUG_ENTER (); #if 0 - shpseg* shape; + shape* shape; types* type; int dim; simpletype basetype; @@ -621,7 +619,7 @@ APCmodarray (node *arg_node, info *arg_info) DBUG_PRINT (" modarray-loop"); if (INFO_APC_UNSUPPORTED (arg_info)) { - AddUnsupported (arg_info, ID_TYPE (MODARRAY_ARRAY (arg_node))); + AddUnsupported (arg_info, ID_NTYPE (MODARRAY_ARRAY (arg_node))); } DBUG_RETURN (arg_node); @@ -672,9 +670,9 @@ APCcode (node *arg_node, info *arg_info) arg_node = CollectAccessPatterns (arg_node); /* check type of id-node */ - if (!(ID_DIM (CODE_CEXPR (arg_node)) == 0)) { + if (TYgetDim (ID_NTYPE (CODE_CEXPR (arg_node))) != 0) { /* not a scalar type, so this with-loop is unsupported! */ - AddUnsupported (arg_info, ID_TYPE (CODE_CEXPR (arg_node))); + AddUnsupported (arg_info, ID_NTYPE (CODE_CEXPR (arg_node))); } /* traverse code block */ diff --git a/src/libsac2c/arrayopt/pad_infer.c b/src/libsac2c/arrayopt/pad_infer.c index 486133a36..0ccb1d0a9 100644 --- a/src/libsac2c/arrayopt/pad_infer.c +++ b/src/libsac2c/arrayopt/pad_infer.c @@ -71,7 +71,7 @@ typedef struct { ******************************************************************************/ typedef struct c_u_t { - shpseg *access; /* offset vector */ + shape *access; /* offset vector */ int offset; /* offset with respect to array shape */ int shifted_offset; /* shifted (non-negative) offset */ int set; /* cache set */ @@ -198,7 +198,7 @@ PrintCacheSpec (int level, cache_t *cache) ******************************************************************************/ static void -SetVect (int dim, shpseg *pv, int val) +SetVect (int dim, shape *pv, int val) { int i; @@ -207,56 +207,58 @@ SetVect (int dim, shpseg *pv, int val) DBUG_ASSERT (dim <= SHP_SEG_SIZE, " dimension out of range in SetVect()!"); for (i = 0; i < dim; i++) { - SHPSEG_SHAPE (pv, i) = val; + SHsetExtent (pv, i, val); } DBUG_RETURN (); } static void -CopyVect (int dim, shpseg *xnew, shpseg *old) +CopyVect (int dim, shape *xnew, shape *old) { int i; DBUG_ENTER (); - DBUG_ASSERT (dim <= SHP_SEG_SIZE, " dimension out of range in CopyVect()!"); + DBUG_ASSERT (dim <= SHgetDim (xnew), + " dimension out of range in CopyVect()!"); for (i = 0; i < dim; i++) { - SHPSEG_SHAPE (xnew, i) = SHPSEG_SHAPE (old, i); + SHsetExtent (xnew, i, SHgetExtent (old, i)); } DBUG_RETURN (); } static void -AddVect (int dim, shpseg *res, shpseg *a, shpseg *b) +AddVect (int dim, shape *res, shape *a, shape *b) { int i; DBUG_ENTER (); - DBUG_ASSERT (dim <= SHP_SEG_SIZE, " dimension out of range in AddVect()!"); + DBUG_ASSERT (dim <= SHgetDim (res), " dimension out of range in AddVect()!"); for (i = 0; i < dim; i++) { - SHPSEG_SHAPE (res, i) = SHPSEG_SHAPE (a, i) + SHPSEG_SHAPE (b, i); + SHsetExtent (res, i, SHgetExtent (a, i) + SHgetExtent (b, i)); } DBUG_RETURN (); } static int -EqualVect (int dim, shpseg *a, shpseg *b) +EqualVect (int dim, shape *a, shape *b) { int i; int equal = 1; DBUG_ENTER (); - DBUG_ASSERT (dim <= SHP_SEG_SIZE, " dimension out of range in AddVect()!"); + DBUG_ASSERT (dim <= SHgetDim (a), " dimension out of range in EqualVect()!"); + DBUG_ASSERT (dim <= SHgetDim (b), " dimension out of range in EqualVect()!"); for (i = 0; i < dim; i++) { - if (SHPSEG_SHAPE (a, i) != SHPSEG_SHAPE (b, i)) { + if (SHgetExtent (a, i) != SHgetExtent (b, i)) { equal = 0; break; } @@ -465,7 +467,7 @@ IsTemporalReuseConflict (cache_util_t *cache_util, cache_t *cache, unsigned int * static cache_util_t *ComputeAccessData(int rows, * cache_util_t *cache_util, * cache_t *cache, - * shpseg* shape) + * shape* shp) * * description * @@ -492,7 +494,7 @@ IsTemporalReuseConflict (cache_util_t *cache_util, cache_t *cache, unsigned int static cache_util_t * ComputeAccessData (unsigned int rows, cache_util_t *cache_util, cache_t *cache, int dim, - shpseg *shape) + shape *shp) { unsigned int a; @@ -500,7 +502,7 @@ ComputeAccessData (unsigned int rows, cache_util_t *cache_util, cache_t *cache, for (a = 0; a < rows; a++) { - cache_util[a].offset = PIlinearizeVector (dim, shape, cache_util[a].access); + cache_util[a].offset = PIlinearizeVector (dim, shp, cache_util[a].access); cache_util[a].shifted_offset = cache_util[a].offset - cache_util[0].offset; @@ -545,15 +547,15 @@ ComputeSpatialReuse (unsigned int rows, cache_util_t *cache_util, cache_t *cache if (IsSpatialReuseConflict (cache_util, cache, a, i)) { conflicts++; for (d = 0; d < minpaddim; d++) { - if (SHPSEG_SHAPE (cache_util[a].access, d) - != SHPSEG_SHAPE (cache_util[i].access, d)) { + if (SHgetExtent (cache_util[a].access, d) + != SHgetExtent (cache_util[i].access, d)) { minpaddim = d; break; } } for (d = dim - 2; d > maxpaddim; d--) { - if (SHPSEG_SHAPE (cache_util[a].access, d) - != SHPSEG_SHAPE (cache_util[i].access, d)) { + if (SHgetExtent (cache_util[a].access, d) + != SHgetExtent (cache_util[i].access, d)) { maxpaddim = d; break; } @@ -614,16 +616,16 @@ ComputeTemporalMinpaddim (unsigned int rows, cache_util_t *cache_util, unsigned min2 = dim; for (d = 0; d < dim; d++) { - if (SHPSEG_SHAPE (cache_util[a].access, d) - != SHPSEG_SHAPE (cache_util[i].access, d)) { + if (SHgetExtent (cache_util[a].access, d) + != SHgetExtent (cache_util[i].access, d)) { min1 = d + 1; break; } } for (d = 0; d < dim; d++) { - if (SHPSEG_SHAPE (cache_util[i].access, d) - != SHPSEG_SHAPE (cache_util[a + 1].access, d)) { + if (SHgetExtent (cache_util[i].access, d) + != SHgetExtent (cache_util[a + 1].access, d)) { min2 = d + 1; break; } @@ -679,8 +681,8 @@ ComputeTemporalMaxpaddim (cache_util_t *cache_util, unsigned int a, int dim) DBUG_ENTER (); for (d = 0; d < dim; d++) { - if (SHPSEG_SHAPE (cache_util[a].access, d) - != SHPSEG_SHAPE (cache_util[a + 1].access, d)) { + if (SHgetExtent (cache_util[a].access, d) + != SHgetExtent (cache_util[a + 1].access, d)) { break; } } @@ -765,7 +767,7 @@ ComputeTemporalReuse (unsigned int rows, cache_util_t *cache_util, cache_t *cach /****************************************************************************** * * function: - * static int SelectPaddim(int min, int max, shpseg* shape) + * static int SelectPaddim(int min, int max, shape* shp) * * description * @@ -777,7 +779,7 @@ ComputeTemporalReuse (unsigned int rows, cache_util_t *cache_util, cache_t *cach * ******************************************************************************/ -static int SelectPaddim(int min, int max, shpseg* shape) +static int SelectPaddim(int min, int max, shape* shp) { int d, res; @@ -786,7 +788,7 @@ static int SelectPaddim(int min, int max, shpseg* shape) res = min; for (d=min+1; d<=max; d++) { - if (SHPSEG_SHAPE(shape,d) > SHPSEG_SHAPE(shape,res)) { + if (SHgetExtent(shp,d) > SHgetExtent(shp,res)) { res = d; } } @@ -801,7 +803,7 @@ static int SelectPaddim(int min, int max, shpseg* shape) * static int ChoosePaddimForTemporalReuse(int rows, * cache_util_t *cache_util, * cache_t *cache, - * shpseg* shape) + * shape* shp) * * description * @@ -813,7 +815,7 @@ static int SelectPaddim(int min, int max, shpseg* shape) static int ChoosePaddimForTemporalReuse(int rows, cache_util_t *cache_util, cache_t *cache, - shpseg* shape) { + shape* shp) { int res, a, minpaddim, maxpaddim; @@ -847,7 +849,7 @@ static int ChoosePaddimForTemporalReuse(int rows, } } - res = SelectPaddim(minpaddim, maxpaddim, shape); + res = SelectPaddim(minpaddim, maxpaddim, shp); if (res==0) res=1; @@ -861,7 +863,7 @@ static int ChoosePaddimForTemporalReuse(int rows, * static int ChoosePaddimForSpatialReuse(int rows, * cache_util_t *cache_util, * cache_t *cache, - * shpseg* shape) + * shape* shp) * * description * @@ -873,7 +875,7 @@ static int ChoosePaddimForTemporalReuse(int rows, static int ChoosePaddimForSpatialReuse(int rows, cache_util_t *cache_util, cache_t *cache, - shpseg* shape) + shape* shp) { int res, a, minpaddim, maxpaddim; @@ -906,7 +908,7 @@ static int ChoosePaddimForSpatialReuse(int rows, } } - res = SelectPaddim(minpaddim, maxpaddim, shape); + res = SelectPaddim(minpaddim, maxpaddim, shp); DBUG_RETURN (res); } @@ -1118,9 +1120,9 @@ ComputeTemporalReuseMaxPadDim (int dim, unsigned int rows, cache_util_t *cache_u /****************************************************************************** * * function: - * static shpseg * + * static shape * * UpdatePaddingVectorForSpatialReuse(unsigned int rows, cache_util_t *cache_util, - * int dim, shpseg *shape, shpseg *pv) + * int dim, shape *shp, shape *pv) * * description * @@ -1131,11 +1133,11 @@ ComputeTemporalReuseMaxPadDim (int dim, unsigned int rows, cache_util_t *cache_u * ******************************************************************************/ -static shpseg * +static shape * UpdatePaddingVectorForSpatialReuse (unsigned int rows, cache_util_t *cache_util, int dim, - shpseg *shape, shpseg *pv) + shape *shp, shape *pv) { - shpseg *res = NULL; + shape *res = NULL; int min_paddim, max_paddim, current_paddim; DBUG_ENTER (); @@ -1152,9 +1154,9 @@ UpdatePaddingVectorForSpatialReuse (unsigned int rows, cache_util_t *cache_util, /* * Update padding in current padding dimension. */ - SHPSEG_SHAPE (pv, current_paddim) += 1; + SHsetExtent (pv, current_paddim, SHgetExtent (pv, current_paddim)+1); - if (PIpaddingOverhead (dim, shape, pv) <= global.padding_overhead_limit) { + if (PIpaddingOverhead (dim, shp, pv) <= global.padding_overhead_limit) { res = pv; break; } @@ -1162,7 +1164,7 @@ UpdatePaddingVectorForSpatialReuse (unsigned int rows, cache_util_t *cache_util, /* * Current padding dimension exhausted, switch to next dimension. */ - SHPSEG_SHAPE (pv, current_paddim) = 0; + SHsetExtent (pv, current_paddim, 0); current_paddim += 1; if (current_paddim > max_paddim) { @@ -1179,9 +1181,9 @@ UpdatePaddingVectorForSpatialReuse (unsigned int rows, cache_util_t *cache_util, /****************************************************************************** * * function: - * static shpseg * + * static shape * * UpdatePaddingVectorForTemporalReuse(unsigned int rows, cache_util_t *cache_util, - * int dim, shpseg *shape, shpseg *pv) + * int dim, shape *shp, shape *pv) * * description * @@ -1192,11 +1194,11 @@ UpdatePaddingVectorForSpatialReuse (unsigned int rows, cache_util_t *cache_util, * ******************************************************************************/ -static shpseg * +static shape * UpdatePaddingVectorForTemporalReuse (unsigned int rows, cache_util_t *cache_util, int dim, - shpseg *shape, shpseg *pv) + shape *shp, shape *pv) { - shpseg *res = NULL; + shape *res = NULL; int min_paddim, max_paddim, current_paddim; DBUG_ENTER (); @@ -1221,9 +1223,9 @@ UpdatePaddingVectorForTemporalReuse (unsigned int rows, cache_util_t *cache_util /* * Update padding in current padding dimension. */ - SHPSEG_SHAPE (pv, current_paddim) += 1; + SHsetExtent (pv, current_paddim, SHgetExtent (pv, current_paddim)+1); - if (PIpaddingOverhead (dim, shape, pv) <= global.padding_overhead_limit) { + if (PIpaddingOverhead (dim, shp, pv) <= global.padding_overhead_limit) { res = pv; break; } @@ -1231,7 +1233,7 @@ UpdatePaddingVectorForTemporalReuse (unsigned int rows, cache_util_t *cache_util /* * Current padding dimension exhausted, switch to next dimension. */ - SHPSEG_SHAPE (pv, current_paddim) = 0; + SHsetExtent (pv, current_paddim, 0); current_paddim += 1; if (current_paddim > max_paddim) { @@ -1252,8 +1254,8 @@ UpdatePaddingVectorForTemporalReuse (unsigned int rows, cache_util_t *cache_util * EvaluatePadding( int *ret, * int dim, cache_t *cache, * unsigned int rows, cache_util_t *cache_util, - * shpseg* shape, - * shpseg* pv) + * shape* shp, + * shape* pv) * * description * @@ -1265,9 +1267,9 @@ UpdatePaddingVectorForTemporalReuse (unsigned int rows, cache_util_t *cache_util static int EvaluatePadding (int *ret, int dim, cache_t *cache, unsigned int rows, cache_util_t *cache_util, - shpseg *shape, shpseg *pv) + shape *shp, shape *pv) { - shpseg *actual_shape; + shape *actual_shape; int num_sr_conflicts; int num_tr_conflicts; @@ -1281,8 +1283,8 @@ EvaluatePadding (int *ret, int dim, cache_t *cache, unsigned int rows, cache_uti /* * Compute actual array shape including padding. */ - actual_shape = TBmakeShpseg (NULL); - AddVect (dim, actual_shape, shape, pv); + actual_shape = SHmakeShape (dim); + AddVect (dim, actual_shape, shp, pv); /* * Compute cache utilization table. @@ -1300,7 +1302,7 @@ EvaluatePadding (int *ret, int dim, cache_t *cache, unsigned int rows, cache_uti /* * Free local resources. */ - FREEfreeShpseg (actual_shape); + SHfreeShape (actual_shape); } *ret = num_tr_conflicts; @@ -1311,11 +1313,11 @@ EvaluatePadding (int *ret, int dim, cache_t *cache, unsigned int rows, cache_uti /****************************************************************************** * * function: - * static shpseg * + * static shape * * ComputePaddingForSpatialReuse( int dim, cache_t *cache, * unsigned int rows, cache_util_t *cache_util, - * shpseg* shape, - * shpseg* pv) + * shape* shp, + * shape* pv) * * description * @@ -1324,26 +1326,26 @@ EvaluatePadding (int *ret, int dim, cache_t *cache, unsigned int rows, cache_uti * ******************************************************************************/ -static shpseg * +static shape * ComputePaddingForSpatialReuse (int dim, cache_t *cache, unsigned int rows, - cache_util_t *cache_util, shpseg *shape, shpseg *pv) + cache_util_t *cache_util, shape *shp, shape *pv) { - shpseg *actual_shape; - shpseg *pv_opt, *new_pv = NULL; + shape *actual_shape; + shape *pv_opt, *new_pv = NULL; int min_sr_conflicts; int num_sr_conflicts; DBUG_ENTER (); - actual_shape = TBmakeShpseg (NULL); - pv_opt = TBmakeShpseg (NULL); + actual_shape = SHmakeShape (dim); + pv_opt = SHmakeShape (dim); min_sr_conflicts = VERY_LARGE_NUMBER; do { /* * Compute actual array shape including padding. */ - AddVect (dim, actual_shape, shape, pv); + AddVect (dim, actual_shape, shp, pv); /* * Compute cache utilization table. @@ -1356,13 +1358,13 @@ ComputePaddingForSpatialReuse (int dim, cache_t *cache, unsigned int rows, * Produce diagnostic output. */ APprintDiag ("\nCurrent state : "); - PIprintShpSeg (dim, shape); + PIprintShpSeg (dim, shp); APprintDiag (" + "); PIprintShpSeg (dim, pv); APprintDiag (" -> "); PIprintShpSeg (dim, actual_shape); APprintDiag ("\nCurrent overhead : <= %d%%\n\n", - PIpaddingOverhead (dim, shape, pv)); + PIpaddingOverhead (dim, shp, pv)); PrintCacheUtil (dim, rows, cache_util); APprintDiag ("\n\n"); @@ -1398,7 +1400,7 @@ ComputePaddingForSpatialReuse (int dim, cache_t *cache, unsigned int rows, * padding. */ new_pv - = UpdatePaddingVectorForSpatialReuse (rows, cache_util, dim, shape, pv); + = UpdatePaddingVectorForSpatialReuse (rows, cache_util, dim, shp, pv); if (new_pv == NULL) { /* @@ -1432,8 +1434,8 @@ ComputePaddingForSpatialReuse (int dim, cache_t *cache, unsigned int rows, /* * Free local resources. */ - FREEfreeShpseg (actual_shape); - FREEfreeShpseg (pv_opt); + SHfreeShape (actual_shape); + SHfreeShape (pv_opt); DBUG_RETURN (pv); } @@ -1441,11 +1443,11 @@ ComputePaddingForSpatialReuse (int dim, cache_t *cache, unsigned int rows, /****************************************************************************** * * function: - * static shpseg * + * static shape * * ComputePaddingForTemporalReuse( int dim, cache_t *cache, * unsigned int rows, cache_util_t *cache_util, - * shpseg* shape, - * shpseg* pv) + * shape* shp, + * shape* pv) * * description * @@ -1454,13 +1456,13 @@ ComputePaddingForSpatialReuse (int dim, cache_t *cache, unsigned int rows, * ******************************************************************************/ -static shpseg * +static shape * ComputePaddingForTemporalReuse (int dim, cache_t *cache, unsigned int rows, - cache_util_t *cache_util, shpseg *shape, shpseg *pv) + cache_util_t *cache_util, shape *shp, shape *pv) { - shpseg *actual_shape; - shpseg *pv_opt; - shpseg *new_pv = NULL; + shape *actual_shape; + shape *pv_opt; + shape *new_pv = NULL; int min_sr_conflicts; int min_tr_conflicts; int num_sr_conflicts; @@ -1468,8 +1470,8 @@ ComputePaddingForTemporalReuse (int dim, cache_t *cache, unsigned int rows, DBUG_ENTER (); - actual_shape = TBmakeShpseg (NULL); - pv_opt = TBmakeShpseg (NULL); + actual_shape = SHmakeShape (dim); + pv_opt = SHmakeShape (dim); min_sr_conflicts = VERY_LARGE_NUMBER; min_tr_conflicts = VERY_LARGE_NUMBER; @@ -1477,7 +1479,7 @@ ComputePaddingForTemporalReuse (int dim, cache_t *cache, unsigned int rows, /* * Compute actual array shape including padding. */ - AddVect (dim, actual_shape, shape, pv); + AddVect (dim, actual_shape, shp, pv); /* * Compute cache utilization table. @@ -1490,13 +1492,13 @@ ComputePaddingForTemporalReuse (int dim, cache_t *cache, unsigned int rows, * Produce diagnostic output. */ APprintDiag ("\nCurrent state : "); - PIprintShpSeg (dim, shape); + PIprintShpSeg (dim, shp); APprintDiag (" + "); PIprintShpSeg (dim, pv); APprintDiag (" -> "); PIprintShpSeg (dim, actual_shape); APprintDiag ("\nCurrent overhead : <= %d%%\n\n", - PIpaddingOverhead (dim, shape, pv)); + PIpaddingOverhead (dim, shp, pv)); PrintCacheUtil (dim, rows, cache_util); APprintDiag ("\n\n"); @@ -1549,7 +1551,7 @@ ComputePaddingForTemporalReuse (int dim, cache_t *cache, unsigned int rows, * So, let's try some more padding. */ new_pv = UpdatePaddingVectorForTemporalReuse (rows, cache_util, dim, - shape, pv); + shp, pv); if (new_pv == NULL) { /* @@ -1603,8 +1605,8 @@ ComputePaddingForTemporalReuse (int dim, cache_t *cache, unsigned int rows, /* * Free local resources. */ - FREEfreeShpseg (actual_shape); - FREEfreeShpseg (pv_opt); + SHfreeShape (actual_shape); + SHfreeShape (pv_opt); DBUG_RETURN (pv); } @@ -1612,9 +1614,9 @@ ComputePaddingForTemporalReuse (int dim, cache_t *cache, unsigned int rows, /****************************************************************************** * * function: - * static shpseg * + * static shape * * ComputePadding( cache_t *cache_L1, cache_t *cache_L1, cache_t *cache_L1, - * int dim, shpseg* shape, shpseg *padding, + * int dim, shape* shp, shape *padding, * pattern_t *pattern, array_type_t *array) * * description @@ -1624,14 +1626,14 @@ ComputePaddingForTemporalReuse (int dim, cache_t *cache, unsigned int rows, * ******************************************************************************/ -static shpseg * +static shape * ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim, - shpseg *shape, shpseg *padding, pattern_t *pattern, array_type_t *array) + shape *shp, shape *padding, pattern_t *pattern, array_type_t *array) { cache_util_t *cache_util; unsigned int rows; - shpseg *padding_keep; - shpseg *padding_store; + shape *padding_keep; + shape *padding_store; int num_sr_conflicts_P1; int num_sr_conflicts_P2; int num_tr_conflicts_P1; @@ -1641,8 +1643,8 @@ ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim rows = InitCacheUtil (&cache_util, pattern, array); - padding_keep = TBmakeShpseg (NULL); - padding_store = TBmakeShpseg (NULL); + padding_keep = SHmakeShape (dim); + padding_store = SHmakeShape (dim); if (cache_L1 != NULL) { @@ -1650,10 +1652,10 @@ ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim "Inferring padding vector with respect to L1 cache :\n" "----------------------------------------------------\n\n"); - padding = ComputePaddingForSpatialReuse (dim, cache_L1, rows, cache_util, shape, + padding = ComputePaddingForSpatialReuse (dim, cache_L1, rows, cache_util, shp, padding); - padding = ComputePaddingForTemporalReuse (dim, cache_L1, rows, cache_util, shape, + padding = ComputePaddingForTemporalReuse (dim, cache_L1, rows, cache_util, shp, padding); if (cache_L2 != NULL) { @@ -1674,20 +1676,20 @@ ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim CopyVect (dim, padding_store, padding); padding = ComputePaddingForSpatialReuse (dim, cache_L2, rows, cache_util, - shape, padding); + shp, padding); padding = ComputePaddingForTemporalReuse (dim, cache_L2, rows, cache_util, - shape, padding); + shp, padding); if (EqualVect (dim, padding, padding_store)) { break; } padding = ComputePaddingForSpatialReuse (dim, cache_L1, rows, cache_util, - shape, padding); + shp, padding); padding = ComputePaddingForTemporalReuse (dim, cache_L1, rows, cache_util, - shape, padding); + shp, padding); } while (!EqualVect (dim, padding, padding_store)); APprintDiag ("\nRecommended padding for L2 cache : "); @@ -1698,9 +1700,9 @@ ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim * Evaluate both padding candidates. */ num_sr_conflicts_P1 = EvaluatePadding (&num_tr_conflicts_P1, dim, cache_L1, - rows, cache_util, shape, padding_keep); + rows, cache_util, shp, padding_keep); num_sr_conflicts_P2 = EvaluatePadding (&num_tr_conflicts_P2, dim, cache_L1, - rows, cache_util, shape, padding); + rows, cache_util, shp, padding); if ((num_sr_conflicts_P1 < num_sr_conflicts_P2) || (num_tr_conflicts_P1 < num_tr_conflicts_P2)) { @@ -1730,26 +1732,26 @@ ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim CopyVect (dim, padding_store, padding); padding = ComputePaddingForSpatialReuse (dim, cache_L3, rows, - cache_util, shape, padding); + cache_util, shp, padding); padding = ComputePaddingForTemporalReuse (dim, cache_L3, rows, - cache_util, shape, padding); + cache_util, shp, padding); if (EqualVect (dim, padding, padding_store)) { break; } padding = ComputePaddingForSpatialReuse (dim, cache_L2, rows, - cache_util, shape, padding); + cache_util, shp, padding); padding = ComputePaddingForTemporalReuse (dim, cache_L2, rows, - cache_util, shape, padding); + cache_util, shp, padding); padding = ComputePaddingForSpatialReuse (dim, cache_L1, rows, - cache_util, shape, padding); + cache_util, shp, padding); padding = ComputePaddingForTemporalReuse (dim, cache_L1, rows, - cache_util, shape, padding); + cache_util, shp, padding); } while (!EqualVect (dim, padding, padding_store)); @@ -1762,10 +1764,10 @@ ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim */ num_sr_conflicts_P1 = EvaluatePadding (&num_tr_conflicts_P1, dim, cache_L1, rows, - cache_util, shape, padding_keep); + cache_util, shp, padding_keep); num_sr_conflicts_P2 = EvaluatePadding (&num_tr_conflicts_P2, dim, cache_L1, rows, - cache_util, shape, padding); + cache_util, shp, padding); if ((num_sr_conflicts_P1 < num_sr_conflicts_P2) || (num_tr_conflicts_P1 < num_tr_conflicts_P2)) { @@ -1785,10 +1787,10 @@ ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim */ num_sr_conflicts_P1 = EvaluatePadding (&num_tr_conflicts_P1, dim, cache_L2, rows, - cache_util, shape, padding_keep); + cache_util, shp, padding_keep); num_sr_conflicts_P2 = EvaluatePadding (&num_tr_conflicts_P2, dim, cache_L2, rows, - cache_util, shape, padding); + cache_util, shp, padding); if ((num_sr_conflicts_P1 < num_sr_conflicts_P2) || (num_tr_conflicts_P1 < num_tr_conflicts_P2)) { @@ -1833,8 +1835,8 @@ ComputePadding (cache_t *cache_L1, cache_t *cache_L2, cache_t *cache_L3, int dim void APinfer () { - shpseg *padding; - shpseg *initial_padding; + shape *padding; + shape *initial_padding; cache_t *cache_L1; cache_t *cache_L2; @@ -1842,14 +1844,14 @@ APinfer () simpletype type; int dim; - shpseg *shape; + shape *shp; int element_size; array_type_t *at_ptr; conflict_group_t *cg_ptr; pattern_t *pt_ptr; - shpseg *new_shape; + shape *new_shape; DBUG_ENTER (); @@ -1861,11 +1863,6 @@ APinfer () PItidyAccessPattern (); PIprintAccessPatterns (); - /* - * Init padding vectors. - */ - padding = TBmakeShpseg (NULL); - initial_padding = TBmakeShpseg (NULL); /* for every array type... */ at_ptr = PIgetFirstArrayType (); @@ -1881,7 +1878,13 @@ APinfer () * Extract information concerning array data type. */ dim = PIgetArrayTypeDim (at_ptr); - shape = DUPdupShpseg (PIgetArrayTypeShape (at_ptr)); + /* + * Init padding vectors. + */ + padding = SHmakeShape (dim); + initial_padding = SHmakeShape (dim); + + shp = SHcopyShape (PIgetArrayTypeShape (at_ptr)); type = PIgetArrayTypeBasetype (at_ptr); element_size = ctype_size[type]; @@ -1929,11 +1932,11 @@ APinfer () CopyVect (dim, initial_padding, padding); - padding = ComputePadding (cache_L1, cache_L2, cache_L3, dim, shape, padding, + padding = ComputePadding (cache_L1, cache_L2, cache_L3, dim, shp, padding, pt_ptr, at_ptr); APprintDiag ("\nOriginal shape vector : "); - PIprintShpSeg (dim, shape); + PIprintShpSeg (dim, shp); APprintDiag ("\nInitial padding vector : "); PIprintShpSeg (dim, initial_padding); @@ -1942,7 +1945,7 @@ APinfer () PIprintShpSeg (dim, padding); APprintDiag ("\nMemory allocation overhead : <= %d%%\n\n", - PIpaddingOverhead (dim, shape, padding)); + PIpaddingOverhead (dim, shp, padding)); cg_ptr = PIgetNextConflictGroup (cg_ptr); } @@ -1951,8 +1954,8 @@ APinfer () * Padding inference finished for one array type. */ - new_shape = TBmakeShpseg (NULL); - AddVect (dim, new_shape, shape, padding); + new_shape = SHmakeShape (dim); + AddVect (dim, new_shape, shp, padding); APprintDiag ( "\n*****************************************************************\n" @@ -1961,7 +1964,7 @@ APinfer () "*\n" "* Original array type : %s", CVbasetype2String (type)); - PIprintShpSeg (dim, shape); + PIprintShpSeg (dim, shp); APprintDiag ("\n" "* Recommended padding vector : "); @@ -1974,7 +1977,7 @@ APinfer () APprintDiag ("\n" "* Memory allocation overhead : <= %d%%", - PIpaddingOverhead (dim, shape, padding)); + PIpaddingOverhead (dim, shp, padding)); APprintDiag ( "\n*\n" @@ -1984,14 +1987,14 @@ APinfer () * If current array type needs padding, add to pad_info. */ - if (EqualVect (dim, shape, new_shape)) { + if (EqualVect (dim, shp, new_shape)) { /* * No padding recommended. */ - FREEfreeShpseg (shape); - FREEfreeShpseg (new_shape); + SHfreeShape (shp); + SHfreeShape (new_shape); } else { - PIaddInferredShape (type, dim, shape, new_shape, DUPdupShpseg (padding)); + PIaddInferredShape (type, dim, shp, new_shape, SHcopyShape (padding)); } /* @@ -2009,15 +2012,15 @@ APinfer () cache_L3 = MEMfree (cache_L3); } + padding = SHfreeShape (padding); + initial_padding = SHfreeShape (initial_padding); + /* * Infer padding for next array type. */ at_ptr = PIgetNextArrayType (at_ptr); } - FREEfreeShpseg (padding); - FREEfreeShpseg (initial_padding); - PIprintPadInfo (); PIremoveUnsupportedShapes (); diff --git a/src/libsac2c/arrayopt/pad_info.c b/src/libsac2c/arrayopt/pad_info.c index 806a419a0..e82bbe177 100644 --- a/src/libsac2c/arrayopt/pad_info.c +++ b/src/libsac2c/arrayopt/pad_info.c @@ -9,6 +9,7 @@ #include "globals.h" #include "DupTree.h" #include "ctinfo.h" +#include "type_utils.h" #include "str.h" #include "memory.h" #include "convert.h" @@ -19,7 +20,7 @@ /* access macros for array_type_t */ #define AT_TYPE(p) (p)->type #define AT_DIM(p) (p)->dim -#define AT_SHAPE(p) (p)->shape +#define AT_SHAPE(p) (p)->shp #define AT_GROUPS(p) (p)->groups #define AT_NEXT(p) (p)->next @@ -36,7 +37,7 @@ /* access macros for unsupported_shapes_t */ #define US_TYPE(p) (p)->type #define US_DIM(p) (p)->dim -#define US_SHAPE(p) (p)->shape +#define US_SHAPE(p) (p)->shp #define US_NEXT(p) (p)->next /* access_macros for pad_info_t */ @@ -70,7 +71,7 @@ static unsupported_shape_t *unsupported_shape; /***************************************************************************** * * function: - * static pad_info_t *GetNewTableEntry(types *old_type) + * static pad_info_t *GetNewTableEntry(ntype *old_type) * * description: * returns pointer to pad_info table entry corrsponding to old_type or NULL @@ -78,7 +79,7 @@ static unsupported_shape_t *unsupported_shape; *****************************************************************************/ static pad_info_t * -GetNewTableEntry (types *old_type) +GetNewTableEntry (ntype *old_type) { pad_info_t *tmp; @@ -90,10 +91,10 @@ GetNewTableEntry (types *old_type) matching_entry = NULL; while (tmp != NULL) { - if ((PI_TYPE (tmp) == TYPES_BASETYPE (old_type)) - && (PI_DIM (tmp) == TYPES_DIM (old_type)) - && TCequalShpseg (PI_DIM (tmp), PI_OLD_SHAPE (tmp), - TYPES_SHPSEG (old_type))) { + if ((PI_TYPE (tmp) == TUgetSimpleImplementationType (old_type)) + && (PI_DIM (tmp) == TYgetDim (old_type)) + && SHcompareShapes (PI_OLD_SHAPE (tmp), + TYgetShape (old_type))) { matching_entry = tmp; tmp = NULL; @@ -108,7 +109,7 @@ GetNewTableEntry (types *old_type) /***************************************************************************** * * function: - * static pad_info_t *GetOldTableEntry(types* new_type) + * static pad_info_t *GetOldTableEntry(ntype* new_type) * * description: * returns pointer to pad_info table entry corrsponding to new_type or NULL @@ -116,7 +117,7 @@ GetNewTableEntry (types *old_type) *****************************************************************************/ static pad_info_t * -GetOldTableEntry (types *new_type) +GetOldTableEntry (ntype *new_type) { pad_info_t *tmp; @@ -128,10 +129,10 @@ GetOldTableEntry (types *new_type) matching_entry = NULL; while (tmp != NULL) { - if ((PI_TYPE (tmp) == TYPES_BASETYPE (new_type)) - && (PI_DIM (tmp) == TYPES_DIM (new_type)) - && TCequalShpseg (PI_DIM (tmp), PI_NEW_SHAPE (tmp), - TYPES_SHPSEG (new_type))) { + if ((PI_TYPE (tmp) == TUgetSimpleImplementationType (new_type)) + && (PI_DIM (tmp) == TYgetDim (new_type)) + && SHcompareShapes (PI_NEW_SHAPE (tmp), + TYgetShape (new_type))) { matching_entry = tmp; tmp = NULL; @@ -146,7 +147,7 @@ GetOldTableEntry (types *new_type) /***************************************************************************** * * function: - * static array_type_t* GetArrayTypeEntry(simpletype type, int dim, shpseg* shape) + * static array_type_t* GetArrayTypeEntry(simpletype type, int dim, shape* shp) * * description: * get entry from access_pattern with specified type and class @@ -155,7 +156,7 @@ GetOldTableEntry (types *new_type) *****************************************************************************/ static array_type_t * -GetArrayTypeEntry (simpletype type, int dim, shpseg *shape) +GetArrayTypeEntry (simpletype type, int dim, shape *shp) { array_type_t *array_type_ptr; @@ -168,7 +169,7 @@ GetArrayTypeEntry (simpletype type, int dim, shpseg *shape) while ((array_type_ptr != NULL) && (!matched)) { if ((dim == AT_DIM (array_type_ptr)) && (type == AT_TYPE (array_type_ptr)) - && (TCequalShpseg (dim, shape, AT_SHAPE (array_type_ptr)))) { + && (SHcompareShapes (shp, AT_SHAPE (array_type_ptr)))) { matched = TRUE; } else { array_type_ptr = AT_NEXT (array_type_ptr); @@ -186,7 +187,7 @@ GetArrayTypeEntry (simpletype type, int dim, shpseg *shape) * * function: * static unsupported_shape_t* GetUnsupportedShapeEntry(simpletype type, int dim, - *shpseg* shape) + *shape* shape) * * description: * get entry from unsupported_shape with specified type @@ -195,7 +196,7 @@ GetArrayTypeEntry (simpletype type, int dim, shpseg *shape) *****************************************************************************/ static unsupported_shape_t * -GetUnsupportedShapeEntry (simpletype type, int dim, shpseg *shape) +GetUnsupportedShapeEntry (simpletype type, int dim, shape *shape) { unsupported_shape_t *unsupported_shape_ptr; @@ -209,7 +210,7 @@ GetUnsupportedShapeEntry (simpletype type, int dim, shpseg *shape) while ((unsupported_shape_ptr != NULL) && (!matched)) { if ((dim == US_DIM (unsupported_shape_ptr)) && (type == US_TYPE (unsupported_shape_ptr)) - && (TCequalShpseg (dim, shape, US_SHAPE (unsupported_shape_ptr)))) { + && (SHcompareShapes (shape, US_SHAPE (unsupported_shape_ptr)))) { matched = TRUE; } else { unsupported_shape_ptr = US_NEXT (unsupported_shape_ptr); @@ -241,8 +242,8 @@ RemovePadInfoElement (pad_info_t *element) DBUG_ENTER (); - FREEfreeShpseg (PI_OLD_SHAPE (element)); - FREEfreeShpseg (PI_NEW_SHAPE (element)); + SHfreeShape (PI_OLD_SHAPE (element)); + SHfreeShape (PI_NEW_SHAPE (element)); pi_next_ptr = PI_NEXT (element); element = MEMfree (element); @@ -268,7 +269,7 @@ RemoveUnsupportedShapeElement (unsupported_shape_t *element) DBUG_ENTER (); - FREEfreeShpseg (US_SHAPE (element)); + SHfreeShape (US_SHAPE (element)); us_next_ptr = US_NEXT (element); element = MEMfree (element); @@ -293,7 +294,7 @@ RemoveArrayTypeElement (array_type_t *element) DBUG_ENTER (); - FREEfreeShpseg (AT_SHAPE (element)); + SHfreeShape (AT_SHAPE (element)); at_next_ptr = AT_NEXT (element); element = MEMfree (element); @@ -318,7 +319,7 @@ RemoveConflictGroupElement (conflict_group_t *element) DBUG_ENTER (); - FREEfreeShpseg (CG_GROUP (element)); + SHfreeShape (CG_GROUP (element)); cg_next_ptr = CG_NEXT (element); element = MEMfree (element); @@ -343,7 +344,7 @@ RemovePatternElement (pattern_t *element) DBUG_ENTER (); - FREEfreeShpseg (PT_PATTERN (element)); + SHfreeShape (PT_PATTERN (element)); pt_next_ptr = PT_NEXT (element); element = MEMfree (element); @@ -547,8 +548,8 @@ RemoveDuplicateAccesses (void) while (pt_ptr != NULL) { if (PT_NEXT (pt_ptr) != NULL) { - if (TCequalShpseg (AT_DIM (at_ptr), PT_PATTERN (pt_ptr), - PT_PATTERN (PT_NEXT (pt_ptr)))) { + if (SHcompareShapes (PT_PATTERN (pt_ptr), + PT_PATTERN (PT_NEXT (pt_ptr)))) { /* remove duplicate */ PT_NEXT (pt_ptr) = RemovePatternElement (PT_NEXT (pt_ptr)); @@ -620,8 +621,8 @@ RemoveIdenticalConflictGroups (void) while (identical && (pt_ptr != NULL) && (pt_check_ptr != NULL)) { - if (TCequalShpseg (AT_DIM (at_ptr), PT_PATTERN (pt_ptr), - PT_PATTERN (pt_check_ptr))) { + if (SHcompareShapes (PT_PATTERN (pt_ptr), + PT_PATTERN (pt_check_ptr))) { pt_ptr = PT_NEXT (pt_ptr); pt_check_ptr = PT_NEXT (pt_check_ptr); } else { @@ -666,15 +667,15 @@ RemoveIdenticalConflictGroups (void) /***************************************************************************** * * function: - * void PIprintShpSeg(int dim, shpseg* shape) + * void PIprintShpSeg(int dim, shape* shp) * * description: - * print shpseg to apdiag-file + * print shape to apdiag-file * *****************************************************************************/ void -PIprintShpSeg (int dim, shpseg *shape) +PIprintShpSeg (int dim, shape *shp) { int i; @@ -685,9 +686,9 @@ PIprintShpSeg (int dim, shpseg *shape) APprintDiag ("["); for (i = 0; i < dim - 1; i++) { - APprintDiag ("%3d, ", SHPSEG_SHAPE (shape, i)); + APprintDiag ("%3d, ", SHgetExtent (shp, i)); } - APprintDiag ("%3d]", SHPSEG_SHAPE (shape, dim - 1)); + APprintDiag ("%3d]", SHgetExtent (shp, dim - 1)); DBUG_RETURN (); } @@ -856,7 +857,7 @@ PIinit () /***************************************************************************** * * function: - * pattern_t* PIconcatPatterns(pattern_t* pattern, shpseg* shape) + * pattern_t* PIconcatPatterns(pattern_t* pattern, shape* shp) * * description: * concat existing list of patterns (pattern) and new pattern (shape) @@ -865,7 +866,7 @@ PIinit () *****************************************************************************/ pattern_t * -PIconcatPatterns (pattern_t *pattern, shpseg *shape) +PIconcatPatterns (pattern_t *pattern, shape *shp) { pattern_t *result; @@ -873,7 +874,7 @@ PIconcatPatterns (pattern_t *pattern, shpseg *shape) DBUG_ENTER (); result = (pattern_t *)MEMmalloc (sizeof (pattern_t)); - PT_PATTERN (result) = shape; + PT_PATTERN (result) = shp; PT_NEXT (result) = pattern; DBUG_RETURN (result); @@ -882,7 +883,7 @@ PIconcatPatterns (pattern_t *pattern, shpseg *shape) /***************************************************************************** * * function: - * void PIaddAccessPattern(simpletype type, int dim, shpseg* shape, shpseg* group, + * void PIaddAccessPattern(simpletype type, int dim, shape* shp, shape* group, *accessdir_t direction, pattern_t* patterns) * * description: @@ -893,7 +894,7 @@ PIconcatPatterns (pattern_t *pattern, shpseg *shape) *****************************************************************************/ void -PIaddAccessPattern (simpletype type, int dim, shpseg *shape, shpseg *group, +PIaddAccessPattern (simpletype type, int dim, shape *shp, shape *group, accessdir_t direction, pattern_t *patterns) { @@ -907,7 +908,7 @@ PIaddAccessPattern (simpletype type, int dim, shpseg *shape, shpseg *group, DBUG_ASSERT (patterns != NULL, " unexpected empty access pattern!"); /* check existence of array type */ - at_ptr = GetArrayTypeEntry (type, dim, shape); + at_ptr = GetArrayTypeEntry (type, dim, shp); /* add new type */ if (at_ptr == NULL) { @@ -915,12 +916,12 @@ PIaddAccessPattern (simpletype type, int dim, shpseg *shape, shpseg *group, array_type = (array_type_t *)MEMmalloc (sizeof (array_type_t)); AT_DIM (array_type) = dim; AT_TYPE (array_type) = type; - AT_SHAPE (array_type) = shape; + AT_SHAPE (array_type) = shp; AT_GROUPS (array_type) = NULL; AT_NEXT (array_type) = at_next_ptr; at_ptr = array_type; } else { - FREEfreeShpseg (shape); + SHfreeShape (shp); } /* add new conflict group with patterns to type */ @@ -985,7 +986,7 @@ PIprintAccessPatterns () /***************************************************************************** * * function: - * bool PIaddUnsupportedShape(types* array_type) + * bool PIaddUnsupportedShape(ntype * array_type) * * description: * add a new entry to unsupported_shape, if no entry for specified type, class @@ -996,7 +997,7 @@ PIprintAccessPatterns () *****************************************************************************/ bool -PIaddUnsupportedShape (types *array_type) +PIaddUnsupportedShape (ntype *array_type) { unsupported_shape_t *unsupported_shape_ptr; @@ -1007,17 +1008,18 @@ PIaddUnsupportedShape (types *array_type) /* check, if entry for array_type and class already exists */ unsupported_shape_ptr - = GetUnsupportedShapeEntry (TYPES_BASETYPE (array_type), TYPES_DIM (array_type), - TYPES_SHPSEG (array_type)); + = GetUnsupportedShapeEntry (TUgetSimpleImplementationType (array_type), + TUgetFullDimEncoding (array_type), + TYgetShape (array_type)); if (unsupported_shape_ptr == NULL) { /* create new entry */ us_next_ptr = unsupported_shape; unsupported_shape = (unsupported_shape_t *)MEMmalloc (sizeof (unsupported_shape_t)); - US_DIM (unsupported_shape) = TYPES_DIM (array_type); - US_TYPE (unsupported_shape) = TYPES_BASETYPE (array_type); - US_SHAPE (unsupported_shape) = TYPES_SHPSEG (array_type); + US_DIM (unsupported_shape) = TUgetFullDimEncoding (array_type); + US_TYPE (unsupported_shape) = TUgetSimpleImplementationType (array_type); + US_SHAPE (unsupported_shape) = TYgetShape (array_type); US_NEXT (unsupported_shape) = us_next_ptr; added = TRUE; } else { @@ -1030,7 +1032,7 @@ PIaddUnsupportedShape (types *array_type) /***************************************************************************** * * function: - * bool PIisUnsupportedShape(types* array_type) + * bool PIisUnsupportedShape(ntype* array_type) * * description: * check, if specified type already exists in list of unsupported shapes @@ -1038,7 +1040,7 @@ PIaddUnsupportedShape (types *array_type) *****************************************************************************/ bool -PIisUnsupportedShape (types *array_type) +PIisUnsupportedShape (ntype *array_type) { unsupported_shape_t *unsupported_shape_ptr; @@ -1047,8 +1049,9 @@ PIisUnsupportedShape (types *array_type) DBUG_ENTER (); unsupported_shape_ptr - = GetUnsupportedShapeEntry (TYPES_BASETYPE (array_type), TYPES_DIM (array_type), - TYPES_SHPSEG (array_type)); + = GetUnsupportedShapeEntry (TUgetSimpleImplementationType (array_type), + TUgetFullDimEncoding (array_type), + TYgetShape (array_type)); if (unsupported_shape_ptr == NULL) { is_unsupported = FALSE; } else { @@ -1091,7 +1094,7 @@ PIprintUnsupportedShapes () /****************************************************************************** * * function: - * int PIlinearizeVector (int dim, shpseg* shape, shpseg* vect) + * int PIlinearizeVector (int dim, shape* shp, shape* vect) * * description * @@ -1101,7 +1104,7 @@ PIprintUnsupportedShapes () ******************************************************************************/ int -PIlinearizeVector (int dim, shpseg *shape, shpseg *vect) +PIlinearizeVector (int dim, shape *shp, shape *vect) { int offset; @@ -1110,10 +1113,10 @@ PIlinearizeVector (int dim, shpseg *shape, shpseg *vect) DBUG_ENTER (); /* Horner scheme */ - offset = SHPSEG_SHAPE (vect, 0); + offset = SHgetExtent (vect, 0); for (i = 1; i < dim; i++) { - offset *= SHPSEG_SHAPE (shape, i); - offset += SHPSEG_SHAPE (vect, i); + offset *= SHgetExtent (shp, i); + offset += SHgetExtent (vect, i); } DBUG_RETURN (offset); @@ -1194,8 +1197,8 @@ PIremoveUnsupportedShapes () while (pi_ptr != NULL) { if ((US_TYPE (us_ptr) == PI_TYPE (pi_ptr)) && (US_DIM (us_ptr) == PI_DIM (pi_ptr)) - && (TCequalShpseg (US_DIM (us_ptr), US_SHAPE (us_ptr), - PI_OLD_SHAPE (pi_ptr)))) { + && (SHcompareShapes (US_SHAPE (us_ptr), + PI_OLD_SHAPE (pi_ptr)))) { /* unsupported shape found in pad_info */ PrintPadInfoElement (pi_ptr); @@ -1245,14 +1248,14 @@ PIgetArrayTypeDim (array_type_t *at_ptr) /***************************************************************************** * * function: - * shpseg* PIgetArrayTypeShape(array_type_t* at_ptr) + * shape* PIgetArrayTypeShape(array_type_t* at_ptr) * * description: * return shape of specified array type * *****************************************************************************/ -shpseg * +shape * PIgetArrayTypeShape (array_type_t *at_ptr) { @@ -1287,14 +1290,14 @@ PIgetArrayTypeBasetype (array_type_t *at_ptr) /***************************************************************************** * * function: - * shpseg* PIgetPatternShape(pattern_t* pt_ptr) + * shape* PIgetPatternShape(pattern_t* pt_ptr) * * description: * return shape of specified pattern * *****************************************************************************/ -shpseg * +shape * PIgetPatternShape (pattern_t *pt_ptr) { @@ -1463,18 +1466,18 @@ PIgetNextPattern (pattern_t *pt_ptr) * * function: * void PIaddInferredShape(simpletype type, int dim, - * shpseg* old_shape, shpseg* new_shape - * shpseg *padding) + * shape* old_shape, shape* new_shape + * shape *padding) * * description: * add a new entry to the data structure for a newly inferred type - * attention: shpsegs are set free within pad_info.c !!! + * attention: shape are set free within pad_info.c !!! * *****************************************************************************/ void -PIaddInferredShape (simpletype type, int dim, shpseg *old_shape, shpseg *new_shape, - shpseg *padding) +PIaddInferredShape (simpletype type, int dim, shape *old_shape, shape *new_shape, + shape *padding) { pad_info_t *tmp; @@ -1500,8 +1503,8 @@ PIaddInferredShape (simpletype type, int dim, shpseg *old_shape, shpseg *new_sha * * function: * int PIpaddingOverhead(int dim, - * shpseg* orig_shape, - * shpseg* padding) + * shape* orig_shape, + * shape* padding) * * description * @@ -1512,7 +1515,7 @@ PIaddInferredShape (simpletype type, int dim, shpseg *old_shape, shpseg *new_sha ******************************************************************************/ int -PIpaddingOverhead (int dim, shpseg *orig_shape, shpseg *padding) +PIpaddingOverhead (int dim, shape *orig_shape, shape *padding) { int i, overhead; unsigned long int orig_size, padding_size; @@ -1523,8 +1526,8 @@ PIpaddingOverhead (int dim, shpseg *orig_shape, shpseg *padding) padding_size = 1; for (i = 0; i < dim; i++) { - orig_size *= SHPSEG_SHAPE (orig_shape, i); - padding_size *= (SHPSEG_SHAPE (orig_shape, i) + SHPSEG_SHAPE (padding, i)); + orig_size *= SHgetExtent (orig_shape, i); + padding_size *= (SHgetExtent (orig_shape, i) + SHgetExtent (padding, i)); } if ((padding_size < orig_size) || (orig_size == 0)) { @@ -1566,9 +1569,9 @@ PInoteResults () while (pi_ptr != NULL) { basetype = CVbasetype2String (PI_TYPE (pi_ptr)); - old = CVshpseg2String (PI_DIM (pi_ptr), PI_OLD_SHAPE (pi_ptr)); - xnew = CVshpseg2String (PI_DIM (pi_ptr), PI_NEW_SHAPE (pi_ptr)); - pad = CVshpseg2String (PI_DIM (pi_ptr), PI_PADDING (pi_ptr)); + old = SHshape2String (PI_DIM (pi_ptr), PI_OLD_SHAPE (pi_ptr)); + xnew = SHshape2String (PI_DIM (pi_ptr), PI_NEW_SHAPE (pi_ptr)); + pad = SHshape2String (PI_DIM (pi_ptr), PI_PADDING (pi_ptr)); overhead = PIpaddingOverhead (PI_DIM (pi_ptr), PI_OLD_SHAPE (pi_ptr), PI_PADDING (pi_ptr)); @@ -1618,7 +1621,7 @@ PIprintPadInfo () /***************************************************************************** * * function: - * types* PIgetNewType(types* old_type) + * ntype* PIgetNewType(ntype* old_type) * * description: * returns type-structure with padded shape @@ -1629,11 +1632,11 @@ PIprintPadInfo () * *****************************************************************************/ -types * -PIgetNewType (types *old_type) +ntype * +PIgetNewType (ntype *old_type) { - types *new_type; + ntype *new_type; pad_info_t *table_entry; DBUG_ENTER (); @@ -1643,10 +1646,9 @@ PIgetNewType (types *old_type) table_entry = GetNewTableEntry (old_type); if (table_entry != NULL) { - new_type = DUPdupAllTypes (old_type); - FREEfreeShpseg (TYPES_SHPSEG (new_type)); - TYPES_SHPSEG (new_type) = DUPdupShpseg (PI_NEW_SHAPE (table_entry)); - FREEfreeOneTypes (old_type); + new_type = TYmakeAKS (TYcopyType (TYgetScalar( old_type)), + SHcopyShape (PI_NEW_SHAPE (table_entry))); + TYfreeType (old_type); } DBUG_RETURN (new_type); @@ -1655,7 +1657,7 @@ PIgetNewType (types *old_type) /***************************************************************************** * * function: - * types* PIgetOldType(types* new_type) + * ntype* PIgetOldType(ntype* new_type) * * description: * returns type-structure with unpadded shape @@ -1666,11 +1668,11 @@ PIgetNewType (types *old_type) * *****************************************************************************/ -types * -PIgetOldType (types *new_type) +ntype * +PIgetOldType (ntype *new_type) { - types *old_type; + ntype *old_type; pad_info_t *table_entry; DBUG_ENTER (); @@ -1680,10 +1682,9 @@ PIgetOldType (types *new_type) table_entry = GetOldTableEntry (new_type); if (table_entry != NULL) { - old_type = DUPdupAllTypes (new_type); - FREEfreeShpseg (TYPES_SHPSEG (old_type)); - TYPES_SHPSEG (old_type) = DUPdupShpseg (PI_OLD_SHAPE (table_entry)); - FREEfreeOneTypes (new_type); + old_type = TYmakeAKS (TYcopyType (TYgetScalar( new_type)), + SHcopyShape (PI_OLD_SHAPE (table_entry))); + TYfreeType (new_type); } DBUG_RETURN (old_type); @@ -1692,7 +1693,7 @@ PIgetOldType (types *new_type) /***************************************************************************** * * function: - * node* PIgetFUndefPad(types *old_type) + * node* PIgetFUndefPad(ntype *old_type) * * description: * return pointer to fundef-node of padding-function @@ -1700,7 +1701,7 @@ PIgetOldType (types *new_type) *****************************************************************************/ node * -PIgetFundefPad (types *old_type) +PIgetFundefPad (ntype *old_type) { pad_info_t *table_entry; @@ -1723,7 +1724,7 @@ PIgetFundefPad (types *old_type) *****************************************************************************/ node * -PIgetFundefUnpad (types *old_type) +PIgetFundefUnpad (ntype *old_type) { pad_info_t *table_entry; diff --git a/src/libsac2c/arrayopt/pad_info.h b/src/libsac2c/arrayopt/pad_info.h index cf8f0c498..b243e3b22 100644 --- a/src/libsac2c/arrayopt/pad_info.h +++ b/src/libsac2c/arrayopt/pad_info.h @@ -15,49 +15,52 @@ #ifndef _SAC_PAD_INFO_H_ #define _SAC_PAD_INFO_H_ +#include "shape.h" +#include "new_types.h" + /* used in pad.c */ extern void PIinit (void); extern void PIfree (void); /* used in pad_collect.c */ -extern pattern_t *PIconcatPatterns (pattern_t *pattern, shpseg *shape); -extern void PIaddAccessPattern (simpletype type, int dim, shpseg *shape, shpseg *group, +extern pattern_t *PIconcatPatterns (pattern_t *pattern, shape *shp); +extern void PIaddAccessPattern (simpletype type, int dim, shape *shp, shape *group, accessdir_t direction, pattern_t *patterns); -extern void PIprintShpSeg (int dim, shpseg *shape); +extern void PIprintShpSeg (int dim, shape *shp); extern void PIprintArrayTypeElement (array_type_t *at_ptr); extern void PIprintConflictGroupElement (array_type_t *at_ptr, conflict_group_t *cg_ptr); extern void PIprintPatternElement (array_type_t *at_ptr, pattern_t *pt_ptr); extern void PIprintAccessPatterns (void); -extern bool PIaddUnsupportedShape (types *array_type); -extern bool PIisUnsupportedShape (types *array_type); +extern bool PIaddUnsupportedShape (ntype *array_type); +extern bool PIisUnsupportedShape (ntype *array_type); extern void PIprintUnsupportedShapes (void); extern void PItidyAccessPattern (void); extern void PIremoveUnsupportedShapes (void); /* used in pad_infer.c */ -extern int PIlinearizeVector (int dim, shpseg *shape, shpseg *vect); +extern int PIlinearizeVector (int dim, shape *shp, shape *vect); extern int PIgetArrayTypeDim (array_type_t *at_ptr); -extern shpseg *PIgetArrayTypeShape (array_type_t *at_ptr); +extern shape *PIgetArrayTypeShape (array_type_t *at_ptr); extern simpletype PIgetArrayTypeBasetype (array_type_t *at_ptr); -extern shpseg *PIgetPatternShape (pattern_t *pt_ptr); +extern shape *PIgetPatternShape (pattern_t *pt_ptr); extern array_type_t *PIgetFirstArrayType (void); extern array_type_t *PIgetNextArrayType (array_type_t *at_ptr); extern conflict_group_t *PIgetFirstConflictGroup (array_type_t *at_ptr); extern conflict_group_t *PIgetNextConflictGroup (conflict_group_t *cg_ptr); extern pattern_t *PIgetFirstPattern (conflict_group_t *cg_ptr); extern pattern_t *PIgetNextPattern (pattern_t *pt_ptr); -extern void PIaddInferredShape (simpletype type, int dim, shpseg *old_shape, - shpseg *new_shape, shpseg *padding); -extern int PIpaddingOverhead (int dim, shpseg *shape, shpseg *padding); +extern void PIaddInferredShape (simpletype type, int dim, shape *old_shape, + shape *new_shape, shape *padding); +extern int PIpaddingOverhead (int dim, shape *shp, shape *padding); extern void PInoteResults (void); /* used in pad_transform.c */ extern void PIprintPadInfo (void); -extern types *PIgetNewType (types *old_type); -extern types *PIgetOldType (types *old_type); -extern node *PIgetFundefPad (types *old_type); -extern node *PIgetFundefUnpad (types *old_type); +extern ntype *PIgetNewType (ntype *old_type); +extern ntype *PIgetOldType (ntype *old_type); +extern node *PIgetFundefPad (ntype *old_type); +extern node *PIgetFundefUnpad (ntype *old_type); #endif /* _SAC_PAD_INFO_H_ */ diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index 2e2fb0ec1..eb9d1793e 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -6922,8 +6922,8 @@ COMPprfIdxModarray_AxSxS (node *arg_node, info *arg_info) /* if( global.backend == BE_cuda && - ( TCgetBasetype( ID_NTYPE( arg1)) == T_float_dev || - TCgetBasetype( ID_NTYPE( arg1)) == T_int_dev) && + ( TUgetSimpleImplementationType (ID_NTYPE( arg1)) == T_float_dev || + TUgetSimpleImplementationType (ID_NTYPE( arg1)) == T_int_dev) && !FUNDEF_ISCUDAGLOBALFUN( INFO_FUNDEF( arg_info))) { ret_node = TCmakeAssignIcm4( "CUDA_PRF_IDX_MODARRAY_AxSxS__DATA", MakeTypeArgs( IDS_NAME( let_ids), diff --git a/src/libsac2c/codegen/icm_comment.c b/src/libsac2c/codegen/icm_comment.c index cd787dc24..c8d797cda 100644 --- a/src/libsac2c/codegen/icm_comment.c +++ b/src/libsac2c/codegen/icm_comment.c @@ -37,7 +37,7 @@ #define ICM_BOOL(name) ICM_INT (name) /* dim and i needs to be signed due to function in tree_compound.c - called TCgetShapeDim as it uses negatives to encode other + called TUgetFullDimEncoding as it uses negatives to encode other shape information. */ #define ICM_VARANY(dim, name) \ diff --git a/src/libsac2c/constants/shape.c b/src/libsac2c/constants/shape.c index 477e336dc..999c915b2 100644 --- a/src/libsac2c/constants/shape.c +++ b/src/libsac2c/constants/shape.c @@ -605,36 +605,6 @@ SHshape2String (size_t dots, shape *shp) DBUG_RETURN (res); } -/** - * - * @fn shape *SHoldTypes2Shape( types *types) - * - * @brief if types has a dim>=0 a shape structure is created which carries the same - * shape info as the types-node does. Otherwise, NULL is returned. - * - ******************************************************************************/ -shape * -SHoldTypes2Shape (types *types) -{ - int dim; - shape *res; - shpseg *shpseg; - - DBUG_ENTER (); - DBUG_ASSERT (types != NULL, "SHoldTypes2Shape called with NULL types!"); - - /* this function handle user defined types, too */ - shpseg = TCtype2Shpseg (types, &dim); - - res = SHoldShpseg2Shape (dim, shpseg); - - if (shpseg != NULL) { - shpseg = FREEfreeShpseg (shpseg); - } - - DBUG_RETURN (res); -} - /** * * @fn shape *SHoldShpseg2Shape( int dim, shpseg *shpseg) diff --git a/src/libsac2c/constants/shape.h b/src/libsac2c/constants/shape.h index 26171e981..447ccc149 100644 --- a/src/libsac2c/constants/shape.h +++ b/src/libsac2c/constants/shape.h @@ -48,7 +48,6 @@ extern node *SHshape2Exprs (shape *shp); extern node *SHshape2Array (shape *shp); extern shape *SHarray2Shape (node *array); -extern shape *SHoldTypes2Shape (types *shpseg); extern shape *SHoldShpseg2Shape (int dim, shpseg *shpseg); extern shpseg *SHshape2OldShpseg (shape *shp); diff --git a/src/libsac2c/cuda/cuda_utils.c b/src/libsac2c/cuda/cuda_utils.c index 6dca2ce43..b45354276 100644 --- a/src/libsac2c/cuda/cuda_utils.c +++ b/src/libsac2c/cuda/cuda_utils.c @@ -197,20 +197,6 @@ CUisShmemTypeNew (ntype *ty) DBUG_RETURN (CUisShmemType (TYgetSimpleType (TYgetScalar (ty)))); } -bool -CUisShmemTypeOld (types *ty) -{ - DBUG_ENTER (); - DBUG_RETURN (CUisShmemType (TCgetBasetype (ty))); -} - -bool -CUisDeviceTypeOld (types *ty) -{ - DBUG_ENTER (); - DBUG_RETURN (CUisDeviceType (TCgetBasetype (ty))); -} - bool CUisDeviceArrayTypeNew (ntype *ty) { diff --git a/src/libsac2c/cuda/cuda_utils.h b/src/libsac2c/cuda/cuda_utils.h index 07ab99a74..d0aeffb3b 100644 --- a/src/libsac2c/cuda/cuda_utils.h +++ b/src/libsac2c/cuda/cuda_utils.h @@ -29,8 +29,6 @@ extern simpletype CUd2shSimpleTypeConversion (simpletype sty); extern simpletype CUh2shSimpleTypeConversion (simpletype sty); extern bool CUisDeviceTypeNew (ntype *ty); extern bool CUisShmemTypeNew (ntype *ty); -extern bool CUisDeviceTypeOld (types *ty); -extern bool CUisShmemTypeOld (types *ty); extern bool CUisDeviceArrayTypeNew (ntype *ty); extern ntype *CUconvertHostToDeviceType (ntype *host_type); extern ntype *CUconvertDeviceToHostType (ntype *device_type); diff --git a/src/libsac2c/multithread/tag_executionmode.c b/src/libsac2c/multithread/tag_executionmode.c index 69dfbfac2..7b44abebf 100644 --- a/src/libsac2c/multithread/tag_executionmode.c +++ b/src/libsac2c/multithread/tag_executionmode.c @@ -37,6 +37,8 @@ #include "debug.h" #include "globals.h" +#include "new_types.h" +#include "shape.h" #include "type_utils.h" /* @@ -494,8 +496,6 @@ IsGeneratorBigEnough (node *test_variables) node *iterator; bool is_bigenough; int var_dim, var_size; /* dimension and size of an actual variable */ - int i; - node *vardec; DBUG_ENTER (); /* some initializations */ @@ -506,12 +506,8 @@ IsGeneratorBigEnough (node *test_variables) /* TODO handling of AUD and AKD arrays */ while (iterator != NULL) { - vardec = IDS_DECL (iterator); - var_dim = VARDEC_DIM (vardec); - var_size = 1; - for (i = 0; i < var_dim; i++) { - var_size *= VARDEC_SHAPE (vardec, i); - } + var_dim = TYgetDim (IDS_NTYPE (iterator)); + var_size = SHgetUnrLen (TYgetShape (IDS_NTYPE (iterator))); if (var_size >= global.max_threads) { is_bigenough = TRUE; @@ -545,10 +541,10 @@ static bool IsMTClever (node *test_variables) { bool is_clever; - int i, var_dim; /* dimension and size of an actual variable */ + int var_dim; /* dimension and size of an actual variable */ double var_size; /* size of an actual variable */ double carry; - node *iterator, *vardec; + node *iterator; DBUG_ENTER (); /* some initialization */ @@ -558,12 +554,9 @@ IsMTClever (node *test_variables) while ((is_clever == FALSE) && (iterator != NULL)) { - vardec = IDS_DECL (iterator); - var_dim = VARDEC_DIM (vardec); - var_size = 1.0; - for (i = 0; i < var_dim; i++) { - var_size *= (double)VARDEC_SHAPE (vardec, i); - } + var_dim = TYgetDim (IDS_NTYPE (iterator)); + var_size = SHgetUnrLen (TYgetShape (IDS_NTYPE (iterator))); + /* add the size of the actual variable to the sum of the sizes of the former variables */ carry += var_size; @@ -594,9 +587,9 @@ IsSTClever (node *test_variables) { /* implementation is like IsMTClever, except of the absence carry-variable */ bool is_clever; - int i, var_dim; /* dimension and size of an actual variable */ + int var_dim; /* dimension and size of an actual variable */ double var_size; /* size of an actual variable */ - node *iterator, *vardec; + node *iterator; DBUG_ENTER (); /* some initialization */ @@ -605,12 +598,9 @@ IsSTClever (node *test_variables) while ((is_clever == FALSE) && (iterator != NULL)) { - vardec = IDS_DECL (iterator); - var_dim = VARDEC_DIM (vardec); - var_size = 1.0; - for (i = 0; i < var_dim; i++) { - var_size *= (double)VARDEC_SHAPE (vardec, i); - } + var_dim = TYgetDim (IDS_NTYPE (iterator)); + var_size = SHgetUnrLen (TYgetShape (IDS_NTYPE (iterator))); + if (var_size >= (double)(global.max_replication_size)) { is_clever = TRUE; DBUG_PRINT ("Found variable, #elements > max_replication_size"); diff --git a/src/libsac2c/tree/DataFlowMaskUtils.c b/src/libsac2c/tree/DataFlowMaskUtils.c index ea4994058..07c40640e 100644 --- a/src/libsac2c/tree/DataFlowMaskUtils.c +++ b/src/libsac2c/tree/DataFlowMaskUtils.c @@ -41,48 +41,6 @@ DFMUdfm2Rets (dfmask_t *mask) DBUG_RETURN (rets); } -/****************************************************************************** - * - * function: - * types *DFMUdfm2ReturnTypes( dfmask_t* mask) - * - * description: - * Creates a types chain based on the given DFmask. - * - *****************************************************************************/ - -types * -DFMUdfm2ReturnTypes (dfmask_t *mask) -{ - node *avis; - types *tmp; - types *rettypes = NULL; - - DBUG_ENTER (); - - /* - * build return types, return exprs (use SPMD_OUT). - */ - avis = DFMgetMaskEntryAvisSet (mask); - while (avis != NULL) { - - tmp = rettypes; - rettypes = TYtype2OldType (AVIS_TYPE (avis)); - TYPES_NEXT (rettypes) = tmp; - - avis = DFMgetMaskEntryAvisSet (NULL); - } - - /* - * we must build a void-type if ('rettypes' == NULL) is hold - */ - if (rettypes == NULL) { - rettypes = TBmakeTypes1 (T_void); - } - - DBUG_RETURN (rettypes); -} - /****************************************************************************** * * function: diff --git a/src/libsac2c/tree/DataFlowMaskUtils.h b/src/libsac2c/tree/DataFlowMaskUtils.h index aae586934..f9de726ce 100644 --- a/src/libsac2c/tree/DataFlowMaskUtils.h +++ b/src/libsac2c/tree/DataFlowMaskUtils.h @@ -3,7 +3,6 @@ #include "types.h" -extern types *DFMUdfm2ReturnTypes (dfmask_t *mask); extern node *DFMUdfm2Rets (dfmask_t *mask); extern node *DFMUdfm2Vardecs (dfmask_t *mask, lut_t *lut); extern node *DFMUdfm2Args (dfmask_t *mask, lut_t *lut); diff --git a/src/libsac2c/tree/free_attribs.c b/src/libsac2c/tree/free_attribs.c index 11825fc8b..914de4101 100644 --- a/src/libsac2c/tree/free_attribs.c +++ b/src/libsac2c/tree/free_attribs.c @@ -583,7 +583,7 @@ FREEattribAccess (access_t *attr, node *parent) while (attr != NULL) { access_t *tmp = attr; attr = attr->next; - tmp->offset = FREEfreeShpseg (tmp->offset); + tmp->offset = SHfreeShape (tmp->offset); tmp = MEMfree (tmp); } diff --git a/src/libsac2c/tree/tree_basic.c b/src/libsac2c/tree/tree_basic.c index f93d1e4dd..73ee38ed2 100644 --- a/src/libsac2c/tree/tree_basic.c +++ b/src/libsac2c/tree/tree_basic.c @@ -127,7 +127,7 @@ TBmakeNodelistNode (node *node, nodelist *next) /*--------------------------------------------------------------------------*/ access_t * -TBmakeAccess (node *array, node *iv, accessclass_t mclass, shpseg *offset, +TBmakeAccess (node *array, node *iv, accessclass_t mclass, shape *offset, accessdir_t direction, access_t *next) { access_t *tmp; diff --git a/src/libsac2c/tree/tree_basic.h b/src/libsac2c/tree/tree_basic.h index e74d148c7..e57903932 100644 --- a/src/libsac2c/tree/tree_basic.h +++ b/src/libsac2c/tree/tree_basic.h @@ -171,7 +171,7 @@ extern argtab_t *TBmakeArgtab (size_t size); ***/ extern access_t *TBmakeAccess (node *array, node *iv, accessclass_t mclass, - shpseg *offset, accessdir_t direction, access_t *next); + shape *offset, accessdir_t direction, access_t *next); #define ACCESS_ARRAY(a) (a->array_vardec) #define ACCESS_IV(a) (a->iv_vardec) diff --git a/src/libsac2c/tree/tree_compound.c b/src/libsac2c/tree/tree_compound.c index 11017115f..a69dd81de 100644 --- a/src/libsac2c/tree/tree_compound.c +++ b/src/libsac2c/tree/tree_compound.c @@ -261,504 +261,6 @@ TCshpseg2Array (shpseg *shape, int dim) /*--------------------------------------------------------------------------*/ -/*** - *** TYPES : - ***/ - -/****************************************************************************** - * - * function: - * types *TCappendTypes( types *chain, types *item) - * - * description: - * append item to list of types - * - ******************************************************************************/ - -types * -TCappendTypes (types *chain, types *item) -{ - types *ret; - - DBUG_ENTER (); - - APPEND (ret, types *, TYPES, chain, item); - - DBUG_RETURN (ret); -} - -/****************************************************************************** - * - * function: - * unsigned int TCcountTypes( types *type) - * - * description: - * Counts the number of types. - * - ******************************************************************************/ - -unsigned int -TCcountTypes (types *type) -{ - unsigned int count = 0; - - DBUG_ENTER (); - - while (type != NULL) { - if (TYPES_BASETYPE (type) != T_void) { - count++; - } - type = TYPES_NEXT (type); - } - - DBUG_RETURN (count); -} - -/****************************************************************************** - * - * Function: - * type *TCgetTypesLine( types* type, size_t line) - * - * Description: - * line > 0: generate an error message if error occurs. - * otherwise: DBUG assert. - * - ******************************************************************************/ - -types * -TCgetTypesLine (types *type, size_t line) -{ - node *tdef; - types *res_type = NULL; - - DBUG_ENTER (); - - if (TYPES_BASETYPE (type) == T_user) { - tdef = TYPES_TDEF (type); - - if ((tdef == NULL) && (global.compiler_phase <= PH_tc)) { - tdef = NULL; - } - - if (line > 0) { - if (tdef == NULL) { - CTIabortLine (line, "Type '%s:%s' is unknown", TYPES_MOD (type), - TYPES_NAME (type)); - } - } else { - DBUG_ASSERT (tdef != NULL, "typedef not found!"); - } - - /* - * we have to switch to ntypes here, as the typedefs do - * not hold any old types anymore. maybe the backend - * will move to newtypes one day so this hybrid function - * can be removed. - */ - - if (TUisHidden (TYPEDEF_NTYPE (tdef))) { - /* - * Basic type is hidden therefore we have to use the original type - * structure and rely on the belonging typedef!! - */ - res_type = type; - } else { - /* - * ok, we can resolve the type to the corresponding basetype - */ - res_type = TYtype2OldType (TYPEDEF_NTYPE (tdef)); - } - } else { - res_type = type; - } - - DBUG_RETURN (res_type); -} - -/****************************************************************************** - * - * Function: - * type *TCgetTypes( types* type) - * - * Description: - * - * - ******************************************************************************/ - -types * -TCgetTypes (types *type) -{ - types *res_type; - - DBUG_ENTER (); - - res_type = TCgetTypesLine (type, 0); - - DBUG_RETURN (res_type); -} - -/****************************************************************************** - * - * Function: - * int TCgetShapeDim( types* type) - * - * Description: - * returns encoded dimension (DIM) of 'type' - * ('encoded' means, that it contains also some shape information): - * >= 0 : dimension == DIM and known shape - * < -2: dimension == -2 - DIM and unknown shape - * == -1: dimension unknown (but > 0) - * == -2: dimension unknown (>= 0) - * - ******************************************************************************/ - -int -TCgetShapeDim (types *type) -{ - types *impl_type; - int dim, base_dim, impl_dim; - - DBUG_ENTER (); - - base_dim = TYPES_DIM (type); - - impl_type = TCgetTypes (type); - - if (impl_type != type) { - /* - * user-defined type - */ - impl_dim = TYPES_DIM (impl_type); - - if (TYPEDEF_ISNESTED (TYPES_TDEF (type))) { - dim = base_dim; - } else if ((UNKNOWN_SHAPE == impl_dim) || (UNKNOWN_SHAPE == base_dim)) { - dim = UNKNOWN_SHAPE; - } else if ((ARRAY_OR_SCALAR == impl_dim) && (ARRAY_OR_SCALAR == base_dim)) { - dim = ARRAY_OR_SCALAR; - } else if ((ARRAY_OR_SCALAR == impl_dim) && (SCALAR == base_dim)) { - dim = ARRAY_OR_SCALAR; - } else if ((SCALAR == impl_dim) && (ARRAY_OR_SCALAR == base_dim)) { - dim = ARRAY_OR_SCALAR; - } else if ((ARRAY_OR_SCALAR == impl_dim) || (ARRAY_OR_SCALAR == base_dim)) { - dim = UNKNOWN_SHAPE; - } else if (KNOWN_SHAPE (impl_dim) && KNOWN_SHAPE (base_dim)) { - dim = impl_dim + base_dim; - } else if (KNOWN_SHAPE (impl_dim) && KNOWN_DIMENSION (base_dim)) { - dim = base_dim - impl_dim; - } else if (KNOWN_DIMENSION (impl_dim) && KNOWN_SHAPE (base_dim)) { - dim = impl_dim - base_dim; - } else if (KNOWN_DIMENSION (impl_dim) && KNOWN_DIMENSION (base_dim)) { - dim = impl_dim + base_dim - KNOWN_DIM_OFFSET; - } else { - dim = 0; - DBUG_UNREACHABLE ("illegal shape/dim information found!"); - } - } else { - /* - * basic type - */ - dim = base_dim; - } - - DBUG_RETURN (dim); -} - -/****************************************************************************** - * - * Function: - * int TCgetDim( types* type) - * - * Description: - * returns dimension of 'type': - * >= 0 : dimension known - * == -1: dimension unknown (but > 0) - * == -2: dimension unknown (>= 0) - * - ******************************************************************************/ - -int -TCgetDim (types *type) -{ - int dim; - - DBUG_ENTER (); - - dim = TCgetShapeDim (type); - dim = DIM_NO_OFFSET (dim); - - DBUG_RETURN (dim); -} - -/****************************************************************************** - * - * Function: - * simpletype TCgetBasetype( types* type) - * - * Description: - * - * - ******************************************************************************/ - -simpletype -TCgetBasetype (types *type) -{ - simpletype res; - - DBUG_ENTER (); - - res = TYPES_BASETYPE (TCgetTypes (type)); - - DBUG_RETURN (res); -} - -/****************************************************************************** - * - * Function: - * int TCgetBasetypeSize(types *type) - * - * Description: - * - * - ******************************************************************************/ - -size_t -TCgetBasetypeSize (types *type) -{ - size_t size; - - DBUG_ENTER (); - - size = global.basetype_size[TCgetBasetype (type)]; - - DBUG_RETURN (size); -} - -/****************************************************************************** - * - * Function: - * int GetTypesLength( types *type) - * - * Description: - * If 'type' is an array type the number of array elements is returned. - * Otherwise the return value is 0. - * - ******************************************************************************/ - -int -TCgetTypesLength (types *type) -{ - shpseg *shape; - int dim, length; - - DBUG_ENTER (); - - shape = TCtype2Shpseg (type, &dim); - - length = TCgetShpsegLength (dim, shape); - - if (shape != NULL) { - shape = FREEfreeShpseg (shape); - } - - DBUG_RETURN (length); -} - -/****************************************************************************** - * - * Function: - * shpseg *TCtype2Shpseg( types *type, int *ret_dim) - * - * Description: - * - * - ******************************************************************************/ - -shpseg * -TCtype2Shpseg (types *type, int *ret_dim) -{ - int dim, base_dim, i; - types *impl_type; - shpseg *new_shpseg = NULL; - - DBUG_ENTER (); - - dim = TCgetShapeDim (type); - - DBUG_ASSERT (dim < SHP_SEG_SIZE, "shape is out of range"); - - if (dim > SCALAR) { - new_shpseg = TBmakeShpseg (NULL); - impl_type = TCgetTypes (type); - - base_dim = TYPES_DIM (type); - for (i = 0; i < base_dim; i++) { - SHPSEG_SHAPE (new_shpseg, i) = TYPES_SHAPE (type, i); - } - - if (impl_type != type) { - /* - * user-defined type - */ - for (i = 0; i < TYPES_DIM (impl_type); i++) { - SHPSEG_SHAPE (new_shpseg, base_dim + i) = TYPES_SHAPE (impl_type, i); - } - } - } else { - new_shpseg = NULL; - } - - if (ret_dim != NULL) { - (*ret_dim) = dim; - } - - DBUG_RETURN (new_shpseg); -} - -/****************************************************************************** - * - * Function: - * shape *TCtype2Shape( types *type) - * - * Description: - * - * - ******************************************************************************/ - -shape * -TCtype2Shape (types *type) -{ - shape *shp = NULL; - shpseg *new_shpseg = NULL; - int dim; - - DBUG_ENTER (); - - dim = TCgetShapeDim (type); - new_shpseg = TCtype2Shpseg (type, NULL); - - if (new_shpseg != NULL) { - shp = SHoldShpseg2Shape (dim, new_shpseg); - new_shpseg = MEMfree (new_shpseg); - } else { - DBUG_ASSERT (dim <= 0, "shape inconsistency"); - } - - DBUG_RETURN (shp); -} - -/****************************************************************************** - * - * Function: - * node *TCtype2Exprs( types *type) - * - * Description: - * Computes the shape of corresponding type and stores it as N_exprs chain. - * - ******************************************************************************/ - -node * -TCtype2Exprs (types *type) -{ - node *tmp; - types *impl_type; - int dim, i; - node *ret_node = NULL; - - DBUG_ENTER (); - - /* create a dummy node to append the shape items to */ - ret_node = TBmakeExprs (NULL, NULL); - - dim = TCgetShapeDim (type); - - if (dim > SCALAR) { - tmp = ret_node; - impl_type = TCgetTypes (type); - - for (i = 0; i < TYPES_DIM (type); i++) { - EXPRS_NEXT (tmp) = TBmakeExprs (TBmakeNum (TYPES_SHAPE (type, i)), NULL); - tmp = EXPRS_NEXT (tmp); - } - - if (impl_type != type) { - /* - * user-defined type - */ - for (i = 0; i < TYPES_DIM (impl_type); i++) { - EXPRS_NEXT (tmp) - = TBmakeExprs (TBmakeNum (TYPES_SHAPE (impl_type, i)), NULL); - tmp = EXPRS_NEXT (tmp); - } - } - } - - /* remove dummy node at head of chain */ - ret_node = FREEdoFreeNode (ret_node); - - DBUG_RETURN (ret_node); -} - -bool -TCisHidden (types *type) -{ - node *tdef; - bool ret = FALSE; - - DBUG_ENTER (); - - if (TYPES_BASETYPE (type) == T_hidden) { - ret = TRUE; - } else if (TYPES_BASETYPE (type) == T_user) { - tdef = TYPES_TDEF (type); - DBUG_ASSERT (tdef != NULL, "Failed attempt to look up typedef"); - - /* - * we have to move to the new types here, as the typedef does - * not hold any old types anymore - */ - if (TYisSimple (TYgetScalar (TYPEDEF_NTYPE (tdef)))) { - ret = (TYgetSimpleType (TYgetScalar (TYPEDEF_NTYPE (tdef))) == T_hidden); - } - } - - DBUG_RETURN (ret); -} - -bool -TCisUnique (types *type) -{ - bool ret = FALSE; - - DBUG_ENTER (); - - if (TYPES_BASETYPE (type) == T_user) { - ret = TUisUniqueUserType (TYoldType2Type (type)); - } - - DBUG_RETURN (ret); -} - -bool -TCisNested (types *type) -{ - node *tdef; - bool ret = FALSE; - - DBUG_ENTER (); - - if (TYPES_BASETYPE (type) == T_user) { - tdef = TYPES_TDEF (type); - DBUG_ASSERT (tdef != NULL, "Failed attempt to look up typedef"); - - ret = TYPEDEF_ISNESTED (tdef); - } - - DBUG_RETURN (ret); -} - -/*--------------------------------------------------------------------------*/ - /*** *** IDS : ***/ diff --git a/src/libsac2c/tree/tree_compound.h b/src/libsac2c/tree/tree_compound.h index 6adae0939..02b8042f9 100644 --- a/src/libsac2c/tree/tree_compound.h +++ b/src/libsac2c/tree/tree_compound.h @@ -65,35 +65,6 @@ extern node *TCshpseg2Array (shpseg *shape, int dim); /*--------------------------------------------------------------------------*/ -/*** - *** TYPES : - ***/ - -/* - * compound access macros - */ - -#define TYPES_SHAPE(t, x) (SHPSEG_SHAPE (TYPES_SHPSEG (t), x)) - -extern types *TCappendTypes (types *chain, types *item); -extern unsigned int TCcountTypes (types *type); -extern types *TCgetTypesLine (types *type, size_t line); -extern types *TCgetTypes (types *type); -extern int TCgetShapeDim (types *type); -extern int TCgetDim (types *type); -extern simpletype TCgetBasetype (types *type); -extern size_t TCgetBasetypeSize (types *type); -extern int TCgetTypesLength (types *type); -extern shpseg *TCtype2Shpseg (types *type, int *ret_dim); -extern shape *TCtype2Shape (types *type); -extern node *TCtype2Exprs (types *type); - -extern bool TCisUnique (types *type); -extern bool TCisHidden (types *type); -extern bool TCisNested (types *type); - -/*--------------------------------------------------------------------------*/ - /*** *** N_ids : ***/ @@ -347,13 +318,6 @@ extern node *TCremoveFundef (node *fundef_chain, node *fundef); #define VARDEC_NTYPE(n) (AVIS_TYPE (VARDEC_AVIS (n))) #define VARDEC_NAME(n) (AVIS_NAME (VARDEC_AVIS (n))) -/* - * TODO: REMOVE US CAUSE WE'RE UGLY - */ -#define VARDEC_DIM(n) (TYPES_DIM (VARDEC_TYPE (n))) -#define VARDEC_SHAPE(n, x) (TYPES_SHAPE (VARDEC_TYPE (n), x)) -#define VARDEC_SHPSEG(n) (TYPES_SHPSEG (VARDEC_TYPE (n))) - /****************************************************************************** * * Function: diff --git a/src/libsac2c/typecheck/new_types.c b/src/libsac2c/typecheck/new_types.c index 34c362d2c..faf008c0e 100644 --- a/src/libsac2c/typecheck/new_types.c +++ b/src/libsac2c/typecheck/new_types.c @@ -5866,321 +5866,6 @@ TYdeNestTypeFromOuter (ntype *nested, ntype *outer) DBUG_RETURN (res); } -/****************************************************************************** - * - * function: - * ntype * TYoldType2ScalarType( types *old) - * - * description: - * converts an old TYPES node into an ntype node for the base type. - * - ******************************************************************************/ - -ntype * -TYoldType2ScalarType (types *old) -{ - ntype *res; - usertype udt; - -#ifndef DBUG_OFF - char *tmp = NULL, *tmp2 = NULL; -#endif - - DBUG_ENTER (); - - switch (TYPES_BASETYPE (old)) { - case T_user: - if (TYPES_POLY (old)) { - res = TYmakePolyType (TYPES_NAME (old)); - } else { - udt = UTfindUserType (TYPES_NAME (old), NSgetNamespace (TYPES_MOD (old))); - if (udt == UT_NOT_DEFINED) { - res = TYmakeSymbType (STRcpy (TYPES_NAME (old)), - NSgetNamespace (TYPES_MOD (old))); - } else { - res = TYmakeUserType (udt); - } - } - break; - case T_byte: - case T_short: - case T_int: - case T_long: - case T_longlong: - case T_ubyte: - case T_ushort: - case T_uint: - case T_ulong: - case T_ulonglong: - case T_float: - case T_floatvec: - case T_double: - case T_longdbl: - case T_bool: - case T_str: - case T_char: - case T_hidden: - res = TYmakeSimpleType (TYPES_BASETYPE (old)); - break; - case T_void: - case T_unknown: - case T_nothing: - res = NULL; - break; - case T_dots: - res = NULL; - DBUG_UNREACHABLE ("TYoldType2Type applied to T_dots"); - break; - default: - res = NULL; - DBUG_UNREACHABLE ("TYoldType2Type applied to illegal type"); - } - -#if 0 - DBUG_EXECUTE (tmp = CVtype2String (old, 3, TRUE); - tmp2 = TYtype2DebugString (res, TRUE, 0)); - DBUG_PRINT ("base type of %s converted into : %s\n", tmp, tmp2); - DBUG_EXECUTE (tmp = MEMfree (tmp); tmp2 = MEMfree (tmp2)); -#endif - - DBUG_RETURN (res); -} - -/****************************************************************************** - * - * function: - * ntype * TYoldType2Type( types *old) - * - * description: - * converts an old TYPES node into an ntype node (or - if neccessary - - * a nesting of ntype nodes). - * - ******************************************************************************/ - -ntype * -TYoldType2Type (types *old) -{ - ntype *res; - -#ifndef DBUG_OFF - char *tmp = NULL, *tmp2 = NULL; -#endif - - DBUG_ENTER (); - - if (TYPES_AKV (old)) { - CTInote ("AKV information lost in newtype->oldtype->newtype conversion"); - } - - res = TYoldType2ScalarType (old); - - if (res != NULL) { - if (TYPES_DIM (old) > SCALAR) { - res - = TYmakeAKS (res, SHoldShpseg2Shape (TYPES_DIM (old), TYPES_SHPSEG (old))); - } else if (TYPES_DIM (old) < KNOWN_DIM_OFFSET) { - /* the result of this subtraction is always positive so safe */ - res = TYmakeAKD (res, (size_t)(KNOWN_DIM_OFFSET - TYPES_DIM (old)), SHmakeShape (0)); - } else if (TYPES_DIM (old) == UNKNOWN_SHAPE) { - res = TYmakeAUDGZ (res); - } else if (TYPES_DIM (old) == ARRAY_OR_SCALAR) { - res = TYmakeAUD (res); - } else { /* TYPES_DIM( old) == SCALAR */ - res = TYmakeAKS (res, SHcreateShape (0)); - } - } - -#if 0 - DBUG_EXECUTE (tmp = CVtype2String (old, 3, TRUE); - tmp2 = TYtype2DebugString (res, TRUE, 0)); - DBUG_PRINT ("%s converted into : %s\n", tmp, tmp2); - DBUG_EXECUTE (tmp = MEMfree (tmp); tmp2 = MEMfree (tmp2)); -#endif - - DBUG_RETURN (res); -} - -/****************************************************************************** - * - * function: - * ntype * TYoldTypes2ProdType( types *old) - * - * description: - * converts a (linked list of) old TYPES node(s) into a product type of ntypes. - * - ******************************************************************************/ - -ntype * -TYoldTypes2ProdType (types *old) -{ - size_t i, num_types; - ntype *res; - - num_types = TCcountTypes (old); - res = TYmakeEmptyProductType (num_types); - for (i = 0; i < num_types; i++) { - res = TYsetProductMember (res, i, TYoldType2Type (old)); - old = TYPES_NEXT (old); - } - return (res); -} - -/****************************************************************************** - * - * function: - * types * TYType2OldType( ntype *new) - * - * description: - * - * - ******************************************************************************/ - -static types * -Type2OldType (ntype *xnew) -{ - types *res = NULL; - types *tmp = NULL; - int i; - - DBUG_ENTER (); - - switch (NTYPE_CON (xnew)) { - case TC_alpha: - DBUG_ASSERT (TYcmpTypes (SSIgetMin (TYgetAlpha (xnew)), - SSIgetMax (TYgetAlpha (xnew))) - == TY_eq, - "Type2OldType applied to non-unique alpha type"); - res = Type2OldType (SSIgetMin (TYgetAlpha (xnew))); - break; - case TC_prod: - if (NTYPE_ARITY (xnew) == 0) { - res = TBmakeTypes1 (T_void); - } else { - for (i = (int)NTYPE_ARITY (xnew) - 1; i >= 0; i--) { - res = Type2OldType (PROD_MEMBER (xnew, i)); - TYPES_NEXT (res) = tmp; - tmp = res; - } - } - break; - case TC_akv: - res = Type2OldType (AKS_BASE (xnew)); - TYPES_DIM (res) = TYgetDim (xnew); - TYPES_SHPSEG (res) = SHshape2OldShpseg (TYgetShape (xnew)); - TYPES_AKV (res) = TRUE; - break; - case TC_aks: - res = Type2OldType (AKS_BASE (xnew)); - TYPES_DIM (res) = SHgetDim (AKS_SHP (xnew)); - TYPES_SHPSEG (res) = SHshape2OldShpseg (AKS_SHP (xnew)); - - break; - case TC_akd: - res = Type2OldType (AKD_BASE (xnew)); - TYPES_DIM (res) = KNOWN_DIM_OFFSET - (int)AKD_DOTS (xnew); - break; - case TC_audgz: - res = Type2OldType (AUDGZ_BASE (xnew)); - TYPES_DIM (res) = UNKNOWN_SHAPE; - break; - case TC_aud: - res = Type2OldType (AUD_BASE (xnew)); - TYPES_DIM (res) = ARRAY_OR_SCALAR; - break; - case TC_simple: - if ((SIMPLE_TYPE (xnew) == T_hidden) - && (SIMPLE_HIDDEN_UDT (xnew) != UT_NOT_DEFINED)) { - res = TBmakeTypes (T_user, 0, NULL, - STRcpy (UTgetName (SIMPLE_HIDDEN_UDT (xnew))), - STRcpy ((UTgetNamespace (SIMPLE_HIDDEN_UDT (xnew)) == NULL) - ? NULL - : NSgetName ( - UTgetNamespace (SIMPLE_HIDDEN_UDT (xnew))))); - TYPES_TDEF (res) = UTgetTdef (SIMPLE_HIDDEN_UDT (xnew)); - } else { - res = TBmakeTypes (SIMPLE_TYPE (xnew), 0, NULL, NULL, NULL); - } - break; - case TC_user: - res = TBmakeTypes (T_user, 0, NULL, STRcpy (UTgetName (USER_TYPE (xnew))), - STRcpy ((UTgetNamespace (USER_TYPE (xnew)) == NULL) - ? NULL - : NSgetName (UTgetNamespace (USER_TYPE (xnew))))); - TYPES_TDEF (res) = UTgetTdef (USER_TYPE (xnew)); - break; - default: - DBUG_UNREACHABLE ("Type2OldType not yet entirely implemented!"); - res = NULL; - break; - } - - if (res != NULL && xnew != NULL) { - TYPES_MUTC_SCOPE (res) = NTYPE_MUTC_SCOPE (xnew); - TYPES_MUTC_USAGE (res) = NTYPE_MUTC_USAGE (xnew); - if (TYisUnique (xnew)) { - TYPES_UNIQUE (res) = TRUE; - } - } - - /* Decide whether the type is distributable. */ - /* TODO: This is not the best location but we only need this during code generation - * so at this moment we do not need this in the new type system. */ - if (global.backend == BE_distmem) { - if (TYgetDistributed (xnew) == distmem_dis_dsm) { - TYPES_DISTRIBUTED (res) = distmem_dis_dsm; - } - - /* It seems like the basetype is not yet supported by the distributed memory - * backend. Don't distribute. */ - else if ( - global.type_cbasetype[TYPES_BASETYPE (res)] != C_btother - /* To avoid problems with string functions, we do not distribute unsigned char - arrays. */ - && global.type_cbasetype[TYPES_BASETYPE (res)] != C_btuchar - /* It doesn't make sense to distribute scalars. */ - && TYPES_DIM (res) != SCALAR - /* We do not distribute hidden types. It is not practical since we would have to - * think about (de-)serialization. But since hidden types come from the - * non-distributed C world it doesn't make make sense to distribute them - * anyways. */ - && !TCisHidden (res) - /* It doesn't make sense to distribute unique types. These are only used by the - * master node. - * TODO: TYPES_UNIQUE seems to be always FALSE. */ - && !TYPES_UNIQUE (res) - /* For now we do not distribute nested types. TODO: What are these actually? */ - && !TCisNested (res)) { - TYPES_DISTRIBUTED (res) = distmem_dis_dis; - } - } - - DBUG_RETURN (res); -} - -types * -TYtype2OldType (ntype *xnew) -{ - types *res; -#ifndef DBUG_OFF - char *tmp_str = NULL, *tmp_str2 = NULL; -#endif - - DBUG_ENTER (); - - DBUG_EXECUTE (tmp_str = TYtype2DebugString (xnew, FALSE, 0)); - DBUG_PRINT ("converting %s", tmp_str); - - res = Type2OldType (xnew); - -#if 0 - DBUG_EXECUTE (tmp_str2 = CVtype2String (res, 0, TRUE)); - DBUG_PRINT ("... result is %s", tmp_str2); - DBUG_EXECUTE (tmp_str = MEMfree (tmp_str)); - DBUG_EXECUTE (tmp_str2 = MEMfree (tmp_str2)); -#endif - - DBUG_RETURN (res); -} /** ** functions for creating wrapper function code diff --git a/src/libsac2c/typecheck/new_types.h b/src/libsac2c/typecheck/new_types.h index f9dea7cd6..7c32a301f 100644 --- a/src/libsac2c/typecheck/new_types.h +++ b/src/libsac2c/typecheck/new_types.h @@ -322,11 +322,6 @@ extern ntype *TYnestTypes (ntype *outer, ntype *inner); extern ntype *TYdeNestTypeFromInner (ntype *nested, ntype *inner); extern ntype *TYdeNestTypeFromOuter (ntype *nested, ntype *outer); -extern ntype *TYoldType2ScalarType (types *old); -extern ntype *TYoldType2Type (types *old); -extern types *TYtype2OldType (ntype *mnew); -extern ntype *TYoldTypes2ProdType (types *old); - /* * Functions for converting types into SAC code for wrapper functions */ diff --git a/src/libsac2c/typecheck/specialize.c b/src/libsac2c/typecheck/specialize.c index d2e88676d..042b8456d 100644 --- a/src/libsac2c/typecheck/specialize.c +++ b/src/libsac2c/typecheck/specialize.c @@ -273,13 +273,7 @@ SpecializationOracle (node *wrapper, node *fundef, ntype *args, dft_res *dft) res = TYmakeEmptyProductType (TCcountArgs (arg)); i = 0; while (arg != NULL) { - type = AVIS_TYPE (ARG_AVIS (arg)); - if (type == NULL) { - /* not yet converted ! */ - type = TYoldType2Type (ARG_TYPE (arg)); - } else { - type = TYcopyType (type); - } + type = TYcopyType (AVIS_TYPE (ARG_AVIS (arg))); res = TYsetProductMember (res, i, TYlubOfTypes (TYgetProductMember (args, i), type)); type = TYfreeType (type); diff --git a/src/libsac2c/types/types.h b/src/libsac2c/types/types.h index 82b0ccbaf..ea0aa70a9 100644 --- a/src/libsac2c/types/types.h +++ b/src/libsac2c/types/types.h @@ -23,6 +23,12 @@ #define TRUE true #define FALSE false +/* + * moved from shape.h + */ + +typedef struct SHAPE shape; + /* Structcure to store where a token came from. */ struct location { const char *fname; @@ -314,7 +320,7 @@ typedef struct ACCESS_T { struct NODE *array_vardec; /* */ struct NODE *iv_vardec; /* index vector */ accessclass_t accessclass; /* */ - shpseg *offset; /* */ + shape *offset; /* */ accessdir_t direction; /* 0 == ADIR_read, 1 == ADIR_write */ struct ACCESS_T *next; /* */ } access_t; @@ -543,12 +549,6 @@ typedef enum { #include "nt_info.mac" } cbasetype_class_t; -/* - * moved from shape.h - */ - -typedef struct SHAPE shape; - /* * moved from constant.h */ @@ -878,13 +878,13 @@ typedef struct PATTR attrib; /* structure for storing access patterns */ typedef struct PATTERN_T { - shpseg *pattern; + shape *pattern; struct PATTERN_T *next; } pattern_t; /* structure for grouping access patterns by conflict groups */ typedef struct CONFLICT_GROUP_T { - shpseg *group; + shape *group; accessdir_t direction; pattern_t *patterns; struct CONFLICT_GROUP_T *next; @@ -894,7 +894,7 @@ typedef struct CONFLICT_GROUP_T { typedef struct ARRAY_TYPE_T { simpletype type; int dim; - shpseg *shape; + shape *shp; conflict_group_t *groups; struct ARRAY_TYPE_T *next; } array_type_t; @@ -903,7 +903,7 @@ typedef struct ARRAY_TYPE_T { typedef struct UNSUPPORTED_SHAPE_T { simpletype type; int dim; - shpseg *shape; + shape *shp; struct UNSUPPORTED_SHAPE_T *next; } unsupported_shape_t; @@ -911,9 +911,9 @@ typedef struct UNSUPPORTED_SHAPE_T { typedef struct PAD_INFO_T { simpletype type; int dim; - shpseg *old_shape; - shpseg *new_shape; - shpseg *padding; + shape *old_shape; + shape *new_shape; + shape *padding; node *fundef_pad; node *fundef_unpad; struct PAD_INFO_T *next; -- GitLab From da7d218aa70a1dc963268251deb6208d23acf891 Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sun, 22 Nov 2020 18:24:44 +0100 Subject: [PATCH 12/16] shpseg eradicated from shape and from tree_compound --- src/libsac2c/arrayopt/pad_collect.c | 10 +- src/libsac2c/arrayopt/pad_transform.c | 58 ++++---- src/libsac2c/constants/shape.c | 82 ------------ src/libsac2c/constants/shape.h | 3 - src/libsac2c/print/print.c | 53 +++++--- src/libsac2c/tree/tree_compound.c | 184 -------------------------- src/libsac2c/tree/tree_compound.h | 16 +-- 7 files changed, 62 insertions(+), 344 deletions(-) diff --git a/src/libsac2c/arrayopt/pad_collect.c b/src/libsac2c/arrayopt/pad_collect.c index cf8a33430..2d39ac87b 100644 --- a/src/libsac2c/arrayopt/pad_collect.c +++ b/src/libsac2c/arrayopt/pad_collect.c @@ -570,8 +570,8 @@ APCgenarray (node *arg_node, info *arg_info) DBUG_ENTER (); #if 0 - shape* shape; - types* type; + shape* shp; + ntype* type; int dim; simpletype basetype; @@ -586,13 +586,13 @@ APCgenarray (node *arg_node, info *arg_info) dim = SHPSEG_SHAPE(TYPES_SHPSEG(ARRAY_TYPE(GENARRAY_SHAPE(arg_node))),0); - shape = TCarray2Shpseg(GENARRAY_SHAPE(arg_node), NULL); + shp = SHarray2Shape (GENARRAY_SHAPE(arg_node)); - type = TBmakeTypes(basetype,dim,shape,NULL,NULL); + type = TYmakeAKS (TYmakeSimple (basetype), shape); AddUnsupported(arg_info,type); - FREEfreeOneTypes( type); + type = TYfreeType( type); } #endif diff --git a/src/libsac2c/arrayopt/pad_transform.c b/src/libsac2c/arrayopt/pad_transform.c index 2dfeb57d7..e7b7ef26d 100644 --- a/src/libsac2c/arrayopt/pad_transform.c +++ b/src/libsac2c/arrayopt/pad_transform.c @@ -288,8 +288,8 @@ AddDummyPart (node *wl, shpseg *old_shape, shpseg *new_shape, int dims) if (SHPSEG_SHAPE (old_shape, i) != SHPSEG_SHAPE (new_shape, i)) { lbound_shape = LBound (old_shape, dims, i); ubound_shape = UBound (old_shape, new_shape, dims, i); - lbound_array = TCshpseg2Array (lbound_shape, dims); - ubound_array = TCshpseg2Array (ubound_shape, dims); + lbound_array = SHshape2Array (lbound_shape); + ubound_array = SHshape2Array (ubound_shape); FREEfreeShpseg (lbound_shape); FREEfreeShpseg (ubound_shape); @@ -328,7 +328,7 @@ AddDummyCode (node *wl) { node *vardec; - types *type; + ntype *type; node *expr; node *ids_attrib; @@ -468,7 +468,7 @@ AddDummyCode (node *wl) /***************************************************************************** * * function: - * static void InsertWithLoopGenerator(types* oldtype, types* newtype, node* wl) + * static void InsertWithLoopGenerator(ntype* oldtype, ntype* newtype, node* wl) * * description: * insert new part-nodes and code-node into withloop to apply padding @@ -476,7 +476,7 @@ AddDummyCode (node *wl) *****************************************************************************/ static void -InsertWithLoopGenerator (types *oldtype, types *newtype, node *wl) +InsertWithLoopGenerator (ntype *oldtype, ntype *newtype, node *wl) { shpseg *shape_diff; @@ -486,24 +486,14 @@ InsertWithLoopGenerator (types *oldtype, types *newtype, node *wl) DBUG_ENTER (); - /* calculate shape difference */ - shape_diff = TCdiffShpseg (TYPES_DIM (oldtype), TYPES_SHPSEG (newtype), - TYPES_SHPSEG (oldtype)); - for (i = 0; i < TYPES_DIM (oldtype); i++) { - if (SHPSEG_SHAPE (shape_diff, i) > 0) { - different = TRUE; - } - DBUG_ASSERT (SHPSEG_SHAPE (shape_diff, i) >= 0, "negative shape difference"); - } - - if (different) { + if (!SHcompareShapes (TYgetType(oldtype), TYgetShape (newtype))) { /* add code block */ assignment_vardec = AddDummyCode (wl); /* add nodes to part */ - wl = AddDummyPart (wl, TYPES_SHPSEG (oldtype), TYPES_SHPSEG (newtype), - TYPES_DIM (oldtype)); + wl = AddDummyPart (wl, TYgetShape (oldtype), TYgetShape (newtype), + TYgetDim (oldtype)); } DBUG_RETURN (); @@ -523,7 +513,7 @@ node * APTarg (node *arg_node, info *arg_info) { - types *new_type; + ntype *new_type; DBUG_ENTER (); @@ -564,7 +554,7 @@ node * APTvardec (node *arg_node, info *arg_info) { - types *new_type; + ntype *new_type; node *original_vardec; DBUG_ENTER (); @@ -797,11 +787,11 @@ node * APTgenarray (node *arg_node, info *arg_info) { - shpseg *shpseg; + shape *shp; int dim; int simpletype; - types *oldtype = NULL; - types *newtype = NULL; + ntype *oldtype = NULL; + ntype *newtype = NULL; DBUG_ENTER (); @@ -814,9 +804,9 @@ APTgenarray (node *arg_node, info *arg_info) DBUG_PRINT (" genarray-loop"); - shpseg = TCarray2Shpseg (GENARRAY_SHAPE (arg_node), NULL); + shp = SHarray2Shape (GENARRAY_SHAPE (arg_node), NULL); /* constant array has dim=1 - * => number of elements is stored in shpseg[0] + * => number of elements is stored in shp[0] */ dim = SHgetUnrLen (ARRAY_SHAPE (GENARRAY_SHAPE (arg_node))); /* all elements have the same type @@ -827,8 +817,8 @@ APTgenarray (node *arg_node, info *arg_info) /* infer result of with-loop Attention: only elements with scalar types are supported yet !!! */ - oldtype = TBmakeTypes (simpletype, dim, shpseg, NULL, NULL); - newtype = PIgetNewType (DUPdupAllTypes (oldtype)); + oldtype = TYmakeAKS (TYmakeSimple (simpletype), shp); + newtype = PIgetNewType (TYcopyType (oldtype)); if (newtype != NULL) { /* apply padding (genarray-specific)*/ @@ -837,7 +827,7 @@ APTgenarray (node *arg_node, info *arg_info) FREEdoFreeNode (GENARRAY_SHAPE (arg_node)); GENARRAY_SHAPE (arg_node) - = TCshpseg2Array (TYPES_SHPSEG (newtype), TYPES_DIM (newtype)); + = SHshape2Array (TYgetShape (newtype)); INFO_APT_EXPRESSION_PADDED (arg_info) = TRUE; } @@ -876,8 +866,8 @@ node * APTmodarray (node *arg_node, info *arg_info) { - types *oldtype = NULL; - types *newtype = NULL; + ntype *oldtype = NULL; + ntype *newtype = NULL; DBUG_ENTER (); @@ -933,8 +923,8 @@ node * APTfold (node *arg_node, info *arg_info) { - types *oldtype = NULL; - types *newtype = NULL; + ntype *oldtype = NULL; + ntype *newtype = NULL; DBUG_ENTER (); @@ -1102,11 +1092,11 @@ APTprf (node *arg_node, info *arg_info) if (ID_PADDED (PRF_ARG1 (arg_node))) { /* substitute paddable argument with reference to constant vector containing padded shape */ - types *old_type; + ntype *old_type; old_type = PIgetOldType ( DUPdupAllTypes (VARDEC_TYPE (ID_DECL (PRF_ARG1 (arg_node))))); - arg_node = TCshpseg2Array (TYPES_SHPSEG (old_type), TYPES_DIM (old_type)); + arg_node = SHshape2Array (TYgetShape (old_type)); old_type = MEMfree (old_type); } /* even if PRF_ARG1 is padded, the result of PRF will have an diff --git a/src/libsac2c/constants/shape.c b/src/libsac2c/constants/shape.c index 999c915b2..076b94464 100644 --- a/src/libsac2c/constants/shape.c +++ b/src/libsac2c/constants/shape.c @@ -605,88 +605,6 @@ SHshape2String (size_t dots, shape *shp) DBUG_RETURN (res); } -/** - * - * @fn shape *SHoldShpseg2Shape( int dim, shpseg *shpseg) - * - * @brief iff dim > 0 a new shape structure is created which contains the same - * shape info as the shpseg does. Otherwise, NULL is returned. - * - ******************************************************************************/ -shape * -SHoldShpseg2Shape (int dim, shpseg *shpseg) -{ - int i, j; - shape *res; - - DBUG_ENTER (); - - if (dim >= 0) { - res = SHmakeShape (dim); - - if (dim > 0) { - i = 0; - while (dim > SHP_SEG_SIZE) { - DBUG_ASSERT (shpseg != NULL, - "SHoldShpseg2Shape called with NULL shpseg but dim >0!"); - for (j = 0; j < SHP_SEG_SIZE; j++, i++) { - SHAPE_EXT (res, i) = SHPSEG_SHAPE (shpseg, j); - } - shpseg = SHPSEG_NEXT (shpseg); - dim -= SHP_SEG_SIZE; - } - for (j = 0; j < dim; j++, i++) { - SHAPE_EXT (res, i) = SHPSEG_SHAPE (shpseg, j); - } - } - } else { - res = NULL; - } - - DBUG_RETURN (res); -} - -/** - * - * @fn shpseg *SHshape2OldShpseg( shape *shp) - * - * @brief if shp has a dim>0 a shpseg structure is created which carries the - * same shape info as the shp does. Otherwise, NULL is returned. - * - ******************************************************************************/ - -shpseg * -SHshape2OldShpseg (shape *shp) -{ - int dim, i, j; - shpseg *res, *curr_seg; - - DBUG_ENTER (); - DBUG_ASSERT (shp != NULL, "SHshape2OldShpseg called with NULL shp!"); - - dim = SHAPE_DIM (shp); - if (dim > 0) { - i = 0; - res = TBmakeShpseg (NULL); - curr_seg = res; - while (dim > SHP_SEG_SIZE) { - for (j = 0; j < SHP_SEG_SIZE; j++, i++) { - SHPSEG_SHAPE (curr_seg, j) = SHAPE_EXT (shp, i); - } - SHPSEG_NEXT (curr_seg) = TBmakeShpseg (NULL); - curr_seg = SHPSEG_NEXT (curr_seg); - dim -= SHP_SEG_SIZE; - } - for (j = 0; j < dim; j++, i++) { - SHPSEG_SHAPE (curr_seg, j) = SHAPE_EXT (shp, i); - } - } else { - res = NULL; - } - - DBUG_RETURN (res); -} - /** * * @fn bool SHcompareWithCArray( shape *shp, int* shpdata, int dim) diff --git a/src/libsac2c/constants/shape.h b/src/libsac2c/constants/shape.h index 447ccc149..bf9ac5113 100644 --- a/src/libsac2c/constants/shape.h +++ b/src/libsac2c/constants/shape.h @@ -48,9 +48,6 @@ extern node *SHshape2Exprs (shape *shp); extern node *SHshape2Array (shape *shp); extern shape *SHarray2Shape (node *array); -extern shape *SHoldShpseg2Shape (int dim, shpseg *shpseg); -extern shpseg *SHshape2OldShpseg (shape *shp); - extern bool SHcompareWithCArray (shape *shp, int *shpdata, int dim); extern bool SHcompareWithArguments (shape *shp, int dim, ...); diff --git a/src/libsac2c/print/print.c b/src/libsac2c/print/print.c index 6f10ac3ac..37f57a0e4 100644 --- a/src/libsac2c/print/print.c +++ b/src/libsac2c/print/print.c @@ -85,8 +85,8 @@ struct INFO { bool prototype; int separate; int dim; - shpseg *shape; - shpseg *shapecnt; + shape *shp; + shape *shapecnt; bool isarray; /* writesib */ bool firstError; @@ -117,7 +117,7 @@ struct INFO { #define INFO_PROTOTYPE(n) ((n)->prototype) #define INFO_SEPARATE(n) ((n)->separate) #define INFO_DIM(n) ((n)->dim) -#define INFO_SHAPE(n) ((n)->shape) +#define INFO_SHAPE(n) ((n)->shp) #define INFO_ISARRAY(n) ((n)->isarray) #define INFO_SHAPE_COUNTER(n) ((n)->shapecnt) #define INFO_FIRSTERROR(n) ((n)->firstError) @@ -514,7 +514,7 @@ WLAAprintAccesses (node *arg_node, info *arg_info) feature_t feature; int i, dim, iv; access_t *access; - shpseg *offset; + shape *offset; DBUG_ENTER (); @@ -625,17 +625,17 @@ WLAAprintAccesses (node *arg_node, info *arg_info) if (ACCESS_DIR (access) == ADIR_read) { fprintf (global.outfile, "read ( %s + [ %d", VARDEC_NAME (ACCESS_IV (access)), - SHPSEG_SHAPE (offset, 0)); + SHgetExtent (offset, 0)); } else { fprintf (global.outfile, "write( %s + [ %d", VARDEC_NAME (ACCESS_IV (access)), - SHPSEG_SHAPE (offset, 0)); + SHgetExtent (offset, 0)); } for (i = 1; i < dim; i++) - fprintf (global.outfile, ",%d", SHPSEG_SHAPE (offset, i)); + fprintf (global.outfile, ",%d", SHgetExtent (offset, i)); fprintf (global.outfile, " ], %s)\n", STRonNULL ("?", VARDEC_NAME (ACCESS_ARRAY (access)))); - offset = SHPSEG_NEXT (offset); + offset = NULL; } while (offset != NULL); } access = ACCESS_NEXT (access); @@ -648,17 +648,17 @@ WLAAprintAccesses (node *arg_node, info *arg_info) do { if (ACCESS_DIR (access) == ADIR_read) { fprintf (global.outfile, "read ( [ %d", - SHPSEG_SHAPE (offset, 0)); + SHgetExtent (offset, 0)); } else { fprintf (global.outfile, "write( [ %d", - SHPSEG_SHAPE (offset, 0)); + SHgetExtent (offset, 0)); } for (i = 1; i < dim; i++) { - fprintf (global.outfile, ",%d", SHPSEG_SHAPE (offset, i)); + fprintf (global.outfile, ",%d", SHgetExtent (offset, i)); } fprintf (global.outfile, " ], %s)\n", STRonNULL ("?", VARDEC_NAME (ACCESS_ARRAY (access)))); - offset = SHPSEG_NEXT (offset); + offset = NULL; } while (offset != NULL); } access = ACCESS_NEXT (access); @@ -712,7 +712,7 @@ TSIprintInfo (node *arg_node, info *arg_info) } else { pragma = MakePragma (); for (i = dim - 1; i >= 0; i--) { - tilesize = SHPSEG_SHAPE (CODE_TSI_TILESHP (arg_node), i); + tilesize = SHgetExtent (CODE_TSI_TILESHP (arg_node), i); aelems = TBmakeExprs (MakeNum (tilesize), aelems); } ap_name = MEMmalloc (6 * sizeof (char)); @@ -3371,8 +3371,8 @@ PRTarray (node *arg_node, info *arg_info) int i; char *type_str; int old_print_dim = INFO_DIM (arg_info); - shpseg *old_print_shape = INFO_SHAPE (arg_info); - shpseg *old_print_shape_counter = INFO_SHAPE_COUNTER (arg_info); + shape *old_print_shape = INFO_SHAPE (arg_info); + shape *old_print_shape_counter = INFO_SHAPE_COUNTER (arg_info); bool old_isarray = INFO_ISARRAY (arg_info); node *shpcounter; @@ -3385,11 +3385,11 @@ PRTarray (node *arg_node, info *arg_info) if (ARRAY_AELEMS (arg_node) != NULL) { INFO_DIM (arg_info) = ARRAY_FRAMEDIM (arg_node); - INFO_SHAPE (arg_info) = SHshape2OldShpseg (ARRAY_FRAMESHAPE (arg_node)); + INFO_SHAPE (arg_info) = SHcopyShape (ARRAY_FRAMESHAPE (arg_node)); INFO_ISARRAY (arg_info) = TRUE; shpcounter = TCcreateZeroVector (ARRAY_FRAMEDIM (arg_node), T_int); - INFO_SHAPE_COUNTER (arg_info) = TCarray2Shpseg (shpcounter, NULL); + INFO_SHAPE_COUNTER (arg_info) = SHarray2Shape (shpcounter); shpcounter = FREEdoFreeTree (shpcounter); for (i = 0; i < INFO_DIM (arg_info); i++) @@ -3400,8 +3400,8 @@ PRTarray (node *arg_node, info *arg_info) for (i = 0; i < INFO_DIM (arg_info); i++) fprintf (global.outfile, " ]"); - FREEfreeShpseg (INFO_SHAPE (arg_info)); - FREEfreeShpseg (INFO_SHAPE_COUNTER (arg_info)); + SHfreeShape (INFO_SHAPE (arg_info)); + SHfreeShape (INFO_SHAPE_COUNTER (arg_info)); INFO_ISARRAY (arg_info) = FALSE; } else { type_str = TYtype2String (ARRAY_ELEMTYPE (arg_node), FALSE, 0); @@ -3427,6 +3427,15 @@ PRTarray (node *arg_node, info *arg_info) * ******************************************************************************/ +static +int ShapeInc (shape *shp, int idx) +{ + int res; + res = SHgetExtent (shp, idx); + SHsetExtent (shp, idx, res+1); + return res+1; +} + node * PRTexprs (node *arg_node, info *arg_info) { @@ -3452,10 +3461,10 @@ PRTexprs (node *arg_node, info *arg_info) if (INFO_ISARRAY (arg_info)) { for (i = INFO_DIM (arg_info) - 1; (i >= 0) - && (++SHPSEG_SHAPE (INFO_SHAPE_COUNTER (arg_info), i) - >= SHPSEG_SHAPE (INFO_SHAPE (arg_info), i)); + && (ShapeInc (INFO_SHAPE_COUNTER (arg_info), i) + >= SHgetExtent (INFO_SHAPE (arg_info), i)); i--) - SHPSEG_SHAPE (INFO_SHAPE_COUNTER (arg_info), i) = 0; + SHsetExtent (INFO_SHAPE_COUNTER (arg_info), i, 0); for (j = INFO_DIM (arg_info) - 1; j > i; j--) fprintf (global.outfile, " ]"); fprintf (global.outfile, ", "); diff --git a/src/libsac2c/tree/tree_compound.c b/src/libsac2c/tree/tree_compound.c index a69dd81de..2f3828d46 100644 --- a/src/libsac2c/tree/tree_compound.c +++ b/src/libsac2c/tree/tree_compound.c @@ -47,70 +47,6 @@ /*--------------------------------------------------------------------------*/ -/*** - *** SHPSEG : - ***/ - -/****************************************************************************** - * - * Function: - * int TCgetShpsegLength( int dims, shpseg *shape) - * - * Description: - * - * - ******************************************************************************/ - -int -TCgetShpsegLength (int dims, shpseg *shape) -{ - int length, i; - - DBUG_ENTER (); - - if (dims > 0) { - length = 1; - for (i = 0; i < dims; i++) { - length *= SHPSEG_SHAPE (shape, i); - } - } else if (dims == 0) { - length = 0; - } else { - length = (-1); - } - - DBUG_RETURN (length); -} - -/***************************************************************************** - * - * function: - * shpseg *TCdiffShpseg( int dim, shpseg *shape1, shpseg *shape2) - * - * description: - * calculate shape1 - shape2 - * - *****************************************************************************/ - -shpseg * -TCdiffShpseg (int dim, shpseg *shape1, shpseg *shape2) -{ - - shpseg *shape_diff; - int i; - - DBUG_ENTER (); - - shape_diff = TBmakeShpseg (NULL); - - for (i = 0; i < dim; i++) { - SHPSEG_SHAPE (shape_diff, i) - = SHPSEG_SHAPE (shape1, i) - SHPSEG_SHAPE (shape2, i); - } - - DBUG_RETURN (shape_diff); -} - /***************************************************************************** * * function: @@ -138,126 +74,6 @@ TCshapeVarsMatch (node *avis1, node *avis2) DBUG_RETURN (res); } -/***************************************************************************** - * - * function: - * bool TCequalShpseg( int dim, shpseg *shape2, shpseg *shape1) - * - * description: - * compares two shapes, result is TRUE, if shapes are equal - * - *****************************************************************************/ - -bool -TCequalShpseg (int dim, shpseg *shape2, shpseg *shape1) -{ - - bool equal_shapes; - int i; - - DBUG_ENTER (); - - equal_shapes = TRUE; - - i = 0; - while (i < dim && equal_shapes) { - if (SHPSEG_SHAPE (shape1, i) != SHPSEG_SHAPE (shape2, i)) { - equal_shapes = FALSE; - } - i++; - } - - DBUG_RETURN (equal_shapes); -} - -shpseg * -TCmergeShpseg (shpseg *first, int dim1, shpseg *second, int dim2) -{ - shpseg *xnew; - int i; - - DBUG_ENTER (); - - xnew = TBmakeShpseg (NULL); - - for (i = 0; i < dim1; i++) { - SHPSEG_SHAPE (xnew, i) = SHPSEG_SHAPE (first, i); - } - - for (i = 0; i < dim2; i++) { - SHPSEG_SHAPE (xnew, i + dim1) = SHPSEG_SHAPE (second, i); - } - - DBUG_RETURN (xnew); -} - -/***************************************************************************** - * - * function: - * shpseg *TCarray2Shpseg( node *array, int *ret_dim) - * - * description: - * Convert 'array' into a shpseg (requires int-array!!!). - * If 'dim' is != NULL the dimensionality is stored there. - * - *****************************************************************************/ - -shpseg * -TCarray2Shpseg (node *array, int *ret_dim) -{ - - node *tmp; - shpseg *shape; - int i; - - DBUG_ENTER (); - - shape = TBmakeShpseg (NULL); - - tmp = ARRAY_AELEMS (array); - i = 0; - while (tmp != NULL) { - DBUG_ASSERT (NODE_TYPE (EXPRS_EXPR (tmp)) == N_num, "integer array expected!"); - SHPSEG_SHAPE (shape, i) = NUM_VAL (EXPRS_EXPR (tmp)); - i++; - tmp = EXPRS_NEXT (tmp); - } - - if (ret_dim != NULL) { - (*ret_dim) = i; - } - - DBUG_RETURN (shape); -} - -/***************************************************************************** - * - * function: - * node *TCshpseg2Array( shpseg *shape, int dim) - * - * description: - * convert shpseg with given dimension into array with simpletype T_int - * - *****************************************************************************/ - -node * -TCshpseg2Array (shpseg *shape, int dim) -{ - int i; - node *next; - node *array_node; - - DBUG_ENTER (); - - next = NULL; - for (i = dim - 1; i >= 0; i--) { - next = TBmakeExprs (TBmakeNum (SHPSEG_SHAPE (shape, i)), next); - } - - array_node = TCmakeIntVector (next); - - DBUG_RETURN (array_node); -} /*--------------------------------------------------------------------------*/ diff --git a/src/libsac2c/tree/tree_compound.h b/src/libsac2c/tree/tree_compound.h index 02b8042f9..0838374c7 100644 --- a/src/libsac2c/tree/tree_compound.h +++ b/src/libsac2c/tree/tree_compound.h @@ -48,20 +48,6 @@ specific implementation of a function should remain with the source code. #define LIB_FUN 0x0008 #define OVRLD_FUN 0x0010 -/*--------------------------------------------------------------------------*/ - -/*** - *** SHPSEG : - ***/ - -extern int TCgetShpsegLength (int dims, shpseg *shape); -extern shpseg *TCdiffShpseg (int dim, shpseg *shape1, shpseg *shape2); -extern bool TCshapeVarsMatch (node *avis1, node *avis2); -extern bool TCequalShpseg (int dim, shpseg *shape2, shpseg *shape1); -extern shpseg *TCmergeShpseg (shpseg *first, int dim1, shpseg *second, int dim2); - -extern shpseg *TCarray2Shpseg (node *array, int *ret_dim); -extern node *TCshpseg2Array (shpseg *shape, int dim); /*--------------------------------------------------------------------------*/ @@ -1626,6 +1612,8 @@ extern size_t TCcountWlseg (node *withop); #define AVIS_SSASTACK_TOP(n) SSASTACK_AVIS (AVIS_SSASTACK (n)) #define AVIS_SSASTACK_INUSE(n) SSASTACK_INUSE (AVIS_SSASTACK (n)) +extern bool TCshapeVarsMatch (node *avis1, node *avis2); + /*--------------------------------------------------------------------------*/ /*** -- GitLab From a46482d30d9d9caf0201894a55d7ac426950c2ef Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sun, 22 Nov 2020 20:20:09 +0100 Subject: [PATCH 13/16] DUPtree free and tree_basic de-types'ed --- src/libsac2c/arrayopt/pad_collect.c | 5 +- src/libsac2c/tree/DupTree.c | 180 ---------------------------- src/libsac2c/tree/DupTree.h | 5 - src/libsac2c/tree/free.c | 67 ----------- src/libsac2c/tree/free.h | 3 - src/libsac2c/tree/free_attribs.c | 4 - src/libsac2c/tree/tree_basic.c | 47 -------- src/libsac2c/tree/tree_basic.h | 51 -------- 8 files changed, 3 insertions(+), 359 deletions(-) diff --git a/src/libsac2c/arrayopt/pad_collect.c b/src/libsac2c/arrayopt/pad_collect.c index 2d39ac87b..f5b24e5e2 100644 --- a/src/libsac2c/arrayopt/pad_collect.c +++ b/src/libsac2c/arrayopt/pad_collect.c @@ -273,7 +273,7 @@ CollectAccessPatterns (node *arg_node) col_ptr = collection; while (col_ptr != NULL) { - type = TYPES_BASETYPE (VARDEC_TYPE (COL_ARRAY (col_ptr))); + type = TUgetSimpleImplementationType (VARDEC_NTYPE (COL_ARRAY (col_ptr))); dim = TYgetDim (VARDEC_NTYPE (COL_ARRAY (col_ptr))); shp = SHcopyShape (TYgetShape (VARDEC_NTYPE (COL_ARRAY (col_ptr)))); group_vect = AccessClass2Group (COL_CLASS (col_ptr), dim); @@ -582,7 +582,8 @@ APCgenarray (node *arg_node, info *arg_info) if (INFO_APC_UNSUPPORTED(arg_info)) { TODO: the following assumes, genarray_shape is given by a N_array node /* do not add type of vector, but contents of array to unsupported shapes */ - basetype = TYPES_BASETYPE(ID_TYPE(WITH_CEXPR(INFO_APC_WITH(arg_info)))); + basetype = TUgetSimpleImplementationType ( + ID_NTYPE(WITH_CEXPR(INFO_APC_WITH(arg_info)))); dim = SHPSEG_SHAPE(TYPES_SHPSEG(ARRAY_TYPE(GENARRAY_SHAPE(arg_node))),0); diff --git a/src/libsac2c/tree/DupTree.c b/src/libsac2c/tree/DupTree.c index 73d2d5f94..254dc6bd6 100644 --- a/src/libsac2c/tree/DupTree.c +++ b/src/libsac2c/tree/DupTree.c @@ -425,85 +425,6 @@ DupDfmask (dfmask_t *mask, info *arg_info) DBUG_RETURN (new_mask); } -/****************************************************************************** - * - * Function: - * shpseg *DupShpseg( shpseg *arg_shpseg, info *arg_info) - * - * Remark: - * 'arg_info' might be NULL, because this function is not only used by - * the traversal mechanism but also by DupShpseg()! - * - ******************************************************************************/ - -static shpseg * -DupShpseg (shpseg *arg_shpseg, info *arg_info) -{ - int i; - shpseg *new_shpseg; - - DBUG_ENTER (); - - if (arg_shpseg != NULL) { - new_shpseg = TBmakeShpseg (NULL); - for (i = 0; i < SHP_SEG_SIZE; i++) { - SHPSEG_SHAPE (new_shpseg, i) = SHPSEG_SHAPE (arg_shpseg, i); - } - - SHPSEG_NEXT (new_shpseg) = DupShpseg (SHPSEG_NEXT (arg_shpseg), arg_info); - } else { - new_shpseg = NULL; - } - - DBUG_RETURN (new_shpseg); -} - -/****************************************************************************** - * - * Function: - * types *DupTypes( types* source, info *arg_info) - * - * Remark: - * 'arg_info' might be NULL, because this function is not only used by - * the traversal mechanism but also by Dup...Types()! - * - ******************************************************************************/ - -static types * -DupTypes (types *arg_types, info *arg_info) -{ - types *new_types; - - DBUG_ENTER (); - - if (arg_types != NULL) { - new_types - = TBmakeTypes (TYPES_BASETYPE (arg_types), TYPES_DIM (arg_types), - DupShpseg (TYPES_SHPSEG (arg_types), arg_info), - STRcpy (TYPES_NAME (arg_types)), STRcpy (TYPES_MOD (arg_types))); - - TYPES_TDEF (new_types) = TYPES_TDEF (arg_types); - TYPES_MUTC_SCOPE (new_types) = TYPES_MUTC_SCOPE (arg_types); - TYPES_MUTC_USAGE (new_types) = TYPES_MUTC_USAGE (arg_types); - - DBUG_PRINT_TAG ("TYPE", "new type" F_PTR ",old " F_PTR, - (void *)new_types, (void *)arg_types); - DBUG_PRINT_TAG ("TYPE", "new name %s, old name %s", - TYPES_NAME (new_types), TYPES_NAME (arg_types)); - - TYPES_NEXT (new_types) = DupTypes (TYPES_NEXT (arg_types), arg_info); - - if (arg_info != NULL) { - INFO_LUT (arg_info) - = LUTinsertIntoLutP (INFO_LUT (arg_info), arg_types, new_types); - } - } else { - new_types = NULL; - } - - DBUG_RETURN (new_types); -} - /****************************************************************************** * * Function: @@ -1317,8 +1238,6 @@ DUParg (node *arg_node, info *arg_info) */ new_node = TBmakeArg (DUPTRAV (ARG_AVIS (arg_node)), NULL); - ARG_TYPE (new_node) = DupTypes (ARG_TYPE (arg_node), arg_info); - ARG_OBJDEF (new_node) = ARG_OBJDEF (arg_node); ARG_LINKSIGN (new_node) = ARG_LINKSIGN (arg_node); ARG_FLAGSTRUCTURE (new_node) = ARG_FLAGSTRUCTURE (arg_node); @@ -1596,8 +1515,6 @@ DUPvardec (node *arg_node, info *arg_info) new_node = TBmakeVardec (DUPTRAV (VARDEC_AVIS (arg_node)), DUPCONT (VARDEC_NEXT (arg_node))); - VARDEC_TYPE (new_node) = DupTypes (VARDEC_TYPE (arg_node), arg_info); - VARDEC_FLAGSTRUCTURE (new_node) = VARDEC_FLAGSTRUCTURE (arg_node); CopyCommonNodeData (new_node, arg_node); @@ -1844,10 +1761,6 @@ DUPids (node *arg_node, info *arg_info) FUNDEF_VARDECS (INFO_FUNDEFSSA (arg_info)) = TBmakeVardec (newavis, FUNDEF_VARDECS (INFO_FUNDEFSSA (arg_info))); - if (IDS_TYPE (arg_node) != NULL) { - VARDEC_TYPE (AVIS_DECL (newavis)) = DUPdupOneTypes (IDS_TYPE (arg_node)); - } - INFO_LUT (arg_info) = LUTinsertIntoLutP (INFO_LUT (arg_info), IDS_AVIS (arg_node), newavis); } @@ -2413,10 +2326,6 @@ DUPwith (node *arg_node, info *arg_info) vardec = TBmakeVardec (newavis, NULL); - if (IDS_TYPE (oldids) != NULL) { - VARDEC_TYPE (vardec) = DUPdupOneTypes (IDS_TYPE (oldids)); - } - INFO_FUNDEFSSA (arg_info) = TCaddVardecs (INFO_FUNDEFSSA (arg_info), vardec); INFO_LUT (arg_info) = LUTinsertIntoLutS (INFO_LUT (arg_info), IDS_NAME (oldids), @@ -2436,10 +2345,6 @@ DUPwith (node *arg_node, info *arg_info) vardec = TBmakeVardec (newavis, NULL); - if (IDS_TYPE (oldids) != NULL) { - VARDEC_TYPE (vardec) = DUPdupOneTypes (IDS_TYPE (oldids)); - } - INFO_FUNDEFSSA (arg_info) = TCaddVardecs (INFO_FUNDEFSSA (arg_info), vardec); INFO_LUT (arg_info) @@ -3538,91 +3443,6 @@ DUPdoDupNodeLutType (node *arg_node, lut_t *lut, int type) DBUG_RETURN (new_node); } -/****************************************************************************** - * - * Function: - * shpseg *DUPdupShpseg( shpseg *arg_shpseg) - * - * Description: - * - * - ******************************************************************************/ - -shpseg * -DUPdupShpseg (shpseg *arg_shpseg) -{ - shpseg *new_shpseg; - - DBUG_ENTER (); - - new_shpseg = DupShpseg (arg_shpseg, NULL); - - DBUG_RETURN (new_shpseg); -} - -/****************************************************************************** - * - * Function: - * types *DUPdupOneTypes( types *type) - * - * Description: - * Duplicates the first TYPES structure of the given TYPES chain. - * - * This function duplicates the (real) types-structure. Unfortunately, it - * is *not* identical to the (virtual) TYPES-structure 8-(( - * - * For duplicating the (virtual) TYPES-structure only, use DupOneTypesOnly() - * or DupOneTypesOnly_Inplace() !!! - * - ******************************************************************************/ - -types * -DUPdupOneTypes (types *arg_types) -{ - types *new_types, *tmp; - - DBUG_ENTER (); - - DBUG_ASSERT (arg_types != NULL, "DUPdupOneTypes: argument is NULL!"); - - tmp = TYPES_NEXT (arg_types); - TYPES_NEXT (arg_types) = NULL; - new_types = DupTypes (arg_types, NULL); - TYPES_NEXT (arg_types) = tmp; - - DBUG_RETURN (new_types); -} - -/****************************************************************************** - * - * Function: - * types *DUPdupAllTypes( types* type) - * - * Description: - * This function duplicates the (real) types-structure. Unfortunately, it - * is *not* identical to the (virtual) TYPES-structure 8-(( - * - * For duplicating the (virtual) TYPES-structure only, use DupAllTypesOnly() - * !!! - * - ******************************************************************************/ - -types * -DUPdupAllTypes (types *arg_types) -{ - types *new_types; - - DBUG_ENTER (); - - if (arg_types != NULL) { - new_types = DupTypes (arg_types, NULL); - } else { - new_types = NULL; - } - - DBUG_RETURN (new_types); -} - /****************************************************************************** * * Function: diff --git a/src/libsac2c/tree/DupTree.h b/src/libsac2c/tree/DupTree.h index 32b5c927c..0f1b0c54a 100644 --- a/src/libsac2c/tree/DupTree.h +++ b/src/libsac2c/tree/DupTree.h @@ -31,11 +31,6 @@ extern node *DUPdoDupNodeLutType (node *arg_node, lut_t *lut, int type); /* * Functions for duplicating non-node parts of the AST */ -extern shpseg *DUPdupShpseg (shpseg *arg_shpseg); - -extern types *DUPdupOneTypes (types *arg_types); -extern types *DUPdupAllTypes (types *arg_types); - extern nodelist *DUPdupNodelist (nodelist *arg_nl); /* diff --git a/src/libsac2c/tree/free.c b/src/libsac2c/tree/free.c index de312a34e..05fe4d75f 100644 --- a/src/libsac2c/tree/free.c +++ b/src/libsac2c/tree/free.c @@ -97,69 +97,6 @@ FREEfreeIndexInfo (index_info *fr) /*--------------------------------------------------------------------------*/ -shpseg * -FREEfreeShpseg (shpseg *fr) -{ - DBUG_ENTER (); - - DBUG_PRINT ("Removing shpseg"); - - DBUG_ASSERT (fr != NULL, "cannot free a NULL shpseg!"); - - if (SHPSEG_NEXT (fr) != NULL) { - SHPSEG_NEXT (fr) = FREEfreeShpseg (SHPSEG_NEXT (fr)); - } - - fr = MEMfree (fr); - - DBUG_RETURN (fr); -} - -/*--------------------------------------------------------------------------*/ - -types * -FREEfreeOneTypes (types *fr) -{ - types *tmp; - - DBUG_ENTER (); - - if (fr != NULL) { - DBUG_PRINT ("Removing types: %s", - (TYPES_NAME (fr) == NULL) ? "" : TYPES_NAME (fr)); - tmp = fr; - fr = TYPES_NEXT (fr); - - if (TYPES_DIM (tmp) > 0) { - DBUG_ASSERT (TYPES_SHPSEG (tmp) != NULL, - "SHPSEG not found although DIM is greater 0"); - TYPES_SHPSEG (tmp) = FREEfreeShpseg (TYPES_SHPSEG (tmp)); - } - TYPES_NAME (tmp) = MEMfree (TYPES_NAME (tmp)); - TYPES_MOD (tmp) = MEMfree (TYPES_MOD (tmp)); - - tmp = MEMfree (tmp); - } - - DBUG_RETURN (fr); -} - -/*--------------------------------------------------------------------------*/ - -types * -FREEfreeAllTypes (types *fr) -{ - DBUG_ENTER (); - - while (fr != NULL) { - fr = FREEfreeOneTypes (fr); - } - - DBUG_RETURN (fr); -} - -/*--------------------------------------------------------------------------*/ - /* * FREEfreeNodelist always frees entire list. */ @@ -395,10 +332,6 @@ FreeZombie (node *fundef) FUNDEF_NS (fundef) = NSfreeNamespace (FUNDEF_NS (fundef)); FUNDEF_IMPL (fundef) = NULL; - if (FUNDEF_TYPES (fundef) != NULL) { - FUNDEF_TYPES (fundef) = FREEfreeAllTypes (FUNDEF_TYPES (fundef)); - } - if (FUNDEF_WRAPPERTYPE (fundef) != NULL) { FUNDEF_WRAPPERTYPE (fundef) = TYfreeType (FUNDEF_WRAPPERTYPE (fundef)); } diff --git a/src/libsac2c/tree/free.h b/src/libsac2c/tree/free.h index 9246441ae..6b9142e25 100644 --- a/src/libsac2c/tree/free.h +++ b/src/libsac2c/tree/free.h @@ -21,9 +21,6 @@ extern node *FREEremoveAllZombies (node *arg_node); */ extern index_info *FREEfreeIndexInfo (index_info *fr); -extern shpseg *FREEfreeShpseg (shpseg *fr); -extern types *FREEfreeOneTypes (types *fr); -extern types *FREEfreeAllTypes (types *fr); extern nodelist *FREEfreeNodelist (nodelist *fr); extern nodelist *FREEfreeNodelistNode (nodelist *nl); extern access_t *FREEfreeOneAccess (access_t *fr); diff --git a/src/libsac2c/tree/free_attribs.c b/src/libsac2c/tree/free_attribs.c index 914de4101..d897e3e0a 100644 --- a/src/libsac2c/tree/free_attribs.c +++ b/src/libsac2c/tree/free_attribs.c @@ -142,10 +142,6 @@ FREEattribOldType (types *attr, node *parent) { DBUG_ENTER (); - if (attr != NULL) { - attr = FREEfreeOneTypes (attr); - } - DBUG_RETURN (attr); } diff --git a/src/libsac2c/tree/tree_basic.c b/src/libsac2c/tree/tree_basic.c index 73ee38ed2..656dd3fbb 100644 --- a/src/libsac2c/tree/tree_basic.c +++ b/src/libsac2c/tree/tree_basic.c @@ -63,53 +63,6 @@ TBmakeShpseg (node *numsp) /*--------------------------------------------------------------------------*/ -types * -TBmakeTypes1 (simpletype btype) -{ - types *tmp; - - DBUG_ENTER (); - - tmp = TBmakeTypes (btype, 0, NULL, NULL, NULL); - - DBUG_RETURN (tmp); -} - -/*--------------------------------------------------------------------------*/ - -types * -TBmakeTypes (simpletype btype, int dim, shpseg *shpseg, char *name, char *mod) -{ - types *tmp; - - DBUG_ENTER (); - - tmp = (types *)MEMmalloc (sizeof (types)); - - TYPES_BASETYPE (tmp) = btype; - TYPES_NAME (tmp) = name; - TYPES_MOD (tmp) = mod; - TYPES_SHPSEG (tmp) = shpseg; - TYPES_DIM (tmp) = dim; - TYPES_POLY (tmp) = FALSE; - - TYPES_MUTC_SCOPE (tmp) = MUTC_GLOBAL; - TYPES_MUTC_USAGE (tmp) = MUTC_US_DEFAULT; - - TYPES_TDEF (tmp) = NULL; - TYPES_NEXT (tmp) = NULL; - - TYPES_MUTC_SCOPE (tmp) = MUTC_GLOBAL; - TYPES_MUTC_USAGE (tmp) = MUTC_US_DEFAULT; - TYPES_UNIQUE (tmp) = FALSE; - - TYPES_DISTRIBUTED (tmp) = distmem_dis_ndi; - - DBUG_RETURN (tmp); -} - -/*--------------------------------------------------------------------------*/ - nodelist * TBmakeNodelistNode (node *node, nodelist *next) { diff --git a/src/libsac2c/tree/tree_basic.h b/src/libsac2c/tree/tree_basic.h index e57903932..9d46c2e1f 100644 --- a/src/libsac2c/tree/tree_basic.h +++ b/src/libsac2c/tree/tree_basic.h @@ -59,57 +59,6 @@ extern shpseg *TBmakeShpseg (node *num); /*--------------------------------------------------------------------------*/ -/*** - *** TYPES : - *** - *** permanent attributes: - *** - *** simpletype BASETYPE - *** int DIM - *** bool POLY new TC indicates type vars! - *** shpseg* SHPSEG (O) - *** char* NAME (O) - *** char* MOD (O) - *** statustype STATUS - *** types* NEXT (O) - *** - *** temporary attributes: - *** - *** node* TDEF (O) (typecheck -> ) - ***/ - -/* - * STATUS: - * ST_artificial : artificial return type due to the resolution of reference - * parameters and global objects. - * ST_crettype : return type of a function that is compiled to the actual - * return type of the resulting C function. - * ST_regular : otherwise - * - * TDEF is a reference to the defining N_typedef node of a user-defined type. - */ - -extern types *TBmakeTypes1 (simpletype btype); - -extern types *TBmakeTypes (simpletype btype, int dim, shpseg *shpseg, char *name, - char *mod); - -#define TYPES_BASETYPE(t) (t->msimpletype) -#define TYPES_DIM(t) (t->dim) -#define TYPES_POLY(t) (t->poly) -#define TYPES_SHPSEG(t) (t->mshpseg) -#define TYPES_NAME(t) (t->name) -#define TYPES_MOD(t) (t->name_mod) -#define TYPES_TDEF(t) (t->tdef) -#define TYPES_NEXT(t) (t->next) -/* mutc old type accessors */ -#define TYPES_MUTC_SCOPE(t) (t->scope) -#define TYPES_MUTC_USAGE(t) (t->usage) -#define TYPES_UNIQUE(t) (t->unique) -#define TYPES_AKV(t) (t->akv) -#define TYPES_DISTRIBUTED(t) (t->distributed) -/*--------------------------------------------------------------------------*/ - /*** *** NODELIST : *** -- GitLab From 6f9112bf23c9277653e592d72a5e9f529fc073ac Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sun, 22 Nov 2020 20:36:16 +0100 Subject: [PATCH 14/16] convert brushed and minor fixes --- src/libsac2c/precompile/typeconv_precompile.c | 2 +- src/libsac2c/print/convert.c | 47 ------------------- src/libsac2c/print/convert.h | 1 - src/libsac2c/tree/tree_basic.c | 2 +- 4 files changed, 2 insertions(+), 50 deletions(-) diff --git a/src/libsac2c/precompile/typeconv_precompile.c b/src/libsac2c/precompile/typeconv_precompile.c index d833f3bdc..b72144a21 100644 --- a/src/libsac2c/precompile/typeconv_precompile.c +++ b/src/libsac2c/precompile/typeconv_precompile.c @@ -178,7 +178,7 @@ LiftArg (node *arg, node *fundef, ntype *new_type, node **new_assigns) * * Function: * void LiftIds( ids *ids_arg, node *fundef, - * types *new_type, node **new_assigns) + * ntype *new_type, node **new_assigns) * * Description: * Lifts the given return value of a function application: diff --git a/src/libsac2c/print/convert.c b/src/libsac2c/print/convert.c index 71f2e10a4..40caa55da 100644 --- a/src/libsac2c/print/convert.c +++ b/src/libsac2c/print/convert.c @@ -239,53 +239,6 @@ CVtype2String (ntype *type, int flag, bool all) DBUG_RETURN (tmp_string); } -/****************************************************************************** - * - * function: - * char *CVshpseg2String(int dim, shpseg *shape) - * - * description: - * This function converts a given shpseg integer vector data structure into - * an allocated string. The first parameter provides the actually used length - * of the vector. - * - ******************************************************************************/ - -char * -CVshpseg2String (int dim, shpseg *shape) -{ - char *buffer; - char num_buffer[20]; - int i; - - DBUG_ENTER (); - - DBUG_ASSERT (dim <= SHP_SEG_SIZE, " dimension out of range in SetVect()!"); - - /* - * Instead of accurately computing the buffer space to be allocated, - * we make a generous estimation. - */ - buffer = (char *)MEMmalloc (dim * 20); - - buffer[0] = '['; - buffer[1] = '\0'; - - for (i = 0; i < dim - 1; i++) { - sprintf (num_buffer, "%d", SHPSEG_SHAPE (shape, i)); - strcat (buffer, num_buffer); - strcat (buffer, ", "); - } - - if (dim > 0) { - sprintf (num_buffer, "%d", SHPSEG_SHAPE (shape, dim - 1)); - strcat (buffer, num_buffer); - } - strcat (buffer, "]"); - - DBUG_RETURN (buffer); -} - /****************************************************************************** * * function: diff --git a/src/libsac2c/print/convert.h b/src/libsac2c/print/convert.h index 45a321861..1efb76a11 100644 --- a/src/libsac2c/print/convert.h +++ b/src/libsac2c/print/convert.h @@ -10,7 +10,6 @@ extern char *CVfloat2String (float); extern char *CVfloatvec2String (floatvec val); extern char *CVbasetype2String (simpletype type); extern char *CVbasetype2ShortString (simpletype type); -extern char *CVshpseg2String (int dim, shpseg *shape); extern char *CVintBytes2String (size_t bytes); #endif /* _SAC_CONVERT_H_ */ diff --git a/src/libsac2c/tree/tree_basic.c b/src/libsac2c/tree/tree_basic.c index 656dd3fbb..f6c5dcc3f 100644 --- a/src/libsac2c/tree/tree_basic.c +++ b/src/libsac2c/tree/tree_basic.c @@ -231,7 +231,7 @@ TBmakeArgtab (size_t size) argtab->size = size; argtab->ptr_in = (node **)MEMmalloc (argtab->size * sizeof (node *)); - argtab->ptr_out = (node **)MEMmalloc (argtab->size * sizeof (types *)); + argtab->ptr_out = (node **)MEMmalloc (argtab->size * sizeof (node *)); argtab->tag = (argtag_t *)MEMmalloc (argtab->size * sizeof (argtag_t)); for (i = 0; i < argtab->size; i++) { -- GitLab From 974fdd5e7e4ebb1ba925457cfd149fa349b8a1b4 Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Sun, 22 Nov 2020 21:32:14 +0100 Subject: [PATCH 15/16] types and shpseg elided, all refs to them gone?! --- src/libsac2c/constants/shape.c | 18 +++++--- src/libsac2c/print/print.c | 16 +------ src/libsac2c/serialize/serialize_attribs.c | 48 -------------------- src/libsac2c/tree/free_attribs.c | 44 ------------------ src/libsac2c/tree/tree_basic.c | 52 ---------------------- src/libsac2c/tree/tree_basic.h | 18 -------- src/libsac2c/tree/tree_compound.h | 26 ----------- src/libsac2c/types/types.h | 30 ++----------- src/libsac2c/xml/ast.xml | 44 +----------------- 9 files changed, 19 insertions(+), 277 deletions(-) diff --git a/src/libsac2c/constants/shape.c b/src/libsac2c/constants/shape.c index 076b94464..b4dee7a18 100644 --- a/src/libsac2c/constants/shape.c +++ b/src/libsac2c/constants/shape.c @@ -298,13 +298,21 @@ SHserializeShape (FILE *file, shape *shp) DBUG_ENTER (); - fprintf (file, "SHcreateShape( %d", SHAPE_DIM (shp)); + if (shp == NULL) { + DBUG_PRINT_TAG ("SET", "Processing shape (null)"); - for (cnt = 0; cnt < SHAPE_DIM (shp); cnt++) { - fprintf (file, ", %d", SHAPE_EXT (shp, cnt)); - } + fprintf (file, "NULL"); + + DBUG_PRINT_TAG ("SET", "Done processing shape (null)"); + } else { + fprintf (file, "SHcreateShape( %d", SHAPE_DIM (shp)); - fprintf (file, ")"); + for (cnt = 0; cnt < SHAPE_DIM (shp); cnt++) { + fprintf (file, ", %d", SHAPE_EXT (shp, cnt)); + } + + fprintf (file, ")"); + } DBUG_RETURN (); } diff --git a/src/libsac2c/print/print.c b/src/libsac2c/print/print.c index 37f57a0e4..3329d58d2 100644 --- a/src/libsac2c/print/print.c +++ b/src/libsac2c/print/print.c @@ -1933,17 +1933,7 @@ PrintFunctionHeader (node *arg_node, info *arg_info, bool in_comment) if (FUNDEF_RETS (arg_node) == NULL) { fprintf (global.outfile, "void "); } else { - if (FUNDEF_TYPES (arg_node) != NULL) { - /* - * Print old types. - */ - DBUG_ASSERT( FALSE, "encountered old types on fundef!"); - } else { - /* - * We do have new types ! - */ - TRAVdo (FUNDEF_RETS (arg_node), arg_info); - } + TRAVdo (FUNDEF_RETS (arg_node), arg_info); if (FUNDEF_HASDOTRETS (arg_node)) { fprintf (global.outfile, ", ..."); @@ -2670,10 +2660,6 @@ PRTvardec (node *arg_node, info *arg_info) fprintf (global.outfile, "; "); - if (VARDEC_TYPE (arg_node) != NULL) { - DBUG_ASSERT (FALSE, "encountered old types on vardec!"); - } - if (AVIS_DECLTYPE (VARDEC_AVIS (arg_node)) != NULL) { type_str = TYtype2String (AVIS_DECLTYPE (VARDEC_AVIS (arg_node)), FALSE, 0); fprintf (global.outfile, " /* declared: %s */", type_str); diff --git a/src/libsac2c/serialize/serialize_attribs.c b/src/libsac2c/serialize/serialize_attribs.c index 44e434ea6..500df8ce4 100644 --- a/src/libsac2c/serialize/serialize_attribs.c +++ b/src/libsac2c/serialize/serialize_attribs.c @@ -577,32 +577,6 @@ SATserializeChar (info *info, char attr, node *parent) DBUG_RETURN (); } -/** - * - * @fn SATserializeOldType - * - * @brief generates code to serialize the given attribute - * - * @param info info structure of serialize traversal - * @param attr the attribute itself - * @param parent the parent node - * - ***************************************************************************/ - -void -SATserializeOldType (info *info, types *attr, node *parent) -{ - DBUG_ENTER (); - - if (attr == NULL) { - fprintf (INFO_SER_FILE (info), "NULL"); - } else { - fprintf (INFO_SER_FILE (info), "MakeTypes1( %d)", T_unknown); - } - - DBUG_RETURN (); -} - /** * * @fn SATserializeNode @@ -1107,28 +1081,6 @@ SATserializeAccessInfo (info *info, access_info_t *attr, node *parent) DBUG_RETURN (); } -/** - * - * @fn SATserializeShpSeg - * - * @brief generates code to serialize the given attribute - * - * @param info info structure of serialize traversal - * @param attr the attribute itself - * @param parent the parent node - * - ***************************************************************************/ - -void -SATserializeShpSeg (info *info, shpseg *attr, node *parent) -{ - DBUG_ENTER (); - - fprintf (INFO_SER_FILE (info), "NULL"); - - DBUG_RETURN (); -} - /** * * @fn SATserializeIntegerPointer diff --git a/src/libsac2c/tree/free_attribs.c b/src/libsac2c/tree/free_attribs.c index d897e3e0a..d73e7830f 100644 --- a/src/libsac2c/tree/free_attribs.c +++ b/src/libsac2c/tree/free_attribs.c @@ -125,25 +125,6 @@ FREEattribSharedString (const char *attr, node *parent) DBUG_RETURN ((char *)NULL); } -/** - * - * @fn FREEattribOldType - * - * @brief Frees OldType attribute - * - * @param attr OldType node to process - * @param parent parent node - * - * @return result of Free call, usually NULL - * - ***************************************************************************/ -types * -FREEattribOldType (types *attr, node *parent) -{ - DBUG_ENTER (); - - DBUG_RETURN (attr); -} /** * @@ -718,31 +699,6 @@ FREEattribCudaAccessInfo (cuda_access_info_t *attr, node *parent) DBUG_RETURN (attr); } -/** - * - * @fn FREEattribShpSeg - * - * @brief Frees ShpSeg attribute - * - * @param attr ShpSeg node to process - * @param parent parent node - * - * @return result of Free call, usually NULL - * - ***************************************************************************/ -shpseg * -FREEattribShpSeg (shpseg *attr, node *parent) -{ - DBUG_ENTER (); - - if (attr != NULL) { - SHPSEG_NEXT (attr) = FREEattribShpSeg (SHPSEG_NEXT (attr), parent); - attr = MEMfree (attr); - } - - DBUG_RETURN (attr); -} - /** * * @fn FREEattribIntegerPointer diff --git a/src/libsac2c/tree/tree_basic.c b/src/libsac2c/tree/tree_basic.c index f6c5dcc3f..dc890b7df 100644 --- a/src/libsac2c/tree/tree_basic.c +++ b/src/libsac2c/tree/tree_basic.c @@ -11,58 +11,6 @@ /* Make-functions for non-node structures */ /*--------------------------------------------------------------------------*/ -/* - * attention: the given parameter chain of nums structs is set free here!!! - */ -shpseg * -TBmakeShpseg (node *numsp) -{ - shpseg *tmp; - int i; - node *oldnumsp; - - DBUG_ENTER (); - - tmp = (shpseg *)MEMmalloc (sizeof (shpseg)); - -#ifndef DBUG_OFF - /* - * For debugging memory use with dbx, it is important - * that all "memory.has been initialised before reading - * from it. As the Shpseg is allocated in a fixed size - * which may not be entirely filled afterwards, we - * have to write an initial value! Otherwise dbx will - * complain that for example in DupTree uninitialised - * data is read. - */ - for (i = 0; i < SHP_SEG_SIZE; i++) { - SHPSEG_SHAPE (tmp, i) = -1; - } -#endif - - i = 0; - while (numsp != NULL) { - if (i >= SHP_SEG_SIZE) { - CTIabort ("Maximum number of dimensions exceeded"); - } - - DBUG_ASSERT (NODE_TYPE (numsp) == N_nums, "found a non numsp node as argument"); - - SHPSEG_SHAPE (tmp, i) = NUMS_VAL (numsp); - - i++; - oldnumsp = numsp; - numsp = NUMS_NEXT (numsp); - oldnumsp = FREEdoFreeNode (oldnumsp); - } - - SHPSEG_NEXT (tmp) = NULL; - - DBUG_RETURN (tmp); -} - -/*--------------------------------------------------------------------------*/ - nodelist * TBmakeNodelistNode (node *node, nodelist *next) { diff --git a/src/libsac2c/tree/tree_basic.h b/src/libsac2c/tree/tree_basic.h index 9d46c2e1f..4d44ee736 100644 --- a/src/libsac2c/tree/tree_basic.h +++ b/src/libsac2c/tree/tree_basic.h @@ -41,24 +41,6 @@ /*--------------------------------------------------------------------------*/ -/*** - *** SHPSEG : - *** - *** permanent attributes: - *** - *** int[SHP_SEG_SIZE] SHAPE - *** shpseg* NEXT - *** - ***/ - -extern shpseg *TBmakeShpseg (node *num); - -#define SHPSEG_ELEMS(s) (s->shp) -#define SHPSEG_SHAPE(s, x) (SHPSEG_ELEMS (s)[x]) -#define SHPSEG_NEXT(s) (s->next) - -/*--------------------------------------------------------------------------*/ - /*** *** NODELIST : *** diff --git a/src/libsac2c/tree/tree_compound.h b/src/libsac2c/tree/tree_compound.h index 0838374c7..ede028531 100644 --- a/src/libsac2c/tree/tree_compound.h +++ b/src/libsac2c/tree/tree_compound.h @@ -61,11 +61,6 @@ specific implementation of a function should remain with the source code. #define IDS_NTYPE(n) AVIS_TYPE (IDS_AVIS (n)) #define IDS_DIM(n) VARDEC_OR_ARG_DIM (IDS_DECL (n)) -/* - * TODO: remove - */ -#define IDS_TYPE(n) VARDEC_OR_ARG_TYPE (IDS_DECL (n)) - extern node *TCcreateIdsChainFromAvises (int num_avises, ...); extern node *TCappendIds (node *chain, node *item); extern size_t TCcountIds (node *ids_arg); @@ -344,12 +339,6 @@ extern size_t TCcountVardecs (node *vardecs); #define ARG_NAME(n) (AVIS_NAME (ARG_AVIS (n))) #define ARG_NTYPE(n) (AVIS_TYPE (ARG_AVIS (n))) -/* - * TODO: REMOVE US CAUSE WE'RE UGLY - */ -#define ARG_DIM(n) (TYPES_DIM (ARG_TYPE (n))) -#define ARG_TNAME(n) (TYPES_NAME (ARG_TYPE (n))) - extern size_t TCcountArgs (node *args); extern size_t TCcountArgsIgnoreArtificials (node *args); extern node *TCappendArgs (node *arg_chain, node *arg); @@ -395,7 +384,6 @@ extern node *TCcreateExprsFromArgs (node *args); * Use the L_VARDEC_OR_... macros instead!! */ #define VARDEC_OR_ARG_NAME(n) (AVIS_NAME (DECL_AVIS (n))) -#define VARDEC_OR_ARG_TYPE(n) ((NODE_TYPE (n) == N_arg) ? ARG_TYPE (n) : VARDEC_TYPE (n)) #define VARDEC_OR_ARG_STATUS(n) \ ((NODE_TYPE (n) == N_arg) \ ? ARG_STATUS (n) \ @@ -462,13 +450,6 @@ extern node *TCcreateExprsFromArgs (node *args); OBJDEF_AVIS (n) = (rhs); \ } -#define L_VARDEC_OR_ARG_TYPE(n, rhs) \ - if (NODE_TYPE (n) == N_arg) { \ - ARG_TYPE (n) = (rhs); \ - } else { \ - VARDEC_TYPE (n) = (rhs); \ - } - extern node *TCsearchDecl (const char *name, node *decl_node); /*--------------------------------------------------------------------------*/ @@ -832,13 +813,6 @@ extern node *TCids2ExprsNt (node *ids_arg); #define ID_DECL_NEXT(n) VARDEC_OR_ARG_NEXT (ID_DECL (n)) #define ID_PADDED(n) VARDEC_OR_ARG_PADDED (ID_DECL (n)) -#define ID_TYPE(n) \ - ((NODE_TYPE (AVIS_DECL (ID_AVIS (n))) == N_vardec) \ - ? VARDEC_TYPE (AVIS_DECL (ID_AVIS (n))) \ - : ((NODE_TYPE (AVIS_DECL (ID_AVIS (n))) == N_arg) \ - ? ARG_TYPE (AVIS_DECL (ID_AVIS (n))) \ - : NULL)) - #define ID_SSAASSIGN(n) (AVIS_SSAASSIGN (ID_AVIS (n))) #define ID_NAME_OR_ICMTEXT(n) ((ID_AVIS (n) != NULL) ? ID_NAME (n) : ID_ICMTEXT (n)) diff --git a/src/libsac2c/types/types.h b/src/libsac2c/types/types.h index ea0aa70a9..4dcbdaae5 100644 --- a/src/libsac2c/types/types.h +++ b/src/libsac2c/types/types.h @@ -309,13 +309,6 @@ typedef struct NODELIST { struct NODELIST *next; } nodelist; -#define SHP_SEG_SIZE 16 - -typedef struct SHPSEG { - int shp[SHP_SEG_SIZE]; - struct SHPSEG *next; -} shpseg; - typedef struct ACCESS_T { struct NODE *array_vardec; /* */ struct NODE *iv_vardec; /* index vector */ @@ -337,26 +330,6 @@ typedef struct ACCESS_INFO_T { struct NODE *wlarray; } access_info_t; -typedef struct TYPES { - simpletype msimpletype; - char *name; /* only used for T_user !! */ - char *name_mod; /* name of modul belonging to 'name' */ - struct NODE *tdef; /* typedef of user-defined type */ - int dim; /* if (dim == 0) => simpletype */ - bool poly; /* only needed for type templates (newTC !) */ - shpseg *mshpseg; /* pointer to shape specification */ - struct TYPES *next; /* only needed for fun-results */ - /* and implementation of implicit types */ - /* mutc backend */ - mutcScope scope; /* the scope of the value of this var */ - mutcUsage usage; /* where is this var used */ - - bool unique; /* this variable is unique */ - bool akv; /* this variable is akv */ - distmem_dis distributed; /* distributed class of this variable */ - -} types; - /* * Used to store the relations of with-generators. * Should be normalized in flatten and typecheck to op1: <= and op2: < @@ -1324,6 +1297,9 @@ typedef struct sMtx { int **mtx; } * IntMatrix, sMatrix; + +#define SHP_SEG_SIZE 16 + /* These two structs are used to annotate reusable arrays * in a wl. The info will be attached to N_code node */ typedef struct RC_T { diff --git a/src/libsac2c/xml/ast.xml b/src/libsac2c/xml/ast.xml index 9ae160222..bfe1c505c 100644 --- a/src/libsac2c/xml/ast.xml +++ b/src/libsac2c/xml/ast.xml @@ -31,8 +31,6 @@ - @@ -67,8 +65,6 @@ copy="function" persist="no" /> - - - - - - - - - - - - - @@ -6077,18 +6061,6 @@ N_tfarg : - - - - - - - - - - - - @@ -6453,18 +6425,6 @@ N_tfarg : - - - - - - - - - - - - @@ -10157,8 +10117,8 @@ N_tfarg : - - + + -- GitLab From 8960216ffb98727319dfd651a745882115d5e1a0 Mon Sep 17 00:00:00 2001 From: Sven-Bodo Scholz Date: Mon, 23 Nov 2020 00:24:54 +0100 Subject: [PATCH 16/16] trying to fix the conversion warnings as well as the old-types-dependent test --- src/libsac2c/multithread/tag_executionmode.c | 7 ++++--- src/tests/test-icm-compilation.cpp | 3 --- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/libsac2c/multithread/tag_executionmode.c b/src/libsac2c/multithread/tag_executionmode.c index 7b44abebf..c405c887c 100644 --- a/src/libsac2c/multithread/tag_executionmode.c +++ b/src/libsac2c/multithread/tag_executionmode.c @@ -495,7 +495,8 @@ IsGeneratorBigEnough (node *test_variables) { node *iterator; bool is_bigenough; - int var_dim, var_size; /* dimension and size of an actual variable */ + int var_dim; + long long var_size; DBUG_ENTER (); /* some initializations */ @@ -555,7 +556,7 @@ IsMTClever (node *test_variables) while ((is_clever == FALSE) && (iterator != NULL)) { var_dim = TYgetDim (IDS_NTYPE (iterator)); - var_size = SHgetUnrLen (TYgetShape (IDS_NTYPE (iterator))); + var_size = (double)SHgetUnrLen (TYgetShape (IDS_NTYPE (iterator))); /* add the size of the actual variable to the sum of the sizes of the former variables */ @@ -599,7 +600,7 @@ IsSTClever (node *test_variables) while ((is_clever == FALSE) && (iterator != NULL)) { var_dim = TYgetDim (IDS_NTYPE (iterator)); - var_size = SHgetUnrLen (TYgetShape (IDS_NTYPE (iterator))); + var_size = (double)SHgetUnrLen (TYgetShape (IDS_NTYPE (iterator))); if (var_size >= (double)(global.max_replication_size)) { is_clever = TRUE; diff --git a/src/tests/test-icm-compilation.cpp b/src/tests/test-icm-compilation.cpp index 8e139a950..57da6b142 100644 --- a/src/tests/test-icm-compilation.cpp +++ b/src/tests/test-icm-compilation.cpp @@ -17,7 +17,6 @@ extern "C" { #include "constants.h" #include "compile.h" #include "functionprecompile.h" -#include "convert_type_representation.h" #include "limits.h" } @@ -70,8 +69,6 @@ TEST (CompileICM, ICM_ND_FUN_DECL) // Create a stupid argtab of the function fn = FPCdoFunctionPrecompile (fn); - // Convert new types to old types. - fn = CTRdoConvertToOldTypes (fn); node *fn_icm = COMPdoCompile (fn); -- GitLab