This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [PATCH] noclobber & noescape annotations for function arguments


On Thu, 6 May 2010, Manuel López-Ibáñez wrote:

> On 6 May 2010 11:14, Richard Guenther <richard.guenther@gmail.com> wrote:
> > On Fri, Apr 16, 2010 at 5:40 PM, Manuel López-Ibáñez
> > <lopezibanez@gmail.com> wrote:
> >> On 16 April 2010 17:37, Manuel López-Ibáñez <lopezibanez@gmail.com> wrote:
> >>> But I do not see the fnspec simplifying things. On the contrary, it is
> >>> the same inflation/complexity and in addition this complexity is
> >>
> >> In fact, the fnspec is more complex in terms of usability, because for
> >> valid combinations of attributes it forces the user to remember
> >> additional characters.
> >
> > I'm not exactly sure how to go forward. ?I want to keep the easy access
> > to the information. ?Thus, what about making the new attribute
> > internal-only (naming it "fn spec") and as followup add individual
> > attributes which then would during their processing add/rewrite the
> > "fn spec" attribute (and not insert itself)?
> >
> > That allows the Frontends (I'm thinking of the Fortran frontend
> > obviously) to annotate some of their runtime while we can
> > continue bikeshedding about names and semantics of
> > attributes we want to expose to our users.
> >
> > Would that be ok?
> 
> Your plan sounds correct to me.

Ok, the following does that by renaming the attribute, dropping the
user documentation and the testcases.  It adds example use to the
Fortran frontend by annotating internal_pack (to not clobber its
argument and not capture it) and internal_unpack (to not let either
argument escape and not clobber the source argument).

The internal_pack case shows a missed kind of return value handling.  For
internal_pack we know that we either return what the first argument
points-to (its packed data pointer) or we return a new temporary that
does not alias with anything.  We can use a random letter to say that
(it's internal only), but how'd you express that with decomposed
user attributes? ;)

Bootstrap and regtest running.  Are the fortran parts ok?

Other Fortran intrinsics that very often confuse optimizers are
the I/O ones.  For example write (*,*) X causes us to call
_gfortran_st_write (&dt_parm) and _gfortran_st_write_done (&dt_parm).
Both clobber dt_parm (and in general what it points to).  But
do they cause anything to escape?  (people keep mentioning
async I/O here - would that use exactly the same functions?)

Thanks,
Richard.

2010-05-06  Richard Guenther  <rguenther@suse.de>

	* c-common.c (struct c_common_attributes): Add fnspec attribute.
	(handle_fnspec_attribute): New function.
	* gimple.h (gimple_call_return_flags): Declare.
	(gimple_call_arg_flags): Likewise.
	* gimple.c (gimple_call_arg_flags): New function.
	(gimple_call_return_flags): Likewise.
	* tree.h (EAF_DIRECT, EAF_NOCLOBBER, EAF_NOESCAPE, EAF_UNUSED):
	New argument flags.
	(ERF_RETURN_ARG_MASK, ERF_RETURNS_ARG, ERF_NOALIAS): New function
	return value flags.
	* tree-ssa-alias.c (ref_maybe_used_by_call_p_1): Skip unused args.
	* tree-ssa-structalias.c (make_constraint_from_heapvar): Split
	main work to ...
	(make_heapvar_for): ... this new function.
	(handle_rhs_call): Handle fnspec attribute argument specifiers.
	(handle_lhs_call): Likewise.
	(find_func_aliases): Adjust.

	fortran/
	* trans-decl.c (gfc_build_library_function_decl): Split out
	worker to ...
	(gfc_build_library_function_decl_1): ... this new function.
	Set a fnspec attribute if a specification was provided.
	(gfc_build_library_function_decl_with_spec): New function.
	(gfc_build_intrinsic_function_decls): Annotate internal_pack
	and internal_unpack.

