[gfortran] patch to implement malloc and free intrinsics

[FX Coudert <fxcoudert at gmail dot com>]

:ADDPATCH fortran:

This is the latest version of this patch. Regtested on i686-linux. 
Approve if you think reasonnable, or propose another patch, but I won't 
spend any more time on that. However, I'd like to stress that 
implementing MALLOC and FREE is probably something we want done before 
4.1 branches, since most codes using Cray pointers use them.

FX
2005-09-30  Francois-Xavier Coudert  <coudert@clipper.ens.fr>

	* check.c (gfc_check_malloc, gfc_check_free): New functions.
	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_MALLOC.
	* intrinsic.c (add_functions): Add symbols for MALLOC function.
	(add_subroutines): Add symbol for FREE subroutine.
	* intrinsic.h: Prototypes for gfc_check_malloc, gfc_check_free,
	gfc_resolve_malloc and gfc_resolve_free.
	* intrinsic.texi: Add doc for FREE and MALLOC intrinsics.
	* iresolve.c (gfc_resolve_malloc, gfc_resolve_free): New
	functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case for
	GFC_ISYM_MALLOC.


2005-09-30  Francois-Xavier Coudert  <coudert@clipper.ens.fr>

	* Makefile.am: Add intrinsics/malloc.c file.
	* Makefile.in: Regenerate.
	* intrinsics/malloc.c: New file, with implementations for free
	and malloc library functions.


2005-09-30  Francois-Xavier Coudert  <coudert@clipper.ens.fr>

	* gfortran.dg/malloc_free_1.f90: New test.

Index: gcc/testsuite/gfortran.dg/malloc_free_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/malloc_free_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/malloc_free_1.f90	(revision 0)
@@ -0,0 +1,11 @@
+! Test for the MALLOC and FREE intrinsics
+! If something is wrong with them, this test might segfault
+! { dg-do run }
+  integer j
+  integer*8 i8
+
+  do j = 1, 10000
+    i8 = malloc (10 * j)
+    call free (i8)
+  end do
+  end
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 105991)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -1606,6 +1606,11 @@
 
   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
 
