diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 12 | ||||
| -rw-r--r-- | libgfortran/Makefile.am | 4 | ||||
| -rw-r--r-- | libgfortran/Makefile.in | 16 | ||||
| -rw-r--r-- | libgfortran/gfortran.map | 17 | ||||
| -rw-r--r-- | libgfortran/intrinsics/iso_c_binding.c | 249 | ||||
| -rw-r--r-- | libgfortran/intrinsics/iso_c_binding.h | 70 | ||||
| -rw-r--r-- | libgfortran/intrinsics/iso_c_generated_procs.c | 264 | ||||
| -rw-r--r-- | libgfortran/io/unit.c | 24 | ||||
| -rw-r--r-- | libgfortran/libgfortran.h | 3 |
9 files changed, 636 insertions, 23 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c3d2b71..2b880c5 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,15 @@ +2007-07-01 Christopher D. Rickett <crickett@lanl.gov> + + * Makefile.in: Add support for iso_c_generated_procs.c and + iso_c_binding.c. + * Makefile.am: Ditto. + * intrinsics/iso_c_generated_procs.c: New file containing helper + functions. + * intrinsics/iso_c_binding.c: Ditto. + * intrinsics/iso_c_binding.h: New file + * gfortran.map: Include the __iso_c_binding_c_* functions. + * libgfortran.h: define GFC_NUM_RANK_BITS. + 2007-07-01 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/32239 diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 0e74530..ba81c75 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -71,9 +71,11 @@ intrinsics/getcwd.c \ intrinsics/getlog.c \ intrinsics/getXid.c \ intrinsics/hostnm.c \ -intrinsics/kill.c \ intrinsics/ierrno.c \ intrinsics/ishftc.c \ +intrinsics/iso_c_generated_procs.c \ +intrinsics/iso_c_binding.c \ +intrinsics/kill.c \ intrinsics/link.c \ intrinsics/malloc.c \ intrinsics/mvbits.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index c2acb13..5d97b90 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -194,7 +194,8 @@ am__objects_32 = associated.lo abort.lo access.lo args.lo \ reshape_generic.lo reshape_packed.lo selected_int_kind.lo \ selected_real_kind.lo stat.lo symlnk.lo system_clock.lo \ time.lo transpose_generic.lo umask.lo unlink.lo \ - unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo + unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \ + iso_c_generated_procs.lo iso_c_binding.lo am__objects_33 = am__objects_34 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \ _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \ @@ -456,9 +457,11 @@ intrinsics/getcwd.c \ intrinsics/getlog.c \ intrinsics/getXid.c \ intrinsics/hostnm.c \ -intrinsics/kill.c \ intrinsics/ierrno.c \ intrinsics/ishftc.c \ +intrinsics/iso_c_generated_procs.c \ +intrinsics/iso_c_binding.c \ +intrinsics/kill.c \ intrinsics/link.c \ intrinsics/malloc.c \ intrinsics/mvbits.c \ @@ -4295,6 +4298,15 @@ ishftc.lo: intrinsics/ishftc.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ishftc.lo `test -f 'intrinsics/ishftc.c' || echo '$(srcdir)/'`intrinsics/ishftc.c +iso_c_generated_procs.lo: intrinsics/iso_c_generated_procs.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iso_c_generated_procs.lo `test -f 'intrinsics/iso_c_generated_procs.c' || echo '$(srcdir)/'`intrinsics/iso_c_generated_procs.c + +iso_c_binding.lo: intrinsics/iso_c_binding.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iso_c_binding.lo `test -f 'intrinsics/iso_c_binding.c' || echo '$(srcdir)/'`intrinsics/iso_c_binding.c + +kill.lo: intrinsics/kill.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o kill.lo `test -f 'intrinsics/kill.c' || echo '$(srcdir)/'`intrinsics/kill.c + link.lo: intrinsics/link.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT link.lo -MD -MP -MF "$(DEPDIR)/link.Tpo" -c -o link.lo `test -f 'intrinsics/link.c' || echo '$(srcdir)/'`intrinsics/link.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/link.Tpo" "$(DEPDIR)/link.Plo"; else rm -f "$(DEPDIR)/link.Tpo"; exit 1; fi diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 6aebef3..71c809a 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1003,6 +1003,23 @@ GFORTRAN_1.0 { _gfortran_unpack0_char; _gfortran_unpack1; _gfortran_unpack1_char; + __iso_c_binding_c_associated_1; + __iso_c_binding_c_associated_2; + __iso_c_binding_c_f_pointer; + __iso_c_binding_c_f_pointer_d0; + __iso_c_binding_c_f_pointer_i1; + __iso_c_binding_c_f_pointer_i2; + __iso_c_binding_c_f_pointer_i4; + __iso_c_binding_c_f_pointer_i8; + __iso_c_binding_c_f_pointer_i16; + __iso_c_binding_c_f_pointer_r4; + __iso_c_binding_c_f_pointer_r8; + __iso_c_binding_c_f_pointer_r10; + __iso_c_binding_c_f_pointer_r16; + __iso_c_binding_c_f_pointer_u0; + __iso_c_binding_c_f_procpointer; + __iso_c_binding_c_funloc; + __iso_c_binding_c_loc; local: *; }; diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c new file mode 100644 index 0000000..3357547 --- /dev/null +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -0,0 +1,249 @@ +/* Implementation of the ISO_C_BINDING library helper functions. + Copyright (C) 2007 Free Software Foundation, Inc. + Contributed by Christopher Rickett. + +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. */ + + +/* Implement the functions and subroutines provided by the intrinsic + iso_c_binding module. */ + +#include <stdlib.h> + +#include "libgfortran.h" +#include "iso_c_binding.h" + + +/* Set the fields of a Fortran pointer descriptor to point to the + given C address. It uses c_f_pointer_u0 for the common + fields, and will set up the information necessary if this C address + is to an array (i.e., offset, type, element size). The parameter + c_ptr_in represents the C address to have Fortran point to. The + parameter f_ptr_out is the Fortran pointer to associate with the C + address. The parameter shape is a one-dimensional array of integers + specifying the upper bound(s) of the array pointed to by the given C + address, if applicable. The shape parameter is optional in Fortran, + which will cause it to come in here as NULL. The parameter type is + the type of the data being pointed to (i.e.,libgfortran.h). The + elem_size parameter is the size, in bytes, of the data element being + pointed to. If the address is for an array, then the size needs to + be the size of a single element (i.e., for an array of doubles, it + needs to be the number of bytes for the size of one double). */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape, + int type, int elemSize) +{ + if (shape != NULL) + { + f_ptr_out->offset = 0; + + /* Set the necessary dtype field for all pointers. */ + f_ptr_out->dtype = 0; + + /* Put in the element size. */ + f_ptr_out->dtype = f_ptr_out->dtype | (elemSize << GFC_DTYPE_SIZE_SHIFT); + + /* Set the data type (e.g., GFC_DTYPE_INTEGER). */ + f_ptr_out->dtype = f_ptr_out->dtype | (type << GFC_DTYPE_TYPE_SHIFT); + } + + /* Use the generic version of c_f_pointer to set common fields. */ + ISO_C_BINDING_PREFIX (c_f_pointer_u0) (c_ptr_in, f_ptr_out, shape); +} + + +/* A generic function to set the common fields of all descriptors, no + matter whether it's to a scalar or an array. Fields set are: data, + and if appropriate, rank, offset, dim[*].lbound, dim[*].ubound, and + dim[*].stride. Parameter shape is a rank 1 array of integers + containing the upper bound of each dimension of what f_ptr_out + points to. The length of this array must be EXACTLY the rank of + what f_ptr_out points to, as required by the draft (J3/04-007). If + f_ptr_out points to a scalar, then this parameter will be NULL. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + int i = 0; + int shapeSize = 0; + + GFC_DESCRIPTOR_DATA (f_ptr_out) = c_ptr_in; + + if (shape != NULL) + { + f_ptr_out->offset = 0; + shapeSize = 0; + + /* shape's length (rank of the output array) */ + shapeSize = shape->dim[0].ubound + 1 - shape->dim[0].lbound; + for (i = 0; i < shapeSize; i++) + { + /* Lower bound is 1, as specified by the draft. */ + f_ptr_out->dim[i].lbound = 1; + f_ptr_out->dim[i].ubound = ((int *) (shape->data))[i]; + } + + /* Set the offset and strides. + offset is (sum of (dim[i].lbound * dim[i].stride) for all + dims) the -1 means we'll back the data pointer up that much + perhaps we could just realign the data pointer and not change + the offset? */ + f_ptr_out->dim[0].stride = 1; + f_ptr_out->offset = f_ptr_out->dim[0].lbound * f_ptr_out->dim[0].stride; + for (i = 1; i < shapeSize; i++) + { + f_ptr_out->dim[i].stride = (f_ptr_out->dim[i-1].ubound + 1) + - f_ptr_out->dim[i-1].lbound; + f_ptr_out->offset += f_ptr_out->dim[i].lbound + * f_ptr_out->dim[i].stride; + } + + f_ptr_out->offset *= -1; + + /* All we know is the rank, so set it, leaving the rest alone. + Make NO assumptions about the state of dtype coming in! If we + shift right by TYPE_SHIFT bits we'll throw away the existing + rank. Then, shift left by the same number to shift in zeros + and or with the new rank. */ + f_ptr_out->dtype = ((f_ptr_out->dtype >> GFC_DTYPE_TYPE_SHIFT) + << GFC_DTYPE_TYPE_SHIFT) | shapeSize; + } +} + + +/* Sets the descriptor fields for a Fortran pointer to a derived type, + using c_f_pointer_u0 for the majority of the work. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_d0) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Set the common fields. */ + ISO_C_BINDING_PREFIX (c_f_pointer_u0) (c_ptr_in, f_ptr_out, shape); + + /* Preserve the size and rank bits, but reset the type. */ + if (shape != NULL) + { + f_ptr_out->dtype = f_ptr_out->dtype & (~GFC_DTYPE_TYPE_MASK); + f_ptr_out->dtype = f_ptr_out->dtype + | (GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT); + } +} + + +/* This function will change, once there is an actual f90 type for the + procedure pointer. */ + +void +ISO_C_BINDING_PREFIX (c_f_procpointer) (void *c_ptr_in, + gfc_array_void *f_ptr_out) +{ + GFC_DESCRIPTOR_DATA(f_ptr_out) = c_ptr_in; +} + + +/* Test if the given c_ptr is associated or not. This function is + called if the user only supplied one c_ptr parameter to the + c_associated function. The second argument is optional, and the + Fortran compiler will resolve the function to this version if only + one arg was given. Associated here simply means whether or not the + c_ptr is NULL or not. */ + +GFC_LOGICAL_4 +ISO_C_BINDING_PREFIX (c_associated_1) (void *c_ptr_in_1) +{ + if (c_ptr_in_1 != NULL) + return 1; + else + return 0; +} + + +/* Test if the two c_ptr arguments are associated with one another. + This version of the c_associated function is called if the user + supplied two c_ptr args in the Fortran source. According to the + draft standard (J3/04-007), if c_ptr_in_1 is NULL, the two pointers + are NOT associated. If c_ptr_in_1 is non-NULL and it is not equal + to c_ptr_in_2, then either c_ptr_in_2 is NULL or is associated with + another address; either way, the two pointers are not associated + with each other then. */ + +GFC_LOGICAL_4 +ISO_C_BINDING_PREFIX (c_associated_2) (void *c_ptr_in_1, void *c_ptr_in_2) +{ + /* Since we have the second arg, if it doesn't equal the first, + return false; true otherwise. However, if the first one is null, + then return false; otherwise compare the two ptrs for equality. */ + if (c_ptr_in_1 == NULL) + return 0; + else if (c_ptr_in_1 != c_ptr_in_2) + return 0; + else + return 1; +} + + +/* Return the C address of the given Fortran allocatable object. */ + +void * +ISO_C_BINDING_PREFIX (c_loc) (void *f90_obj) +{ + if (f90_obj == NULL) + { + runtime_error ("C_LOC: Attempt to get C address for Fortran object" + " that has not been allocated or associated"); + abort (); + } + + /* The "C" address should be the address of the object in Fortran. */ + return f90_obj; +} + + +/* Return the C address of the given Fortran procedure. This + routine is expected to return a derived type of type C_FUNPTR, + which represents the C address of the given Fortran object. */ + +void * +ISO_C_BINDING_PREFIX (c_funloc) (void *f90_obj) +{ + if (f90_obj == NULL) + { + runtime_error ("C_LOC: Attempt to get C address for Fortran object" + " that has not been allocated or associated"); + abort (); + } + + /* The "C" address should be the address of the object in Fortran. */ + return f90_obj; +} diff --git a/libgfortran/intrinsics/iso_c_binding.h b/libgfortran/intrinsics/iso_c_binding.h new file mode 100644 index 0000000..afd8552 --- /dev/null +++ b/libgfortran/intrinsics/iso_c_binding.h @@ -0,0 +1,70 @@ +/* Copyright (C) 2007 Free Software Foundation, Inc. + Contributed by Christopher Rickett. + +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, 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, 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + + +/* Declarations for ISO_C_BINDING library helper functions. */ + +#ifndef GFOR_ISO_C_BINDING_H +#define GFOR_ISO_C_BINDING_H + +#include "libgfortran.h" + +typedef struct c_ptr +{ + void *c_address; +} +c_ptr_t; + +typedef struct c_funptr +{ + void *c_address; +} +c_funptr_t; + +#define ISO_C_BINDING_PREFIX(a) __iso_c_binding_##a + +void ISO_C_BINDING_PREFIX(c_f_pointer)(void *, gfc_array_void *, + const array_t *, int, int); + +/* The second param here may change, once procedure pointers are + implemented. */ +void ISO_C_BINDING_PREFIX(c_f_procpointer) (void *, gfc_array_void *); + +GFC_LOGICAL_4 ISO_C_BINDING_PREFIX(c_associated_1) (void *); +GFC_LOGICAL_4 ISO_C_BINDING_PREFIX(c_associated_2) (void *, void *); + +void ISO_C_BINDING_PREFIX(c_f_pointer_u0) (void *, gfc_array_void *, + const array_t *); +void ISO_C_BINDING_PREFIX(c_f_pointer_d0) (void *, gfc_array_void *, + const array_t *); + +void *ISO_C_BINDING_PREFIX(c_loc) (void *); +void *ISO_C_BINDING_PREFIX(c_funloc) (void *); + +#endif diff --git a/libgfortran/intrinsics/iso_c_generated_procs.c b/libgfortran/intrinsics/iso_c_generated_procs.c new file mode 100644 index 0000000..f60b264 --- /dev/null +++ b/libgfortran/intrinsics/iso_c_generated_procs.c @@ -0,0 +1,264 @@ +/* Implementation of the ISO_C_BINDING library helper generated functions. + Copyright (C) 2007 Free Software Foundation, Inc. + Contributed by Christopher Rickett. + +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 "libgfortran.h" +#include "iso_c_binding.h" + + +/* TODO: This file needs to be finished so that a function is provided + for all possible type/kind combinations! */ + +#ifdef HAVE_GFC_INTEGER_1 +void ISO_C_BINDING_PREFIX (c_f_pointer_i1) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_INTEGER_2 +void ISO_C_BINDING_PREFIX (c_f_pointer_i2) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_INTEGER_4 +void ISO_C_BINDING_PREFIX (c_f_pointer_i4) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_INTEGER_8 +void ISO_C_BINDING_PREFIX (c_f_pointer_i8) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_INTEGER_16 +void ISO_C_BINDING_PREFIX (c_f_pointer_i16) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_REAL_4 +void ISO_C_BINDING_PREFIX (c_f_pointer_r4) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_REAL_8 +void ISO_C_BINDING_PREFIX (c_f_pointer_r8) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_REAL_10 +void ISO_C_BINDING_PREFIX (c_f_pointer_r10) (void *, gfc_array_void *, + const array_t *); +#endif +#ifdef HAVE_GFC_REAL_16 +void ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *, gfc_array_void *, + const array_t *); +#endif + + +#ifdef HAVE_GFC_INTEGER_1 +/* Set the given Fortran pointer, 'f_ptr_out', to point to the given C + address, 'c_ptr_in'. The Fortran pointer is of type integer and + kind=1. The function c_f_pointer is used to set up the pointer + descriptor. shape is a one-dimensional array of integers + specifying the upper bounds of the array pointed to by the given C + address, if applicable. 'shape' is an optional parameter in + Fortran, so if the user does not provide it, it will come in here + as NULL. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i1) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=1). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_INTEGER, + (int) sizeof (GFC_INTEGER_1)); +} +#endif + + +#ifdef HAVE_GFC_INTEGER_2 +/* Set the given Fortran pointer, 'f_ptr_out', to point to the given C + address, 'c_ptr_in'. The Fortran pointer is of type integer and + kind=2. The function c_f_pointer is used to set up the pointer + descriptor. shape is a one-dimensional array of integers + specifying the upper bounds of the array pointed to by the given C + address, if applicable. 'shape' is an optional parameter in + Fortran, so if the user does not provide it, it will come in here + as NULL. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i2) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=2). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_INTEGER, + (int) sizeof (GFC_INTEGER_2)); +} +#endif + + +#ifdef HAVE_GFC_INTEGER_4 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type integer and + kind=4. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i4) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=4). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_INTEGER, + (int) sizeof (GFC_INTEGER_4)); +} +#endif + + +#ifdef HAVE_GFC_INTEGER_8 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type integer and + kind=8. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i8) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=8). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_INTEGER, + (int) sizeof (GFC_INTEGER_8)); +} +#endif + + +#ifdef HAVE_GFC_INTEGER_16 +/* Set the given Fortran pointer, 'f_ptr_out', to point to the given C + address, 'c_ptr_in'. The Fortran pointer is of type integer and + kind=16. The function c_f_pointer is used to set up the pointer + descriptor. shape is a one-dimensional array of integers + specifying the upper bounds of the array pointed to by the given C + address, if applicable. 'shape' is an optional parameter in + Fortran, so if the user does not provide it, it will come in here + as NULL. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i16) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=16). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_INTEGER, + (int) sizeof (GFC_INTEGER_16)); +} +#endif + + +#ifdef HAVE_GFC_REAL_4 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type real and + kind=4. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_r4) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an real(kind=4). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_REAL, + (int) sizeof (GFC_REAL_4)); +} +#endif + + +#ifdef HAVE_GFC_REAL_8 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type real and + kind=8. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_r8) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an real(kind=8). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_REAL, + (int) sizeof (GFC_REAL_8)); +} +#endif + + +#ifdef HAVE_GFC_REAL_10 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type real and + kind=10. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_r10) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an real(kind=10). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_REAL, + (int) sizeof (GFC_REAL_10)); +} +#endif + + +#ifdef HAVE_GFC_REAL_16 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type real and + kind=16. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an real(kind=16). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) GFC_DTYPE_REAL, + (int) sizeof (GFC_REAL_16)); +} +#endif diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index fac67bd..9297af0 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -690,26 +690,11 @@ update_position (gfc_unit *u) must free memory allocated for the filename string. */ char * -filename_from_unit (int n) +filename_from_unit (int unit_number) { char *filename; - gfc_unit *u; - int c; - - /* Find the unit. */ - u = unit_root; - while (u != NULL) - { - c = compare (n, u->unit_number); - if (c < 0) - u = u->left; - if (c > 0) - u = u->right; - if (c == 0) - break; - } - - /* Get the filename. */ + gfc_unit *u = NULL; + u = find_unit (unit_number); if (u != NULL) { filename = (char *) get_mem (u->file_len + 1); @@ -718,5 +703,4 @@ filename_from_unit (int n) } else return (char *) NULL; -} - +}
\ No newline at end of file diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index e0801a1..f73594dc 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -321,6 +321,9 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16; #define GFC_DTYPE_TYPE_MASK 0x38 #define GFC_DTYPE_SIZE_SHIFT 6 +/* added for f03. --Rickett, 02.28.06 */ +#define GFC_NUM_RANK_BITS 3 + enum { GFC_DTYPE_UNKNOWN = 0, |