diff options
author | kargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-07-02 02:47:21 +0000 |
---|---|---|
committer | kargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-07-02 02:47:21 +0000 |
commit | c5d33754e3b885a5a2f323bedaa29371f44748b3 (patch) | |
tree | ac4b8eff52a0e3e3d04868300cc36392b6ca3faa /libgfortran | |
parent | af1ff7da323f7dda32e4b0e7bda1d43fa4654252 (diff) | |
download | gcc-c5d33754e3b885a5a2f323bedaa29371f44748b3.tar.gz |
2007-07-01 Christopher D. Rickett <crickett@lanl.gov>
* interface.c (gfc_compare_derived_types): Special case for comparing
derived types across namespaces.
(gfc_compare_types): Deal with BT_VOID.
(compare_parameter): Use BT_VOID to accept ISO C Binding pointers.
* trans-expr.c (gfc_conv_function_call): Remove setting parm_kind
to SCALAR
(gfc_conv_initializer): Deal with ISO C Binding NULL_PTR and
NULL_FUNPTR.
(gfc_conv_expr): Convert expressions for ISO C Binding derived types.
* symbol.c (gfc_set_default_type): BIND(C) variables should not be
implicitly declared.
(check_conflict): Add BIND(C) and check for conflicts.
(gfc_add_explicit_interface): Whitespace.
(gfc_add_is_bind_c): New function.
(gfc_copy_attr): Use it.
(gfc_new_symbol): Initialize ISO C Binding objects.
(get_iso_c_binding_dt): New function.
(verify_bind_c_derived_type): Ditto.
(gen_special_c_interop_ptr): Ditto.
(add_formal_arg): Ditto.
(gen_cptr_param): Ditto.
(gen_fptr_param): Ditto.
(gen_shape_param): Ditto.
(add_proc_interface): Ditto.
(build_formal_args): Ditto.
(generate_isocbinding_symbol): Ditto.
(get_iso_c_sym): Ditto.
* decl.c (num_idents_on_line, has_name_equals): New variables.
(verify_c_interop_param): New function.
(build_sym): Finish binding labels and deal with COMMON blocks.
(add_init_expr_to_sym): Check if the initialized expression is
an iso_c_binding named constants
(variable_decl): Set ISO C Binding type_spec components.
(gfc_match_kind_spec): Check match for C interoperable kind.
(match_char_spec): Fix comment. Chnage gfc_match_small_int
to gfc_match_small_int_expr. Check for C interoperable kind.
(match_type_spec): Clear the current binding label.
(match_attr_spec): Add DECL_IS_BIND_C. If BIND(C) is found, use it
to set attributes.
(set_binding_label): New function.
(set_com_block_bind_c): Ditto.
(verify_c_interop): Ditto.
(verify_com_block_vars_c_interop): Ditto.
(verify_bind_c_sym): Ditto.
(set_verify_bind_c_sym): Ditto.
(set_verify_bind_c_com_block): Ditto.
(get_bind_c_idents): Ditto.
(gfc_match_bind_c_stmt): Ditto.
(gfc_match_data_decl): Use num_idents_on_line.
(match_result): Deal with right paren in BIND(C).
(gfc_match_suffix): New function.
(gfc_match_function_decl): Use it. Code is re-arranged to deal with
ISO C Binding result clauses.
(gfc_match_subroutine): Deal with BIND(C).
(gfc_match_bind_c): New function.
(gfc_get_type_attr_spec): New function. Code is re-arranged in and
taken from gfc_match_derived_decl.
(gfc_match_derived_decl): Add check for BIND(C).
* trans-common.c: Forward declare gfc_get_common.
(gfc_sym_mangled_common_id): Change arg from 'const char *name' to
'gfc_common_head *com'. Check for ISO C Binding of the common block.
(build_common_decl): 'com->name' to 'com in SET_DECL_ASSEMBLER_NAME.
* gfortran.h: Add GFC_MAX_BINDING_LABEL_LEN
(bt): Add BT_VOID
(sym_flavor): Add FL_VOID.
(iso_fortran_env_symbol, iso_c_binding_symbol, intmod_id): New enum
(CInteropKind_t): New struct.
(c_interop_kinds_table): Use it. Declare an array of structs.
(symbol_attribute): Add is_bind_c, is_c_interop, and is_iso_c
bitfields.
(gfc_typespec): Add is_c_interop; is_iso_c, and f90_type members.
(gfc_symbol): Add from_intmod, intmod_sym_id, binding_label, and
common_block members.
(gfc_common_head): Add binding_label and is_bind_c members.
(gfc_gsymbol): Add sym_name, mod_name, and binding_label members.
Add prototypes for get_c_kind, gfc_validate_c_kind,
gfc_check_any_c_kind, gfc_add_is_bind_c, gfc_add_value,
verify_c_interop, verify_c_interop_param, verify_bind_c_sym,
verify_bind_c_derived_type, verify_com_block_vars_c_interop,
generate_isocbinding_symbol, get_iso_c_sym, gfc_iso_c_sub_interface
* iso-c-binding.def: New file. This file contains the definitions
of the types provided by the Fortran 2003 ISO_C_BINDING intrinsic
module.
* trans-const.c (gfc_conv_constant_to_tree): Deal with C_NULL_PTR
or C_NULL_FUNPTR expressions.
* expr.c (gfc_copy_expr): Add BT_VOID case. For BT_CHARACTER, the
ISO C Binding requires a minimum string length of 1 for '\0'.
* module.c (intmod_sym): New struct.
(pointer_info): Add binding_label member.
(write_atom): Set len to 0 for NULL pointers. Check for NULL p and *p.
(ab_attribute): Add AB_IS_BIND_C, AB_IS_C_INTEROP and AB_IS_ISO_C.
(attr_bits): Add "IS_BIND_C", "IS_C_INTEROP", and "IS_ISO_C".
(mio_symbol_attribute): Deal with ISO C Binding attributes.
(bt_types): Add "VOID".
(mio_typespec): Deal with ISO C Binding components.
(mio_namespace_ref): Add intmod variable.
(mio_symbol): Check for symbols from an intrinsic module.
(load_commons): Check for BIND(C) common block.
(read_module): Read binding_label and use it.
(write_common): Add label. Write BIND(C) info.
(write_blank_common): Blank commons are not BIND(C). Explicitly
set is_bind_c=0.
(write_symbol): Deal with binding_label.
(sort_iso_c_rename_list): New function.
(import_iso_c_binding_module): Ditto.
(create_int_parameter): Add to args.
(use_iso_fortran_env_module): Adjust to deal with iso_c_binding
intrinsic module.
* trans-types.c (c_interop_kinds_table): new array of structs.
(gfc_validate_c_kind): New function.
(gfc_check_any_c_kind): Ditto.
(get_real_kind_from_node): Ditto.
(get_int_kind_from_node): Ditto.
(get_int_kind_from_width): Ditto.
(get_int_kind_from_minimal_width): Ditto.
(init_c_interop_kinds): Ditto.
(gfc_init_kinds): call init_c_interop_kinds.
(gfc_typenode_for_spec): Adjust for BT_VOID and ISO C Binding pointers.
Adjust handling of BT_DERIVED.
(gfc_sym_type): Whitespace.
(gfc_get_derived_type): Account for iso_c_binding derived types
* resolve.c (is_scalar_expr_ptr): New function.
(gfc_iso_c_func_interface): Ditto.
(resolve_function): Use gfc_iso_c_func_interface.
(set_name_and_label): New function.
(gfc_iso_c_sub_interface): Ditto.
(resolve_specific_s0): Use gfc_iso_c_sub_interface.
(resolve_bind_c_comms): New function.
(resolve_bind_c_derived_types): Ditto.
(gfc_verify_binding_labels): Ditto.
(resolve_fl_procedure): Check for ISO C interoperability.
(resolve_symbol): Check C interoperability.
(resolve_types): Walk the namespace. Check COMMON blocks.
* trans-decl.c (gfc_sym_mangled_identifier): Prevent the mangling
of identifiers that have an assigned binding label.
(gfc_sym_mangled_function_id): Use the binding label rather than
the mangled name.
(gfc_finish_var_decl): Put variables that are BIND(C) into a common
segment of the object file, because this is what C would do.
(gfc_create_module_variable): Conver to proper types
(set_tree_decl_type_code): New function.
(generate_local_decl): Check dummy variables and derived types for
ISO C Binding attributes.
* match.c (gfc_match_small_int_expr): New function.
(gfc_match_name_C): Ditto.
(match_common_name): Deal with ISO C Binding in COMMON blocks
* trans-io.c (transfer_expr): Deal with C_NULL_PTR or C_NULL_FUNPTR
expressions
* match.h: Add prototypes for gfc_match_small_int_expr,
gfc_match_name_C, match_common_name, set_com_block_bind_c,
set_binding_label, set_verify_bind_c_sym,
set_verify_bind_c_com_block, get_bind_c_idents,
gfc_match_bind_c_stmt, gfc_match_suffix, gfc_match_bind_c,
gfc_get_type_attr_spec
* parse.c (decode_statement): Use gfc_match_bind_c_stmt
(parse_derived): Init *derived_sym = NULL, and gfc_current_block
later for valiadation.
* primary.c (got_delim): Set ISO C Binding components of ts.
(match_logical_constant): Ditto.
(match_complex_constant): Ditto.
(match_complex_constant): Ditto.
(gfc_match_rvalue): Check for existence of at least one arg for
C_LOC, C_FUNLOC, and C_ASSOCIATED.
* misc.c (gfc_clear_ts): Clear ISO C Bindoing components in ts.
(get_c_kind): New function.
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-06-23 Christopher D. Rickett <crickett@lanl.gov>
* bind_c_array_params.f03: New files for Fortran 2003 ISO C Binding.
* bind_c_coms.f90: Ditto.
* bind_c_coms_driver.c: Ditto.
* bind_c_dts.f90: Ditto.
* bind_c_dts_2.f03: Ditto.
* bind_c_dts_2_driver.c: Ditto.
* bind_c_dts_3.f03: Ditto.
* bind_c_dts_4.f03: Ditto.
* bind_c_dts_driver.c: Ditto.
* bind_c_implicit_vars.f03: Ditto.
* bind_c_procs.f03: Ditto.
* bind_c_usage_2.f03: Ditto.
* bind_c_usage_3.f03: Ditto.
* bind_c_usage_5.f03: Ditto.
* bind_c_usage_6.f03: Ditto.
* bind_c_usage_7.f03: Ditto.
* bind_c_vars.f90: Ditto.
* bind_c_vars_driver.c: Ditto.
* binding_c_table_15_1.f03: Ditto.
* binding_label_tests.f03: Ditto.
* binding_label_tests_10.f03: Ditto.
* binding_label_tests_10_main.f03: Ditto.
* binding_label_tests_11.f03: Ditto.
* binding_label_tests_11_main.f03: Ditto.
* binding_label_tests_12.f03: Ditto.
* binding_label_tests_13.f03: Ditto.
* binding_label_tests_13_main.f03: Ditto.
* binding_label_tests_14.f03: Ditto.
* binding_label_tests_2.f03: Ditto.
* binding_label_tests_3.f03: Ditto.
* binding_label_tests_4.f03: Ditto.
* binding_label_tests_5.f03: Ditto.
* binding_label_tests_6.f03: Ditto.
* binding_label_tests_7.f03: Ditto.
* binding_label_tests_8.f03: Ditto.
* binding_label_tests_9.f03: Ditto.
* c_assoc.f90: Ditto.
* c_assoc_2.f03: Ditto.
* c_f_pointer_shape_test.f90: Ditto.
* c_f_pointer_tests.f90: Ditto.
* c_f_tests_driver.c: Ditto.
* c_funloc_tests.f03: Ditto.
* c_funloc_tests_2.f03: Ditto.
* c_funloc_tests_3.f03: Ditto.
* c_funloc_tests_3_funcs.c: Ditto.
* c_kind_params.f90: Ditto.
* c_kind_tests_2.f03: Ditto.
* c_kinds.c: Ditto.
* c_loc_driver.c: Ditto.
* c_loc_test.f90: Ditto.
* c_loc_tests_2.f03: Ditto.
* c_loc_tests_2_funcs.c: Ditto.
* c_loc_tests_3.f03: Ditto.
* c_loc_tests_4.f03: Ditto.
* c_loc_tests_5.f03: Ditto.
* c_loc_tests_6.f03: Ditto.
* c_loc_tests_7.f03: Ditto.
* c_loc_tests_8.f03: Ditto.
* c_ptr_tests.f03: Ditto.
* c_ptr_tests_10.f03: Ditto.
* c_ptr_tests_5.f03: Ditto.
* c_ptr_tests_7.f03: Ditto.
* c_ptr_tests_7_driver.c: Ditto.
* c_ptr_tests_8.f03: Ditto.
* c_ptr_tests_8_funcs.c: Ditto.
* c_ptr_tests_9.f03: Ditto.
* c_ptr_tests_driver.c: Ditto.
* c_size_t_driver.c: Ditto.
* c_size_t_test.f03: Ditto.
* com_block_driver.f90: Ditto.
* global_vars_c_init.f90: Ditto.
* global_vars_c_init_driver.c: Ditto.
* global_vars_f90_init.f90: Ditto.
* global_vars_f90_init_driver.c: Ditto.
* interop_params.f03: Ditto.
* iso_c_binding_only.f03: Ditto.
* iso_c_binding_rename_1.f03: Ditto.
* iso_c_binding_rename_1_driver.c: Ditto.
* iso_c_binding_rename_2.f03: Ditto.
* iso_c_binding_rename_2_driver.c: Ditto.
* kind_tests_2.f03: Ditto.
* kind_tests_3.f03: Ditto.
* module_md5_1.f90: Ditto.
* only_clause_main.c: Ditto.
* print_c_kinds.f90: Ditto.
* test_bind_c_parens.f03: Ditto.
* test_c_assoc.c: Ditto.
* test_com_block.f90: Ditto.
* test_common_binding_labels.f03: Ditto.
* test_common_binding_labels_2.f03: Ditto.
* test_common_binding_labels_2_main.f03: Ditto.
* test_common_binding_labels_3.f03: Ditto.
* test_common_binding_labels_3_main.f03: Ditto.
* test_only_clause.f90: Ditto.
* use_iso_c_binding.f90: Ditto.
* value_5.f90: Ditto.
* value_test.f90: Ditto.
* value_tests_f03.f90: Ditto.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126185 138bc75d-0d04-0410-961f-82ee72b054a4
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 c3d2b7165af..2b880c531d8 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 0e745300172..ba81c75f238 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 c2acb1353a7..5d97b903ddc 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 6aebef3cb82..71c809a11f5 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 00000000000..33575475aa6 --- /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 00000000000..afd85529e9d --- /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 00000000000..f60b264dba6 --- /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 fac67bdaf7e..9297af08521 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 e0801a14d16..f73594dc4d7 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, |