+  add_sym_1 ("malloc", 0, 1, BT_INTEGER, ii, GFC_STD_GNU, gfc_check_malloc,
+	     NULL, gfc_resolve_malloc, a, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
+
   add_sym_2 ("matmul", 0, 1, BT_REAL, dr, GFC_STD_F95,
 	     gfc_check_matmul, NULL, gfc_resolve_matmul,
 	     ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
@@ -2131,12 +2136,13 @@
     *trim_name = "trim_name", *ut = "unit", *han = "handler",
     *sec = "seconds";
 
-  int di, dr, dc, dl;
+  int di, dr, dc, dl, ii;
 
   di = gfc_default_integer_kind;
   dr = gfc_default_real_kind;
   dc = gfc_default_character_kind;
   dl = gfc_default_logical_kind;
+  ii = gfc_index_integer_kind;
 
   add_sym_0s ("abort", 1, GFC_STD_GNU, NULL);
 
@@ -2244,6 +2250,9 @@
 	      gfc_check_flush, NULL, gfc_resolve_flush,
 	      c, BT_INTEGER, di, OPTIONAL);
 
+  add_sym_1s ("free", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
+	      NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
+
   add_sym_2s ("hostnm", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
           gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
 	      c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h	(revision 105991)
+++ gcc/fortran/intrinsic.h	(working copy)
@@ -83,6 +83,7 @@
 try gfc_check_min_max_integer (gfc_actual_arglist *);
 try gfc_check_min_max_real (gfc_actual_arglist *);
 try gfc_check_min_max_double (gfc_actual_arglist *);
+try gfc_check_malloc (gfc_expr *);
 try gfc_check_matmul (gfc_expr *, gfc_expr *);
 try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_minloc_maxloc (gfc_actual_arglist *);
@@ -134,6 +135,7 @@
 try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_exit (gfc_expr *);
 try gfc_check_flush (gfc_expr *);
+try gfc_check_free (gfc_expr *);
 try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_gerror (gfc_expr *);
 try gfc_check_getlog (gfc_expr *);
@@ -335,6 +337,7 @@
 void gfc_resolve_log (gfc_expr *, gfc_expr *);
 void gfc_resolve_log10 (gfc_expr *, gfc_expr *);
 void gfc_resolve_logical (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_malloc (gfc_expr *, gfc_expr *);
 void gfc_resolve_matmul (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_max (gfc_expr *, gfc_actual_arglist *);
 void gfc_resolve_maxloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
@@ -394,6 +397,7 @@
 void gfc_resolve_cpu_time (gfc_code *);
 void gfc_resolve_exit (gfc_code *);
 void gfc_resolve_flush (gfc_code *);
+void gfc_resolve_free (gfc_code *);
 void gfc_resolve_fstat_sub (gfc_code *);
 void gfc_resolve_gerror (gfc_code *);
 void gfc_resolve_getarg (gfc_code *);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 105991)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -363,6 +363,7 @@
   GFC_ISYM_LOC,
   GFC_ISYM_LOG10,
   GFC_ISYM_LOGICAL,
+  GFC_ISYM_MALLOC,
   GFC_ISYM_MATMUL,
   GFC_ISYM_MAX,
   GFC_ISYM_MAXLOC,
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c	(revision 105991)
+++ gcc/fortran/iresolve.c	(working copy)
@@ -912,6 +912,24 @@
 
 
 void
+gfc_resolve_malloc (gfc_expr * f, gfc_expr * size)
+{
+  if (size->ts.kind < gfc_index_integer_kind)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_index_integer_kind;
+      gfc_convert_type_warn (size, &ts, 2, 0);
+    }
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_index_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX("malloc"));
+}
+
+
+void
 gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
 {
   gfc_expr temp;
@@ -2080,6 +2098,22 @@
 
 
 void
+gfc_resolve_free (gfc_code * c)
+{
+  gfc_typespec ts;
+  gfc_expr *n;
+
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_index_integer_kind;
+  n = c->ext.actual->expr;
+  if (n->ts.kind != ts.kind)
+    gfc_convert_type (n, &ts, 2);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("free"));
+}
+
+
+void
 gfc_resolve_gerror (gfc_code * c)
 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"));
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 105991)
+++ gcc/fortran/check.c	(working copy)
@@ -1362,7 +1362,19 @@
 
 /* End of min/max family.  */
 
+try
+gfc_check_malloc (gfc_expr * size)
+{
+  if (type_check (size, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
 
+  if (scalar_check (size, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
 try
 gfc_check_matmul (gfc_expr * matrix_a, gfc_expr * matrix_b)
 {
@@ -2621,6 +2633,19 @@
 
 
 try
+gfc_check_free (gfc_expr * i)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (i, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_hostnm (gfc_expr * name)
 {
   if (type_check (name, 0, BT_CHARACTER) == FAILURE)
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(revision 105991)
+++ gcc/fortran/trans-intrinsic.c	(working copy)
@@ -3096,6 +3096,7 @@
     case GFC_ISYM_IRAND:
     case GFC_ISYM_ISATTY:
     case GFC_ISYM_LINK:
+    case GFC_ISYM_MALLOC:
     case GFC_ISYM_MATMUL:
     case GFC_ISYM_RAND:
     case GFC_ISYM_RENAME:
Index: gcc/fortran/intrinsic.texi
===================================================================
--- gcc/fortran/intrinsic.texi	(revision 105991)
+++ gcc/fortran/intrinsic.texi	(working copy)
@@ -88,9 +88,11 @@
 * @code{EXPONENT}:      EXPONENT,  Exponent function
 * @code{FLOOR}:         FLOOR,     Integer floor function
 * @code{FNUM}:          FNUM,      File number function
+* @code{FREE}:          FREE,      Memory de-allocation subroutine
 * @code{LOC}:           LOC,       Returns the address of a variable
 * @code{LOG}:           LOG,       Logarithm function
 * @code{LOG10}:         LOG10,     Base 10 logarithm function 
+* @code{MALLOC}:        MALLOC,    Dynamic memory allocation function
 * @code{REAL}:          REAL,      Convert to real type 
 * @code{SIGNAL}:        SIGNAL,    Signal handling subroutine (or function)
 * @code{SIN}:           SIN,       Sine function
@@ -1757,7 +1759,7 @@
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .80
-@item @var{X} @tab The type shall be @code{REAL} with intent out.
+@item @var{X} @tab The type shall be @code{REAL} with @code{INTENT(OUT)}.
 @end multitable
 
 @item @emph{Return value}:
@@ -2697,7 +2699,42 @@
 @end table
 
 
+@node FREE
+@section @code{FREE} --- Frees memory
+@findex @code{FREE} intrinsic
+@cindex FREE
 
+@table @asis
+@item @emph{Description}:
+Frees memory previously allocated by @code{MALLOC()}. The @code{FREE}
+intrinsic is an extension intended to be used with Cray pointers, and is
+provided in @command{gfortran} to allow user to compile legacy code. For
+new code using Fortran 95 pointers, the memory de-allocation intrinsic is
+@code{DEALLOCATE}.
+
+@item @emph{Option}:
+gnu
+
+@item @emph{Class}:
+subroutine
+
+@item @emph{Syntax}:
+@code{FREE(PTR)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .80
+@item @var{PTR} @tab The type shall be @code{INTEGER}. It represents the
+location of the memory that should be de-allocated.
+@end multitable
+
+@item @emph{Return value}:
+None
+
+@item @emph{Example}:
+See @code{MALLOC} for an example.
+@end table
+
+
 @node FLOOR
 @section @code{FLOOR} --- Integer floor function
 @findex @code{FLOOR} intrinsic
@@ -2918,6 +2955,71 @@
 @end table
 
 
+@node MALLOC
+@section @code{MALLOC} --- Allocate dynamic memory
+@findex @code{MALLOC} intrinsic
+@cindex MALLOC
+
+@table @asis
+@item @emph{Description}:
+@code{MALLOC(SIZE)} allocates @var{SIZE} bytes of dynamic memory and
+returns the address of the allocated memory. The @code{MALLOC} intrinsic
+is an extension intended to be used with Cray pointers, and is provided
+in @command{gfortran} to allow user to compile legacy code. For new code
+using Fortran 95 pointers, the memory allocation intrinsic is
+@code{ALLOCATE}.
+
+@item @emph{Option}:
+gnu
+
+@item @emph{Class}:
+non-elemental function
+
+@item @emph{Syntax}:
+@code{PTR = MALLOC(SIZE)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .80
+@item @var{SIZE} @tab The type shall be @code{INTEGER(*)}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER(K)}, with @var{K} such that
+variables of type @code{INTEGER(K)} have the same size as
+C pointers (@code{sizeof(void *)}).
+
+@item @emph{Example}:
+The following example demonstrates the use of @code{MALLOC} and
+@code{FREE} with Cray pointers. This example is intended to run on
+32-bit systems, where the default integer kind is suitable to store
+pointers; on 64-bit systems, ptr_x would need to be declared as
+@code{integer(kind=8)}.
+
+This example is not currently functionnal, as Cray pointer support is
+still lacking.
+
+@smallexample
+program test_malloc
+  integer i
+  integer ptr_x
+  real*8 x(*), z
+  pointer(ptr_x,x)
+
+  ptr_x = malloc(20*8)
+  do i = 1, 20
+    x(i) = sqrt(1.0d0 / i)
+  end do
+  z = 0
+  do i = 1, 20
+    z = z + x(i)
+    print *, z
+  end do
+  call free(ptr_x)
+end program test_malloc
+@end smallexample
+@end table
+
+
 @node REAL
 @section @code{REAL} --- Convert to real type 
 @findex @code{REAL} intrinsic
Index: libgfortran/intrinsics/malloc.c
===================================================================
--- libgfortran/intrinsics/malloc.c	(revision 0)
+++ libgfortran/intrinsics/malloc.c	(revision 0)
@@ -0,0 +1,55 @@
+/* Implementation of the MALLOC and FREE intrinsics
+   Copyright (C) 2005 Free Software Foundation, Inc.
+   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+extern void PREFIX(free) (void **);
+export_proto_np(PREFIX(free));
+
+void
+PREFIX(free) (void ** ptr)
+{
+  free (*ptr);
+}
+
+
+extern void * PREFIX(malloc) (size_t *);
+export_proto_np(PREFIX(malloc));
+
+void *
+PREFIX(malloc) (size_t * size)
+{
+  return malloc (*size);
+}
Index: libgfortran/Makefile.am
===================================================================
--- libgfortran/Makefile.am	(revision 105991)
+++ libgfortran/Makefile.am	(working copy)
@@ -63,6 +63,7 @@
 intrinsics/ierrno.c \
 intrinsics/ishftc.c \
 intrinsics/link.c \
+intrinsics/malloc.c \
 intrinsics/mvbits.c \
 intrinsics/pack_generic.c \
 intrinsics/perror.c \