Arrays and Objects :) Only UTF-8 still missing...

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_ */

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)                                                    \
     {                                                                                    \

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 {

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)
 

src/libsac2c/cinterface/generate_copy_and_free.c

+/*
+ * $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 -->
+ *****************************************************************************/

src/libsac2c/cinterface/generate_copy_and_free.h

+/*
+ * $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_ */

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);

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;
+}

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_ */

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) {

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
  */

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,

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)

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);

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);
 

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);

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)));
+}

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_*/

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>

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