Re: [gfortran] Add malloc and free intrinsics

[François-Xavier Coudert <fxcoudert at gmail dot com>]

OK, round 2.

I updated the documentation so that it mentions that Cray pointers are
not yet supported, so that the example is not working yet; it says
that the example is for 32-bit systems, and indicates that MALLOC/FREE
are here to support legacy code, and hints that the Fortran 95
intrinsics to do memory allocation are ALLOCATE/DEALLOCATE.

I changed the testsuite file so that it uses integer*8, that works on
both 32- and 64-bit systems.

Any more comments?

FX

Index: gcc/fortran/check.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/check.c,v
retrieving revision 1.34
diff -u -3 -p -p -u -r1.34 check.c
--- gcc/fortran/check.c	17 Sep 2005 18:57:59 -0000	1.34
+++ gcc/fortran/check.c	26 Sep 2005 13:03:57 -0000
@@ -1339,6 +1339,18 @@ gfc_check_min_max_double (gfc_actual_arg
 
 /* 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)
@@ -2541,6 +2553,19 @@ gfc_check_flush (gfc_expr * unit)
     return FAILURE;
 
   if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+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;
Index: gcc/fortran/gfortran.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.87
diff -u -3 -p -p -u -r1.87 gfortran.h
--- gcc/fortran/gfortran.h	17 Sep 2005 18:57:59 -0000	1.87
+++ gcc/fortran/gfortran.h	26 Sep 2005 13:03:57 -0000
@@ -353,6 +353,7 @@ enum gfc_generic_isym_id
   GFC_ISYM_LOG,
   GFC_ISYM_LOG10,
   GFC_ISYM_LOGICAL,
+  GFC_ISYM_MALLOC,
   GFC_ISYM_MATMUL,
   GFC_ISYM_MAX,
   GFC_ISYM_MAXLOC,
Index: gcc/fortran/intrinsic.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.55
diff -u -3 -p -p -u -r1.55 intrinsic.c
--- gcc/fortran/intrinsic.c	22 Sep 2005 19:00:22 -0000	1.55
+++ gcc/fortran/intrinsic.c	26 Sep 2005 13:03:57 -0000
@@ -1605,6 +1605,11 @@ add_functions (void)
 
   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);
@@ -2116,12 +2121,13 @@ add_subroutines (void)
     *val = "value", *num = "number", *name = "name",
     *trim_name = "trim_name", *ut = "unit";
 
-  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);
 
@@ -2223,6 +2229,9 @@ add_subroutines (void)
   add_sym_1s ("flush", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      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,
Index: gcc/fortran/intrinsic.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.33
diff -u -3 -p -p -u -r1.33 intrinsic.h
--- gcc/fortran/intrinsic.h	22 Sep 2005 19:00:23 -0000	1.33
+++ gcc/fortran/intrinsic.h	26 Sep 2005 13:03:57 -0000
@@ -82,6 +82,7 @@ try gfc_check_min_max (gfc_actual_arglis
 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 *);
@@ -131,6 +132,7 @@ try gfc_check_system_clock (gfc_expr *, 
 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 *);
@@ -330,6 +332,7 @@ void gfc_resolve_link (gfc_expr *, gfc_e
 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 *);
@@ -387,6 +390,7 @@ void gfc_resolve_chdir_sub (gfc_code *);
 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/intrinsic.texi
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/intrinsic.texi,v
retrieving revision 1.17
diff -u -3 -p -r1.17 intrinsic.texi
--- gcc/fortran/intrinsic.texi	22 Sep 2005 19:00:23 -0000	1.17
+++ gcc/fortran/intrinsic.texi	28 Sep 2005 12:21:18 -0000
@@ -85,10 +85,12 @@ and editing.  All contributions and corr
 * @code{EXIT}:          EXIT,      Exit the program with status.
 * @code{EXP}:           EXP,       Exponential function
 * @code{EXPONENT}:      EXPONENT,  Exponent function
+* @code{FREE}:          FREE,      Memory de-allocation subroutine
 * @code{FLOOR}:         FLOOR,     Integer floor function
 * @code{FNUM}:          FNUM,      File number function
 * @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{SQRT}:          SQRT,      Square-root function
 * @code{SIN}:           SIN,       Sine function
@@ -1704,7 +1706,7 @@ subroutine
 
 @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}:
@@ -2644,6 +2646,41 @@ end program test_exponent
 @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
@@ -2826,6 +2863,71 @@ end program test_log10
 @item @code{ALOG10(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab f95, gnu
 @item @code{DLOG10(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab f95, gnu
 @end multitable
+@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
 
 
Index: gcc/fortran/iresolve.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.40
diff -u -3 -p -p -u -r1.40 iresolve.c
--- gcc/fortran/iresolve.c	22 Sep 2005 19:00:23 -0000	1.40
+++ gcc/fortran/iresolve.c	26 Sep 2005 13:03:58 -0000
@@ -871,6 +871,24 @@ gfc_resolve_logical (gfc_expr * f, gfc_e
 
 
 void
+gfc_resolve_malloc (gfc_expr * f, gfc_expr * size)
+{
+  if (size->ts.kind < gfc_default_integer_kind)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_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_i%d"), size->ts.kind);
+}
+
+
+void
 gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
 {
   gfc_expr temp;
@@ -1938,6 +1956,22 @@ gfc_resolve_flush (gfc_code * c)
 
   name = gfc_get_string (PREFIX("flush_i%d"), ts.kind);
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+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"));
 }
 
 
Index: gcc/fortran/trans-intrinsic.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.54
diff -u -3 -p -p -u -r1.54 trans-intrinsic.c
--- gcc/fortran/trans-intrinsic.c	13 Sep 2005 08:07:15 -0000	1.54
+++ gcc/fortran/trans-intrinsic.c	26 Sep 2005 13:03:58 -0000
@@ -2997,6 +2997,7 @@ gfc_conv_intrinsic_function (gfc_se * se
     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: libgfortran/Makefile.am
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.42
diff -u -3 -p -p -u -r1.42 Makefile.am
--- libgfortran/Makefile.am	25 Sep 2005 21:39:55 -0000	1.42
+++ libgfortran/Makefile.am	26 Sep 2005 13:03:58 -0000
@@ -65,6 +65,7 @@ intrinsics/kill.c \
 intrinsics/ierrno.c \
 intrinsics/ishftc.c \
 intrinsics/link.c \
+intrinsics/malloc.c \
 intrinsics/mvbits.c \
 intrinsics/pack_generic.c \
 intrinsics/perror.c \
Index: libgfortran/intrinsics/malloc.c
===================================================================
RCS file: libgfortran/intrinsics/malloc.c
diff -N libgfortran/intrinsics/malloc.c
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ libgfortran/intrinsics/malloc.c	2005-09-26 14:23:13.000000000 +0200
@@ -0,0 +1,65 @@
+/* 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 * malloc_i4 (GFC_INTEGER_4 *);
+export_proto(malloc_i4);
+
+void *
+malloc_i4 (GFC_INTEGER_4 * size)
+{
+  return malloc (*size);
+}
+
+
+extern void * malloc_i8 (GFC_INTEGER_8 *);
+export_proto(malloc_i8);
+
+void *
+malloc_i8 (GFC_INTEGER_8 * size)
+{
+  return malloc (*size);
+}

Attachment: malloc.ChangeLog
Description: Binary data

Attachment: malloc_free_1.f90
Description: Binary data