diff --git a/include/sacinterface.h b/include/sacinterface.h
index 0575a7961b0252a15771060184225ed46bbb350d..38e6346412060618365ae13ae232140e886e286c 100644
--- a/include/sacinterface.h
+++ b/include/sacinterface.h
@@ -152,4 +152,5 @@ extern SACarg *SACARGconvertFromVoidPointer (int basetype, void *data);
* @return
******************************************************************************/
extern void *SACARGconvertToVoidPointer (int basetype, SACarg *arg);
+
#endif /* _SAC_SACINTERFACE_H_ */
diff --git a/src/libsac/interface/sacarg.c b/src/libsac/interface/sacarg.c
index 12df5922736de09c57cf4da3aab469536abf8cd5..a2550cfd99fc9b8f0f8385cdce3b10cb77dd2b9d 100644
--- a/src/libsac/interface/sacarg.c
+++ b/src/libsac/interface/sacarg.c
@@ -33,6 +33,9 @@ static const int basetype_to_size[] = {
#undef TYP_IFsize
};
+#define BTYPE_ISINTERNAL(btype) \
+ ((btype == T_int) || (btype == T_float) || (btype == T_double) || (btype == T_char) \
+ || (btype == T_bool))
/**
* Functions for creating SACargs
*/
@@ -106,6 +109,17 @@ SACARGmakeSacArg (basetype btype, SAC_array_descriptor_t desc, void *data)
/**
* Functions for handling references to SACargs
*/
+void
+SACARGfreeDataInternal (basetype btype, void *data)
+{
+ SAC_FREE (data);
+}
+
+/*
+ * this function is generated by sac4c
+ */
+extern void SACARGfreeDataUdt (basetype btype, void *data);
+
void
SACARGfree (SACarg *arg)
{
@@ -118,7 +132,12 @@ SACARGfree (SACarg *arg)
/*
* last reference freed, so free the contained data
*/
- SAC_FREE (SACARG_DESC (arg));
+ if (!BTYPE_ISINTERNAL (SACARG_BTYPE (arg))) {
+ SACARGfreeDataUdt (SACARG_BTYPE (arg), SACARG_DATA (arg));
+ } else {
+ SACARGfreeDataInternal (SACARG_BTYPE (arg), SACARG_DATA (arg));
+ }
+
SAC_FREE (SACARG_DATA (arg));
}
@@ -145,6 +164,22 @@ SACARGcopy (SACarg *arg)
return (SACARGnewReference (arg));
}
+void *
+SACARGcopyDataInternal (basetype btype, int size, void *data)
+{
+ void *result;
+
+ result = SAC_MALLOC (basetype_to_size[btype] * size);
+ result = memcpy (result, data, basetype_to_size[btype] * size);
+
+ return (result);
+}
+
+/*
+ * this function is generated by sac4c
+ */
+extern void *SACARGcopyDataUdt (basetype btype, int size, void *data);
+
void *
SACARGextractData (SACarg *arg)
{
@@ -155,19 +190,14 @@ SACARGextractData (SACarg *arg)
SAC_FREE (SACARG_DESC (arg));
SAC_FREE (arg);
} else {
- if ((SACARG_BTYPE (arg) != T_int) && (SACARG_BTYPE (arg) != T_float)
- && (SACARG_BTYPE (arg) != T_char) && (SACARG_BTYPE (arg) != T_bool)) {
- /*
- * we cannot yet copy external types, so we emit an error here
- */
- SAC_RuntimeError ("External arguments can only be extracted if "
- "the contained data is not shared, i.e., "
- "its reference counter is 0!");
+ if (!BTYPE_ISINTERNAL (SACARG_BTYPE (arg))) {
+ result = SACARGcopyDataUdt (SACARG_BTYPE (arg), SACARG_SIZE (arg),
+ SACARG_DATA (arg));
+ } else {
+ result = SACARGcopyDataInternal (SACARG_BTYPE (arg), SACARG_SIZE (arg),
+ SACARG_DATA (arg));
}
- result = SAC_MALLOC (basetype_to_size[SACARG_BTYPE (arg)] * SACARG_SIZE (arg));
- result = memcpy (result, SACARG_DATA (arg),
- basetype_to_size[SACARG_BTYPE (arg)] * SACARG_SIZE (arg));
SACARGfree (arg);
}
@@ -257,6 +287,19 @@ SACARGunwrapUdt (void **data, SAC_array_descriptor_t *desc, SACarg *arg,
}
}
+#define UNWRAPWRAPPER(name, ctype) \
+ void SACARGunwrapUdt##name (ctype **data, SAC_array_descriptor_t *desc, SACarg *arg, \
+ SAC_array_descriptor_t arg_desc) \
+ { \
+ SACARGunwrapUdt ((void *)data, desc, arg, arg_desc); \
+ }
+
+UNWRAPWRAPPER (Int, int)
+UNWRAPWRAPPER (Bool, bool)
+UNWRAPWRAPPER (Float, float)
+UNWRAPWRAPPER (Double, double)
+UNWRAPWRAPPER (Char, char)
+
#define WRAP(name, ctype, btype) \
void SACARGwrap##name (SACarg **arg, SAC_array_descriptor_t *desc, void *data, \
SAC_array_descriptor_t data_desc) \
@@ -303,6 +346,20 @@ SACARGwrapUdt (SACarg **arg, SAC_array_descriptor_t *desc, basetype btype, void
DESC_RC ((*desc))++;
}
+#define WRAPWRAPPER(name, ctype) \
+ void SACARGwrapUdt##name (SACarg **arg, SAC_array_descriptor_t *desc, \
+ basetype btype, ctype *data, \
+ SAC_array_descriptor_t data_desc) \
+ { \
+ SACARGwrapUdt (arg, desc, btype, (void *)data, data_desc); \
+ }
+
+WRAPWRAPPER (Int, int)
+WRAPWRAPPER (Bool, bool)
+WRAPWRAPPER (Float, float)
+WRAPWRAPPER (Double, double)
+WRAPWRAPPER (Char, char)
+
#define HASTYPE(name, ctype, btype) \
bool SACARGis##name (SACarg *arg) \
{ \
diff --git a/src/libsac2c/cinterface/construct_bundles.c b/src/libsac2c/cinterface/construct_bundles.c
index 2d786233614263d7cdfc208905088f89fed76fb0..ae8437faf6a26fd5d37393f9205d8a03a8b1234b 100644
--- a/src/libsac2c/cinterface/construct_bundles.c
+++ b/src/libsac2c/cinterface/construct_bundles.c
@@ -191,33 +191,44 @@ InsertIntoBundles (node *fundef, int arity, node *bundles)
node *
CBLfundef (node *arg_node, info *arg_info)
{
- node *temp;
+ node *old_node = NULL;
int arity;
DBUG_ENTER ("CBLfundef");
- if (FUNDEF_ISWRAPPERFUN (arg_node)) {
+ if (FUNDEF_ISWRAPPERFUN (arg_node) && !FUNDEF_ISSACARGCONVERSION (arg_node)) {
if (!FUNDEF_HASDOTRETS (arg_node) && !FUNDEF_HASDOTARGS (arg_node)) {
- temp = arg_node;
+ old_node = arg_node;
arg_node = FUNDEF_NEXT (arg_node);
- FUNDEF_NEXT (temp) = NULL;
+ FUNDEF_NEXT (old_node) = NULL;
- arity = TCcountArgs (FUNDEF_ARGS (temp));
+ arity = TCcountArgs (FUNDEF_ARGS (old_node));
- DBUG_PRINT ("CBL", ("Adding function %s (%d) to bundle.", CTIitemName (temp),
- arity));
+ DBUG_PRINT ("CBL", ("Adding function %s (%d) to bundle.",
+ CTIitemName (old_node), arity));
INFO_BUNDLES (arg_info)
- = InsertIntoBundles (temp, arity, INFO_BUNDLES (arg_info));
+ = InsertIntoBundles (old_node, arity, INFO_BUNDLES (arg_info));
} else {
CTIwarn ("%s is not exported as it uses varargs.", CTIitemName (arg_node));
}
}
- if (arg_node == NULL) {
- arg_node = INFO_BUNDLES (arg_info);
- INFO_BUNDLES (arg_info) = NULL;
+ if (old_node != NULL) {
+ /*
+ * we moved a fundef into a bundle so the current
+ * node actually already is the next node
+ */
+ if (arg_node == NULL) {
+ arg_node = INFO_BUNDLES (arg_info);
+ INFO_BUNDLES (arg_info) = NULL;
+ } else {
+ arg_node = TRAVdo (arg_node, arg_info);
+ }
} else {
+ /*
+ * we did not do anything, so go on as usual
+ */
if (FUNDEF_NEXT (arg_node) != NULL) {
FUNDEF_NEXT (arg_node) = TRAVdo (FUNDEF_NEXT (arg_node), arg_info);
} else {
diff --git a/src/libsac2c/cinterface/create_c_wrapper_body.c b/src/libsac2c/cinterface/create_c_wrapper_body.c
index b5920ff7fdd16107ea00febcaf0eb82c90a9eb1e..b89cb900c9d65bc65a8d9f357d802334f22e8899 100644
--- a/src/libsac2c/cinterface/create_c_wrapper_body.c
+++ b/src/libsac2c/cinterface/create_c_wrapper_body.c
@@ -23,9 +23,6 @@
*****************************************************************************/
#include "create_c_wrapper_body.h"
-/*
- * Other includes go here
- */
#include "dbug.h"
#include "traverse.h"
#include "tree_basic.h"
@@ -47,7 +44,7 @@ struct INFO {
};
/**
- * A template entry in the template info structure
+ * The info structure
*/
#define INFO_FILE(n) ((n)->file)
diff --git a/src/libsac2c/cinterface/generate_copy_and_free.c b/src/libsac2c/cinterface/generate_copy_and_free.c
new file mode 100644
index 0000000000000000000000000000000000000000..35fba02c79966ae336f8daa69ab00407152bfdc2
--- /dev/null
+++ b/src/libsac2c/cinterface/generate_copy_and_free.c
@@ -0,0 +1,347 @@
+/*
+ * $Id$
+ */
+
+/** <!--********************************************************************-->
+ *
+ * @defgroup gcf Generate Copy and Free
+ *
+ * @ingroup gcf
+ *
+ * @{
+ *
+ *****************************************************************************/
+
+/** <!--********************************************************************-->
+ *
+ * @file generate_copy_and_free.c
+ *
+ * Prefix: GCF
+ *
+ *****************************************************************************/
+#include "generate_copy_and_free.h"
+
+/*
+ * Other includes go here
+ */
+#include "dbug.h"
+#include "traverse.h"
+#include "tree_basic.h"
+#include "filemgr.h"
+#include "globals.h"
+#include "build.h"
+#include "memory.h"
+#include "type_utils.h"
+#include "user_types.h"
+#include "ctinfo.h"
+
+/** <!--********************************************************************-->
+ *
+ * @name INFO structure
+ * @{
+ *
+ *****************************************************************************/
+struct INFO {
+ FILE *copyfile;
+ FILE *freefile;
+};
+
+#define INFO_COPYFILE(n) ((n)->copyfile)
+#define INFO_FREEFILE(n) ((n)->freefile)
+
+static info *
+MakeInfo ()
+{
+ info *result;
+
+ DBUG_ENTER ("MakeInfo");
+
+ result = MEMmalloc (sizeof (info));
+
+ INFO_COPYFILE (result) = NULL;
+ INFO_FREEFILE (result) = NULL;
+
+ DBUG_RETURN (result);
+}
+
+static info *
+FreeInfo (info *info)
+{
+ DBUG_ENTER ("FreeInfo");
+
+ info = MEMfree (info);
+
+ DBUG_RETURN (info);
+}
+/** <!--********************************************************************-->
+ * @} <!-- INFO structure -->
+ *****************************************************************************/
+
+/** <!--********************************************************************-->
+ *
+ * @name Entry functions
+ * @{
+ *
+ *****************************************************************************/
+/** <!--********************************************************************-->
+ *
+ * @fn node *TEMPdoTemplateTraversal( node *syntax_tree)
+ *
+ *****************************************************************************/
+node *
+GCFdoGenerateCopyAndFree (node *syntax_tree)
+{
+ info *info;
+
+ DBUG_ENTER ("GCFdoGenerateCopyAndFree");
+
+ info = MakeInfo ();
+
+ TRAVpush (TR_gcf);
+ syntax_tree = TRAVdo (syntax_tree, info);
+ TRAVpop ();
+
+ info = FreeInfo (info);
+
+ DBUG_RETURN (syntax_tree);
+}
+
+/** <!--********************************************************************-->
+ * @} <!-- Entry functions -->
+ *****************************************************************************/
+
+/** <!--********************************************************************-->
+ *
+ * @name Static helper funcions
+ * @{
+ *
+ *****************************************************************************/
+
+static void
+PrintFileHeader (FILE *file)
+{
+ DBUG_ENTER ("PrintFileHeader");
+
+ fprintf (file,
+ "/*\n"
+ " * C interface helper functions.\n"
+ " *\n"
+ " * generated by sac4c %s (%s) rev %s\n"
+ " */\n\n"
+ "#include \"sac.h\"\n"
+ "#include \"header.h\"\n\n",
+ global.version_id, build_style, build_rev);
+
+ DBUG_VOID_RETURN;
+}
+
+static void
+PrintFreeHead (FILE *file)
+{
+ DBUG_ENTER ("PrintFreeHead");
+
+ fprintf (file, "extern void SACARGfreeDataInternal( int btype, void *data);\n"
+ "\n");
+
+ fprintf (file, "void SACARGfreeDataUdt( int btype, void *data)\n"
+ "{ \n"
+ " switch( btype) {\n");
+
+ DBUG_VOID_RETURN;
+}
+
+static void
+PrintFreeTail (FILE *file)
+{
+ DBUG_ENTER ("PrintFreeTail");
+
+ fprintf (file,
+ " default:\n"
+ " SAC_RuntimeError( \"No free function defined for type %%d\", btype);\n"
+ " }\n"
+ "}\n\n");
+
+ DBUG_VOID_RETURN;
+}
+
+static void
+PrintCopyHead (FILE *file)
+{
+ DBUG_ENTER ("PrintCopyHead");
+
+ fprintf (file,
+ "extern void *SACARGcopyDataInternal( int btype, int size, void *data);\n"
+ "\n");
+
+ fprintf (file, "void *SACARGcopyDataUdt( int btype, int size, void *data)\n"
+ "{\n"
+ " void *result;\n"
+ "\n"
+ " switch( btype) {\n");
+
+ DBUG_VOID_RETURN;
+}
+
+static void
+PrintCopyTail (FILE *file)
+{
+ DBUG_ENTER ("PrintCopyTail");
+
+ fprintf (file,
+ " default:\n"
+ " SAC_RuntimeError( \"No copy function defined for type %%d\", btype);\n"
+ " }\n"
+ "\n"
+ " return( result);\n"
+ "}\n\n");
+
+ DBUG_VOID_RETURN;
+}
+
+/** <!--********************************************************************-->
+ * @} <!-- Static helper functions -->
+ *****************************************************************************/
+
+/** <!--********************************************************************-->
+ *
+ * @name Traversal functions
+ * @{
+ *
+ *****************************************************************************/
+
+/** <!--********************************************************************-->
+ *
+ * @fn node *GCFtypedef(node *arg_node, info *arg_info)
+ *
+ * @brief Print the copy/free function part of this typedef
+ *
+ *****************************************************************************/
+node *
+GCFtypedef (node *arg_node, info *arg_info)
+{
+ simpletype inner;
+ usertype udt;
+ int btype;
+ node *unaliased_tdef;
+
+ DBUG_ENTER ("GCFtypedef");
+
+ inner = UTgetBaseSimpleType (TYPEDEF_NTYPE (arg_node));
+ udt = UTfindUserType (TYPEDEF_NAME (arg_node), TYPEDEF_NS (arg_node));
+
+ DBUG_ASSERT ((udt != UT_NOT_DEFINED), "udt for typedef not found!");
+
+ btype = udt + global.sac4c_udt_offset;
+
+ if (inner == T_hidden) {
+ /*
+ * external type, so we need to use its copy/free functions
+ */
+ unaliased_tdef = UTgetTdef (UTgetUnAliasedType (udt));
+
+ fprintf (INFO_COPYFILE (arg_info), " case %d:\n", btype);
+ if (TYPEDEF_COPYFUN (unaliased_tdef) == NULL) {
+ fprintf (INFO_COPYFILE (arg_info),
+ " SAC_RuntimeError( \"No copy function defined for type "
+ "%s.\");\n",
+ CTIitemName (arg_node));
+
+ CTIwarn ("No copy function defined for type `%s'. Copying SACargs "
+ "containing data of such type will fail at runtime.",
+ CTIitemName (arg_node));
+ } else {
+ fprintf (INFO_COPYFILE (arg_info), " result = %s( data);\n",
+ TYPEDEF_COPYFUN (unaliased_tdef));
+ }
+ fprintf (INFO_COPYFILE (arg_info), " break;\n");
+
+ fprintf (INFO_FREEFILE (arg_info), " case %d:\n", btype);
+ if (TYPEDEF_FREEFUN (unaliased_tdef) == NULL) {
+ fprintf (INFO_FREEFILE (arg_info),
+ " SAC_RuntimeError( \"No free function defined for type "
+ "%s.\");\n",
+ CTIitemName (arg_node));
+
+ CTIwarn ("No free function defined for type `%s'. Freeing SACargs "
+ "containing data of such type will fail at runtime.",
+ CTIitemName (arg_node));
+ } else {
+ fprintf (INFO_FREEFILE (arg_info), " %s( data);\n",
+ TYPEDEF_FREEFUN (unaliased_tdef));
+ }
+ fprintf (INFO_FREEFILE (arg_info), " break;\n");
+ } else {
+ /*
+ * internal inner type, so we use the SAC copy/free functions
+ */
+ fprintf (INFO_COPYFILE (arg_info),
+ " case %d:\n"
+ " result = SACARGcopyDataInternal( %d, size, data);\n"
+ " break;\n",
+ btype, inner);
+
+ fprintf (INFO_FREEFILE (arg_info),
+ " case %d:\n"
+ " SACARGfreeDataInternal( %d, data);\n"
+ " break;\n",
+ btype, inner);
+ }
+
+ if (TYPEDEF_NEXT (arg_node) != NULL) {
+ TYPEDEF_NEXT (arg_node) = TRAVdo (TYPEDEF_NEXT (arg_node), arg_info);
+ }
+
+ DBUG_RETURN (arg_node);
+}
+
+/** <!--********************************************************************-->
+ *
+ * @fn node *GCFmodule(node *arg_node, info *arg_info)
+ *
+ * @brief Print the copy/free function type indepedent parts and handle
+ * files
+ *
+ *****************************************************************************/
+node *
+GCFmodule (node *arg_node, info *arg_info)
+{
+ DBUG_ENTER ("GCFmodule");
+
+ INFO_COPYFILE (arg_info) = FMGRwriteOpen ("%s/sacargcopy.c", global.tmp_dirname);
+ INFO_FREEFILE (arg_info) = FMGRwriteOpen ("%s/sacargfree.c", global.tmp_dirname);
+
+ PrintFileHeader (INFO_COPYFILE (arg_info));
+ PrintFileHeader (INFO_FREEFILE (arg_info));
+
+ /*
+ * print the function heads
+ */
+ PrintCopyHead (INFO_COPYFILE (arg_info));
+ PrintFreeHead (INFO_FREEFILE (arg_info));
+
+ /*
+ * fill in the cases
+ */
+ if (MODULE_TYPES (arg_node) != NULL) {
+ MODULE_TYPES (arg_node) = TRAVdo (MODULE_TYPES (arg_node), arg_info);
+ }
+
+ /*
+ * add the bottom
+ */
+ PrintCopyTail (INFO_COPYFILE (arg_info));
+ PrintFreeTail (INFO_FREEFILE (arg_info));
+
+ INFO_FREEFILE (arg_info) = FMGRclose (INFO_FREEFILE (arg_info));
+ INFO_COPYFILE (arg_info) = FMGRclose (INFO_COPYFILE (arg_info));
+
+ DBUG_RETURN (arg_node);
+}
+
+/** <!--********************************************************************-->
+ * @} <!-- Traversal functions -->
+ *****************************************************************************/
+
+/** <!--********************************************************************-->
+ * @} <!-- Traversal template -->
+ *****************************************************************************/
diff --git a/src/libsac2c/cinterface/generate_copy_and_free.h b/src/libsac2c/cinterface/generate_copy_and_free.h
new file mode 100644
index 0000000000000000000000000000000000000000..2730447acc5eceaed4f866a4e87928d94d309fff
--- /dev/null
+++ b/src/libsac2c/cinterface/generate_copy_and_free.h
@@ -0,0 +1,21 @@
+/*
+ * $Id$
+ */
+#ifndef _SAC_GENERATE_COPY_AND_FREE_H_
+#define _SAC_GENERATE_COPY_AND_FREE_H_
+
+#include "types.h"
+
+/** <!--********************************************************************-->
+ *
+ * Generate Copy and Free Traversal (gcf_tab)
+ *
+ * Prefix: GCF
+ *
+ *****************************************************************************/
+extern node *GCFdoGenerateCopyAndFree (node *syntax_tree);
+
+extern node *GCFtypedef (node *arg_node, info *arg_info);
+extern node *GCFmodule (node *arg_node, info *arg_info);
+
+#endif /* _SAC_GENERATE_COPY_AND_FREE_H_ */
diff --git a/src/libsac2c/cinterface/print_ldflags.c b/src/libsac2c/cinterface/print_ldflags.c
index 2a74efcf51f16a723b8cb92ab594281068ae4ef2..2cbf507bcec0250429734be9a589158cbacb9cac 100644
--- a/src/libsac2c/cinterface/print_ldflags.c
+++ b/src/libsac2c/cinterface/print_ldflags.c
@@ -21,11 +21,11 @@ PLDFdoPrintLDFlags (node *syntax_tree)
DBUG_ENTER ("PLDFdoPrintLDFlags");
flags = CCMgetLinkerFlags (syntax_tree);
- printf ("-L%s/lib/ %s%s/lib/ -L%s %s%s -l%s %s",
+ printf ("-L%s/lib/ %s%s/lib/ -L%s %s%s %s -l%s",
STRonNull (".", getenv (SAC2CBASEENV)), global.config.ld_path,
STRonNull (".", getenv (SAC2CBASEENV)), STRonNull (".", global.lib_dirname),
- global.config.ld_path, STRonNull (".", global.lib_dirname),
- global.outfilename, flags);
+ global.config.ld_path, STRonNull (".", global.lib_dirname), flags,
+ global.outfilename);
flags = MEMfree (flags);
CTIterminateCompilation (syntax_tree);
diff --git a/src/libsac2c/codegen/gen_startup_code.c b/src/libsac2c/codegen/gen_startup_code.c
index 10479970bbca041bf7d999b2bef15a8ddac9be0f..e0b34507353bb1d452dfa6e1836ba9337686bfec 100644
--- a/src/libsac2c/codegen/gen_startup_code.c
+++ b/src/libsac2c/codegen/gen_startup_code.c
@@ -469,34 +469,6 @@ GSCprintFileHeader (node *syntax_tree)
DBUG_VOID_RETURN;
}
-/******************************************************************************
- *
- * function:
- * void GSCprintInternalInitFileHeader( node *syntax_tree)
- *
- * description:
- * generates header part of internal_runtime_init.c
- * used when compiling a c library
- * code contains part of the startup code from a "real" SAC-executeable
- *
- ******************************************************************************/
-
-void
-GSCprintInternalInitFileHeader (node *syntax_tree)
-{
- DBUG_ENTER ("GSCprintCWrapperFileHeader");
-
- PrintGlobalSwitches ();
- PrintGlobalSettings (syntax_tree);
-
- fprintf (global.outfile, "#undef SAC_DO_COMPILE_MODULE\n");
- fprintf (global.outfile, "#define SAC_DO_COMPILE_MODULE 0\n");
-
- PrintIncludes ();
-
- DBUG_VOID_RETURN;
-}
-
/******************************************************************************
*
* function:
@@ -636,3 +608,23 @@ GSCprintMain ()
DBUG_VOID_RETURN;
}
+
+/** <!-- ****************************************************************** -->
+ * @brief Used to print stubs for SACARGfreeDataUdt and SACARGcopyDataUdt
+ * when compiling programs to circumvent linker errors.
+ ******************************************************************************/
+void
+GSCprintSACargCopyFreeStubs ()
+{
+ DBUG_ENTER ("GSCprintSACargCopyFreeStubs");
+
+ fprintf (global.outfile, "/*\n"
+ " * stubs for SACARGfreeDataUdt and SACARGcopyDataUdt\n"
+ " */\n"
+ "void SACARGfreeDataUdt( int size, void *data) {};\n"
+ "void *SACARGcopyDataUdt( int type, int size, void *data) { "
+ "return ((void *) 0x0); } \n"
+ "\n");
+
+ DBUG_VOID_RETURN;
+}
diff --git a/src/libsac2c/codegen/gen_startup_code.h b/src/libsac2c/codegen/gen_startup_code.h
index bc2e0bc46be6c75c309da7f9c65d573094fa59eb..1023088f7a1b59402c79bf251b7417e9781d35d2 100644
--- a/src/libsac2c/codegen/gen_startup_code.h
+++ b/src/libsac2c/codegen/gen_startup_code.h
@@ -24,5 +24,6 @@ extern void GSCprintDefines ();
extern void GSCprintMain ();
extern void GSCprintMainBegin ();
extern void GSCprintMainEnd ();
+extern void GSCprintSACargCopyFreeStubs ();
#endif /* _SAC_GEN_STARTUP_CODE_H_ */
diff --git a/src/libsac2c/generics/generate_generic_type_conversions.c b/src/libsac2c/generics/generate_generic_type_conversions.c
index 8bdbc266466e05a39b549e68334b1e87ee6c1852..4e885b3aa95e21831820dddb6d33cb232ce0d8b2 100644
--- a/src/libsac2c/generics/generate_generic_type_conversions.c
+++ b/src/libsac2c/generics/generate_generic_type_conversions.c
@@ -196,10 +196,107 @@ BuildTypeConversion (const char *name, const namespace_t *ns, ntype *from, ntype
DBUG_RETURN (result);
}
+/** <!-- ****************************************************************** -->
+ * @brief Returns the name of the innermost simpletype of a user
+ * defined type.
+ *
+ * @param ns namespace of type
+ * @param name name of type
+ *
+ * @return appropriate string for that type
+ ******************************************************************************/
+static const char *
+GetInnerTypeName (namespace_t *ns, const char *name)
+{
+ const char *result;
+ ntype *base;
+ usertype udt;
+
+ DBUG_ENTER ("GetInnerTypeName");
+
+ udt = UTfindUserType (name, ns);
+
+ DBUG_ASSERT ((udt != UT_NOT_DEFINED), "cannot find usertype for typedef!");
+
+ udt = UTgetUnAliasedType (udt);
+
+ do {
+ base = UTgetBaseType (udt);
+ } while (TUisArrayOfUser (base));
+
+ switch (TYgetSimpleType (TYgetScalar (base))) {
+ case T_int:
+ result = "Int";
+ break;
+ case T_bool:
+ result = "Bool";
+ break;
+ case T_float:
+ result = "Float";
+ break;
+ case T_double:
+ result = "Double";
+ break;
+ case T_char:
+ result = "Char";
+ break;
+ case T_hidden:
+ result = "";
+ break;
+ default:
+ DBUG_ASSERT (0, "unhandled simple type");
+ result = "Unknown";
+ break;
+ }
+
+ DBUG_RETURN (result);
+}
+
+/** <!-- ****************************************************************** -->
+ * @brief Constructs the apropriate linkname for a wrap function.
+ *
+ * @param ns namespace of type
+ * @param name name of type
+ *
+ * @return a matching linksign name
+ ******************************************************************************/
+static char *
+GetWrapUdtLinkName (namespace_t *ns, const char *name)
+{
+ char *result;
+
+ DBUG_ENTER ("GetWrapUdtLinkName");
+
+ result = STRcat ("SACARGwrapUdt", GetInnerTypeName (ns, name));
+
+ DBUG_RETURN (result);
+}
+
+/** <!-- ****************************************************************** -->
+ * @brief Constructs the apropriate linkname for an unwrap function.
+ *
+ * @param ns namespace of type
+ * @param name name of type
+ *
+ * @return a matching linksign name
+ ******************************************************************************/
+static char *
+GetUnwrapUdtLinkName (namespace_t *ns, const char *name)
+{
+ char *result;
+
+ DBUG_ENTER ("GetUnwrapUdtLinkName");
+
+ result = STRcat ("SACARGunwrapUdt", GetInnerTypeName (ns, name));
+
+ DBUG_RETURN (result);
+}
+
/** <!-- ****************************************************************** -->
* @brief Inserts a fundec for <ns>::unwrap<name> into the funs chain and
* adds a symbol for that type to the symbols chain.
*
+ * @param type the actual type
* @param ns namespace of type
* @param name type name
* @param *symbols chain of provided symbols
@@ -209,29 +306,26 @@ BuildTypeConversion (const char *name, const namespace_t *ns, ntype *from, ntype
* @return modified funs chain
******************************************************************************/
static node *
-BuildWrap (namespace_t *ns, const char *name, node **symbols, node **notexports,
- node *funs)
+BuildWrap (ntype *type, namespace_t *ns, const char *name, node **symbols,
+ node **notexports, node *funs)
{
node *result;
char *funname;
node *udtarg, *sourcearg;
node *sacargret;
+ usertype sacargudt;
DBUG_ENTER ("BuildWrap");
funname = STRcat ("wrap", name);
- sacargret
- = TBmakeRet (TYmakeAKS (TYmakeSymbType (STRcpy (SACARG_NAME),
- NSgetNamespace (global.preludename)),
- SHmakeShape (0)),
- NULL);
+ sacargudt = UTfindUserType (SACARG_NAME, NSgetNamespace (global.preludename));
- sourcearg = TBmakeArg (TBmakeAvis (TRAVtmpVar (),
- TYmakeAKS (TYmakeSymbType (STRcpy (name),
- NSdupNamespace (ns)),
- SHmakeShape (0))),
- NULL);
+ DBUG_ASSERT ((sacargudt != UT_NOT_DEFINED), "Cannot find sacarg udt!");
+
+ sacargret = TBmakeRet (TYmakeAKS (TYmakeUserType (sacargudt), SHmakeShape (0)), NULL);
+
+ sourcearg = TBmakeArg (TBmakeAvis (TRAVtmpVar (), TYcopyType (type)), NULL);
udtarg = TBmakeArg (TBmakeAvis (TRAVtmpVar (), TYmakeAKS (TYmakeSimpleType (T_int),
SHmakeShape (0))),
sourcearg);
@@ -248,8 +342,9 @@ BuildWrap (namespace_t *ns, const char *name, node **symbols, node **notexports,
result = TBmakeFundef (STRcpy (funname), NSdupNamespace (ns), sacargret, udtarg, NULL,
funs);
- FUNDEF_LINKNAME (result) = STRcpy ("SACARGwrapUdt");
+ FUNDEF_LINKNAME (result) = GetWrapUdtLinkName (ns, name);
FUNDEF_ISEXTERN (result) = TRUE;
+ FUNDEF_ISSACARGCONVERSION (result) = TRUE;
*symbols = TBmakeSymbol (STRcpy (funname), *symbols);
*notexports = TBmakeSymbol (funname, *notexports);
@@ -261,6 +356,7 @@ BuildWrap (namespace_t *ns, const char *name, node **symbols, node **notexports,
* @brief Inserts a fundec for <ns>::unwrap<name> into the funs chain and
* adds a symbol for that type to the symbols chain.
*
+ * @param type the actual type
* @param ns namespace of type
* @param name type name
* @param *symbols chain of provided symbols
@@ -270,27 +366,27 @@ BuildWrap (namespace_t *ns, const char *name, node **symbols, node **notexports,
* @return
******************************************************************************/
static node *
-BuildUnWrap (namespace_t *ns, const char *name, node **symbols, node **notexports,
- node *funs)
+BuildUnWrap (ntype *type, namespace_t *ns, const char *name, node **symbols,
+ node **notexports, node *funs)
{
node *result;
char *funname;
node *udtarg;
node *destret;
+ usertype sacargudt;
DBUG_ENTER ("BuildUnWrap");
funname = STRcat ("unwrap", name);
- destret = TBmakeRet (TYmakeAKS (TYmakeSymbType (STRcpy (name), NSdupNamespace (ns)),
- SHmakeShape (0)),
- NULL);
+ sacargudt = UTfindUserType (SACARG_NAME, NSgetNamespace (global.preludename));
+
+ DBUG_ASSERT ((sacargudt != UT_NOT_DEFINED), "Cannot find sacarg udt!");
- udtarg = TBmakeArg (TBmakeAvis (TRAVtmpVar (),
- TYmakeAKS (TYmakeSymbType (STRcpy (SACARG_NAME),
- NSgetNamespace (
- global.preludename)),
- SHmakeShape (0))),
+ destret = TBmakeRet (TYcopyType (type), NULL);
+
+ udtarg = TBmakeArg (TBmakeAvis (TRAVtmpVar (), TYmakeAKS (TYmakeUserType (sacargudt),
+ SHmakeShape (0))),
NULL);
RET_LINKSIGN (destret) = 1;
@@ -302,8 +398,9 @@ BuildUnWrap (namespace_t *ns, const char *name, node **symbols, node **notexport
result
= TBmakeFundef (STRcpy (funname), NSdupNamespace (ns), destret, udtarg, NULL, funs);
- FUNDEF_LINKNAME (result) = STRcpy ("SACARGunwrapUdt");
+ FUNDEF_LINKNAME (result) = GetUnwrapUdtLinkName (ns, name);
FUNDEF_ISEXTERN (result) = TRUE;
+ FUNDEF_ISSACARGCONVERSION (result) = TRUE;
*symbols = TBmakeSymbol (STRcpy (funname), *symbols);
*notexports = TBmakeSymbol (funname, *notexports);
@@ -390,51 +487,54 @@ GGTCmodule (node *arg_node, info *arg_info)
node *
GGTCtypedef (node *arg_node, info *arg_info)
{
+ node *to_fun, *from_fun;
+ char *to_name, *from_name;
+ ntype *tdef_type;
+ usertype udt;
+
DBUG_ENTER ("GGTCtypedef");
- if (TYPEDEF_ISUNIQUE (arg_node) && TYPEDEF_ISLOCAL (arg_node)) {
- node *to_fun, *from_fun;
- char *to_name, *from_name;
- ntype *tdef_type;
+ if (TYPEDEF_ISLOCAL (arg_node)) {
+ udt = UTfindUserType (TYPEDEF_NAME (arg_node), TYPEDEF_NS (arg_node));
- to_name = STRcat ("to_", TYPEDEF_NAME (arg_node));
- from_name = STRcat ("from_", TYPEDEF_NAME (arg_node));
+ DBUG_ASSERT ((udt != UT_NOT_DEFINED), "Cannot find user type!");
- tdef_type = TYmakeAKS (TYmakeSymbType (STRcpy (TYPEDEF_NAME (arg_node)),
- NSdupNamespace (TYPEDEF_NS (arg_node))),
- SHmakeShape (0));
+ tdef_type = TYmakeAKS (TYmakeUserType (udt), SHmakeShape (0));
- to_fun = BuildTypeConversion (to_name, TYPEDEF_NS (arg_node),
- TYPEDEF_NTYPE (arg_node), tdef_type, F_to_unq);
+ if (TYPEDEF_ISUNIQUE (arg_node)) {
+ to_name = STRcat ("to_", TYPEDEF_NAME (arg_node));
+ from_name = STRcat ("from_", TYPEDEF_NAME (arg_node));
- from_fun = BuildTypeConversion (from_name, TYPEDEF_NS (arg_node), tdef_type,
- TYPEDEF_NTYPE (arg_node), F_from_unq);
+ to_fun = BuildTypeConversion (to_name, TYPEDEF_NS (arg_node),
+ TYPEDEF_NTYPE (arg_node), tdef_type, F_to_unq);
- FUNDEF_NEXT (to_fun) = INFO_FUNDEFS (arg_info);
- FUNDEF_NEXT (from_fun) = to_fun;
- INFO_FUNDEFS (arg_info) = from_fun;
+ from_fun = BuildTypeConversion (from_name, TYPEDEF_NS (arg_node), tdef_type,
+ TYPEDEF_NTYPE (arg_node), F_from_unq);
- INFO_NOTPROVIDEDSYMBOLS (arg_info)
- = TBmakeSymbol (STRcpy (to_name), INFO_NOTPROVIDEDSYMBOLS (arg_info));
- INFO_NOTEXPORTEDSYMBOLS (arg_info)
- = TBmakeSymbol (to_name, INFO_NOTEXPORTEDSYMBOLS (arg_info));
- INFO_NOTPROVIDEDSYMBOLS (arg_info)
- = TBmakeSymbol (STRcpy (from_name), INFO_NOTPROVIDEDSYMBOLS (arg_info));
- INFO_NOTEXPORTEDSYMBOLS (arg_info)
- = TBmakeSymbol (from_name, INFO_NOTEXPORTEDSYMBOLS (arg_info));
+ FUNDEF_NEXT (to_fun) = INFO_FUNDEFS (arg_info);
+ FUNDEF_NEXT (from_fun) = to_fun;
+ INFO_FUNDEFS (arg_info) = from_fun;
- tdef_type = TYfreeType (tdef_type);
- }
+ INFO_NOTPROVIDEDSYMBOLS (arg_info)
+ = TBmakeSymbol (STRcpy (to_name), INFO_NOTPROVIDEDSYMBOLS (arg_info));
+ INFO_NOTEXPORTEDSYMBOLS (arg_info)
+ = TBmakeSymbol (to_name, INFO_NOTEXPORTEDSYMBOLS (arg_info));
+ INFO_NOTPROVIDEDSYMBOLS (arg_info)
+ = TBmakeSymbol (STRcpy (from_name), INFO_NOTPROVIDEDSYMBOLS (arg_info));
+ INFO_NOTEXPORTEDSYMBOLS (arg_info)
+ = TBmakeSymbol (from_name, INFO_NOTEXPORTEDSYMBOLS (arg_info));
+ }
- if (TYPEDEF_ISLOCAL (arg_node) && !TYPEDEF_ISUNIQUE (arg_node)) {
INFO_FUNDEFS (arg_info)
- = BuildWrap (TYPEDEF_NS (arg_node), TYPEDEF_NAME (arg_node),
+ = BuildWrap (tdef_type, TYPEDEF_NS (arg_node), TYPEDEF_NAME (arg_node),
&INFO_PROVIDEDSYMBOLS (arg_info),
&INFO_NOTEXPORTEDSYMBOLS (arg_info), INFO_FUNDEFS (arg_info));
INFO_FUNDEFS (arg_info)
- = BuildUnWrap (TYPEDEF_NS (arg_node), TYPEDEF_NAME (arg_node),
+ = BuildUnWrap (tdef_type, TYPEDEF_NS (arg_node), TYPEDEF_NAME (arg_node),
&INFO_PROVIDEDSYMBOLS (arg_info),
&INFO_NOTEXPORTEDSYMBOLS (arg_info), INFO_FUNDEFS (arg_info));
+
+ tdef_type = TYfreeType (tdef_type);
}
if (TYPEDEF_NEXT (arg_node) != NULL) {
diff --git a/src/libsac2c/global/globals.mac b/src/libsac2c/global/globals.mac
index 29d756bbe74acfb68f8a0c41fa5704037a643618..c5db89d5a4d27dbf4616fbf84a4f22aa02c03146 100644
--- a/src/libsac2c/global/globals.mac
+++ b/src/libsac2c/global/globals.mac
@@ -65,7 +65,7 @@ GLOBAL (int, start_token, 0)
* Version control
*/
-GLOBAL (const char *, version_id, "v1.00-beta (Live CD Edition)")
+GLOBAL (const char *, version_id, "v1.00-beta (Jolly Good Fellow)")
/*
* version string
*/
diff --git a/src/libsac2c/global/phase_sac2c.mac b/src/libsac2c/global/phase_sac2c.mac
index d29e018f00e9096b9ed9e27ba7a0d5c45fa9bba2..4533099a37c52266a00f187ae4e43700231db266 100644
--- a/src/libsac2c/global/phase_sac2c.mac
+++ b/src/libsac2c/global/phase_sac2c.mac
@@ -37,9 +37,6 @@ SUBPHASE (rpr, "Resolving pragma annotations", RSPdoResolvePragmas, ALWAYS, pre)
SUBPHASE (obi, "Generating object initializers", OIdoObjectInit, ALWAYS, pre)
-SUBPHASE (ggtc, "Generating generic type conversion functions",
- GGTCdoGenerateGenericTypeConversions, ALWAYS, pre)
-
SUBPHASE (csgd, "Checking and simplifying generic definitions",
CSGDdoCheckAndSimplifyGenericDefinitions, ALWAYS, pre)
@@ -80,14 +77,17 @@ SUBPHASE (moe, "Handling multiple operator expressions", HMdoHandleMops, ALWAYS,
SUBPHASE (flt, "Flattening nested expressions", FLATdoFlatten, ALWAYS, sim)
+SUBPHASE (udt, "Processing user defined types", RSTdoResolveSymbolTypes, ALWAYS, sim)
+
+SUBPHASE (ggtc, "Generating generic type conversion functions",
+ GGTCdoGenerateGenericTypeConversions, ALWAYS, sim)
+
ENDPHASE (sim)
/******************************************************************************/
PHASE (ptc, "Converting to static single assignment form", ALWAYS)
-SUBPHASE (udt, "Processing user defined types", RSTdoResolveSymbolTypes, ALWAYS, ptc)
-
SUBPHASE (ivd, "Inserting variable declarations", INSVDdoInsertVardec, ALWAYS, ptc)
SUBPHASE (itc, "Converting type decls into type conversions", INSTCdoInsertTypeConv,
diff --git a/src/libsac2c/global/phase_sac4c.mac b/src/libsac2c/global/phase_sac4c.mac
index 9ff87f3a3f80b35511a4cc4720f6b02c4aedb305..80261779c678874b1316e3a84ecc4b4a8b99a6c2 100644
--- a/src/libsac2c/global/phase_sac4c.mac
+++ b/src/libsac2c/global/phase_sac4c.mac
@@ -12,8 +12,6 @@ SUBPHASE (pccf, "Printing CC Flags", PCCFdoPrintCCFlags, global.printccflags, am
SUBPHASE (lm, "Loading module contents", LMCdoLoadModuleContents, ALWAYS, ami)
-SUBPHASE (ses, "Stripping external signatures", SESdoStripExternalSignatures, ALWAYS, ami)
-
SUBPHASE (uwt, "Updating dispatch information", EWTdoExtendWrapperTypes, ALWAYS, ami)
SUBPHASE (etv, "Eliminating Type Variables", EATdoEliminateAlphaTypes, ALWAYS, ami)
@@ -31,6 +29,8 @@ SUBPHASE (cwh, "Creating header files", CCWHdoCreateCWrapperHeader, !global.prin
SUBPHASE (cwb, "Creating interface stub files", CCWBdoCreateCWrapperBody, ALWAYS, gwc)
+SUBPHASE (gcf, "Creating copy and free functions", GCFdoGenerateCopyAndFree, ALWAYS, gwc)
+
SUBPHASE (btf, "Transforming bundles to wrapper functions", BTFdoBundleToFundef, ALWAYS,
gwc)
@@ -91,6 +91,11 @@ SUBPHASE (linl, "Inlining LaC functions", LINLdoLACInlining, ALWAYS, cpc)
SUBPHASE (rec, "Removing external code", RECdoRemoveExternalCode, ALWAYS, cpc)
+SUBPHASE (rera, "Restoring reference arguments", RERAdoRestoreReferenceArguments, ALWAYS,
+ cpc)
+
+SUBPHASE (reso, "Restoring global objects", RESOdoRestoreObjects, ALWAYS, cpc)
+
SUBPHASE (sls, "Applying linksign pragma", SLSdoSetLinksign, ALWAYS, cpc)
SUBPHASE (mmv, "Marking memval identifiers", MMVdoMarkMemVals, ALWAYS, cpc)
diff --git a/src/libsac2c/modules/ccmanager.c b/src/libsac2c/modules/ccmanager.c
index b484ed8762daf0953e2f03f4cb31d1f197da3777..c784381d12eb53bf1e350d07f813c932ed16e54e 100644
--- a/src/libsac2c/modules/ccmanager.c
+++ b/src/libsac2c/modules/ccmanager.c
@@ -356,6 +356,8 @@ InvokeCCWrapper (char *cccall, char *ccflags)
(void (*) (const char *, const char *, void *))CompileOneFile);
CompileOneFile (global.tmp_dirname, "globals.c", callstring);
CompileOneFile (global.tmp_dirname, "interface.c", callstring);
+ CompileOneFile (global.tmp_dirname, "sacargcopy.c", callstring);
+ CompileOneFile (global.tmp_dirname, "sacargfree.c", callstring);
/*
* compile PIC code
@@ -364,6 +366,8 @@ InvokeCCWrapper (char *cccall, char *ccflags)
(void (*) (const char *, const char *, void *))CompileOneFilePIC);
CompileOneFilePIC (global.tmp_dirname, "globals.c", callstring);
CompileOneFilePIC (global.tmp_dirname, "interface.c", callstring);
+ CompileOneFilePIC (global.tmp_dirname, "sacargcopy.c", callstring);
+ CompileOneFilePIC (global.tmp_dirname, "sacargfree.c", callstring);
callstring = MEMfree (callstring);
@@ -428,7 +432,7 @@ CCMgetLinkerFlags (node *syntax_tree)
deplibs
= (char *)STRSfold (&BuildDepLibsStringProg, global.dependencies, STRcpy (""));
- result = STRcatn (5, paths, " ", deplibs, " ", libs);
+ result = STRcatn (5, paths, " ", libs, " ", deplibs);
libs = MEMfree (libs);
paths = MEMfree (paths);
diff --git a/src/libsac2c/modules/libbuilder.c b/src/libsac2c/modules/libbuilder.c
index f1110ef1bf49d1f9dfa7b587971d0dd844a4e577..1e5c643f4d24d1484d7fa8b1ea8f92459ca1fea2 100644
--- a/src/libsac2c/modules/libbuilder.c
+++ b/src/libsac2c/modules/libbuilder.c
@@ -119,10 +119,11 @@ LIBBcreateWrapperLibrary (node *syntax_tree)
CTInote ("Creating static wrapper library `lib%s.a'", global.outfilename);
SYScall ("%s %s/lib%s.a %s/fun*_nonpic.o %s/globals_nonpic.o "
- "%s/interface_nonpic.o %s",
+ "%s/interface_nonpic.o %s/sacargcopy_nonpic.o "
+ "%s/sacargfree_nonpic.o %s",
global.config.ar_create, STRonNull (".", global.lib_dirname),
global.outfilename, global.tmp_dirname, global.tmp_dirname,
- global.tmp_dirname, deplibs);
+ global.tmp_dirname, global.tmp_dirname, global.tmp_dirname, deplibs);
if (global.config.ranlib[0] != '\0') {
SYScall ("%s %s/lib%s.a", global.config.ranlib,
@@ -132,10 +133,11 @@ LIBBcreateWrapperLibrary (node *syntax_tree)
CTInote ("Creating shared wrapper library `lib%s.so'", global.outfilename);
SYScall ("%s -o %s/lib%s.so %s/fun*_pic.o %s/globals_pic.o "
- "%s/interface_pic.o %s",
+ "%s/interface_pic.o %s/sacargcopy_pic.o "
+ "%s/sacargfree_pic.o %s",
global.config.ld_dynamic, STRonNull (".", global.lib_dirname),
global.outfilename, global.tmp_dirname, global.tmp_dirname,
- global.tmp_dirname, deplibs);
+ global.tmp_dirname, global.tmp_dirname, global.tmp_dirname, deplibs);
deplibs = MEMfree (deplibs);
diff --git a/src/libsac2c/print/print.c b/src/libsac2c/print/print.c
index 82db0260bed10d783414400eb1767323f8e58609..476a17a233a37636f596556b4aafc1f42b672da5 100644
--- a/src/libsac2c/print/print.c
+++ b/src/libsac2c/print/print.c
@@ -4735,6 +4735,7 @@ PrintTRAVdo (node *syntax_tree, info *arg_info)
GSCprintFileHeader (syntax_tree);
syntax_tree = TRAVdo (syntax_tree, arg_info);
+ GSCprintSACargCopyFreeStubs ();
GSCprintMain ();
fclose (global.outfile);
diff --git a/src/libsac2c/typecheck/type_utils.c b/src/libsac2c/typecheck/type_utils.c
index 53a075bfc2b7f3e7590f6b8f1eef84d5d5d38499..e03f8345877aaa9d2652252002cf576275b02613 100644
--- a/src/libsac2c/typecheck/type_utils.c
+++ b/src/libsac2c/typecheck/type_utils.c
@@ -1371,3 +1371,28 @@ TUisScalar (ntype *ty)
DBUG_RETURN (TUdimKnown (ty) && (TYgetDim (ty) == 0));
}
+
+/** <!-- ****************************************************************** -->
+ * @brief Returns the simpletype of the innermost basetype of a typedef
+ * chain
+ *
+ * @param type type to start search with
+ *
+ * @return the types innermost basetype
+ ******************************************************************************/
+simpletype
+UTgetBaseSimpleType (ntype *type)
+{
+ usertype udt;
+
+ DBUG_ENTER ("GetBaseSimpleType");
+ while (TUisArrayOfUser (type)) {
+ udt = TYgetUserType (TYgetScalar (type));
+ udt = UTgetUnAliasedType (udt);
+ type = UTgetBaseType (udt);
+ }
+
+ DBUG_ASSERT ((TYisArray (type)), "Non array type found!");
+ DBUG_ASSERT ((TYisSimple (TYgetScalar (type))), "non simple type as base!");
+ DBUG_RETURN (TYgetSimpleType (TYgetScalar (type)));
+}
diff --git a/src/libsac2c/typecheck/type_utils.h b/src/libsac2c/typecheck/type_utils.h
index ecfa58998322766a05b0ed0c980dc7533a0b07a3..be356670100db80aa57e7e94d927bb660d310591 100644
--- a/src/libsac2c/typecheck/type_utils.h
+++ b/src/libsac2c/typecheck/type_utils.h
@@ -49,5 +49,6 @@ extern ntype *TUcombineBottoms (ntype *prod);
extern ntype *TUcombineBottomsFromRets (node *rets);
extern ntype *TUspreadBottoms (ntype *prod);
extern ntype *TUcheckUdtAndSetBaseType (usertype udt, int *visited);
+extern simpletype UTgetBaseSimpleType (ntype *type);
#endif /* _SAC_TYPE_UTILS_H_*/
diff --git a/src/libsac2c/xml/ast.xml b/src/libsac2c/xml/ast.xml
index 2cc45cb24f1c35631a01e74a0d67c027f10524f7..d31b703d8c7e15af8354798576d035164c5a73c1 100644
--- a/src/libsac2c/xml/ast.xml
+++ b/src/libsac2c/xml/ast.xml
@@ -2364,6 +2364,13 @@
<node name="Module" />
</travuser>
</traversal>
+ <traversal id="GCF" name="Generate Copy And Free" default="sons"
+ include="generate_copy_and_free.h">
+ <travuser>
+ <node name="Typedef" />
+ <node name="Module" />
+ </travuser>
+ </traversal>
<traversal id="CCWB" name="Create C wrapper body" default="sons"
include="create_c_wrapper_body.h">
<travuser>
@@ -3239,6 +3246,9 @@
<flag name="IsSticky" default="FALSE">
<description>This function should not be removed by DeadFunctionRemoval. This is mainly used by the module system to ensure that for all exported functions code is generated. Furthermore, it is used to ensure that the prelude functions are not removed during compilation.</description>
</flag>
+ <flag name="IsSACargConversion" default="FALSE">
+ <description>This function is a special SACarg conversion function used by the C interface. This tag is mainly used to ensure that these functions do not turn up in the resulting C header file.</description>
+ </flag>
<flag name="IsNeeded">
<description>This flag is used in multiple phases, usually to tag functions that are referenced in some sense. It has always to be reset to FALSE at the end of each phase.</description>
</flag>
diff --git a/src/makefiles/targets.mkf b/src/makefiles/targets.mkf
index 3dd6b0275af48c3c0ad35f132ce2ea4d68202db5..17b2fabf8a6dd7813f688f693b10bc5b3276f53b 100644
--- a/src/makefiles/targets.mkf
+++ b/src/makefiles/targets.mkf
@@ -194,7 +194,7 @@ libsac2c_print := print convert
libsac2c_cinterface := load_module_contents construct_bundles \
create_c_wrapper_header bundle_to_fundef \
print_ldflags create_c_wrapper_body \
- print_ccflags
+ print_ccflags generate_copy_and_free
libsac2c_constraints := insert_domain_constraints insert_conformity_checks \
strip_conformity_checks constraint_statistics