diff options
author | Christopher D. Rickett <crickett@lanl.gov> | 2007-07-02 02:47:21 +0000 |
---|---|---|
committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2007-07-02 02:47:21 +0000 |
commit | a8b3b0b633eb1f33d41c8f49a77641d4f767cd01 (patch) | |
tree | ac4b8eff52a0e3e3d04868300cc36392b6ca3faa /libgfortran/intrinsics | |
parent | 5edfe9e86fb349a11ad604074fcbdfc917f3c04a (diff) | |
download | gcc-a8b3b0b633eb1f33d41c8f49a77641d4f767cd01.zip gcc-a8b3b0b633eb1f33d41c8f49a77641d4f767cd01.tar.gz gcc-a8b3b0b633eb1f33d41c8f49a77641d4f767cd01.tar.bz2 |
[multiple changes]
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.
From-SVN: r126185
Diffstat (limited to 'libgfortran/intrinsics')
-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 |
3 files changed, 583 insertions, 0 deletions
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 |