Index: trunk/gcc/tree-ssa-structalias.c
===================================================================
*** trunk.orig/gcc/tree-ssa-structalias.c	2010-05-06 11:41:08.000000000 +0200
--- trunk/gcc/tree-ssa-structalias.c	2010-05-06 11:43:07.000000000 +0200
*************** make_transitive_closure_constraints (var
*** 3599,3609 ****
    process_constraint (new_constraint (lhs, rhs));
  }
  
! /* Create a new artificial heap variable with NAME and make a
!    constraint from it to LHS.  Return the created variable.  */
  
  static varinfo_t
! make_constraint_from_heapvar (varinfo_t lhs, const char *name)
  {
    varinfo_t vi;
    tree heapvar = heapvar_lookup (lhs->decl, lhs->offset);
--- 3599,3609 ----
    process_constraint (new_constraint (lhs, rhs));
  }
  
! /* Create a new artificial heap variable with NAME.
!    Return the created variable.  */
  
  static varinfo_t
! make_heapvar_for (varinfo_t lhs, const char *name)
  {
    varinfo_t vi;
    tree heapvar = heapvar_lookup (lhs->decl, lhs->offset);
*************** make_constraint_from_heapvar (varinfo_t
*** 3635,3640 ****
--- 3635,3650 ----
    vi->is_full_var = true;
    insert_vi_for_tree (heapvar, vi);
  
+   return vi;
+ }
+ 
+ /* Create a new artificial heap variable with NAME and make a
+    constraint from it to LHS.  Return the created variable.  */
+ 
+ static varinfo_t
+ make_constraint_from_heapvar (varinfo_t lhs, const char *name)
+ {
+   varinfo_t vi = make_heapvar_for (lhs, name);
    make_constraint_from (lhs, vi->id);
  
    return vi;
*************** handle_rhs_call (gimple stmt, VEC(ce_s,
*** 3709,3725 ****
  {
    struct constraint_expr rhsc;
    unsigned i;
  
    for (i = 0; i < gimple_call_num_args (stmt); ++i)
      {
        tree arg = gimple_call_arg (stmt, i);
  
!       /* Find those pointers being passed, and make sure they end up
! 	 pointing to anything.  */
!       if (could_have_pointers (arg))
  	make_escape_constraint (arg);
      }
  
    /* The static chain escapes as well.  */
    if (gimple_call_chain (stmt))
      make_escape_constraint (gimple_call_chain (stmt));
--- 3719,3779 ----
  {
    struct constraint_expr rhsc;
    unsigned i;
+   bool returns_uses = false;
  
    for (i = 0; i < gimple_call_num_args (stmt); ++i)
      {
        tree arg = gimple_call_arg (stmt, i);
+       int flags = gimple_call_arg_flags (stmt, i);
  
!       /* If the argument is not used or it does not contain pointers
! 	 we can ignore it.  */
!       if ((flags & EAF_UNUSED)
! 	  || !could_have_pointers (arg))
! 	continue;
! 
!       /* As we compute ESCAPED context-insensitive we do not gain
!          any precision with just EAF_NOCLOBBER but not EAF_NOESCAPE
! 	 set.  The argument would still get clobbered through the
! 	 escape solution.
! 	 ???  We might get away with less (and more precise) constraints
! 	 if using a temporary for transitively closing things.  */
!       if ((flags & EAF_NOCLOBBER)
! 	   && (flags & EAF_NOESCAPE))
! 	{
! 	  varinfo_t uses = get_call_use_vi (stmt);
! 	  if (!(flags & EAF_DIRECT))
! 	    make_transitive_closure_constraints (uses);
! 	  make_constraint_to (uses->id, arg);
! 	  returns_uses = true;
! 	}
!       else if (flags & EAF_NOESCAPE)
! 	{
! 	  varinfo_t uses = get_call_use_vi (stmt);
! 	  varinfo_t clobbers = get_call_clobber_vi (stmt);
! 	  if (!(flags & EAF_DIRECT))
! 	    {
! 	      make_transitive_closure_constraints (uses);
! 	      make_transitive_closure_constraints (clobbers);
! 	    }
! 	  make_constraint_to (uses->id, arg);
! 	  make_constraint_to (clobbers->id, arg);
! 	  returns_uses = true;
! 	}
!       else
  	make_escape_constraint (arg);
      }
  
+   /* If we added to the calls uses solution make sure we account for
+      pointers to it to be returned.  */
+   if (returns_uses)
+     {
+       rhsc.var = get_call_use_vi (stmt)->id;
+       rhsc.offset = 0;
+       rhsc.type = SCALAR;
+       VEC_safe_push (ce_s, heap, *results, &rhsc);
+     }
+ 
    /* The static chain escapes as well.  */
    if (gimple_call_chain (stmt))
      make_escape_constraint (gimple_call_chain (stmt));
*************** handle_rhs_call (gimple stmt, VEC(ce_s,
*** 3752,3795 ****
     the LHS point to global and escaped variables.  */
  
  static void
! handle_lhs_call (tree lhs, int flags, VEC(ce_s, heap) *rhsc, tree fndecl)
  {
    VEC(ce_s, heap) *lhsc = NULL;
  
    get_constraint_for (lhs, &lhsc);
! 
!   if (flags & ECF_MALLOC)
      {
        varinfo_t vi;
!       vi = make_constraint_from_heapvar (get_vi_for_tree (lhs), "HEAP");
        /* We delay marking allocated storage global until we know if
           it escapes.  */
        DECL_EXTERNAL (vi->decl) = 0;
        vi->is_global_var = 0;
        /* If this is not a real malloc call assume the memory was
!          initialized and thus may point to global memory.  All
  	 builtin functions with the malloc attribute behave in a sane way.  */
        if (!fndecl
  	  || DECL_BUILT_IN_CLASS (fndecl) != BUILT_IN_NORMAL)
  	make_constraint_from (vi, nonlocal_id);
      }
!   else if (VEC_length (ce_s, rhsc) > 0)
!     {
!       /* If the store is to a global decl make sure to
! 	 add proper escape constraints.  */
!       lhs = get_base_address (lhs);
!       if (lhs
! 	  && DECL_P (lhs)
! 	  && is_global_var (lhs))
! 	{
! 	  struct constraint_expr tmpc;
! 	  tmpc.var = escaped_id;
! 	  tmpc.offset = 0;
! 	  tmpc.type = SCALAR;
! 	  VEC_safe_push (ce_s, heap, lhsc, &tmpc);
! 	}
!       process_all_all_constraints (lhsc, rhsc);
!     }
    VEC_free (ce_s, heap, lhsc);
  }
  
--- 3806,3868 ----
     the LHS point to global and escaped variables.  */
  
  static void
! handle_lhs_call (gimple stmt, tree lhs, int flags, VEC(ce_s, heap) *rhsc,
! 		 tree fndecl)
  {
    VEC(ce_s, heap) *lhsc = NULL;
  
    get_constraint_for (lhs, &lhsc);
!   /* If the store is to a global decl make sure to
!      add proper escape constraints.  */
!   lhs = get_base_address (lhs);
!   if (lhs
!       && DECL_P (lhs)
!       && is_global_var (lhs))
!     {
!       struct constraint_expr tmpc;
!       tmpc.var = escaped_id;
!       tmpc.offset = 0;
!       tmpc.type = SCALAR;
!       VEC_safe_push (ce_s, heap, lhsc, &tmpc);
!     }
! 
!   /* If the call returns an argument unmodified override the rhs
!      constraints.  */
!   flags = gimple_call_return_flags (stmt);
!   if (flags & ERF_RETURNS_ARG
!       && (flags & ERF_RETURN_ARG_MASK) < gimple_call_num_args (stmt))
!     {
!       tree arg;
!       rhsc = NULL;
!       arg = gimple_call_arg (stmt, flags & ERF_RETURN_ARG_MASK);
!       get_constraint_for (arg, &rhsc);
!       process_all_all_constraints (lhsc, rhsc);
!       VEC_free (ce_s, heap, rhsc);
!     }
!   else if (flags & ERF_NOALIAS)
      {
        varinfo_t vi;
!       struct constraint_expr tmpc;
!       rhsc = NULL;
!       vi = make_heapvar_for (get_vi_for_tree (lhs), "HEAP");
        /* We delay marking allocated storage global until we know if
           it escapes.  */
        DECL_EXTERNAL (vi->decl) = 0;
        vi->is_global_var = 0;
        /* If this is not a real malloc call assume the memory was
! 	 initialized and thus may point to global memory.  All
  	 builtin functions with the malloc attribute behave in a sane way.  */
        if (!fndecl
  	  || DECL_BUILT_IN_CLASS (fndecl) != BUILT_IN_NORMAL)
  	make_constraint_from (vi, nonlocal_id);
+       tmpc.var = vi->id;
+       tmpc.offset = 0;
+       tmpc.type = ADDRESSOF;
+       VEC_safe_push (ce_s, heap, rhsc, &tmpc);
      }
! 
!   process_all_all_constraints (lhsc, rhsc);
! 
    VEC_free (ce_s, heap, lhsc);
  }
  
*************** find_func_aliases (gimple origt)
*** 4202,4208 ****
  	    handle_rhs_call (t, &rhsc);
  	  if (gimple_call_lhs (t)
  	      && could_have_pointers (gimple_call_lhs (t)))
! 	    handle_lhs_call (gimple_call_lhs (t), flags, rhsc, fndecl);
  	  VEC_free (ce_s, heap, rhsc);
  	}
        else
--- 4275,4281 ----
  	    handle_rhs_call (t, &rhsc);
  	  if (gimple_call_lhs (t)
  	      && could_have_pointers (gimple_call_lhs (t)))
! 	    handle_lhs_call (t, gimple_call_lhs (t), flags, rhsc, fndecl);
  	  VEC_free (ce_s, heap, rhsc);
  	}
        else
Index: trunk/gcc/c-common.c
===================================================================
*** trunk.orig/gcc/c-common.c	2010-05-06 11:41:08.000000000 +0200
--- trunk/gcc/c-common.c	2010-05-06 11:43:07.000000000 +0200
*************** static tree handle_type_generic_attribut
*** 533,538 ****
--- 533,539 ----
  static tree handle_alloc_size_attribute (tree *, tree, tree, int, bool *);
  static tree handle_target_attribute (tree *, tree, tree, int, bool *);
  static tree handle_optimize_attribute (tree *, tree, tree, int, bool *);
+ static tree handle_fnspec_attribute (tree *, tree, tree, int, bool *);
  
  static void check_function_nonnull (tree, int, tree *);
  static void check_nonnull_arg (void *, tree, unsigned HOST_WIDE_INT);
*************** const struct attribute_spec c_common_att
*** 832,837 ****
--- 833,842 ----
  			      handle_target_attribute },
    { "optimize",               1, -1, true, false, false,
  			      handle_optimize_attribute },
+   /* For internal use (marking of builtins and runtime functions) only.
+      The name contains space to prevent its usage in source code.  */
+   { "fn spec",	 	      1, 1, false, true, true,
+ 			      handle_fnspec_attribute },
    { NULL,                     0, 0, false, false, false, NULL }
  };
  
*************** handle_alloc_size_attribute (tree *node,
*** 7141,7146 ****
--- 7146,7165 ----
    return NULL_TREE;
  }
  
+ /* Handle a "fn spec" attribute; arguments as in
+    struct attribute_spec.handler.  */
+ 
+ static tree
+ handle_fnspec_attribute (tree *node ATTRIBUTE_UNUSED, tree ARG_UNUSED (name),
+ 			 tree args,
+ 			 int ARG_UNUSED (flags), bool *no_add_attrs)
+ {
+   gcc_assert (args
+ 	      && TREE_CODE (TREE_VALUE (args)) == STRING_CST
+ 	      && !TREE_CHAIN (args));
+   return NULL_TREE;
+ }
+ 
  /* Handle a "returns_twice" attribute; arguments as in
     struct attribute_spec.handler.  */
  
Index: trunk/gcc/gimple.c
===================================================================
*** trunk.orig/gcc/gimple.c	2010-05-06 11:41:08.000000000 +0200
--- trunk/gcc/gimple.c	2010-05-06 11:43:07.000000000 +0200
*************** gimple_call_flags (const_gimple stmt)
*** 1756,1761 ****
--- 1756,1835 ----
    return flags;
  }
  
+ /* Detects argument flags for argument number ARG on call STMT.  */
+ 
+ int
+ gimple_call_arg_flags (const_gimple stmt, unsigned arg)
+ {
+   tree type = TREE_TYPE (TREE_TYPE (gimple_call_fn (stmt)));
+   tree attr = lookup_attribute ("fn spec", TYPE_ATTRIBUTES (type));
+   if (!attr)
+     return 0;
+ 
+   attr = TREE_VALUE (TREE_VALUE (attr));
+   if (1 + arg >= (unsigned) TREE_STRING_LENGTH (attr))
+     return 0;
+ 
+   switch (TREE_STRING_POINTER (attr)[1 + arg])
+     {
+     case 'x':
+     case 'X':
+       return EAF_UNUSED;
+ 
+     case 'R':
+       return EAF_DIRECT | EAF_NOCLOBBER | EAF_NOESCAPE;
+ 
+     case 'r':
+       return EAF_NOCLOBBER | EAF_NOESCAPE;
+ 
+     case 'W':
+       return EAF_DIRECT | EAF_NOESCAPE;
+ 
+     case 'w':
+       return EAF_NOESCAPE;
+ 
+     case '.':
+     default:
+       return 0;
+     }
+ }
+ 
+ /* Detects return flags for the call STMT.  */
+ 
+ int
+ gimple_call_return_flags (const_gimple stmt)
+ {
+   tree type;
+   tree attr = NULL_TREE;
+ 
+   if (gimple_call_flags (stmt) & ECF_MALLOC)
+     return ERF_NOALIAS;
+ 
+   type = TREE_TYPE (TREE_TYPE (gimple_call_fn (stmt)));
+   attr = lookup_attribute ("fn spec", TYPE_ATTRIBUTES (type));
+   if (!attr)
+     return 0;
+ 
+   attr = TREE_VALUE (TREE_VALUE (attr));
+   if (TREE_STRING_LENGTH (attr) < 1)
+     return 0;
+ 
+   switch (TREE_STRING_POINTER (attr)[0])
+     {
+     case '1':
+     case '2':
+     case '3':
+     case '4':
+       return ERF_RETURNS_ARG | (TREE_STRING_POINTER (attr)[0] - '1');
+ 
+     case 'm':
+       return ERF_NOALIAS;
+ 
+     case '.':
+     default:
+       return 0;
+     }
+ }
  
  /* Return true if GS is a copy assignment.  */
  
Index: trunk/gcc/gimple.h
===================================================================
*** trunk.orig/gcc/gimple.h	2010-05-06 11:41:08.000000000 +0200
--- trunk/gcc/gimple.h	2010-05-06 11:43:07.000000000 +0200
*************** void gimple_seq_free (gimple_seq);
*** 857,862 ****
--- 857,864 ----
  void gimple_seq_add_seq (gimple_seq *, gimple_seq);
  gimple_seq gimple_seq_copy (gimple_seq);
  int gimple_call_flags (const_gimple);
+ int gimple_call_return_flags (const_gimple);
+ int gimple_call_arg_flags (const_gimple, unsigned);
  void gimple_call_reset_alias_info (gimple);
  bool gimple_assign_copy_p (gimple);
  bool gimple_assign_ssa_name_copy_p (gimple);
Index: trunk/gcc/tree-ssa-alias.c
===================================================================
*** trunk.orig/gcc/tree-ssa-alias.c	2010-05-06 11:41:08.000000000 +0200
--- trunk/gcc/tree-ssa-alias.c	2010-05-06 11:43:07.000000000 +0200
*************** process_args:
*** 1097,1102 ****
--- 1097,1106 ----
    for (i = 0; i < gimple_call_num_args (call); ++i)
      {
        tree op = gimple_call_arg (call, i);
+       int flags = gimple_call_arg_flags (call, i);
+ 
+       if (flags & EAF_UNUSED)
+ 	continue;
  
        if (TREE_CODE (op) == WITH_SIZE_EXPR)
  	op = TREE_OPERAND (op, 0);
Index: trunk/gcc/tree.h
===================================================================
*** trunk.orig/gcc/tree.h	2010-05-06 11:41:08.000000000 +0200
--- trunk/gcc/tree.h	2010-05-06 11:43:07.000000000 +0200
*************** extern tree build_duplicate_type (tree);
*** 5168,5173 ****
--- 5168,5197 ----
  extern int flags_from_decl_or_type (const_tree);
  extern int call_expr_flags (const_tree);
  
+ /* Call argument flags.  */
+ 
+ /* Nonzero if the argument is not dereferenced recursively, thus only
+    directly reachable memory is read or written.  */
+ #define EAF_DIRECT		(1 << 0)
+ /* Nonzero if memory reached by the argument is not clobbered.  */
+ #define EAF_NOCLOBBER		(1 << 1)
+ /* Nonzero if the argument does not escape.  */
+ #define EAF_NOESCAPE		(1 << 2)
+ /* Nonzero if the argument is not used by the function.  */
+ #define EAF_UNUSED		(1 << 3)
+ 
+ /* Call return flags.  */
+ 
+ /* Mask for the argument number that is returned.  Lower two bits of
+    the return flags, encodes argument slots zero to three.  */
+ #define ERF_RETURN_ARG_MASK	(3)
+ /* Nonzero if the return value is equal to the argument number
+    flags & ERF_RETURN_ARG_MASK.  */
+ #define ERF_RETURNS_ARG		(1 << 2)
+ /* Nonzero if the return value does not alias with anything.  Functions
+    with the malloc attribute have this set on their return value.  */
+ #define ERF_NOALIAS		(1 << 3)
+ 
  extern int setjmp_call_p (const_tree);
  extern bool gimple_alloca_call_p (const_gimple);
  extern bool alloca_call_p (const_tree);
Index: trunk/gcc/fortran/trans-decl.c
===================================================================
*** trunk.orig/gcc/fortran/trans-decl.c	2010-04-30 10:17:23.000000000 +0200
--- trunk/gcc/fortran/trans-decl.c	2010-05-06 12:26:37.000000000 +0200
*************** gfc_get_fake_result_decl (gfc_symbol * s
*** 2317,2338 ****
  /* Builds a function decl.  The remaining parameters are the types of the
     function arguments.  Negative nargs indicates a varargs function.  */
  
! tree
! gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...)
  {
    tree arglist;
    tree argtype;
    tree fntype;
    tree fndecl;
-   va_list p;
    int n;
  
    /* Library functions must be declared with global scope.  */
    gcc_assert (current_function_decl == NULL_TREE);
  
-   va_start (p, nargs);
- 
- 
    /* Create a list of the argument types.  */
    for (arglist = NULL_TREE, n = abs (nargs); n > 0; n--)
      {
--- 2317,2335 ----
  /* Builds a function decl.  The remaining parameters are the types of the
     function arguments.  Negative nargs indicates a varargs function.  */
  
! static tree
! gfc_build_library_function_decl_1 (tree name, const char *spec,
! 				   tree rettype, int nargs, va_list p)
  {
    tree arglist;
    tree argtype;
    tree fntype;
    tree fndecl;
    int n;
  
    /* Library functions must be declared with global scope.  */
    gcc_assert (current_function_decl == NULL_TREE);
  
    /* Create a list of the argument types.  */
    for (arglist = NULL_TREE, n = abs (nargs); n > 0; n--)
      {
*************** gfc_build_library_function_decl (tree na
*** 2348,2353 ****
--- 2345,2358 ----
  
    /* Build the function type and decl.  */
    fntype = build_function_type (rettype, arglist);
+   if (spec)
+     {
+       tree attr_args = build_tree_list (NULL_TREE,
+ 					build_string (strlen (spec), spec));
+       tree attrs = tree_cons (get_identifier ("fn spec"),
+ 			      attr_args, TYPE_ATTRIBUTES (fntype));
+       fntype = build_type_attribute_variant (fntype, attrs);
+     }
    fndecl = build_decl (input_location,
  		       FUNCTION_DECL, name, fntype);
  
*************** gfc_build_library_function_decl (tree na
*** 2355,2362 ****
    DECL_EXTERNAL (fndecl) = 1;
    TREE_PUBLIC (fndecl) = 1;
  
-   va_end (p);
- 
    pushdecl (fndecl);
  
    rest_of_decl_compilation (fndecl, 1, 0);
--- 2360,2365 ----
*************** gfc_build_library_function_decl (tree na
*** 2364,2369 ****
--- 2367,2403 ----
    return fndecl;
  }
  
+ /* Builds a function decl.  The remaining parameters are the types of the
+    function arguments.  Negative nargs indicates a varargs function.  */
+ 
+ tree
+ gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...)
+ {
+   tree ret;
+   va_list args;
+   va_start (args, nargs);
+   ret = gfc_build_library_function_decl_1 (name, NULL, rettype, nargs, args);
+   va_end (args);
+   return ret;
+ }
+ 
+ /* Builds a function decl.  The remaining parameters are the types of the
+    function arguments.  Negative nargs indicates a varargs function.
+    The SPEC parameter specifies the function argument and return type
+    specification according to the fnspec function type attribute.  */
+ 
+ static tree
+ gfc_build_library_function_decl_with_spec (tree name, const char *spec,
+ 					   tree rettype, int nargs, ...)
+ {
+   tree ret;
+   va_list args;
+   va_start (args, nargs);
+   ret = gfc_build_library_function_decl_1 (name, spec, rettype, nargs, args);
+   va_end (args);
+   return ret;
+ }
+ 
  static void
  gfc_build_intrinsic_function_decls (void)
  {
*************** gfc_build_builtin_function_decls (void)
*** 2821,2832 ****
      gfc_build_library_function_decl (get_identifier (PREFIX("set_max_subrecord_length")),
  				     void_type_node, 1, integer_type_node);
  
!   gfor_fndecl_in_pack = gfc_build_library_function_decl (
!         get_identifier (PREFIX("internal_pack")),
          pvoid_type_node, 1, pvoid_type_node);
  
!   gfor_fndecl_in_unpack = gfc_build_library_function_decl (
!         get_identifier (PREFIX("internal_unpack")),
          void_type_node, 2, pvoid_type_node, pvoid_type_node);
  
    gfor_fndecl_associated =
--- 2855,2866 ----
      gfc_build_library_function_decl (get_identifier (PREFIX("set_max_subrecord_length")),
  				     void_type_node, 1, integer_type_node);
  
!   gfor_fndecl_in_pack = gfc_build_library_function_decl_with_spec (
!         get_identifier (PREFIX("internal_pack")), ".r",
          pvoid_type_node, 1, pvoid_type_node);
  
!   gfor_fndecl_in_unpack = gfc_build_library_function_decl_with_spec (
!         get_identifier (PREFIX("internal_unpack")), ".wR",
          void_type_node, 2, pvoid_type_node, pvoid_type_node);
  
    gfor_fndecl_associated =

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]