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