diff -Nrcpad gcc-4.0.2/gcc/fortran/.cvsignore gcc-4.1.0/gcc/fortran/.cvsignore *** gcc-4.0.2/gcc/fortran/.cvsignore Thu May 13 06:40:29 2004 --- gcc-4.1.0/gcc/fortran/.cvsignore Thu Jan 1 00:00:00 1970 *************** *** 1 **** - gfortran.info* --- 0 ---- diff -Nrcpad gcc-4.0.2/gcc/fortran/ChangeLog gcc-4.1.0/gcc/fortran/ChangeLog *** gcc-4.0.2/gcc/fortran/ChangeLog Wed Sep 21 03:56:59 2005 --- gcc-4.1.0/gcc/fortran/ChangeLog Tue Feb 28 08:28:14 2006 *************** *** 1,24 **** ! 2005-09-20 Release Manager ! * GCC 4.0.2 released. ! 2005-09-13 Paul Thomas PR fortran/19358 * trans-array.c (gfc_trans_dummy_array_bias): correct the typo which uses dim[i].upper for lbound, rather than dim[i].lower. ! 2005-09-10 Volker Reichelt ! PR fortran/22502 ! Backport: ! 2005-07-29 Steven Bosscher ! * trans-types.h (gfc_array_range_type): Add missing GTY decl for this. 2005-09-09 Thomas Koenig ! * io.c (gfc_resolve_filepos): Also resolve iostat. 2005-09-09 Paul Thomas --- 1,1907 ---- ! 2006-02-28 Release Manager ! * GCC 4.1.0 released. ! 2006-02-20 Erik Edelmann ! ! PR fortran/26201 ! * intrinsic.c (gfc_convert_type_warn): Call ! gfc_intrinsic_symbol() on the newly created symbol. ! ! 2006-02-14 Erik Edelmann ! ! PR fortran/25806 ! * trans-array.c (gfc_trans_allocate_array_storage): New argument ! dealloc; free the temporary only if dealloc is true. ! (gfc_trans_allocate_temp_array): New argument bool dealloc, to be ! passed onwards to gfc_trans_allocate_array_storage. ! (gfc_trans_array_constructor, gfc_conv_loop_setup): Update call to ! gfc_trans_allocate_temp_array. ! * trans-array.h (gfc_trans_allocate_temp_array): Update function ! prototype. ! * trans-expr.c (gfc_conv_function_call): Set new argument 'dealloc' ! to gfc_trans_allocate_temp_array to false in case of functions ! returning pointers. ! (gfc_trans_arrayfunc_assign): Return NULL for functions returning ! pointers. ! ! 2006-02-14 Francois-Xavier Coudert ! ! PR libfortran/25425 ! * trans-decl.c (gfc_generate_function_code): Add new argument, ! pedantic, to set_std call. ! ! 2006-02-13 Paul Thomas ! ! PR fortran/26074 ! PR fortran/25103 ! * resolve.c (resolve_symbol): Extend the requirement that module ! arrays have constant bounds to those in the main program. At the ! same time simplify the array bounds, to avoiding trapping parameter ! array references, and exclude automatic character length from main ! and modules. Rearrange resolve_symbol and resolve_derived to put as ! each flavor together, as much as is possible and move all specific ! code for flavors FL_VARIABLE, FL_PROCEDURE and FL_PARAMETER into new ! functions. ! (resolve_fl_var_and_proc, resolve_fl_variable, resolve_fl_procedure): ! New functions to do work of resolve_symbol. ! (resolve_index_expr): New function that is called from resolved_symbol ! and is extracted from resolve_charlen. ! (resolve_charlen): Call this new function. ! (resolve_fl_derived): Renamed resolve_derived to be consistent with ! the naming of the new functions for the other flavours. Change the ! charlen checking so that the style is consistent with other similar ! checks. Add the generation of the gfc_dt_list, removed from resolve_ ! symbol. ! ! PR fortran/20861 ! * resolve.c (resolve_actual_arglist): Prevent internal procedures ! from being dummy arguments. ! ! PR fortran/20871 ! * resolve.c (resolve_actual_arglist): Prevent pure but non-intrinsic ! procedures from being dummy arguments. ! ! PR fortran/25083 ! * resolve.c (check_data_variable): Add test that data variable is in ! COMMON. ! ! PR fortran/25088 ! * resolve.c (resolve_call): Add test that the subroutine does not ! have a type. ! ! 2006-02-13 Paul Thomas ! ! PR fortran/26038 ! * trans-stmt.c (gfc_trans_allocate): Provide assumed character length ! scalar with missing backend_decl for the hidden dummy charlen. ! ! PR fortran/25059 ! * interface.c (gfc_extend_assign): Remove detection of non-PURE ! subroutine in assignment interface, with gfc_error, and put it in ! * resolve.c (resolve_code). ! ! PR fortran/25070 ! * interface.c (gfc_procedure_use): Flag rank checking for non- ! elemental, contained or interface procedures in call to ! (compare_actual_formal), where ranks are checked for assumed ! shape arrays.. ! ! 2006-02-11 Tobias Schlüter ! ! Backport r110819 and r110840 from the trunk ! PR fortran/14771 ! * gfortran.h (gfc_intrinsic_op): Add INTRINSIC_PARENTHESES. ! * dump-parse-tree (gfc_show_expr): Handle INTRINSIC_PARENTHESES. ! * expr.c (simplify_intrinsic_op): Treat INTRINSIC_PARENTHESES as ! if it were INTRINSIC_UPLUS. ! * resolve.c (resolve_operator): Handle INTRINSIC_PARENTHESES. ! * match.c (intrinsic_operators): Add INTRINSIC_PARENTHESES. ! * matchexp.c (match_primary): Record parentheses surrounding ! numeric expressions. ! * module.c (intrinsics): Add INTRINSIC_PARENTHESES for module ! dumping. ! * trans-expr.c (gfc_conv_expr_op): Handle INTRINSIC_PARENTHESES. ! ! PR fortran/14771 ! * arith.c (eval_intrinsic): Accept INTRINSIC_PARENTHESES. ! * expr.c (check_intrinsic_op): Likewise. ! * module.c (mio_expr): Likewise. ! ! 2006-02-10 Steven G. Kargl ! ! PR fortran/25756 ! * symbol.c (gfc_free_st_label): Give variable meaningful name. Remove ! unneeded parenthesis. Fix-up the head of the list (2 lines gleaned ! from g95). ! ! 2006-02-10 Steven G. Kargl ! ! PR fortran/20858 ! *decl.c (variable_decl): Improve error message. Remove initialization ! typespec. Wrap long line. ! *expr.c (gfc_check_pointer_assign): Permit checking of type, kind type, ! and rank. ! *simplify.c (gfc_simplify_null): Ensure type, kind type, and rank ! are set. ! ! ! 2005-02-08 Thomas Koenig ! ! PR libfortran/23815 ! * gfortran.texi: Document the GFORTRAN_CONVERT_UNIT environment ! variable. ! * invoke.texi: Mention the "Runtime" chapter. ! Document the -fconvert= option. ! * gfortran.h: Add options_convert. ! * lang.opt: Add fconvert=little-endian, fconvert=big-endian, ! fconvert=native and fconvert=swap. ! * trans-decl.c (top level): Add gfor_fndecl_set_convert. ! (gfc_build_builtin_function_decls): Set gfor_fndecl_set_convert. ! (gfc_generate_function_code): If -fconvert was specified, ! and this is the main program, add a call to set_convert(). ! * options.c: Handle the -fconvert options. ! ! 2006-02-05 Jakub Jelinek ! ! * resolve.c (resolve_symbol): Initialize constructor_expr to NULL. ! ! 2006-02-04 Thomas Koenig ! ! PR fortran/26039 ! PR fortran/25046 ! * expr.c (gfc_check_conformance): Reorder error message ! to avoid plural. ! * check.c(gfc_check_minloc_maxloc): Call gfc_check_conformance ! for checking arguments array and mask. ! (check_reduction): Likewise. ! ! 2006-02-03 Steven G. Kargl ! Paul Thomas ! ! PR fortran/20845 ! * resolve.c (resolve_symbol): Default initialization of derived type ! component reguires the SAVE attribute. ! ! 2006-02-02 Steven G. Kargl ! ! PR fortran/24958 ! match.c (gfc_match_nullify): Free the list from head not tail. ! ! PR fortran/25072 ! * match.c (match_forall_header): Fix internal error caused by bogus ! gfc_epxr pointers. ! ! 2005-01-31 Erik Edelmann ! ! PR fortran/24266 ! * trans-io.c (set_internal_unit): Check the rank of the ! expression node itself instead of its symbol. ! ! 2006-01-30 Paul Thomas ! ! PR fortran/18578 ! PR fortran/18579 ! PR fortran/20857 ! PR fortran/20885 ! * interface.c (compare_actual_formal): Error for INTENT(OUT or INOUT) ! if actual argument is not a variable. ! ! PR fortran/17911 ! * expr.c (gfc_check_assign, gfc_check_pointer_assign): Emit error if ! the lvalue is a use associated procedure. ! ! PR fortran/20895 ! PR fortran/25030 ! * expr.c (gfc_check_pointer_assign): Emit error if lvalue and rvalue ! character lengths are not the same. Use gfc_dep_compare_expr for the ! comparison. ! * gfortran.h: Add prototype for gfc_dep_compare_expr. ! * dependency.h: Remove prototype for gfc_dep_compare_expr. ! ! 2005-01-27 Paul Thomas ! ! PR fortran/25951 ! * resolve.c (resolve_function): Add GFC_ISYM_LOC to the list of ! generic_ids exempted from assumed size checking. ! ! PR fortran/25964 ! * resolve.c (resolve_function): Exclude statement functions from ! global reference checking. ! ! PR fortran/25084 ! PR fortran/20852 ! PR fortran/25085 ! PR fortran/25086 ! * resolve.c (resolve_function): Declare a gfc_symbol to replace the ! references through the symtree to the symbol associated with the ! function expresion. Give error on reference to an assumed character ! length function is defined in an interface or an external function ! that is not a dummy argument. ! (resolve_symbol): Give error if an assumed character length function ! is array-valued, pointer-valued, pure or recursive. Emit warning ! that character(*) value functions are obsolescent in F95. ! ! PR fortran/25416 ! * trans-expr.c (gfc_conv_function_call): The above patch to resolve.c ! prevents any assumed character length function call from getting here ! except intrinsics such as SPREAD. In this case, ensure that no ! segfault occurs from referencing non-existent charlen->length-> ! expr_type and provide a backend_decl for the charlen from the charlen ! of the first actual argument. ! ! Cure temp name confusion. ! * trans-expr.c (gfc_get_interface_mapping_array): Change name of ! temporary from "parm" to "ifm" to avoid clash with temp coming from ! trans-array.c. ! ! PR fortran/25124 ! PR fortran/25625 ! * decl.c (get_proc_name): If there is an existing ! symbol in the encompassing namespace, call errors ! if it is a procedure of the same name or the kind ! field is set, indicating a type declaration. ! ! PR fortran/20881 ! PR fortran/23308 ! PR fortran/25538 ! PR fortran/25710 ! * decl.c (add_global_entry): New function to check ! for existing global symbol with this name and to ! create new one if none exists. ! (gfc_match_entry): Call add_global_entry before ! matching argument lists for subroutine and function ! entries. ! * gfortran.h: Prototype for existing function, global_used. ! * resolve.c (resolve_global_procedure): New function ! to check global symbols for procedures. ! (resolve_call, resolve_function): Calls to this ! new function for non-contained and non-module ! procedures. ! * match.c (match_common): Add check for existing ! global symbol, creat one if none exists and emit ! error if there is a clash. ! * parse.c (global_used): Remove static and use the ! gsymbol name rather than the new_block name, so that ! the function can be called from resolve.c. ! (parse_block_data, parse_module, add_global_procedure): ! Improve checks for existing gsymbols. Emit error if ! already defined or if references were to another type. ! Set defined flag. ! ! PR fortran/24276 ! * trans-expr.c (gfc_conv_aliased_arg): New function called by ! gfc_conv_function_call that coverts an expression for an aliased ! component reference to a derived type array into a temporary array ! of the same type as the component. The temporary is passed as an ! actual argument for the procedure call and is copied back to the ! derived type after the call. ! (is_aliased_array): New function that detects an array reference ! that is followed by a component reference. ! (gfc_conv_function_call): Detect an aliased actual argument with ! is_aliased_array and convert it to a temporary and back again ! using gfc_conv_aliased_arg. ! ! 2006-01-27 Jakub Jelinek ! ! PR fortran/25324 ! * Make-lang.in (fortran/scanner.o): Depend on toplev.h. ! * lang.opt (fpreprocessed): New option. ! * scanner.c: Include toplev.h. ! (gfc_src_file, gfc_src_preprocessor_lines): New variables. ! (preprocessor_line): Unescape filename if there were any ! backslashes. ! (load_file): If initial and gfc_src_file is not NULL, ! use it rather than opening the file. If gfc_src_preprocessor_lines ! has non-NULL elements, pass it to preprocessor_line. ! (unescape_filename, gfc_read_orig_filename): New functions. ! * gfortran.h (gfc_option_t): Add flag_preprocessed. ! (gfc_read_orig_filename): New prototype. ! * options.c (gfc_init_options): Clear flag_preprocessed. ! (gfc_post_options): If flag_preprocessed, call ! gfc_read_orig_filename. ! (gfc_handle_option): Handle OPT_fpreprocessed. ! * lang-specs.h: Pass -fpreprocessed to f951 if preprocessing ! sources. ! ! 2005-01-27 Erik Edelmann ! ! PR fortran/25716 ! * symbol.c (free_old_symbol): New function. ! (gfc_commit_symbols): Use it. ! (gfc_commit_symbol): New function. ! (gfc_use_derived): Use it. ! * gfortran.h: Add prototype for gfc_commit_symbol. ! * intrinsic.c (gfc_find_function): Search in 'conversion' ! if not found in 'functions'. ! (gfc_convert_type_warn): Add a symtree to the new ! expression node, and commit the new symtree->n.sym. ! * resolve.c (gfc_resolve_index): Make sure typespec is ! properly initialized. ! ! 2005-01-25 Steven Bosscher ! Tobias Schlüter ! ! PR fortran/18540 ! * resolve.c (resolve_branch): Allow FORTRAN 66 cross-block GOTOs ! as extension. ! ! 2005-01-23 Paul Thomas ! ! Fix regression in testing of admissability of attributes. ! * symbol.c (gfc_add_attribute): If the current_attr has non-zero ! intent, do not do the check for a dummy being used. ! * decl.c (attr_decl1): Add current_attr.intent as the third argument ! in the call to gfc_add_attribute. ! * gfortran.h: Add the third argument to the prototype for ! gfc_add_attribute. ! ! 2006-01-21 Joseph S. Myers ! ! * gfortranspec.c (lang_specific_driver): Update copyright notice ! date. ! ! 2006-01-18 Paul Thomas ! ! PR fortran/20869 ! PR fortran/20875 ! PR fortran/25024 ! * symbol.c (check_conflict): Add pointer valued elemental ! functions and internal procedures with the external attribute ! to the list of conflicts. ! (gfc_add_attribute): New catch-all function to perform the ! checking of symbol attributes for attribute declaration ! statements. ! * decl.c (attr_decl1): Call gfc_add_attribute for each of - ! (gfc_match_external, gfc_match_intent, gfc_match_intrinsic, ! gfc_match_pointer, gfc_match_dimension, gfc_match_target): ! Remove spurious calls to checks in symbol.c. Set the ! attribute directly and use the call to attr_decl() for ! checking. ! * gfortran.h: Add prototype for gfc_add_attribute. ! ! PR fortran/25785 ! * resolve.c (resolve_function): Exclude PRESENT from assumed size ! argument checking. Replace strcmp's with comparisons with generic ! codes. ! ! 2006-01-14 Paul Thomas ! ! PR fortran/22146 ! * trans-array.c (gfc_reverse_ss): Remove static attribute. ! (gfc_walk_elemental_function_args): Replace gfc_expr * argument for ! the function call with the corresponding gfc_actual_arglist*. Change ! code accordingly. ! (gfc_walk_function_expr): Call to gfc_walk_elemental_function_args ! now requires the actual argument list instead of the expression for ! the function call. ! * trans-array.h: Modify the prototype for gfc_walk_elemental_function_args ! and provide a prototype for gfc_reverse_ss. ! * trans-stmt.h (gfc_trans_call): Add the scalarization code for the case ! where an elemental subroutine has array valued actual arguments. ! ! PR fortran/25029 ! PR fortran/21256 ! PR fortran/20868 ! PR fortran/20870 ! * resolve.c (check_assumed_size_reference): New function to check for upper ! bound in assumed size array references. ! (resolve_assumed_size_actual): New function to do a very restricted scan ! of actual argument expressions of those procedures for which incomplete ! assumed size array references are not allowed. ! (resolve_function, resolve_call): Switch off assumed size checking of ! actual arguments, except for elemental procedures and intrinsic ! inquiry functions, in some circumstances. ! (resolve_variable): Call check_assumed_size_reference. ! ! 2006-01-11 Bernhard Fischer ! ! PR fortran/25486 ! * scanner.c (load_line): use maxlen to determine the line-length used ! for padding lines in fixed form. ! ! 2005-01-11 Paul Thomas ! ! PR fortran/25730 ! * trans-types.c (copy_dt_decls_ifequal): Copy backend decl for ! character lengths. ! ! 2006-01-09 Andrew Pinski ! ! fortran/24936 ! * trans-stmt.c (gfc_trans_pointer_assign_need_temp): Use fold_convert ! to avoid type mismatch. ! ! 2006-01-09 Andrew Pinski ! ! PR fortran/21977 ! * trans-decl.c (gfc_generate_function_code): Move the NULLing of ! current_fake_result_decl down to below generate_local_vars. ! ! 2005-01-09 Erik Edelmann ! ! PR fortran/25093 ! * resolve.c (resolve_fntype): Check that PUBLIC functions ! aren't of PRIVATE type. ! ! 2006-01-09 Feng Wang ! ! PR fortran/12456 ! * trans-expr.c (gfc_to_single_character): New function that converts ! string to single character if its length is 1. ! (gfc_build_compare_string):New function that compare string and handle ! single character specially. ! (gfc_conv_expr_op): Use gfc_build_compare_string. ! (gfc_trans_string_copy): Use gfc_to_single_character. ! * trans-intrinsic.c (gfc_conv_intrinsic_strcmp): Use ! gfc_build_compare_string. ! * trans.h (gfc_build_compare_string): Add prototype. ! ! 2006-01-09 Feng Wang ! ! * simplify.c (gfc_simplify_char): Use UCHAR_MAX instead of literal ! constant. ! (gfc_simplify_ichar): Get the result from unsinged char and in the ! range 0 to UCHAR_MAX instead of CHAR_MIN to CHAR_MAX. ! ! 2006-01-07 Jerry DeLisle ! ! PR fortran/24268 ! * io.c (next_char_not_space): New function that returns the next ! character that is not white space. ! (format_lex): Use the new function to skip whitespace within ! a format string. ! ! 2006-01-06 Steven G. Kargl ! ! PR fortran/25101 ! * resolve.c (resolve_forall_iterators): Check for scalar variables; ! Check stride is nonzero. ! ! PR fortran/24640 ! * parse.c (next_free): Check for whitespace after the label; ! Update copyright year. ! * match.c (gfc_match_small_literal_int): Initialize cnt variable; ! Update copyright year. ! ! ! 2006-01-05 Erik Edelmann ! ! PR fortran/23675 ! * expr.c (gfc_expr_set_symbols_referenced): New function. ! * gfortran.h: Add a function prototype for it. ! * resolve.c (resolve_function): Use it for ! use associated character functions lengths. ! * expr.c, gfortran.h, resolve.c: Updated copyright years. ! ! 2005-12-31 Steven G. Kargl ! ! PR fortran/25106 ! PR fortran/25055 ! * io.c (match_dt_format): Remove second arg in gfc_match_st_label. ! * match.c (gfc_match_small_literal_int): Add cnt argument; ! (gfc_match_st_label,gfc_match_stopcode): Account for cnt argument. ! (gfc_match_st_label): Remove allow_zero (second argument), and use ! cnt for errors. ! (gfc_match_do,gfc_match_goto): Remove second arg in gfc_match_st_label ! * match.h (gfc_match_small_literal_int,gfc_match_st_label): ! Update prototypes. ! * decl.c (match_char_length,gfc_match_old_kind_spec): Account for cnt. ! * parse.c (next_free): Account for cnt; Remove second arg in ! gfc_match_st_label ! * primary.c (match_kind_param): Ditto. ! ! 2005-12-30 Erik Edelmann ! ! PR fortran/22607 ! * trans-decl.c(gfc_get_extern_function_decl): Don't set ! DECL_IS_PURE (fndecl) = 1 for return-by-reference ! functions. ! ! fortran/PR 25396 ! * interface.c (gfc_extend_expr): Initialize ! e->value.function.name to NULL. ! ! 2005-12-29 Paul Thomas ! ! PR fortran/25532 ! * trans-types.c (copy_dt_decls_ifequal): Copy declarations for ! components of derived type components by recursing into ! gfc_get_derived_type. ! ! 2005-12-28 Andrew Pinski ! ! PR fortran/25587 ! * trans-io.c (gfc_build_st_parameter): Correct off by one error. ! ! 2005-12-26 Paul Thomas ! ! PR fortran/20889 ! * resolve.c (resolve_structure_cons): Do not attempt to convert ! the type of mismatched pointer type components, except when ! the constructor component is BT_UNKNOWN; emit error instead. ! ! PR fortran/25018 ! * expr.c (check_inquiry): Return FAILURE if there is no symtree to ! provide a name. Error/warning for assumed character length argument ! to LEN for an initialization expression, using GFC_GNU_STD. Add an ! argument to flag that the expression is not restricted. ! (check_init_expr): Improve the message for a failing variable. ! (gfc_match_init_expr): Call check_enquiry again to make sure that ! unsimplified expressions are not causing unnecessary errors. ! ! PR fortran/19362 ! PR fortran/20244 ! PR fortran/20864 ! PR fortran/25391 ! * interface.c (gfc_compare_types): Broken into two. ! (gfc_compare_derived_types): Second half of gfc_compare_types with ! corrections for a missing check that module name is non-NULL and ! a check for private components. ! * symbol.c (gfc_free_dt_list): New function. ! (gfc_free_namespace): Call gfc_free_dt_list. ! * resolve.c (resolve_symbol): Build the list of derived types in the ! symbols namespace. ! * gfortran.h: Define the structure type gfc_dt_list. Add a new field, ! derived_types to gfc_namespace. Provide a prototye for the new ! function gfc_compare_derived_types. ! * trans_types.c(gfc_get_derived_type): Test for the derived type being ! available in the host namespace. In this case, the host backend ! declaration is used for the structure and its components. If an ! unbuilt, equal structure that is not use associated is found in the ! host namespace, build it there and then. On exit,traverse the ! namespace of the derived type to see if there are equal but unbuilt. ! If so, copy the structure and its component declarations. ! (copy_dt_decls_ifequal): New functions to copy declarations to other ! equal structure types. ! ! PR fortran/20862 ! * io.c (gfc_match_format): Make the appearance of a format statement ! in a module specification block an error. ! ! PR fortran/23152 ! * match.c (gfc_match_namelist): Set assumed shape arrays in ! namelists as std=GFC_STD_GNU and assumed size arrays as an ! unconditional error. ! ! PR fortran/25069 ! * match.c (gfc_match_namelist): Set the respecification of a USE ! associated namelist group as std=GFC_STD_GNU. Permit the concatenation ! on no error. ! ! PR fortran/25053 ! PR fortran/25063 ! PR fortran/25064 ! PR fortran/25066 ! PR fortran/25067 ! PR fortran/25068 ! PR fortran/25307 ! * io.c (resolve_tag): Change std on IOSTAT != default integer to ! GFC_STD_GNU and change message accordingly. Add same error for ! SIZE. ! (match_dt_element, gfortran.h): Add field err_where to gfc_dt and ! set it when tags are being matched. ! (gfc_resolve_dt): Remove tests that can be done before resolution ! and add some of the new ones here. ! (check_io_constraints): New function that checks for most of the ! data transfer constraints. Some of these were previously done in ! match_io, from where this function is called, and some were done ! in gfc_resolve_dt. ! (match_io): Remove most of the tests of constraints and add the ! call to check_io_constraints. ! ! 2005-12-24 Tobias Schl"uter ! ! PR fortran/18990 ! * gfortran.h (gfc_charlen): Add resolved field. ! * expr.c (gfc_specification_expr): Accept NULL argument. ! * resolve.c (gfc_resolve_charlen, gfc_resolve_derived): New. ! (gfc_resolve_symbol): Resolve derived type definitions. Use ! resolve_charlen to resolve character lengths. ! ! 2005-12-22 Steven G. Kargl ! ! * decl.c (gfc_match_old_kind_spec,match_type_spec): Use gfc_std_notify ! to report nonstandard intrinsic type declarations. ! ! 2005-12-21 Erik Edelmann ! ! PR fortran/25423 ! * parse.c (parse_where_block): break instead of "fall ! through" after parsing nested WHERE construct. ! ! 2005-12-20 Jerry DeLisle ! ! PR fortran/24268 ! * io.c (format_lex): Allow whitespace within text of format specifier. ! ! 2005-12-20 Steven G. Kargl ! Tobias Schlueter ! ! PR fortran/25458 ! * simplify.c (gfc_simplify_ibset, gfc_simplify_not): Add call to ! twos_complement. ! ! 2005-12-14 Erik Edelmann ! ! PR fortran/18197 ! * resolve.c (resolve_formal_arglist): Remove code to set ! the type of a function symbol from it's result symbol. ! ! 2005-12-12 Steven G. Kargl ! ! PR fortran/25078 ! * match.c (gfc_match_equivalence): Count number of objects. ! ! 2005-12-13 Thomas Koenig ! ! PR fortran/23815 ! * io.c (top level): Add convert to io_tag. ! (resolve_tag): convert is GFC_STD_GNU. ! (match_open_element): Add convert. ! (gfc_free_open): Likewise. ! (gfc_resolve_open): Likewise. ! (gfc_free_inquire): Likewise. ! (match_inquire_element): Likewise. ! * dump-parse-tree.c (gfc_show_code_node): Add ! convet for open and inquire. ! gfortran.h: Add convert to gfc_open and gfc_inquire. ! * trans-io.c (gfc_trans_open): Add convert. ! (gfc_trans_inquire): Likewise. ! * ioparm.def: Add convert to open and inquire. ! * gfortran.texi: Document CONVERT. ! ! 2005-12-08 Erik Edelmann ! ! PR fortran/25292 ! * check.c (gfc_check_associated): Allow function results ! as actual arguments to ASSOCIATED. Moved a misplaced ! comment. ! ! 2005-12-07 Paul Thomas ! ! PR fortran/15809 ! * trans-decl.c (gfc_get_symbol_decl): In the case of automatic ! character length, dummy pointer arrays, build an expression for ! unit size of the array elements, to be picked up and used in the ! descriptor dtype. ! * trans-io.c (gfc_trans_transfer): Modify the detection of ! components of derived type arrays to use the gfc_expr references ! instead of the array descriptor dtype. This allows the latter ! to contain expressions. ! ! 2005-12-02 Francois-Xavier Coudert ! ! PR fortran/23912 ! * iresolve.c (gfc_resolve_dim, gfc_resolve_mod, ! gfc_resolve_modulo): When arguments have different kinds, fold ! the lower one to the largest kind. ! * check.c (gfc_check_a_p): Arguments of different kinds is not ! a hard error, but an extension. ! * simplify.c (gfc_simplify_dim, gfc_simplify_mod, ! gfc_simplify_modulo): When arguments have different kinds, fold ! the lower one to the largest kind. ! ! 2005-12-01 Erik Schnetter ! ! * decl.c (gfc_match_old_kind_spec): Improve handling of old style ! COMPLEX*N ! ! 2005-12-01 Bernhard Fischer ! ! PR fortran/21302 ! * lang.opt: New options -ffree-line-length- and -ffree-line-length-none. ! * gfortran.h: Add free_line_length and add description of ! free_line_length and fixed_line_length. ! * options.c (gfc_init_options, gfc_handle_option): Initialize ! and set free_line_length and fixed_line_length. ! * scanner.c (load_line): Set free_line_length to 132 and ! fixed_line_length to 72 or user requested values. ! * scanner.c: Typo in comment. ! * invoke.texi: Document -ffree-line-length- and ! -ffree-line-length-none ! ! 2005-11-30 Paul Thomas ! ! PR fortran/24223 ! * resolve.c (resolve_contained_fntype) Error if an internal ! function is assumed character length. ! ! PR fortran/24705 ! * trans-decl.c (gfc_create_module_variable) Skip ICE in ! when backend decl has been built and the symbol is marked ! as being in an equivalence statement. ! ! 2005-11-29 Jakub Jelinek ! ! * io.c (gfc_resolve_open): RESOLVE_TAG access field as well. ! ! 2005-11-27 Bernhard Fischer ! ! * gfortran.h: remove superfluous whitespace and use GNU ! comment-style for the documentation of backend_decl. ! ! 2005-11-26 Steven G. Kargl ! ! PR fortran/24917 ! * primary.c (match_boz_constant): Implement postfix BOZ constants; ! (match_string_constant): Peek for b, o, z, and x ! ! * gfortran.dg/boz_6.f90: New test. ! ! 2005-11-21 Jakub Jelinek ! ! PR fortran/14943 ! PR fortran/21647 ! * Make-lang.in (fortran/trans-io.o): Depend on fortran/ioparm.def. ! * dump-parse-tree.c (gfc_show_code_node): Dump c->block for ! EXEC_{READ,WRITE,IOLENGTH} nodes. ! * io.c (terminate_io, match_io, gfc_match_inquire): Put data ! transfer commands into EXEC_{READ,WRITE,IOLENGTH}'s code->block. ! * resolve.c (resolve_blocks): Handle EXEC_{READ,WRITE,IOLENGTH}. ! * trans-io.c (ioparm_unit, ioparm_err, ioparm_end, ioparm_eor, ! ioparm_list_format, ioparm_library_return, ioparm_iostat, ! ioparm_exist, ioparm_opened, ioparm_number, ioparm_named, ! ioparm_rec, ioparm_nextrec, ioparm_size, ioparm_recl_in, ! ioparm_recl_out, ioparm_iolength, ioparm_file, ioparm_file_len, ! ioparm_status, ioparm_status_len, ioparm_access, ioparm_access_len, ! ioparm_form, ioparm_form_len, ioparm_blank, ioparm_blank_len, ! ioparm_position, ioparm_position_len, ioparm_action, ! ioparm_action_len, ioparm_delim, ioparm_delim_len, ioparm_pad, ! ioparm_pad_len, ioparm_format, ioparm_format_len, ioparm_advance, ! ioparm_advance_len, ioparm_name, ioparm_name_len, ! ioparm_internal_unit, ioparm_internal_unit_len, ! ioparm_internal_unit_desc, ioparm_sequential, ioparm_sequential_len, ! ioparm_direct, ioparm_direct_len, ioparm_formatted, ! ioparm_formatted_len, ioparm_unformatted, ioparm_unformatted_len, ! ioparm_read, ioparm_read_len, ioparm_write, ioparm_write_len, ! ioparm_readwrite, ioparm_readwrite_len, ioparm_namelist_name, ! ioparm_namelist_name_len, ioparm_namelist_read_mode, ioparm_iomsg, ! ioparm_iomsg_len, ioparm_var): Remove. ! (enum ioparam_type, enum iofield_type, enum iofield, ! enum iocall): New enums. ! (gfc_st_parameter_field, gfc_st_parameter): New typedefs. ! (st_parameter, st_parameter_field, iocall): New variables. ! (ADD_FIELD, ADD_STRING): Remove. ! (dt_parm, dt_post_end_block): New variables. ! (gfc_build_st_parameter): New function. ! (gfc_build_io_library_fndecls): Use it. Initialize iocall ! array rather than ioparm_*, add extra first arguments to ! the function types. ! (set_parameter_const): New function. ! (set_parameter_value): Add type argument, return a bitmask. ! Changed to set a field in automatic structure variable rather ! than set a field in a global _gfortran_ioparm variable. ! (set_parameter_ref): Likewise. If requested var has different ! size than what field should point to, call with a temporary and ! then copy into the user variable. Add postblock argument. ! (set_string): Remove var_len argument, add type argument, return ! a bitmask. Changed to set fields in automatic structure variable ! rather than set a field in a global _gfortran_ioparm variable. ! (set_internal_unit): Remove iunit, iunit_len, iunit_desc arguments, ! add var argument. Return a bitmask. Changed to set fields in ! automatic structure variable rather than set a field in a global ! _gfortran_ioparm variable. ! (set_flag): Removed. ! (io_result): Add var argument. Changed to read common.flags field ! from automatic structure variable and bitwise AND it with 3. ! (set_error_locus): Add var argument. Changed to set fields in ! automatic structure variable rather than set a field in a global ! _gfortran_{filename,line} variables. ! (gfc_trans_open): Use gfc_start_block rather than gfc_init_block. ! Create a temporary st_parameter_* structure. Adjust callers of ! all above mentioned functions. Pass address of the temporary ! variable as first argument to the generated function call. ! Use iocall array rather than ioparm_* separate variables. ! (gfc_trans_close, build_filepos, gfc_trans_inquire): Likewise. ! (build_dt): Likewise. Change first argument to tree from tree *. ! Don't dereference code->ext.dt if last_dt == INQUIRE. Emit ! IOLENGTH argument setup here. Set dt_parm/dt_post_end_block ! variables and gfc_trans_code the nested data transfer commands ! in code->block. ! (gfc_trans_iolength): Just set last_dt and call build_dt immediately. ! (transfer_namelist_element): Pass address of dt_parm variable ! to generated functions. Use iocall array rather than ioparm_* ! separate variables. ! (gfc_trans_backspace, gfc_trans_endfile, gfc_trans_rewind, ! gfc_trans_flush, gfc_trans_read, gfc_trans_write): Use iocall array ! rather than ioparm_* separate variables. ! (gfc_trans_dt_end): Likewise. Pass address of dt_parm variable ! as first argument to generated function. Adjust io_result caller. ! Prepend dt_post_end_block before io_result code. ! (transfer_expr): Use iocall array rather than ioparm_* separate ! variables. Pass address of dt_parm variables as first argument ! to generated functions. ! * ioparm.def: New file. ! ! 2005-11-20 Toon Moene ! ! * invoke.texi: Remove superfluous @item. ! ! 2005-11-20 Janne Blomqvist ! ! PR fortran/24862 ! * trans-io.c (gfc_trans_transfer): Handle arrays of derived type. ! ! 2005-11-17 Francois-Xavier Coudert ! ! PR fortran/20811 ! * scanner.c (gfc_open_included_file): Add an extra include_cwd ! argument. Only include files in the current working directory if ! its value is true. ! * gfortran.h: Change prototype for gfc_open_included_file. ! (load_file): Don't search for include files in the current working ! directory. ! * options.c (gfc_post_options): Add the directory of the source file ! to the list of paths for included files. ! * module.c (gfc_use_module): Look for module files in the current ! directory. ! ! 2005-11-16 Alan Modra ! ! PR fortran/24096 ! * trans-types.c (gfc_init_kinds): Use one less for max_exponent ! of IBM extended double format. ! ! 2005-11-13 Francois-Xavier Coudert ! ! * intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET, ! FPUTC, FPUT, AND, XOR and OR intrinsic functions. ! (add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic ! subroutines. ! * gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, ! GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, ! GFC_ISYM_OR, GFC_ISYM_XOR. ! * iresolve.c (gfc_resolve_and, gfc_resolve_complex, ! gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget, ! gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell, ! gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub, ! gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub): ! New functions. ! * check.c (gfc_check_complex, gfc_check_fgetputc_sub, ! gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput, ! gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions. ! * simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or, ! gfc_simplify_xor): New functions. ! * trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for ! GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC, ! GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and ! GFC_ISYM_XOR. ! * intrinsic.h: Add prototypes for all functions added to iresolve.c, ! simplify.c and check.c. ! ! 2005-11-10 Paul Thomas ! Steven G. Kargl ! ! PR fortran/15976 ! * resolve.c (resolve_symbol): Disallow automatic arrays in module scope. ! ! 2005-11-10 Paul Thomas ! ! PR fortran/24655 ! PR fortran/24755 ! * match.c (recursive_stmt_fcn): Add checks that symtree exists ! for the expression to weed out inline intrinsic functions and ! parameters. ! ! PR fortran/24409 ! * module.c (mio_symtree_ref): Correct the patch of 0923 so that ! a symbol is not substituted for by a the symbol for the module ! itself and to prevent the promotion of a formal argument. ! ! 2005-11-10 Tobias Schl"uter ! ! PR fortran/24643 ! * primary.c (match_varspec): Check for implicitly typed CHARACTER ! variables before matching substrings. ! ! 2005-11-09 Steven G. Kargl ! ! * trans-intrinsic.c: Typo in comment. ! ! 2005-11-09 Erik Edelmann ! ! PR fortran/22607 ! * trans-decl.c(build_function_decl): Don't set ! DECL_IS_PURE (fndecl) = 1 for return-by-reference ! functions. ! ! 2005-11-08 Tobias Schl"uter ! ! * dump-parse-tree.c: Fix comment typo, add a few blank lines. ! ! 2005-11-07 Steven G. Kargl ! ! * error.c: Use flag_fatal_error. ! * invoke.texi: Remove -Werror from list of options. ! ! 2005-11-06 Paul Thomas ! ! PR fortran/24534 ! * resolve.c (resolve_symbol): Exclude case of PRIVATE declared ! within derived type from error associated with PRIVATE type ! components within derived type. ! ! PR fortran/20838 ! PR fortran/20840 ! * gfortran.h: Add prototype for gfc_has_vector_index. ! * io.c (gfc_resolve_dt): Error if internal unit has a vector index. ! * expr.c (gfc_has_vector_index): New function to check if any of ! the array references of an expression have vector inidices. ! (gfc_check_pointer_assign): Error if internal unit has a vector index. ! ! PR fortran/17737 ! * data.c (gfc_assign_data_value): Remove gcc_assert that caused the ICE ! and replace by a standard dependent warning/error if overwriting an ! existing initialization. ! * decl.c (gfc_data_variable): Remove old error for already initialized ! variable and the unused error check for common block variables. Add ! error for hots associated variable and standard dependent error for ! common block variables, outside of blockdata. ! * symbol.c (check_conflict): Add constraints for DATA statement. ! ! 2005-11-06 Janne Blomqvist ! ! PR fortran/24174 ! PR fortran/24305 ! * fortran/trans-io.c (gfc_build_io_library_fndecls): Add kind ! argument to transfer_array. ! (transfer_array_desc): Add kind argument. ! ! 2005-11-06 Francois-Xavier Coudert ! ! * intrinsic.c (add_functions): Add ctime and fdate intrinsics. ! (add_subroutines): Likewise. ! * intrinsic.h: Prototypes for gfc_check_ctime, ! gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime, ! gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub. ! * gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE. ! * iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate, ! gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions. ! * trans-decl.c (gfc_build_intrinsic_function_decls): Add ! gfor_fndecl_fdate and gfor_fndecl_ctime. ! * check.c (gfc_check_ctime, gfc_check_ctime_sub, ! gfc_check_fdate_sub): New functions. ! * trans-intrinsic.c (gfc_conv_intrinsic_ctime, ! gfc_conv_intrinsic_fdate): New functions. ! (gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME ! and GFC_ISYM_FDATE. ! * intrinsic.texi: Documentation for the new CTIME and FDATE ! intrinsics. ! * trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate. ! ! 2005-11-05 Kazu Hirata ! ! * decl.c, trans-decl.c: Fix comment typos. ! * gfortran.texi: Fix a typo. ! ! 2005-11-05 Francois-Xavier Coudert ! ! * intrinsic.c (add_functions): Add function version of TTYNAM. ! * intrinsic.h: Add prototypes for gfc_check_ttynam and ! gfc_resolve_ttynam. ! * gfortran.h: Add case for GFC_ISYM_TTYNAM. ! * iresolve.c (gfc_resolve_ttynam): New function. ! * trans-decl.c (gfc_build_intrinsic_function_decls): Add a tree ! for function call to library ttynam. ! * check.c (gfc_check_ttynam): New function. ! * trans-intrinsic.c (gfc_conv_intrinsic_ttynam): New function. ! (): Call gfc_conv_intrinsic_ttynam. ! * trans.h: Add prototype for gfor_fndecl_ttynam. ! ! 2005-11-04 Steven G. Kargl ! ! PR fortran/24636 ! * match.c (gfc_match_stopcode): Set stop_code = -1. ! ! 2005-11-04 Francois-Xavier Coudert ! ! PR fortran/18452 ! * lang-specs.h: Pass -lang-fortran to the preprocessor. ! ! 2005-11-02 Andrew Pinski ! ! PR fortran/18157 ! * trans-array.c (gfc_conv_resolve_dependencies): Use the correct ! type for the temporary array. ! * trans-expr.c (gfc_trans_assignment): Pass lss ! instead of lss_section ! to gfc_conv_resolve_dependencies to get the ! correct type. ! ! 2005-11-02 Tobias Schl"uter ! ! * decl.c (gfc_match_entry): Function entries don't need an argument ! list if there's no RESULT clause. ! ! 2005-11-01 Tobias Schl"uter ! ! PR fortran/24008 ! * decl.c (gfc_match_entry): Function entries need an argument list. ! ! 2005-11-01 Erik Edelmann ! ! PR 24245 ! * trans.c (gfc_generate_code): Move code to create a main ! program symbol from here ... ! * parse.c (main_program_symbol): ... to this new ! function, setting the locus from gfc_current_locus ! instead of ns->code->loc. ! (gfc_parse_file): Call main_program_symbol for main programs. ! ! 2005-11-01 Tobias Schl"uter ! ! PR fortran/24404 ! * resolve.c (resolve_symbol): Output symbol names in more error ! messages, clarify error message. ! ! 2005-11-01 Tobias Schl"uter ! ! * dump-parse-tree.c (show_symtree): Revert change unintentionally ! committed in r106246. ! ! 2005-11-01 Paul Thomas ! ! PR fortran/21565 ! * symbol.c (check_conflict): An object cannot be in a namelist and in ! block data. ! ! PR fortran/18737 ! * resolve.c (resolve_symbol): Set the error flag to ! gfc_set_default_type, in the case of an external symbol, so that ! an error message is emitted if IMPLICIT NONE is set. ! ! PR fortran/14994 ! * gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SECNDS to enum. ! * check.c (gfc_check_secnds): New function. ! * intrinsic.c (add_functions): Add call to secnds. ! * iresolve.c (gfc_resolve_secnds): New function. ! * trans-intrinsic (gfc_conv_intrinsic_function): Add call to ! secnds via case GFC_ISYM_SECNDS. ! * intrinsic.texi: Add documentation for secnds. ! ! 2005-10-31 Andreas Schwab ! ! * Make-lang.in (GFORTRAN_TARGET_INSTALL_NAME): Define. ! (GFORTRAN_CROSS_NAME): Remove. ! (fortran.install-common): Correctly install a cross compiler. ! (fortran.uninstall): Use GFORTRAN_TARGET_INSTALL_NAME instead of ! GFORTRAN_CROSS_NAME. ! ! 2005-10-30 Erik Edelmann ! ! * gfortran.texi: Update contributors. ! ! 2005-10-30 Erik Edelmann ! ! PR fortran/18883 ! * trans-decl.c (gfc_finish_var_decl): Add decl to the ! current function, rather than the parent. Make ! assertion accept fake result variables. ! * trans-expr.c (gfc_conv_variable): If the character ! length of an ENTRY isn't set, get the length from ! the master function instead. ! ! 2005-10-30 Thomas Koenig ! ! * gfortran.texi: Remove reservations about I/O usability. Document ! that array intrinsics mostly work. ! ! 2005-10-30 Tobias Schl"uter ! ! * gfortran.texi: Move license stuff to back. Add information ! on ENUM and ENUMERATOR. ! * invoke.texi: Document -fshort-enums. ! ! 2005-10-30 Gaurav Gautam ! Tobias Schl"uter ! ! * arith.c (gfc_enum_initializer): New function. ! (gfc_check_integer_range): Made extern. ! * decl.c (enumerator_history): New typedef. ! (last_initializer, enum_history, max_enum): New variables. ! (create_enum_history, gfc_free_enum_history): New functions. ! (add_init_expr_to_sym): Call create_enum_history if parsing ENUM. ! (variable_decl): Modified to parse enumerator definition. ! (match_attr_spec): Add PARAMETER attribute to ENUMERATORs. ! (gfc_match_data_decl): Issues error, if match_type_spec do not ! return desired return values. ! (set_enum_kind, gfc_match_enum, gfc_match_enumerator_def): New ! functions. ! (gfc_match_end): Deal with END ENUM. ! * gfortran.h (gfc_statement): ST_ENUM, ST_ENUMERATOR, ST_END_ENUM ! added. ! (symbol_attribute): Bit field for enumerator added. ! (gfc_options): Add fshort_enums. ! (gfc_enum_initializer, gfc_check_integer_range): Add prototypes. ! * options.c: Include target.h ! (gfc_init_options): Initialize fshort_enums. ! (gfc_handle_option): Deal with fshort_enums. ! * parse.c (decode_statement): Match ENUM and ENUMERATOR statement. ! (gfc_ascii_statement): Deal with the enumerator statements. ! (parse_enum): New function to parse enum construct. ! (parse_spec): Added case ST_ENUM. ! * parse.h (gfc_compile_state): COMP_ENUM added. ! (gfc_match_enum, gfc_match_enumerator_def, gfc_free_enum_history): ! Prototype added. ! * symbol.c (gfc_copy_attr): Copy enumeration attribute. ! * lang.opt (fshort-enums): Option added. ! ! 2005-10-30 Francois-Xavier Coudert ! ! * check.c (gfc_check_malloc, gfc_check_free): New functions. ! * gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_MALLOC. ! * intrinsic.c (add_functions): Add symbols for MALLOC function. ! (add_subroutines): Add symbol for FREE subroutine. ! * intrinsic.h: Prototypes for gfc_check_malloc, gfc_check_free, ! gfc_resolve_malloc and gfc_resolve_free. ! * intrinsic.texi: Add doc for FREE and MALLOC intrinsics. ! * iresolve.c (gfc_resolve_malloc, gfc_resolve_free): New ! functions. ! * trans-intrinsic.c (gfc_conv_intrinsic_function): Add case for ! GFC_ISYM_MALLOC. ! ! 2005-10-30 Steven Bosscher ! ! * gfortran.texi: Update contributors. ! ! 2005-10-29 Steven Bosscher ! ! * interface.c: Fix previous checkin (an incomplete patch ! was commited for me). ! ! 2005-10-29 Joseph S. Myers ! ! * intrinsic.texi: Remove empty @cindex line. ! ! 2005-10-28 Francois-Xavier Coudert ! ! * check.c (gfc_check_alarm_sub, gfc_check_signal, ! gfc_check_signal_sub): New functions. ! * gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL. ! * intrinsic.c (add_functions): Add signal intrinsic. ! (add_subroutines): Add signal and alarm intrinsics. ! * intrinsic.texi: Document the new intrinsics. ! * iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub, ! gfc_resolve_signal_sub): New functions. ! * trans-intrinsic.c (gfc_conv_intrinsic_function): Add case ! for GFC_ISYM_SIGNAL. ! * intrinsic.h: Add prototypes for gfc_check_alarm_sub, ! gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal, ! gfc_resolve_alarm_sub, gfc_resolve_signal_sub. ! ! 2005-10-28 Steven Bosscher ! ! PR fortran/24545 ! * interface.c (gfc_match_end_interface): Fix typo in ! INTERFACE_USER_OP case. ! ! 2005-10-26 Francois-Xavier Coudert ! ! PR fortran/15586 ! * resolve.c (resolve_symbol): Remove the use of whynot, so that ! error messages are not built from pieces. ! ! 2005-10-26 Paul Thomas ! ! PR fortran/24158 ! * decl.c (gfc_match_data_decl): Correct broken bit of code ! that prevents undefined derived types from being used as ! components of another derived type. ! * resolve.c (resolve_symbol): Add backstop error when derived ! type variables arrive here with a type that has no components. ! ! 2005-10-25 Jakub Jelinek ! ! * trans.h (gfc_conv_cray_pointee): Remove. ! * trans-expr.c (gfc_conv_variable): Revert 2005-10-24 change. ! * trans-array.c (gfc_conv_array_parameter): Likewise. ! * trans-decl.c (gfc_conv_cray_pointee): Remove. ! (gfc_finish_cray_pointee): New function. ! (gfc_finish_var_decl): Use it. Don't return early for Cray ! pointees. ! (gfc_create_module_variable): Revert 2005-10-24 change. ! * decl.c (cray_pointer_decl): Update comment. ! * gfortran.texi: Don't mention Cray pointees aren't visible in the ! debugger. ! ! * symbol.c (check_conflict): Add conflict between cray_pointee ! and in_common resp. in_equivalence. ! * resolve.c (resolve_equivalence): Revert 2005-10-24 change. ! ! * module.c (ab_attribute): Add AB_CRAY_POINTER and AB_CRAY_POINTEE. ! (attr_bits): Likewise. ! (mio_symbol_attribute): Save and restore cray_pointe{r,e} attributes. ! (mio_symbol): For cray_pointee write/read cp_pointer reference. ! ! 2005-10-25 Feng Wang ! ! PR fortran/22290 ! * trans-decl.c (gfc_add_assign_aux_vars): New function. Add two ! auxiliary variables. ! (gfc_get_symbol_decl): Use it when a variable, including dummy ! argument, is assigned a label. ! (gfc_trans_assign_aux_var): New function. Set initial value of ! the auxiliary variable explicitly. ! (gfc_trans_deferred_vars): Use it. ! * trans-stmt.c (gfc_conv_label_variable): Handle dummy argument. ! ! 2005-10-24 Asher Langton ! ! PR fortran/17031 ! PR fortran/22282 ! * check.c (gfc_check_loc): New function. ! * decl.c (variable_decl): New variables cp_as and sym. Added a ! check for variables that have already been declared as Cray ! Pointers, so we can get the necessary attributes without adding ! a new symbol. ! (attr_decl1): Added code to catch pointee symbols and "fix" ! their array specs. ! (cray_pointer_decl): New method. ! (gfc_match_pointer): Added Cray pointer parsing code. ! (gfc_mod_pointee_as): New method. ! * expr.c (gfc_check_assign): Added a check to catch vector-type ! assignments to pointees with an unspecified final dimension. ! * gfortran.h: (GFC_ISYM_LOC): New. ! (symbol_attribute): Added cray_pointer and cray_pointee bits. ! (gfc_array_spec): Added cray_pointee and cp_was_assumed bools. ! (gfc_symbol): Added gfc_symbol *cp_pointer. ! (gfc_option): Added flag_cray_pointer. ! (gfc_add_cray_pointee): Declare. ! (gfc_add_cray_pointer ): Declare. ! (gfc_mod_pointee_as): Declare. ! * intrinsic.c (add_functions): Add code for loc() intrinsic. ! * intrinsic.h (gfc_check_loc): Declare. ! (gfc_resolve_loc): Declare. ! * iresolve.c (gfc_resolve_loc): New. ! * lang.opt: Added fcray-pointer flag. ! * options.c (gfc_init_options): Initialized. ! gfc_match_option.flag_cray_pointer. ! (gfc_handle_option): Deal with -fcray-pointer. ! * parse.c:(resolve_equivalence): Added code prohibiting Cray ! pointees in equivalence statements. ! * resolve.c (resolve_array_ref): Added code to prevent bounds ! checking for Cray Pointee arrays. ! (resolve_equivalence): Prohibited pointees in equivalence ! statements. ! * symbol.c (check_conflict): Added Cray pointer/pointee ! attribute checking. ! (gfc_add_cray_pointer): New. ! (gfc_add_cray_pointee): New. ! (gfc_copy_attr): New code for Cray pointers and pointees. ! * trans-array.c (gfc_trans_auto_array_allocation): Added code to ! prevent space from being allocated for pointees. ! (gfc_conv_array_parameter): Added code to catch pointees and ! correctly set their base address. ! * trans-decl.c (gfc_finish_var_decl): Added code to prevent ! pointee declarations from making it to the back end. ! (gfc_create_module_variable): Same. ! * trans-expr.c (gfc_conv_variable): Added code to detect and ! translate pointees. ! (gfc_conv_cray_pointee): New. ! * trans-intrinsic.c (gfc_conv_intrinsic_loc): New. ! (gfc_conv_intrinsic_function): Added entry point for loc ! translation. ! * trans.h (gfc_conv_cray_pointee): Declare. ! ! * gfortran.texi: Added section on Cray pointers, removed Cray ! pointers from list of proposed extensions. ! * intrinsic.texi: Added documentation for loc intrinsic. ! * invoke.texi: Documented -fcray-pointer flag. ! ! 2005-10-24 Asher Langton ! ! * decl.c (gfc_match_save): Changed duplicate SAVE errors to ! warnings in the absence of strict standard conformance ! * symbol.c (gfc_add_save): Same. ! ! 2005-10-24 Francois-Xavier Coudert ! ! PR fortran/15586 ! * arith.c (gfc_arith_error): Change message to include locus. ! (check_result, eval_intrinsic, gfc_int2int, gfc_real2real, ! gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use ! the new gfc_arith_error. ! (arith_error): Rewrite full error messages instead of building ! them from pieces. ! * check.c (must_be): Removed. ! (type_check, numeric_check, int_or_real_check, real_or_complex_check, ! kind_check, double_check, logical_array_check, array_check, ! scalar_check, same_type_check, rank_check, kind_value_check, ! variable_check, gfc_check_allocated, gfc_check_associated, ! gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product, ! gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null, ! gfc_check_pack, gfc_check_precision, gfc_check_present, ! gfc_check_spread): Rewrite full error messages instead of ! building them from pieces. ! * decl.c (gfc_match_entry): Rewrite full error messages instead ! of building them from pieces. ! * parse.c (gfc_state_name): Remove. ! * parse.h: Remove prototype for gfc_state_name. ! ! 2005-10-23 Andrew Pinski ! ! PR fortran/23635 ! * check.c (gfc_check_ichar_iachar): Move the code around so ! that the check on the length is after check for ! references. ! ! 2005-10-23 Asher Langton ! ! * decl.c (match_type_spec): Add a BYTE type as an extension. ! ! 2005-10-23 Paul Thomas ! ! PR fortran/18022 ! * trans-expr.c (gfc_trans_arrayfunc_assign): Return NULL ! if there is a component ref during an array ref to force ! use of temporary in assignment. ! ! PR fortran/24311 ! PR fortran/24384 ! * fortran/iresolve.c (check_charlen_present): New function to ! add a charlen to the typespec, in the case of constant ! expressions. ! (gfc_resolve_merge, gfc_resolve_spread): Call.the above. ! (gfc_resolve_spread): Make calls to library functions that ! handle the case of the spread intrinsic with a scalar source. ! ! 2005-10-22 Erik Edelmann ! ! PR fortran/24426 ! * decl.c (variable_decl): Don't assign default initializers to ! pointers. ! ! 2005-10-21 Jakub Jelinek ! ! * interface.c (compare_actual_formal): Issue error when attempting ! to pass an assumed-size array as assumed-shape array argument. ! ! 2005-10-20 Erik Edelmann ! ! PR fortran/21625 ! * resolve.c (expr_to_initialize): New function. ! (resolve_allocate_expr): Take current statement as new ! argument. Add default initializers to variables of ! derived types, if they need it. ! (resolve_code): Provide current statement as argument to ! resolve_allocate_expr(). ! ! 2005-10-19 Paul Thomas ! ! PR fortran/24440 ! * resolve.c (resolve_symbol): Correct error in check for ! assumed size array with default initializer by testing ! for arrayspec before dereferencing it. ! ! 2005-10-17 Paul Thomas ! ! PR fortran/23446 ! * gfortran.h: Primitive for gfc_is_formal_arg. ! * resolve.c(gfc_is_formal_arg): New function to signal across ! several function calls that formal argument lists are being ! processed. ! (resolve_formal_arglist): Set/reset the flag for gfc_is_formal_arg. ! *expr.c(check_restricted): Add check, via gfc_is_formal_arg, if ! symbol is part of an formal argument declaration. ! ! PR fortran/21459 ! * decl.c (add_init_expr_to_sym): Make a new character ! length for each variable, when the expression is NULL ! and link to cl_list. ! ! PR fortran/20866 ! * match.c (recursive_stmt_fcn): New function that tests if ! a statement function resurses through itself or other other ! statement functions. ! (gfc_match_st_function): Call recursive_stmt_fcn to check ! if this is recursive and to raise error if so. ! ! PR fortran/20849 ! PR fortran/20853 ! * resolve.c (resolve_symbol): Errors for assumed size arrays ! with default initializer and for external objects with an ! initializer. ! ! PR fortran/20837 ! * decl.c (match_attr_spec): Prevent PUBLIC from being used ! outside a module. ! ! 2005-10-16 Erik Edelmann ! ! PR 22273 ! * expr.c (check_inquiry): Add "len" to inquiry_function. ! ! 2005-10-14 Jakub Jelinek ! ! * primary.c (match_boz_constant): Add missing break after gfc_error. ! ! 2005-10-12 Paul Thomas ! ! PR fortran/24092 ! * trans-types.c (gfc_get_derived_type): Insert code to obtain backend ! declaration for derived types, building if necessary. Return the ! derived type if the fields have been built by this process. Otherwise, ! continue as before but using the already obtained backend_decls for the ! derived type components. Change the gcc_assert to act on the field. ! ! 2005-10-12 Paul Thomas ! ! PR fortran/18082 ! * decl.c (variable_decl): Make a new copy of the character ! length for each variable, when the expression is not a ! constant. ! ! 2005-10-12 Francois-Xavier Coudert ! ! * gfortran.h: Add bitmasks for different FPE traps. Add fpe ! member to options_t. ! * invoke.texi: Document the new -ffpe-trap option. ! * lang.opt: Add -ffpe-trap option. ! * options.c (gfc_init_options): Initialize the FPE option. ! (gfc_handle_fpe_trap_option): New function to parse the argument ! of the -ffpe-trap option. ! (gfc_handle_option): Add case for -ffpe-trap. ! * trans-decl.c: Declare a tree for the set_fpe library function. ! (gfc_build_builtin_function_decls): Build this tree. ! (gfc_generate_function_code): Generate a call to set_fpe at ! the beginning of the main program. ! * trans.h: New tree for the set_fpe library function. ! ! 2005-10-12 Paul Thomas ! ! PR fortran/20847 ! PR fortran/20856 ! * symbol.c (check_conflict): Prevent common variables and ! function results from having the SAVE attribute,as required ! by the standard. ! ! 2005-10-12 Paul Thomas ! ! PR fortran/24207 ! * resolve.c (resolve_symbol): Exclude use and host associated ! symbols from the test for private objects in a public namelist. ! ! 2005-10-12 Jakub Jelinek ! ! * trans-common.c (build_field): Fix comment typo. ! (create_common): Set backend_decl of COMMON or EQUIVALENCEd ! variables to a VAR_DECL with the COMPONENT_REF in ! DECL_HAS_VALUE_EXPR rather than COMPONENT_REF directly. ! * f95-lang.c (gfc_expand_function): Emit debug info for ! EQUIVALENCEd variables if the equiv union is going to be output. ! ! 2005-10-11 Steven G. Kargl ! ! PR fortran/20786 ! * iresolve.c (gfc_resolve_aint, gfc_resolve_anint): Type conversion ! of the argument. ! ! 2005-10-11 Jakub Jelinek ! ! * f95-lang.c (gfc_init_decl_processing): Initialize ! void_list_node. ! ! 2005-10-07 Erik Edelmann ! ! PR 18568 ! * resolve.c (find_array_spec): Search through the list of ! components in the symbol of the type instead of the symbol of the ! variable. ! ! 2005-10-05 Richard Guenther ! ! PR fortran/24176 ! * parse.c (gfc_parse_file): Exit early for empty files. ! ! 2005-10-03 Steve Ellcey ! ! * fortran/trans-types.c (gfc_init_kinds): Only pass float, double, ! and long double floating point types through to Fortran compiler. ! ! 2005-10-03 Francois-Xavier Coudert ! ! PR fortran/20120 ! * f95-lang.c (DO_DEFINE_MATH_BUILTIN): Add support for long ! double builtin function. ! (gfc_init_builtin_functions): Add mfunc_longdouble, ! mfunc_clongdouble and func_clongdouble_longdouble trees. Build ! them for round, trunc, cabs, copysign and pow functions. ! * iresolve.c (gfc_resolve_reshape, gfc_resolve_transpose): Add ! case for kind 10 and 16. ! * trans-decl.c: Add trees for cpowl10, cpowl16, ishftc16, ! exponent10 and exponent16. ! (gfc_build_intrinsic_function_decls): Build nodes for int16, ! real10, real16, complex10 and complex16 types. Build all possible ! combinations for function _gfortran_pow_?n_?n. Build function ! calls cpowl10, cpowl16, ishftc16, exponent10 and exponent16. ! * trans-expr.c (gfc_conv_power_op): Add case for integer(16), ! real(10) and real(16). ! * trans-intrinsic.c: Add suppport for long double builtin ! functions in BUILT_IN_FUNCTION, LIBM_FUNCTION and LIBF_FUNCTION ! macros. ! (gfc_conv_intrinsic_aint): Add case for integer(16), real(10) and ! real(16) kinds. ! (gfc_build_intrinsic_lib_fndecls): Add support for real10_decl ! and real16_decl in library functions. ! (gfc_get_intrinsic_lib_fndecl): Add cases for real and complex ! kinds 10 and 16. ! (gfc_conv_intrinsic_exponent): Add cases for real(10) and real(16) ! kinds. ! (gfc_conv_intrinsic_sign): Likewise. ! (gfc_conv_intrinsic_ishftc): Add case for integer(16) kind. ! * trans-types.c (gfc_get_int_type, gfc_get_real_type, ! gfc_get_complex_type, gfc_get_logical_type): Doesn't error out in ! the case of kinds not available. ! * trans.h: Declare trees for cpowl10, cpowl16, ishftc16, ! exponent10 and exponent16. ! ! 2005-10-01 Paul Thomas ! ! PR fortran/16404 ! PR fortran/20835 ! PR fortran/20890 ! PR fortran/20899 ! PR fortran/20900 ! PR fortran/20901 ! PR fortran/20902 ! * gfortran.h: Prototype for gfc_add_in_equivalence. ! * match.c (gfc_match_equivalence): Make a structure component ! an explicit,rather than a syntax, error in an equivalence ! group. Call gfc_add_in_equivalence to add the constraints ! imposed in check_conflict. ! * resolve.c (resolve_symbol): Add constraints: No public ! structures with private-type components and no public ! procedures with private-type dummy arguments. ! (resolve_equivalence_derived): Add constraint that prevents ! a structure equivalence member from having a default ! initializer. ! (sequence_type): New static function to determine whether an ! object is default numeric, default character, non-default ! or mixed sequence. Add corresponding enum typespec. ! (resolve_equivalence): Add constraints to equivalence groups ! or their members: No more than one initialized member and ! that different types are not equivalenced for std=f95. All ! the simple constraints have been moved to check_conflict. ! * symbol.c (check_conflict): Simple equivalence constraints ! added, including those removed from resolve_symbol. ! (gfc_add_in_equivalence): New function to interface calls ! match_equivalence to check_conflict. ! ! 2005-09-27 Jakub Jelinek ! ! PR fortran/18518 ! * trans-common.c (build_equiv_decl): Add IS_SAVED argument. ! If it is true, set TREE_STATIC on the decl. ! (create_common): If any symbol in equivalence has SAVE attribute, ! pass true as last argument to build_equiv_decl. ! ! 2005-09-24 Janne Blomqvist ! ! * trans-io.c (gfc_build_io_library_fndecls): Add entry ! iocall_x_array for transfer_array. ! (transfer_array_desc): New function. ! (gfc_trans_transfer): Add code to call transfer_array_desc. ! ! 2005-09-26 Jakub Jelinek ! ! PR fortran/23677 ! * symbol.c (gfc_is_var_automatic): Return true if character length ! is non-constant rather than constant. ! * resolve.c (gfc_resolve): Don't handle !gfc_option.flag_automatic ! here. ! * options.c (gfc_post_options): Set gfc_option.flag_max_stack_var_size ! to 0 for -fno-automatic. ! ! 2005-09-23 Paul Thomas ! ! PR fortran/16861 ! * module.c (mio_component_ref): Return if the symbol is NULL ! and wait for another iteration during module reads. ! (mio_symtree_ref): Suppress the writing of contained symbols, ! when a symbol is available in the main namespace. ! (read_module): Restrict scope of special treatment of contained ! symbols to variables only and suppress redundant call to ! find_true_name. ! ! 2005-09-22 Steven G. Kargl ! ! PR fortran/24005 ! * interface.c (check_interface1): Fix NULL dereference. ! ! 2005-09-22 Erik Edelmann ! ! PR fortran/23843 ! * resolve.c (derived_inaccessible): New function. ! (resolve_transfer): Use it to check for private ! components. ! ! 2005-09-22 Steven G. Kargl ! ! PR fortran/23516 ! * intrinsic.c (add_function): Add IMAG, IMAGPART, and REALPART ! intrinsics. ! * intrinsic.h: Prototypes for gfc_simplify_realpart and ! gfc_resolve_realpart. ! * intrinsic.texi: Document intrinsic procedures. ! * simplify.c (gfc_simplify_realpart): New function. ! * irseolve.c (gfc_resolve_realpart): New function. ! ! 2005-09-21 Erik Edelmann ! ! PR fortran/19929 ! * trans-stmt.c (gfc_trans_deallocate): Check if the ! object to be deallocated is an array by looking at ! expr->rank instead of expr->symtree->n.sym->attr.dimension. ! ! 2005-09-20 Tobias Schl"uter ! ! PR fortran/23420 ! * io.c (resolve_tag): Don't allow non-CHARACTER constants as formats. ! (match_io): Fix usage of gfc_find_symbol. ! ! 2005-09-20 Jakub Jelinek ! ! PR fortran/23663 ! * primary.c (match_actual_arg): Handle ENTRY the same way ! as FUNCTION. ! ! 2005-09-18 Francois-Xavier Coudert ! ! * Make-lang.in: Make check-fortran alias for check-gfortran. ! ! 2005-09-18 Andreas Jaeger ! ! * module.c (read_module): Add missed line from last patch. ! ! 2005-09-18 Erik Edelmann ! ! PR fortran/15975 ! * resolve.c (resolve_symbol): Don't assign default ! initializer to pointers. ! ! 2005-09-18 Paul Thomas ! ! PR fortran/16861 ! * module.c (read_module): Give symbols from module procedures ! different true_name entries to those from the module proper. ! ! 2005-09-17 Francois-Xavier Coudert ! ! PR fortran/15586 ! * arith.c (gfc_arith_error): Add translation support for error ! messages. ! * array.c (gfc_match_array_ref): Likewise. ! (gfc_match_array_spec): Likewise. ! * check.c (must_be): Add msgid convention to third argument. ! (same_type_check): Add translation support for error message. ! (rank_check): Likewise. ! (kind_value_check): Likewise. ! (gfc_check_associated): Correct typo. ! (gfc_check_reshape): Add translation support for error message. ! (gfc_check_spread): Likewise. ! * error.c (error_printf): Add nocmsgid convention to argument. ! (gfc_warning, gfc_notify_std, gfc_warning_now, gfc_warning_check) ! (gfc_error, gfc_error_now): Likewise. ! (gfc_status): Add cmsgid convention to argument. ! * expr.c (gfc_extract_int): Add translation support for error ! messages. ! (gfc_check_conformance): Add msgid convention to argument. ! (gfc_check_pointer_assign): Correct tabbing. ! * gfortran.h: Include intl.h header. Remove prototype for gfc_article. ! * gfortranspec.c: Include intl.h header. ! (lang_specific_driver): Add translation support for --version. ! * io.c (check_format): Add translation support for error message. ! (format_item_1): Likewise. ! (data_desc): Likewise. ! * matchexp.c: Likewise. ! * misc.c (gfc_article): Remove function. ! * module.c (bad_module): Use msgid convention. Add translation support ! for error messages. ! (require_atom): Add translation support for error messages. ! * parse.c (gfc_ascii_statement): Likewise. ! (gfc_state_name): Likewise. ! * primary.c (match_boz_constant): Reorganise error messages for ! translations. ! * resolve.c (resolve_entries): Likewise. ! (resolve_operator): Add translation support for error messages. ! (gfc_resolve_expr): Use msgid convention. Reorganise error messages ! for translations. ! (resolve_symbol): Add translation support for error messages. ! * symbol.c (gfc_add_procedure): Remove use of gfc_article function. ! * trans-const.c (gfc_build_string_const): Use msgid convention. ! ! 2005-09-16 Paul Brook ! ! PR fortran/23906 ! * dependency.c (transform_sections): Divide by correct value. ! Elaborate comment. ! ! 2005-09-14 Paul Thomas ! ! PR fortran/21875 Internal Unit Array I/O, NIST ! * fortran/trans-io.c (gfc_build_io_library_fndecls): Add field for ! array descriptor to IOPARM structure. ! * fortran/trans-io.c (set_internal_unit): New function to generate code ! to store the character (array) and the character length for an internal ! unit. ! * fortran/trans-io (build_dt): Use the new function set_internal_unit. ! ! 2005-09-14 Paul Thomas PR fortran/19358 * trans-array.c (gfc_trans_dummy_array_bias): correct the typo which uses dim[i].upper for lbound, rather than dim[i].lower. ! 2005-09-13 Erik Edelmann ! PR fortran/17740 ! * trans-expr.c (gfc_trans_arrayfunc_assign): Check value ! of attr.elemental for specific function instead of generic name. ! 2005-09-13 Richard Sandiford ! ! PR fortran/18899 ! * trans-intrinsic.c (gfc_conv_intrinsic_bound): Move initialization ! of argse. Remove now-redundant want_pointer assignment. ! * trans-array.c (gfc_conv_expr_descriptor): When not assigning to ! a pointer, keep the original bounds of a full array reference. ! ! 2005-09-13 Richard Sandiford ! ! PR target/19269 ! * iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift) ! (gfc_resolve_pack, gfc_resolve_reshape, gfc_resolve_spread) ! (gfc_resolve_transpose, gfc_resolve_unpack): Add "_char" to the name ! for character-based operations. ! (gfc_resolve_pack): Remove ATTRIBUTE_UNUSED from array argument. ! (gfc_resolve_unpack): Copy the whole typespec from the vector. ! * trans-array.c (gfc_conv_expr_descriptor): In the EXPR_FUNCTION ! case, get the string length from the scalarization state. ! ! 2005-09-14 Francois-Xavier Coudert ! ! * Make-lang.in: Change targets prefixes from f95 to fortran. ! * config-lang.in: Change language name to "fortran". ! * lang.opt: Change language name to "fortran". ! * options.c: Change CL_F95 to CL_Fortran. 2005-09-09 Thomas Koenig ! gfortran.texi: Document IOSTAT= specifier. ! ! 2005-09-09 Thomas Koenig ! ! * gfortran.h: Add iomsg to gfc_open, gfc_close, gfc_filepos, ! gfc_inquire and gfc_dt. ! * dump-parse-tree.c (gfc_show_code_node): Add iomsg ! for open, close, file positioning, inquire and namelist. ! * io.c (io_tag): Add tag_iomsg. ! (resolve_tag): Add standards warning for iomsg. ! (match_open_element): Add iomsg. ! (gfc_free_open): Add iomsg. ! (gfc_resolve_open): Add iomsg. ! (gfc_free_close): Add iomsg. ! (match_close_element): Add iomsg. ! (gfc_resolve_close): Add iomsg. ! (gfc_free_filepos): Add iomsg. ! (match_file_element): Add iomsg. ! (gfc_resolve_filepos): Add iostat and iomsg. ! (match-dt_element): Add iomsg. ! (gfc_free_dt): Add iomsg. ! (gfc_resolve_dt): Add iomsg. ! (gfc_free_inquire): Add iomsg. ! (match_inquire_element): Add iomsg. ! (gfc_resolve_inquire): Add iomsg. ! * trans_io.c: Add ioparm_iomsg and ioparm_iomsg_len. ! (gfc_build_io_library_fndecls): Add iomsg as last field. ! (gfc_trans_open): Add iomsg. ! (gfc_trans_close): Add iomsg. ! (build_fileos): Call set_string for iomsg. ! (gfc_trans_inquire): Add iomsg. ! (build_dt): Add iomsg. ! ! 2005-09-09 Richard Sandiford ! ! * match.h (gfc_match_equiv_variable): Declare. ! ! 2005-09-09 Richard Sandiford ! ! PR fortran/19239 ! * Makefile.in (fortran/trans-expr.o): Depend on dependency.h. ! * dependency.h (gfc_ref_needs_temporary_p): Declare. ! * dependency.c (gfc_ref_needs_temporary_p): New function. ! (gfc_check_fncall_dependency): Use it instead of inlined check. ! By so doing, take advantage of the fact that character substrings ! within an array reference also need a temporary. ! * trans.h (GFC_SS_VECTOR): Adjust comment. ! * trans-array.c (gfc_free_ss): Remove GFC_SS_VECTOR case. ! (gfc_set_vector_loop_bounds): New function. ! (gfc_add_loop_ss_code): Call it after evaluating the subscripts of ! a GFC_SS_SECTION. Deal with the GFC_SS_VECTOR case by evaluating ! the vector expression and caching its descriptor for use within ! the loop. ! (gfc_conv_array_index_ref, gfc_conv_vector_array_index): Delete. ! (gfc_conv_array_index_offset): Handle scalar, vector and range ! dimensions as separate cases of a switch statement. In the vector ! case, use the loop variable to calculate a vector index and use the ! referenced element as the dimension's index. Perform bounds checking ! on this final index. ! (gfc_conv_section_upper_bound): Return null for vector indexes. ! (gfc_conv_section_startstride): Give vector indexes a start value ! of 0 and a stride of 1. ! (gfc_conv_ss_startstride): Adjust for new GFC_SS_VECTOR representation. ! (gfc_conv_expr_descriptor): Expand comments. Generalize the ! handling of the !want_pointer && !direct_byref case. Use ! gfc_ref_needs_temporary_p to decide whether the variable case ! needs a temporary. ! (gfc_walk_variable_expr): Handle DIMEN_VECTOR by creating a ! GFC_SS_VECTOR index. ! * trans-expr.c: Include dependency.h. ! (gfc_trans_arrayfunc_assign): Fail if the target needs a temporary. ! ! 2005-09-09 Richard Sandiford ! ! PR fortran/21104 ! * trans.h (gfc_interface_sym_mapping, gfc_interface_mapping): Moved ! from trans-expr.c. ! (gfc_init_interface_mapping, gfc_free_interface_mapping) ! (gfc_add_interface_mapping, gfc_finish_interface_mapping) ! (gfc_apply_interface_mapping): Declare. ! * trans-array.h (gfc_set_loop_bounds_from_array_spec): Declare. ! (gfc_trans_allocate_temp_array): Add pre and post block arguments. ! * trans-array.c (gfc_set_loop_bounds_from_array_spec): New function. ! (gfc_trans_allocate_array_storage): Replace loop argument with ! separate pre and post blocks. ! (gfc_trans_allocate_temp_array): Add pre and post block arguments. ! Update call to gfc_trans_allocate_array_storage. ! (gfc_trans_array_constructor, gfc_conv_loop_setup): Adjust for new ! interface to gfc_trans_allocate_temp_array. ! * trans-expr.c (gfc_interface_sym_mapping, gfc_interface_mapping): ! Moved to trans.h. ! (gfc_init_interface_mapping, gfc_free_interface_mapping) ! (gfc_add_interface_mapping, gfc_finish_interface_mapping) ! (gfc_apply_interface_mapping): Make extern. ! (gfc_conv_function_call): Build an interface mapping for array ! return values too. Call gfc_set_loop_bounds_from_array_spec. ! Adjust call to gfc_trans_allocate_temp_array so that code is ! added to SE rather than LOOP. ! ! 2005-09-09 Richard Sandiford ! ! PR fortran/12840 ! * trans.h (gfor_fndecl_internal_realloc): Declare. ! (gfor_fndecl_internal_realloc64): Declare. ! * trans-decl.c (gfor_fndecl_internal_realloc): New variable. ! (gfor_fndecl_internal_realloc64): New variable. ! (gfc_build_builtin_function_decls): Initialize them. ! * trans-array.h (gfc_trans_allocate_temp_array): Add a fourth argument. ! * trans-array.c (gfc_trans_allocate_array_storage): Add an argument ! to say whether the array can grow later. Don't allocate the array ! on the stack if so. Don't call malloc for zero-sized arrays. ! (gfc_trans_allocate_temp_array): Add a similar argument here. ! Pass it along to gfc_trans_allocate_array_storage. ! (gfc_get_iteration_count, gfc_grow_array): New functions. ! (gfc_iterator_has_dynamic_bounds): New function. ! (gfc_get_array_constructor_element_size): New function. ! (gfc_get_array_constructor_size): New function. ! (gfc_trans_array_ctor_element): Replace pointer argument with ! a descriptor tree. ! (gfc_trans_array_constructor_subarray): Likewise. Take an extra ! argument to say whether the variable-sized part of the constructor ! must be allocated using realloc. Grow the array when this ! argument is true. ! (gfc_trans_array_constructor_value): Likewise. ! (gfc_get_array_cons_size): Delete. ! (gfc_trans_array_constructor): If the loop bound has not been set, ! split the allocation into a static part and a dynamic part. Set ! loop->to to the bounds for static part before allocating the ! temporary. Adjust call to gfc_trans_array_constructor_value. ! (gfc_conv_loop_setup): Allow any constructor to determine the ! loop bounds. Check whether the constructor has a dynamic size ! and prefer to use something else if so. Expect the loop bound ! to be set later. Adjust call to gfc_trans_allocate_temp_array. ! * trans-expr.c (gfc_conv_function_call): Adjust another call here. 2005-09-09 Paul Thomas *************** *** 58,65 **** * primary.c (match_variable) Old gfc_match_variable, made static and third argument provided to indicate if parent namespace to be visited or not. ! (gfc_match_variable): New. Interface to match_variable. ! (gfc_match_equiv_variable): New. Interface to match_variable. * trans-common.c (finish_equivalences): Provide the call to create_common with a gfc_common_header so that module equivalences are made external, rather than local. --- 1941,1948 ---- * primary.c (match_variable) Old gfc_match_variable, made static and third argument provided to indicate if parent namespace to be visited or not. ! (gfc_match_variable) New. Interface to match_variable. ! (gfc_match_equiv_variable) New. Interface to match_variable. * trans-common.c (finish_equivalences): Provide the call to create_common with a gfc_common_header so that module equivalences are made external, rather than local. *************** *** 79,88 **** * match.c (gfc_match_common): Remove unnecessary / wrong special cases for end-of-statement. 2005-09-07 Thomas Koenig PR fortran/20848 ! * symbol.c(check_conflict): Add conflict for parameter/save. 2005-09-04 Tobias Schl"uter --- 1962,2022 ---- * match.c (gfc_match_common): Remove unnecessary / wrong special cases for end-of-statement. + 2005-09-08 Janne Blomqvist + + * gfortran.texi: Add section about implemented F2003 features. + + 2005-09-08 Richard Sandiford + + PR fortran/15326 + * trans-array.c (gfc_add_loop_ss_code): Set ss->string_length in + the GFC_SS_FUNCTION case too. + * trans-expr.c (gfc_conv_function_val): Allow symbols to be bound + to function pointers as well as function decls. + (gfc_interface_sym_mapping, gfc_interface_mapping): New structures. + (gfc_init_interface_mapping, gfc_free_interface_mapping) + (gfc_get_interface_mapping_charlen, gfc_get_interface_mapping_array) + (gfc_set_interface_mapping_bounds, gfc_add_interface_mapping) + (gfc_finish_interface_mapping, gfc_apply_interface_mapping_to_cons) + (gfc_apply_interface_mapping_to_ref) + (gfc_apply_interface_mapping_to_expr) + (gfc_apply_interface_mapping): New functions. + (gfc_conv_function_call): Evaluate the arguments before working + out where the result should go. Make the null pointer case provide + the string length in parmse.string_length. Cope with non-constant + string lengths, using the above functions to evaluate such lengths. + Use a temporary typespec; don't assign to sym->cl->backend_decl. + Don't assign to se->string_length when returning a cached array + descriptor. + + 2005-09-08 Richard Sandiford + + PR fortran/19928 + * trans-array.c (gfc_conv_array_ref): Call gfc_advance_se_ss_chain + after handling scalarized references. Make "indexse" inherit from + "se" when handling AR_ELEMENTs. + (gfc_walk_variable_expr): Add GFC_SS_SCALAR entries for each + substring or scalar reference that follows an array section. + * trans-expr.c (gfc_conv_variable): When called from within a + scalarization loop, start out with "ref" pointing to the scalarized + part of the reference. Don't call gfc_advance_se_ss_chain here. + + 2005-09-07 Richard Sandiford + + PR fortran/23373 + * trans-expr.c (gfc_trans_pointer_assignment): Assign to a temporary + descriptor if the rhs is not a null pointer or variable. + 2005-09-07 Thomas Koenig PR fortran/20848 ! * symbol.c(check_conflict): Add conflict for parameter/save, ! ! 2005-09-06 Richard Sandiford ! ! PR fortran/19269 ! * simplify.c (gfc_simplify_transpose): Set the result's typespec from ! the source, not the first element of the return value. 2005-09-04 Tobias Schl"uter *************** *** 102,107 **** --- 2036,2050 ---- * resolve.c (gfc_resolve): When -fno-automatic is used, mark needed variables as SAVE. + 2005-08-27 Erik Edelmann + + * trans-array.c (gfc_trans_deferred_array): Fix comments. + + 2005-08-27 Erik Schnetter + + * primary.c (match_charkind_name): Fix typo in comment leading to + function. + 2005-08-25 Erik Edelmann PR fortran/20363 *************** *** 109,114 **** --- 2052,2104 ---- (build_sym, add_init_expr, attr_decl1): Remove calls to find_special in favor of calls to gfc_get_symbol. + 2005-08-24 Thomas Koenig + + PR fortran/17758 + * gfortran.h (symbol_attribute): Add noreturn to the structure. + (gfc_intrinsic_sym): Add noreturn to the structure. + * intrinsic.c (make_noreturn): New function. + (add_subroutines): Mark subroutines abort and exit as noreturn. + (gfc_intrinsic_sub_interface): Copy noreturn attribute from + isym to the resolved symbol. + * trans-decl.c (gfc_get_extern_function_decl): Set function + as VOLATILE (== noreturn) if the noreturn attribute is set. + + 2005-08-21 Steven G. Kargl + + * decl.c: Typo in comment. + + 2005-08-21 Steven G. Kargl + + * array.c: Bump GFC_MAX_AC_EXPAND from 100 to 65535. + + 2005-08-21 Tobias Schl"uter + + * gfortran.h (gfc_option_t): Remove source field. Add + flag_d_lines field. + (gfc_new_file): Remove arguments in prototype. + (gfc_source_file): Make 'const char *'. + * f95-lang.c (gfc_init): Use gfc_source_file instead of + gfc_option.source. Call gfc_new_file without arguments. + * invoke.texi: Document new options '-fd-lines-as-code' and + '-fd-lines-as-comment'. + * lang.opt: Add new options. Alphabetize. + * options.c (gfc_init_options): Initialize gfc_source_file instead + of gfc_option.source. Initialize gfc_option.flag_d_lines. + (form_from_filename): Move here from scanner.c. Make + 'filename' argument 'const'. + (gfc_post_options): Set gfc_source_file. Determine source form. + Warn if 'd-lines*' are used in free form. + * scanner.c (gfc_source_file): Constify. + (skip_fixed_comments): Deal with d-lines. + (get_file): Constify argument 'name'. + (load_file): Constify argument 'filename'. + (form_from_filename): Moved to options.c. + (gfc_new_file): Remove arguments. Don't initialize + gfc_source_file, don't determine source form. + * trans-const.c (gfc_init_constants): Use gfc_source_file instead + of gfc_option.source. + 2005-08-19 Steven G. Kargl PR fortran/23065 *************** *** 122,137 **** * trans-expr.c (gfc_conv_power_op): Evaluate the expression before expand. ! 2005-08-14 Paul Thomas PR fortran/21432. * gfortran.texi: Document PRINT namelist. ! 2005-08-14 Paul Thomas PR fortran/21432. * io.c (match_io): Add code to implement PRINT namelist. 2005-08-11 Francois-Xavier Coudert Steven Bosscher --- 2112,2136 ---- * trans-expr.c (gfc_conv_power_op): Evaluate the expression before expand. ! 2005-08-14 Asher Langton ! ! * parse.c (match): Enclose macro in do...while(0) and braces. ! ! 2005-08-14 Paul Thomas PR fortran/21432. * gfortran.texi: Document PRINT namelist. ! 2005-08-14 Paul Thomas PR fortran/21432. * io.c (match_io): Add code to implement PRINT namelist. + 2005-08-14 Canqun Yang + + * trans-stmt.c (gfc_trans_arithmetic_if): Optimized in case of equal + labels. + 2005-08-11 Francois-Xavier Coudert Steven Bosscher *************** *** 163,169 **** (gfc_resolve_spread): Likewise. (gfc_resolve_sum): Likewise. ! 2005-08-07 Francois-Xavier Coudert * check.c (gfc_check_ttynam_sub, gfc_check_isatty): Add check functions for new intrinsics TTYNAM and ISATTY. --- 2162,2168 ---- (gfc_resolve_spread): Likewise. (gfc_resolve_sum): Likewise. ! 2005-08-09 Francois-Xavier Coudert * check.c (gfc_check_ttynam_sub, gfc_check_isatty): Add check functions for new intrinsics TTYNAM and ISATTY. *************** *** 181,190 **** --- 2180,2215 ---- * scanner.c (preprocessor_line): Don't write beyond the end of flag buffer. + 2005-08-07 Janne Blomqvist + + PR fortran/22390 + * dump-parse-tree.c (gfc_show_code_node): Add case for FLUSH. + * gfortran.h: Add enums for FLUSH. + * io.c (gfc_free_filepos,match_file_element,match_filepos): Modify + comment appropriately. (gfc_match_flush): New function. + * match.c (gfc_match_if): Add match for flush. + * match.h: Add prototype. + * parse.c (decode_statement): Add flush to 'f' case. + (next_statement): Add case for flush. (gfc_ascii_statement): Likewise. + * resolve.c (resolve_code): Add flush case. + * st.c (gfc_free_statement): Add flush case. + * trans-io.c: Add prototype for flush. + (gfc_build_io_library_fndecls): Build fndecl for flush. + (gfc_trans_flush): New function. + * trans-stmt.h: Add prototype. + * trans.c (gfc_trans_code): Add case for flush. + 2005-08-06 Francois-Xavier Coudert * primary.c (match_hollerith_constant): Fix typo. + 2005-08-06 Kazu Hirata + + * decl.c, dump-parse-tree.c, gfortran.texi, intrinsic.texi, + invoke.texi, resolve.c, trans-array.c, trans-array.h, + trans-common.c, trans-expr.c, trans-io.c, trans.h: Fix + comment/doc typos. Follow spelling conventions. + 2005-08-06 Jakub Jelinek PR fortran/18833 *************** *** 196,221 **** REF_SUBSTRING or nothing if needed. Check that substrings don't have zero length. ! 2005-08-05 Tobias Schlueter ! Paul Thomas ! PR fortran/22010 ! Port from g95. ! * module.c (mio_namelist): New function. Correct to set ! namelist_tail and to give error on renaming namelist by use ! association. ! (mio_symbol): Call mio_namelist. 2005-08-04 Paul Brook * trans-expr.c (gfc_conv_expr, gfc_conv_expr_type): Update comments. (gfc_conv_expr_lhs): Fix assertion. (gfc_conv_expr_val): Merge post block. Set se.expr to new value. ! * trans.h: Move and update comments. 2005-07-31 Jerry DeLisle ! * intrinsic.texi: Backport from 4.1 branch. 2005-07-27 Volker Reichelt --- 2221,2272 ---- REF_SUBSTRING or nothing if needed. Check that substrings don't have zero length. ! 2005-08-05 Thomas Koenig ! * trans-expr.c (gfc_build_builtin_function_decls): Mark ! stop_numeric and stop_string as non-returning. 2005-08-04 Paul Brook * trans-expr.c (gfc_conv_expr, gfc_conv_expr_type): Update comments. (gfc_conv_expr_lhs): Fix assertion. (gfc_conv_expr_val): Merge post block. Set se.expr to new value. ! ! 2005-08-02 David Edelsohn ! ! PR fortran/22491 ! * expr.c (simplify_parameter_variable): Do not copy the subobject ! references if the expression value is a constant. ! ! * expr.c (gfc_simplify_expr): Evaluate constant substrings. 2005-07-31 Jerry DeLisle ! * intrinsic.texi: Add documentation for exponent, floor, and fnum and ! fix description of ceiling in index. ! ! 2005-07-31 Steven Bosscher ! ! * trans-decl.c (gfc_build_builtin_function_decls): Give the internal ! malloc functions the 'malloc' attribute. Give runtime_error the ! 'noreturn' attribute. ! ! 2005-07-31 Steven Bosscher ! ! * trans-stmt.c (gfc_trans_goto): Jump to the known label instead ! of the assigned goto variable. ! ! 2005-07-29 Steven Bosscher ! ! * trans-types.h (gfc_array_range_type): Add missing GTY decl for this. ! ! 2005-07-28 Andrew Pinski ! ! * fortran/f95-lang.c (language_function): Remove ! named_labels, shadowed_labels, returns_value, returns_abnormally, ! warn_about_return_type, and extern_inline fields. ! (named_labels): Remove variable. ! (gfc_init_decl_processing): Remove setting of named_labels. 2005-07-27 Volker Reichelt *************** *** 229,260 **** * data.c (gfc_assign_data_value_range): Call create_character_initializer if last_ts is a character type. ! 2005-07-22 Paul Thomas PR fortran/16940 * resolve.c (resolve_symbol): A symbol with FL_UNKNOWN is matched against interfaces in parent namespaces. If there the symtree is set to point to the interface. ! 2005-07-19 Francois-Xavier Coudert ! ! PR fortran/20842 ! * io.c (match_dt_element): Do not allow END tag in PRINT or ! WRITE statement. ! ! 2005-07-16 Andrew Pinski ! PR fortran/13257 ! * io.c (check_format): Allow an optional comma ! between descriptors. ! 2005-07-15 Paul Brook ! Backport form mainline. ! 2005-06-22 Paul Brook ! PR fortran/21034 ! * symbol.c (gfc_is_var_automatic): New function. ! (save_symbol): Use it. 2005-07-14 Jakub Jelinek --- 2280,2317 ---- * data.c (gfc_assign_data_value_range): Call create_character_initializer if last_ts is a character type. ! 2005-07-22 Manfred Hollstein ! ! * match.c (gfc_match_symbol): Fix uninitialised warnings. ! * matchexp.c (gfc_match_expr): Likewise. ! ! 2005-07-20 Giovanni Bajo ! ! Make CONSTRUCTOR use VEC to store initializers. ! * trans-array.c (gfc_build_null_descriptor, ! gfc_trans_array_constructor_value, gfc_conv_array_initializer): ! Update to cope with VEC in CONSTRUCTOR_ELTS. ! * trans-common.c (create_common): Likewise. ! * trans-expr.c (gfc_conv_structure): Likewise. ! * trans-stmt.c (gfc_trans_character_select): Use ! build_constructor_from_list instead of build_constructor. ! ! 2005-07-19 Paul Thomas PR fortran/16940 * resolve.c (resolve_symbol): A symbol with FL_UNKNOWN is matched against interfaces in parent namespaces. If there the symtree is set to point to the interface. ! 2005-07-16 David Edelsohn ! PR fortran/21730 ! * decl.c (do_parm): Adjust character initializer to character length ! of symbol before assigning. ! 2005-07-14 Steve Ellcey ! * trans-types.c (MAX_REAL_KINDS): Increase from 4 to 5. 2005-07-14 Jakub Jelinek *************** *** 288,301 **** * array.c (resolve_character_array_constructor): Allocate gfc_charlen for the array and attach to namespace list for automatic deallocation. ! 2005-07-12 Feng Wang ! Backport from the mainline: ! 2005-03-05 Tobias Schl"uter ! * trans-const.c (gfc_conv_constant_to_tree): Use correct tree ! type for COMPLEX constants. - 2005-07-07 Feng Wang PR fortran/16531 PR fortran/15966 PR fortran/18781 --- 2345,2393 ---- * array.c (resolve_character_array_constructor): Allocate gfc_charlen for the array and attach to namespace list for automatic deallocation. ! 2005-07-13 Andreas Schwab ! * Make-lang.in (fortran/dependency.o): Depend on ! $(GFORTRAN_TRANS_DEPS). ! ! 2005-07-11 Jakub Jelinek ! ! * trans-stmt.c (gfc_trans_forall_loop): Clear maskindex before ! the outermost loop. ! (gfc_trans_assign_need_temp, gfc_trans_pointer_assign_need_temp, ! gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_where_2): ! Don't clear maskindexes here. ! ! 2005-07-08 Daniel Berlin ! ! * trans-decl.c (create_function_arglist): DECL_ARG_TYPE_AS_WRITTEN ! is removed. ! ! 2005-07-08 Jakub Jelinek ! ! * primary.c (gfc_match_rvalue): Handle ENTRY the same way ! as FUNCTION. ! ! 2005-07-07 Jakub Jelinek ! ! * scanner.c (load_line): Add pbuflen argument, don't make ! buflen static. If maxlen == 0 or preprocessor_flag, ! don't truncate at buflen, but at maxlen. In xrealloc add ! 1 byte at the end for the terminating '\0'. Don't fill ! with spaces up to buflen, but gfc_option.fixed_line_length. ! (load_file): Adjust load_line caller. Add line_len variable. ! ! * scanner.c (preprocessor_line): Only set current_file->line when errors ! have not been encountered. Warn and don't crash if a file leave ! preprocessor line has no corresponding entering line. Formatting. ! ! 2005-07-07 Steven Bosscher ! ! * primary.c (match_hollerith_constant): Use int, not unsigned int, ! for the hollerith length. Fix indentation. ! ! 2005-07-07 Feng Wang PR fortran/16531 PR fortran/15966 PR fortran/18781 *************** *** 329,453 **** array. * gfortran.texi: Document Hollerith constants as extention support. ! 2005-07-11 Feng Wang ! * match.c (gfc_match_label): Remove unused variable. ! Backport from the mainline: ! 2005-06-01 Roger Sayle ! * intrinsic.c (add_conv): No longer take a "simplify" argument as ! its always gfc_convert_constant, instead take a "standard" argument. ! (add_conversions): Change all existing calls of add_conv to pass ! GFC_STD_F77 as appropriate. Additionally, if we're allowing GNU ! extensions support integer-logical and logical-integer conversions. ! (gfc_convert_type_warn): Warn about use the use of these conversions ! as a extension when appropriate, i.e. with -pedantic. ! * simplify.c (gfc_convert_constant): Add support for integer to ! logical and logical to integer conversions, using gfc_int2log and ! gfc_log2int. ! * arith.c (gfc_log2int, gfc_int2log): New functions. ! * arith.h (gfc_log2int, gfc_int2log): Prototype here. ! * gfortran.texi: Document this new GNU extension. ! 2005-05-30 Roger Sayle ! * gfortran.h (GFC_STD_LEGACY): New "standard" macro. Reindent. ! * options.c (gfc_init_options): By default, allow legacy extensions ! but warn about them. ! (gfc_post_options): Make -pedantic warn about legacy extensions ! even with -std=legacy. ! (gfc_handle_option): Make -std=gnu follow the default behaviour ! of warning about legacy extensions, but allowing them. Make the ! new -std=legacy accept everything and warn about nothing. ! * lang.opt (std=legacy): New F95 command line option. ! * invoke.texi: Document both -std=f2003 and -std=legacy. ! * gfortran.texi: Explain the two types of extensions and document ! how they are affected by the various -std= command line options. ! 2005-07-11 Jakub Jelinek ! * trans-stmt.c (gfc_trans_forall_loop): Clear maskindex before ! the outermost loop. ! (gfc_trans_assign_need_temp, gfc_trans_pointer_assign_need_temp, ! gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_where_2): ! Don't clear maskindexes here. ! 2005-07-10 Feng Wang ! Backport from the mainline: ! 2005-07-07 Feng Wang ! PR fortran/22327 ! * trans-array.c (gfc_trans_array_constructor_value): Fix index of data. ! 2005-06-24 Feng Wang ! * simplify.c (gfc_simplify_modulo): Don't clear before get result. ! 2005-07-09 Jakub Jelinek ! Backport from the mainline: ! 2005-07-08 Jakub Jelinek ! * primary.c (gfc_match_rvalue): Handle ENTRY the same way ! as FUNCTION. ! 2005-07-07 Jakub Jelinek ! * scanner.c (load_line): Add pbuflen argument, don't make ! buflen static. If maxlen == 0 or preprocessor_flag, ! don't truncate at buflen, but at maxlen. In xrealloc add ! 1 byte at the end for the terminating '\0'. Don't fill ! with spaces up to buflen, but gfc_option.fixed_line_length. ! (load_file): Adjust load_line caller. Add line_len variable. ! * scanner.c (preprocessor_line): Only set current_file->line when errors ! have not been encountered. Warn and don't crash if a file leave ! preprocessor line has no corresponding entering line. Formatting. ! 2005-07-07 Jakub Jelinek ! * decl.c (gfc_match_entry): Allow ENTRY without parentheses ! even in FUNCTIONs. - 2005-06-25 Jakub Jelinek * trans-stmt.c (gfc_trans_forall_1): Prefer to use smaller logical type than boolean_type_node. ! 2005-06-13 Jakub Jelinek ! * trans-expr.c (gfc_conv_function_call): Return int instead of ! void. Use a local variable for has_alternate_specifier and ! return it. Avoid modification of function type's return value ! in place, since it may be shared. ! * trans.h (has_alternate_specifier): Remove. ! (gfc_conv_function_call): Change return type. ! * trans-stmt.c (has_alternate_specifier): Remove. ! (gfc_trans_call): Add a local has_alternate_specifier variable, ! set it from gfc_conv_function_call return value. ! 2005-07-08 Steven G. Kargl ! Backport from the mainline: ! PR fortran/21257 ! (port from g95) ! * match.c (gfc_match_label): Detect duplicate labels. ! * gfortran.dg/duplicate_labels.f90: New test. ! PR fortran/19926 ! * primary.c (gfc_match_rvalue): expr_type can be EXPR_CONSTANT ! for an array; check that sym->as is NULL. ! * gfortran.dg/pr19926.f90: New test. ! PR fortran/17792 ! PR fortran/21375 ! * trans-array.c (gfc_array_deallocate): pstat is new argument ! (gfc_array_allocate): update gfc_array_deallocate() call. ! (gfc_trans_deferred_array): ditto. ! * trans-array.h: update gfc_array_deallocate() prototype. ! * trans-decl.c (gfc_build_builtin_function_decls): update declaration ! * trans-stmt.c (gfc_trans_deallocate): Implement STAT= feature. ! * intrinsic.c (gfc_intrinsic_func_interface): Enable errors for generic ! functions whose simplification routine return FAILURE. ! 2005-07-07 Release Manager ! * GCC 4.0.1 released. 2005-06-19 Francois-Xavier Coudert --- 2421,2509 ---- array. * gfortran.texi: Document Hollerith constants as extention support. ! 2005-07-07 Feng Wang ! PR fortran/22327 ! * trans-array.c (gfc_trans_array_constructor_value): Fix index of data. ! 2005-07-07 Jakub Jelinek ! * decl.c (gfc_match_entry): Allow ENTRY without parentheses ! even in FUNCTIONs. ! 2005-07-03 Kazu Hirata ! * gfortran.texi, intrinsic.texi: Fix typos. ! * symbol.c: Fix a comment typo. ! 2005-07-03 Kaveh R. Ghazi ! * error.c (error_printf, error_print): Use ATTRIBUTE_GCC_GFC. ! * gfortran.h (ATTRIBUTE_GCC_GFC): New. ! (gfc_warning, gfc_warning_now, gfc_error, gfc_error_now, ! gfc_fatal_error, gfc_internal_error, gfc_notify_std): Use ! ATTRIBUTE_GCC_GFC. ! 2005-07-03 Francois-Xavier Coudert ! PR fortran/20842 ! * io.c (match_dt_element): Do not allow END tag in PRINT or ! WRITE statement. ! 2005-07-02 Joseph S. Myers ! * lang.opt: Remove "." from end of help texts. ! 2005-07-01 Jerry DeLisle ! * gfortran.texi: Fix typos and grammar. ! * invoke.texi: Fix typos and grammar. ! * intrinsic.texi: Add documentaion for eoshift, epsilon, etime, and ! exit. Fixed alignment of text for dtime syntax. Fixed a few line ! lengths. ! 2005-06-25 Jakub Jelinek * trans-stmt.c (gfc_trans_forall_1): Prefer to use smaller logical type than boolean_type_node. ! 2005-06-25 Kelley Cook ! * all files: Update FSF address in copyright headers. ! 2005-06-24 Jerry DeLisle ! PR fortran/21915 ! * gfortran.h: Add symbols for new intrinsic functions. ! * intrinsic.c: Add new functions acosh, asinh, and atanh. ! * intrinsic.h: Add prototypes for the new functions. ! * iresolve.c (gfc_resolve_acosh): New function. ! (gfc_resolve_asinh): New function. ! (gfc_resolve_atanh): New function. ! * mathbuiltins.def: Add defines. ! * simplify.c (gfc_simplify_acosh): New function. ! (gfc_simplify_asinh): New function. ! (gfc_simplify_atanh): New function. ! 2005-06-24 Feng Wang ! * simplify.c (gfc_simplify_modulo): Don't clear before get result. ! 2005-06-22 Paul Brook ! PR fortran/21034 ! * symbol.c (gfc_is_var_automatic): New function. ! (save_symbol): Use it. ! ! 2005-06-21 Tobias Schlueter ! Paul Thomas ! ! PR fortran/22010 ! Port from g95. ! * module.c (mio_namelist): New function. Correct to set ! namelist_tail and to give error on renaming namelist by use ! association. ! (mio_symbol): Call mio_namelist. 2005-06-19 Francois-Xavier Coudert *************** *** 459,473 **** * gfortran.texi: Remove mention of -fno-backslash as a possible extension. ! 2005-06-20 Erik Edelmann * intrinsic.c (check_intrinsic_standard): Fix spelling error in a warning message. ! 2005-06-18 Francois-Xavier Coudert ! * match.c (match_arithmetic_if): Arithmetic IF is obsolete in ! Fortran 95. 2005-06-13 Jakub Jelinek --- 2515,2549 ---- * gfortran.texi: Remove mention of -fno-backslash as a possible extension. ! 2005-06-20 Steven G. Kargl ! (port from g95) ! ! PR fortran/21257 ! * match.c (gfc_match_label): Detect duplicate labels. ! ! ! 2005-06-20 Erik Edelmann * intrinsic.c (check_intrinsic_standard): Fix spelling error in a warning message. ! 2005-06-18 Erik Edelman ! Steven G. Kargl ! PR fortran/19926 ! * primary.c (gfc_match_rvalue): expr_type can be EXPR_CONSTANT ! for an array; check that sym->as is NULL. ! ! ! 2005-06-18 Steven G. Kargl ! ! * intrinsic.c (gfc_intrinsic_func_interface): Enable errors for generic ! functions whose simplification routine return FAILURE. ! ! 2005-06-13 Geoffrey Keating ! ! * Make-lang.in (fortran.install-man): Doesn't depend on installdirs. ! (rule for installing f95.1 manpage): Does depend on installdirs. 2005-06-13 Jakub Jelinek *************** *** 475,500 **** * trans-stmt.c (gfc_trans_forall_loop): Only increment maskindex in the innermost loop. ! 2005-06-05 Jakub Jelinek ! Backport from the mainline: ! 2005-04-17 Paul Thomas ! PR fortran/17472 ! PR fortran/18209 ! PR fortran/18396 ! PR fortran/19467 ! PR fortran/19657 ! * fortran/trans-io.c (gfc_build_io_library_fndecls): Create ! declaration for st_set_nml_var and st_set_nml_var_dim. Remove ! declarations of old namelist functions. ! (build_dt): Simplified call to transfer_namelist_element. ! (nml_get_addr_expr): Generates address expression for start of ! object data. New function. ! (nml_full_name): Qualified name for derived type components. New ! function. ! (transfer_namelist_element): Modified for calls to new functions ! and improved derived type handling. 2005-06-05 Tobias Schl"uter --- 2551,2609 ---- * trans-stmt.c (gfc_trans_forall_loop): Only increment maskindex in the innermost loop. ! * trans-expr.c (gfc_conv_function_call): Return int instead of ! void. Use a local variable for has_alternate_specifier and ! return it. Avoid modification of function type's return value ! in place, since it may be shared. ! * trans.h (has_alternate_specifier): Remove. ! (gfc_conv_function_call): Change return type. ! * trans-stmt.c (has_alternate_specifier): Remove. ! (gfc_trans_call): Add a local has_alternate_specifier variable, ! set it from gfc_conv_function_call return value. ! 2005-06-12 Richard Henderson ! * trans-array.c (gfc_conv_descriptor_data_get): Rename from ! gfc_conv_descriptor_data. Cast the result to the DATAPTR type. ! (gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr): New. ! (gfc_trans_allocate_array_storage): Use them. ! (gfc_array_allocate, gfc_array_deallocate): Likewise. ! (gfc_trans_dummy_array_bias, gfc_conv_expr_descriptor): Likewise. ! (gfc_trans_deferred_array): Likewise. ! * trans-expr.c (gfc_conv_function_call): Likewise. ! (gfc_trans_subcomponent_assign): Likewise. ! (gfc_trans_pointer_assignment): Likewise. ! * trans-intrinsic.c (gfc_conv_allocated): Likewise. ! * trans-types.c (gfc_array_descriptor_base): New. ! (gfc_get_element_type): Use GFC_TYPE_ARRAY_DATAPTR_TYPE. ! (gfc_get_array_descriptor_base): Break out from ... ! (gfc_get_array_type_bounds): ... here. Create type variants. ! * trans-array.h (gfc_conv_descriptor_data_get): Declare. ! (gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr): Declare. ! ! 2005-06-12 Tobias Schl"uter ! ! * trans-expr.c (gfc_conv_variable): POINTER results don't need f2c ! calling conventions. Look at sym instead of sym->result. ! * trans-types.c (gfc_sym_type): Remove workaround for frontend bug. ! Remove condition which is always false with workaround removed. ! (gfc_return_by_reference): Always look at sym, never at sym->result. ! ! 2005-06-11 Steven G. Kargl ! ! PR fortran/17792 ! PR fortran/21375 ! * trans-array.c (gfc_array_deallocate): pstat is new argument ! (gfc_array_allocate): update gfc_array_deallocate() call. ! (gfc_trans_deferred_array): ditto. ! * trans-array.h: update gfc_array_deallocate() prototype. ! * trans-decl.c (gfc_build_builtin_function_decls): update declaration ! * trans-stmt.c (gfc_trans_deallocate): Implement STAT= feature. ! ! 2005-06-07 Jerry DeLisle ! ! * intrinsic.texi: Add documentation for dcmplx, digits, ! dim, idim, ddim, dot_product, dprod, dreal, and dtime. 2005-06-05 Tobias Schl"uter *************** *** 506,554 **** * invoke.texi: Fix description of flags required for compatibility with g77. - 2005-06-05 Paul Thomas - - PR fortran/18109 - PR fortran/18283 - PR fortran/19107 - PR fortran/16939 - PR fortran/17192 - PR fortran/17193 - PR fortran/17202 - PR fortran/18689 - PR fortran/18890 - * fortran/trans-array.c (gfc_conv_expr_descriptor): Obtain the - string length from the expression typespec character length value - and set temp_ss->stringlength and backend_decl. Obtain the - tree expression from gfc_conv_expr rather than gfc_conv_expr_val. - Dereference the expression to obtain the character. - * fortran/trans-array.c (gfc_conv_resolve_dependencies): Add string - length to temp_ss for character pointer array assignments. - * fortran/trans-expr.c (gfc_conv_component_ref): Remove the - dereference of scalar character pointer structure components. - * fortran/trans-expr.c (gfc_trans_subarray_assign): Obtain the - string length for the structure component from the component - expression. - * fortran/trans-expr.c (gfc_conv_variable): Correct errors in - dereferencing of characters and character pointers. - * fortran/trans-expr.c (gfc_conv_function_call): Provide string - length as return argument for various kinds of handling of return. - Return a char[]* temporary for character pointer functions and - dereference the temporary upon return. - 2005-06-04 Tobias Schl"uter ! Erik Schnetter PR fortran/19195 * trans.c (gfc_get_backend_locus): Remove unnecessary adjustment, remove FIXME comment. ! 2005-06-04 Zdenek Dvorak ! PR fortran/16898 ! * trans-types.c (gfc_array_range_type): New variable. ! (gfc_init_types): Initialize gfc_array_range_type. ! (gfc_get_array_type_bounds): Use gfc_array_range_type. 2005-06-04 Tobias Schl"uter Erik Edelmann --- 2615,2631 ---- * invoke.texi: Fix description of flags required for compatibility with g77. 2005-06-04 Tobias Schl"uter ! Erik Schnetter PR fortran/19195 * trans.c (gfc_get_backend_locus): Remove unnecessary adjustment, remove FIXME comment. ! 2005-06-04 Tobias Schl"uter ! * match.c (match_forall_iterator): Don't immediately give error if '=' ! is not followed by an expression. 2005-06-04 Tobias Schl"uter Erik Edelmann *************** *** 556,598 **** * array.c (gfc_match_array_constructor): Disallow empty array constructor. ! 2005-06-04 Tobias Schl"uter ! * match.c (match_forall_iterator): Don't immediately give error if '=' ! is not followed by an expression. ! 2005-06-01 Tobias Schl"uter ! * gfortran.h (gfc_option): Add flag_f2c. ! * invoke.texi: Document '-ff2c' command line option. Adapt ! documentation for '-fno-second-underscore' and '-fno-underscoring'. ! * lang.opt (ff2c): New entry. ! * options.c (gfc-init_options): Set default calling convention ! to -fno-f2c and -fno-second-underscore. ! (handle_options): Set gfc_option.flag_f2c according to requested ! calling convention. ! * trans-decl.c (gfc_get_extern_function_decl): Use special f2c ! intrinsics where necessary. ! (gfc_trans_deferred_vars): Change todo error to assertion. ! * trans-expr.c (gfc_conv_variable): Dereference access ! to hidden result argument. ! (gfc_conv_function_call): Add hidden result argument to argument ! list if f2c calling conventions requested. Slightly restructure ! tests. Convert result of default REAL function to requested type ! if f2c calling conventions are used. Dereference COMPLEX result ! if f2c cc are used. ! * trans-types.c (gfc_sym_type): Return double for default REAL ! function if f2c cc are used. ! (gfc_return_by_reference): Slightly restructure logic. Return ! COMPLEX by reference depending on calling conventions. ! (gfc_get_function_type): Correctly make hidden result argument a ! pass-by-reference argument for COMPLEX. Remove old code which does ! this for derived types. ! * resolve.c (resolve_symbol): Copy 'pointer' and 'dimension' ! attribute from result symbol to function symbol. ! * trans-expr.c (gfc_conv_function_call): Check sym for attribute ! 'dimension' instead of sym->result. 2005-06-01 Jakub Jelinek --- 2633,2666 ---- * array.c (gfc_match_array_constructor): Disallow empty array constructor. ! 2005-06-03 Jerry DeLisle ! * fortran/intrinsic.texi: Add documentation for ! command_argument_count, conjg, dconjg, count, ! cpu_time, cshift, date_and_time, dble, dfloat. ! 2005-06-01 Roger Sayle ! * intrinsic.c (add_conv): No longer take a "simplify" argument as ! its always gfc_convert_constant, instead take a "standard" argument. ! (add_conversions): Change all existing calls of add_conv to pass ! GFC_STD_F77 as appropriate. Additionally, if we're allowing GNU ! extensions support integer-logical and logical-integer conversions. ! (gfc_convert_type_warn): Warn about use the use of these conversions ! as a extension when appropriate, i.e. with -pedantic. ! * simplify.c (gfc_convert_constant): Add support for integer to ! logical and logical to integer conversions, using gfc_int2log and ! gfc_log2int. ! * arith.c (gfc_log2int, gfc_int2log): New functions. ! * arith.h (gfc_log2int, gfc_int2log): Prototype here. ! * gfortran.texi: Document this new GNU extension. ! 2005-06-01 Paul Thomas ! ! * fortran/trans-expr.c (gfc_conv_variable): Clean up bracketting. ! * fortran/trans-expr.c (gfc_conv_function_call): Insert spaces. ! Correct comments and replace convert of integer_one_node with ! build_int_cst. 2005-06-01 Jakub Jelinek *************** *** 609,618 **** PR fortran/20883 * fortran/io.c (resolve_tag): Fix error message. 2005-05-29 Janne Blomqvist ! Steven G. Kargl ! ! PR fortran/20846 * io.c (gfc_match_inquire): Implement constraints on UNIT and FILE usage. 2005-05-29 Francois-Xavier Coudert --- 2677,2745 ---- PR fortran/20883 * fortran/io.c (resolve_tag): Fix error message. + 2005-05-31 Kaveh R. Ghazi + + * fortran/trans-decl.c: Don't include errors.h. + * fortran/Make-lang.in: Updates dependencies. + + 2005-05-31 Paul Thomas + + PR fortran/18109 + PR fortran/18283 + PR fortran/19107 + * fortran/trans-array.c (gfc_conv_expr_descriptor): Obtain the + string length from the expression typespec character length value + and set temp_ss->stringlength and backend_decl. Obtain the + tree expression from gfc_conv_expr rather than gfc_conv_expr_val. + Dereference the expression to obtain the character. + * fortran/trans-expr.c (gfc_conv_component_ref): Remove the + dereference of scalar character pointer structure components. + * fortran/trans-expr.c (gfc_trans_subarray_assign): Obtain the + string length for the structure component from the component + expression. + + 2005-05-30 Roger Sayle + + * gfortran.h (GFC_STD_LEGACY): New "standard" macro. Reindent. + * options.c (gfc_init_options): By default, allow legacy extensions + but warn about them. + (gfc_post_options): Make -pedantic warn about legacy extensions + even with -std=legacy. + (gfc_handle_option): Make -std=gnu follow the default behaviour + of warning about legacy extensions, but allowing them. Make the + new -std=legacy accept everything and warn about nothing. + * lang.opt (std=legacy): New F95 command line option. + * invoke.texi: Document both -std=f2003 and -std=legacy. + * gfortran.texi: Explain the two types of extensions and document + how they are affected by the various -std= command line options. + + 2005-05-30 Kazu Hirata + + * trans-expr.c: Remove trailing ^M. + + * trans-expr.c: Fix comment typos. + + 2005-05-29 Paul Thomas + + PR fortran/16939 + PR fortran/17192 + PR fortran/17193 + PR fortran/17202 + PR fortran/18689 + PR fortran/18890 + * fortran/trans-array.c (gfc_conv_resolve_dependencies): Add string + length to temp_ss for character pointer array assignments. + * fortran/trans-expr.c (gfc_conv_variable): Correct errors in + dereferencing of characters and character pointers. + * fortran/trans-expr.c (gfc_conv_function_call): Provide string + length as return argument for various kinds of handling of return. + Return a char[]* temporary for character pointer functions and + dereference the temporary upon return. + 2005-05-29 Janne Blomqvist ! Steven G. Kargl ! ! fortran/PR20846 * io.c (gfc_match_inquire): Implement constraints on UNIT and FILE usage. 2005-05-29 Francois-Xavier Coudert *************** *** 621,651 **** * io.c (format_item_1): Add check and extension warning for $ edit descriptor. 2005-05-28 Jerry DeLisle ! Steven G. Kargl ! * intrinsic.texi: added documentation for BIT_SIZE, BTEST, CHAR, CEILING, ! CMPLX, ATAN2, and ASSOCIATED. 2005-05-27 Steven G. Kargl * trans-array.c (gfc_trans_deferred_array): Use build_int_cst to force like types in comparsion. ! 2005-05-21 Andrew Pinski ! Backport from the mainline: ! 2005-03-14 Zdenek Dvorak ! * fortran/trans-intrinsic.c (gfc_conv_intrinsic_ishft): Convert ! the argument of the shift to the unsigned type. 2005-05-18 Thomas Koenig PR libfortran/21127 ! * fortran/iresolve.c (gfc_resolve_reshape): Add gfc_type_letter (BT_COMPLEX) for complex to to resolved function name. 2005-05-18 Tobias Schl"uter * f95-lang.c (gfc_init_builtin_functions): Define BUILT_IN_TRUNC --- 2748,2795 ---- * io.c (format_item_1): Add check and extension warning for $ edit descriptor. + 2005-05-28 Steven G. Kargl + + * arith.c (gfc_arith_init_1): Fix off by one problem; + (gfc_check_integer_range): Chop extra bits in subnormal numbers. + 2005-05-28 Jerry DeLisle ! Steven G. Kargl ! * intrinsic.texi: added documentation for BIT_SIZE, BTEST, CHAR, CEILING ! and CMPLX 2005-05-27 Steven G. Kargl * trans-array.c (gfc_trans_deferred_array): Use build_int_cst to force like types in comparsion. ! 2005-05-26 Kazu Hirata ! * data.c, parse.c, trans-array.c, trans-decl.c, ! trans-intrinsic.c, trans-stmt.c, trans-types.c, trans.c, ! trans.h: Fix comment typos. Follow spelling conventions. ! ! 2005-05-22 Roger Sayle ! ! * gfortran.texi: Document some more GNU extensions. ! ! 2005-05-22 Francois-Xavier Coudert ! ! * error.c (gfc_warning): Fix typo in comment. 2005-05-18 Thomas Koenig PR libfortran/21127 ! * fortran/iresolve.c (gfc_resolve_reshape): Add gfc_type_letter (BT_COMPLEX) for complex to to resolved function name. + 2005-05-18 Erik Edelmann + + * array.c (gfc_match_array_constructor): Support [ ... ] + style array constructors. + 2005-05-18 Tobias Schl"uter * f95-lang.c (gfc_init_builtin_functions): Define BUILT_IN_TRUNC *************** *** 662,667 **** --- 2806,2817 ---- * trans-const.c (gfc_conv_const_charlen): Use gfc_charlen_type_node to build character length. + 2005-05-17 Zdenek Dvorak + + * trans-types.c (gfc_array_range_type): New variable. + (gfc_init_types): Initialize gfc_array_range_type. + (gfc_get_array_type_bounds): Use gfc_array_range_type. + 2005-05-17 Jakub Jelinek PR fortran/15080 *************** *** 690,704 **** (gfc_trans_where_2): Initialize mask indexes before calling gfc_trans_nested_forall_loop. ! 2005-05-15 Feng Wang ! Jerry DeLisle PR fortran/17432 ! * trans-stmt.c (gfc_trans_label_assign): fix pointer type, to resolve ICE on assign of format label. * trans-io.c (set_string): add fold-convert to properly handle assigned format label in write. ! 2005-05-13 Paul Brook * trans-stmt.c (gfc_trans_forall_1): Fix comment typo. --- 2840,2854 ---- (gfc_trans_where_2): Initialize mask indexes before calling gfc_trans_nested_forall_loop. ! 2005-05-15 Feng Wang ! Jerry DeLisle PR fortran/17432 ! * trans-stmt.c (gfc_trans_label_assign): fix pointer type, to resolve ICE on assign of format label. * trans-io.c (set_string): add fold-convert to properly handle assigned format label in write. ! 2005-05-13 Paul Brook * trans-stmt.c (gfc_trans_forall_1): Fix comment typo. *************** *** 713,724 **** --- 2863,2930 ---- * io.c (check_format): Look for literal characters inside hollerith constant. + 2005-05-11 Tobias Schl"uter + + * resolve.c (resolve_symbol): Copy 'pointer' and 'dimension' + attribute from result symbol to function symbol. + * trans-expr.c (gfc_conv_function_call): Look at sym->attr.dimension + instead of sym->result->attr.dimension. + + 2005-05-10 Tobias Schl"uter + + PR fortran/20178 + * gfortran.h (gfc_option): Add flag_f2c. + * invoke.texi: Document '-ff2c' command line option. Adapt + documentation for '-fno-second-underscore' and '-fno-underscoring'. + * lang.opt (ff2c): New entry. + * options.c (gfc-init_options): Set default calling convention + to -fno-f2c. Mark -fsecond-underscore unset. + (gfc_post_options): Set -fsecond-underscore if not explicitly set + by user. + (handle_options): Set gfc_option.flag_f2c according to requested + calling convention. + * trans-decl.c (gfc_get_extern_function_decl): Use special f2c + intrinsics where necessary. + (gfc_trans_deferred_vars): Change todo error to assertion. + * trans-expr.c (gfc_conv_variable): Dereference access + to hidden result argument. + (gfc_conv_function_call): Add hidden result argument to argument + list if f2c calling conventions requested. Slightly restructure + tests. Convert result of default REAL function to requested type + if f2c calling conventions are used. Dereference COMPLEX result + if f2c cc are used. + * trans-types.c (gfc_sym_type): Return double for default REAL + function if f2c cc are used. + (gfc_return_by_reference): Slightly restructure logic. Return + COMPLEX by reference depending on calling conventions. + (gfc_get_function_type): Correctly make hidden result argument a + pass-by-reference argument for COMPLEX. Remove old code which does + this for derived types. + 2005-05-09 Tobias Schl"uter * match.c (gfc_match_return): Only require space after keyword when it is obligatory. Only give stdwarn to after matching is successful. * dump-parse-tree.c (gfc_show_symbol): Deal with alternate returns. + 2005-05-08 Kazu Hirata + + * intrinsic.texi: Fix typos. + + 2005-05-07 Steven G. Kargl + + * intrinsic.texi: Document ASSOCIATED and ATAN2. Update Bessel function + description to include information about scalar arguments. + + 2005-05-03 Kazu Hirata + + * Make-lang.in, dump-parse-tree.c, invoke.texi, lang.opt, + match.h, trans-array.h: Update copyright. + + 2005-04-29 Tom Tromey + + * f95-lang.c (poplevel): Updated for change to build_block. + 2005-04-29 Jakub Jelinek PR fortran/13082 *************** *** 752,766 **** 2005-04-29 Francois-Xavier Coudert ! PR fortran/16861 ! * resolve.c (resolve_variable): If e->symtree is not set, this ! ought to be a FAILURE, and not a segfault. 2005-04-29 Paul Brook * trans-expr.c (gfc_conv_expr_present): Fix broken assert. Update comment. 2005-04-28 Francois-Xavier Coudert PR fortran/20865 --- 2958,2984 ---- 2005-04-29 Francois-Xavier Coudert ! * gfortran.h (gfc_namespace): Add seen_implicit_none field, ! Tobias forgot this in previous commit. 2005-04-29 Paul Brook * trans-expr.c (gfc_conv_expr_present): Fix broken assert. Update comment. + 2005-04-29 Tobias Schl"uter + + * gfortran.h (gfc_namespace): Add seen_implicit_none field. + * symbol.c (gfc_set_implicit_none): Give error if there's a previous + IMPLICIT NONE, set seen_implicit_none. + (gfc_merge_new_implicit): Error if there's an IMPLICIT NONE statement. + + 2005-04-28 Tobias Schl"uter + + * gfortran.h (gfc_gsymbol): Make name a const char *. + * symbol.c (gfc_get_gsymbol): Allocate gsymbol name via + gfc_get_string. + 2005-04-28 Francois-Xavier Coudert PR fortran/20865 *************** *** 789,820 **** * trans-common.c (translate_common): Cast offset and common_segment->offset to type int for warning message. ! 2005-04-23 Richard Guenther PR fortran/14569 * gfortran.h (gfc_linebuf): Add truncated field. ! * parse.c (next_statement): Handle warning for truncated lines. * scanner.c (load_line): Return if line was truncated. No longer warn for truncated lines. Remove unused parameters. (load_file): Store load_line return value to linebuf. - (gfc_next_char_literal): Reset truncation flag for lines ending - in a comment for both fixed and free form. (gfc_error_recovery): Do not advance line at the end. ! 2005-04-20 Release Manager ! * GCC 4.0.0 released. ! 2005-04-12 Toon Moene ! * gfortran.texi: Warn about the limited abilities ! of gfortran at this release. ! * invoke.texi: Ditto. 2005-04-09 Francois-Xavier Coudert * match.c (match_arithmetic_if): Remove gfc_ prefix and correct comment according to GNU coding style. 2005-04-08 Diego Novillo --- 3007,3123 ---- * trans-common.c (translate_common): Cast offset and common_segment->offset to type int for warning message. ! 2005-04-23 DJ Delorie ! ! * trans-decl.c: Adjust warning() callers. ! ! 2005-04-23 Tobias Schl"uter ! ! * trans-const.c (gfc_conv_mpfr_to_tree): Use hexadecimal string as ! intermediate representation. Fix typo in comment. ! ! 2005-04-21 Steven G. Kargl ! ! * trans-const.c (gfc_conv_mpfr_to_tree): Remove unneeded computation; ! simplify logic; Add a gcc_assert. ! ! 2005-04-19 Steven G. Kargl ! ! * trans-const.c (gfc_conv_mpz_to_tree): Fix comment. ! ! 2005-04-19 Arnaud Desitter ! Steven G. Kargl ! ! * invoke.texi: Update -Waliasing description ! ! 2005-04-19 Francois-Xavier Coudert ! ! PR fortran/16861 ! * resolve.c (resolve_variable): If e->symtree is not set, this ! ought to be a FAILURE, and not a segfault. ! ! 2005-04-17 Paul Thomas ! ! PR fortran/17472 ! PR fortran/18209 ! PR fortran/18396 ! PR fortran/19467 ! PR fortran/19657 ! * fortran/trans-io.c (gfc_build_io_library_fndecls): Create ! declaration for st_set_nml_var and st_set_nml_var_dim. Remove ! declarations of old namelist functions. ! (build_dt): Simplified call to transfer_namelist_element. ! (nml_get_addr_expr): Generates address expression for start of ! object data. New function. ! (nml_full_name): Qualified name for derived type components. New ! function. ! (transfer_namelist_element): Modified for calls to new functions ! and improved derived type handling. ! ! 2005-04-17 Richard Guenther ! ! * scanner.c (gfc_next_char_literal): Reset truncation flag ! for lines ending in a comment for both fixed and free form. ! (load_line): Do not set truncated flag if only truncating ! the EOL marker. ! ! 2005-04-15 Richard Guenther PR fortran/14569 * gfortran.h (gfc_linebuf): Add truncated field. ! * parse.c (next_statement): Handle warning for truncated ! lines. * scanner.c (load_line): Return if line was truncated. No longer warn for truncated lines. Remove unused parameters. (load_file): Store load_line return value to linebuf. (gfc_error_recovery): Do not advance line at the end. ! 2005-04-14 Steven G. Kargl ! * gfortran.h (gfc_real_info): Add subnormal struct member. ! * arith.c (gfc_arith_init_1): Set it. ! (gfc_check_real_range): Use it. ! * simplify.c (gfc_simplify_nearest): Fix nearest(0.,1.). ! 2005-04-12 Kazu Hirata ! * simplify.c: Fix a comment typo. ! ! 2005-04-11 Richard Sandiford ! ! * lang.opt: Refer to the GCC internals documentation instead of c.opt. ! ! 2005-04-11 Tobias Schl"uter ! ! * simplify.c (gfc_simplify_nearest): Overhaul. ! ! 2005-04-10 Kazu Hirata ! ! * interface.c: Fix a comment typo. ! ! 2005-04-10 Francois-Xavier Coudert ! ! * match.c (match_arithmetic_if): Arithmetic IF is obsolete in ! Fortran 95. ! ! 2005-04-09 Steven G. Kargl ! ! * simplify.c (gfc_simplify_anint): Use mpfr_round() ! (gfc_simplify_dnint): ditto. ! (gfc_simplify_nint): ditto. ! ! 2005-04-09 Andrew Pinski ! ! PR fortran/13257 ! * io.c (check_format): Allow an optional comma ! between descriptors. 2005-04-09 Francois-Xavier Coudert * match.c (match_arithmetic_if): Remove gfc_ prefix and correct comment according to GNU coding style. + (gfc_match_if): Remove gfc_ prefix in call to + match_arithmetic_if. 2005-04-08 Diego Novillo *************** *** 834,840 **** 2005-04-06 Steven G. Kargl ! * invoke.texi: Remove documentation of -std=f90. 2005-04-06 Tobias Schl"uter --- 3137,3143 ---- 2005-04-06 Steven G. Kargl ! * invoke.texi: Remove documentation of -std=f90 2005-04-06 Tobias Schl"uter *************** *** 870,901 **** 2005-04-02 Steven G. Kargl ! * intrinsic.texi: Document ALLOCATED, ANINT, ANY, ASIN; Fix typos. ! 2005-03-30 Canqun Yang ! * trans-common.c (create_common): Build RECORD_NODE for common blocks ! contain no equivalence objects. ! (add_equivalences): New argument saw_equiv. ! (trans_common): New local variable saw_equiv. ! (finish_equivalences): Add a local variable dummy, Always pass true ! for the 3rd parameter to create_common. 2005-03-29 Steven G. Kargl * gfortran.h (option_t): Change d8, i8, r8 to flag_default_double, flag_default_integer, flag_default_real * invoke.texi: Update documentation ! * lang.opt: Remove d8, i8, r8 definitions; Add fdefault-double-8 fdefault-integer-8, and fdefault-real-8 definitions. * options.c (gfc_init_options): Set option defaults (gfc_handle_option): Handle command line options. * trans-types.c (gfc_init_kinds): Use options. 2005-03-27 Steven G. Kargl * intrinsic.texi: Document AIMAG, AINT, ALL 2005-03-25 Steven G. Kargl * intrinsic.texi: Fix "make dvi" --- 3173,3218 ---- 2005-04-02 Steven G. Kargl ! * intrinsic.texi: Document ALLOCATED, ANINT, ANY, ASIN; fix typos ! 2005-04-01 Kazu Hirata ! * decl.c, f95-lang.c, interface.c, module.c, trans-stmt.c, ! trans.h: Fix comment typos. 2005-03-29 Steven G. Kargl * gfortran.h (option_t): Change d8, i8, r8 to flag_default_double, flag_default_integer, flag_default_real * invoke.texi: Update documentation ! * lang.opt: Remove d8, i8, r8 definitions; Add fdefault-double-8 fdefault-integer-8, and fdefault-real-8 definitions. * options.c (gfc_init_options): Set option defaults (gfc_handle_option): Handle command line options. * trans-types.c (gfc_init_kinds): Use options. + 2005-03-29 Keith Besaw + + * f95-lang.c (builtin_function): Process the attrs parameter + and apply the "const" attribute to the builtin if found. + 2005-03-27 Steven G. Kargl * intrinsic.texi: Document AIMAG, AINT, ALL + 2005-03-26 Steven G. Kargl + + * arith.c (check_result): Fix illogical logic. + + 2005-03-26 Canqun Yang + + * trans-common.c (create_common): Build RECORD_NODE for common blocks + contain no equivalence objects. + (add_equivalences): New argument saw_equiv. + (trans_common): New local variable saw_equiv. + (finish_equivalences): Add a local variable dummy, Always pass true + for the 3rd parameter to create_common. + 2005-03-25 Steven G. Kargl * intrinsic.texi: Fix "make dvi" *************** *** 905,910 **** --- 3222,3261 ---- * intrinsic.texi: New file. * gfortran.texi: Include it; white space change; fix typo. + 2005-03-23 Joseph S. Myers + + * f95-lang.c (LANG_HOOKS_TRUTHVALUE_CONVERSION): Remove. + + 2005-03-23 Steven Bosscher + + * convert.c (convert): Replace fold (buildN (...)) with fold_buildN. + * trans-array.c (gfc_trans_allocate_array_storage, + gfc_trans_allocate_temp_array gfc_trans_array_constructor_value, + gfc_conv_array_index_ref, gfc_trans_array_bound_check, + gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, + gfc_conv_array_ref, gfc_trans_preloop_setup, gfc_conv_ss_startstride, + gfc_conv_loop_setup, gfc_array_init_size, gfc_trans_array_bounds, + gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias, + gfc_conv_expr_descriptor): Likewise. + * trans-expr.c (gfc_conv_powi, gfc_conv_string_tmp, + gfc_conv_concat_op, gfc_conv_expr_op): Likewise. + * trans-intrinsic.c (build_round_expr, gfc_conv_intrinsic_bound, + gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_sign, + gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval, + gfc_conv_intrinsic_btest, gfc_conv_intrinsic_bitop, + gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ibits, + gfc_conv_intrinsic_ishft, gfc_conv_intrinsic_ishftc, + gfc_conv_intrinsic_merge, prepare_arg_info, + gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_repeat): Likewise. + * trans-stmt.c (gfc_trans_simple_do, gfc_trans_do, gfc_trans_do_while, + gfc_trans_forall_loop, gfc_do_allocate, generate_loop_for_temp_to_lhs, + generate_loop_for_rhs_to_temp, compute_inner_temp_size, + allocate_temp_for_forall_nest, gfc_trans_pointer_assign_need_temp, + gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_where_assign): + Likewise. + * trans-types.c (gfc_get_dtype, gfc_get_array_type_bounds): Likewise. + * trans.c (gfc_add_modify_expr): Likewise. + 2005-03-22 Francois-Xavier Coudert * check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill, *************** *** 945,954 **** --- 3296,3326 ---- (gfc_arith_power): Remove special casing of zero to integral power zero. + 2005-03-18 Kaveh R. Ghazi + + * Make-lang.in (fortran-warn): Remove -Wno-error. + (expr.o-warn, resolve.o-warn, simplify.o-warn, + trans-common.o-warn): Specify -Wno-error. + + 2005-03-17 Tobias Schl"uter + + * trans-array.c (gfc_trans_static_array_pointer, + get_array_ctor_var_strlen, gfc_conv_array_index_offset): Fix + comment and formatting typos. + 2005-03-17 Francois-Xavier Coudert * invoke.texi: Fix typos. + 2005-03-15 Zack Weinberg + + * Make-lang.in (GFORTRAN_TEXI): Add gcc-vers.texi. + + 2005-03-15 Feng Wang + + * trans-stmt.c (gfc_trans_label_assign): Don't set DECL_ARTIFICIAL flag + to zero on label_tree. + 2005-03-15 Feng Wang PR fortran/18827 *************** *** 970,975 **** --- 3342,3352 ---- * symbol.c (check_conflict): A dummy argument can't be a statement function. + 2005-03-14 Zdenek Dvorak + + * fortran/trans-intrinsic.c (gfc_conv_intrinsic_ishft): Convert + the argument of the shift to the unsigned type. + 2005-03-13 Tobias Schl"uter PR fortran/16907 *************** *** 995,1012 **** (gfc_build_qualified_array): Fix comment typo. * trans.h (gfc_put_var_on_stack): Add prototype. 2005-03-05 Steven G. Kargl ! PR fortran/19936 * primary.c (match_complex_constant): Mangled complex constant may be an implied do-loop. Give implied do-loop matcher a chance. ! 2005-03-05 Steven G. Kargl PR fortran/19754 * resolve.c (compare_shapes): New function. (resolve_operator): Use it. 2005-03-04 Tobias Schl"uter PR fortran/19673 --- 3372,3402 ---- (gfc_build_qualified_array): Fix comment typo. * trans.h (gfc_put_var_on_stack): Add prototype. + 2005-03-11 Kaveh R. Ghazi + + * Make-lang.in (fortran-warn): Set to $(STRICT_WARN) -Wno-error. + * decl.c, trans.c: Don't use C++ style comments. + * gfortran.h (sym_flavor, procedure_type, sym_intent, gfc_access, + ifsrc): Give names to enums and use ENUM_BITFIELD. + (gfc_access): Remove trailing comma. + 2005-03-05 Steven G. Kargl ! PR 19936 * primary.c (match_complex_constant): Mangled complex constant may be an implied do-loop. Give implied do-loop matcher a chance. ! 2005-03-05 Steven G. Kargl PR fortran/19754 * resolve.c (compare_shapes): New function. (resolve_operator): Use it. + 2005-03-05 Tobias Schl"uter + + * trans-const.c (gfc_conv_constant_to_tree): Use correct tree + type for COMPLEX constants. + 2005-03-04 Tobias Schl"uter PR fortran/19673 *************** *** 1038,1053 **** PR fortran/20058 * trans-types.c (gfc_max_integer_kind): Declare ! (gfc_init_kinds): Initialize it. * gfortran.h (gfc_max_integer_kind): extern it. * primary.c (match_boz_constant): Use it; remove gfortran extension ! of kind suffixes on BOZ literal constants 2005-02-24 Volker Reichelt * decl.c, resolve.c, trans-array.c, trans.h: Fix comment typo(s). ! 2005-04-24 Tobias Schl"uter Unrevert previously reverted patch. Adding this fix: * module.c (find_true_name): Deal with NULL module. --- 3428,3453 ---- PR fortran/20058 * trans-types.c (gfc_max_integer_kind): Declare ! (gfc_init_kinds): Initialize it. * gfortran.h (gfc_max_integer_kind): extern it. * primary.c (match_boz_constant): Use it; remove gfortran extension ! of kind suffixes on BOZ literal constants ! ! ! 2005-02-27 Steven G. Kargl ! ! * arith.c (gfc_check_real_range): Remove multiple returns ! (check_result): New function. ! (gfc_arith_uminus,gfc_arith_plus,gfc_arith_times, ! gfc_arith_divide,gfc_arith_power,gfc_arith_minus): Use it. ! 2005-02-24 Volker Reichelt * decl.c, resolve.c, trans-array.c, trans.h: Fix comment typo(s). ! ! 2005-02-24 Tobias Schl"uter Unrevert previously reverted patch. Adding this fix: * module.c (find_true_name): Deal with NULL module. *************** *** 1118,1124 **** (compare_actual_formal): Check for NULL pointer instead of empty string. * intrinsic.c (gfc_current_intrinsic, gfc_current_intrinsic_arg): ! Add 'const' qualifier. (conv_name): Return a heap allocated string. (find_conv): Add 'const' qualifier to 'target'. (add_sym): Use 'gfc_get_string' instead of 'strcpy'. --- 3518,3524 ---- (compare_actual_formal): Check for NULL pointer instead of empty string. * intrinsic.c (gfc_current_intrinsic, gfc_current_intrinsic_arg): ! Add 'const' qualifier. (conv_name): Return a heap allocated string. (find_conv): Add 'const' qualifier to 'target'. (add_sym): Use 'gfc_get_string' instead of 'strcpy'. *************** *** 1176,1182 **** * expr.c (gfc_type_convert_binary): Typo in comment. 2005-02-19 Steven G. Kargl ! * check.c (gfc_check_selected_int_kind): New function. * intrinsic.h: Prototype it. * intrinsic.c (add_function): Use it. --- 3576,3582 ---- * expr.c (gfc_type_convert_binary): Typo in comment. 2005-02-19 Steven G. Kargl ! * check.c (gfc_check_selected_int_kind): New function. * intrinsic.h: Prototype it. * intrinsic.c (add_function): Use it. *************** *** 1184,1195 **** BT_REAL to BT_INTEGER and use gfc_default_integer_kind. 2005-02-19 Steven G. Kargl ! * check.c (gfc_check_int): improve checking of optional kind * simplify.c (gfc_simplify_int): Change BT_REAL to BT_INTEGER 2005-02-19 Steven G. Kargl ! * check.c (gfc_check_achar): New function * intrinsic.h: Prototype it. * intrinsic.c (add_function): Use it. --- 3584,3595 ---- BT_REAL to BT_INTEGER and use gfc_default_integer_kind. 2005-02-19 Steven G. Kargl ! * check.c (gfc_check_int): improve checking of optional kind * simplify.c (gfc_simplify_int): Change BT_REAL to BT_INTEGER 2005-02-19 Steven G. Kargl ! * check.c (gfc_check_achar): New function * intrinsic.h: Prototype it. * intrinsic.c (add_function): Use it. *************** *** 1233,1239 **** gfc_match_null, match_type_spec, match_attr_spec, gfc_match_formal_arglist, match_result, gfc_match_function_decl): Update callers to match. ! (gfc_match_entry) : Likewise, fix comment typo. (gfc_match_subroutine, attr_decl1, gfc_add_dimension, access_attr_decl, do_parm, gfc_match_save, gfc_match_modproc, gfc_match_derived_decl): Update callers. --- 3633,3639 ---- gfc_match_null, match_type_spec, match_attr_spec, gfc_match_formal_arglist, match_result, gfc_match_function_decl): Update callers to match. ! (gfc_match_entry): Likewise, fix comment typo. (gfc_match_subroutine, attr_decl1, gfc_add_dimension, access_attr_decl, do_parm, gfc_match_save, gfc_match_modproc, gfc_match_derived_decl): Update callers. *************** *** 1323,1329 **** 2005-01-22 Steven G. Kargl ! * intrinsic.c (make_alias): Add standard argument. (add_functions): Update make_alias calls. 2005-01-22 Paul Brook --- 3723,3729 ---- 2005-01-22 Steven G. Kargl ! * intrinsic.c (make_alias): Add standard argument. (add_functions): Update make_alias calls. 2005-01-22 Paul Brook *************** *** 1384,1390 **** unsigned issue. Use build_int_cst instead of converting integer_zero_node. Remove unnecessary conversion. ! * trans-types.c (gfc_get_character_type_len): : Use gfc_charlen_type_node as basic type for the range field. * trans-intrinsic.c (build_fixbound_expr, --- 3784,3790 ---- unsigned issue. Use build_int_cst instead of converting integer_zero_node. Remove unnecessary conversion. ! * trans-types.c (gfc_get_character_type_len): Use gfc_charlen_type_node as basic type for the range field. * trans-intrinsic.c (build_fixbound_expr, *************** *** 1498,1504 **** gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush, gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink, gfc_check_unlink_sub): Fix formatting issues. ! 2005-01-08 Tobias Schl"uter * gfortran.h: Remove outdated comment. Don't include stdio.h --- 3898,3904 ---- gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush, gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink, gfc_check_unlink_sub): Fix formatting issues. ! 2005-01-08 Tobias Schl"uter * gfortran.h: Remove outdated comment. Don't include stdio.h *************** *** 1547,1553 **** * gfortran.h (gfc_case): fix typo in comment. ! 2004-12-27 Tobias Schlueter * trans-intrinsic.c (gfc_conv_intrinsic_ishft): Change to logical shift. Call fold. Remove 0-bit shift shortcut. --- 3947,3953 ---- * gfortran.h (gfc_case): fix typo in comment. ! 2004-12-27 Tobias Schlueter * trans-intrinsic.c (gfc_conv_intrinsic_ishft): Change to logical shift. Call fold. Remove 0-bit shift shortcut. *************** *** 1831,1837 **** 2004-10-30 Canqun Yang ! * check.c (gfc_check_rand): Allow missing optional argument. (gfc_check_irand): Ditto. * intrinsic.c (add_functions): Set arg optional flag for {i,}rand. --- 4231,4237 ---- 2004-10-30 Canqun Yang ! * check.c (gfc_check_rand): Allow missing optional argument. (gfc_check_irand): Ditto. * intrinsic.c (add_functions): Set arg optional flag for {i,}rand. *************** *** 1876,1882 **** 2004-10-08 Tobias Schlueter * arith.c: Fix formatting issues. ! 2004-10-07 Tobias Schlueter PR fortran/17676 --- 4276,4282 ---- 2004-10-08 Tobias Schlueter * arith.c: Fix formatting issues. ! 2004-10-07 Tobias Schlueter PR fortran/17676 *************** *** 1930,1936 **** * trans-const.h (gfc_build_cstring_const): Add prototype. * trans-io.c (set_string, set_error_locus): Use new function. * trans-stmt.c (gfc_trans_goto): Use new function. ! PR fortran/17708 * parse.c (accept_statement): Don't treat END DO like END IF and END SELECT. --- 4330,4336 ---- * trans-const.h (gfc_build_cstring_const): Add prototype. * trans-io.c (set_string, set_error_locus): Use new function. * trans-stmt.c (gfc_trans_goto): Use new function. ! PR fortran/17708 * parse.c (accept_statement): Don't treat END DO like END IF and END SELECT. *************** *** 2015,2021 **** PR fortran/17615 * trans-expr.c (gfc_trans_arrayfunc_assign): Look at resolved function to determine return type. ! 2004-09-20 Jan Hubicka * trans-decl.c (build_entry_thunks): Finalize the function; do not lower --- 4415,4421 ---- PR fortran/17615 * trans-expr.c (gfc_trans_arrayfunc_assign): Look at resolved function to determine return type. ! 2004-09-20 Jan Hubicka * trans-decl.c (build_entry_thunks): Finalize the function; do not lower *************** *** 2059,2065 **** * gfortran.texi: Fix a typo. ! 2004-09-15 Aaron W. LaFramboise * parse.c (eof_buf): Rename eof to eof_buf. (unexpected_eof): Same. --- 4459,4465 ---- * gfortran.texi: Fix a typo. ! 2004-09-15 Aaron W. LaFramboise * parse.c (eof_buf): Rename eof to eof_buf. (unexpected_eof): Same. *************** *** 3452,3458 **** unused variables if they're use associated. 2004-06-14 Tobias Schlueter ! Andrew Vaught PR fortran/14928 * gfortran.h (gfc_check_f): Add new field f3ml. --- 5852,5858 ---- unused variables if they're use associated. 2004-06-14 Tobias Schlueter ! Andrew Vaught PR fortran/14928 * gfortran.h (gfc_check_f): Add new field f3ml. *************** *** 3819,3825 **** * arith.c: Fix comment typos. ! 2004-05-15 Tobias Schlueter PR fortran/13742 * decl.c (add_init_expr_to_sym): Verify that COMMON variable is --- 6219,6225 ---- * arith.c: Fix comment typos. ! 2004-05-15 Tobias Schlueter PR fortran/13742 * decl.c (add_init_expr_to_sym): Verify that COMMON variable is *************** *** 3922,3928 **** * decl.c (variable_decl): Always apply default initializer. ! 2004-05-08 Tobias Schlüter PR fortran/15206 * trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to --- 6322,6328 ---- * decl.c (variable_decl): Always apply default initializer. ! 2004-05-08 Tobias Schlüter PR fortran/15206 * trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to *************** *** 4006,4025 **** * primary.c (match_digits, match_integer_constant): Add comment explaining signflag. ! 2004-05-01 Tobias Schlüter PR fortran/13940 * primary.c: Include system.h and flags.h, needed for pedantic. (match_boz_constant): Allow "x" for hexadecimal constants, warn if pedantic is set. ! 2004-05-01 Tobias Schlüter PR fortran/13940 * match.c (match_data_constant): Handle case where gfc_find_symbol sets sym to NULL ! 2004-04-28 Tobias Schlüter * Make-lang.in (f95-lang.o, trans-intrinsic.o): Add missing dependency on mathbuiltins.def --- 6406,6425 ---- * primary.c (match_digits, match_integer_constant): Add comment explaining signflag. ! 2004-05-01 Tobias Schlüter PR fortran/13940 * primary.c: Include system.h and flags.h, needed for pedantic. (match_boz_constant): Allow "x" for hexadecimal constants, warn if pedantic is set. ! 2004-05-01 Tobias Schlüter PR fortran/13940 * match.c (match_data_constant): Handle case where gfc_find_symbol sets sym to NULL ! 2004-04-28 Tobias Schlüter * Make-lang.in (f95-lang.o, trans-intrinsic.o): Add missing dependency on mathbuiltins.def *************** *** 4330,4336 **** * resolve.c (resolve_branch): Get error message right way round. ! 2004-01-10 Canqun Yang * trans-array (gfc_conv_loop_setup): Adjust comment to track reality. --- 6730,6736 ---- * resolve.c (resolve_branch): Get error message right way round. ! 2004-01-10 Canqun Yang * trans-array (gfc_conv_loop_setup): Adjust comment to track reality. *************** *** 4419,4425 **** (GFC_DECL_ASSIGN_ADDR(node)): New macro to access this. (GFC_DECL_ASSIGN(node)): New macro to access flag. ! 2003-12-31 Huang Chun PR fortran/13434 * trans-intrinsic.c (gfc_conv_intrinsic_minmaxval): Fixed bug in --- 6819,6825 ---- (GFC_DECL_ASSIGN_ADDR(node)): New macro to access this. (GFC_DECL_ASSIGN(node)): New macro to access flag. ! 2003-12-31 Huang Chun PR fortran/13434 * trans-intrinsic.c (gfc_conv_intrinsic_minmaxval): Fixed bug in *************** *** 4436,4442 **** * trans-expr.c (gfc_conv_expr_op): Fold the result expression. * trans.c (gfc_add_modify_expr, gfc_add_expr_to_block): Likewise. ! 2003-12-12 Huang Chun * primary.c (match_substring): Fix substring bug for start point or end point is NULL. --- 6836,6842 ---- * trans-expr.c (gfc_conv_expr_op): Fold the result expression. * trans.c (gfc_add_modify_expr, gfc_add_expr_to_block): Likewise. ! 2003-12-12 Huang Chun * primary.c (match_substring): Fix substring bug for start point or end point is NULL. *************** *** 4481,4487 **** * io.c (gfc_match_format): Check for missing format label. ! 2003-11-30 Huang Chun PR fortran/13155 * trans-decl.c (gfc_sym_mangled_function_id): Don't mangle symbols --- 6881,6887 ---- * io.c (gfc_match_format): Check for missing format label. ! 2003-11-30 Huang Chun PR fortran/13155 * trans-decl.c (gfc_sym_mangled_function_id): Don't mangle symbols *************** *** 4517,4523 **** * trans.c (gfc_create_var_np): Use create_tmp_var_raw. ! 2003-11-28 Huang Chun * trans.h (has_alternate_specifier): New global variable. * match.c (gfc_match_call): Handle actual arguments associated with --- 6917,6923 ---- * trans.c (gfc_create_var_np): Use create_tmp_var_raw. ! 2003-11-28 Huang Chun * trans.h (has_alternate_specifier): New global variable. * match.c (gfc_match_call): Handle actual arguments associated with *************** *** 6938,6944 **** NON_LVALUE_EXPR. * trans-stmt.c (g95_trans_arithmetic_if): Implement this. ! 2002-09-18 Steven Bosscher * Make-lang.in (F95_ADDITIONAL_OBJS): Add tree-ssa-dce.o --- 9338,9344 ---- NON_LVALUE_EXPR. * trans-stmt.c (g95_trans_arithmetic_if): Implement this. ! 2002-09-18 Steven Bosscher * Make-lang.in (F95_ADDITIONAL_OBJS): Add tree-ssa-dce.o *************** *** 7016,7022 **** * trans-intrinsic.c: Implement PRODUCT, COUNT. MINLOC and MAXLOC intrinsics. ! 2002-09-02 Steven Bosscher * trans-array.c, trans-types.c: Add rank information to descriptor. --- 9416,9422 ---- * trans-intrinsic.c: Implement PRODUCT, COUNT. MINLOC and MAXLOC intrinsics. ! 2002-09-02 Steven Bosscher * trans-array.c, trans-types.c: Add rank information to descriptor. *************** *** 7033,7039 **** * trans-types.c (g95_init_types): Always name integer and char types. (g95_get_array_type_bounds): TYPE_NAME may be a TYPE_DECL. ! 2002-09-02 Steven Bosscher * Make-lang.in: Add options.c to F95_PARSER_OBJS --- 9433,9439 ---- * trans-types.c (g95_init_types): Always name integer and char types. (g95_get_array_type_bounds): TYPE_NAME may be a TYPE_DECL. ! 2002-09-02 Steven Bosscher * Make-lang.in: Add options.c to F95_PARSER_OBJS *************** *** 7063,7065 **** --- 9463,9466 ---- (g95_conv_intrinsic_anyall): New function. * iresolve.c (g95_resolve_any, g95_resolve_all): Include rank in mangled name + diff -Nrcpad gcc-4.0.2/gcc/fortran/Make-lang.in gcc-4.1.0/gcc/fortran/Make-lang.in *** gcc-4.0.2/gcc/fortran/Make-lang.in Sat Nov 13 07:35:54 2004 --- gcc-4.1.0/gcc/fortran/Make-lang.in Fri Jan 27 20:03:59 2006 *************** *** 1,6 **** # -*- makefile -*- # Top level makefile fragment for GNU gfortran, the GNU Fortran 95 compiler. ! # Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. # Contributed by Paul Brook --- 1,6 ---- # -*- makefile -*- # Top level makefile fragment for GNU gfortran, the GNU Fortran 95 compiler. ! # Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. # Contributed by Paul Brook *************** *** 18,25 **** #You should have received a copy of the GNU General Public License #along with GCC; see the file COPYING. If not, write to ! #the Free Software Foundation, 59 Temple Place - Suite 330, ! #Boston, MA 02111-1307, USA. # This file provides the language dependent support in the main Makefile. # Each language makefile fragment must provide the following targets: --- 18,25 ---- #You should have received a copy of the GNU General Public License #along with GCC; see the file COPYING. If not, write to ! #the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! #Boston, MA 02110-1301, USA. # This file provides the language dependent support in the main Makefile. # Each language makefile fragment must provide the following targets: *************** *** 42,61 **** # Actual name to use when installing a native compiler. GFORTRAN_INSTALL_NAME := $(shell echo gfortran|sed '$(program_transform_name)') ! ! # Actual name to use when installing a cross-compiler. ! GFORTRAN_CROSS_NAME := $(shell echo gfortran|sed '$(program_transform_cross_name)') #^L ! # This is in addition to the warning flags defined by default. ! # You can use it to enable/disable warnings globally or for specific ! # files, e.g. ! # fortran-warn = -Wno-strict-prototypes ! # fortran/arith.o-warn = -Wno-error ! # ! # We don't need these cheats, everything builds fine with all warnings ! # enabled and -Werror. # These are the groups of object files we have. The F95_PARSER_OBJS are # all the front end files, the F95_OBJS are the files for the translation --- 42,60 ---- # Actual name to use when installing a native compiler. GFORTRAN_INSTALL_NAME := $(shell echo gfortran|sed '$(program_transform_name)') ! GFORTRAN_TARGET_INSTALL_NAME := $(target_noncanonical)-$(shell echo gfortran|sed '$(program_transform_name)') #^L ! # Use strict warnings for this front end. ! fortran-warn = $(STRICT_WARN) ! ! # These files get warnings from an inline function in GMP saying: ! # "control may reach end of non-void function '__gmpz_get_ui' being inlined" ! fortran/expr.o-warn = -Wno-error ! fortran/resolve.o-warn = -Wno-error ! fortran/simplify.o-warn = -Wno-error ! fortran/trans-common.o-warn = -Wno-error # These are the groups of object files we have. The F95_PARSER_OBJS are # all the front end files, the F95_OBJS are the files for the translation *************** F95_LIBS = $(GMPLIBS) $(LIBS) *** 81,87 **** # # Define the names for selecting gfortran in LANGUAGES. ! F95 f95: f951$(exeext) # Tell GNU make to ignore files by these names if they exist. .PHONY: F95 f95 --- 80,86 ---- # # Define the names for selecting gfortran in LANGUAGES. ! FORTRAN fortran: f951$(exeext) # Tell GNU make to ignore files by these names if they exist. .PHONY: F95 f95 *************** gt-fortran-trans-intrinsic.h : s- *** 117,149 **** # # Build hooks: ! f95.all.build: gfortran$(exeext) ! f95.all.cross: gfortran-cross$(exeext) ! f95.start.encap: gfortran$(exeext) ! f95.rest.encap: ! f95.srcinfo: doc/gfortran.info -cp -p $^ $(srcdir)/fortran ! f95.tags: force cd $(srcdir)/fortran; etags -o TAGS.sub *.c *.h; \ etags --include TAGS.sub --include ../TAGS.sub ! f95.info: doc/gfortran.info dvi:: doc/gfortran.dvi html:: $(htmldir)/gfortran/index.html F95_MANFILES = doc/gfortran.1 ! f95.man: $(F95_MANFILES) ! f95.srcman: $(F95_MANFILES) -cp -p $^ $(srcdir)/doc ! f95.srcextra: check-f95 : check-gfortran lang_checks += check-gfortran # GFORTRAN documentation. --- 116,149 ---- # # Build hooks: ! fortran.all.build: gfortran$(exeext) ! fortran.all.cross: gfortran-cross$(exeext) ! fortran.start.encap: gfortran$(exeext) ! fortran.rest.encap: ! fortran.srcinfo: doc/gfortran.info -cp -p $^ $(srcdir)/fortran ! fortran.tags: force cd $(srcdir)/fortran; etags -o TAGS.sub *.c *.h; \ etags --include TAGS.sub --include ../TAGS.sub ! fortran.info: doc/gfortran.info dvi:: doc/gfortran.dvi html:: $(htmldir)/gfortran/index.html F95_MANFILES = doc/gfortran.1 ! fortran.man: $(F95_MANFILES) ! fortran.srcman: $(F95_MANFILES) -cp -p $^ $(srcdir)/doc ! fortran.srcextra: check-f95 : check-gfortran + check-fortran : check-gfortran lang_checks += check-gfortran # GFORTRAN documentation. *************** GFORTRAN_TEXI = \ *** 153,159 **** $(srcdir)/doc/include/fdl.texi \ $(srcdir)/doc/include/gpl.texi \ $(srcdir)/doc/include/funding.texi \ ! $(srcdir)/doc/include/gcc-common.texi doc/gfortran.info: $(GFORTRAN_TEXI) if [ x$(BUILD_INFO) = xinfo ]; then \ --- 153,160 ---- $(srcdir)/doc/include/fdl.texi \ $(srcdir)/doc/include/gpl.texi \ $(srcdir)/doc/include/funding.texi \ ! $(srcdir)/doc/include/gcc-common.texi \ ! gcc-vers.texi doc/gfortran.info: $(GFORTRAN_TEXI) if [ x$(BUILD_INFO) = xinfo ]; then \ *************** gfortran.pod: $(GFORTRAN_TEXI) *** 180,203 **** # f951 is installed elsewhere as part of $(COMPILERS). # Nothing to do here. ! f95.install-normal: # Install the driver program as $(target)-gfortran # and also as either gfortran (if native) or $(tooldir)/bin/gfortran. ! f95.install-common: installdirs -if [ -f f951$(exeext) ] ; then \ if [ -f gfortran-cross$(exeext) ] ; then \ - rm -f $(DESTDIR)$(bindir)/$(GFORTRAN_CROSS_NAME)$(exeext); \ - $(INSTALL_PROGRAM) gfortran-cross$(exeext) $(DESTDIR)$(bindir)/$(GFORTRAN_CROSS_NAME)$(exeext); \ - chmod a+x $(DESTDIR)$(bindir)/$(GFORTRAN_CROSS_NAME)$(exeext); \ if [ -d $(DESTDIR)$(gcc_tooldir)/bin/. ] ; then \ rm -f $(DESTDIR)$(gcc_tooldir)/bin/gfortran$(exeext); \ $(INSTALL_PROGRAM) gfortran-cross$(exeext) $(DESTDIR)$(gcc_tooldir)/bin/gfortran$(exeext); \ else true; fi; \ else \ - rm -f $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \ - $(INSTALL_PROGRAM) gfortran$(exeext) $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \ - chmod a+x $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \ rm -f $(DESTDIR)$(bindir)/$(GFORTRAN_TARGET_INSTALL_NAME)$(exeext); \ $(LN) $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext) $(DESTDIR)$(bindir)/$(GFORTRAN_TARGET_INSTALL_NAME)$(exeext); \ fi ; \ --- 181,201 ---- # f951 is installed elsewhere as part of $(COMPILERS). # Nothing to do here. ! fortran.install-normal: # Install the driver program as $(target)-gfortran # and also as either gfortran (if native) or $(tooldir)/bin/gfortran. ! fortran.install-common: installdirs -if [ -f f951$(exeext) ] ; then \ + rm -f $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \ + $(INSTALL_PROGRAM) gfortran$(exeext) $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \ + chmod a+x $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \ if [ -f gfortran-cross$(exeext) ] ; then \ if [ -d $(DESTDIR)$(gcc_tooldir)/bin/. ] ; then \ rm -f $(DESTDIR)$(gcc_tooldir)/bin/gfortran$(exeext); \ $(INSTALL_PROGRAM) gfortran-cross$(exeext) $(DESTDIR)$(gcc_tooldir)/bin/gfortran$(exeext); \ else true; fi; \ else \ rm -f $(DESTDIR)$(bindir)/$(GFORTRAN_TARGET_INSTALL_NAME)$(exeext); \ $(LN) $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext) $(DESTDIR)$(bindir)/$(GFORTRAN_TARGET_INSTALL_NAME)$(exeext); \ fi ; \ *************** f95.install-common: installdirs *** 205,226 **** install-info:: $(DESTDIR)$(infodir)/gfortran.info ! f95.install-man: installdirs \ ! $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext) ! $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext): doc/gfortran.1 -rm -f $@ -$(INSTALL_DATA) $< $@ -chmod a-x $@ ! f95.uninstall: if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ echo " install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/gfortran.info"; \ install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/gfortran.info || : ; \ else : ; fi; \ rm -rf $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \ rm -rf $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext); \ ! rm -rf $(DESTDIR)$(bindir)/$(GFORTRAN_CROSS_NAME)$(exeext); \ rm -rf $(DESTDIR)$(infodir)/gfortran.info* # --- 203,224 ---- install-info:: $(DESTDIR)$(infodir)/gfortran.info ! fortran.install-man: $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext) ! $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext): doc/gfortran.1 \ ! installdirs -rm -f $@ -$(INSTALL_DATA) $< $@ -chmod a-x $@ ! fortran.uninstall: if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ echo " install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/gfortran.info"; \ install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/gfortran.info || : ; \ else : ; fi; \ rm -rf $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \ rm -rf $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext); \ ! rm -rf $(DESTDIR)$(bindir)/$(GFORTRAN_TARGET_INSTALL_NAME)$(exeext); \ rm -rf $(DESTDIR)$(infodir)/gfortran.info* # *************** f95.uninstall: *** 228,243 **** # A lot of the ancillary files are deleted by the main makefile. # We just have to delete files specific to us. ! f95.mostlyclean: -rm -f f951$(exeext) -rm -f fortran/*.o ! f95.clean: ! f95.distclean: -rm -f fortran/config.status fortran/Makefile ! f95.extraclean: ! f95.maintainer-clean: -rm -f doc/gfortran.info* fortran/gfortran.*aux -rm -f $(docobjdir)/gfortran.1 --- 226,241 ---- # A lot of the ancillary files are deleted by the main makefile. # We just have to delete files specific to us. ! fortran.mostlyclean: -rm -f f951$(exeext) -rm -f fortran/*.o ! fortran.clean: ! fortran.distclean: -rm -f fortran/config.status fortran/Makefile ! fortran.extraclean: ! fortran.maintainer-clean: -rm -f doc/gfortran.info* fortran/gfortran.*aux -rm -f $(docobjdir)/gfortran.1 *************** f95.maintainer-clean: *** 245,261 **** # Stage hooks: # The toplevel makefile has already created stage?/fortran at this point. ! f95.stage1: stage1-start -mv fortran/*$(objext) stage1/fortran ! f95.stage2: stage2-start -mv fortran/*$(objext) stage2/fortran ! f95.stage3: stage3-start -mv fortran/*$(objext) stage3/fortran ! f95.stage4: stage4-start -mv fortran/*$(objext) stage4/fortran ! f95.stageprofile: stageprofile-start -mv fortran/*$(objext) stageprofile/fortran ! f95.stagefeedback: stageprofile-start -mv fortran/*$(objext) stagefeedback/fortran # --- 243,259 ---- # Stage hooks: # The toplevel makefile has already created stage?/fortran at this point. ! fortran.stage1: stage1-start -mv fortran/*$(objext) stage1/fortran ! fortran.stage2: stage2-start -mv fortran/*$(objext) stage2/fortran ! fortran.stage3: stage3-start -mv fortran/*$(objext) stage3/fortran ! fortran.stage4: stage4-start -mv fortran/*$(objext) stage4/fortran ! fortran.stageprofile: stageprofile-start -mv fortran/*$(objext) stageprofile/fortran ! fortran.stagefeedback: stageprofile-start -mv fortran/*$(objext) stagefeedback/fortran # *************** GFORTRAN_TRANS_DEPS = fortran/gfortran.h *** 279,298 **** fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \ gt-fortran-f95-lang.h gtype-fortran.h cgraph.h $(TARGET_H) fortran/convert.o: $(GFORTRAN_TRANS_DEPS) fortran/trans.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \ ! cgraph.h $(TARGET_H) function.h errors.h $(FLAGS_H) tree-gimple.h \ tree-dump.h fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \ real.h toplev.h $(TARGET_H) fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS) ! fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) ! fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \ gt-fortran-trans-intrinsic.h ! fortran/dependency.o: fortran/gfortran.h fortran/dependency.h fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) --- 277,298 ---- fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \ gt-fortran-f95-lang.h gtype-fortran.h cgraph.h $(TARGET_H) + fortran/scanner.o: toplev.h fortran/convert.o: $(GFORTRAN_TRANS_DEPS) fortran/trans.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \ ! cgraph.h $(TARGET_H) function.h $(FLAGS_H) tree-gimple.h \ tree-dump.h fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \ real.h toplev.h $(TARGET_H) fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS) ! fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) ! fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h \ ! fortran/ioparm.def fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \ gt-fortran-trans-intrinsic.h ! fortran/dependency.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) diff -Nrcpad gcc-4.0.2/gcc/fortran/arith.c gcc-4.1.0/gcc/fortran/arith.c *** gcc-4.0.2/gcc/fortran/arith.c Tue Jul 12 01:50:47 2005 --- gcc-4.1.0/gcc/fortran/arith.c Sun Feb 12 18:31:40 2006 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Since target arithmetic must be done on the host, there has to be some way of evaluating arithmetic expressions as the host --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Since target arithmetic must be done on the host, there has to be some way of evaluating arithmetic expressions as the host *************** gfc_arith_error (arith code) *** 138,162 **** switch (code) { case ARITH_OK: ! p = "Arithmetic OK"; break; case ARITH_OVERFLOW: ! p = "Arithmetic overflow"; break; case ARITH_UNDERFLOW: ! p = "Arithmetic underflow"; break; case ARITH_NAN: ! p = "Arithmetic NaN"; break; case ARITH_DIV0: ! p = "Division by zero"; break; case ARITH_INCOMMENSURATE: ! p = "Array operands are incommensurate"; break; case ARITH_ASYMMETRIC: ! p = "Integer outside symmetric range implied by Standard Fortran"; break; default: gfc_internal_error ("gfc_arith_error(): Bad error code"); --- 138,163 ---- switch (code) { case ARITH_OK: ! p = _("Arithmetic OK at %L"); break; case ARITH_OVERFLOW: ! p = _("Arithmetic overflow at %L"); break; case ARITH_UNDERFLOW: ! p = _("Arithmetic underflow at %L"); break; case ARITH_NAN: ! p = _("Arithmetic NaN at %L"); break; case ARITH_DIV0: ! p = _("Division by zero at %L"); break; case ARITH_INCOMMENSURATE: ! p = _("Array operands are incommensurate at %L"); break; case ARITH_ASYMMETRIC: ! p = ! _("Integer outside symmetric range implied by Standard Fortran at %L"); break; default: gfc_internal_error ("gfc_arith_error(): Bad error code"); *************** gfc_arith_init_1 (void) *** 259,264 **** --- 260,273 ---- mpfr_init (real_info->tiny); mpfr_set (real_info->tiny, b, GFC_RND_MODE); + /* subnormal (x) = b**(emin - digit) */ + mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (b, b, real_info->min_exponent - real_info->digits, + GFC_RND_MODE); + + mpfr_init (real_info->subnormal); + mpfr_set (real_info->subnormal, b, GFC_RND_MODE); + /* epsilon(x) = b**(1-p) */ mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); mpfr_pow_si (b, b, 1 - real_info->digits, GFC_RND_MODE); *************** gfc_arith_done_1 (void) *** 330,336 **** the range of the kind. Returns ARITH_OK, ARITH_ASYMMETRIC or ARITH_OVERFLOW. */ ! static arith gfc_check_integer_range (mpz_t p, int kind) { arith result; --- 339,345 ---- the range of the kind. Returns ARITH_OK, ARITH_ASYMMETRIC or ARITH_OVERFLOW. */ ! arith gfc_check_integer_range (mpz_t p, int kind) { arith result; *************** gfc_check_real_range (mpfr_t p, int kind *** 370,389 **** mpfr_init (q); mpfr_abs (q, p, GFC_RND_MODE); - retval = ARITH_OK; if (mpfr_sgn (q) == 0) ! goto done; ! ! if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) { ! retval = ARITH_OVERFLOW; ! goto done; ! } ! if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0) ! retval = ARITH_UNDERFLOW; - done: mpfr_clear (q); return retval; --- 379,426 ---- mpfr_init (q); mpfr_abs (q, p, GFC_RND_MODE); if (mpfr_sgn (q) == 0) ! retval = ARITH_OK; ! else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) ! retval = ARITH_OVERFLOW; ! else if (mpfr_cmp (q, gfc_real_kinds[i].subnormal) < 0) ! retval = ARITH_UNDERFLOW; ! else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0) { ! /* MPFR operates on a numbers with a given precision and enormous ! exponential range. To represent subnormal numbers the exponent is ! allowed to become smaller than emin, but always retains the full ! precision. This function resets unused bits to 0 to alleviate ! rounding problems. Note, a future version of MPFR will have a ! mpfr_subnormalize() function, which handles this truncation in a ! more efficient and robust way. */ ! int j, k; ! char *bin, *s; ! mp_exp_t e; ! ! bin = mpfr_get_str (NULL, &e, gfc_real_kinds[i].radix, 0, q, GMP_RNDN); ! k = gfc_real_kinds[i].digits - (gfc_real_kinds[i].min_exponent - e); ! for (j = k; j < gfc_real_kinds[i].digits; j++) ! bin[j] = '0'; ! /* Need space for '0.', bin, 'E', and e */ ! s = (char *) gfc_getmem (strlen(bin)+10); ! sprintf (s, "0.%sE%d", bin, (int) e); ! mpfr_set_str (q, s, gfc_real_kinds[i].radix, GMP_RNDN); ! ! if (mpfr_sgn (p) < 0) ! mpfr_neg (p, q, GMP_RNDN); ! else ! mpfr_set (p, q, GMP_RNDN); ! ! gfc_free (s); ! gfc_free (bin); ! ! retval = ARITH_OK; ! } ! else ! retval = ARITH_OK; mpfr_clear (q); return retval; *************** gfc_range_check (gfc_expr * e) *** 551,556 **** --- 588,623 ---- } + /* Several of the following routines use the same set of statements to + check the validity of the result. Encapsulate the checking here. */ + + static arith + check_result (arith rc, gfc_expr * x, gfc_expr * r, gfc_expr ** rp) + { + arith val = rc; + + if (val == ARITH_UNDERFLOW) + { + if (gfc_option.warn_underflow) + gfc_warning (gfc_arith_error (val), &x->where); + val = ARITH_OK; + } + + if (val == ARITH_ASYMMETRIC) + { + gfc_warning (gfc_arith_error (val), &x->where); + val = ARITH_OK; + } + + if (val != ARITH_OK) + gfc_free_expr (r); + else + *rp = r; + + return val; + } + + /* It may seem silly to have a subroutine that actually computes the unary plus of a constant, but it prevents us from making exceptions in the code elsewhere. */ *************** gfc_arith_uminus (gfc_expr * op1, gfc_ex *** 592,616 **** rc = gfc_range_check (result); ! if (rc == ARITH_UNDERFLOW) ! { ! if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc == ARITH_ASYMMETRIC) ! { ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc != ARITH_OK) ! gfc_free_expr (result); ! else ! *resultp = result; ! ! return rc; } --- 659,665 ---- rc = gfc_range_check (result); ! return check_result (rc, op1, result, resultp); } *************** gfc_arith_plus (gfc_expr * op1, gfc_expr *** 647,671 **** rc = gfc_range_check (result); ! if (rc == ARITH_UNDERFLOW) ! { ! if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc == ARITH_ASYMMETRIC) ! { ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc != ARITH_OK) ! gfc_free_expr (result); ! else ! *resultp = result; ! ! return rc; } --- 696,702 ---- rc = gfc_range_check (result); ! return check_result (rc, op1, result, resultp); } *************** gfc_arith_minus (gfc_expr * op1, gfc_exp *** 702,726 **** rc = gfc_range_check (result); ! if (rc == ARITH_UNDERFLOW) ! { ! if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc == ARITH_ASYMMETRIC) ! { ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc != ARITH_OK) ! gfc_free_expr (result); ! else ! *resultp = result; ! ! return rc; } --- 733,739 ---- rc = gfc_range_check (result); ! return check_result (rc, op1, result, resultp); } *************** gfc_arith_times (gfc_expr * op1, gfc_exp *** 771,795 **** rc = gfc_range_check (result); ! if (rc == ARITH_UNDERFLOW) ! { ! if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc == ARITH_ASYMMETRIC) ! { ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc != ARITH_OK) ! gfc_free_expr (result); ! else ! *resultp = result; ! ! return rc; } --- 784,790 ---- rc = gfc_range_check (result); ! return check_result (rc, op1, result, resultp); } *************** gfc_arith_divide (gfc_expr * op1, gfc_ex *** 873,897 **** if (rc == ARITH_OK) rc = gfc_range_check (result); ! if (rc == ARITH_UNDERFLOW) ! { ! if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc == ARITH_ASYMMETRIC) ! { ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc != ARITH_OK) ! gfc_free_expr (result); ! else ! *resultp = result; ! ! return rc; } --- 868,874 ---- if (rc == ARITH_OK) rc = gfc_range_check (result); ! return check_result (rc, op1, result, resultp); } *************** gfc_arith_power (gfc_expr * op1, gfc_exp *** 986,995 **** result = gfc_constant_result (op1->ts.type, op1->ts.kind, &op1->where); if (power == 0) ! { ! /* Handle something to the zeroth power. Since we're dealing with integral exponents, there is no ambiguity in the ! limiting procedure used to determine the value of 0**0. */ switch (op1->ts.type) { case BT_INTEGER: --- 963,972 ---- result = gfc_constant_result (op1->ts.type, op1->ts.kind, &op1->where); if (power == 0) ! { ! /* Handle something to the zeroth power. Since we're dealing with integral exponents, there is no ambiguity in the ! limiting procedure used to determine the value of 0**0. */ switch (op1->ts.type) { case BT_INTEGER: *************** gfc_arith_power (gfc_expr * op1, gfc_exp *** 1059,1083 **** if (rc == ARITH_OK) rc = gfc_range_check (result); ! if (rc == ARITH_UNDERFLOW) ! { ! if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc == ARITH_ASYMMETRIC) ! { ! gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where); ! rc = ARITH_OK; ! *resultp = result; ! } ! else if (rc != ARITH_OK) ! gfc_free_expr (result); ! else ! *resultp = result; ! ! return rc; } --- 1036,1042 ---- if (rc == ARITH_OK) rc = gfc_range_check (result); ! return check_result (rc, op1, result, resultp); } *************** eval_intrinsic (gfc_intrinsic_op operato *** 1548,1553 **** --- 1507,1518 ---- unary = 1; break; + case INTRINSIC_PARENTHESES: + temp.ts = op1->ts; + + unary = 1; + break; + case INTRINSIC_GE: case INTRINSIC_LT: /* Additional restrictions */ case INTRINSIC_LE: /* for ordering relations. */ *************** eval_intrinsic (gfc_intrinsic_op operato *** 1646,1652 **** if (rc != ARITH_OK) { /* Something went wrong */ ! gfc_error ("%s at %L", gfc_arith_error (rc), &op1->where); return NULL; } --- 1611,1617 ---- if (rc != ARITH_OK) { /* Something went wrong */ ! gfc_error (gfc_arith_error (rc), &op1->where); return NULL; } *************** gfc_convert_complex (gfc_expr * real, gf *** 1949,1956 **** static void arith_error (arith rc, gfc_typespec * from, gfc_typespec * to, locus * where) { ! gfc_error ("%s converting %s to %s at %L", gfc_arith_error (rc), ! gfc_typename (from), gfc_typename (to), where); /* TODO: Do something about the error, ie, throw exception, return NaN, etc. */ --- 1914,1953 ---- static void arith_error (arith rc, gfc_typespec * from, gfc_typespec * to, locus * where) { ! switch (rc) ! { ! case ARITH_OK: ! gfc_error ("Arithmetic OK converting %s to %s at %L", ! gfc_typename (from), gfc_typename (to), where); ! break; ! case ARITH_OVERFLOW: ! gfc_error ("Arithmetic overflow converting %s to %s at %L", ! gfc_typename (from), gfc_typename (to), where); ! break; ! case ARITH_UNDERFLOW: ! gfc_error ("Arithmetic underflow converting %s to %s at %L", ! gfc_typename (from), gfc_typename (to), where); ! break; ! case ARITH_NAN: ! gfc_error ("Arithmetic NaN converting %s to %s at %L", ! gfc_typename (from), gfc_typename (to), where); ! break; ! case ARITH_DIV0: ! gfc_error ("Division by zero converting %s to %s at %L", ! gfc_typename (from), gfc_typename (to), where); ! break; ! case ARITH_INCOMMENSURATE: ! gfc_error ("Array operands are incommensurate converting %s to %s at %L", ! gfc_typename (from), gfc_typename (to), where); ! break; ! case ARITH_ASYMMETRIC: ! gfc_error ("Integer outside symmetric range implied by Standard Fortran" ! " converting %s to %s at %L", ! gfc_typename (from), gfc_typename (to), where); ! break; ! default: ! gfc_internal_error ("gfc_arith_error(): Bad error code"); ! } /* TODO: Do something about the error, ie, throw exception, return NaN, etc. */ *************** gfc_int2int (gfc_expr * src, int kind) *** 1973,1979 **** { if (rc == ARITH_ASYMMETRIC) { ! gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); } else { --- 1970,1976 ---- { if (rc == ARITH_ASYMMETRIC) { ! gfc_warning (gfc_arith_error (rc), &src->where); } else { *************** gfc_real2real (gfc_expr * src, int kind) *** 2075,2081 **** if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) --- 2072,2078 ---- if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) *************** gfc_real2complex (gfc_expr * src, int ki *** 2107,2113 **** if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) --- 2104,2110 ---- if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) *************** gfc_complex2real (gfc_expr * src, int ki *** 2162,2168 **** if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); } if (rc != ARITH_OK) --- 2159,2165 ---- if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); } if (rc != ARITH_OK) *************** gfc_complex2complex (gfc_expr * src, int *** 2194,2200 **** if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) --- 2191,2197 ---- if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) *************** gfc_complex2complex (gfc_expr * src, int *** 2209,2215 **** if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) --- 2206,2212 ---- if (rc == ARITH_UNDERFLOW) { if (gfc_option.warn_underflow) ! gfc_warning (gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) *************** gfc_hollerith2logical (gfc_expr * src, i *** 2414,2416 **** --- 2411,2457 ---- return result; } + + /* Returns an initializer whose value is one higher than the value of the + LAST_INITIALIZER argument. If that is argument is NULL, the + initializers value will be set to zero. The initializer's kind + will be set to gfc_c_int_kind. + + If -fshort-enums is given, the appropriate kind will be selected + later after all enumerators have been parsed. A warning is issued + here if an initializer exceeds gfc_c_int_kind. */ + + gfc_expr * + gfc_enum_initializer (gfc_expr *last_initializer, locus where) + { + gfc_expr *result; + + result = gfc_get_expr (); + result->expr_type = EXPR_CONSTANT; + result->ts.type = BT_INTEGER; + result->ts.kind = gfc_c_int_kind; + result->where = where; + + mpz_init (result->value.integer); + + if (last_initializer != NULL) + { + mpz_add_ui (result->value.integer, last_initializer->value.integer, 1); + result->where = last_initializer->where; + + if (gfc_check_integer_range (result->value.integer, + gfc_c_int_kind) != ARITH_OK) + { + gfc_error ("Enumerator exceeds the C integer type at %C"); + return NULL; + } + } + else + { + /* Control comes here, if it's the very first enumerator and no + initializer has been given. It will be initialized to ZERO (0). */ + mpz_set_si (result->value.integer, 0); + } + + return result; + } diff -Nrcpad gcc-4.0.2/gcc/fortran/arith.h gcc-4.1.0/gcc/fortran/arith.h *** gcc-4.0.2/gcc/fortran/arith.h Tue Jul 12 01:50:47 2005 --- gcc-4.1.0/gcc/fortran/arith.h Thu Jul 7 07:54:58 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef GFC_ARITH_H #define GFC_ARITH_H --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #ifndef GFC_ARITH_H #define GFC_ARITH_H diff -Nrcpad gcc-4.0.2/gcc/fortran/array.c gcc-4.1.0/gcc/fortran/array.c *** gcc-4.0.2/gcc/fortran/array.c Thu Jul 14 01:59:43 2005 --- gcc-4.1.0/gcc/fortran/array.c Sat Sep 17 18:58:01 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" #include "system.h" --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" #include "system.h" *************** Software Foundation, 59 Temple Place - S *** 28,34 **** will expand to an array constructor without iterators. Constructors larger than this will remain in the iterator form. */ ! #define GFC_MAX_AC_EXPAND 100 /**************** Array reference matching subroutines *****************/ --- 28,34 ---- will expand to an array constructor without iterators. Constructors larger than this will remain in the iterator form. */ ! #define GFC_MAX_AC_EXPAND 65535 /**************** Array reference matching subroutines *****************/ *************** gfc_match_array_ref (gfc_array_ref * ar, *** 169,176 **** } } ! gfc_error ("Array reference at %C cannot have more than " ! stringize (GFC_MAX_DIMENSIONS) " dimensions"); error: return MATCH_ERROR; --- 169,176 ---- } } ! gfc_error ("Array reference at %C cannot have more than %d dimensions", ! GFC_MAX_DIMENSIONS); error: return MATCH_ERROR; *************** gfc_match_array_spec (gfc_array_spec ** *** 419,426 **** if (as->rank >= GFC_MAX_DIMENSIONS) { ! gfc_error ("Array specification at %C has more than " ! stringize (GFC_MAX_DIMENSIONS) " dimensions"); goto cleanup; } --- 419,426 ---- if (as->rank >= GFC_MAX_DIMENSIONS) { ! gfc_error ("Array specification at %C has more than %d dimensions", ! GFC_MAX_DIMENSIONS); goto cleanup; } *************** gfc_match_array_constructor (gfc_expr ** *** 866,879 **** gfc_expr *expr; locus where; match m; if (gfc_match (" (/") == MATCH_NO) ! return MATCH_NO; where = gfc_current_locus; head = tail = NULL; ! if (gfc_match (" /)") == MATCH_YES) { gfc_error ("Empty array constructor at %C is not allowed"); goto cleanup; --- 866,892 ---- gfc_expr *expr; locus where; match m; + const char *end_delim; if (gfc_match (" (/") == MATCH_NO) ! { ! if (gfc_match (" [") == MATCH_NO) ! return MATCH_NO; ! else ! { ! if (gfc_notify_std (GFC_STD_F2003, "New in Fortran 2003: [...] " ! "style array constructors at %C") == FAILURE) ! return MATCH_ERROR; ! end_delim = " ]"; ! } ! } ! else ! end_delim = " /)"; where = gfc_current_locus; head = tail = NULL; ! if (gfc_match (end_delim) == MATCH_YES) { gfc_error ("Empty array constructor at %C is not allowed"); goto cleanup; *************** gfc_match_array_constructor (gfc_expr ** *** 898,904 **** break; } ! if (gfc_match (" /)") == MATCH_NO) goto syntax; expr = gfc_get_expr (); --- 911,917 ---- break; } ! if (gfc_match (end_delim) == MATCH_NO) goto syntax; expr = gfc_get_expr (); diff -Nrcpad gcc-4.0.2/gcc/fortran/bbt.c gcc-4.1.0/gcc/fortran/bbt.c *** gcc-4.0.2/gcc/fortran/bbt.c Fri May 14 13:00:04 2004 --- gcc-4.1.0/gcc/fortran/bbt.c Sat Jun 25 00:40:37 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* The idea is to balance the tree using pseudorandom numbers. The main constraint on this implementation is that we have several --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* The idea is to balance the tree using pseudorandom numbers. The main constraint on this implementation is that we have several diff -Nrcpad gcc-4.0.2/gcc/fortran/check.c gcc-4.1.0/gcc/fortran/check.c *** gcc-4.0.2/gcc/fortran/check.c Tue Aug 9 17:44:02 2005 --- gcc-4.1.0/gcc/fortran/check.c Sun Feb 5 00:14:37 2006 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* These functions check to see if an argument list is compatible with --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* These functions check to see if an argument list is compatible with *************** Software Foundation, 59 Temple Place - S *** 33,50 **** #include "intrinsic.h" - /* The fundamental complaint function of this source file. This - function can be called in all kinds of ways. */ - - static void - must_be (gfc_expr * e, int n, const char *thing) - { - gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s", - gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where, - thing); - } - - /* Check the type of an expression. */ static try --- 33,38 ---- *************** type_check (gfc_expr * e, int n, bt type *** 53,59 **** if (e->ts.type == type) return SUCCESS; ! must_be (e, n, gfc_basic_typename (type)); return FAILURE; } --- 41,49 ---- if (e->ts.type == type) return SUCCESS; ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where, ! gfc_basic_typename (type)); return FAILURE; } *************** numeric_check (gfc_expr * e, int n) *** 67,73 **** if (gfc_numeric_ts (&e->ts)) return SUCCESS; ! must_be (e, n, "a numeric type"); return FAILURE; } --- 57,64 ---- if (gfc_numeric_ts (&e->ts)) return SUCCESS; ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be a numeric type", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where); return FAILURE; } *************** int_or_real_check (gfc_expr * e, int n) *** 80,86 **** { if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL) { ! must_be (e, n, "INTEGER or REAL"); return FAILURE; } --- 71,79 ---- { if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL) { ! gfc_error ( ! "'%s' argument of '%s' intrinsic at %L must be INTEGER or REAL", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where); return FAILURE; } *************** real_or_complex_check (gfc_expr * e, int *** 95,101 **** { if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX) { ! must_be (e, n, "REAL or COMPLEX"); return FAILURE; } --- 88,96 ---- { if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX) { ! gfc_error ( ! "'%s' argument of '%s' intrinsic at %L must be REAL or COMPLEX", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where); return FAILURE; } *************** kind_check (gfc_expr * k, int n, bt type *** 119,125 **** if (k->expr_type != EXPR_CONSTANT) { ! must_be (k, n, "a constant"); return FAILURE; } --- 114,122 ---- if (k->expr_type != EXPR_CONSTANT) { ! gfc_error ( ! "'%s' argument of '%s' intrinsic at %L must be a constant", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &k->where); return FAILURE; } *************** double_check (gfc_expr * d, int n) *** 145,151 **** if (d->ts.kind != gfc_default_double_kind) { ! must_be (d, n, "double precision"); return FAILURE; } --- 142,150 ---- if (d->ts.kind != gfc_default_double_kind) { ! gfc_error ( ! "'%s' argument of '%s' intrinsic at %L must be double precision", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &d->where); return FAILURE; } *************** logical_array_check (gfc_expr * array, i *** 160,166 **** { if (array->ts.type != BT_LOGICAL || array->rank == 0) { ! must_be (array, n, "a logical array"); return FAILURE; } --- 159,167 ---- { if (array->ts.type != BT_LOGICAL || array->rank == 0) { ! gfc_error ( ! "'%s' argument of '%s' intrinsic at %L must be a logical array", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &array->where); return FAILURE; } *************** array_check (gfc_expr * e, int n) *** 176,182 **** if (e->rank != 0) return SUCCESS; ! must_be (e, n, "an array"); return FAILURE; } --- 177,184 ---- if (e->rank != 0) return SUCCESS; ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be an array", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where); return FAILURE; } *************** scalar_check (gfc_expr * e, int n) *** 190,196 **** if (e->rank == 0) return SUCCESS; ! must_be (e, n, "a scalar"); return FAILURE; } --- 192,199 ---- if (e->rank == 0) return SUCCESS; ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be a scalar", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where); return FAILURE; } *************** scalar_check (gfc_expr * e, int n) *** 201,216 **** static try same_type_check (gfc_expr * e, int n, gfc_expr * f, int m) { - char message[100]; - if (gfc_compare_types (&e->ts, &f->ts)) return SUCCESS; ! sprintf (message, "the same type and kind as '%s'", ! gfc_current_intrinsic_arg[n]); ! ! must_be (f, m, message); ! return FAILURE; } --- 204,215 ---- static try same_type_check (gfc_expr * e, int n, gfc_expr * f, int m) { if (gfc_compare_types (&e->ts, &f->ts)) return SUCCESS; ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same type " ! "and kind as '%s'", gfc_current_intrinsic_arg[m], ! gfc_current_intrinsic, &f->where, gfc_current_intrinsic_arg[n]); return FAILURE; } *************** same_type_check (gfc_expr * e, int n, gf *** 220,234 **** static try rank_check (gfc_expr * e, int n, int rank) { - char message[100]; - if (e->rank == rank) return SUCCESS; ! sprintf (message, "of rank %d", rank); ! ! must_be (e, n, message); ! return FAILURE; } --- 219,230 ---- static try rank_check (gfc_expr * e, int n, int rank) { if (e->rank == rank) return SUCCESS; ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank %d", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, ! &e->where, rank); return FAILURE; } *************** nonoptional_check (gfc_expr * e, int n) *** 257,270 **** static try kind_value_check (gfc_expr * e, int n, int k) { - char message[100]; - if (e->ts.kind == k) return SUCCESS; ! sprintf (message, "of kind %d", k); ! ! must_be (e, n, message); return FAILURE; } --- 253,264 ---- static try kind_value_check (gfc_expr * e, int n, int k) { if (e->ts.kind == k) return SUCCESS; ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be of kind %d", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, ! &e->where, k); return FAILURE; } *************** variable_check (gfc_expr * e, int n) *** 289,295 **** return FAILURE; } ! must_be (e, n, "a variable"); return FAILURE; } --- 283,290 ---- return FAILURE; } ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be a variable", ! gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where); return FAILURE; } *************** dim_rank_check (gfc_expr * dim, gfc_expr *** 359,365 **** return SUCCESS; } - /***** Check functions *****/ /* Check subroutine suitable for intrinsics taking a real argument and --- 354,359 ---- *************** gfc_check_allocated (gfc_expr * array) *** 436,442 **** if (!array->symtree->n.sym->attr.allocatable) { ! must_be (array, 0, "ALLOCATABLE"); return FAILURE; } --- 430,438 ---- if (!array->symtree->n.sym->attr.allocatable) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE", ! gfc_current_intrinsic_arg[0], gfc_current_intrinsic, ! &array->where); return FAILURE; } *************** gfc_check_a_p (gfc_expr * a, gfc_expr * *** 453,460 **** if (int_or_real_check (a, 0) == FAILURE) return FAILURE; ! if (same_type_check (a, 0, p, 1) == FAILURE) ! return FAILURE; return SUCCESS; } --- 449,469 ---- if (int_or_real_check (a, 0) == FAILURE) return FAILURE; ! if (a->ts.type != p->ts.type) ! { ! gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must " ! "have the same type", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic_arg[1], gfc_current_intrinsic, ! &p->where); ! return FAILURE; ! } ! ! if (a->ts.kind != p->ts.kind) ! { ! if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L", ! &p->where) == FAILURE) ! return FAILURE; ! } return SUCCESS; } *************** gfc_check_associated (gfc_expr * pointer *** 467,486 **** int i; try t; ! if (variable_check (pointer, 0) == FAILURE) ! return FAILURE; - attr = gfc_variable_attr (pointer, NULL); if (!attr.pointer) { ! must_be (pointer, 0, "a POINTER"); return FAILURE; } if (target == NULL) return SUCCESS; - /* Target argument is optional. */ if (target->expr_type == EXPR_NULL) { gfc_error ("NULL pointer at %L is not permitted as actual argument " --- 476,500 ---- int i; try t; ! if (pointer->expr_type == EXPR_VARIABLE) ! attr = gfc_variable_attr (pointer, NULL); ! else if (pointer->expr_type == EXPR_FUNCTION) ! attr = pointer->symtree->n.sym->attr; ! else ! gcc_assert (0); /* Pointer must be a variable or a function. */ if (!attr.pointer) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", ! gfc_current_intrinsic_arg[0], gfc_current_intrinsic, ! &pointer->where); return FAILURE; } + /* Target argument is optional. */ if (target == NULL) return SUCCESS; if (target->expr_type == EXPR_NULL) { gfc_error ("NULL pointer at %L is not permitted as actual argument " *************** gfc_check_associated (gfc_expr * pointer *** 489,498 **** return FAILURE; } ! attr = gfc_variable_attr (target, NULL); if (!attr.pointer && !attr.target) { ! must_be (target, 1, "a POINTER or a TARGET"); return FAILURE; } --- 503,520 ---- return FAILURE; } ! if (target->expr_type == EXPR_VARIABLE) ! attr = gfc_variable_attr (target, NULL); ! else if (target->expr_type == EXPR_FUNCTION) ! attr = target->symtree->n.sym->attr; ! else ! gcc_assert (0); /* Target must be a variable or a function. */ ! if (!attr.pointer && !attr.target) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER " ! "or a TARGET", gfc_current_intrinsic_arg[1], ! gfc_current_intrinsic, &target->where); return FAILURE; } *************** gfc_check_associated (gfc_expr * pointer *** 507,513 **** if (target->ref->u.ar.dimen_type[i] == DIMEN_VECTOR) { gfc_error ("Array section with a vector subscript at %L shall not " ! "be the target of an pointer", &target->where); t = FAILURE; break; --- 529,535 ---- if (target->ref->u.ar.dimen_type[i] == DIMEN_VECTOR) { gfc_error ("Array section with a vector subscript at %L shall not " ! "be the target of a pointer", &target->where); t = FAILURE; break; *************** gfc_check_cmplx (gfc_expr * x, gfc_expr *** 616,622 **** if (x->ts.type == BT_COMPLEX) { ! must_be (y, 1, "not be present if 'x' is COMPLEX"); return FAILURE; } } --- 638,646 ---- if (x->ts.type == BT_COMPLEX) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must not be " ! "present if 'x' is COMPLEX", gfc_current_intrinsic_arg[1], ! gfc_current_intrinsic, &y->where); return FAILURE; } } *************** gfc_check_cmplx (gfc_expr * x, gfc_expr *** 629,634 **** --- 653,685 ---- try + gfc_check_complex (gfc_expr * x, gfc_expr * y) + { + if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL) + { + gfc_error ( + "'%s' argument of '%s' intrinsic at %L must be INTEGER or REAL", + gfc_current_intrinsic_arg[0], gfc_current_intrinsic, &x->where); + return FAILURE; + } + if (scalar_check (x, 0) == FAILURE) + return FAILURE; + + if (y->ts.type != BT_INTEGER && y->ts.type != BT_REAL) + { + gfc_error ( + "'%s' argument of '%s' intrinsic at %L must be INTEGER or REAL", + gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &y->where); + return FAILURE; + } + if (scalar_check (y, 1) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try gfc_check_count (gfc_expr * mask, gfc_expr * dim) { if (logical_array_check (mask, 0) == FAILURE) *************** gfc_check_cshift (gfc_expr * array, gfc_ *** 664,669 **** --- 715,733 ---- try + gfc_check_ctime (gfc_expr * time) + { + if (scalar_check (time, 0) == FAILURE) + return FAILURE; + + if (type_check (time, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try gfc_check_dcmplx (gfc_expr * x, gfc_expr * y) { if (numeric_check (x, 0) == FAILURE) *************** gfc_check_dcmplx (gfc_expr * x, gfc_expr *** 676,682 **** if (x->ts.type == BT_COMPLEX) { ! must_be (y, 1, "not be present if 'x' is COMPLEX"); return FAILURE; } } --- 740,748 ---- if (x->ts.type == BT_COMPLEX) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must not be " ! "present if 'x' is COMPLEX", gfc_current_intrinsic_arg[1], ! gfc_current_intrinsic, &y->where); return FAILURE; } } *************** gfc_check_dot_product (gfc_expr * vector *** 723,729 **** break; default: ! must_be (vector_a, 0, "numeric or LOGICAL"); return FAILURE; } --- 789,797 ---- break; default: ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " ! "or LOGICAL", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &vector_a->where); return FAILURE; } *************** gfc_check_ichar_iachar (gfc_expr * c) *** 929,944 **** if (type_check (c, 0, BT_CHARACTER) == FAILURE) return FAILURE; ! /* Check that the argument is length one. Non-constant lengths ! can't be checked here, so assume thay are ok. */ ! if (c->ts.cl && c->ts.cl->length) ! { ! /* If we already have a length for this expression then use it. */ ! if (c->ts.cl->length->expr_type != EXPR_CONSTANT) ! return SUCCESS; ! i = mpz_get_si (c->ts.cl->length->value.integer); ! } ! else if (c->expr_type == EXPR_VARIABLE || c->expr_type == EXPR_SUBSTRING) { gfc_expr *start; gfc_expr *end; --- 997,1003 ---- if (type_check (c, 0, BT_CHARACTER) == FAILURE) return FAILURE; ! if (c->expr_type == EXPR_VARIABLE || c->expr_type == EXPR_SUBSTRING) { gfc_expr *start; gfc_expr *end; *************** gfc_check_ichar_iachar (gfc_expr * c) *** 952,969 **** gcc_assert (ref == NULL || ref->type == REF_SUBSTRING); if (!ref) ! return SUCCESS; ! ! start = ref->u.ss.start; ! end = ref->u.ss.end; ! gcc_assert (start); ! if (end == NULL || end->expr_type != EXPR_CONSTANT ! || start->expr_type != EXPR_CONSTANT) ! return SUCCESS; ! i = mpz_get_si (end->value.integer) + 1 ! - mpz_get_si (start->value.integer); } else return SUCCESS; --- 1011,1042 ---- gcc_assert (ref == NULL || ref->type == REF_SUBSTRING); if (!ref) ! { ! /* Check that the argument is length one. Non-constant lengths ! can't be checked here, so assume thay are ok. */ ! if (c->ts.cl && c->ts.cl->length) ! { ! /* If we already have a length for this expression then use it. */ ! if (c->ts.cl->length->expr_type != EXPR_CONSTANT) ! return SUCCESS; ! i = mpz_get_si (c->ts.cl->length->value.integer); ! } ! else ! return SUCCESS; ! } ! else ! { ! start = ref->u.ss.start; ! end = ref->u.ss.end; ! gcc_assert (start); ! if (end == NULL || end->expr_type != EXPR_CONSTANT ! || start->expr_type != EXPR_CONSTANT) ! return SUCCESS; ! i = mpz_get_si (end->value.integer) + 1 ! - mpz_get_si (start->value.integer); ! } } else return SUCCESS; *************** gfc_check_index (gfc_expr * string, gfc_ *** 1022,1028 **** if (string->ts.kind != substring->ts.kind) { ! must_be (substring, 1, "the same kind as 'string'"); return FAILURE; } --- 1095,1104 ---- if (string->ts.kind != substring->ts.kind) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same " ! "kind as '%s'", gfc_current_intrinsic_arg[1], ! gfc_current_intrinsic, &substring->where, ! gfc_current_intrinsic_arg[0]); return FAILURE; } *************** gfc_check_kind (gfc_expr * x) *** 1134,1140 **** { if (x->ts.type == BT_DERIVED) { ! must_be (x, 0, "a non-derived type"); return FAILURE; } --- 1210,1218 ---- { if (x->ts.type == BT_DERIVED) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be a " ! "non-derived type", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &x->where); return FAILURE; } *************** gfc_check_link_sub (gfc_expr * path1, gf *** 1194,1199 **** --- 1272,1283 ---- return SUCCESS; } + try + gfc_check_loc (gfc_expr *expr) + { + return variable_check (expr, 0); + } + try gfc_check_symlnk (gfc_expr * path1, gfc_expr * path2) *************** gfc_check_min_max_double (gfc_actual_arg *** 1339,1357 **** /* End of min/max family. */ try gfc_check_matmul (gfc_expr * matrix_a, gfc_expr * matrix_b) { if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts)) { ! must_be (matrix_a, 0, "numeric or LOGICAL"); return FAILURE; } if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts)) { ! must_be (matrix_b, 0, "numeric or LOGICAL"); return FAILURE; } --- 1423,1457 ---- /* End of min/max family. */ + try + gfc_check_malloc (gfc_expr * size) + { + if (type_check (size, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (size, 0) == FAILURE) + return FAILURE; + + return SUCCESS; + } + try gfc_check_matmul (gfc_expr * matrix_a, gfc_expr * matrix_b) { if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts)) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " ! "or LOGICAL", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &matrix_a->where); return FAILURE; } if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts)) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric " ! "or LOGICAL", gfc_current_intrinsic_arg[1], ! gfc_current_intrinsic, &matrix_b->where); return FAILURE; } *************** gfc_check_matmul (gfc_expr * matrix_a, g *** 1370,1376 **** break; default: ! must_be (matrix_a, 0, "of rank 1 or 2"); return FAILURE; } --- 1470,1478 ---- break; default: ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank " ! "1 or 2", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &matrix_a->where); return FAILURE; } *************** gfc_check_minloc_maxloc (gfc_actual_argl *** 1423,1428 **** --- 1525,1540 ---- if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE) return FAILURE; + if (m != NULL) + { + char buffer[80]; + snprintf(buffer, sizeof(buffer), "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2], + gfc_current_intrinsic); + if (gfc_check_conformance (buffer, a, m) == FAILURE) + return FAILURE; + } + return SUCCESS; } *************** gfc_check_minloc_maxloc (gfc_actual_argl *** 1445,1452 **** static try check_reduction (gfc_actual_arglist * ap) { ! gfc_expr *m, *d; d = ap->next->expr; m = ap->next->next->expr; --- 1557,1565 ---- static try check_reduction (gfc_actual_arglist * ap) { ! gfc_expr *a, *m, *d; + a = ap->expr; d = ap->next->expr; m = ap->next->next->expr; *************** check_reduction (gfc_actual_arglist * ap *** 1468,1473 **** --- 1581,1596 ---- if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE) return FAILURE; + if (m != NULL) + { + char buffer[80]; + snprintf(buffer, sizeof(buffer), "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2], + gfc_current_intrinsic); + if (gfc_check_conformance (buffer, a, m) == FAILURE) + return FAILURE; + } + return SUCCESS; } *************** gfc_check_null (gfc_expr * mold) *** 1535,1541 **** if (!attr.pointer) { ! must_be (mold, 0, "a POINTER"); return FAILURE; } --- 1658,1666 ---- if (!attr.pointer) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", ! gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &mold->where); return FAILURE; } *************** gfc_check_pack (gfc_expr * array, gfc_ex *** 1554,1560 **** if (mask->rank != 0 && mask->rank != array->rank) { ! must_be (array, 0, "conformable with 'mask' argument"); return FAILURE; } --- 1679,1688 ---- if (mask->rank != 0 && mask->rank != array->rank) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be conformable " ! "with '%s' argument", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &array->where, ! gfc_current_intrinsic_arg[1]); return FAILURE; } *************** gfc_check_precision (gfc_expr * x) *** 1578,1584 **** { if (x->ts.type != BT_REAL && x->ts.type != BT_COMPLEX) { ! must_be (x, 0, "of type REAL or COMPLEX"); return FAILURE; } --- 1706,1714 ---- { if (x->ts.type != BT_REAL && x->ts.type != BT_COMPLEX) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be of type " ! "REAL or COMPLEX", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &x->where); return FAILURE; } *************** gfc_check_present (gfc_expr * a) *** 1597,1609 **** sym = a->symtree->n.sym; if (!sym->attr.dummy) { ! must_be (a, 0, "a dummy variable"); return FAILURE; } if (!sym->attr.optional) { ! must_be (a, 0, "an OPTIONAL dummy variable"); return FAILURE; } --- 1727,1743 ---- sym = a->symtree->n.sym; if (!sym->attr.dummy) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a " ! "dummy variable", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &a->where); return FAILURE; } if (!sym->attr.optional) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be of " ! "an OPTIONAL dummy variable", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &a->where); return FAILURE; } *************** gfc_check_reshape (gfc_expr * source, gf *** 1727,1735 **** if (m > 0) { ! gfc_error ! ("'shape' argument of 'reshape' intrinsic at %L has more than " ! stringize (GFC_MAX_DIMENSIONS) " elements", &shape->where); return FAILURE; } --- 1861,1868 ---- if (m > 0) { ! gfc_error ("'shape' argument of 'reshape' intrinsic at %L has more " ! "than %d elements", &shape->where, GFC_MAX_DIMENSIONS); return FAILURE; } *************** gfc_check_scan (gfc_expr * x, gfc_expr * *** 1781,1786 **** --- 1914,1936 ---- try + gfc_check_secnds (gfc_expr * r) + { + + if (type_check (r, 0, BT_REAL) == FAILURE) + return FAILURE; + + if (kind_value_check (r, 0, 4) == FAILURE) + return FAILURE; + + if (scalar_check (r, 0) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try gfc_check_selected_int_kind (gfc_expr * r) { *************** gfc_check_spread (gfc_expr * source, gfc *** 1902,1908 **** { if (source->rank >= GFC_MAX_DIMENSIONS) { ! must_be (source, 0, "less than rank " stringize (GFC_MAX_DIMENSIONS)); return FAILURE; } --- 2052,2061 ---- { if (source->rank >= GFC_MAX_DIMENSIONS) { ! gfc_error ("'%s' argument of '%s' intrinsic at %L must be less " ! "than rank %d", gfc_current_intrinsic_arg[0], ! gfc_current_intrinsic, &source->where, GFC_MAX_DIMENSIONS); ! return FAILURE; } *************** gfc_check_spread (gfc_expr * source, gfc *** 1919,1924 **** --- 2072,2135 ---- } + /* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and + functions). */ + try + gfc_check_fgetputc_sub (gfc_expr * unit, gfc_expr * c, gfc_expr * status) + { + if (type_check (unit, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (unit, 0) == FAILURE) + return FAILURE; + + if (type_check (c, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 2, BT_INTEGER) == FAILURE + || kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE + || scalar_check (status, 2) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try + gfc_check_fgetputc (gfc_expr * unit, gfc_expr * c) + { + return gfc_check_fgetputc_sub (unit, c, NULL); + } + + + try + gfc_check_fgetput_sub (gfc_expr * c, gfc_expr * status) + { + if (type_check (c, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 1, BT_INTEGER) == FAILURE + || kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE + || scalar_check (status, 1) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try + gfc_check_fgetput (gfc_expr * c) + { + return gfc_check_fgetput_sub (c, NULL); + } + + try gfc_check_fstat (gfc_expr * unit, gfc_expr * array) { *************** gfc_check_fstat_sub (gfc_expr * unit, gf *** 1970,1975 **** --- 2181,2218 ---- try + gfc_check_ftell (gfc_expr * unit) + { + if (type_check (unit, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (unit, 0) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try + gfc_check_ftell_sub (gfc_expr * unit, gfc_expr * offset) + { + if (type_check (unit, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (unit, 0) == FAILURE) + return FAILURE; + + if (type_check (offset, 1, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (offset, 1) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try gfc_check_stat (gfc_expr * name, gfc_expr * array) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_trim (gfc_expr * x) *** 2111,2116 **** --- 2354,2372 ---- } + try + gfc_check_ttynam (gfc_expr * unit) + { + if (scalar_check (unit, 0) == FAILURE) + return FAILURE; + + if (type_check (unit, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + /* Common check function for the half a dozen intrinsics that have a single real argument. */ *************** gfc_check_irand (gfc_expr * x) *** 2388,2393 **** --- 2644,2683 ---- return SUCCESS; } + + try + gfc_check_alarm_sub (gfc_expr * seconds, gfc_expr * handler, gfc_expr * status) + { + if (scalar_check (seconds, 0) == FAILURE) + return FAILURE; + + if (type_check (seconds, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (handler->ts.type != BT_INTEGER && handler->ts.type != BT_PROCEDURE) + { + gfc_error ( + "'%s' argument of '%s' intrinsic at %L must be INTEGER or PROCEDURE", + gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &handler->where); + return FAILURE; + } + + if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (scalar_check (status, 2) == FAILURE) + return FAILURE; + + if (type_check (status, 2, BT_INTEGER) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + try gfc_check_rand (gfc_expr * x) { *************** gfc_check_srand (gfc_expr * x) *** 2422,2427 **** --- 2712,2732 ---- } try + gfc_check_ctime_sub (gfc_expr * time, gfc_expr * result) + { + if (scalar_check (time, 0) == FAILURE) + return FAILURE; + + if (type_check (time, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (type_check (result, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + try gfc_check_etime (gfc_expr * x) { if (array_check (x, 0) == FAILURE) *************** gfc_check_etime_sub (gfc_expr * values, *** 2474,2479 **** --- 2779,2794 ---- try + gfc_check_fdate_sub (gfc_expr * date) + { + if (type_check (date, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try gfc_check_gerror (gfc_expr * msg) { if (type_check (msg, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_flush (gfc_expr * unit) *** 2545,2550 **** --- 2860,2878 ---- try + gfc_check_free (gfc_expr * i) + { + if (type_check (i, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (i, 0) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try gfc_check_hostnm (gfc_expr * name) { if (type_check (name, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_unlink_sub (gfc_expr * name, g *** 2680,2685 **** --- 3008,3070 ---- try + gfc_check_signal (gfc_expr * number, gfc_expr * handler) + { + if (scalar_check (number, 0) == FAILURE) + return FAILURE; + + if (type_check (number, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (handler->ts.type != BT_INTEGER && handler->ts.type != BT_PROCEDURE) + { + gfc_error ( + "'%s' argument of '%s' intrinsic at %L must be INTEGER or PROCEDURE", + gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &handler->where); + return FAILURE; + } + + if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try + gfc_check_signal_sub (gfc_expr * number, gfc_expr * handler, gfc_expr * status) + { + if (scalar_check (number, 0) == FAILURE) + return FAILURE; + + if (type_check (number, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (handler->ts.type != BT_INTEGER && handler->ts.type != BT_PROCEDURE) + { + gfc_error ( + "'%s' argument of '%s' intrinsic at %L must be INTEGER or PROCEDURE", + gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &handler->where); + return FAILURE; + } + + if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 2, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (status, 2) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + try gfc_check_system_sub (gfc_expr * cmd, gfc_expr * status) { if (type_check (cmd, 0, BT_CHARACTER) == FAILURE) *************** gfc_check_system_sub (gfc_expr * cmd, gf *** 2696,2698 **** --- 3081,3122 ---- return SUCCESS; } + + + /* This is used for the GNU intrinsics AND, OR and XOR. */ + try + gfc_check_and (gfc_expr * i, gfc_expr * j) + { + if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL) + { + gfc_error ( + "'%s' argument of '%s' intrinsic at %L must be INTEGER or LOGICAL", + gfc_current_intrinsic_arg[0], gfc_current_intrinsic, &i->where); + return FAILURE; + } + + if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL) + { + gfc_error ( + "'%s' argument of '%s' intrinsic at %L must be INTEGER or LOGICAL", + gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &j->where); + return FAILURE; + } + + if (i->ts.type != j->ts.type) + { + gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must " + "have the same type", gfc_current_intrinsic_arg[0], + gfc_current_intrinsic_arg[1], gfc_current_intrinsic, + &j->where); + return FAILURE; + } + + if (scalar_check (i, 0) == FAILURE) + return FAILURE; + + if (scalar_check (j, 1) == FAILURE) + return FAILURE; + + return SUCCESS; + } diff -Nrcpad gcc-4.0.2/gcc/fortran/config-lang.in gcc-4.1.0/gcc/fortran/config-lang.in *** gcc-4.0.2/gcc/fortran/config-lang.in Wed Aug 25 21:18:35 2004 --- gcc-4.1.0/gcc/fortran/config-lang.in Tue Sep 13 06:24:18 2005 *************** *** 6,12 **** # stagestuff - files to add to $(STAGESTUFF) # diff_excludes - files to ignore when building diffs between two versions. ! language="f95" compilers="f951\$(exeext)" --- 6,12 ---- # stagestuff - files to add to $(STAGESTUFF) # diff_excludes - files to ignore when building diffs between two versions. ! language="fortran" compilers="f951\$(exeext)" diff -Nrcpad gcc-4.0.2/gcc/fortran/convert.c gcc-4.1.0/gcc/fortran/convert.c *** gcc-4.0.2/gcc/fortran/convert.c Thu May 13 06:40:29 2004 --- gcc-4.1.0/gcc/fortran/convert.c Sat Jun 25 00:40:37 2005 *************** for more details. *** 15,22 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* This file contains the functions for converting C expressions --- 15,22 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* This file contains the functions for converting C expressions *************** convert (tree type, tree expr) *** 81,87 **** return expr; if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr))) ! return fold (build1 (NOP_EXPR, type, expr)); if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK) return error_mark_node; if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE) --- 81,87 ---- return expr; if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr))) ! return fold_build1 (NOP_EXPR, type, expr); if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK) return error_mark_node; if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE) *************** convert (tree type, tree expr) *** 106,114 **** /* If we have a NOP_EXPR, we must fold it here to avoid infinite recursion between fold () and convert (). */ if (TREE_CODE (e) == NOP_EXPR) ! return fold (build1 (NOP_EXPR, type, TREE_OPERAND (e, 0))); else ! return fold (build1 (NOP_EXPR, type, e)); } if (code == POINTER_TYPE || code == REFERENCE_TYPE) return fold (convert_to_pointer (type, e)); --- 106,114 ---- /* If we have a NOP_EXPR, we must fold it here to avoid infinite recursion between fold () and convert (). */ if (TREE_CODE (e) == NOP_EXPR) ! return fold_build1 (NOP_EXPR, type, TREE_OPERAND (e, 0)); else ! return fold_build1 (NOP_EXPR, type, e); } if (code == POINTER_TYPE || code == REFERENCE_TYPE) return fold (convert_to_pointer (type, e)); diff -Nrcpad gcc-4.0.2/gcc/fortran/data.c gcc-4.1.0/gcc/fortran/data.c *** gcc-4.0.2/gcc/fortran/data.c Mon Jul 25 08:46:58 2005 --- gcc-4.1.0/gcc/fortran/data.c Sun Nov 6 20:05:12 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330,Boston, MA ! 02111-1307, USA. */ /* Notes for DATA statement implementation: --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor,Boston, MA ! 02110-1301, USA. */ /* Notes for DATA statement implementation: *************** find_con_by_component (gfc_component *co *** 132,138 **** } ! /* Create a character type intialization expression from RVALUE. TS [and REF] describe [the substring of] the variable being initialized. INIT is thh existing initializer, not NULL. Initialization is performed according to normal assignment rules. */ --- 132,138 ---- } ! /* Create a character type initialization expression from RVALUE. TS [and REF] describe [the substring of] the variable being initialized. INIT is thh existing initializer, not NULL. Initialization is performed according to normal assignment rules. */ *************** gfc_assign_data_value (gfc_expr * lvalue *** 315,322 **** expr = create_character_intializer (init, last_ts, ref, rvalue); else { ! /* We should never be overwriting an existing initializer. */ ! gcc_assert (!init); expr = gfc_copy_expr (rvalue); if (!gfc_compare_types (&lvalue->ts, &expr->ts)) --- 315,333 ---- expr = create_character_intializer (init, last_ts, ref, rvalue); else { ! /* Overwriting an existing initializer is non-standard but usually only ! provokes a warning from other compilers. */ ! if (init != NULL) ! { ! /* Order in which the expressions arrive here depends on whether they ! are from data statements or F95 style declarations. Therefore, ! check which is the most recent. */ ! expr = (init->where.lb->linenum > rvalue->where.lb->linenum) ? ! init : rvalue; ! gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization " ! "of '%s' at %L", symbol->name, &expr->where); ! return; ! } expr = gfc_copy_expr (rvalue); if (!gfc_compare_types (&lvalue->ts, &expr->ts)) *************** formalize_structure_cons (gfc_expr * exp *** 561,567 **** c = expr->value.constructor; ! /* Constructor is already fomalized. */ if (c->n.component == NULL) return; --- 572,578 ---- c = expr->value.constructor; ! /* Constructor is already formalized. */ if (c->n.component == NULL) return; diff -Nrcpad gcc-4.0.2/gcc/fortran/decl.c gcc-4.1.0/gcc/fortran/decl.c *** gcc-4.0.2/gcc/fortran/decl.c Thu Aug 25 12:25:21 2005 --- gcc-4.1.0/gcc/fortran/decl.c Fri Feb 10 20:09:41 2006 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** Software Foundation, 59 Temple Place - S *** 32,38 **** static int old_char_selector; ! /* When variables aquire types and attributes from a declaration statement, they get them from the following static variables. The first part of a declaration sets these variables and the second part copies these into symbol structures. */ --- 32,38 ---- static int old_char_selector; ! /* When variables acquire types and attributes from a declaration statement, they get them from the following static variables. The first part of a declaration sets these variables and the second part copies these into symbol structures. */ *************** static symbol_attribute current_attr; *** 43,48 **** --- 43,72 ---- static gfc_array_spec *current_as; static int colon_seen; + /* Initializer of the previous enumerator. */ + + static gfc_expr *last_initializer; + + /* History of all the enumerators is maintained, so that + kind values of all the enumerators could be updated depending + upon the maximum initialized value. */ + + typedef struct enumerator_history + { + gfc_symbol *sym; + gfc_expr *initializer; + struct enumerator_history *next; + } + enumerator_history; + + /* Header of enum history chain. */ + + static enumerator_history *enum_history = NULL; + + /* Pointer of enum history node containing largest initializer. */ + + static enumerator_history *max_enum = NULL; + /* gfc_new_block points to the symbol of a newly matched block. */ gfc_symbol *gfc_new_block; *************** var_element (gfc_data_variable * new) *** 179,202 **** sym = new->expr->symtree->n.sym; ! if(sym->value != NULL) { ! gfc_error ("Variable '%s' at %C already has an initialization", ! sym->name); return MATCH_ERROR; } ! #if 0 // TODO: Find out where to move this message ! if (sym->attr.in_common) ! /* See if sym is in the blank common block. */ ! for (t = &sym->ns->blank_common; t; t = t->common_next) ! if (sym == t->head) ! { ! gfc_error ("DATA statement at %C may not initialize variable " ! "'%s' from blank COMMON", sym->name); ! return MATCH_ERROR; ! } ! #endif if (gfc_add_data (&sym->attr, sym->name, &new->expr->where) == FAILURE) return MATCH_ERROR; --- 203,221 ---- sym = new->expr->symtree->n.sym; ! if (!sym->attr.function && gfc_current_ns->parent && gfc_current_ns->parent == sym->ns) { ! gfc_error ("Host associated variable '%s' may not be in the DATA " ! "statement at %C.", sym->name); return MATCH_ERROR; } ! if (gfc_current_state () != COMP_BLOCK_DATA ! && sym->attr.in_common ! && gfc_notify_std (GFC_STD_GNU, "Extension: initialization of " ! "common block variable '%s' in DATA statement at %C", ! sym->name) == FAILURE) ! return MATCH_ERROR; if (gfc_add_data (&sym->attr, sym->name, &new->expr->where) == FAILURE) return MATCH_ERROR; *************** match_old_style_init (const char *name) *** 401,407 **** /* Match the stuff following a DATA statement. If ERROR_FLAG is set, we are matching a DATA statement and are therefore issuing an error if we encounter something unexpected, if not, we're trying to match ! an old-style intialization expression of the form INTEGER I /2/. */ match gfc_match_data (void) --- 420,426 ---- /* Match the stuff following a DATA statement. If ERROR_FLAG is set, we are matching a DATA statement and are therefore issuing an error if we encounter something unexpected, if not, we're trying to match ! an old-style initialization expression of the form INTEGER I /2/. */ match gfc_match_data (void) *************** char_len_param_value (gfc_expr ** expr) *** 489,502 **** static match match_char_length (gfc_expr ** expr) { ! int length; match m; m = gfc_match_char ('*'); if (m != MATCH_YES) return m; ! m = gfc_match_small_literal_int (&length); if (m == MATCH_ERROR) return m; --- 508,522 ---- static match match_char_length (gfc_expr ** expr) { ! int length, cnt; match m; m = gfc_match_char ('*'); if (m != MATCH_YES) return m; ! /* cnt is unused, here. */ ! m = gfc_match_small_literal_int (&length, &cnt); if (m == MATCH_ERROR) return m; *************** get_proc_name (const char *name, gfc_sym *** 584,600 **** int rc; if (gfc_current_ns->parent == NULL) ! return gfc_get_symbol (name, NULL, result); ! rc = gfc_get_symbol (name, gfc_current_ns->parent, result); ! if (*result == NULL) ! return rc; ! /* ??? Deal with ENTRY problem */ st = gfc_new_symtree (&gfc_current_ns->sym_root, name); - sym = *result; st->n.sym = sym; sym->refs++; --- 604,645 ---- int rc; if (gfc_current_ns->parent == NULL) ! rc = gfc_get_symbol (name, NULL, result); ! else ! rc = gfc_get_symbol (name, gfc_current_ns->parent, result); ! sym = *result; ! if (sym && !sym->new && gfc_current_state () != COMP_INTERFACE) ! { ! /* Trap another encompassed procedure with the same name. All ! these conditions are necessary to avoid picking up an entry ! whose name clashes with that of the encompassing procedure; ! this is handled using gsymbols to register unique,globally ! accessible names. */ ! if (sym->attr.flavor != 0 ! && sym->attr.proc != 0 ! && sym->formal) ! gfc_error_now ("Procedure '%s' at %C is already defined at %L", ! name, &sym->declared_at); ! ! /* Trap declarations of attributes in encompassing scope. The ! signature for this is that ts.kind is set. Legitimate ! references only set ts.type. */ ! if (sym->ts.kind != 0 ! && sym->attr.proc == 0 ! && gfc_current_ns->parent != NULL ! && sym->attr.access == 0) ! gfc_error_now ("Procedure '%s' at %C has an explicit interface" ! " and must not have attributes declared at %L", ! name, &sym->declared_at); ! } ! ! if (gfc_current_ns->parent == NULL || *result == NULL) ! return rc; st = gfc_new_symtree (&gfc_current_ns->sym_root, name); st->n.sym = sym; sym->refs++; *************** gfc_set_constant_character_len (int len, *** 677,682 **** --- 722,784 ---- } } + + /* Function to create and update the enumerator history + using the information passed as arguments. + Pointer "max_enum" is also updated, to point to + enum history node containing largest initializer. + + SYM points to the symbol node of enumerator. + INIT points to its enumerator value. */ + + static void + create_enum_history(gfc_symbol *sym, gfc_expr *init) + { + enumerator_history *new_enum_history; + gcc_assert (sym != NULL && init != NULL); + + new_enum_history = gfc_getmem (sizeof (enumerator_history)); + + new_enum_history->sym = sym; + new_enum_history->initializer = init; + new_enum_history->next = NULL; + + if (enum_history == NULL) + { + enum_history = new_enum_history; + max_enum = enum_history; + } + else + { + new_enum_history->next = enum_history; + enum_history = new_enum_history; + + if (mpz_cmp (max_enum->initializer->value.integer, + new_enum_history->initializer->value.integer) < 0) + max_enum = new_enum_history; + } + } + + + /* Function to free enum kind history. */ + + void + gfc_free_enum_history(void) + { + enumerator_history *current = enum_history; + enumerator_history *next; + + while (current != NULL) + { + next = current->next; + gfc_free (current); + current = next; + } + max_enum = NULL; + enum_history = NULL; + } + + /* Function called by variable_decl() that adds an initialization expression to a symbol. */ *************** add_init_expr_to_sym (const char *name, *** 746,751 **** --- 848,860 ---- /* Update symbol character length according initializer. */ if (sym->ts.cl->length == NULL) { + /* If there are multiple CHARACTER variables declared on + the same line, we don't want them to share the same + length. */ + sym->ts.cl = gfc_get_charlen (); + sym->ts.cl->next = gfc_current_ns->cl_list; + gfc_current_ns->cl_list = sym->ts.cl; + if (init->expr_type == EXPR_CONSTANT) sym->ts.cl->length = gfc_int_expr (init->value.character.length); *************** add_init_expr_to_sym (const char *name, *** 778,783 **** --- 887,896 ---- *initp = NULL; } + /* Maintain enumerator history. */ + if (gfc_current_state () == COMP_ENUM) + create_enum_history (sym, init); + return SUCCESS; } *************** gfc_match_null (gfc_expr ** result) *** 900,917 **** symbol table or the current interface. */ static match ! variable_decl (void) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_expr *initializer, *char_len; gfc_array_spec *as; gfc_charlen *cl; locus var_locus; match m; try t; initializer = NULL; as = NULL; /* When we get here, we've just matched a list of attributes and maybe a type and a double colon. The next thing we expect to see --- 1013,1035 ---- symbol table or the current interface. */ static match ! variable_decl (int elem) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_expr *initializer, *char_len; gfc_array_spec *as; + gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */ gfc_charlen *cl; locus var_locus; match m; try t; + gfc_symbol *sym; + locus old_locus; initializer = NULL; as = NULL; + cp_as = NULL; + old_locus = gfc_current_locus; /* When we get here, we've just matched a list of attributes and maybe a type and a double colon. The next thing we expect to see *************** variable_decl (void) *** 924,933 **** /* Now we could see the optional array spec. or character length. */ m = gfc_match_array_spec (&as); ! if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) as = gfc_copy_array_spec (current_as); char_len = NULL; cl = NULL; --- 1042,1062 ---- /* Now we could see the optional array spec. or character length. */ m = gfc_match_array_spec (&as); ! if (gfc_option.flag_cray_pointer && m == MATCH_YES) ! cp_as = gfc_copy_array_spec (as); ! else if (m == MATCH_ERROR) goto cleanup; + if (m == MATCH_NO) as = gfc_copy_array_spec (current_as); + else if (gfc_current_state () == COMP_ENUM) + { + gfc_error ("Enumerator cannot be array at %C"); + gfc_free_enum_history (); + m = MATCH_ERROR; + goto cleanup; + } + char_len = NULL; cl = NULL; *************** variable_decl (void) *** 944,951 **** cl->length = char_len; break; case MATCH_NO: ! cl = current_ts.cl; break; case MATCH_ERROR: --- 1073,1092 ---- cl->length = char_len; break; + /* Non-constant lengths need to be copied after the first + element. */ case MATCH_NO: ! if (elem > 1 && current_ts.cl->length ! && current_ts.cl->length->expr_type != EXPR_CONSTANT) ! { ! cl = gfc_get_charlen (); ! cl->next = gfc_current_ns->cl_list; ! gfc_current_ns->cl_list = cl; ! cl->length = gfc_copy_expr (current_ts.cl->length); ! } ! else ! cl = current_ts.cl; ! break; case MATCH_ERROR: *************** variable_decl (void) *** 953,961 **** } } /* OK, we've successfully matched the declaration. Now put the symbol in the current namespace, because it might be used in the ! optional intialization expression for this symbol, e.g. this is perfectly legal: integer, parameter :: i = huge(i) --- 1094,1145 ---- } } + /* If this symbol has already shown up in a Cray Pointer declaration, + then we want to set the type & bail out. */ + if (gfc_option.flag_cray_pointer) + { + gfc_find_symbol (name, gfc_current_ns, 1, &sym); + if (sym != NULL && sym->attr.cray_pointee) + { + sym->ts.type = current_ts.type; + sym->ts.kind = current_ts.kind; + sym->ts.cl = cl; + sym->ts.derived = current_ts.derived; + m = MATCH_YES; + + /* Check to see if we have an array specification. */ + if (cp_as != NULL) + { + if (sym->as != NULL) + { + gfc_error ("Duplicate array spec for Cray pointee at %C."); + gfc_free_array_spec (cp_as); + m = MATCH_ERROR; + goto cleanup; + } + else + { + if (gfc_set_array_spec (sym, cp_as, &var_locus) == FAILURE) + gfc_internal_error ("Couldn't set pointee array spec."); + + /* Fix the array spec. */ + m = gfc_mod_pointee_as (sym->as); + if (m == MATCH_ERROR) + goto cleanup; + } + } + goto cleanup; + } + else + { + gfc_free_array_spec (cp_as); + } + } + + /* OK, we've successfully matched the declaration. Now put the symbol in the current namespace, because it might be used in the ! optional initialization expression for this symbol, e.g. this is perfectly legal: integer, parameter :: i = huge(i) *************** variable_decl (void) *** 1020,1026 **** m = gfc_match_null (&initializer); if (m == MATCH_NO) { ! gfc_error ("Pointer initialization requires a NULL at %C"); m = MATCH_ERROR; } --- 1204,1210 ---- m = gfc_match_null (&initializer); if (m == MATCH_NO) { ! gfc_error ("Pointer initialization requires a NULL() at %C"); m = MATCH_ERROR; } *************** variable_decl (void) *** 1035,1042 **** if (m != MATCH_YES) goto cleanup; - initializer->ts = current_ts; - } else if (gfc_match_char ('=') == MATCH_YES) { --- 1219,1224 ---- *************** variable_decl (void) *** 1068,1073 **** --- 1250,1279 ---- } } + /* Check if we are parsing an enumeration and if the current enumerator + variable has an initializer or not. If it does not have an + initializer, the initialization value of the previous enumerator + (stored in last_initializer) is incremented by 1 and is used to + initialize the current enumerator. */ + if (gfc_current_state () == COMP_ENUM) + { + if (initializer == NULL) + initializer = gfc_enum_initializer (last_initializer, old_locus); + + if (initializer == NULL || initializer->ts.type != BT_INTEGER) + { + gfc_error("ENUMERATOR %L not initialized with integer expression", + &var_locus); + m = MATCH_ERROR; + gfc_free_enum_history (); + goto cleanup; + } + + /* Store this current initializer, for the next enumerator + variable to be parsed. */ + last_initializer = initializer; + } + /* Add the initializer. Note that it is fine if initializer is NULL here, because we sometimes also need to check if a declaration *must* have an initialization expression. */ *************** variable_decl (void) *** 1075,1081 **** t = add_init_expr_to_sym (name, &initializer, &var_locus); else { ! if (current_ts.type == BT_DERIVED && !initializer) initializer = gfc_default_initializer (¤t_ts); t = build_struct (name, cl, &initializer, &as); } --- 1281,1288 ---- t = add_init_expr_to_sym (name, &initializer, &var_locus); else { ! if (current_ts.type == BT_DERIVED && !current_attr.pointer ! && !initializer) initializer = gfc_default_initializer (¤t_ts); t = build_struct (name, cl, &initializer, &as); } *************** match *** 1097,1124 **** gfc_match_old_kind_spec (gfc_typespec * ts) { match m; if (gfc_match_char ('*') != MATCH_YES) return MATCH_NO; ! m = gfc_match_small_literal_int (&ts->kind); if (m != MATCH_YES) return MATCH_ERROR; /* Massage the kind numbers for complex types. */ ! if (ts->type == BT_COMPLEX && ts->kind == 8) ! ts->kind = 4; ! if (ts->type == BT_COMPLEX && ts->kind == 16) ! ts->kind = 8; if (gfc_validate_kind (ts->type, ts->kind, true) < 0) { ! gfc_error ("Old-style kind %d not supported for type %s at %C", ! ts->kind, gfc_basic_typename (ts->type)); ! return MATCH_ERROR; } return MATCH_YES; } --- 1304,1344 ---- gfc_match_old_kind_spec (gfc_typespec * ts) { match m; + int original_kind, cnt; if (gfc_match_char ('*') != MATCH_YES) return MATCH_NO; ! /* cnt is unused, here. */ ! m = gfc_match_small_literal_int (&ts->kind, &cnt); if (m != MATCH_YES) return MATCH_ERROR; + original_kind = ts->kind; + /* Massage the kind numbers for complex types. */ ! if (ts->type == BT_COMPLEX) ! { ! if (ts->kind % 2) ! { ! gfc_error ("Old-style type declaration %s*%d not supported at %C", ! gfc_basic_typename (ts->type), original_kind); ! return MATCH_ERROR; ! } ! ts->kind /= 2; ! } if (gfc_validate_kind (ts->type, ts->kind, true) < 0) { ! gfc_error ("Old-style type declaration %s*%d not supported at %C", ! gfc_basic_typename (ts->type), original_kind); return MATCH_ERROR; } + if (gfc_notify_std (GFC_STD_GNU, "Nonstandard type declaration %s*%d at %C", + gfc_basic_typename (ts->type), original_kind) == FAILURE) + return MATCH_ERROR; + return MATCH_YES; } *************** match_type_spec (gfc_typespec * ts, int *** 1367,1372 **** --- 1587,1610 ---- gfc_clear_ts (ts); + if (gfc_match (" byte") == MATCH_YES) + { + if (gfc_notify_std(GFC_STD_GNU, "Extension: BYTE type at %C") + == FAILURE) + return MATCH_ERROR; + + if (gfc_validate_kind (BT_INTEGER, 1, true) < 0) + { + gfc_error ("BYTE type used at %C " + "is not available on the target machine"); + return MATCH_ERROR; + } + + ts->type = BT_INTEGER; + ts->kind = 1; + return MATCH_YES; + } + if (gfc_match (" integer") == MATCH_YES) { ts->type = BT_INTEGER; *************** match_type_spec (gfc_typespec * ts, int *** 1406,1411 **** --- 1644,1653 ---- if (gfc_match (" double complex") == MATCH_YES) { + if (gfc_notify_std (GFC_STD_GNU, "DOUBLE COMPLEX at %C does not " + "conform to the Fortran 95 standard") == FAILURE) + return MATCH_ERROR; + ts->type = BT_COMPLEX; ts->kind = gfc_default_double_kind; return MATCH_YES; *************** match_attr_spec (void) *** 1752,1757 **** --- 1994,2005 ---- d = (decl_types) gfc_match_strings (decls); if (d == DECL_NONE || d == DECL_COLON) break; + + if (gfc_current_state () == COMP_ENUM) + { + gfc_error ("Enumerator cannot have attributes %C"); + return MATCH_ERROR; + } seen[d]++; seen_at[d] = gfc_current_locus; *************** match_attr_spec (void) *** 1771,1776 **** --- 2019,2036 ---- } } + /* If we are parsing an enumeration and have ensured that no other + attributes are present we can now set the parameter attribute. */ + if (gfc_current_state () == COMP_ENUM) + { + t = gfc_add_flavor (¤t_attr, FL_PARAMETER, NULL, NULL); + if (t == FAILURE) + { + m = MATCH_ERROR; + goto cleanup; + } + } + /* No double colon, so assume that we've been looking at something else the whole time. */ if (d == DECL_NONE) *************** match_attr_spec (void) *** 1855,1860 **** --- 2115,2134 ---- goto cleanup; } + if ((d == DECL_PRIVATE || d == DECL_PUBLIC) + && gfc_current_state () != COMP_MODULE) + { + if (d == DECL_PRIVATE) + attr = "PRIVATE"; + else + attr = "PUBLIC"; + + gfc_error ("%s attribute at %L is not allowed outside of a MODULE", + attr, &seen_at[d]); + m = MATCH_ERROR; + goto cleanup; + } + switch (d) { case DECL_ALLOCATABLE: *************** gfc_match_data_decl (void) *** 1944,1949 **** --- 2218,2224 ---- { gfc_symbol *sym; match m; + int elem; m = match_type_spec (¤t_ts, 0); if (m != MATCH_YES) *************** gfc_match_data_decl (void) *** 1975,1991 **** if (current_attr.pointer && gfc_current_state () == COMP_DERIVED) goto ok; ! if (gfc_find_symbol (current_ts.derived->name, ! current_ts.derived->ns->parent, 1, &sym) == 0) ! goto ok; ! /* Hope that an ambiguous symbol is itself masked by a type definition. */ ! if (sym != NULL && sym->attr.flavor == FL_DERIVED) goto ok; ! gfc_error ("Derived type at %C has not been previously defined"); ! m = MATCH_ERROR; ! goto cleanup; } ok: --- 2250,2270 ---- if (current_attr.pointer && gfc_current_state () == COMP_DERIVED) goto ok; ! gfc_find_symbol (current_ts.derived->name, ! current_ts.derived->ns->parent, 1, &sym); ! /* Any symbol that we find had better be a type definition ! which has its components defined. */ ! if (sym != NULL && sym->attr.flavor == FL_DERIVED ! && current_ts.derived->components != NULL) goto ok; ! /* Now we have an error, which we signal, and then fix up ! because the knock-on is plain and simple confusing. */ ! gfc_error_now ("Derived type at %C has not been previously defined " ! "and so cannot appear in a derived type definition."); ! current_attr.pointer = 1; ! goto ok; } ok: *************** ok: *** 1995,2004 **** if (m == MATCH_NO && current_ts.type == BT_CHARACTER && old_char_selector) gfc_match_char (','); ! /* Give the types/attributes to symbols that follow. */ for (;;) { ! m = variable_decl (); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) --- 2274,2285 ---- if (m == MATCH_NO && current_ts.type == BT_CHARACTER && old_char_selector) gfc_match_char (','); ! /* Give the types/attributes to symbols that follow. Give the element ! a number so that repeat character length expressions can be copied. */ ! elem = 1; for (;;) { ! m = variable_decl (elem++); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) *************** cleanup: *** 2346,2351 **** --- 2627,2655 ---- return m; } + /* This is mostly a copy of parse.c(add_global_procedure) but modified to pass the + name of the entry, rather than the gfc_current_block name, and to return false + upon finding an existing global entry. */ + + static bool + add_global_entry (const char * name, int sub) + { + gfc_gsymbol *s; + + s = gfc_get_gsymbol(name); + + if (s->defined + || (s->type != GSYM_UNKNOWN && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION))) + global_used(s, NULL); + else + { + s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; + s->where = gfc_current_locus; + s->defined = 1; + return true; + } + return false; + } /* Match an ENTRY statement. */ *************** gfc_match_entry (void) *** 2359,2375 **** gfc_compile_state state; match m; gfc_entry_list *el; m = gfc_match_name (name); if (m != MATCH_YES) return m; state = gfc_current_state (); ! if (state != COMP_SUBROUTINE ! && state != COMP_FUNCTION) { ! gfc_error ("ENTRY statement at %C cannot appear within %s", ! gfc_state_name (gfc_current_state ())); return MATCH_ERROR; } --- 2663,2726 ---- gfc_compile_state state; match m; gfc_entry_list *el; + locus old_loc; m = gfc_match_name (name); if (m != MATCH_YES) return m; state = gfc_current_state (); ! if (state != COMP_SUBROUTINE && state != COMP_FUNCTION) { ! switch (state) ! { ! case COMP_PROGRAM: ! gfc_error ("ENTRY statement at %C cannot appear within a PROGRAM"); ! break; ! case COMP_MODULE: ! gfc_error ("ENTRY statement at %C cannot appear within a MODULE"); ! break; ! case COMP_BLOCK_DATA: ! gfc_error ! ("ENTRY statement at %C cannot appear within a BLOCK DATA"); ! break; ! case COMP_INTERFACE: ! gfc_error ! ("ENTRY statement at %C cannot appear within an INTERFACE"); ! break; ! case COMP_DERIVED: ! gfc_error ! ("ENTRY statement at %C cannot appear " ! "within a DERIVED TYPE block"); ! break; ! case COMP_IF: ! gfc_error ! ("ENTRY statement at %C cannot appear within an IF-THEN block"); ! break; ! case COMP_DO: ! gfc_error ! ("ENTRY statement at %C cannot appear within a DO block"); ! break; ! case COMP_SELECT: ! gfc_error ! ("ENTRY statement at %C cannot appear within a SELECT block"); ! break; ! case COMP_FORALL: ! gfc_error ! ("ENTRY statement at %C cannot appear within a FORALL block"); ! break; ! case COMP_WHERE: ! gfc_error ! ("ENTRY statement at %C cannot appear within a WHERE block"); ! break; ! case COMP_CONTAINS: ! gfc_error ! ("ENTRY statement at %C cannot appear " ! "within a contained subprogram"); ! break; ! default: ! gfc_internal_error ("gfc_match_entry(): Bad state"); ! } return MATCH_ERROR; } *************** gfc_match_entry (void) *** 2390,2395 **** --- 2741,2749 ---- if (state == COMP_SUBROUTINE) { /* An entry in a subroutine. */ + if (!add_global_entry (name, 1)) + return MATCH_ERROR; + m = gfc_match_formal_arglist (entry, 0, 1); if (m != MATCH_YES) return MATCH_ERROR; *************** gfc_match_entry (void) *** 2400,2407 **** } else { ! /* An entry in a function. */ ! m = gfc_match_formal_arglist (entry, 0, 1); if (m != MATCH_YES) return MATCH_ERROR; --- 2754,2782 ---- } else { ! /* An entry in a function. ! We need to take special care because writing ! ENTRY f() ! as ! ENTRY f ! is allowed, whereas ! ENTRY f() RESULT (r) ! can't be written as ! ENTRY f RESULT (r). */ ! if (!add_global_entry (name, 0)) ! return MATCH_ERROR; ! ! old_loc = gfc_current_locus; ! if (gfc_match_eos () == MATCH_YES) ! { ! gfc_current_locus = old_loc; ! /* Match the empty argument list, and add the interface to ! the symbol. */ ! m = gfc_match_formal_arglist (entry, 0, 1); ! } ! else ! m = gfc_match_formal_arglist (entry, 0, 0); ! if (m != MATCH_YES) return MATCH_ERROR; *************** contained_procedure (void) *** 2526,2531 **** --- 2901,2940 ---- return 0; } + /* Set the kind of each enumerator. The kind is selected such that it is + interoperable with the corresponding C enumeration type, making + sure that -fshort-enums is honored. */ + + static void + set_enum_kind(void) + { + enumerator_history *current_history = NULL; + int kind; + int i; + + if (max_enum == NULL || enum_history == NULL) + return; + + if (!gfc_option.fshort_enums) + return; + + i = 0; + do + { + kind = gfc_integer_kinds[i++].kind; + } + while (kind < gfc_c_int_kind + && gfc_check_integer_range (max_enum->initializer->value.integer, + kind) != ARITH_OK); + + current_history = enum_history; + while (current_history != NULL) + { + current_history->sym->ts.kind = kind; + current_history = current_history->next; + } + } + /* Match any of the various end-block statements. Returns the type of END to the caller. The END INTERFACE, END IF, END DO and END SELECT statements cannot be replaced by a single END statement. */ *************** gfc_match_end (gfc_statement * st) *** 2631,2636 **** --- 3040,3054 ---- eos_ok = 0; break; + case COMP_ENUM: + *st = ST_END_ENUM; + target = " enum"; + eos_ok = 0; + last_initializer = NULL; + set_enum_kind (); + gfc_free_enum_history (); + break; + default: gfc_error ("Unexpected END statement at %C"); goto cleanup; *************** attr_decl1 (void) *** 2775,2780 **** --- 3193,3212 ---- m = MATCH_ERROR; goto cleanup; } + + if (sym->attr.cray_pointee && sym->as != NULL) + { + /* Fix the array spec. */ + m = gfc_mod_pointee_as (sym->as); + if (m == MATCH_ERROR) + goto cleanup; + } + + if (gfc_add_attribute (&sym->attr, &var_locus, current_attr.intent) == FAILURE) + { + m = MATCH_ERROR; + goto cleanup; + } if ((current_attr.external || current_attr.intrinsic) && sym->attr.flavor != FL_PROCEDURE *************** attr_decl (void) *** 2828,2839 **** } match gfc_match_external (void) { gfc_clear_attr (¤t_attr); ! gfc_add_external (¤t_attr, NULL); return attr_decl (); } --- 3260,3421 ---- } + /* This routine matches Cray Pointer declarations of the form: + pointer ( , ) + or + pointer ( , ), ( , ), ... + The pointer, if already declared, should be an integer. Otherwise, we + set it as BT_INTEGER with kind gfc_index_integer_kind. The pointee may + be either a scalar, or an array declaration. No space is allocated for + the pointee. For the statement + pointer (ipt, ar(10)) + any subsequent uses of ar will be translated (in C-notation) as + ar(i) => (( *) ipt)(i) + After gimplification, pointee variable will disappear in the code. */ + + static match + cray_pointer_decl (void) + { + match m; + gfc_array_spec *as; + gfc_symbol *cptr; /* Pointer symbol. */ + gfc_symbol *cpte; /* Pointee symbol. */ + locus var_locus; + bool done = false; + + while (!done) + { + if (gfc_match_char ('(') != MATCH_YES) + { + gfc_error ("Expected '(' at %C"); + return MATCH_ERROR; + } + + /* Match pointer. */ + var_locus = gfc_current_locus; + gfc_clear_attr (¤t_attr); + gfc_add_cray_pointer (¤t_attr, &var_locus); + current_ts.type = BT_INTEGER; + current_ts.kind = gfc_index_integer_kind; + + m = gfc_match_symbol (&cptr, 0); + if (m != MATCH_YES) + { + gfc_error ("Expected variable name at %C"); + return m; + } + + if (gfc_add_cray_pointer (&cptr->attr, &var_locus) == FAILURE) + return MATCH_ERROR; + + gfc_set_sym_referenced (cptr); + + if (cptr->ts.type == BT_UNKNOWN) /* Override the type, if necessary. */ + { + cptr->ts.type = BT_INTEGER; + cptr->ts.kind = gfc_index_integer_kind; + } + else if (cptr->ts.type != BT_INTEGER) + { + gfc_error ("Cray pointer at %C must be an integer."); + return MATCH_ERROR; + } + else if (cptr->ts.kind < gfc_index_integer_kind) + gfc_warning ("Cray pointer at %C has %d bytes of precision;" + " memory addresses require %d bytes.", + cptr->ts.kind, + gfc_index_integer_kind); + + if (gfc_match_char (',') != MATCH_YES) + { + gfc_error ("Expected \",\" at %C"); + return MATCH_ERROR; + } + + /* Match Pointee. */ + var_locus = gfc_current_locus; + gfc_clear_attr (¤t_attr); + gfc_add_cray_pointee (¤t_attr, &var_locus); + current_ts.type = BT_UNKNOWN; + current_ts.kind = 0; + + m = gfc_match_symbol (&cpte, 0); + if (m != MATCH_YES) + { + gfc_error ("Expected variable name at %C"); + return m; + } + + /* Check for an optional array spec. */ + m = gfc_match_array_spec (&as); + if (m == MATCH_ERROR) + { + gfc_free_array_spec (as); + return m; + } + else if (m == MATCH_NO) + { + gfc_free_array_spec (as); + as = NULL; + } + + if (gfc_add_cray_pointee (&cpte->attr, &var_locus) == FAILURE) + return MATCH_ERROR; + + gfc_set_sym_referenced (cpte); + + if (cpte->as == NULL) + { + if (gfc_set_array_spec (cpte, as, &var_locus) == FAILURE) + gfc_internal_error ("Couldn't set Cray pointee array spec."); + } + else if (as != NULL) + { + gfc_error ("Duplicate array spec for Cray pointee at %C."); + gfc_free_array_spec (as); + return MATCH_ERROR; + } + + as = NULL; + + if (cpte->as != NULL) + { + /* Fix array spec. */ + m = gfc_mod_pointee_as (cpte->as); + if (m == MATCH_ERROR) + return m; + } + + /* Point the Pointee at the Pointer. */ + cpte->cp_pointer = cptr; + + if (gfc_match_char (')') != MATCH_YES) + { + gfc_error ("Expected \")\" at %C"); + return MATCH_ERROR; + } + m = gfc_match_char (','); + if (m != MATCH_YES) + done = true; /* Stop searching for more declarations. */ + + } + + if (m == MATCH_ERROR /* Failed when trying to find ',' above. */ + || gfc_match_eos () != MATCH_YES) + { + gfc_error ("Expected \",\" or end of statement at %C"); + return MATCH_ERROR; + } + return MATCH_YES; + } + + match gfc_match_external (void) { gfc_clear_attr (¤t_attr); ! current_attr.external = 1; return attr_decl (); } *************** gfc_match_intent (void) *** 2850,2856 **** return MATCH_ERROR; gfc_clear_attr (¤t_attr); ! gfc_add_intent (¤t_attr, intent, NULL); /* Can't fail */ return attr_decl (); } --- 3432,3438 ---- return MATCH_ERROR; gfc_clear_attr (¤t_attr); ! current_attr.intent = intent; return attr_decl (); } *************** gfc_match_intrinsic (void) *** 2861,2867 **** { gfc_clear_attr (¤t_attr); ! gfc_add_intrinsic (¤t_attr, NULL); return attr_decl (); } --- 3443,3449 ---- { gfc_clear_attr (¤t_attr); ! current_attr.intrinsic = 1; return attr_decl (); } *************** gfc_match_optional (void) *** 2872,2878 **** { gfc_clear_attr (¤t_attr); ! gfc_add_optional (¤t_attr, NULL); return attr_decl (); } --- 3454,3460 ---- { gfc_clear_attr (¤t_attr); ! current_attr.optional = 1; return attr_decl (); } *************** gfc_match_optional (void) *** 2881,2891 **** match gfc_match_pointer (void) { ! ! gfc_clear_attr (¤t_attr); ! gfc_add_pointer (¤t_attr, NULL); ! ! return attr_decl (); } --- 3463,3486 ---- match gfc_match_pointer (void) { ! gfc_gobble_whitespace (); ! if (gfc_peek_char () == '(') ! { ! if (!gfc_option.flag_cray_pointer) ! { ! gfc_error ("Cray pointer declaration at %C requires -fcray-pointer" ! " flag."); ! return MATCH_ERROR; ! } ! return cray_pointer_decl (); ! } ! else ! { ! gfc_clear_attr (¤t_attr); ! current_attr.pointer = 1; ! ! return attr_decl (); ! } } *************** gfc_match_allocatable (void) *** 2894,2900 **** { gfc_clear_attr (¤t_attr); ! gfc_add_allocatable (¤t_attr, NULL); return attr_decl (); } --- 3489,3495 ---- { gfc_clear_attr (¤t_attr); ! current_attr.allocatable = 1; return attr_decl (); } *************** gfc_match_dimension (void) *** 2905,2911 **** { gfc_clear_attr (¤t_attr); ! gfc_add_dimension (¤t_attr, NULL, NULL); return attr_decl (); } --- 3500,3506 ---- { gfc_clear_attr (¤t_attr); ! current_attr.dimension = 1; return attr_decl (); } *************** gfc_match_target (void) *** 2916,2922 **** { gfc_clear_attr (¤t_attr); ! gfc_add_target (¤t_attr, NULL); return attr_decl (); } --- 3511,3517 ---- { gfc_clear_attr (¤t_attr); ! current_attr.target = 1; return attr_decl (); } *************** do_parm (void) *** 3107,3112 **** --- 3702,3717 ---- goto cleanup; } + if (sym->ts.type == BT_CHARACTER + && sym->ts.cl != NULL + && sym->ts.cl->length != NULL + && sym->ts.cl->length->expr_type == EXPR_CONSTANT + && init->expr_type == EXPR_CONSTANT + && init->ts.type == BT_CHARACTER + && init->ts.kind == 1) + gfc_set_constant_character_len ( + mpz_get_si (sym->ts.cl->length->value.integer), init); + sym->value = init; return MATCH_YES; *************** gfc_match_save (void) *** 3161,3170 **** { if (gfc_current_ns->seen_save) { ! gfc_error ("Blanket SAVE statement at %C follows previous " ! "SAVE statement"); ! ! return MATCH_ERROR; } gfc_current_ns->save_all = gfc_current_ns->seen_save = 1; --- 3766,3776 ---- { if (gfc_current_ns->seen_save) { ! if (gfc_notify_std (GFC_STD_LEGACY, ! "Blanket SAVE statement at %C follows previous " ! "SAVE statement") ! == FAILURE) ! return MATCH_ERROR; } gfc_current_ns->save_all = gfc_current_ns->seen_save = 1; *************** gfc_match_save (void) *** 3173,3180 **** if (gfc_current_ns->save_all) { ! gfc_error ("SAVE statement at %C follows blanket SAVE statement"); ! return MATCH_ERROR; } gfc_match (" ::"); --- 3779,3788 ---- if (gfc_current_ns->save_all) { ! if (gfc_notify_std (GFC_STD_LEGACY, ! "SAVE statement at %C follows blanket SAVE statement") ! == FAILURE) ! return MATCH_ERROR; } gfc_match (" ::"); *************** syntax: *** 3225,3231 **** /* Match a module procedure statement. Note that we have to modify symbols in the parent's namespace because the current one was there ! to receive symbols that are in a interface's formal argument list. */ match gfc_match_modproc (void) --- 3833,3839 ---- /* Match a module procedure statement. Note that we have to modify symbols in the parent's namespace because the current one was there ! to receive symbols that are in an interface's formal argument list. */ match gfc_match_modproc (void) *************** loop: *** 3380,3382 **** --- 3988,4100 ---- return MATCH_YES; } + + + /* Cray Pointees can be declared as: + pointer (ipt, a (n,m,...,*)) + By default, this is treated as an AS_ASSUMED_SIZE array. We'll + cheat and set a constant bound of 1 for the last dimension, if this + is the case. Since there is no bounds-checking for Cray Pointees, + this will be okay. */ + + try + gfc_mod_pointee_as (gfc_array_spec *as) + { + as->cray_pointee = true; /* This will be useful to know later. */ + if (as->type == AS_ASSUMED_SIZE) + { + as->type = AS_EXPLICIT; + as->upper[as->rank - 1] = gfc_int_expr (1); + as->cp_was_assumed = true; + } + else if (as->type == AS_ASSUMED_SHAPE) + { + gfc_error ("Cray Pointee at %C cannot be assumed shape array"); + return MATCH_ERROR; + } + return MATCH_YES; + } + + + /* Match the enum definition statement, here we are trying to match + the first line of enum definition statement. + Returns MATCH_YES if match is found. */ + + match + gfc_match_enum (void) + { + match m; + + m = gfc_match_eos (); + if (m != MATCH_YES) + return m; + + if (gfc_notify_std (GFC_STD_F2003, + "New in Fortran 2003: ENUM AND ENUMERATOR at %C") + == FAILURE) + return MATCH_ERROR; + + return MATCH_YES; + } + + + /* Match the enumerator definition statement. */ + + match + gfc_match_enumerator_def (void) + { + match m; + int elem; + + gfc_clear_ts (¤t_ts); + + m = gfc_match (" enumerator"); + if (m != MATCH_YES) + return m; + + if (gfc_current_state () != COMP_ENUM) + { + gfc_error ("ENUM definition statement expected before %C"); + gfc_free_enum_history (); + return MATCH_ERROR; + } + + (¤t_ts)->type = BT_INTEGER; + (¤t_ts)->kind = gfc_c_int_kind; + + m = match_attr_spec (); + if (m == MATCH_ERROR) + { + m = MATCH_NO; + goto cleanup; + } + + elem = 1; + for (;;) + { + m = variable_decl (elem++); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO) + break; + + if (gfc_match_eos () == MATCH_YES) + goto cleanup; + if (gfc_match_char (',') != MATCH_YES) + break; + } + + if (gfc_current_state () == COMP_ENUM) + { + gfc_free_enum_history (); + gfc_error ("Syntax error in ENUMERATOR definition at %C"); + m = MATCH_ERROR; + } + + cleanup: + gfc_free_array_spec (current_as); + current_as = NULL; + return m; + + } + diff -Nrcpad gcc-4.0.2/gcc/fortran/dependency.c gcc-4.1.0/gcc/fortran/dependency.c *** gcc-4.0.2/gcc/fortran/dependency.c Wed Feb 23 21:34:10 2005 --- gcc-4.1.0/gcc/fortran/dependency.c Fri Sep 16 03:26:37 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* dependency.c -- Expression dependency analysis code. */ /* There's probably quite a bit of duplication in this file. We currently --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* dependency.c -- Expression dependency analysis code. */ /* There's probably quite a bit of duplication in this file. We currently *************** gfc_is_same_range (gfc_array_ref * ar1, *** 175,180 **** --- 175,219 ---- } + /* Return true if the result of reference REF can only be constructed + using a temporary array. */ + + bool + gfc_ref_needs_temporary_p (gfc_ref *ref) + { + int n; + bool subarray_p; + + subarray_p = false; + for (; ref; ref = ref->next) + switch (ref->type) + { + case REF_ARRAY: + /* Vector dimensions are generally not monotonic and must be + handled using a temporary. */ + if (ref->u.ar.type == AR_SECTION) + for (n = 0; n < ref->u.ar.dimen; n++) + if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR) + return true; + + subarray_p = true; + break; + + case REF_SUBSTRING: + /* Within an array reference, character substrings generally + need a temporary. Character array strides are expressed as + multiples of the element size (consistent with other array + types), not in characters. */ + return subarray_p; + + case REF_COMPONENT: + break; + } + + return false; + } + + /* Dependency checking for direct function return by reference. Returns true if the arguments of the function depend on the destination. This is considerably less conservative than other *************** int *** 185,193 **** gfc_check_fncall_dependency (gfc_expr * dest, gfc_expr * fncall) { gfc_actual_arglist *actual; - gfc_ref *ref; gfc_expr *expr; - int n; gcc_assert (dest->expr_type == EXPR_VARIABLE && fncall->expr_type == EXPR_FUNCTION); --- 224,230 ---- *************** gfc_check_fncall_dependency (gfc_expr * *** 205,235 **** switch (expr->expr_type) { case EXPR_VARIABLE: ! if (expr->rank > 1) ! { ! /* This is an array section. */ ! for (ref = expr->ref; ref; ref = ref->next) ! { ! if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) ! break; ! } ! gcc_assert (ref); ! /* AR_FULL can't contain vector subscripts. */ ! if (ref->u.ar.type == AR_SECTION) ! { ! for (n = 0; n < ref->u.ar.dimen; n++) ! { ! if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR) ! break; ! } ! /* Vector subscript array sections will be copied to a ! temporary. */ ! if (n != ref->u.ar.dimen) ! continue; ! } ! } ! ! if (gfc_check_dependency (dest, actual->expr, NULL, 0)) return 1; break; --- 242,249 ---- switch (expr->expr_type) { case EXPR_VARIABLE: ! if (!gfc_ref_needs_temporary_p (expr->ref) ! && gfc_check_dependency (dest, expr, NULL, 0)) return 1; break; *************** get_deps (mpz_t x1, mpz_t x2, mpz_t y) *** 378,384 **** } ! /* Transforms a sections l and r such that (l_start:l_end:l_stride) -> (0:no_of_elements) (r_start:r_end:r_stride) -> (X1:X2) Where r_end is implicit as both sections must have the same number of --- 392,398 ---- } ! /* Perform the same linear transformation on sections l and r such that (l_start:l_end:l_stride) -> (0:no_of_elements) (r_start:r_end:r_stride) -> (X1:X2) Where r_end is implicit as both sections must have the same number of *************** transform_sections (mpz_t X1, mpz_t X2, *** 420,426 **** mpz_mul (X2, no_of_elements, r_stride->value.integer); if (l_stride != NULL) ! mpz_cdiv_q (X2, X2, r_stride->value.integer); mpz_add (X2, X2, X1); return 0; --- 434,440 ---- mpz_mul (X2, no_of_elements, r_stride->value.integer); if (l_stride != NULL) ! mpz_cdiv_q (X2, X2, l_stride->value.integer); mpz_add (X2, X2, X1); return 0; diff -Nrcpad gcc-4.0.2/gcc/fortran/dependency.h gcc-4.1.0/gcc/fortran/dependency.h *** gcc-4.0.2/gcc/fortran/dependency.h Fri May 14 13:00:04 2004 --- gcc-4.1.0/gcc/fortran/dependency.h Mon Jan 30 05:45:06 2006 *************** for more details. *** 16,30 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ int gfc_check_fncall_dependency (gfc_expr *, gfc_expr *); int gfc_check_dependency (gfc_expr *, gfc_expr *, gfc_expr **, int); int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int); - int gfc_dep_compare_expr (gfc_expr *, gfc_expr *); int gfc_expr_is_one (gfc_expr *, int); int gfc_dep_resolver(gfc_ref *, gfc_ref *); --- 16,30 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ + bool gfc_ref_needs_temporary_p (gfc_ref *); int gfc_check_fncall_dependency (gfc_expr *, gfc_expr *); int gfc_check_dependency (gfc_expr *, gfc_expr *, gfc_expr **, int); int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int); int gfc_expr_is_one (gfc_expr *, int); int gfc_dep_resolver(gfc_ref *, gfc_ref *); diff -Nrcpad gcc-4.0.2/gcc/fortran/dump-parse-tree.c gcc-4.1.0/gcc/fortran/dump-parse-tree.c *** gcc-4.0.2/gcc/fortran/dump-parse-tree.c Tue May 10 23:04:45 2005 --- gcc-4.1.0/gcc/fortran/dump-parse-tree.c Sun Feb 12 18:31:40 2006 *************** *** 1,5 **** /* Parse tree dumper ! Copyright (C) 2003, 2004 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. --- 1,5 ---- /* Parse tree dumper ! Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Actually this is just a collection of routines that used to be --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Actually this is just a collection of routines that used to be *************** code_indent (int level, gfc_st_label * l *** 61,66 **** --- 61,67 ---- /* Simple indentation at the current level. This one is used to show symbols. */ + static inline void show_indent (void) { *************** show_indent (void) *** 70,75 **** --- 71,77 ---- /* Show type-specific information. */ + static void gfc_show_typespec (gfc_typespec * ts) { *************** gfc_show_actual_arglist (gfc_actual_argl *** 122,128 **** } ! /* Show an gfc_array_spec array specification structure. */ static void gfc_show_array_spec (gfc_array_spec * as) --- 124,130 ---- } ! /* Show a gfc_array_spec array specification structure. */ static void gfc_show_array_spec (gfc_array_spec * as) *************** gfc_show_array_spec (gfc_array_spec * as *** 165,171 **** } ! /* Show an gfc_array_ref array reference structure. */ static void gfc_show_array_ref (gfc_array_ref * ar) --- 167,173 ---- } ! /* Show a gfc_array_ref array reference structure. */ static void gfc_show_array_ref (gfc_array_ref * ar) *************** gfc_show_expr (gfc_expr * p) *** 476,481 **** --- 478,486 ---- case INTRINSIC_NOT: gfc_status ("NOT "); break; + case INTRINSIC_PARENTHESES: + gfc_status ("parens"); + break; default: gfc_internal_error *************** gfc_show_symbol (gfc_symbol * sym) *** 686,691 **** --- 691,697 ---- /* Show a user-defined operator. Just prints an operator and the name of the associated subroutine, really. */ + static void show_uop (gfc_user_op * uop) { *************** show_common (gfc_symtree * st) *** 746,751 **** --- 752,758 ---- gfc_status_char ('\n'); } + /* Worker function to display the symbol tree. */ static void *************** gfc_show_code_node (int level, gfc_code *** 1084,1089 **** --- 1091,1101 ---- gfc_status (" UNIT="); gfc_show_expr (open->unit); } + if (open->iomsg) + { + gfc_status (" IOMSG="); + gfc_show_expr (open->iomsg); + } if (open->iostat) { gfc_status (" IOSTAT="); *************** gfc_show_code_node (int level, gfc_code *** 1139,1144 **** --- 1151,1161 ---- gfc_status (" PAD="); gfc_show_expr (open->pad); } + if (open->convert) + { + gfc_status (" CONVERT="); + gfc_show_expr (open->convert); + } if (open->err != NULL) gfc_status (" ERR=%d", open->err->value); *************** gfc_show_code_node (int level, gfc_code *** 1153,1158 **** --- 1170,1180 ---- gfc_status (" UNIT="); gfc_show_expr (close->unit); } + if (close->iomsg) + { + gfc_status (" IOMSG="); + gfc_show_expr (close->iomsg); + } if (close->iostat) { gfc_status (" IOSTAT="); *************** gfc_show_code_node (int level, gfc_code *** 1177,1182 **** --- 1199,1208 ---- case EXEC_REWIND: gfc_status ("REWIND"); + goto show_filepos; + + case EXEC_FLUSH: + gfc_status ("FLUSH"); show_filepos: fp = c->ext.filepos; *************** gfc_show_code_node (int level, gfc_code *** 1186,1191 **** --- 1212,1222 ---- gfc_status (" UNIT="); gfc_show_expr (fp->unit); } + if (fp->iomsg) + { + gfc_status (" IOMSG="); + gfc_show_expr (fp->iomsg); + } if (fp->iostat) { gfc_status (" IOSTAT="); *************** gfc_show_code_node (int level, gfc_code *** 1210,1215 **** --- 1241,1251 ---- gfc_show_expr (i->file); } + if (i->iomsg) + { + gfc_status (" IOMSG="); + gfc_show_expr (i->iomsg); + } if (i->iostat) { gfc_status (" IOSTAT="); *************** gfc_show_code_node (int level, gfc_code *** 1321,1326 **** --- 1357,1367 ---- gfc_status (" PAD="); gfc_show_expr (i->pad); } + if (i->convert) + { + gfc_status (" CONVERT="); + gfc_show_expr (i->convert); + } if (i->err != NULL) gfc_status (" ERR=%d", i->err->value); *************** gfc_show_code_node (int level, gfc_code *** 1329,1334 **** --- 1370,1376 ---- case EXEC_IOLENGTH: gfc_status ("IOLENGTH "); gfc_show_expr (c->expr); + goto show_dt_code; break; case EXEC_READ: *************** gfc_show_code_node (int level, gfc_code *** 1356,1361 **** --- 1398,1409 ---- gfc_status (" FMT=%d", dt->format_label->value); if (dt->namelist) gfc_status (" NML=%s", dt->namelist->name); + + if (dt->iomsg) + { + gfc_status (" IOMSG="); + gfc_show_expr (dt->iomsg); + } if (dt->iostat) { gfc_status (" IOSTAT="); *************** gfc_show_code_node (int level, gfc_code *** 1377,1383 **** gfc_show_expr (dt->advance); } ! break; case EXEC_TRANSFER: gfc_status ("TRANSFER "); --- 1425,1435 ---- gfc_show_expr (dt->advance); } ! show_dt_code: ! gfc_status_char ('\n'); ! for (c = c->block->next; c; c = c->next) ! gfc_show_code_node (level + (c->next != NULL), c); ! return; case EXEC_TRANSFER: gfc_status ("TRANSFER "); *************** gfc_show_code_node (int level, gfc_code *** 1404,1410 **** } ! /* Show and equivalence chain. */ static void gfc_show_equiv (gfc_equiv *eq) --- 1456,1462 ---- } ! /* Show an equivalence chain. */ static void gfc_show_equiv (gfc_equiv *eq) diff -Nrcpad gcc-4.0.2/gcc/fortran/error.c gcc-4.1.0/gcc/fortran/error.c *** gcc-4.0.2/gcc/fortran/error.c Thu Jul 14 10:19:28 2005 --- gcc-4.1.0/gcc/fortran/error.c Mon Nov 7 16:37:10 2005 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Handle the inevitable errors. A major catch here is that things flagged as errors in one match subroutine can conceivably be legal --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Handle the inevitable errors. A major catch here is that things flagged as errors in one match subroutine can conceivably be legal *************** error_string (const char *p) *** 118,124 **** locus. Calls error_printf() recursively, but the recursion is at most one level deep. */ ! static void error_printf (const char *, ...) ATTRIBUTE_PRINTF_1; static void show_locus (int offset, locus * loc) --- 118,124 ---- locus. Calls error_printf() recursively, but the recursion is at most one level deep. */ ! static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); static void show_locus (int offset, locus * loc) *************** separate: *** 314,320 **** #define IBUF_LEN 30 #define MAX_ARGS 10 ! static void error_print (const char *type, const char *format0, va_list argp) { char c, *p, int_buf[IBUF_LEN], c_arg[MAX_ARGS], *cp_arg[MAX_ARGS]; --- 314,320 ---- #define IBUF_LEN 30 #define MAX_ARGS 10 ! static void ATTRIBUTE_GCC_GFC(2,0) error_print (const char *type, const char *format0, va_list argp) { char c, *p, int_buf[IBUF_LEN], c_arg[MAX_ARGS], *cp_arg[MAX_ARGS]; *************** error_print (const char *type, const cha *** 449,460 **** /* Wrapper for error_print(). */ static void ! error_printf (const char *format, ...) { va_list argp; ! va_start (argp, format); ! error_print ("", format, argp); va_end (argp); } --- 449,460 ---- /* Wrapper for error_print(). */ static void ! error_printf (const char *nocmsgid, ...) { va_list argp; ! va_start (argp, nocmsgid); ! error_print ("", _(nocmsgid), argp); va_end (argp); } *************** error_printf (const char *format, ...) *** 462,468 **** /* Issue a warning. */ void ! gfc_warning (const char *format, ...) { va_list argp; --- 462,468 ---- /* Issue a warning. */ void ! gfc_warning (const char *nocmsgid, ...) { va_list argp; *************** gfc_warning (const char *format, ...) *** 473,482 **** warning_buffer.index = 0; cur_error_buffer = &warning_buffer; ! va_start (argp, format); if (buffer_flag == 0) warnings++; ! error_print ("Warning:", format, argp); va_end (argp); error_char ('\0'); --- 473,482 ---- warning_buffer.index = 0; cur_error_buffer = &warning_buffer; ! va_start (argp, nocmsgid); if (buffer_flag == 0) warnings++; ! error_print (_("Warning:"), _(nocmsgid), argp); va_end (argp); error_char ('\0'); *************** gfc_warning (const char *format, ...) *** 486,495 **** /* Possibly issue a warning/error about use of a nonstandard (or deleted) feature. An error/warning will be issued if the currently selected standard does not contain the requested bits. Return FAILURE if ! and error is generated. */ try ! gfc_notify_std (int std, const char *format, ...) { va_list argp; bool warning; --- 486,495 ---- /* Possibly issue a warning/error about use of a nonstandard (or deleted) feature. An error/warning will be issued if the currently selected standard does not contain the requested bits. Return FAILURE if ! an error is generated. */ try ! gfc_notify_std (int std, const char *nocmsgid, ...) { va_list argp; bool warning; *************** gfc_notify_std (int std, const char *for *** 514,524 **** else errors++; } ! va_start (argp, format); if (warning) ! error_print ("Warning:", format, argp); else ! error_print ("Error:", format, argp); va_end (argp); error_char ('\0'); --- 514,524 ---- else errors++; } ! va_start (argp, nocmsgid); if (warning) ! error_print (_("Warning:"), _(nocmsgid), argp); else ! error_print (_("Error:"), _(nocmsgid), argp); va_end (argp); error_char ('\0'); *************** gfc_notify_std (int std, const char *for *** 529,535 **** /* Immediate warning (i.e. do not buffer the warning). */ void ! gfc_warning_now (const char *format, ...) { va_list argp; int i; --- 529,535 ---- /* Immediate warning (i.e. do not buffer the warning). */ void ! gfc_warning_now (const char *nocmsgid, ...) { va_list argp; int i; *************** gfc_warning_now (const char *format, ... *** 541,548 **** buffer_flag = 0; warnings++; ! va_start (argp, format); ! error_print ("Warning:", format, argp); va_end (argp); error_char ('\0'); --- 541,548 ---- buffer_flag = 0; warnings++; ! va_start (argp, nocmsgid); ! error_print (_("Warning:"), _(nocmsgid), argp); va_end (argp); error_char ('\0'); *************** gfc_warning_check (void) *** 578,584 **** /* Issue an error. */ void ! gfc_error (const char *format, ...) { va_list argp; --- 578,584 ---- /* Issue an error. */ void ! gfc_error (const char *nocmsgid, ...) { va_list argp; *************** gfc_error (const char *format, ...) *** 589,598 **** error_buffer.index = 0; cur_error_buffer = &error_buffer; ! va_start (argp, format); if (buffer_flag == 0) errors++; ! error_print ("Error:", format, argp); va_end (argp); error_char ('\0'); --- 589,598 ---- error_buffer.index = 0; cur_error_buffer = &error_buffer; ! va_start (argp, nocmsgid); if (buffer_flag == 0) errors++; ! error_print (_("Error:"), _(nocmsgid), argp); va_end (argp); error_char ('\0'); *************** gfc_error (const char *format, ...) *** 602,608 **** /* Immediate error. */ void ! gfc_error_now (const char *format, ...) { va_list argp; int i; --- 602,608 ---- /* Immediate error. */ void ! gfc_error_now (const char *nocmsgid, ...) { va_list argp; int i; *************** gfc_error_now (const char *format, ...) *** 615,640 **** buffer_flag = 0; errors++; ! va_start (argp, format); ! error_print ("Error:", format, argp); va_end (argp); error_char ('\0'); buffer_flag = i; } /* Fatal error, never returns. */ void ! gfc_fatal_error (const char *format, ...) { va_list argp; buffer_flag = 0; ! va_start (argp, format); ! error_print ("Fatal Error:", format, argp); va_end (argp); exit (3); --- 615,643 ---- buffer_flag = 0; errors++; ! va_start (argp, nocmsgid); ! error_print (_("Error:"), _(nocmsgid), argp); va_end (argp); error_char ('\0'); buffer_flag = i; + + if (flag_fatal_errors) + exit (1); } /* Fatal error, never returns. */ void ! gfc_fatal_error (const char *nocmsgid, ...) { va_list argp; buffer_flag = 0; ! va_start (argp, nocmsgid); ! error_print (_("Fatal Error:"), _(nocmsgid), argp); va_end (argp); exit (3); *************** gfc_error_check (void) *** 687,692 **** --- 690,698 ---- if (error_buffer.message != NULL) fputs (error_buffer.message, stderr); error_buffer.flag = 0; + + if (flag_fatal_errors) + exit (1); } return rc; *************** gfc_free_error (gfc_error_buf * err) *** 735,747 **** /* Debug wrapper for printf. */ void ! gfc_status (const char *format, ...) { va_list argp; ! va_start (argp, format); ! vprintf (format, argp); va_end (argp); } --- 741,753 ---- /* Debug wrapper for printf. */ void ! gfc_status (const char *cmsgid, ...) { va_list argp; ! va_start (argp, cmsgid); ! vprintf (_(cmsgid), argp); va_end (argp); } diff -Nrcpad gcc-4.0.2/gcc/fortran/expr.c gcc-4.1.0/gcc/fortran/expr.c *** gcc-4.0.2/gcc/fortran/expr.c Tue Jul 12 01:50:47 2005 --- gcc-4.1.0/gcc/fortran/expr.c Sun Feb 12 18:31:40 2006 *************** *** 1,6 **** /* Routines for manipulation of expression nodes. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, ! Inc. Contributed by Andy Vaught This file is part of GCC. --- 1,6 ---- /* Routines for manipulation of expression nodes. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software ! Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" #include "system.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" #include "system.h" *************** gfc_extract_int (gfc_expr * expr, int *r *** 255,269 **** { if (expr->expr_type != EXPR_CONSTANT) ! return "Constant expression required at %C"; if (expr->ts.type != BT_INTEGER) ! return "Integer expression required at %C"; if ((mpz_cmp_si (expr->value.integer, INT_MAX) > 0) || (mpz_cmp_si (expr->value.integer, INT_MIN) < 0)) { ! return "Integer value too large in expression at %C"; } *result = (int) mpz_get_si (expr->value.integer); --- 255,269 ---- { if (expr->expr_type != EXPR_CONSTANT) ! return _("Constant expression required at %C"); if (expr->ts.type != BT_INTEGER) ! return _("Integer expression required at %C"); if ((mpz_cmp_si (expr->value.integer, INT_MAX) > 0) || (mpz_cmp_si (expr->value.integer, INT_MIN) < 0)) { ! return _("Integer value too large in expression at %C"); } *result = (int) mpz_get_si (expr->value.integer); *************** copy_ref (gfc_ref * src) *** 311,316 **** --- 311,333 ---- } + /* Detect whether an expression has any vector index array + references. */ + + int + gfc_has_vector_index (gfc_expr *e) + { + gfc_ref * ref; + int i; + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY) + for (i = 0; i < ref->u.ar.dimen; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR) + return 1; + return 0; + } + + /* Copy a shape array. */ mpz_t * *************** simplify_intrinsic_op (gfc_expr * p, int *** 765,770 **** --- 782,788 ---- switch (p->value.op.operator) { case INTRINSIC_UPLUS: + case INTRINSIC_PARENTHESES: result = gfc_uplus (op1); break; *************** simplify_parameter_variable (gfc_expr * *** 1068,1074 **** try t; e = gfc_copy_expr (p->symtree->n.sym->value); ! if (p->ref) e->ref = copy_ref (p->ref); t = gfc_simplify_expr (e, type); --- 1086,1093 ---- try t; e = gfc_copy_expr (p->symtree->n.sym->value); ! /* Do not copy subobject refs for constant. */ ! if (e->expr_type != EXPR_CONSTANT && p->ref != NULL) e->ref = copy_ref (p->ref); t = gfc_simplify_expr (e, type); *************** gfc_simplify_expr (gfc_expr * p, int typ *** 1130,1136 **** if (simplify_ref_chain (p->ref, type) == FAILURE) return FAILURE; ! /* TODO: evaluate constant substrings. */ break; case EXPR_OP: --- 1149,1176 ---- if (simplify_ref_chain (p->ref, type) == FAILURE) return FAILURE; ! if (gfc_is_constant_expr (p)) ! { ! char *s; ! int start, end; ! ! gfc_extract_int (p->ref->u.ss.start, &start); ! start--; /* Convert from one-based to zero-based. */ ! gfc_extract_int (p->ref->u.ss.end, &end); ! s = gfc_getmem (end - start + 1); ! memcpy (s, p->value.character.string + start, end - start); ! s[end] = '\0'; /* TODO: C-style string for debugging. */ ! gfc_free (p->value.character.string); ! p->value.character.string = s; ! p->value.character.length = end - start; ! p->ts.cl = gfc_get_charlen (); ! p->ts.cl->next = gfc_current_ns->cl_list; ! gfc_current_ns->cl_list = p->ts.cl; ! p->ts.cl->length = gfc_int_expr (p->value.character.length); ! gfc_free_ref_list (p->ref); ! p->ref = NULL; ! p->expr_type = EXPR_CONSTANT; ! } break; case EXPR_OP: *************** check_intrinsic_op (gfc_expr * e, try (* *** 1304,1309 **** --- 1344,1352 ---- break; + case INTRINSIC_PARENTHESES: + break; + default: gfc_error ("Only intrinsic operators can be used in expression at %L", &e->where); *************** not_numeric: *** 1326,1345 **** this problem here. */ static try ! check_inquiry (gfc_expr * e) { const char *name; /* FIXME: This should be moved into the intrinsic definitions, to eliminate this ugly hack. */ static const char * const inquiry_function[] = { ! "digits", "epsilon", "huge", "kind", "maxexponent", "minexponent", "precision", "radix", "range", "tiny", "bit_size", "size", "shape", "lbound", "ubound", NULL }; int i; name = e->symtree->n.sym->name; for (i = 0; inquiry_function[i]; i++) --- 1369,1392 ---- this problem here. */ static try ! check_inquiry (gfc_expr * e, int not_restricted) { const char *name; /* FIXME: This should be moved into the intrinsic definitions, to eliminate this ugly hack. */ static const char * const inquiry_function[] = { ! "digits", "epsilon", "huge", "kind", "len", "maxexponent", "minexponent", "precision", "radix", "range", "tiny", "bit_size", "size", "shape", "lbound", "ubound", NULL }; int i; + /* An undeclared parameter will get us here (PR25018). */ + if (e->symtree == NULL) + return FAILURE; + name = e->symtree->n.sym->name; for (i = 0; inquiry_function[i]; i++) *************** check_inquiry (gfc_expr * e) *** 1354,1363 **** if (e == NULL || e->expr_type != EXPR_VARIABLE) return FAILURE; ! /* At this point we have a numeric inquiry function with a variable ! argument. The type of the variable might be undefined, but we ! need it now, because the arguments of these functions are allowed ! to be undefined. */ if (e->ts.type == BT_UNKNOWN) { --- 1401,1409 ---- if (e == NULL || e->expr_type != EXPR_VARIABLE) return FAILURE; ! /* At this point we have an inquiry function with a variable argument. The ! type of the variable might be undefined, but we need it now, because the ! arguments of these functions are allowed to be undefined. */ if (e->ts.type == BT_UNKNOWN) { *************** check_inquiry (gfc_expr * e) *** 1369,1374 **** --- 1415,1429 ---- e->ts = e->symtree->n.sym->ts; } + /* Assumed character length will not reduce to a constant expression + with LEN,as required by the standard. */ + if (i == 4 && not_restricted + && e->symtree->n.sym->ts.type == BT_CHARACTER + && e->symtree->n.sym->ts.cl->length == NULL) + gfc_notify_std (GFC_STD_GNU, "The F95 does not permit the assumed character " + "length variable '%s' in constant expression at %L.", + e->symtree->n.sym->name, &e->where); + return SUCCESS; } *************** check_init_expr (gfc_expr * e) *** 1402,1408 **** case EXPR_FUNCTION: t = SUCCESS; ! if (check_inquiry (e) != SUCCESS) { t = SUCCESS; for (ap = e->value.function.actual; ap; ap = ap->next) --- 1457,1463 ---- case EXPR_FUNCTION: t = SUCCESS; ! if (check_inquiry (e, 1) != SUCCESS) { t = SUCCESS; for (ap = e->value.function.actual; ap; ap = ap->next) *************** check_init_expr (gfc_expr * e) *** 1440,1446 **** break; } ! gfc_error ("Variable '%s' at %L cannot appear in an initialization " "expression", e->symtree->n.sym->name, &e->where); t = FAILURE; break; --- 1495,1502 ---- break; } ! gfc_error ("Parameter '%s' at %L has not been declared or is " ! "a variable, which does not reduce to a constant " "expression", e->symtree->n.sym->name, &e->where); t = FAILURE; break; *************** gfc_match_init_expr (gfc_expr ** result) *** 1519,1526 **** return MATCH_ERROR; } ! if (!gfc_is_constant_expr (expr)) ! gfc_internal_error ("Initialization expression didn't reduce %C"); *result = expr; --- 1575,1588 ---- return MATCH_ERROR; } ! /* Not all inquiry functions are simplified to constant expressions ! so it is necessary to call check_inquiry again. */ ! if (!gfc_is_constant_expr (expr) ! && check_inquiry (expr, 1) == FAILURE) ! { ! gfc_error ("Initialization expression didn't reduce %C"); ! return MATCH_ERROR; ! } *result = expr; *************** static try *** 1599,1605 **** restricted_intrinsic (gfc_expr * e) { /* TODO: Check constraints on inquiry functions. 7.1.6.2 (7). */ ! if (check_inquiry (e) == SUCCESS) return SUCCESS; return restricted_args (e->value.function.actual); --- 1661,1667 ---- restricted_intrinsic (gfc_expr * e) { /* TODO: Check constraints on inquiry functions. 7.1.6.2 (7). */ ! if (check_inquiry (e, 0) == SUCCESS) return SUCCESS; return restricted_args (e->value.function.actual); *************** check_restricted (gfc_expr * e) *** 1652,1663 **** break; } if (sym->attr.in_common || sym->attr.use_assoc || sym->attr.dummy || sym->ns != gfc_current_ns || (sym->ns->proc_name != NULL ! && sym->ns->proc_name->attr.flavor == FL_MODULE)) { t = SUCCESS; break; --- 1714,1729 ---- break; } + /* gfc_is_formal_arg broadcasts that a formal argument list is being processed + in resolve.c(resolve_formal_arglist). This is done so that host associated + dummy array indices are accepted (PR23446). */ if (sym->attr.in_common || sym->attr.use_assoc || sym->attr.dummy || sym->ns != gfc_current_ns || (sym->ns->proc_name != NULL ! && sym->ns->proc_name->attr.flavor == FL_MODULE) ! || gfc_is_formal_arg ()) { t = SUCCESS; break; *************** check_restricted (gfc_expr * e) *** 1706,1711 **** --- 1772,1779 ---- try gfc_specification_expr (gfc_expr * e) { + if (e == NULL) + return SUCCESS; if (e->ts.type != BT_INTEGER) { *************** gfc_specification_expr (gfc_expr * e) *** 1731,1737 **** /* Given two expressions, make sure that the arrays are conformable. */ try ! gfc_check_conformance (const char *optype, gfc_expr * op1, gfc_expr * op2) { int op1_flag, op2_flag, d; mpz_t op1_size, op2_size; --- 1799,1806 ---- /* Given two expressions, make sure that the arrays are conformable. */ try ! gfc_check_conformance (const char *optype_msgid, ! gfc_expr * op1, gfc_expr * op2) { int op1_flag, op2_flag, d; mpz_t op1_size, op2_size; *************** gfc_check_conformance (const char *optyp *** 1742,1748 **** if (op1->rank != op2->rank) { ! gfc_error ("Incompatible ranks in %s at %L", optype, &op1->where); return FAILURE; } --- 1811,1818 ---- if (op1->rank != op2->rank) { ! gfc_error ("Incompatible ranks in %s at %L", _(optype_msgid), ! &op1->where); return FAILURE; } *************** gfc_check_conformance (const char *optyp *** 1755,1762 **** if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0) { ! gfc_error ("%s at %L has different shape on dimension %d (%d/%d)", ! optype, &op1->where, d + 1, (int) mpz_get_si (op1_size), (int) mpz_get_si (op2_size)); t = FAILURE; --- 1825,1833 ---- if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0) { ! gfc_error ("different shape for %s at %L on dimension %d (%d/%d)", ! _(optype_msgid), &op1->where, d + 1, ! (int) mpz_get_si (op1_size), (int) mpz_get_si (op2_size)); t = FAILURE; *************** gfc_check_assign (gfc_expr * lvalue, gfc *** 1792,1797 **** --- 1863,1876 ---- return FAILURE; } + if (sym->attr.flavor == FL_PROCEDURE && sym->attr.use_assoc) + { + gfc_error ("'%s' in the assignment at %L cannot be an l-value " + "since it is a procedure", sym->name, &lvalue->where); + return FAILURE; + } + + if (rvalue->rank != 0 && lvalue->rank != rvalue->rank) { gfc_error ("Incompatible ranks %d and %d in assignment at %L", *************** gfc_check_assign (gfc_expr * lvalue, gfc *** 1813,1818 **** --- 1892,1907 ---- return FAILURE; } + if (sym->attr.cray_pointee + && lvalue->ref != NULL + && lvalue->ref->u.ar.type != AR_ELEMENT + && lvalue->ref->u.ar.as->cp_was_assumed) + { + gfc_error ("Vector assignment to assumed-size Cray Pointee at %L" + " is illegal.", &lvalue->where); + return FAILURE; + } + /* This is possibly a typo: x = f() instead of x => f() */ if (gfc_option.warn_surprising && rvalue->expr_type == EXPR_FUNCTION *************** gfc_check_pointer_assign (gfc_expr * lva *** 1867,1872 **** --- 1956,1970 ---- return FAILURE; } + if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE + && lvalue->symtree->n.sym->attr.use_assoc) + { + gfc_error ("'%s' in the pointer assignment at %L cannot be an " + "l-value since it is a procedure", + lvalue->symtree->n.sym->name, &lvalue->where); + return FAILURE; + } + attr = gfc_variable_attr (lvalue, NULL); if (!attr.pointer) { *************** gfc_check_pointer_assign (gfc_expr * lva *** 1886,1892 **** /* If rvalue is a NULL() or NULLIFY, we're done. Otherwise the type, kind, etc for lvalue and rvalue must match, and rvalue must be a pure variable if we're in a pure function. */ ! if (rvalue->expr_type == EXPR_NULL) return SUCCESS; if (!gfc_compare_types (&lvalue->ts, &rvalue->ts)) --- 1984,1990 ---- /* If rvalue is a NULL() or NULLIFY, we're done. Otherwise the type, kind, etc for lvalue and rvalue must match, and rvalue must be a pure variable if we're in a pure function. */ ! if (rvalue->expr_type == EXPR_NULL && rvalue->ts.type == BT_UNKNOWN) return SUCCESS; if (!gfc_compare_types (&lvalue->ts, &rvalue->ts)) *************** gfc_check_pointer_assign (gfc_expr * lva *** 1898,1904 **** if (lvalue->ts.kind != rvalue->ts.kind) { ! gfc_error ("Different kind type parameters in pointer " "assignment at %L", &lvalue->where); return FAILURE; } --- 1996,2023 ---- if (lvalue->ts.kind != rvalue->ts.kind) { ! gfc_error ("Different kind type parameters in pointer " ! "assignment at %L", &lvalue->where); ! return FAILURE; ! } ! ! if (lvalue->rank != rvalue->rank) ! { ! gfc_error ("Different ranks in pointer assignment at %L", ! &lvalue->where); ! return FAILURE; ! } ! ! /* Now punt if we are dealing with a NULLIFY(X) or X = NULL(X). */ ! if (rvalue->expr_type == EXPR_NULL) ! return SUCCESS; ! ! if (lvalue->ts.type == BT_CHARACTER ! && lvalue->ts.cl->length && rvalue->ts.cl->length ! && abs (gfc_dep_compare_expr (lvalue->ts.cl->length, ! rvalue->ts.cl->length)) == 1) ! { ! gfc_error ("Different character lengths in pointer " "assignment at %L", &lvalue->where); return FAILURE; } *************** gfc_check_pointer_assign (gfc_expr * lva *** 1906,1929 **** attr = gfc_expr_attr (rvalue); if (!attr.target && !attr.pointer) { ! gfc_error ("Pointer assignment target is neither TARGET " "nor POINTER at %L", &rvalue->where); return FAILURE; } if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym)) { ! gfc_error ("Bad target in pointer assignment in PURE " "procedure at %L", &rvalue->where); } ! if (lvalue->rank != rvalue->rank) { ! gfc_error ("Unequal ranks %d and %d in pointer assignment at %L", ! lvalue->rank, rvalue->rank, &rvalue->where); return FAILURE; } return SUCCESS; } --- 2025,2068 ---- attr = gfc_expr_attr (rvalue); if (!attr.target && !attr.pointer) { ! gfc_error ("Pointer assignment target is neither TARGET " "nor POINTER at %L", &rvalue->where); return FAILURE; } if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym)) { ! gfc_error ("Bad target in pointer assignment in PURE " "procedure at %L", &rvalue->where); } ! if (gfc_has_vector_index (rvalue)) { ! gfc_error ("Pointer assignment with vector subscript " ! "on rhs at %L", &rvalue->where); return FAILURE; } + if (rvalue->symtree->n.sym + && rvalue->symtree->n.sym->as + && rvalue->symtree->n.sym->as->type == AS_ASSUMED_SIZE) + { + gfc_ref * ref; + int dim = 0; + int last = 0; + for (ref = rvalue->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY) + for (dim = 0;dim < ref->u.ar.as->rank; dim++) + last = ref->u.ar.end[dim] == NULL; + if (last) + { + gfc_error ("The upper bound in the last dimension of the " + "assumed_size array on the rhs of the pointer " + "assignment at %L must be set", &rvalue->where); + return FAILURE; + } + } + return SUCCESS; } *************** gfc_get_variable_expr (gfc_symtree * var *** 2026,2028 **** --- 2165,2237 ---- return e; } + + /* Traverse expr, marking all EXPR_VARIABLE symbols referenced. */ + + void + gfc_expr_set_symbols_referenced (gfc_expr * expr) + { + gfc_actual_arglist *arg; + gfc_constructor *c; + gfc_ref *ref; + int i; + + if (!expr) return; + + switch (expr->expr_type) + { + case EXPR_OP: + gfc_expr_set_symbols_referenced (expr->value.op.op1); + gfc_expr_set_symbols_referenced (expr->value.op.op2); + break; + + case EXPR_FUNCTION: + for (arg = expr->value.function.actual; arg; arg = arg->next) + gfc_expr_set_symbols_referenced (arg->expr); + break; + + case EXPR_VARIABLE: + gfc_set_sym_referenced (expr->symtree->n.sym); + break; + + case EXPR_CONSTANT: + case EXPR_NULL: + case EXPR_SUBSTRING: + break; + + case EXPR_STRUCTURE: + case EXPR_ARRAY: + for (c = expr->value.constructor; c; c = c->next) + gfc_expr_set_symbols_referenced (c->expr); + break; + + default: + gcc_unreachable (); + break; + } + + for (ref = expr->ref; ref; ref = ref->next) + switch (ref->type) + { + case REF_ARRAY: + for (i = 0; i < ref->u.ar.dimen; i++) + { + gfc_expr_set_symbols_referenced (ref->u.ar.start[i]); + gfc_expr_set_symbols_referenced (ref->u.ar.end[i]); + gfc_expr_set_symbols_referenced (ref->u.ar.stride[i]); + } + break; + + case REF_COMPONENT: + break; + + case REF_SUBSTRING: + gfc_expr_set_symbols_referenced (ref->u.ss.start); + gfc_expr_set_symbols_referenced (ref->u.ss.end); + break; + + default: + gcc_unreachable (); + break; + } + } diff -Nrcpad gcc-4.0.2/gcc/fortran/f95-lang.c gcc-4.1.0/gcc/fortran/f95-lang.c *** gcc-4.0.2/gcc/fortran/f95-lang.c Wed May 18 19:36:43 2005 --- gcc-4.1.0/gcc/fortran/f95-lang.c Wed Oct 12 06:18:12 2005 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* f95-lang.c-- GCC backend interface stuff */ --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* f95-lang.c-- GCC backend interface stuff */ *************** struct language_function *** 77,88 **** GTY(()) { /* struct gfc_language_function base; */ - tree named_labels; - tree shadowed_labels; - int returns_value; - int returns_abnormally; - int warn_about_return_type; - int extern_inline; struct binding_level *binding_level; }; --- 77,82 ---- *************** static void gfc_expand_function (tree); *** 114,120 **** #undef LANG_HOOKS_POST_OPTIONS #undef LANG_HOOKS_PRINT_IDENTIFIER #undef LANG_HOOKS_PARSE_FILE - #undef LANG_HOOKS_TRUTHVALUE_CONVERSION #undef LANG_HOOKS_MARK_ADDRESSABLE #undef LANG_HOOKS_TYPE_FOR_MODE #undef LANG_HOOKS_TYPE_FOR_SIZE --- 108,113 ---- *************** static void gfc_expand_function (tree); *** 133,139 **** #define LANG_HOOKS_POST_OPTIONS gfc_post_options #define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file - #define LANG_HOOKS_TRUTHVALUE_CONVERSION gfc_truthvalue_conversion #define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size --- 126,131 ---- *************** const char *const tree_code_name[] = { *** 178,184 **** }; #undef DEFTREECODE - static tree named_labels; #define NULL_BINDING_LEVEL (struct binding_level *) NULL --- 170,175 ---- *************** tree *ridpointers = NULL; *** 196,201 **** --- 187,222 ---- static void gfc_expand_function (tree fndecl) { + tree t; + + if (DECL_INITIAL (fndecl) + && BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl))) + { + /* Local static equivalenced variables are never seen by + check_global_declarations, so we need to output debug + info by hand. */ + + t = BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl)); + for (t = BLOCK_VARS (t); t; t = TREE_CHAIN (t)) + if (TREE_CODE (t) == VAR_DECL && DECL_HAS_VALUE_EXPR_P (t) + && TREE_STATIC (t)) + { + tree expr = DECL_VALUE_EXPR (t); + + if (TREE_CODE (expr) == COMPONENT_REF + && TREE_CODE (TREE_OPERAND (expr, 0)) == VAR_DECL + && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) + == UNION_TYPE + && cgraph_varpool_node (TREE_OPERAND (expr, 0))->needed + && errorcount == 0 && sorrycount == 0) + { + timevar_push (TV_SYMOUT); + (*debug_hooks->global_decl) (t); + timevar_pop (TV_SYMOUT); + } + } + } + tree_rest_of_compilation (fndecl); } *************** static bool *** 280,286 **** gfc_init (void) { #ifdef USE_MAPPED_LOCATION ! linemap_add (&line_table, LC_ENTER, false, gfc_option.source, 1); linemap_add (&line_table, LC_RENAME, false, "", 0); #endif --- 301,307 ---- gfc_init (void) { #ifdef USE_MAPPED_LOCATION ! linemap_add (&line_table, LC_ENTER, false, gfc_source_file, 1); linemap_add (&line_table, LC_RENAME, false, "", 0); #endif *************** gfc_init (void) *** 291,298 **** /* Then the frontend. */ gfc_init_1 (); ! if (gfc_new_file (gfc_option.source, gfc_option.source_form) != SUCCESS) ! fatal_error ("can't open input file: %s", gfc_option.source); return true; } --- 312,319 ---- /* Then the frontend. */ gfc_init_1 (); ! if (gfc_new_file () != SUCCESS) ! fatal_error ("can't open input file: %s", gfc_source_file); return true; } *************** poplevel (int keep, int reverse, int fun *** 422,428 **** binding level is a function body, or if there are any nested blocks then create a BLOCK node to record them for the life of this function. */ if (keep || functionbody) ! block_node = build_block (keep ? decl_chain : 0, 0, subblock_chain, 0, 0); /* Record the BLOCK node just built as the subblock its enclosing scope. */ for (subblock_node = subblock_chain; subblock_node; --- 443,449 ---- binding level is a function body, or if there are any nested blocks then create a BLOCK node to record them for the life of this function. */ if (keep || functionbody) ! block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0); /* Record the BLOCK node just built as the subblock its enclosing scope. */ for (subblock_node = subblock_chain; subblock_node; *************** pushdecl (tree decl) *** 506,512 **** TREE_CHAIN (decl) = current_binding_level->names; current_binding_level->names = decl; ! /* For the declartion of a type, set its name if it is not already set. */ if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0) { --- 527,533 ---- TREE_CHAIN (decl) = current_binding_level->names; current_binding_level->names = decl; ! /* For the declaration of a type, set its name if it is not already set. */ if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0) { *************** static void *** 563,569 **** gfc_init_decl_processing (void) { current_function_decl = NULL; - named_labels = NULL; current_binding_level = NULL_BINDING_LEVEL; free_binding_level = NULL_BINDING_LEVEL; --- 584,589 ---- *************** gfc_init_decl_processing (void) *** 578,583 **** --- 598,604 ---- build_common_tree_nodes (false, false); set_sizetype (long_unsigned_type_node); build_common_tree_nodes_2 (0); + void_list_node = build_tree_list (NULL_TREE, void_type_node); /* Set up F95 type nodes. */ gfc_init_kinds (); *************** builtin_function (const char *name, *** 682,688 **** int function_code, enum built_in_class class, const char *library_name, ! tree attrs ATTRIBUTE_UNUSED) { tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); DECL_EXTERNAL (decl) = 1; --- 703,709 ---- int function_code, enum built_in_class class, const char *library_name, ! tree attrs) { tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); DECL_EXTERNAL (decl) = 1; *************** builtin_function (const char *name, *** 693,698 **** --- 714,730 ---- pushdecl (decl); DECL_BUILT_IN_CLASS (decl) = class; DECL_FUNCTION_CODE (decl) = function_code; + + /* Possibly apply some default attributes to this built-in function. */ + if (attrs) + { + /* FORNOW the only supported attribute is "const". If others need + to be supported then see the more general solution in procedure + builtin_function in c-decl.c */ + if (lookup_attribute ( "const", attrs )) + TREE_READONLY (decl) = 1; + } + return decl; } *************** gfc_define_builtin (const char * name, *** 717,722 **** --- 749,756 ---- #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \ + gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \ + BUILT_IN_ ## code ## L, name "l", true); \ gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \ BUILT_IN_ ## code, name, true); \ gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \ *************** gfc_define_builtin (const char * name, *** 725,735 **** #define DEFINE_MATH_BUILTIN(code, name, argtype) \ DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) - /* The middle-end is missing builtins for some complex math functions, so - we don't use them yet. */ #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \ ! DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) ! /* DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)*/ /* Create function types for builtin functions. */ --- 759,767 ---- #define DEFINE_MATH_BUILTIN(code, name, argtype) \ DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \ ! DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \ ! DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c) /* Create function types for builtin functions. */ *************** gfc_init_builtin_functions (void) *** 759,775 **** --- 791,812 ---- { tree mfunc_float[3]; tree mfunc_double[3]; + tree mfunc_longdouble[3]; tree mfunc_cfloat[3]; tree mfunc_cdouble[3]; + tree mfunc_clongdouble[3]; tree func_cfloat_float; tree func_cdouble_double; + tree func_clongdouble_longdouble; tree ftype; tree tmp; build_builtin_fntypes (mfunc_float, float_type_node); build_builtin_fntypes (mfunc_double, double_type_node); + build_builtin_fntypes (mfunc_longdouble, long_double_type_node); build_builtin_fntypes (mfunc_cfloat, complex_float_type_node); build_builtin_fntypes (mfunc_cdouble, complex_double_type_node); + build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node); tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node); func_cfloat_float = build_function_type (float_type_node, tmp); *************** gfc_init_builtin_functions (void) *** 777,806 **** --- 814,858 ---- tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node); func_cdouble_double = build_function_type (double_type_node, tmp); + tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node); + func_clongdouble_longdouble = + build_function_type (long_double_type_node, tmp); + #include "mathbuiltins.def" /* We define these separately as the fortran versions have different semantics (they return an integer type) */ + gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0], + BUILT_IN_ROUNDL, "roundl", true); gfc_define_builtin ("__builtin_round", mfunc_double[0], BUILT_IN_ROUND, "round", true); gfc_define_builtin ("__builtin_roundf", mfunc_float[0], BUILT_IN_ROUNDF, "roundf", true); + + gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0], + BUILT_IN_TRUNCL, "truncl", true); gfc_define_builtin ("__builtin_trunc", mfunc_double[0], BUILT_IN_TRUNC, "trunc", true); gfc_define_builtin ("__builtin_truncf", mfunc_float[0], BUILT_IN_TRUNCF, "truncf", true); + gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble, + BUILT_IN_CABSL, "cabsl", true); gfc_define_builtin ("__builtin_cabs", func_cdouble_double, BUILT_IN_CABS, "cabs", true); gfc_define_builtin ("__builtin_cabsf", func_cfloat_float, BUILT_IN_CABSF, "cabsf", true); + gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1], + BUILT_IN_COPYSIGNL, "copysignl", true); gfc_define_builtin ("__builtin_copysign", mfunc_double[1], BUILT_IN_COPYSIGN, "copysign", true); gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], BUILT_IN_COPYSIGNF, "copysignf", true); /* These are used to implement the ** operator. */ + gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1], + BUILT_IN_POWL, "powl", true); gfc_define_builtin ("__builtin_pow", mfunc_double[1], BUILT_IN_POW, "pow", true); gfc_define_builtin ("__builtin_powf", mfunc_float[1], diff -Nrcpad gcc-4.0.2/gcc/fortran/gfortran.h gcc-4.1.0/gcc/fortran/gfortran.h *** gcc-4.0.2/gcc/fortran/gfortran.h Fri Sep 9 09:05:52 2005 --- gcc-4.1.0/gcc/fortran/gfortran.h Sun Feb 12 18:31:40 2006 *************** *** 1,6 **** /* gfortran header file ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, ! Inc. Contributed by Andy Vaught This file is part of GCC. --- 1,6 ---- /* gfortran header file ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software ! Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef GCC_GFORTRAN_H #define GCC_GFORTRAN_H --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #ifndef GCC_GFORTRAN_H #define GCC_GFORTRAN_H *************** Software Foundation, 59 Temple Place - S *** 30,35 **** --- 30,36 ---- time I looked, so by comparison this is perfectly reasonable. */ #include "system.h" + #include "intl.h" #include "coretypes.h" #include "input.h" *************** mstring; *** 102,107 **** --- 103,123 ---- #define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */ #define GFC_STD_F77 (1<<0) /* Up to and including F77. */ + /* Bitmasks for the various FPE that can be enabled. */ + #define GFC_FPE_INVALID (1<<0) + #define GFC_FPE_DENORMAL (1<<1) + #define GFC_FPE_ZERO (1<<2) + #define GFC_FPE_OVERFLOW (1<<3) + #define GFC_FPE_UNDERFLOW (1<<4) + #define GFC_FPE_PRECISION (1<<5) + + /* Keep this in sync with libgfortran/io/io.h ! */ + + typedef enum + { CONVERT_NATIVE=0, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE } + options_convert; + + /*************************** Enums *****************************/ /* The author remains confused to this day about the convention of *************** typedef enum *** 166,172 **** INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV, INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE, INTRINSIC_LT, INTRINSIC_LE, INTRINSIC_NOT, INTRINSIC_USER, ! INTRINSIC_ASSIGN, GFC_INTRINSIC_END /* Sentinel */ } gfc_intrinsic_op; --- 182,188 ---- INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV, INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE, INTRINSIC_LT, INTRINSIC_LE, INTRINSIC_NOT, INTRINSIC_USER, ! INTRINSIC_ASSIGN, INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */ } gfc_intrinsic_op; *************** typedef enum *** 194,210 **** ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE, ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF, ST_ELSEWHERE, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO, ! ST_END_FILE, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF, ST_END_INTERFACE, ! ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT, ST_END_SUBROUTINE, ! ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE, ST_EXIT, ST_FORALL, ! ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ! ST_IMPLICIT_NONE, ST_INQUIRE, ST_INTERFACE, ST_PARAMETER, ST_MODULE, ! ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN, ST_PAUSE, ST_PRIVATE, ! ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND, ST_STOP, ! ST_SUBROUTINE, ! ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE, ST_ASSIGNMENT, ! ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE, ST_SIMPLE_IF, ! ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT, ST_NONE } gfc_statement; --- 210,226 ---- ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE, ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF, ST_ELSEWHERE, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO, ! ST_END_FILE, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF, ! ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT, ! ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE, ! ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO, ! ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_INQUIRE, ST_INTERFACE, ! ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN, ! ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND, ! ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE, ! ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE, ! ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT, ! ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_NONE } gfc_statement; *************** interface_type; *** 220,226 **** /* Symbol flavors: these are all mutually exclusive. 10 elements = 4 bits. */ ! typedef enum { FL_UNKNOWN = 0, FL_PROGRAM, FL_BLOCK_DATA, FL_MODULE, FL_VARIABLE, FL_PARAMETER, FL_LABEL, FL_PROCEDURE, FL_DERIVED, FL_NAMELIST --- 236,242 ---- /* Symbol flavors: these are all mutually exclusive. 10 elements = 4 bits. */ ! typedef enum sym_flavor { FL_UNKNOWN = 0, FL_PROGRAM, FL_BLOCK_DATA, FL_MODULE, FL_VARIABLE, FL_PARAMETER, FL_LABEL, FL_PROCEDURE, FL_DERIVED, FL_NAMELIST *************** typedef enum *** 228,254 **** sym_flavor; /* Procedure types. 7 elements = 3 bits. */ ! typedef enum { PROC_UNKNOWN, PROC_MODULE, PROC_INTERNAL, PROC_DUMMY, PROC_INTRINSIC, PROC_ST_FUNCTION, PROC_EXTERNAL } procedure_type; /* Intent types. */ ! typedef enum { INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT } sym_intent; /* Access types. */ ! typedef enum ! { ACCESS_UNKNOWN = 0, ACCESS_PUBLIC, ACCESS_PRIVATE, } gfc_access; /* Flags to keep track of where an interface came from. 4 elements = 2 bits. */ ! typedef enum { IFSRC_UNKNOWN = 0, IFSRC_DECL, IFSRC_IFBODY, IFSRC_USAGE } ifsrc; --- 244,270 ---- sym_flavor; /* Procedure types. 7 elements = 3 bits. */ ! typedef enum procedure_type { PROC_UNKNOWN, PROC_MODULE, PROC_INTERNAL, PROC_DUMMY, PROC_INTRINSIC, PROC_ST_FUNCTION, PROC_EXTERNAL } procedure_type; /* Intent types. */ ! typedef enum sym_intent { INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT } sym_intent; /* Access types. */ ! typedef enum gfc_access ! { ACCESS_UNKNOWN = 0, ACCESS_PUBLIC, ACCESS_PRIVATE } gfc_access; /* Flags to keep track of where an interface came from. 4 elements = 2 bits. */ ! typedef enum ifsrc { IFSRC_UNKNOWN = 0, IFSRC_DECL, IFSRC_IFBODY, IFSRC_USAGE } ifsrc; *************** enum gfc_generic_isym_id *** 273,278 **** --- 289,295 ---- GFC_ISYM_ABS, GFC_ISYM_ACHAR, GFC_ISYM_ACOS, + GFC_ISYM_ACOSH, GFC_ISYM_ADJUSTL, GFC_ISYM_ADJUSTR, GFC_ISYM_AIMAG, *************** enum gfc_generic_isym_id *** 280,289 **** --- 297,309 ---- GFC_ISYM_ALL, GFC_ISYM_ALLOCATED, GFC_ISYM_ANINT, + GFC_ISYM_AND, GFC_ISYM_ANY, GFC_ISYM_ASIN, + GFC_ISYM_ASINH, GFC_ISYM_ASSOCIATED, GFC_ISYM_ATAN, + GFC_ISYM_ATANH, GFC_ISYM_ATAN2, GFC_ISYM_J0, GFC_ISYM_J1, *************** enum gfc_generic_isym_id *** 297,307 **** --- 317,329 ---- GFC_ISYM_CHDIR, GFC_ISYM_CMPLX, GFC_ISYM_COMMAND_ARGUMENT_COUNT, + GFC_ISYM_COMPLEX, GFC_ISYM_CONJG, GFC_ISYM_COS, GFC_ISYM_COSH, GFC_ISYM_COUNT, GFC_ISYM_CSHIFT, + GFC_ISYM_CTIME, GFC_ISYM_DBLE, GFC_ISYM_DIM, GFC_ISYM_DOT_PRODUCT, *************** enum gfc_generic_isym_id *** 312,321 **** --- 334,349 ---- GFC_ISYM_ETIME, GFC_ISYM_EXP, GFC_ISYM_EXPONENT, + GFC_ISYM_FDATE, + GFC_ISYM_FGET, + GFC_ISYM_FGETC, GFC_ISYM_FLOOR, GFC_ISYM_FNUM, + GFC_ISYM_FPUT, + GFC_ISYM_FPUTC, GFC_ISYM_FRACTION, GFC_ISYM_FSTAT, + GFC_ISYM_FTELL, GFC_ISYM_GETCWD, GFC_ISYM_GETGID, GFC_ISYM_GETPID, *************** enum gfc_generic_isym_id *** 347,354 **** --- 375,384 ---- GFC_ISYM_LLE, GFC_ISYM_LLT, GFC_ISYM_LOG, + GFC_ISYM_LOC, GFC_ISYM_LOG10, GFC_ISYM_LOGICAL, + GFC_ISYM_MALLOC, GFC_ISYM_MATMUL, GFC_ISYM_MAX, GFC_ISYM_MAXLOC, *************** enum gfc_generic_isym_id *** 362,367 **** --- 392,398 ---- GFC_ISYM_NEAREST, GFC_ISYM_NINT, GFC_ISYM_NOT, + GFC_ISYM_OR, GFC_ISYM_PACK, GFC_ISYM_PRESENT, GFC_ISYM_PRODUCT, *************** enum gfc_generic_isym_id *** 374,383 **** --- 405,416 ---- GFC_ISYM_SCALE, GFC_ISYM_SCAN, GFC_ISYM_SECOND, + GFC_ISYM_SECNDS, GFC_ISYM_SET_EXPONENT, GFC_ISYM_SHAPE, GFC_ISYM_SI_KIND, GFC_ISYM_SIGN, + GFC_ISYM_SIGNAL, GFC_ISYM_SIN, GFC_ISYM_SINH, GFC_ISYM_SIZE, *************** enum gfc_generic_isym_id *** 396,406 **** --- 429,441 ---- GFC_ISYM_TRANSFER, GFC_ISYM_TRANSPOSE, GFC_ISYM_TRIM, + GFC_ISYM_TTYNAM, GFC_ISYM_UBOUND, GFC_ISYM_UMASK, GFC_ISYM_UNLINK, GFC_ISYM_UNPACK, GFC_ISYM_VERIFY, + GFC_ISYM_XOR, GFC_ISYM_CONVERSION }; typedef enum gfc_generic_isym_id gfc_generic_isym_id; *************** typedef struct *** 427,432 **** --- 462,471 ---- unsigned sequence:1, elemental:1, pure:1, recursive:1; unsigned unmaskable:1, masked:1, contained:1; + /* This is set if the subroutine doesn't return. Currently, this + is only possible for intrinsic subroutines. */ + unsigned noreturn:1; + /* Set if this procedure is an alternate entry point. These procedures don't have any code associated, and the backend will turn them into thunks to the master function. */ *************** typedef struct *** 453,472 **** unsigned is_main_program:1; /* Mutually exclusive multibit attributes. */ ! gfc_access access:2; ! sym_intent intent:2; ! sym_flavor flavor:4; ! ifsrc if_source:2; ! procedure_type proc:3; } symbol_attribute; /* The following three structures are used to identify a location in ! the sources. ! gfc_file is used to maintain a tree of the source files and how they include each other --- 492,514 ---- unsigned is_main_program:1; /* Mutually exclusive multibit attributes. */ ! ENUM_BITFIELD (gfc_access) access:2; ! ENUM_BITFIELD (sym_intent) intent:2; ! ENUM_BITFIELD (sym_flavor) flavor:4; ! ENUM_BITFIELD (ifsrc) if_source:2; ! ENUM_BITFIELD (procedure_type) proc:3; ! ! /* Special attributes for Cray pointers, pointees. */ ! unsigned cray_pointer:1, cray_pointee:1; } symbol_attribute; /* The following three structures are used to identify a location in ! the sources. ! gfc_file is used to maintain a tree of the source files and how they include each other *************** symbol_attribute; *** 474,490 **** which file it resides in locus point to the sourceline and the character in the source ! line. */ ! typedef struct gfc_file { struct gfc_file *included_by, *next, *up; int inclusion_line, line; char *filename; } gfc_file; ! typedef struct gfc_linebuf { #ifdef USE_MAPPED_LOCATION source_location location; --- 516,532 ---- which file it resides in locus point to the sourceline and the character in the source ! line. */ ! typedef struct gfc_file { struct gfc_file *included_by, *next, *up; int inclusion_line, line; char *filename; } gfc_file; ! typedef struct gfc_linebuf { #ifdef USE_MAPPED_LOCATION source_location location; *************** typedef struct gfc_linebuf *** 501,512 **** #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line)) ! typedef struct { char *nextc; gfc_linebuf *lb; } locus; extern int gfc_suppress_error; --- 543,562 ---- #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line)) ! typedef struct { char *nextc; gfc_linebuf *lb; } locus; + /* In order for the "gfc" format checking to work correctly, you must + have declared a typedef locus first. */ + #if GCC_VERSION >= 4001 + #define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m) + #else + #define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m) + #endif + extern int gfc_suppress_error; *************** typedef struct gfc_charlen *** 527,532 **** --- 577,584 ---- struct gfc_expr *length; struct gfc_charlen *next; tree backend_decl; + + int resolved; } gfc_charlen; *************** typedef struct *** 548,553 **** --- 600,612 ---- int rank; /* A rank of zero means that a variable is a scalar. */ array_type type; struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS]; + + /* These two fields are used with the Cray Pointer extension. */ + bool cray_pointee; /* True iff this spec belongs to a cray pointee. */ + bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to + AS_EXPLICIT, but we want to remember that we + did this. */ + } gfc_array_spec; *************** typedef struct gfc_symbol *** 692,697 **** --- 751,759 ---- struct gfc_symbol *result; /* function result symbol */ gfc_component *components; /* Derived type components */ + /* Defined only for Cray pointees; points to their pointer. */ + struct gfc_symbol *cp_pointer; + struct gfc_symbol *common_next; /* Links for COMMON syms */ /* This is in fact a gfc_common_head but it is only used for pointer *************** typedef struct gfc_common_head *** 732,738 **** int use_assoc, saved; char name[GFC_MAX_SYMBOL_LEN + 1]; struct gfc_symbol *head; ! } gfc_common_head; #define gfc_get_common_head() gfc_getmem(sizeof(gfc_common_head)) --- 794,800 ---- int use_assoc, saved; char name[GFC_MAX_SYMBOL_LEN + 1]; struct gfc_symbol *head; ! } gfc_common_head; #define gfc_get_common_head() gfc_getmem(sizeof(gfc_common_head)) *************** typedef struct gfc_symtree *** 779,784 **** --- 841,856 ---- } gfc_symtree; + /* A linked list of derived types in the namespace. */ + typedef struct gfc_dt_list + { + struct gfc_symbol *derived; + struct gfc_dt_list *next; + } + gfc_dt_list; + + #define gfc_get_dt_list() gfc_getmem(sizeof(gfc_dt_list)) + /* A namespace describes the contents of procedure, module or interface block. */ *************** typedef struct gfc_namespace *** 791,797 **** /* Tree containing all the user-defined operators in the namespace. */ gfc_symtree *uop_root; /* Tree containing all the common blocks. */ ! gfc_symtree *common_root; /* If set_flag[letter] is set, an implicit type has been set for letter. */ int set_flag[GFC_LETTERS]; --- 863,869 ---- /* Tree containing all the user-defined operators in the namespace. */ gfc_symtree *uop_root; /* Tree containing all the common blocks. */ ! gfc_symtree *common_root; /* If set_flag[letter] is set, an implicit type has been set for letter. */ int set_flag[GFC_LETTERS]; *************** typedef struct gfc_namespace *** 828,834 **** gfc_charlen *cl_list; ! int save_all, seen_save; /* Normally we don't need to refcount namespaces. However when we read a module containing a function with multiple entry points, this --- 900,906 ---- gfc_charlen *cl_list; ! int save_all, seen_save, seen_implicit_none; /* Normally we don't need to refcount namespaces. However when we read a module containing a function with multiple entry points, this *************** typedef struct gfc_namespace *** 838,843 **** --- 910,918 ---- /* A list of all alternate entry points to this procedure (or NULL). */ gfc_entry_list *entries; + /* A list of all derived types in this procedure (or NULL). */ + gfc_dt_list *derived_types; + /* Set to 1 if namespace is a BLOCK DATA program unit. */ int is_block_data; } *************** typedef struct gfc_gsymbol *** 853,859 **** { BBT_HEADER(gfc_gsymbol); ! char name[GFC_MAX_SYMBOL_LEN+1]; enum { GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE, GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA } type; --- 928,934 ---- { BBT_HEADER(gfc_gsymbol); ! const char *name; enum { GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE, GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA } type; *************** typedef struct gfc_intrinsic_sym *** 1028,1034 **** const char *name, *lib_name; gfc_intrinsic_arg *formal; gfc_typespec ts; ! int elemental, pure, generic, specific, actual_ok, standard; gfc_simplify_f simplify; gfc_check_f check; --- 1103,1109 ---- const char *name, *lib_name; gfc_intrinsic_arg *formal; gfc_typespec ts; ! int elemental, pure, generic, specific, actual_ok, standard, noreturn; gfc_simplify_f simplify; gfc_check_f check; *************** extern gfc_logical_info gfc_logical_kind *** 1162,1168 **** typedef struct { ! mpfr_t epsilon, huge, tiny; int kind, radix, digits, min_exponent, max_exponent; int range, precision; --- 1237,1243 ---- typedef struct { ! mpfr_t epsilon, huge, tiny, subnormal; int kind, radix, digits, min_exponent, max_exponent; int range, precision; *************** gfc_alloc; *** 1255,1261 **** typedef struct { gfc_expr *unit, *file, *status, *access, *form, *recl, ! *blank, *position, *action, *delim, *pad, *iostat; gfc_st_label *err; } gfc_open; --- 1330,1336 ---- typedef struct { gfc_expr *unit, *file, *status, *access, *form, *recl, ! *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert; gfc_st_label *err; } gfc_open; *************** gfc_open; *** 1263,1269 **** typedef struct { ! gfc_expr *unit, *status, *iostat; gfc_st_label *err; } gfc_close; --- 1338,1344 ---- typedef struct { ! gfc_expr *unit, *status, *iostat, *iomsg; gfc_st_label *err; } gfc_close; *************** gfc_close; *** 1271,1277 **** typedef struct { ! gfc_expr *unit, *iostat; gfc_st_label *err; } gfc_filepos; --- 1346,1352 ---- typedef struct { ! gfc_expr *unit, *iostat, *iomsg; gfc_st_label *err; } gfc_filepos; *************** typedef struct *** 1282,1288 **** gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named, *name, *access, *sequential, *direct, *form, *formatted, *unformatted, *recl, *nextrec, *blank, *position, *action, *read, ! *write, *readwrite, *delim, *pad, *iolength; gfc_st_label *err; --- 1357,1363 ---- gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named, *name, *access, *sequential, *direct, *form, *formatted, *unformatted, *recl, *nextrec, *blank, *position, *action, *read, ! *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert; gfc_st_label *err; *************** gfc_inquire; *** 1292,1305 **** typedef struct { ! gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size; gfc_symbol *namelist; /* A format_label of `format_asterisk' indicates the "*" format */ gfc_st_label *format_label; gfc_st_label *err, *end, *eor; ! locus eor_where, end_where; } gfc_dt; --- 1367,1380 ---- typedef struct { ! gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg; gfc_symbol *namelist; /* A format_label of `format_asterisk' indicates the "*" format */ gfc_st_label *format_label; gfc_st_label *err, *end, *eor; ! locus eor_where, end_where, err_where; } gfc_dt; *************** typedef enum *** 1323,1329 **** EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_OPEN, EXEC_CLOSE, EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END, ! EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND } gfc_exec_op; --- 1398,1404 ---- EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_OPEN, EXEC_CLOSE, EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END, ! EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH } gfc_exec_op; *************** typedef struct gfc_code *** 1361,1367 **** ext; /* Points to additional structures required by statement */ /* Backend_decl is used for cycle and break labels in do loops, and ! * probably for other constructs as well, once we translate them. */ tree backend_decl; } gfc_code; --- 1436,1442 ---- ext; /* Points to additional structures required by statement */ /* Backend_decl is used for cycle and break labels in do loops, and ! probably for other constructs as well, once we translate them. */ tree backend_decl; } gfc_code; *************** gfc_data; *** 1404,1413 **** /* Structure for holding compile options */ typedef struct { - const char *source; char *module_dir; gfc_source_form source_form; ! int fixed_line_length; int max_identifier_length; int verbose; --- 1479,1500 ---- /* Structure for holding compile options */ typedef struct { char *module_dir; gfc_source_form source_form; ! /* When fixed_line_length or free_line_length are 0, the whole line is used. ! ! Default is -1, the maximum line length mandated by the respective source ! form is used: ! for FORM_FREE GFC_MAX_LINE (132) ! else 72. ! ! If fixed_line_length or free_line_length is not 0 nor -1 then the user has ! requested a specific line-length. ! ! If the user requests a fixed_line_length <7 then gfc_init_options() ! emits a fatal error. */ ! int fixed_line_length; /* maximum line length in fixed-form. */ ! int free_line_length; /* maximum line length in free-form. */ int max_identifier_length; int verbose; *************** typedef struct *** 1431,1445 **** --- 1518,1539 ---- int flag_no_backend; int flag_pack_derived; int flag_repack_arrays; + int flag_preprocessed; int flag_f2c; int flag_automatic; int flag_backslash; + int flag_cray_pointer; + int flag_d_lines; int q_kind; + int fpe; + int warn_std; int allow_std; int warn_nonstd_intrinsics; + int fshort_enums; + int convert; } gfc_option_t; *************** void gfc_scanner_init_1 (void); *** 1490,1496 **** void gfc_add_include_path (const char *); void gfc_release_include_path (void); ! FILE *gfc_open_included_file (const char *); int gfc_at_end (void); int gfc_at_eof (void); --- 1584,1590 ---- void gfc_add_include_path (const char *); void gfc_release_include_path (void); ! FILE *gfc_open_included_file (const char *, bool); int gfc_at_end (void); int gfc_at_eof (void); *************** int gfc_next_char (void); *** 1505,1514 **** int gfc_peek_char (void); void gfc_error_recovery (void); void gfc_gobble_whitespace (void); ! try gfc_new_file (const char *, gfc_source_form); extern gfc_source_form gfc_current_form; ! extern char *gfc_source_file; extern locus gfc_current_locus; /* misc.c */ --- 1599,1609 ---- int gfc_peek_char (void); void gfc_error_recovery (void); void gfc_gobble_whitespace (void); ! try gfc_new_file (void); ! const char * gfc_read_orig_filename (const char *, const char **); extern gfc_source_form gfc_current_form; ! extern const char *gfc_source_file; extern locus gfc_current_locus; /* misc.c */ *************** void gfc_free (void *); *** 1517,1523 **** int gfc_terminal_width(void); void gfc_clear_ts (gfc_typespec *); FILE *gfc_open_file (const char *); - const char *gfc_article (const char *); const char *gfc_basic_typename (bt); const char *gfc_typename (gfc_typespec *); --- 1612,1617 ---- *************** typedef struct gfc_error_buf *** 1553,1571 **** void gfc_error_init_1 (void); void gfc_buffer_error (int); ! void gfc_warning (const char *, ...); ! void gfc_warning_now (const char *, ...); void gfc_clear_warning (void); void gfc_warning_check (void); ! void gfc_error (const char *, ...); ! void gfc_error_now (const char *, ...); ! void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN; ! void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN; void gfc_clear_error (void); int gfc_error_check (void); ! try gfc_notify_std (int, const char *, ...); /* A general purpose syntax error. */ #define gfc_syntax_error(ST) \ --- 1647,1665 ---- void gfc_error_init_1 (void); void gfc_buffer_error (int); ! void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); ! void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_clear_warning (void); void gfc_warning_check (void); ! void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); ! void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); ! void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2); ! void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2); void gfc_clear_error (void); int gfc_error_check (void); ! try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); /* A general purpose syntax error. */ #define gfc_syntax_error(ST) \ *************** void gfc_get_errors (int *, int *); *** 1583,1588 **** --- 1677,1684 ---- /* arith.c */ void gfc_arith_init_1 (void); void gfc_arith_done_1 (void); + gfc_expr *gfc_enum_initializer (gfc_expr *, locus); + arith gfc_check_integer_range (mpz_t p, int kind); /* trans-types.c */ int gfc_validate_kind (bt, int, bool); *************** void gfc_get_component_attr (symbol_attr *** 1610,1621 **** --- 1706,1721 ---- void gfc_set_sym_referenced (gfc_symbol * sym); + try gfc_add_attribute (symbol_attribute *, locus *, uint); try gfc_add_allocatable (symbol_attribute *, locus *); try gfc_add_dimension (symbol_attribute *, const char *, locus *); try gfc_add_external (symbol_attribute *, locus *); try gfc_add_intrinsic (symbol_attribute *, locus *); try gfc_add_optional (symbol_attribute *, locus *); try gfc_add_pointer (symbol_attribute *, locus *); + try gfc_add_cray_pointer (symbol_attribute *, locus *); + try gfc_add_cray_pointee (symbol_attribute *, locus *); + try gfc_mod_pointee_as (gfc_array_spec *as); try gfc_add_result (symbol_attribute *, const char *, locus *); try gfc_add_save (symbol_attribute *, const char *, locus *); try gfc_add_saved_common (symbol_attribute *, locus *); *************** try gfc_add_dummy (symbol_attribute *, c *** 1624,1629 **** --- 1724,1730 ---- try gfc_add_generic (symbol_attribute *, const char *, locus *); try gfc_add_common (symbol_attribute *, locus *); try gfc_add_in_common (symbol_attribute *, const char *, locus *); + try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *); try gfc_add_data (symbol_attribute *, const char *, locus *); try gfc_add_in_namelist (symbol_attribute *, const char *, locus *); try gfc_add_sequence (symbol_attribute *, const char *, locus *); *************** int gfc_symbols_could_alias (gfc_symbol *** 1675,1680 **** --- 1776,1782 ---- void gfc_undo_symbols (void); void gfc_commit_symbols (void); + void gfc_commit_symbol (gfc_symbol * sym); void gfc_free_namespace (gfc_namespace *); void gfc_symbol_init_2 (void); *************** void gfc_free_ref_list (gfc_ref *); *** 1736,1741 **** --- 1838,1844 ---- void gfc_type_convert_binary (gfc_expr *); int gfc_is_constant_expr (gfc_expr *); try gfc_simplify_expr (gfc_expr *, int); + int gfc_has_vector_index (gfc_expr *); gfc_expr *gfc_get_expr (void); void gfc_free_expr (gfc_expr *); *************** try gfc_check_assign_symbol (gfc_symbol *** 1759,1764 **** --- 1862,1868 ---- gfc_expr *gfc_default_initializer (gfc_typespec *); gfc_expr *gfc_get_variable_expr (gfc_symtree *); + void gfc_expr_set_symbols_referenced (gfc_expr * expr); /* st.c */ extern gfc_code new_st; *************** int gfc_elemental (gfc_symbol *); *** 1778,1783 **** --- 1882,1888 ---- try gfc_resolve_iterator (gfc_iterator *, bool); try gfc_resolve_index (gfc_expr *, int); try gfc_resolve_dim_arg (gfc_expr *); + int gfc_is_formal_arg (void); /* array.c */ void gfc_free_array_spec (gfc_array_spec *); *************** int gfc_is_compile_time_shape (gfc_array *** 1814,1819 **** --- 1919,1925 ---- /* interface.c -- FIXME: some of these should be in symbol.c */ void gfc_free_interface (gfc_interface *); + int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *); int gfc_compare_types (gfc_typespec *, gfc_typespec *); void gfc_check_interfaces (gfc_namespace *); void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); *************** void gfc_show_namespace (gfc_namespace * *** 1862,1866 **** --- 1968,1976 ---- /* parse.c */ try gfc_parse_file (void); + void global_used (gfc_gsymbol *, locus *); + + /* dependency.c */ + int gfc_dep_compare_expr (gfc_expr *, gfc_expr *); #endif /* GCC_GFORTRAN_H */ diff -Nrcpad gcc-4.0.2/gcc/fortran/gfortran.texi gcc-4.1.0/gcc/fortran/gfortran.texi *** gcc-4.0.2/gcc/fortran/gfortran.texi Sun Aug 14 21:46:51 2005 --- gcc-4.1.0/gcc/fortran/gfortran.texi Wed Feb 8 20:14:00 2006 *************** This file documents the use and the inte *** 69,94 **** the GNU Fortran 95 compiler, (@command{gfortran}). Published by the Free Software Foundation ! 59 Temple Place - Suite 330 ! Boston, MA 02111-1307 USA @insertcopying @end ifinfo - Contributed by Steven Bosscher (@email{s.bosscher@@gcc.gnu.org}). @setchapternewpage odd @titlepage @title Using GNU Fortran 95 @sp 2 ! @center Steven Bosscher @page @vskip 0pt plus 1filll For the @value{version-GCC} Version* @sp 1 Published by the Free Software Foundation @* ! 59 Temple Place - Suite 330@* ! Boston, MA 02111-1307, USA@* @c Last printed ??ber, 19??.@* @c Printed copies are available for $? each.@* @c ISBN ??? --- 69,93 ---- the GNU Fortran 95 compiler, (@command{gfortran}). Published by the Free Software Foundation ! 51 Franklin Street, Fifth Floor ! Boston, MA 02110-1301 USA @insertcopying @end ifinfo @setchapternewpage odd @titlepage @title Using GNU Fortran 95 @sp 2 ! @center The gfortran team @page @vskip 0pt plus 1filll For the @value{version-GCC} Version* @sp 1 Published by the Free Software Foundation @* ! 51 Franklin Street, Fifth Floor@* ! Boston, MA 02110-1301, USA@* @c Last printed ??ber, 19??.@* @c Printed copies are available for $? each.@* @c ISBN ??? *************** Boston, MA 02111-1307, USA@* *** 99,105 **** @contents @page ! @node Top, Copying,, (DIR) @top Introduction @cindex Introduction --- 98,104 ---- @contents @page ! @node Top @top Introduction @cindex Introduction *************** not accurately reflect the status of the *** 119,129 **** @comment better formatting. @comment @menu - * Copying:: GNU General Public License says - how you can copy and share GNU Fortran. - * GNU Free Documentation License:: - How you can copy and share this manual. - * Funding:: How to help assure continued work for free software. * Getting Started:: What you should know about @command{gfortran}. * GFORTRAN and GCC:: You can compile Fortran, C, or other programs. * GFORTRAN and G77:: Why we chose to start from scratch. --- 118,123 ---- *************** not accurately reflect the status of the *** 131,168 **** * Project Status:: Status of @command{gfortran}, roadmap, proposed extensions. * Contributing:: How you can help. * Standards:: Standards supported by @command{gfortran} * Extensions:: Language extensions implemented by @command{gfortran} * Intrinsic Procedures:: Intrinsic procedures supported by @command{gfortran} * Index:: Index of this documentation. @end menu @c --------------------------------------------------------------------- - @c GNU General Public License - @c --------------------------------------------------------------------- - - @include gpl.texi - - - - @c --------------------------------------------------------------------- - @c GNU Free Documentation License - @c --------------------------------------------------------------------- - - @include fdl.texi - - - - @c --------------------------------------------------------------------- - @c Funding Free Software - @c --------------------------------------------------------------------- - - @include funding.texi - - - - @c --------------------------------------------------------------------- @c Getting Started @c --------------------------------------------------------------------- --- 125,144 ---- * Project Status:: Status of @command{gfortran}, roadmap, proposed extensions. * Contributing:: How you can help. * Standards:: Standards supported by @command{gfortran} + * Runtime:: Influencing runtime behavior with environment variables. * Extensions:: Language extensions implemented by @command{gfortran} * Intrinsic Procedures:: Intrinsic procedures supported by @command{gfortran} + * Copying:: GNU General Public License says + how you can copy and share GNU Fortran. + * GNU Free Documentation License:: + How you can copy and share this manual. + * Funding:: How to help assure continued work for free software. * Index:: Index of this documentation. @end menu @c --------------------------------------------------------------------- @c Getting Started @c --------------------------------------------------------------------- *************** not accurately reflect the status of the *** 172,191 **** Gfortran is the GNU Fortran 95 compiler front end, designed initially as a free replacement for, or alternative to, the unix @command{f95} command; ! @command{gfortran} is command you'll use to invoke the compiler. ! @emph{Gfortran is not yet a fully conformant Fortran 95 compiler}. ! It can generate code for most constructs and expressions, ! but work remains to be done. In particular, there are known ! deficiencies with ENTRY, NAMELIST, and sophisticated use of ! MODULES, POINTERS and DERIVED TYPES. For those whose Fortran ! codes conform to either the Fortran 77 standard or the ! GNU Fortran 77 language, we recommend to use @command{g77} ! from GCC 3.4. We recommend that distributors continue to provide ! packages of g77-3.4 until we announce that @command{gfortran} ! fully replaces @command{g77}. ! The gfortran developers welcome any feedback on user experience ! with @command{gfortran} at @email{fortran@@gcc.gnu.org}. When @command{gfortran} is finished, it will do everything you expect from any decent compiler: --- 148,158 ---- Gfortran is the GNU Fortran 95 compiler front end, designed initially as a free replacement for, or alternative to, the unix @command{f95} command; ! @command{gfortran} is the command you'll use to invoke the compiler. ! Gfortran is still in an early state of development. ! @command{gfortran} can generate code for most constructs and expressions, ! but much work remains to be done. When @command{gfortran} is finished, it will do everything you expect from any decent compiler: *************** that also understands and accepts Fortra *** 253,259 **** The @command{gcc} command is the @dfn{driver} program for all the languages in the GNU Compiler Collection (GCC); With @command{gcc}, ! you can compiler the source code of any language for which a front end is available in GCC. @item --- 220,226 ---- The @command{gcc} command is the @dfn{driver} program for all the languages in the GNU Compiler Collection (GCC); With @command{gcc}, ! you can compile the source code of any language for which a front end is available in GCC. @item *************** will automatically link the correct libr *** 267,273 **** @item A collection of run-time libraries. ! These libraries contains the machine code needed to support capabilities of the Fortran language that are not directly provided by the machine code generated by the @command{gfortran} compilation phase, --- 234,240 ---- @item A collection of run-time libraries. ! These libraries contain the machine code needed to support capabilities of the Fortran language that are not directly provided by the machine code generated by the @command{gfortran} compilation phase, *************** GCC used to be the GNU ``C'' Compiler, *** 301,316 **** but is now known as the @dfn{GNU Compiler Collection}. GCC provides the GNU system with a very versatile compiler middle end (shared optimization passes), ! and with back ends (code generators) for many different computer architectures and operating systems. The code of the middle end and back end are shared by all compiler front ends that are in the GNU Compiler Collection. A GCC front end is essentially a source code parser ! and a pass to generate a representation of the semantics ! of the program in the source code in the GCC language ! independent intermediate language, ! called @dfn{GENERIC}. The parser takes a source file written in a particular computer language, reads and parses it, --- 268,282 ---- but is now known as the @dfn{GNU Compiler Collection}. GCC provides the GNU system with a very versatile compiler middle end (shared optimization passes), ! and back ends (code generators) for many different computer architectures and operating systems. The code of the middle end and back end are shared by all compiler front ends that are in the GNU Compiler Collection. A GCC front end is essentially a source code parser ! and an intermediate code generator. The code generator translates the ! semantics of the source code into a language independent form called ! @dfn{GENERIC}. The parser takes a source file written in a particular computer language, reads and parses it, *************** or just @dfn{AST} or ``tree'' for short. *** 323,339 **** This data structure represents the whole program or a subroutine or a function. The ``tree'' is passed to the GCC middle end, ! which will perform optimization passes on it, ! pass the optimized AST and generate assembly ! for the program unit. Different phases in this translation process can be, and in fact @emph{are} merged in many compiler front ends. GNU Fortran 95 has a strict separation between the parser and code generator. ! The goal of the gfortran project is to build a new front end for GCC: ! A Fortran 95 front end. In a non-gfortran installation, @command{gcc} will not be able to compile Fortran 95 source code (only the ``C'' front end has to be compiled if you want to build GCC, --- 289,304 ---- This data structure represents the whole program or a subroutine or a function. The ``tree'' is passed to the GCC middle end, ! which will perform optimization passes on it. The optimized AST is then ! handed off too the back end which assembles the program unit. Different phases in this translation process can be, and in fact @emph{are} merged in many compiler front ends. GNU Fortran 95 has a strict separation between the parser and code generator. ! The goal of the gfortran project is to build a new front end for GCC. ! Specifically, a Fortran 95 front end. In a non-gfortran installation, @command{gcc} will not be able to compile Fortran 95 source code (only the ``C'' front end has to be compiled if you want to build GCC, *************** or just a big bug.... *** 407,413 **** The start of the GNU Fortran 95 project was announced on the GCC homepage in March 18, 2000 (even though Andy had already been working on it for a while, ! or course). Gfortran is currently reaching the stage where is is able to compile real world programs. However it is still under development and has many rough --- 372,378 ---- The start of the GNU Fortran 95 project was announced on the GCC homepage in March 18, 2000 (even though Andy had already been working on it for a while, ! of course). Gfortran is currently reaching the stage where is is able to compile real world programs. However it is still under development and has many rough *************** whether to use inline code (good for sma *** 456,484 **** overhead occurs) or generate function calls (good for large arrays as it allows use of hand-optimized assembly routines, SIMD instructions, etc.) ! The IO library is still under development. The following features should be ! usable for real programs: ! ! @itemize @minus ! @item List directed ! @item Unformatted sequential ! @end itemize ! ! Usable with bugs: ! ! @itemize @minus ! @item Formatted sequential ('T' edit descriptor, and others) ! @end itemize ! ! Not recommended: ! ! @itemize @minus ! @item Unformatted direct access ! @item Formatted direct access ! @end itemize ! Many Fortran programs only use a small subset of the available IO ! capabilities, so your mileage may vary. @node Proposed Extensions @section Proposed Extensions --- 421,430 ---- overhead occurs) or generate function calls (good for large arrays as it allows use of hand-optimized assembly routines, SIMD instructions, etc.) ! The IO library is in a mostly usable state. Unformatted I/O for ! @code{REAL(KIND=10)} variables is currently not recommended. ! Array intrinsics mostly work. @node Proposed Extensions @section Proposed Extensions *************** Flag for defining the kind number for de *** 496,510 **** @item User-specified alignment rules for structures. @item ! Flag to generate a @code{Makefile} info. @item Automatically extend single precision constants to double. @item - Cray pointers (this was high on the @command{g77} wishlist). - - @item Compile code that conserves memory by dynamically allocating common and module storage either on stack or heap. --- 442,453 ---- @item User-specified alignment rules for structures. @item ! Flag to generate @code{Makefile} info. @item Automatically extend single precision constants to double. @item Compile code that conserves memory by dynamically allocating common and module storage either on stack or heap. *************** dereference instead of segfaulting. The *** 543,552 **** option in the g95 development mailing list. @item ! Allow setting default unit number. @item ! Option to initialize of otherwise uninitialized integer and floating point variables. @item --- 486,495 ---- option in the g95 development mailing list. @item ! Allow setting the default unit number. @item ! Option to initialize otherwise uninitialized integer and floating point variables. @item *************** action. *** 575,581 **** Set precision for fp units that support it (i387). @item ! Variables for setting fp rounding mode. @item Variable to fill uninitialized variables with a user-defined bit --- 518,524 ---- Set precision for fp units that support it (i387). @item ! Variable for setting fp rounding mode. @item Variable to fill uninitialized variables with a user-defined bit *************** Environment variable for temporary file *** 603,614 **** @item Environment variable forcing standard output to be line buffered (unix). ! @item ! Variable for swapping endianness during unformatted read. ! @item ! Variable for swapping Endianness during unformatted write. @end itemize @c --------------------------------------------------------------------- @c Extensions --- 546,626 ---- @item Environment variable forcing standard output to be line buffered (unix). ! @end itemize ! @node Runtime ! @chapter Runtime: Influencing runtime behavior with environment variables ! @cindex Runtime ! ! The behaviour of the @command{gfortran} can be influenced by ! environment variables. ! @menu ! * GFORTRAN_CONVERT_UNIT:: Set endianness for unformatted I/O ! @end menu ! ! @node GFORTRAN_CONVERT_UNIT ! @section GFORTRAN_CONVERT_UNIT --- Set endianness for unformatted I/O ! ! By setting the @code{GFORTRAN_CONVERT_UNIT variable}, it is possible ! to change the representation of data for unformatted files. ! The syntax for the @code{GFORTRAN_CONVERT_UNIT} variable is: ! @smallexample ! GFORTRAN_CONVERT_UNIT: mode | mode ';' exception ; ! mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ; ! exception: mode ':' unit_list | unit_list ; ! unit_list: unit_spec | unit_list unit_spec ; ! unit_spec: INTEGER | INTEGER '-' INTEGER ; ! @end smallexample ! The variable consists of an optional default mode, followed by ! a list of optional exceptions, which are separated by semicolons ! from the preceding default and each other. Each exception consists ! of a format and a comma-separated list of units. Valid values for ! the modes are the same as for the @code{CONVERT} specifier: ! ! @itemize @w{} ! @item @code{NATIVE} Use the native format. This is the default. ! @item @code{SWAP} Swap between little- and big-endian. ! @item @code{LITTLE_ENDIAN} Use the little-endian format ! for unformatted files. ! @item @code{BIG_ENDIAN} Use the big-endian format for unformatted files. @end itemize + A missing mode for an exception is taken to mean @code{BIG_ENDIAN}. + Examples of values for @code{GFORTRAN_CONVERT_UNIT} are: + @itemize @w{} + @item @code{'big_endian'} Do all unformatted I/O in big_endian mode. + @item @code{'little_endian;native:10-20,25'} Do all unformatted I/O + in little_endian mode, except for units 10 to 20 and 25, which are in + native format. + @item @code{'10-20'} Units 10 to 20 are big-endian, the rest is native. + @end itemize + + Setting the environment variables should be done on the command + line or via the @code{export} + command for @code{sh}-compatible shells and via @code{setenv} + for @code{csh}-compatible shells. + + Example for @code{sh}: + @smallexample + $ gfortran foo.f90 + $ GFORTRAN_CONVERT_UNIT='big_endian;native:10-20' ./a.out + @end smallexample + + Example code for @code{csh}: + @smallexample + % gfortran foo.f90 + % setenv GFORTRAN_CONVERT_UNIT 'big_endian;native:10-20' + % ./a.out + @end smallexample + + Using anything but the native representation for unformatted data + carries a significant speed overhead. If speed in this area matters + to you, it is best if you use this only for data that needs to be + portable. + + @xref{CONVERT specifier}, for an alternative way to specify the + data representation for unformatted files. @xref{Runtime Options}, for + setting a default data representation for the whole program. The + @code{CONVERT} specifier overrides the @code{-fconvert} compile options. @c --------------------------------------------------------------------- @c Extensions *************** of extensions, and @option{-std=legacy} *** 636,643 **** --- 648,663 ---- * Old-style kind specifications:: * Old-style variable initialization:: * Extensions to namelist:: + * X format descriptor:: + * Commas in FORMAT specifications:: + * I/O item lists:: + * Hexadecimal constants:: + * Real array indices:: + * Unary operators:: * Implicitly interconvert LOGICAL and INTEGER:: * Hollerith constants support:: + * Cray pointers:: + * CONVERT specifier:: @end menu @node Old-style kind specifications *************** Examples of standard conforming code equ *** 690,696 **** @section Extensions to namelist @cindex Namelist ! @command{gfortran} fully supports the fortran95 standard for namelist io including array qualifiers, substrings and fully qualified derived types. The output from a namelist write is compatible with namelist read. The output has all names in upper case and indentation to column 1 after the --- 710,716 ---- @section Extensions to namelist @cindex Namelist ! @command{gfortran} fully supports the Fortran 95 standard for namelist I/O including array qualifiers, substrings and fully qualified derived types. The output from a namelist write is compatible with namelist read. The output has all names in upper case and indentation to column 1 after the *************** had been called: *** 731,737 **** CH=abcd, / @end smallexample ! To aid this dialog, when input is from stdin, errors produce send their messages to stderr and execution continues, even if IOSTAT is set. PRINT namelist is permitted. This causes an error if -std=f95 is used. --- 751,757 ---- CH=abcd, / @end smallexample ! To aid this dialog, when input is from stdin, errors send their messages to stderr and execution continues, even if IOSTAT is set. PRINT namelist is permitted. This causes an error if -std=f95 is used. *************** PROGRAM test_print *** 743,758 **** END PROGRAM test_print @end smallexample @node Implicitly interconvert LOGICAL and INTEGER @section Implicitly interconvert LOGICAL and INTEGER @cindex Implicitly interconvert LOGICAL and INTEGER ! As a GNU extension for backwards compatability with other compilers, @command{gfortran} allows the implicit conversion of LOGICALs to INTEGERs and vice versa. When converting from a LOGICAL to an INTEGER, the numeric value of @code{.FALSE.} is zero, and that of @code{.TRUE.} is one. When converting from INTEGER to LOGICAL, the value zero is interpreted as ! @code{.FALSE.} and any non-zero value is interpreted as @code{.TRUE.}. @smallexample INTEGER*4 i --- 763,838 ---- END PROGRAM test_print @end smallexample + @node X format descriptor + @section X format descriptor + @cindex X format descriptor + + To support legacy codes, @command{gfortran} permits the count field + of the X edit descriptor in FORMAT statements to be omitted. When + omitted, the count is implicitly assumed to be one. + + @smallexample + PRINT 10, 2, 3 + 10 FORMAT (I1, X, I1) + @end smallexample + + @node Commas in FORMAT specifications + @section Commas in FORMAT specifications + @cindex Commas in FORMAT specifications + + To support legacy codes, @command{gfortran} allows the comma separator + to be omitted immediately before and after character string edit + descriptors in FORMAT statements. + + @smallexample + PRINT 10, 2, 3 + 10 FORMAT ('FOO='I1' BAR='I2) + @end smallexample + + @node I/O item lists + @section I/O item lists + @cindex I/O item lists + + To support legacy codes, @command{gfortran} allows the input item list + of the READ statement, and the output item lists of the WRITE and PRINT + statements to start with a comma. + + @node Hexadecimal constants + @section Hexadecimal constants + @cindex Hexadecimal constants + + As a GNU extension, @command{gfortran} allows hexadecimal constants to + be specified using the X prefix, in addition to the standard Z prefix. + + @node Real array indices + @section Real array indices + @cindex Real array indices + + As a GNU extension, @command{gfortran} allows arrays to be indexed using + real types, whose values are implicitly converted to integers. + + @node Unary operators + @section Unary operators + @cindex Unary operators + + As a GNU extension, @command{gfortran} allows unary plus and unary + minus operators to appear as the second operand of binary arithmetic + operators without the need for parenthesis. + + @smallexample + X = Y * -Z + @end smallexample + @node Implicitly interconvert LOGICAL and INTEGER @section Implicitly interconvert LOGICAL and INTEGER @cindex Implicitly interconvert LOGICAL and INTEGER ! As a GNU extension for backwards compatibility with other compilers, @command{gfortran} allows the implicit conversion of LOGICALs to INTEGERs and vice versa. When converting from a LOGICAL to an INTEGER, the numeric value of @code{.FALSE.} is zero, and that of @code{.TRUE.} is one. When converting from INTEGER to LOGICAL, the value zero is interpreted as ! @code{.FALSE.} and any nonzero value is interpreted as @code{.TRUE.}. @smallexample INTEGER*4 i *************** are stored as byte strings, one characte *** 771,777 **** @command{gfortran} supports Hollerith constants. They can be used as the right hands in the @code{DATA} statement and @code{ASSIGN} statement, also as the arguments. The left hands can be of Integer, Real, Complex and Logical type. ! The constant will be padded or trancated to fit the size of left hand. Valid Hollerith constants examples: @smallexample --- 851,857 ---- @command{gfortran} supports Hollerith constants. They can be used as the right hands in the @code{DATA} statement and @code{ASSIGN} statement, also as the arguments. The left hands can be of Integer, Real, Complex and Logical type. ! The constant will be padded or truncated to fit the size of left hand. Valid Hollerith constants examples: @smallexample *************** a = 8H12345678 ! The Hollerith constant *** 788,795 **** --- 868,1059 ---- a = 0H ! At least one character needed. @end smallexample + @node Cray pointers + @section Cray pointers + @cindex Cray pointers + + Cray pointers are part of a non-standard extension that provides a + C-like pointer in Fortran. This is accomplished through a pair of + variables: an integer "pointer" that holds a memory address, and a + "pointee" that is used to dereference the pointer. + + Pointer/pointee pairs are declared in statements of the form: + @smallexample + pointer ( , ) + @end smallexample + or, + @smallexample + pointer ( , ), ( , ), ... + @end smallexample + The pointer is an integer that is intended to hold a memory address. + The pointee may be an array or scalar. A pointee can be an assumed + size array -- that is, the last dimension may be left unspecified by + using a '*' in place of a value -- but a pointee cannot be an assumed + shape array. No space is allocated for the pointee. + + The pointee may have its type declared before or after the pointer + statement, and its array specification (if any) may be declared + before, during, or after the pointer statement. The pointer may be + declared as an integer prior to the pointer statement. However, some + machines have default integer sizes that are different than the size + of a pointer, and so the following code is not portable: + @smallexample + integer ipt + pointer (ipt, iarr) + @end smallexample + If a pointer is declared with a kind that is too small, the compiler + will issue a warning; the resulting binary will probably not work + correctly, because the memory addresses stored in the pointers may be + truncated. It is safer to omit the first line of the above example; + if explicit declaration of ipt's type is omitted, then the compiler + will ensure that ipt is an integer variable large enough to hold a + pointer. + + Pointer arithmetic is valid with Cray pointers, but it is not the same + as C pointer arithmetic. Cray pointers are just ordinary integers, so + the user is responsible for determining how many bytes to add to a + pointer in order to increment it. Consider the following example: + @smallexample + real target(10) + real pointee(10) + pointer (ipt, pointee) + ipt = loc (target) + ipt = ipt + 1 + @end smallexample + The last statement does not set ipt to the address of + @code{target(1)}, as one familiar with C pointer arithmetic might + expect. Adding 1 to ipt just adds one byte to the address stored in + ipt. + + Any expression involving the pointee will be translated to use the + value stored in the pointer as the base address. + + To get the address of elements, this extension provides an intrinsic + function loc(), loc() is essentially the C '&' operator, except the + address is cast to an integer type: + @smallexample + real ar(10) + pointer(ipt, arpte(10)) + real arpte + ipt = loc(ar) ! Makes arpte is an alias for ar + arpte(1) = 1.0 ! Sets ar(1) to 1.0 + @end smallexample + The pointer can also be set by a call to a malloc-type + function. There is no malloc intrinsic implemented as part of the + Cray pointer extension, but it might be a useful future addition to + @command{gfortran}. Even without an intrinsic malloc function, + dynamic memory allocation can be combined with Cray pointers by + calling a short C function: + @smallexample + mymalloc.c: + + void mymalloc_(void **ptr, int *nbytes) + @{ + *ptr = malloc(*nbytes); + return; + @} + + caller.f: + + program caller + integer ipinfo; + real*4 data + pointer (ipdata, data(1024)) + call mymalloc(ipdata,4*1024) + end + @end smallexample + Cray pointees often are used to alias an existing variable. For + example: + @smallexample + integer target(10) + integer iarr(10) + pointer (ipt, iarr) + ipt = loc(target) + @end smallexample + As long as ipt remains unchanged, iarr is now an alias for target. + The optimizer, however, will not detect this aliasing, so it is unsafe + to use iarr and target simultaneously. Using a pointee in any way + that violates the Fortran aliasing rules or assumptions is illegal. + It is the user's responsibility to avoid doing this; the compiler + works under the assumption that no such aliasing occurs. + + Cray pointers will work correctly when there is no aliasing (i.e., + when they're used to access a dynamically allocated block of memory), + and also in any routine where a pointee is used, but any variable with + which it shares storage is not used. Code that violates these rules + may not run as the user intends. This is not a bug in the optimizer; + any code that violates the aliasing rules is illegal. (Note that this + is not unique to gfortran; any Fortran compiler that supports Cray + pointers will ``incorrectly'' optimize code with illegal aliasing.) + + There are a number of restrictions on the attributes that can be + applied to Cray pointers and pointees. Pointees may not have the + attributes ALLOCATABLE, INTENT, OPTIONAL, DUMMY, TARGET, EXTERNAL, + INTRINSIC, or POINTER. Pointers may not have the attributes + DIMENSION, POINTER, TARGET, ALLOCATABLE, EXTERNAL, or INTRINSIC. + Pointees may not occur in more than one pointer statement. A pointee + cannot be a pointer. Pointees cannot occur in equivalence, common, or + data statements. + + A pointer may be modified during the course of a program, and this + will change the location to which the pointee refers. However, when + pointees are passed as arguments, they are treated as ordinary + variables in the invoked function. Subsequent changes to the pointer + will not change the base address of the array that was passed. + + @node CONVERT specifier + @section CONVERT specifier + @cindex CONVERT specifier + + gfortran allows the conversion of unformatted data between little- + and big-endian representation to facilitate moving of data + between different systems. The conversion can be indicated with + the @code{CONVERT} specifier on the @code{OPEN} statement. + @xref{GFORTRAN_CONVERT_UNIT}, for an alternative way of specifying + the data format via an environment variable. + + Valid values for @code{CONVERT} are: + @itemize @w{} + @item @code{CONVERT='NATIVE'} Use the native format. This is the default. + @item @code{CONVERT='SWAP'} Swap between little- and big-endian. + @item @code{CONVERT='LITTLE_ENDIAN'} Use the little-endian representation + for unformatted files. + @item @code{CONVERT='BIG_ENDIAN'} Use the big-endian representation for + unformatted files. + @end itemize + + Using the option could look like this: + @smallexample + open(file='big.dat',form='unformatted',access='sequential', & + convert='big_endian') + @end smallexample + + The value of the conversion can be queried by using + @code{INQUIRE(CONVERT=ch)}. The values returned are + @code{'BIG_ENDIAN'} and @code{'LITTLE_ENDIAN'}. + + @code{CONVERT} works between big- and little-endian for + @code{INTEGER} values of all supported kinds and for @code{REAL} + on IEEE sytems of kinds 4 and 8. Conversion between different + ``extended double'' types on different architectures such as + m68k and x86_64, which gfortran + supports as @code{REAL(KIND=10)} will probably not work. + + @emph{Note that the values specified via the GFORTRAN_CONVERT_UNIT + environment variable will override the CONVERT specifier in the + open statement}. This is to give control over data formats to + a user who does not have the source code of his program available. + + Using anything but the native representation for unformatted data + carries a significant speed overhead. If speed in this area matters + to you, it is best if you use this only for data that needs to be + portable. + + @c --------------------------------------------------------------------- @include intrinsic.texi @c --------------------------------------------------------------------- + + @c --------------------------------------------------------------------- @c Contributing @c --------------------------------------------------------------------- *************** ideas and significant help to the gfortr *** 845,850 **** --- 1109,1122 ---- @item Paul Brook @item Feng Wang @item Bud Davis + @item Paul Thomas + @item François-Xavier Coudert + @item Steve Kargl + @item Jerry Delisle + @item Janne Blomqvist + @item Erik Edelmann + @item Thomas Koenig + @item Asher Langton @end itemize The following people have contributed bug reports, *************** and much needed feedback and encourageme *** 859,865 **** @end itemize Many other individuals have helped debug, ! test and improve @command{gfortran} over the past two years, and we welcome you to do the same! If you already have done so, and you would like to see your name listed in the --- 1131,1137 ---- @end itemize Many other individuals have helped debug, ! test and improve @command{gfortran} over the past few years, and we welcome you to do the same! If you already have done so, and you would like to see your name listed in the *************** please contact a project maintainer. *** 906,914 **** The GNU Fortran 95 Compiler aims to be a conforming implementation of ISO/IEC 1539:1997 (Fortran 95). ! In the future it may also support other variants and extensions to the Fortran ! language. This includes ANSI Fortran 77, Fortran 90, Fortran 2000 (not yet ! finalized), and OpenMP. @node Index @unnumbered Index --- 1178,1254 ---- The GNU Fortran 95 Compiler aims to be a conforming implementation of ISO/IEC 1539:1997 (Fortran 95). ! In the future it may also support other variants of and extensions to ! the Fortran language. These include ANSI Fortran 77, ISO Fortran 90, ! ISO Fortran 2003 and OpenMP. ! ! @menu ! * Fortran 2003 status:: ! @end menu ! ! @node Fortran 2003 status ! @section Fortran 2003 status ! ! Although @command{gfortran} focuses on implementing the Fortran 95 ! standard for the time being, a few Fortran 2003 features are currently ! available. ! ! @itemize ! @item ! Intrinsics @code{command_argument_count}, @code{get_command}, ! @code{get_command_argument}, and @code{get_environment_variable}. ! ! @item ! @cindex Array constructors ! @cindex @code{[...]} ! Array constructors using square brackets. That is, @code{[...]} rather ! than @code{(/.../)}. ! ! @item ! @cindex @code{FLUSH} statement ! @code{FLUSH} statement. ! ! @item ! @cindex @code{IOMSG=} specifier ! @code{IOMSG=} specifier for I/O statements. ! ! @item ! @cindex @code{ENUM} statement ! @cindex @code{ENUMERATOR} statement ! @cindex @command{-fshort-enums} ! Support for the declaration of enumeration constants via the ! @code{ENUM} and @code{ENUMERATOR} statements. Interoperability with ! @command{gcc} is guaranteed also for the case where the ! @command{-fshort-enums} command line option is given. ! ! @end itemize ! ! ! @c --------------------------------------------------------------------- ! @c GNU General Public License ! @c --------------------------------------------------------------------- ! ! @include gpl.texi ! ! ! ! @c --------------------------------------------------------------------- ! @c GNU Free Documentation License ! @c --------------------------------------------------------------------- ! ! @include fdl.texi ! ! ! ! @c --------------------------------------------------------------------- ! @c Funding Free Software ! @c --------------------------------------------------------------------- ! ! @include funding.texi ! ! @c --------------------------------------------------------------------- ! @c Index ! @c --------------------------------------------------------------------- @node Index @unnumbered Index diff -Nrcpad gcc-4.0.2/gcc/fortran/gfortranspec.c gcc-4.1.0/gcc/fortran/gfortranspec.c *** gcc-4.0.2/gcc/fortran/gfortranspec.c Thu Jan 6 16:41:36 2005 --- gcc-4.1.0/gcc/fortran/gfortranspec.c Sat Jan 21 18:29:08 2006 *************** GNU General Public License for more deta *** 16,23 **** You should have received a copy of the GNU General Public License along with GNU CC; see the file COPYING. If not, write to ! the Free Software Foundation, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* This file is copied more or less verbatim from g77. */ /* This file contains a filter for the main `gcc' driver, which is replicated for the `gfortran' driver by adding this filter. The purpose --- 16,23 ---- You should have received a copy of the GNU General Public License along with GNU CC; see the file COPYING. If not, write to ! the Free Software Foundation, 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* This file is copied more or less verbatim from g77. */ /* This file contains a filter for the main `gcc' driver, which is replicated for the `gfortran' driver by adding this filter. The purpose *************** Boston, MA 02111-1307, USA. */ *** 51,56 **** --- 51,57 ---- #include "coretypes.h" #include "tm.h" + #include "intl.h" #ifndef MATH_LIBRARY #define MATH_LIBRARY "-lm" *************** lang_specific_driver (int *in_argc, cons *** 345,359 **** break; case OPTION_version: ! printf ("\ ! GNU Fortran 95 (GCC %s)\n\ ! Copyright (C) 2005 Free Software Foundation, Inc.\n\ ! \n\ ! GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\ You may redistribute copies of GNU Fortran\n\ under the terms of the GNU General Public License.\n\ ! For more information about these matters, see the file named COPYING\n\ ! ", version_string); exit (0); break; --- 346,358 ---- break; case OPTION_version: ! printf ("GNU Fortran 95 (GCC) %s\n", version_string); ! printf ("Copyright %s 2006 Free Software Foundation, Inc.\n\n", ! _("(C)")); ! printf (_("GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\ You may redistribute copies of GNU Fortran\n\ under the terms of the GNU General Public License.\n\ ! For more information about these matters, see the file named COPYING\n\n")); exit (0); break; *************** For more information about these matters *** 528,534 **** if (verbose && g77_newargv != g77_xargv) { ! fprintf (stderr, "Driving:"); for (i = 0; i < g77_newargc; i++) fprintf (stderr, " %s", g77_newargv[i]); fprintf (stderr, "\n"); --- 527,533 ---- if (verbose && g77_newargv != g77_xargv) { ! fprintf (stderr, _("Driving:")); for (i = 0; i < g77_newargc; i++) fprintf (stderr, " %s", g77_newargv[i]); fprintf (stderr, "\n"); diff -Nrcpad gcc-4.0.2/gcc/fortran/interface.c gcc-4.1.0/gcc/fortran/interface.c *** gcc-4.0.2/gcc/fortran/interface.c Wed Apr 27 15:42:34 2005 --- gcc-4.1.0/gcc/fortran/interface.c Mon Feb 13 19:32:02 2006 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Deal with interfaces. An explicit interface is represented as a --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Deal with interfaces. An explicit interface is represented as a *************** Software Foundation, 59 Temple Place - S *** 41,47 **** Generic interfaces: The generic name points to a linked list of symbols. Each symbol ! has an explicit interface. Each explicit interface has it's own namespace containing the arguments. Module procedures are symbols in which the interface is added later when the module procedure is parsed. --- 41,47 ---- Generic interfaces: The generic name points to a linked list of symbols. Each symbol ! has an explicit interface. Each explicit interface has its own namespace containing the arguments. Module procedures are symbols in which the interface is added later when the module procedure is parsed. *************** gfc_match_end_interface (void) *** 295,304 **** /* Comparing the symbol node names is OK because only use-associated symbols can be renamed. */ if (type != current_interface.type ! || strcmp (current_interface.sym->name, name) != 0) { gfc_error ("Expecting 'END INTERFACE OPERATOR (.%s.)' at %C", ! current_interface.sym->name); m = MATCH_ERROR; } --- 295,304 ---- /* Comparing the symbol node names is OK because only use-associated symbols can be renamed. */ if (type != current_interface.type ! || strcmp (current_interface.uop->name, name) != 0) { gfc_error ("Expecting 'END INTERFACE OPERATOR (.%s.)' at %C", ! current_interface.uop->name); m = MATCH_ERROR; } *************** gfc_match_end_interface (void) *** 320,362 **** } ! /* Compare two typespecs, recursively if necessary. */ int ! gfc_compare_types (gfc_typespec * ts1, gfc_typespec * ts2) { gfc_component *dt1, *dt2; - if (ts1->type != ts2->type) - return 0; - if (ts1->type != BT_DERIVED) - return (ts1->kind == ts2->kind); - - /* Compare derived types. */ - if (ts1->derived == ts2->derived) - return 1; - /* Special case for comparing derived types across namespaces. If the true names and module names are the same and the module name is nonnull, then they are equal. */ ! if (strcmp (ts1->derived->name, ts2->derived->name) == 0 ! && ((ts1->derived->module == NULL && ts2->derived->module == NULL) ! || (ts1->derived != NULL && ts2->derived != NULL ! && strcmp (ts1->derived->module, ts2->derived->module) == 0))) return 1; /* Compare type via the rules of the standard. Both types must have the SEQUENCE attribute to be equal. */ ! if (strcmp (ts1->derived->name, ts2->derived->name)) return 0; ! dt1 = ts1->derived->components; ! dt2 = ts2->derived->components; ! if (ts1->derived->attr.sequence == 0 || ts2->derived->attr.sequence == 0) return 0; /* Since subtypes of SEQUENCE types must be SEQUENCE types as well, a simple test can speed things up. Otherwise, lots of things have to match. */ --- 320,358 ---- } ! /* Compare two derived types using the criteria in 4.4.2 of the standard, ! recursing through gfc_compare_types for the components. */ int ! gfc_compare_derived_types (gfc_symbol * derived1, gfc_symbol * derived2) { gfc_component *dt1, *dt2; /* Special case for comparing derived types across namespaces. If the true names and module names are the same and the module name is nonnull, then they are equal. */ ! if (strcmp (derived1->name, derived2->name) == 0 ! && derived1 != NULL && derived2 != NULL ! && derived1->module != NULL && derived2->module != NULL ! && strcmp (derived1->module, derived2->module) == 0) return 1; /* Compare type via the rules of the standard. Both types must have the SEQUENCE attribute to be equal. */ ! if (strcmp (derived1->name, derived2->name)) return 0; ! if (derived1->component_access == ACCESS_PRIVATE ! || derived2->component_access == ACCESS_PRIVATE) ! return 0; ! if (derived1->attr.sequence == 0 || derived2->attr.sequence == 0) return 0; + dt1 = derived1->components; + dt2 = derived2->components; + /* Since subtypes of SEQUENCE types must be SEQUENCE types as well, a simple test can speed things up. Otherwise, lots of things have to match. */ *************** gfc_compare_types (gfc_typespec * ts1, g *** 389,394 **** --- 385,408 ---- return 1; } + /* Compare two typespecs, recursively if necessary. */ + + int + gfc_compare_types (gfc_typespec * ts1, gfc_typespec * ts2) + { + + if (ts1->type != ts2->type) + return 0; + if (ts1->type != BT_DERIVED) + return (ts1->kind == ts2->kind); + + /* Compare derived types. */ + if (ts1->derived == ts2->derived) + return 1; + + return gfc_compare_derived_types (ts1->derived ,ts2->derived); + } + /* Given two symbols that are formal arguments, compare their ranks and types. Returns nonzero if they have the same rank and type, *************** operator_correspondence (gfc_formal_argl *** 763,769 **** /* Perform the correspondence test in rule 2 of section 14.1.2.3. ! Returns zero if no argument is found that satisifes rule 2, nonzero otherwise. This test is also not symmetric in f1 and f2 and must be called --- 777,783 ---- /* Perform the correspondence test in rule 2 of section 14.1.2.3. ! Returns zero if no argument is found that satisfies rule 2, nonzero otherwise. This test is also not symmetric in f1 and f2 and must be called *************** check_interface1 (gfc_interface * p, gfc *** 926,933 **** if (p->sym == q->sym) continue; /* Duplicates OK here */ ! if (strcmp (p->sym->name, q->sym->name) == 0 ! && strcmp (p->sym->module, q->sym->module) == 0) continue; if (compare_interfaces (p->sym, q->sym, generic_flag)) --- 940,946 ---- if (p->sym == q->sym) continue; /* Duplicates OK here */ ! if (p->sym->name == q->sym->name && p->sym->module == q->sym->module) continue; if (compare_interfaces (p->sym, q->sym, generic_flag)) *************** compare_actual_formal (gfc_actual_arglis *** 1228,1234 **** } if (!compare_parameter ! (f->sym, a->expr, ranks_must_agree, is_elemental)) { if (where) gfc_error ("Type/rank mismatch in argument '%s' at %L", --- 1241,1250 ---- } if (!compare_parameter ! (f->sym, a->expr, ! ranks_must_agree && f->sym->as ! && f->sym->as->type == AS_ASSUMED_SHAPE, ! is_elemental)) { if (where) gfc_error ("Type/rank mismatch in argument '%s' at %L", *************** compare_actual_formal (gfc_actual_arglis *** 1236,1241 **** --- 1252,1272 ---- return 0; } + if (f->sym->as + && f->sym->as->type == AS_ASSUMED_SHAPE + && a->expr->expr_type == EXPR_VARIABLE + && a->expr->symtree->n.sym->as + && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE + && (a->expr->ref == NULL + || (a->expr->ref->type == REF_ARRAY + && a->expr->ref->u.ar.type == AR_FULL))) + { + if (where) + gfc_error ("Actual argument for '%s' cannot be an assumed-size" + " array at %L", f->sym->name, where); + return 0; + } + if (a->expr->expr_type != EXPR_NULL && compare_pointer (f->sym, a->expr) == 0) { *************** compare_actual_formal (gfc_actual_arglis *** 1245,1250 **** --- 1276,1291 ---- return 0; } + /* Check intent = OUT/INOUT for definable actual argument. */ + if (a->expr->expr_type != EXPR_VARIABLE + && (f->sym->attr.intent == INTENT_OUT + || f->sym->attr.intent == INTENT_INOUT)) + { + gfc_error ("Actual argument at %L must be definable to " + "match dummy INTENT = OUT/INOUT", &a->expr->where); + return 0; + } + match: if (a == actual) na = i; *************** check_intents (gfc_formal_arglist * f, g *** 1525,1530 **** --- 1566,1575 ---- void gfc_procedure_use (gfc_symbol * sym, gfc_actual_arglist ** ap, locus * where) { + int ranks_must_agree; + ranks_must_agree = !sym->attr.elemental && (sym->attr.contained + || sym->attr.if_source == IFSRC_IFBODY); + /* Warn about calls with an implicit interface. */ if (gfc_option.warn_implicit_interface && sym->attr.if_source == IFSRC_UNKNOWN) *************** gfc_procedure_use (gfc_symbol * sym, gfc *** 1532,1539 **** sym->name, where); if (sym->attr.if_source == IFSRC_UNKNOWN ! || !compare_actual_formal (ap, sym->formal, 0, ! sym->attr.elemental, where)) return; check_intents (sym->formal, *ap); --- 1577,1584 ---- sym->name, where); if (sym->attr.if_source == IFSRC_UNKNOWN ! || !compare_actual_formal (ap, sym->formal, ranks_must_agree, ! sym->attr.elemental, where)) return; check_intents (sym->formal, *ap); *************** gfc_extend_expr (gfc_expr * e) *** 1690,1695 **** --- 1735,1741 ---- e->value.function.actual = actual; e->value.function.esym = NULL; e->value.function.isym = NULL; + e->value.function.name = NULL; if (gfc_pure (NULL) && !gfc_pure (sym)) { *************** gfc_extend_assign (gfc_code * c, gfc_nam *** 1757,1769 **** c->expr2 = NULL; c->ext.actual = actual; - if (gfc_pure (NULL) && !gfc_pure (sym)) - { - gfc_error ("Subroutine '%s' called in lieu of assignment at %L must be " - "PURE", sym->name, &c->loc); - return FAILURE; - } - return SUCCESS; } --- 1803,1808 ---- diff -Nrcpad gcc-4.0.2/gcc/fortran/intrinsic.c gcc-4.1.0/gcc/fortran/intrinsic.c *** gcc-4.0.2/gcc/fortran/intrinsic.c Tue Aug 9 17:44:02 2005 --- gcc-4.1.0/gcc/fortran/intrinsic.c Mon Feb 20 20:06:49 2006 *************** for more details. *** 18,25 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 18,25 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** find_sym (gfc_intrinsic_sym * start, int *** 711,718 **** gfc_intrinsic_sym * gfc_find_function (const char *name) { ! return find_sym (functions, nfunc, name); } --- 711,723 ---- gfc_intrinsic_sym * gfc_find_function (const char *name) { + gfc_intrinsic_sym *sym; ! sym = find_sym (functions, nfunc, name); ! if (!sym) ! sym = find_sym (conversion, nconv, name); ! ! return sym; } *************** make_alias (const char *name, int standa *** 843,848 **** --- 848,861 ---- } } + /* Make the current subroutine noreturn. */ + + static void + make_noreturn(void) + { + if (sizing == SZ_NOTHING) + next_sym[-1].noreturn = 1; + } /* Add intrinsic functions. */ *************** add_functions (void) *** 863,869 **** *s = "s", *dm = "dim", *kind = "kind", *msk = "mask", *x = "x", *sh = "shift", *stg = "string", *ssg = "substring", *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b", ! *z = "z", *ln = "len", *ut = "unit"; int di, dr, dd, dl, dc, dz, ii; --- 876,883 ---- *s = "s", *dm = "dim", *kind = "kind", *msk = "mask", *x = "x", *sh = "shift", *stg = "string", *ssg = "substring", *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b", ! *z = "z", *ln = "len", *ut = "unit", *han = "handler", ! *num = "number", *tm = "time"; int di, dr, dd, dl, dc, dz, ii; *************** add_functions (void) *** 915,920 **** --- 929,944 ---- make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77); + add_sym_1 ("acosh", 1, 1, BT_REAL, dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_acosh, gfc_resolve_acosh, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dacosh", 1, 1, BT_REAL, dd, GFC_STD_GNU, + NULL, gfc_simplify_acosh, gfc_resolve_acosh, + x, BT_REAL, dd, REQUIRED); + + make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_GNU); + add_sym_1 ("adjustl", 1, 1, BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl, NULL, stg, BT_CHARACTER, dc, REQUIRED); *************** add_functions (void) *** 931,940 **** --- 955,968 ---- gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag, z, BT_COMPLEX, dz, REQUIRED); + make_alias ("imag", GFC_STD_GNU); + make_alias ("imagpart", GFC_STD_GNU); + add_sym_1 ("dimag", 1, 1, BT_REAL, dd, GFC_STD_GNU, NULL, gfc_simplify_aimag, gfc_resolve_aimag, z, BT_COMPLEX, dd, REQUIRED); + make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77); add_sym_2 ("aint", 1, 1, BT_REAL, dr, GFC_STD_F77, *************** add_functions (void) *** 984,989 **** --- 1012,1027 ---- x, BT_REAL, dd, REQUIRED); make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77); + + add_sym_1 ("asinh", 1, 1, BT_REAL, dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_asinh, gfc_resolve_asinh, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dasinh", 1, 1, BT_REAL, dd, GFC_STD_GNU, + NULL, gfc_simplify_asinh, gfc_resolve_asinh, + x, BT_REAL, dd, REQUIRED); + + make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_GNU); add_sym_2 ("associated", 0, 1, BT_LOGICAL, dl, GFC_STD_F95, gfc_check_associated, NULL, NULL, *************** add_functions (void) *** 1000,1005 **** --- 1038,1053 ---- x, BT_REAL, dd, REQUIRED); make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77); + + add_sym_1 ("atanh", 1, 1, BT_REAL, dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_atanh, gfc_resolve_atanh, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("datanh", 1, 1, BT_REAL, dd, GFC_STD_GNU, + NULL, gfc_simplify_atanh, gfc_resolve_atanh, + x, BT_REAL, dd, REQUIRED); + + make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_GNU); add_sym_2 ("atan2", 1, 1, BT_REAL, dr, GFC_STD_F77, gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2, *************** add_functions (void) *** 1010,1016 **** y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED); make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77); ! /* Bessel and Neumann functions for G77 compatibility. */ add_sym_1 ("besj0", 1, 0, BT_REAL, dr, GFC_STD_GNU, gfc_check_g77_math1, NULL, gfc_resolve_g77_math1, --- 1058,1064 ---- y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED); make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77); ! /* Bessel and Neumann functions for G77 compatibility. */ add_sym_1 ("besj0", 1, 0, BT_REAL, dr, GFC_STD_GNU, gfc_check_g77_math1, NULL, gfc_resolve_g77_math1, *************** add_functions (void) *** 1109,1114 **** --- 1157,1168 ---- make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77); + add_sym_2 ("complex", 1, 1, BT_COMPLEX, dz, GFC_STD_GNU, + gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex, + x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED); + + make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU); + /* Making dcmplx a specific of cmplx causes cmplx to return a double complex instead of the default complex. */ *************** add_functions (void) *** 1171,1176 **** --- 1225,1236 ---- make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95); + add_sym_1 ("ctime", 0, 1, BT_CHARACTER, 0, GFC_STD_GNU, + gfc_check_ctime, NULL, gfc_resolve_ctime, + tm, BT_INTEGER, di, REQUIRED); + + make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU); + add_sym_1 ("dble", 1, 1, BT_REAL, dd, GFC_STD_F77, gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble, a, BT_REAL, dr, REQUIRED); *************** add_functions (void) *** 1286,1291 **** --- 1346,1356 ---- make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95); + add_sym_0 ("fdate", 1, 0, BT_CHARACTER, dc, GFC_STD_GNU, + NULL, NULL, gfc_resolve_fdate); + + make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU); + add_sym_2 ("floor", 1, 1, BT_INTEGER, di, GFC_STD_F95, gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor, a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL); *************** add_functions (void) *** 1311,1316 **** --- 1376,1411 ---- make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU); + add_sym_1 ("ftell", 0, 1, BT_INTEGER, ii, GFC_STD_GNU, + gfc_check_ftell, NULL, gfc_resolve_ftell, + ut, BT_INTEGER, di, REQUIRED); + + make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU); + + add_sym_2 ("fgetc", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_fgetputc, NULL, gfc_resolve_fgetc, + ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED); + + make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU); + + add_sym_1 ("fget", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_fgetput, NULL, gfc_resolve_fget, + c, BT_CHARACTER, dc, REQUIRED); + + make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU); + + add_sym_2 ("fputc", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_fgetputc, NULL, gfc_resolve_fputc, + ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED); + + make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU); + + add_sym_1 ("fput", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_fgetput, NULL, gfc_resolve_fput, + c, BT_CHARACTER, dc, REQUIRED); + + make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU); + /* Unix IDs (g77 compatibility) */ add_sym_1 ("getcwd", 0, 1, BT_INTEGER, di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getcwd, *************** add_functions (void) *** 1357,1362 **** --- 1452,1463 ---- make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95); + add_sym_2 ("and", 1, 0, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_and, gfc_simplify_and, gfc_resolve_and, + i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED); + + make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU); + add_sym_0 ("iargc", 1, 1, BT_INTEGER, di, GFC_STD_GNU, NULL, NULL, NULL); *************** add_functions (void) *** 1399,1404 **** --- 1500,1511 ---- make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95); + add_sym_2 ("xor", 1, 0, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_and, gfc_simplify_xor, gfc_resolve_xor, + i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED); + + make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU); + add_sym_0 ("ierrno", 1, 0, BT_INTEGER, di, GFC_STD_GNU, NULL, NULL, gfc_resolve_ierrno); *************** add_functions (void) *** 1431,1436 **** --- 1538,1549 ---- make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95); + add_sym_2 ("or", 1, 0, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_and, gfc_simplify_or, gfc_resolve_or, + i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED); + + make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU); + /* The following function is for G77 compatibility. */ add_sym_1 ("irand", 0, 1, BT_INTEGER, 4, GFC_STD_GNU, gfc_check_irand, NULL, NULL, *************** add_functions (void) *** 1563,1568 **** --- 1676,1686 ---- make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95); + add_sym_1 ("malloc", 0, 1, BT_INTEGER, ii, GFC_STD_GNU, gfc_check_malloc, + NULL, gfc_resolve_malloc, a, BT_INTEGER, di, REQUIRED); + + make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU); + add_sym_2 ("matmul", 0, 1, BT_REAL, dr, GFC_STD_F95, gfc_check_matmul, NULL, gfc_resolve_matmul, ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED); *************** add_functions (void) *** 1775,1780 **** --- 1893,1903 ---- gfc_check_real, gfc_simplify_real, gfc_resolve_real, a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL); + /* This provides compatibility with g77. */ + add_sym_1 ("realpart", 1, 0, BT_REAL, dr, GFC_STD_GNU, + gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart, + a, BT_UNKNOWN, dr, REQUIRED); + add_sym_1 ("float", 1, 0, BT_REAL, dr, GFC_STD_F77, NULL, gfc_simplify_float, NULL, a, BT_INTEGER, di, REQUIRED); *************** add_functions (void) *** 1829,1834 **** --- 1952,1964 ---- make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU); + /* Added for G77 compatibility. */ + add_sym_1 ("secnds", 0, 1, BT_REAL, dr, GFC_STD_GNU, + gfc_check_secnds, NULL, gfc_resolve_secnds, + x, BT_REAL, dr, REQUIRED); + + make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU); + add_sym_1 ("selected_int_kind", 0, 1, BT_INTEGER, di, GFC_STD_F95, gfc_check_selected_int_kind, gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED); *************** add_functions (void) *** 1869,1874 **** --- 1999,2010 ---- make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77); + add_sym_2 ("signal", 1, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_signal, NULL, gfc_resolve_signal, + num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED); + + make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU); + add_sym_1 ("sin", 1, 1, BT_REAL, dr, GFC_STD_F77, gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin, x, BT_REAL, dr, REQUIRED); *************** add_functions (void) *** 2018,2023 **** --- 2154,2165 ---- make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95); + add_sym_1 ("ttynam", 0, 1, BT_CHARACTER, 0, GFC_STD_GNU, + gfc_check_ttynam, NULL, gfc_resolve_ttynam, + ut, BT_INTEGER, di, REQUIRED); + + make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU); + add_sym_2 ("ubound", 0, 1, BT_INTEGER, di, GFC_STD_F95, gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound, ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL); *************** add_functions (void) *** 2051,2056 **** --- 2193,2205 ---- bck, BT_LOGICAL, dl, OPTIONAL); make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95); + + add_sym_1 ("loc", 0, 1, BT_INTEGER, ii, GFC_STD_GNU, + gfc_check_loc, NULL, gfc_resolve_loc, + ar, BT_UNKNOWN, 0, REQUIRED); + + make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU); + } *************** add_subroutines (void) *** 2067,2088 **** *f = "from", *sz = "size", *ln = "len", *cr = "count_rate", *com = "command", *length = "length", *st = "status", *val = "value", *num = "number", *name = "name", ! *trim_name = "trim_name", *ut = "unit"; ! int di, dr, dc, dl; di = gfc_default_integer_kind; dr = gfc_default_real_kind; dc = gfc_default_character_kind; dl = gfc_default_logical_kind; add_sym_0s ("abort", 1, GFC_STD_GNU, NULL); add_sym_1s ("cpu_time", 0, 1, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time, tm, BT_REAL, dr, REQUIRED); /* More G77 compatibility garbage. */ add_sym_1s ("second", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub, tm, BT_REAL, dr, REQUIRED); --- 2216,2245 ---- *f = "from", *sz = "size", *ln = "len", *cr = "count_rate", *com = "command", *length = "length", *st = "status", *val = "value", *num = "number", *name = "name", ! *trim_name = "trim_name", *ut = "unit", *han = "handler", ! *sec = "seconds", *res = "result", *of = "offset"; ! int di, dr, dc, dl, ii; di = gfc_default_integer_kind; dr = gfc_default_real_kind; dc = gfc_default_character_kind; dl = gfc_default_logical_kind; + ii = gfc_index_integer_kind; add_sym_0s ("abort", 1, GFC_STD_GNU, NULL); + make_noreturn(); + add_sym_1s ("cpu_time", 0, 1, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time, tm, BT_REAL, dr, REQUIRED); /* More G77 compatibility garbage. */ + add_sym_2s ("ctime", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub, + tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED); + add_sym_1s ("second", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub, tm, BT_REAL, dr, REQUIRED); *************** add_subroutines (void) *** 2105,2110 **** --- 2262,2271 ---- gfc_check_etime_sub, NULL, gfc_resolve_etime_sub, vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED); + add_sym_1s ("fdate", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub, + dt, BT_CHARACTER, dc, REQUIRED); + add_sym_1s ("gerror", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror, c, BT_CHARACTER, dc, REQUIRED); *************** add_subroutines (void) *** 2161,2166 **** --- 2322,2332 ---- gt, BT_INTEGER, di, OPTIONAL); /* More G77 compatibility garbage. */ + add_sym_3s ("alarm", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub, + sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED, + st, BT_INTEGER, di, OPTIONAL); + add_sym_1s ("srand", 0, 1, BT_UNKNOWN, di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand, c, BT_INTEGER, 4, REQUIRED); *************** add_subroutines (void) *** 2169,2178 **** --- 2335,2371 ---- gfc_check_exit, NULL, gfc_resolve_exit, c, BT_INTEGER, di, OPTIONAL); + make_noreturn(); + + add_sym_3s ("fgetc", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub, + ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED, + st, BT_INTEGER, di, OPTIONAL); + + add_sym_2s ("fget", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub, + c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + add_sym_1s ("flush", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_flush, NULL, gfc_resolve_flush, c, BT_INTEGER, di, OPTIONAL); + add_sym_3s ("fputc", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub, + ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED, + st, BT_INTEGER, di, OPTIONAL); + + add_sym_2s ("fput", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub, + c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + + add_sym_1s ("free", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free, + NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED); + + add_sym_2s ("ftell", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub, + ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED); + add_sym_2s ("hostnm", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub, c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL); *************** add_subroutines (void) *** 2209,2214 **** --- 2402,2412 ---- name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + add_sym_3s ("signal", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_signal_sub, NULL, gfc_resolve_signal_sub, + num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED, + st, BT_INTEGER, di, OPTIONAL); + add_sym_3s ("symlnk", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub, name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, *************** got_specific: *** 3063,3069 **** /* TODO: We should probably only allow elemental functions here. */ flag |= (expr->ts.type != BT_INTEGER && expr->ts.type != BT_CHARACTER); - gfc_suppress_error = 0; if (pedantic && gfc_init_expr && flag && gfc_init_expr_extensions (specific)) { --- 3261,3266 ---- *************** gfc_intrinsic_sub_interface (gfc_code * *** 3132,3137 **** --- 3329,3335 ---- return MATCH_ERROR; } + c->resolved_sym->attr.noreturn = isym->noreturn; check_intrinsic_standard (name, isym->standard, &c->loc); return MATCH_YES; *************** gfc_convert_type_warn (gfc_expr * expr, *** 3222,3227 **** --- 3420,3436 ---- new->rank = rank; new->shape = gfc_copy_shape (shape, rank); + gfc_get_ha_sym_tree (sym->name, &new->symtree); + new->symtree->n.sym->ts = *ts; + new->symtree->n.sym->attr.flavor = FL_PROCEDURE; + new->symtree->n.sym->attr.function = 1; + new->symtree->n.sym->attr.intrinsic = 1; + new->symtree->n.sym->attr.elemental = 1; + new->symtree->n.sym->attr.pure = 1; + new->symtree->n.sym->attr.referenced = 1; + gfc_intrinsic_symbol(new->symtree->n.sym); + gfc_commit_symbol (new->symtree->n.sym); + *expr = *new; gfc_free (new); diff -Nrcpad gcc-4.0.2/gcc/fortran/intrinsic.h gcc-4.1.0/gcc/fortran/intrinsic.h *** gcc-4.0.2/gcc/fortran/intrinsic.h Tue Aug 9 17:44:03 2005 --- gcc-4.1.0/gcc/fortran/intrinsic.h Sun Nov 13 09:33:19 2005 *************** for more details. *** 18,25 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Expression returned when simplification fails. */ --- 18,25 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Expression returned when simplification fails. */ *************** try gfc_check_btest (gfc_expr *, gfc_exp *** 42,56 **** --- 42,61 ---- try gfc_check_char (gfc_expr *, gfc_expr *); try gfc_check_chdir (gfc_expr *); try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *); + try gfc_check_complex (gfc_expr *, gfc_expr *); try gfc_check_count (gfc_expr *, gfc_expr *); try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *); + try gfc_check_ctime (gfc_expr *); try gfc_check_dcmplx (gfc_expr *, gfc_expr *); try gfc_check_dble (gfc_expr *); try gfc_check_digits (gfc_expr *); try gfc_check_dot_product (gfc_expr *, gfc_expr *); try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_etime (gfc_expr *); + try gfc_check_fgetputc (gfc_expr *, gfc_expr *); + try gfc_check_fgetput (gfc_expr *); try gfc_check_fstat (gfc_expr *, gfc_expr *); + try gfc_check_ftell (gfc_expr *); try gfc_check_fn_c (gfc_expr *); try gfc_check_fn_r (gfc_expr *); try gfc_check_fn_rc (gfc_expr *); *************** try gfc_check_hostnm (gfc_expr *); *** 60,65 **** --- 65,71 ---- try gfc_check_huge (gfc_expr *); try gfc_check_i (gfc_expr *); try gfc_check_iand (gfc_expr *, gfc_expr *); + try gfc_check_and (gfc_expr *, gfc_expr *); try gfc_check_ibclr (gfc_expr *, gfc_expr *); try gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_ibset (gfc_expr *, gfc_expr *); *************** try gfc_check_kill (gfc_expr *, gfc_expr *** 77,87 **** --- 83,95 ---- try gfc_check_kind (gfc_expr *); try gfc_check_lbound (gfc_expr *, gfc_expr *); try gfc_check_link (gfc_expr *, gfc_expr *); + try gfc_check_loc (gfc_expr *); try gfc_check_logical (gfc_expr *, gfc_expr *); try gfc_check_min_max (gfc_actual_arglist *); try gfc_check_min_max_integer (gfc_actual_arglist *); try gfc_check_min_max_real (gfc_actual_arglist *); try gfc_check_min_max_double (gfc_actual_arglist *); + try gfc_check_malloc (gfc_expr *); try gfc_check_matmul (gfc_expr *, gfc_expr *); try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_minloc_maxloc (gfc_actual_arglist *); *************** try gfc_check_reshape (gfc_expr *, gfc_e *** 102,113 **** --- 110,123 ---- try gfc_check_scale (gfc_expr *, gfc_expr *); try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_second_sub (gfc_expr *); + try gfc_check_secnds (gfc_expr *); try gfc_check_selected_int_kind (gfc_expr *); try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *); try gfc_check_set_exponent (gfc_expr *, gfc_expr *); try gfc_check_shape (gfc_expr *); try gfc_check_size (gfc_expr *, gfc_expr *); try gfc_check_sign (gfc_expr *, gfc_expr *); + try gfc_check_signal (gfc_expr *, gfc_expr *); try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_srand (gfc_expr *); try gfc_check_stat (gfc_expr *, gfc_expr *); *************** try gfc_check_symlnk (gfc_expr *, gfc_ex *** 116,121 **** --- 126,132 ---- try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_transpose (gfc_expr *); try gfc_check_trim (gfc_expr *); + try gfc_check_ttynam (gfc_expr *); try gfc_check_ubound (gfc_expr *, gfc_expr *); try gfc_check_umask (gfc_expr *); try gfc_check_unlink (gfc_expr *); *************** try gfc_check_x (gfc_expr *); *** 125,136 **** --- 136,151 ---- /* Intrinsic subroutines. */ + try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_chdir_sub (gfc_expr *, gfc_expr *); try gfc_check_cpu_time (gfc_expr *); + try gfc_check_ctime_sub (gfc_expr *, gfc_expr *); try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_exit (gfc_expr *); + try gfc_check_fdate_sub (gfc_expr *); try gfc_check_flush (gfc_expr *); + try gfc_check_free (gfc_expr *); try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_gerror (gfc_expr *); try gfc_check_getlog (gfc_expr *); *************** try gfc_check_mvbits (gfc_expr *, gfc_ex *** 139,144 **** --- 154,162 ---- try gfc_check_random_number (gfc_expr *); try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_etime_sub (gfc_expr *, gfc_expr *); + try gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *); + try gfc_check_fgetput_sub (gfc_expr *, gfc_expr *); + try gfc_check_ftell_sub (gfc_expr *, gfc_expr *); try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *); try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *); try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *); *************** try gfc_check_perror (gfc_expr *); *** 146,151 **** --- 164,170 ---- try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *); + try gfc_check_signal_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_sleep_sub (gfc_expr *); try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_system_sub (gfc_expr *, gfc_expr *); *************** try gfc_check_unlink_sub (gfc_expr *, gf *** 158,163 **** --- 177,183 ---- gfc_expr *gfc_simplify_abs (gfc_expr *); gfc_expr *gfc_simplify_achar (gfc_expr *); gfc_expr *gfc_simplify_acos (gfc_expr *); + gfc_expr *gfc_simplify_acosh (gfc_expr *); gfc_expr *gfc_simplify_adjustl (gfc_expr *); gfc_expr *gfc_simplify_adjustr (gfc_expr *); gfc_expr *gfc_simplify_aimag (gfc_expr *); *************** gfc_expr *gfc_simplify_aint (gfc_expr *, *** 165,178 **** --- 185,202 ---- gfc_expr *gfc_simplify_dint (gfc_expr *); gfc_expr *gfc_simplify_anint (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_dnint (gfc_expr *); + gfc_expr *gfc_simplify_and (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_asin (gfc_expr *); + gfc_expr *gfc_simplify_asinh (gfc_expr *); gfc_expr *gfc_simplify_atan (gfc_expr *); + gfc_expr *gfc_simplify_atanh (gfc_expr *); gfc_expr *gfc_simplify_atan2 (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_bit_size (gfc_expr *); gfc_expr *gfc_simplify_btest (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ceiling (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_char (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_cmplx (gfc_expr *, gfc_expr *, gfc_expr *); + gfc_expr *gfc_simplify_complex (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_conjg (gfc_expr *); gfc_expr *gfc_simplify_cos (gfc_expr *); gfc_expr *gfc_simplify_cosh (gfc_expr *); *************** gfc_expr *gfc_simplify_nint (gfc_expr *, *** 226,235 **** --- 250,261 ---- gfc_expr *gfc_simplify_null (gfc_expr *); gfc_expr *gfc_simplify_idnint (gfc_expr *); gfc_expr *gfc_simplify_not (gfc_expr *); + gfc_expr *gfc_simplify_or (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_precision (gfc_expr *); gfc_expr *gfc_simplify_radix (gfc_expr *); gfc_expr *gfc_simplify_range (gfc_expr *); gfc_expr *gfc_simplify_real (gfc_expr *, gfc_expr *); + gfc_expr *gfc_simplify_realpart (gfc_expr *); gfc_expr *gfc_simplify_repeat (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); *************** gfc_expr *gfc_simplify_tiny (gfc_expr *) *** 253,258 **** --- 279,285 ---- gfc_expr *gfc_simplify_trim (gfc_expr *); gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_verify (gfc_expr *, gfc_expr *, gfc_expr *); + gfc_expr *gfc_simplify_xor (gfc_expr *, gfc_expr *); /* Constant conversion simplification. */ gfc_expr *gfc_convert_constant (gfc_expr *, bt, int); *************** gfc_expr *gfc_convert_constant (gfc_expr *** 261,275 **** --- 288,306 ---- /* Resolution functions. */ void gfc_resolve_abs (gfc_expr *, gfc_expr *); void gfc_resolve_acos (gfc_expr *, gfc_expr *); + void gfc_resolve_acosh (gfc_expr *, gfc_expr *); void gfc_resolve_aimag (gfc_expr *, gfc_expr *); void gfc_resolve_aint (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_dint (gfc_expr *, gfc_expr *); void gfc_resolve_all (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_anint (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_dnint (gfc_expr *, gfc_expr *); + void gfc_resolve_and (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_any (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_asin (gfc_expr *, gfc_expr *); + void gfc_resolve_asinh (gfc_expr *, gfc_expr *); void gfc_resolve_atan (gfc_expr *, gfc_expr *); + void gfc_resolve_atanh (gfc_expr *, gfc_expr *); void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *); *************** void gfc_resolve_char (gfc_expr *, gfc_e *** 278,288 **** --- 309,321 ---- void gfc_resolve_chdir (gfc_expr *, gfc_expr *); void gfc_resolve_cmplx (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_dcmplx (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_complex (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_conjg (gfc_expr *, gfc_expr *); void gfc_resolve_cos (gfc_expr *, gfc_expr *); void gfc_resolve_cosh (gfc_expr *, gfc_expr *); void gfc_resolve_count (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_cshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_ctime (gfc_expr *, gfc_expr *); void gfc_resolve_dble (gfc_expr *, gfc_expr *); void gfc_resolve_dim (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_dot_product (gfc_expr *, gfc_expr *, gfc_expr *); *************** void gfc_resolve_eoshift (gfc_expr *, gf *** 292,301 **** --- 325,340 ---- void gfc_resolve_etime_sub (gfc_code *); void gfc_resolve_exp (gfc_expr *, gfc_expr *); void gfc_resolve_exponent (gfc_expr *, gfc_expr *); + void gfc_resolve_fdate (gfc_expr *); void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_fnum (gfc_expr *, gfc_expr *); void gfc_resolve_fraction (gfc_expr *, gfc_expr *); void gfc_resolve_fstat (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_ftell (gfc_expr *, gfc_expr *); + void gfc_resolve_fgetc (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_fget (gfc_expr *, gfc_expr *); + void gfc_resolve_fputc (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_fput (gfc_expr *, gfc_expr *); void gfc_resolve_g77_math1 (gfc_expr *, gfc_expr *); void gfc_resolve_getcwd (gfc_expr *, gfc_expr *); void gfc_resolve_getgid (gfc_expr *); *************** void gfc_resolve_lbound (gfc_expr *, gfc *** 320,328 **** --- 359,369 ---- void gfc_resolve_len (gfc_expr *, gfc_expr *); void gfc_resolve_len_trim (gfc_expr *, gfc_expr *); void gfc_resolve_link (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_loc (gfc_expr *, gfc_expr *); void gfc_resolve_log (gfc_expr *, gfc_expr *); void gfc_resolve_log10 (gfc_expr *, gfc_expr *); void gfc_resolve_logical (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_malloc (gfc_expr *, gfc_expr *); void gfc_resolve_matmul (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_max (gfc_expr *, gfc_actual_arglist *); void gfc_resolve_maxloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); *************** void gfc_resolve_modulo (gfc_expr *, gfc *** 336,344 **** --- 377,387 ---- void gfc_resolve_nearest (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_nint (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_not (gfc_expr *, gfc_expr *); + void gfc_resolve_or (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_pack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_product (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_real (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_realpart (gfc_expr *, gfc_expr *); void gfc_resolve_rename (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_repeat (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, *************** void gfc_resolve_rrspacing (gfc_expr *, *** 347,355 **** --- 390,400 ---- void gfc_resolve_scale (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_second_sub (gfc_code *); + void gfc_resolve_secnds (gfc_expr *, gfc_expr *); void gfc_resolve_set_exponent (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_shape (gfc_expr *, gfc_expr *); void gfc_resolve_sign (gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_signal (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_sin (gfc_expr *, gfc_expr *); void gfc_resolve_sinh (gfc_expr *, gfc_expr *); void gfc_resolve_spacing (gfc_expr *, gfc_expr *); *************** void gfc_resolve_time8 (gfc_expr *); *** 367,385 **** --- 412,441 ---- void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_transpose (gfc_expr *, gfc_expr *); void gfc_resolve_trim (gfc_expr *, gfc_expr *); + void gfc_resolve_ttynam (gfc_expr *, gfc_expr *); void gfc_resolve_ubound (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_umask (gfc_expr *, gfc_expr *); void gfc_resolve_unlink (gfc_expr *, gfc_expr *); void gfc_resolve_unpack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); + void gfc_resolve_xor (gfc_expr *, gfc_expr *, gfc_expr *); /* Intrinsic subroutine resolution. */ + void gfc_resolve_alarm_sub (gfc_code *); void gfc_resolve_chdir_sub (gfc_code *); void gfc_resolve_cpu_time (gfc_code *); + void gfc_resolve_ctime_sub (gfc_code *); void gfc_resolve_exit (gfc_code *); + void gfc_resolve_fdate_sub (gfc_code *); void gfc_resolve_flush (gfc_code *); + void gfc_resolve_free (gfc_code *); void gfc_resolve_fstat_sub (gfc_code *); + void gfc_resolve_ftell_sub (gfc_code *); + void gfc_resolve_fgetc_sub (gfc_code *); + void gfc_resolve_fget_sub (gfc_code *); + void gfc_resolve_fputc_sub (gfc_code *); + void gfc_resolve_fput_sub (gfc_code *); void gfc_resolve_gerror (gfc_code *); void gfc_resolve_getarg (gfc_code *); void gfc_resolve_getcwd_sub (gfc_code *); *************** void gfc_resolve_random_number (gfc_code *** 395,400 **** --- 451,457 ---- void gfc_resolve_rename_sub (gfc_code *); void gfc_resolve_link_sub (gfc_code *); void gfc_resolve_symlnk_sub (gfc_code *); + void gfc_resolve_signal_sub (gfc_code *); void gfc_resolve_sleep_sub (gfc_code *); void gfc_resolve_stat_sub (gfc_code *); void gfc_resolve_system_clock (gfc_code *); diff -Nrcpad gcc-4.0.2/gcc/fortran/intrinsic.texi gcc-4.1.0/gcc/fortran/intrinsic.texi *** gcc-4.0.2/gcc/fortran/intrinsic.texi Mon Aug 1 05:28:11 2005 --- gcc-4.1.0/gcc/fortran/intrinsic.texi Sun Nov 6 10:17:04 2005 *************** and editing. All contributions and corr *** 41,46 **** --- 41,47 ---- * @code{ADJUSTR}: ADJUSTR, Right adjust a string * @code{AIMAG}: AIMAG, Imaginary part of complex number * @code{AINT}: AINT, Truncate to a whole number + * @code{ALARM}: ALARM, Set an alarm clock * @code{ALL}: ALL, Determine if all values are true * @code{ALLOCATED}: ALLOCATED, Status of allocatable entity * @code{ANINT}: ANINT, Nearest whole number *************** and editing. All contributions and corr *** 67,72 **** --- 68,74 ---- * @code{COUNT}: COUNT, Count occurrences of .TRUE. in an array * @code{CPU_TIME}: CPU_TIME, CPU time subroutine * @code{CSHIFT}: CSHIFT, Circular array shift function + * @code{CTIME}: CTIME, Subroutine (or function) to convert a time into a string * @code{DATE_AND_TIME}: DATE_AND_TIME, Date and time subroutine * @code{DBLE}: DBLE, Double precision conversion function * @code{DCMPLX}: DCMPLX, Double complex conversion function *************** and editing. All contributions and corr *** 85,97 **** * @code{EXIT}: EXIT, Exit the program with status. * @code{EXP}: EXP, Exponential function * @code{EXPONENT}: EXPONENT, Exponent function * @code{FLOOR}: FLOOR, Integer floor function * @code{FNUM}: FNUM, File number function * @code{LOG}: LOG, Logarithm function * @code{LOG10}: LOG10, Base 10 logarithm function ! * @code{SQRT}: SQRT, Square-root function * @code{SIN}: SIN, Sine function * @code{SINH}: SINH, Hyperbolic sine function * @code{TAN}: TAN, Tangent function * @code{TANH}: TANH, Hyperbolic tangent function @end menu --- 87,106 ---- * @code{EXIT}: EXIT, Exit the program with status. * @code{EXP}: EXP, Exponential function * @code{EXPONENT}: EXPONENT, Exponent function + * @code{FDATE}: FDATE, Subroutine (or function) to get the current time as a string * @code{FLOOR}: FLOOR, Integer floor function * @code{FNUM}: FNUM, File number function + * @code{FREE}: FREE, Memory de-allocation subroutine + * @code{LOC}: LOC, Returns the address of a variable * @code{LOG}: LOG, Logarithm function * @code{LOG10}: LOG10, Base 10 logarithm function ! * @code{MALLOC}: MALLOC, Dynamic memory allocation function ! * @code{REAL}: REAL, Convert to real type ! * @code{SECNDS}: SECNDS, Time function ! * @code{SIGNAL}: SIGNAL, Signal handling subroutine (or function) * @code{SIN}: SIN, Sine function * @code{SINH}: SINH, Hyperbolic sine function + * @code{SQRT}: SQRT, Square-root function * @code{TAN}: TAN, Tangent function * @code{TANH}: TANH, Hyperbolic tangent function @end menu *************** end program test_adjustr *** 402,412 **** --- 411,426 ---- @section @code{AIMAG} --- Imaginary part of complex number @findex @code{AIMAG} intrinsic @findex @code{DIMAG} intrinsic + @findex @code{IMAG} intrinsic + @findex @code{IMAGPART} intrinsic @cindex Imaginary part @table @asis @item @emph{Description}: @code{AIMAG(Z)} yields the imaginary part of complex argument @code{Z}. + The @code{IMAG(Z)} and @code{IMAGPART(Z)} intrinsic functions are provided + for compatibility with @command{g77}, and their use in new code is + strongly discouraged. @item @emph{Option}: f95, gnu *************** end program test_aimag *** 441,446 **** --- 455,462 ---- @multitable @columnfractions .24 .24 .24 .24 @item Name @tab Argument @tab Return type @tab Option @item @code{DIMAG(Z)} @tab @code{COMPLEX(8) Z} @tab @code{REAL(8)} @tab f95, gnu + @item @code{IMAG(Z)} @tab @code{COMPLEX(*) Z} @tab @code{REAL(*)} @tab gnu + @item @code{IMAGPART(Z)} @tab @code{COMPLEX(*) Z} @tab @code{REAL(*)} @tab gnu @end multitable @end table *************** end program test_aint *** 503,508 **** --- 519,574 ---- + @node ALARM + @section @code{ALARM} --- Execute a routine after a given delay + @findex @code{ALARM} intrinsic + + @table @asis + @item @emph{Description}: + @code{ALARM(SECONDS [, STATUS])} causes external subroutine @var{HANDLER} + to be executed after a delay of @var{SECONDS} by using @code{alarm(1)} to + set up a signal and @code{signal(2)} to catch it. If @var{STATUS} is + supplied, it will be returned with the number of seconds remaining until + any previously scheduled alarm was due to be delivered, or zero if there + was no previously scheduled alarm. + + @item @emph{Option}: + gnu + + @item @emph{Class}: + subroutine + + @item @emph{Syntax}: + @code{CALL ALARM(SECONDS, HANDLER)} + @code{CALL ALARM(SECONDS, HANDLER, STATUS)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item @var{SECONDS} @tab The type of the argument shall be a scalar + @code{INTEGER}. It is @code{INTENT(IN)}. + @item @var{HANDLER} @tab Signal handler (@code{INTEGER FUNCTION} or + @code{SUBROUTINE}) or dummy/global @code{INTEGER} scalar. + @code{INTEGER}. It is @code{INTENT(IN)}. + @item @var{STATUS} @tab (Optional) @var{STATUS} shall be a scalar + @code{INTEGER} variable. It is @code{INTENT(OUT)}. + @end multitable + + @item @emph{Example}: + @smallexample + program test_alarm + external handler_print + integer i + call alarm (3, handler_print, i) + print *, i + call sleep(10) + end program test_alarm + @end smallexample + This will cause the external routine @var{handler_print} to be called + after 3 seconds. + @end table + + + @node ALL @section @code{ALL} --- All values in @var{MASK} along @var{DIM} are true @findex @code{ALL} intrinsic *************** subroutine *** 1696,1702 **** @item @emph{Arguments}: @multitable @columnfractions .15 .80 ! @item @var{X} @tab The type shall be @code{REAL} with intent out. @end multitable @item @emph{Return value}: --- 1762,1768 ---- @item @emph{Arguments}: @multitable @columnfractions .15 .80 ! @item @var{X} @tab The type shall be @code{REAL} with @code{INTENT(OUT)}. @end multitable @item @emph{Return value}: *************** end program test_cshift *** 1769,1774 **** --- 1835,1892 ---- @end table + @node CTIME + @section @code{CTIME} --- Convert a time into a string + @findex @code{CTIME} intrinsic + @cindex ctime subroutine + + @table @asis + @item @emph{Description}: + @code{CTIME(T,S)} converts @var{T}, a system time value, such as returned + by @code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 + 1995}, and returns that string into @var{S}. + + If @code{CTIME} is invoked as a function, it can not be invoked as a + subroutine, and vice versa. + + @var{T} is an @code{INTENT(IN)} @code{INTEGER(KIND=8)} variable. + @var{S} is an @code{INTENT(OUT)} @code{CHARACTER} variable. + + @item @emph{Option}: + gnu + + @item @emph{Class}: + subroutine + + @item @emph{Syntax}: + @multitable @columnfractions .80 + @item @code{CALL CTIME(T,S)}. + @item @code{S = CTIME(T)}, (not recommended). + @end multitable + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item @var{S}@tab The type shall be of type @code{CHARACTER}. + @item @var{T}@tab The type shall be of type @code{INTEGER(KIND=8)}. + @end multitable + + @item @emph{Return value}: + The converted date and time as a string. + + @item @emph{Example}: + @smallexample + program test_ctime + integer(8) :: i + character(len=30) :: date + i = time8() + + ! Do something, main part of the program + + call ctime(i,date) + print *, 'Program was started on ', date + end program test_ctime + @end smallexample + @end table @node DATE_AND_TIME @section @code{DATE_AND_TIME} --- Date and time subroutine *************** end program test_exponent *** 2636,2641 **** --- 2754,2847 ---- @end table + @node FREE + @section @code{FREE} --- Frees memory + @findex @code{FREE} intrinsic + @cindex FREE + + @table @asis + @item @emph{Description}: + Frees memory previously allocated by @code{MALLOC()}. The @code{FREE} + intrinsic is an extension intended to be used with Cray pointers, and is + provided in @command{gfortran} to allow user to compile legacy code. For + new code using Fortran 95 pointers, the memory de-allocation intrinsic is + @code{DEALLOCATE}. + + @item @emph{Option}: + gnu + + @item @emph{Class}: + subroutine + + @item @emph{Syntax}: + @code{FREE(PTR)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item @var{PTR} @tab The type shall be @code{INTEGER}. It represents the + location of the memory that should be de-allocated. + @end multitable + + @item @emph{Return value}: + None + + @item @emph{Example}: + See @code{MALLOC} for an example. + @end table + + + @node FDATE + @section @code{FDATE} --- Get the current time as a string + @findex @code{FDATE} intrinsic + @cindex fdate subroutine + + @table @asis + @item @emph{Description}: + @code{FDATE(DATE)} returns the current date (using the same format as + @code{CTIME}) in @var{DATE}. It is equivalent to @code{CALL CTIME(DATE, + TIME8())}. + + If @code{FDATE} is invoked as a function, it can not be invoked as a + subroutine, and vice versa. + + @var{DATE} is an @code{INTENT(OUT)} @code{CHARACTER} variable. + + @item @emph{Option}: + gnu + + @item @emph{Class}: + subroutine + + @item @emph{Syntax}: + @multitable @columnfractions .80 + @item @code{CALL FDATE(DATE)}. + @item @code{DATE = FDATE()}, (not recommended). + @end multitable + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item @var{DATE}@tab The type shall be of type @code{CHARACTER}. + @end multitable + + @item @emph{Return value}: + The current date and time as a string. + + @item @emph{Example}: + @smallexample + program test_fdate + integer(8) :: i, j + character(len=30) :: date + call fdate(date) + print *, 'Program started on ', date + do i = 1, 100000000 ! Just a delay + j = i * i - i + end do + call fdate(date) + print *, 'Program ended on ', date + end program test_fdate + @end smallexample + @end table + @node FLOOR @section @code{FLOOR} --- Integer floor function *************** end program test_floor *** 2684,2690 **** @table @asis @item @emph{Description}: ! @code{FNUM(UNIT)} returns the Posix file descriptor number coresponding to the open Fortran I/O unit @code{UNIT}. @item @emph{Option}: --- 2890,2896 ---- @table @asis @item @emph{Description}: ! @code{FNUM(UNIT)} returns the Posix file descriptor number corresponding to the open Fortran I/O unit @code{UNIT}. @item @emph{Option}: *************** end program test_fnum *** 2716,2722 **** --- 2922,2964 ---- @end smallexample @end table + @node LOC + @section @code{LOC} --- Returns the address of a variable + @findex @code{LOC} intrinsic + @cindex loc + @table @asis + @item @emph{Description}: + @code{LOC(X)} returns the address of @var{X} as an integer. + + @item @emph{Option}: + gnu + + @item @emph{Class}: + inquiry function + + @item @emph{Syntax}: + @code{I = LOC(X)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item @var{X} @tab Variable of any type. + @end multitable + + @item @emph{Return value}: + The return value is of type @code{INTEGER(n)}, where @code{n} is the + size (in bytes) of a memory address on the target machine. + + @item @emph{Example}: + @smallexample + program test_loc + integer :: i + real :: r + i = loc(r) + print *, i + end program test_loc + @end smallexample + @end table @node LOG @section @code{LOG} --- Logarithm function *************** end program test_log10 *** 2821,2826 **** --- 3063,3295 ---- @end table + @node MALLOC + @section @code{MALLOC} --- Allocate dynamic memory + @findex @code{MALLOC} intrinsic + @cindex MALLOC + + @table @asis + @item @emph{Description}: + @code{MALLOC(SIZE)} allocates @var{SIZE} bytes of dynamic memory and + returns the address of the allocated memory. The @code{MALLOC} intrinsic + is an extension intended to be used with Cray pointers, and is provided + in @command{gfortran} to allow user to compile legacy code. For new code + using Fortran 95 pointers, the memory allocation intrinsic is + @code{ALLOCATE}. + + @item @emph{Option}: + gnu + + @item @emph{Class}: + non-elemental function + + @item @emph{Syntax}: + @code{PTR = MALLOC(SIZE)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item @var{SIZE} @tab The type shall be @code{INTEGER(*)}. + @end multitable + + @item @emph{Return value}: + The return value is of type @code{INTEGER(K)}, with @var{K} such that + variables of type @code{INTEGER(K)} have the same size as + C pointers (@code{sizeof(void *)}). + + @item @emph{Example}: + The following example demonstrates the use of @code{MALLOC} and + @code{FREE} with Cray pointers. This example is intended to run on + 32-bit systems, where the default integer kind is suitable to store + pointers; on 64-bit systems, ptr_x would need to be declared as + @code{integer(kind=8)}. + + @smallexample + program test_malloc + integer i + integer ptr_x + real*8 x(*), z + pointer(ptr_x,x) + + ptr_x = malloc(20*8) + do i = 1, 20 + x(i) = sqrt(1.0d0 / i) + end do + z = 0 + do i = 1, 20 + z = z + x(i) + print *, z + end do + call free(ptr_x) + end program test_malloc + @end smallexample + @end table + + + @node REAL + @section @code{REAL} --- Convert to real type + @findex @code{REAL} intrinsic + @findex @code{REALPART} intrinsic + @cindex true values + + @table @asis + @item @emph{Description}: + @code{REAL(X [, KIND])} converts its argument @var{X} to a real type. The + @code{REALPART(X)} function is provided for compatibility with @command{g77}, + and its use is strongly discouraged. + + @item @emph{Option}: + f95, gnu + + @item @emph{Class}: + transformational function + + @item @emph{Syntax}: + @multitable @columnfractions .30 .80 + @item @code{X = REAL(X)} + @item @code{X = REAL(X, KIND)} + @item @code{X = REALPART(Z)} + @end multitable + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item @var{X} @tab shall be @code{INTEGER(*)}, @code{REAL(*)}, or + @code{COMPLEX(*)}. + @item @var{KIND} @tab (Optional) @var{KIND} shall be a scalar integer. + @end multitable + + @item @emph{Return value}: + These functions return the a @code{REAL(*)} variable or array under + the following rules: + + @table @asis + @item (A) + @code{REAL(X)} is converted to a default real type if @var{X} is an + integer or real variable. + @item (B) + @code{REAL(X)} is converted to a real type with the kind type parameter + of @var{X} if @var{X} is a complex variable. + @item (C) + @code{REAL(X, KIND)} is converted to a real type with kind type + parameter @var{KIND} if @var{X} is a complex, integer, or real + variable. + @end table + + @item @emph{Example}: + @smallexample + program test_real + complex :: x = (1.0, 2.0) + print *, real(x), real(x,8), realpart(x) + end program test_real + @end smallexample + @end table + + + + @node SIGNAL + @section @code{SIGNAL} --- Signal handling subroutine (or function) + @findex @code{SIGNAL} intrinsic + @cindex SIGNAL subroutine + + @table @asis + @item @emph{Description}: + @code{SIGNAL(NUMBER, HANDLER [, STATUS])} causes external subroutine + @var{HANDLER} to be executed with a single integer argument when signal + @var{NUMBER} occurs. If @var{HANDLER} is an integer, it can be used to + turn off handling of signal @var{NUMBER} or revert to its default + action. See @code{signal(2)}. + + If @code{SIGNAL} is called as a subroutine and the @var{STATUS} argument + is supplied, it is set to the value returned by @code{signal(2)}. + + @item @emph{Option}: + gnu + + @item @emph{Class}: + subroutine, non-elemental function + + @item @emph{Syntax}: + @multitable @columnfractions .30 .80 + @item @code{CALL ALARM(NUMBER, HANDLER)} + @item @code{CALL ALARM(NUMBER, HANDLER, STATUS)} + @item @code{STATUS = ALARM(NUMBER, HANDLER)} + @end multitable + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item @var{NUMBER} @tab shall be a scalar integer, with @code{INTENT(IN)} + @item @var{HANDLER}@tab Signal handler (@code{INTEGER FUNCTION} or + @code{SUBROUTINE}) or dummy/global @code{INTEGER} scalar. + @code{INTEGER}. It is @code{INTENT(IN)}. + @item @var{STATUS} @tab (Optional) @var{STATUS} shall be a scalar + integer. It has @code{INTENT(OUT)}. + @end multitable + + @item @emph{Return value}: + The @code{SIGNAL} functions returns the value returned by @code{signal(2)}. + + @item @emph{Example}: + @smallexample + program test_signal + intrinsic signal + external handler_print + + call signal (12, handler_print) + call signal (10, 1) + + call sleep (30) + end program test_signal + @end smallexample + @end table + + + + + @node SECNDS + @section @code{SECNDS} --- Time subroutine + @findex @code{SECNDS} intrinsic + @cindex SECNDS + + @table @asis + @item @emph{Description}: + @code{SECNDS(X)} gets the time in seconds from the real-time system clock. + @var{X} is a reference time, also in seconds. If this is zero, the time in + seconds from midnight is returned. This function is non-standard and its + use is discouraged. + + @item @emph{Option}: + gnu + + @item @emph{Class}: + function + + @item @emph{Syntax}: + @code{T = SECNDS (X)} + + @item @emph{Arguments}: + @multitable @columnfractions .15 .80 + @item Name @tab Type + @item @var{T} @tab REAL(4) + @item @var{X} @tab REAL(4) + @end multitable + + @item @emph{Return value}: + None + + @item @emph{Example}: + @smallexample + program test_secnds + real(4) :: t1, t2 + print *, secnds (0.0) ! seconds since midnight + t1 = secnds (0.0) ! reference time + do i = 1, 10000000 ! do something + end do + t2 = secnds (t1) ! elapsed time + print *, "Something took ", t2, " seconds." + end program test_secnds + @end smallexample + @end table + + @node SIN @section @code{SIN} --- Sine function diff -Nrcpad gcc-4.0.2/gcc/fortran/invoke.texi gcc-4.1.0/gcc/fortran/invoke.texi *** gcc-4.0.2/gcc/fortran/invoke.texi Wed Aug 31 12:39:27 2005 --- gcc-4.1.0/gcc/fortran/invoke.texi Wed Feb 8 20:14:00 2006 *************** *** 1,11 **** ! @c Copyright (C) 2004,2005 @c Free Software Foundation, Inc. @c This is part of the GFORTRAN manual. @c For copying conditions, see the file gfortran.texi. @ignore @c man begin COPYRIGHT ! Copyright @copyright{} 2004 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document --- 1,11 ---- ! @c Copyright (C) 2004, 2005 @c Free Software Foundation, Inc. @c This is part of the GFORTRAN manual. @c For copying conditions, see the file gfortran.texi. @ignore @c man begin COPYRIGHT ! Copyright @copyright{} 2004, 2005 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document *************** GFORTRAN@. *** 69,87 **** The @command{gfortran} command supports all the options supported by the @command{gcc} command. Only options specific to gfortran are documented here. - @emph{Gfortran is not yet a fully conformant Fortran 95 compiler}. - It can generate code for most constructs and expressions, - but work remains to be done. In particular, there are known - deficiencies with ENTRY, NAMELIST, and sophisticated use of - MODULES, POINTERS and DERIVED TYPES. For those whose Fortran - codes conform to either the Fortran 77 standard or the - GNU Fortran 77 language, we recommend to use @command{g77} - from GCC 3.4. We recommend that distributors continue to provide - packages of g77-3.4 until we announce that @command{gfortran} - fully replaces @command{g77}. - The gfortran developers welcome any feedback on user experience - with @command{gfortran} at @email{fortran@@gcc.gnu.org}. - @xref{Invoking GCC,,GCC Command Options,gcc,Using the GNU Compiler Collection (GCC)}, for information on the non-Fortran-specific aspects of the @command{gcc} command (and, --- 69,74 ---- *************** one is not the default. *** 111,116 **** --- 98,104 ---- * Warning Options:: How picky should the compiler be? * Debugging Options:: Symbol tables, measurements, and debugging dumps. * Directory Options:: Where to find module files + * Runtime Options:: Influencing runtime behavior * Code Gen Options:: Specifying conventions for function calls, data layout and register usage. * Environment Variables:: Env vars that affect GNU Fortran. *************** by type. Explanations are in the follow *** 130,138 **** @gccoptlist{ -ffree-form -fno-fixed-form @gol -fdollar-ok -fimplicit-none -fmax-identifier-length @gol ! -std=@var{std} -ffixed-line-length-@var{n} -ffixed-line-length-none @gol ! -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 } @item Warning Options @xref{Warning Options,,Options to Request or Suppress Warnings}. --- 118,128 ---- @gccoptlist{ -ffree-form -fno-fixed-form @gol -fdollar-ok -fimplicit-none -fmax-identifier-length @gol ! -std=@var{std} -fd-lines-as-code -fd-lines-as-comments @gol -ffixed-line-length-@var{n} -ffixed-line-length-none @gol ! -ffree-line-length-@var{n} -ffree-line-length-none @gol ! -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol ! -fcray-pointer } @item Warning Options @xref{Warning Options,,Options to Request or Suppress Warnings}. *************** by type. Explanations are in the follow *** 140,164 **** -fsyntax-only -pedantic -pedantic-errors @gol -w -Wall -Waliasing -Wconversion @gol -Wimplicit-interface -Wnonstd-intrinsics -Wsurprising -Wunderflow @gol ! -Wunused-labels -Wline-truncation @gol ! -Werror -W} @item Debugging Options @xref{Debugging Options,,Options for Debugging Your Program or GCC}. @gccoptlist{ ! -fdump-parse-tree} @item Directory Options @xref{Directory Options,,Options for Directory Search}. @gccoptlist{ -I@var{dir} -M@var{dir}} @item Code Generation Options @xref{Code Gen Options,,Options for Code Generation Conventions}. @gccoptlist{ -fno-automatic -ff2c -fno-underscoring -fsecond-underscore @gol -fbounds-check -fmax-stack-var-size=@var{n} @gol ! -fpackderived -frepack-arrays} @end table @menu --- 130,158 ---- -fsyntax-only -pedantic -pedantic-errors @gol -w -Wall -Waliasing -Wconversion @gol -Wimplicit-interface -Wnonstd-intrinsics -Wsurprising -Wunderflow @gol ! -Wunused-labels -Wline-truncation -W} @item Debugging Options @xref{Debugging Options,,Options for Debugging Your Program or GCC}. @gccoptlist{ ! -fdump-parse-tree -ffpe-trap=@var{list}} @item Directory Options @xref{Directory Options,,Options for Directory Search}. @gccoptlist{ -I@var{dir} -M@var{dir}} + @item Runtime Options + @xref{Runtime Options,,Options for influencing runtime behavior}. + @gccoptlist{ + -fconvert=@var{conversion}} + @item Code Generation Options @xref{Code Gen Options,,Options for Code Generation Conventions}. @gccoptlist{ -fno-automatic -ff2c -fno-underscoring -fsecond-underscore @gol -fbounds-check -fmax-stack-var-size=@var{n} @gol ! -fpackderived -frepack-arrays -fshort-enums} @end table @menu *************** by type. Explanations are in the follow *** 167,172 **** --- 161,167 ---- * Warning Options:: How picky should the compiler be? * Debugging Options:: Symbol tables, measurements, and debugging dumps. * Directory Options:: Where to find module files + * Runtime Options:: Influencing runtime behavior * Code Gen Options:: Specifying conventions for function calls, data layout and register usage. @end menu *************** that the compiler accepts: *** 192,201 **** @cindex Fortran 90, features @item -ffree-form @item -ffixed-form ! Specify the layout used by the the source file. The free form layout was introduced in Fortran 90. Fixed form was traditionally used in older Fortran programs. @cindex option, -fdefault-double-8 @cindex -fdefault-double-8, option @item -fdefault-double-8 --- 187,208 ---- @cindex Fortran 90, features @item -ffree-form @item -ffixed-form ! Specify the layout used by the source file. The free form layout was introduced in Fortran 90. Fixed form was traditionally used in older Fortran programs. + @cindex option, -fd-lines-as-code + @cindex -fd-lines-as-code, option + @cindex option, -fd-lines-as-comments + @cindex -fd-lines-as-comments, option + @item -fd-lines-as-code + @item -fd-lines-as-comment + Enables special treating for lines with @samp{d} or @samp{D} in fixed + form sources. If the @option{-fd-lines-as-code} option is given + they are treated as if the first column contained a blank. If the + @option{-fd-lines-as-comments} option is given, they are treated as + comment lines. + @cindex option, -fdefault-double-8 @cindex -fdefault-double-8, option @item -fdefault-double-8 *************** Allow @samp{$} as a valid character in a *** 226,232 **** @item -fno-backslash @cindex backslash @cindex escape characters - @item Compile switch to change the interpretation of a backslash from ``C''-style escape characters to a single backslash character. --- 233,238 ---- *************** to them to fill out the line. *** 253,258 **** --- 259,278 ---- @option{-ffixed-line-length-0} means the same thing as @option{-ffixed-line-length-none}. + @cindex -ffree-line-length-@var{n} option + @cindex options, -ffree-line-length-@var{n} + @item -ffree-line-length-@var{n} + @cindex source file format + @cindex lines, length + @cindex length of source lines + @cindex free form + @cindex limits, lengths of source lines + Set column after which characters are ignored in typical free-form + lines in the source file. For free-form, the default value is 132. + @var{n} may be @samp{none}, meaning that the entire line is meaningful. + @option{-ffree-line-length-0} means the same thing as + @option{-ffree-line-length-none}. + @cindex -fmax-identifier-length=@var{n} option @cindex option -fmax-identifier-length=@var{n} @item -fmax-identifier-length=@var{n} *************** Specify that no implicit typing is allow *** 266,271 **** --- 286,296 ---- @samp{IMPLICIT} statements. This is the equivalent of adding @samp{implicit none} to the start of every procedure. + @cindex -fcray-pointer option + @cindex options, -fcray-pointer + @item -fcray-pointer + Enables the Cray pointer extension, which provides a C-like pointer. + @cindex -std=@var{std} option @cindex option, -std=@var{std} @item -std=@var{std} *************** This currently includes @option{-Wunused *** 351,362 **** @cindex options, -Waliasing @item -Waliasing @cindex aliasing ! Warn about possible aliasing of dummy arguments. The following example ! will trigger the warning as it would be illegal to @code{bar} to ! modify either parameter. @smallexample ! INTEGER A ! CALL BAR(A,A) @end smallexample --- 376,397 ---- @cindex options, -Waliasing @item -Waliasing @cindex aliasing ! Warn about possible aliasing of dummy arguments. Specifically, it warns ! if the same actual argument is associated with a dummy argument with ! @code{intent(in)} and a dummy argument with @code{intent(out)} in a call ! with an explicit interface. ! ! The following example will trigger the warning. @smallexample ! interface ! subroutine bar(a,b) ! integer, intent(in) :: a ! integer, intent(out) :: b ! end subroutine ! end interface ! integer :: a ! ! call bar(a,a) @end smallexample *************** Output the internal parse tree before st *** 455,460 **** --- 490,511 ---- really useful for debugging gfortran itself. @end table + @table @gcctabopt + @cindex -ffpe-trap=@var{list} option + @cindex option, -ffpe-trap=@var{list} + @item -ffpe-trap=@var{list} + Specify a list of IEEE exceptions when a Floating Point Exception + (FPE) should be raised. On most systems, this will result in a SIGFPE + signal being sent and the program being interrupted, producing a core + file useful for debugging. @var{list} is a (possibly empty) comma-separated + list of the following IEEE exceptions: @samp{invalid} (invalid floating + point operation, such as @code{sqrt(-1.0)}), @samp{zero} (division by + zero), @samp{overflow} (overflow in a floating point operation), + @samp{underflow} (underflow in a floating point operation), + @samp{precision} (loss of precision during operation) and @samp{denormal} + (operation produced a denormal denormal value). + @end table + @xref{Debugging Options,,Options for Debugging Your Program or GCC, gcc,Using the GNU Compiler Collection (GCC)}, for more information on debugging options. *************** debugging options. *** 467,474 **** @cindex INCLUDE directive @cindex directive, INCLUDE ! There options affect how affect how @command{gfortran} searches ! for files specified via the @code{INCLUDE} directive, and where it searches for previously compiled modules. It also affects the search paths used by @command{cpp} when used to preprocess --- 518,525 ---- @cindex INCLUDE directive @cindex directive, INCLUDE ! These options affect how @command{gfortran} searches ! for files specified by the @code{INCLUDE} directive and where it searches for previously compiled modules. It also affects the search paths used by @command{cpp} when used to preprocess *************** The default is the current directory. *** 513,518 **** --- 564,588 ---- GCC options. @end table + @node Runtime Options + @section Influencing runtime behavior + @cindex runtime, options + + These options affect the runtime behavior of @command{gfortran}. + @table @gcctabopt + @cindex -fconvert=@var{conversion} option + @item -fconvert=@var{conversion} + Specify the representation of data for unformatted files. Valid + values for conversion are: @samp{native}, the default; @samp{swap}, + swap between big- and little-endian; @samp{big-endian}, use big-endian + representation for unformatted files; @samp{little-endian}, use little-endian + representation for unformatted files. + + @emph{This option has an effect only when used in the main program. + The @code{CONVERT} specifier and the GFORTRAN_CONVERT_UNIT environment + variable override the default specified by -fconvert.} + @end table + @node Code Gen Options @section Options for Code Generation Conventions @cindex code generation, conventions *************** Do not transform names of entities speci *** 585,594 **** source file by appending underscores to them. With @option{-funderscoring} in effect, @command{gfortran} appends one ! underscore to external names with no underscores. ! ! This is done to ensure compatibility with code produced by many ! UNIX Fortran compilers. @emph{Caution}: The default behavior of @command{gfortran} is incompatible with @command{f2c} and @command{g77}, please use the --- 655,662 ---- source file by appending underscores to them. With @option{-funderscoring} in effect, @command{gfortran} appends one ! underscore to external names with no underscores. This is done to ensure ! compatibility with code produced by many UNIX Fortran compilers. @emph{Caution}: The default behavior of @command{gfortran} is incompatible with @command{f2c} and @command{g77}, please use the *************** a contiguous block at runtime. *** 723,728 **** --- 791,803 ---- This should result in faster accesses to the array. However it can introduce significant overhead to the function call, especially when the passed data is discontiguous. + + @cindex -fshort-enums + @item -fshort-enums + This option is provided for interoperability with C code that was + compiled with the @command{-fshort-enums} option. It will make + @command{gfortran} choose the smallest @code{INTEGER} kind a given + enumerator set will fit in, and give all its enumerators this kind. @end table @xref{Code Gen Options,,Options for Code Generation Conventions, *************** that affect the operation of @command{gc *** 747,750 **** --- 822,827 ---- gcc,Using the GNU Compiler Collection (GCC)}, for information on environment variables. + @xref{Runtime}, for environment variables that affect the + run-time behavior of @command{gfortran} programs. @c man end diff -Nrcpad gcc-4.0.2/gcc/fortran/io.c gcc-4.1.0/gcc/fortran/io.c *** gcc-4.0.2/gcc/fortran/io.c Fri Sep 9 19:48:14 2005 --- gcc-4.1.0/gcc/fortran/io.c Sun Jan 8 01:53:06 2006 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" #include "system.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" #include "system.h" *************** static const io_tag *** 53,58 **** --- 53,59 ---- tag_advance = {"ADVANCE", " advance = %e", BT_CHARACTER}, tag_rec = {"REC", " rec = %e", BT_INTEGER}, tag_format = {"FORMAT", NULL, BT_CHARACTER}, + tag_iomsg = {"IOMSG", " iomsg = %e", BT_CHARACTER}, tag_iostat = {"IOSTAT", " iostat = %v", BT_INTEGER}, tag_size = {"SIZE", " size = %v", BT_INTEGER}, tag_exist = {"EXIST", " exist = %v", BT_LOGICAL}, *************** static const io_tag *** 77,82 **** --- 78,84 ---- tag_s_delim = {"DELIM", " delim = %v", BT_CHARACTER}, tag_s_pad = {"PAD", " pad = %v", BT_CHARACTER}, tag_iolength = {"IOLENGTH", " iolength = %v", BT_INTEGER}, + tag_convert = {"CONVERT", " convert = %e", BT_CHARACTER}, tag_err = {"ERR", " err = %l", BT_UNKNOWN}, tag_end = {"END", " end = %l", BT_UNKNOWN}, tag_eor = {"EOR", " eor = %l", BT_UNKNOWN}; *************** unget_char (void) *** 152,157 **** --- 154,173 ---- use_last_char = 1; } + /* Eat up the spaces and return a character. */ + + static char + next_char_not_space(void) + { + char c; + do + { + c = next_char (0); + } + while (gfc_is_whitespace (c)); + return c; + } + static int value = 0; /* Simple lexical analyzer for getting the next token in a FORMAT *************** format_lex (void) *** 172,190 **** return token; } ! do ! { ! c = next_char (0); ! } ! while (gfc_is_whitespace (c)); ! negative_flag = 0; switch (c) { case '-': negative_flag = 1; case '+': ! c = next_char (0); if (!ISDIGIT (c)) { token = FMT_UNKNOWN; --- 188,202 ---- return token; } ! c = next_char_not_space (); ! negative_flag = 0; switch (c) { case '-': negative_flag = 1; case '+': ! c = next_char_not_space (); if (!ISDIGIT (c)) { token = FMT_UNKNOWN; *************** format_lex (void) *** 195,205 **** do { ! c = next_char (0); if(ISDIGIT (c)) value = 10 * value + c - '0'; } ! while (ISDIGIT (c)); unget_char (); --- 207,217 ---- do { ! c = next_char_not_space (); if(ISDIGIT (c)) value = 10 * value + c - '0'; } ! while (ISDIGIT (c) || gfc_is_whitespace(c)); unget_char (); *************** format_lex (void) *** 225,231 **** do { ! c = next_char (0); if (c != '0') zflag = 0; if (ISDIGIT (c)) --- 237,243 ---- do { ! c = next_char_not_space (); if (c != '0') zflag = 0; if (ISDIGIT (c)) *************** format_lex (void) *** 258,264 **** break; case 'T': ! c = next_char (0); if (c != 'L' && c != 'R') unget_char (); --- 270,276 ---- break; case 'T': ! c = next_char_not_space (); if (c != 'L' && c != 'R') unget_char (); *************** format_lex (void) *** 278,284 **** break; case 'S': ! c = next_char (0); if (c != 'P' && c != 'S') unget_char (); --- 290,296 ---- break; case 'S': ! c = next_char_not_space (); if (c != 'P' && c != 'S') unget_char (); *************** format_lex (void) *** 286,292 **** break; case 'B': ! c = next_char (0); if (c == 'N' || c == 'Z') token = FMT_BLANK; else --- 298,304 ---- break; case 'B': ! c = next_char_not_space (); if (c == 'N' || c == 'Z') token = FMT_BLANK; else *************** format_lex (void) *** 348,354 **** break; case 'E': ! c = next_char (0); if (c == 'N' || c == 'S') token = FMT_EXT; else --- 360,366 ---- break; case 'E': ! c = next_char_not_space (); if (c == 'N' || c == 'S') token = FMT_EXT; else *************** format_lex (void) *** 400,410 **** static try check_format (void) { ! const char *posint_required = "Positive width required"; ! const char *period_required = "Period required"; ! const char *nonneg_required = "Nonnegative width required"; ! const char *unexpected_element = "Unexpected element"; ! const char *unexpected_end = "Unexpected end of format string"; const char *error; format_token t, u; --- 412,422 ---- static try check_format (void) { ! const char *posint_required = _("Positive width required"); ! const char *period_required = _("Period required"); ! const char *nonneg_required = _("Nonnegative width required"); ! const char *unexpected_element = _("Unexpected element"); ! const char *unexpected_end = _("Unexpected end of format string"); const char *error; format_token t, u; *************** check_format (void) *** 421,427 **** t = format_lex (); if (t != FMT_LPAREN) { ! error = "Missing leading left parenthesis"; goto syntax; } --- 433,439 ---- t = format_lex (); if (t != FMT_LPAREN) { ! error = _("Missing leading left parenthesis"); goto syntax; } *************** format_item_1: *** 459,465 **** t = format_lex (); if (t != FMT_P) { ! error = "Expected P edit descriptor"; goto syntax; } --- 471,477 ---- t = format_lex (); if (t != FMT_P) { ! error = _("Expected P edit descriptor"); goto syntax; } *************** format_item_1: *** 467,473 **** case FMT_P: /* P requires a prior number. */ ! error = "P descriptor requires leading scale factor"; goto syntax; case FMT_X: --- 479,485 ---- case FMT_P: /* P requires a prior number. */ ! error = _("P descriptor requires leading scale factor"); goto syntax; case FMT_X: *************** format_item_1: *** 497,503 **** return FAILURE; if (t != FMT_RPAREN || level > 0) { ! error = "$ must the last specifier"; goto syntax; } --- 509,515 ---- return FAILURE; if (t != FMT_RPAREN || level > 0) { ! error = _("$ must be the last specifier"); goto syntax; } *************** data_desc: *** 542,548 **** t = format_lex (); if (t == FMT_POSINT) { ! error = "Repeat count cannot follow P descriptor"; goto syntax; } --- 554,560 ---- t = format_lex (); if (t == FMT_POSINT) { ! error = _("Repeat count cannot follow P descriptor"); goto syntax; } *************** data_desc: *** 605,611 **** u = format_lex (); if (u != FMT_POSINT) { ! error = "Positive exponent width required"; goto syntax; } } --- 617,623 ---- u = format_lex (); if (u != FMT_POSINT) { ! error = _("Positive exponent width required"); goto syntax; } } *************** gfc_match_format (void) *** 814,819 **** --- 826,838 ---- gfc_expr *e; locus start; + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.flavor == FL_MODULE) + { + gfc_error ("Format statement in module main block at %C."); + return MATCH_ERROR; + } + if (gfc_statement_label == NULL) { gfc_error ("Missing format label at %C"); *************** resolve_tag (const io_tag * tag, gfc_exp *** 978,983 **** --- 997,1011 ---- if (tag == &tag_format) { + if (e->expr_type == EXPR_CONSTANT + && (e->ts.type != BT_CHARACTER + || e->ts.kind != gfc_default_character_kind)) + { + gfc_error ("Constant expression in FORMAT tag at %L must be " + "of type default CHARACTER", &e->where); + return FAILURE; + } + /* If e's rank is zero and e is not an element of an array, it should be of integer or character type. The integer variable should be ASSIGNED. */ *************** resolve_tag (const io_tag * tag, gfc_exp *** 1035,1042 **** gfc_error ("%s tag at %L must be scalar", tag->name, &e->where); return FAILURE; } - } return SUCCESS; } --- 1063,1099 ---- gfc_error ("%s tag at %L must be scalar", tag->name, &e->where); return FAILURE; } + if (tag == &tag_iomsg) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IOMSG tag at %L", + &e->where) == FAILURE) + return FAILURE; + } + + if (tag == &tag_iostat && e->ts.kind != gfc_default_integer_kind) + { + if (gfc_notify_std (GFC_STD_GNU, "Fortran 95 requires default " + "INTEGER in IOSTAT tag at %L", + &e->where) == FAILURE) + return FAILURE; + } + + if (tag == &tag_size && e->ts.kind != gfc_default_integer_kind) + { + if (gfc_notify_std (GFC_STD_GNU, "Fortran 95 requires default " + "INTEGER in SIZE tag at %L", + &e->where) == FAILURE) + return FAILURE; + } + + if (tag == &tag_convert) + { + if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L", + &e->where) == FAILURE) + return FAILURE; + } + } return SUCCESS; } *************** match_open_element (gfc_open * open) *** 1051,1056 **** --- 1108,1116 ---- m = match_etag (&tag_unit, &open->unit); if (m != MATCH_NO) return m; + m = match_out_tag (&tag_iomsg, &open->iomsg); + if (m != MATCH_NO) + return m; m = match_out_tag (&tag_iostat, &open->iostat); if (m != MATCH_NO) return m; *************** match_open_element (gfc_open * open) *** 1087,1092 **** --- 1147,1155 ---- m = match_ltag (&tag_err, &open->err); if (m != MATCH_NO) return m; + m = match_etag (&tag_convert, &open->convert); + if (m != MATCH_NO) + return m; return MATCH_NO; } *************** gfc_free_open (gfc_open * open) *** 1102,1107 **** --- 1165,1171 ---- return; gfc_free_expr (open->unit); + gfc_free_expr (open->iomsg); gfc_free_expr (open->iostat); gfc_free_expr (open->file); gfc_free_expr (open->status); *************** gfc_free_open (gfc_open * open) *** 1113,1118 **** --- 1177,1183 ---- gfc_free_expr (open->action); gfc_free_expr (open->delim); gfc_free_expr (open->pad); + gfc_free_expr (open->convert); gfc_free (open); } *************** gfc_resolve_open (gfc_open * open) *** 1125,1133 **** --- 1190,1200 ---- { RESOLVE_TAG (&tag_unit, open->unit); + RESOLVE_TAG (&tag_iomsg, open->iomsg); RESOLVE_TAG (&tag_iostat, open->iostat); RESOLVE_TAG (&tag_file, open->file); RESOLVE_TAG (&tag_status, open->status); + RESOLVE_TAG (&tag_e_access, open->access); RESOLVE_TAG (&tag_e_form, open->form); RESOLVE_TAG (&tag_e_recl, open->recl); *************** gfc_resolve_open (gfc_open * open) *** 1136,1141 **** --- 1203,1209 ---- RESOLVE_TAG (&tag_e_action, open->action); RESOLVE_TAG (&tag_e_delim, open->delim); RESOLVE_TAG (&tag_e_pad, open->pad); + RESOLVE_TAG (&tag_convert, open->convert); if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE) return FAILURE; *************** gfc_free_close (gfc_close * close) *** 1217,1222 **** --- 1285,1291 ---- return; gfc_free_expr (close->unit); + gfc_free_expr (close->iomsg); gfc_free_expr (close->iostat); gfc_free_expr (close->status); *************** match_close_element (gfc_close * close) *** 1237,1242 **** --- 1306,1314 ---- m = match_etag (&tag_status, &close->status); if (m != MATCH_NO) return m; + m = match_out_tag (&tag_iomsg, &close->iomsg); + if (m != MATCH_NO) + return m; m = match_out_tag (&tag_iostat, &close->iostat); if (m != MATCH_NO) return m; *************** gfc_resolve_close (gfc_close * close) *** 1318,1323 **** --- 1390,1396 ---- { RESOLVE_TAG (&tag_unit, close->unit); + RESOLVE_TAG (&tag_iomsg, close->iomsg); RESOLVE_TAG (&tag_iostat, close->iostat); RESOLVE_TAG (&tag_status, close->status); *************** gfc_free_filepos (gfc_filepos * fp) *** 1335,1346 **** { gfc_free_expr (fp->unit); gfc_free_expr (fp->iostat); gfc_free (fp); } ! /* Match elements of a REWIND, BACKSPACE or ENDFILE statement. */ static match match_file_element (gfc_filepos * fp) --- 1408,1420 ---- { gfc_free_expr (fp->unit); + gfc_free_expr (fp->iomsg); gfc_free_expr (fp->iostat); gfc_free (fp); } ! /* Match elements of a REWIND, BACKSPACE, ENDFILE, or FLUSH statement. */ static match match_file_element (gfc_filepos * fp) *************** match_file_element (gfc_filepos * fp) *** 1350,1355 **** --- 1424,1432 ---- m = match_etag (&tag_unit, &fp->unit); if (m != MATCH_NO) return m; + m = match_out_tag (&tag_iomsg, &fp->iomsg); + if (m != MATCH_NO) + return m; m = match_out_tag (&tag_iostat, &fp->iostat); if (m != MATCH_NO) return m; *************** match_file_element (gfc_filepos * fp) *** 1362,1368 **** /* Match the second half of the file-positioning statements, REWIND, ! BACKSPACE or ENDFILE. */ static match match_filepos (gfc_statement st, gfc_exec_op op) --- 1439,1445 ---- /* Match the second half of the file-positioning statements, REWIND, ! BACKSPACE, ENDFILE, or the FLUSH statement. */ static match match_filepos (gfc_statement st, gfc_exec_op op) *************** gfc_resolve_filepos (gfc_filepos * fp) *** 1440,1445 **** --- 1517,1523 ---- RESOLVE_TAG (&tag_unit, fp->unit); RESOLVE_TAG (&tag_iostat, fp->iostat); + RESOLVE_TAG (&tag_iomsg, fp->iomsg); if (gfc_reference_st_label (fp->err, ST_LABEL_TARGET) == FAILURE) return FAILURE; *************** gfc_resolve_filepos (gfc_filepos * fp) *** 1447,1454 **** } ! /* Match the file positioning statements: ENDFILE, BACKSPACE or ! REWIND. */ match gfc_match_endfile (void) --- 1525,1532 ---- } ! /* Match the file positioning statements: ENDFILE, BACKSPACE, REWIND, ! and the FLUSH statement. */ match gfc_match_endfile (void) *************** gfc_match_rewind (void) *** 1471,1476 **** --- 1549,1562 ---- return match_filepos (ST_REWIND, EXEC_REWIND); } + match + gfc_match_flush (void) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: FLUSH statement at %C") == FAILURE) + return MATCH_ERROR; + + return match_filepos (ST_FLUSH, EXEC_FLUSH); + } /******************** Data Transfer Statements *********************/ *************** match_dt_format (gfc_dt * dt) *** 1551,1557 **** return MATCH_YES; } ! if (gfc_match_st_label (&label, 0) == MATCH_YES) { if (dt->format_expr != NULL || dt->format_label != NULL) { --- 1637,1643 ---- return MATCH_YES; } ! if (gfc_match_st_label (&label) == MATCH_YES) { if (dt->format_expr != NULL || dt->format_label != NULL) { *************** match_dt_element (io_kind k, gfc_dt * dt *** 1659,1668 **** --- 1745,1759 ---- m = match_etag (&tag_rec, &dt->rec); if (m != MATCH_NO) return m; + m = match_out_tag (&tag_iomsg, &dt->iomsg); + if (m != MATCH_NO) + return m; m = match_out_tag (&tag_iostat, &dt->iostat); if (m != MATCH_NO) return m; m = match_ltag (&tag_err, &dt->err); + if (m == MATCH_YES) + dt->err_where = gfc_current_locus; if (m != MATCH_NO) return m; m = match_etag (&tag_advance, &dt->advance); *************** gfc_free_dt (gfc_dt * dt) *** 1708,1713 **** --- 1799,1805 ---- gfc_free_expr (dt->format_expr); gfc_free_expr (dt->rec); gfc_free_expr (dt->advance); + gfc_free_expr (dt->iomsg); gfc_free_expr (dt->iostat); gfc_free_expr (dt->size); *************** gfc_resolve_dt (gfc_dt * dt) *** 1725,1730 **** --- 1817,1823 ---- RESOLVE_TAG (&tag_format, dt->format_expr); RESOLVE_TAG (&tag_rec, dt->rec); RESOLVE_TAG (&tag_advance, dt->advance); + RESOLVE_TAG (&tag_iomsg, dt->iomsg); RESOLVE_TAG (&tag_iostat, dt->iostat); RESOLVE_TAG (&tag_size, dt->size); *************** gfc_resolve_dt (gfc_dt * dt) *** 1740,1826 **** return FAILURE; } - /* Sanity checks on data transfer statements. */ if (e->ts.type == BT_CHARACTER) { ! if (dt->rec != NULL) ! { ! gfc_error ("REC tag at %L is incompatible with internal file", ! &dt->rec->where); ! return FAILURE; ! } ! ! if (dt->namelist != NULL) { ! gfc_error ("Internal file at %L is incompatible with namelist", ! &dt->io_unit->where); return FAILURE; } ! if (dt->advance != NULL) ! { ! gfc_error ("ADVANCE tag at %L is incompatible with internal file", ! &dt->advance->where); ! return FAILURE; ! } } ! if (dt->rec != NULL) { ! if (dt->end != NULL) { ! gfc_error ("REC tag at %L is incompatible with END tag", ! &dt->rec->where); return FAILURE; } ! if (dt->format_label == &format_asterisk) { ! gfc_error ! ("END tag at %L is incompatible with list directed format (*)", ! &dt->end_where); return FAILURE; } ! if (dt->namelist != NULL) { ! gfc_error ("REC tag at %L is incompatible with namelist", ! &dt->rec->where); return FAILURE; } } - if (dt->advance != NULL && dt->format_label == &format_asterisk) - { - gfc_error ("ADVANCE tag at %L is incompatible with list directed " - "format (*)", &dt->advance->where); - return FAILURE; - } - - if (dt->eor != 0 && dt->advance == NULL) - { - gfc_error ("EOR tag at %L requires an ADVANCE tag", &dt->eor_where); - return FAILURE; - } - - if (dt->size != NULL && dt->advance == NULL) - { - gfc_error ("SIZE tag at %L requires an ADVANCE tag", &dt->size->where); - return FAILURE; - } - - /* TODO: Make sure the ADVANCE tag is 'yes' or 'no' if it is a string - constant. */ - - if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE) - return FAILURE; - - if (gfc_reference_st_label (dt->end, ST_LABEL_TARGET) == FAILURE) - return FAILURE; - - if (gfc_reference_st_label (dt->eor, ST_LABEL_TARGET) == FAILURE) - return FAILURE; - /* Check the format label actually exists. */ if (dt->format_label && dt->format_label != &format_asterisk && dt->format_label->defined == ST_LABEL_UNKNOWN) --- 1833,1890 ---- return FAILURE; } if (e->ts.type == BT_CHARACTER) { ! if (gfc_has_vector_index (e)) { ! gfc_error ("Internal unit with vector subscript at %L", ! &e->where); return FAILURE; } + } ! if (e->rank && e->ts.type != BT_CHARACTER) ! { ! gfc_error ("External IO UNIT cannot be an array at %L", &e->where); ! return FAILURE; } ! if (dt->err) { ! if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE) ! return FAILURE; ! if (dt->err->defined == ST_LABEL_UNKNOWN) { ! gfc_error ("ERR tag label %d at %L not defined", ! dt->err->value, &dt->err_where); return FAILURE; } + } ! if (dt->end) ! { ! if (gfc_reference_st_label (dt->end, ST_LABEL_TARGET) == FAILURE) ! return FAILURE; ! if (dt->end->defined == ST_LABEL_UNKNOWN) { ! gfc_error ("END tag label %d at %L not defined", ! dt->end->value, &dt->end_where); return FAILURE; } + } ! if (dt->eor) ! { ! if (gfc_reference_st_label (dt->eor, ST_LABEL_TARGET) == FAILURE) ! return FAILURE; ! if (dt->eor->defined == ST_LABEL_UNKNOWN) { ! gfc_error ("EOR tag label %d at %L not defined", ! dt->eor->value, &dt->eor_where); return FAILURE; } } /* Check the format label actually exists. */ if (dt->format_label && dt->format_label != &format_asterisk && dt->format_label->defined == ST_LABEL_UNKNOWN) *************** terminate_io (gfc_code * io_code) *** 2096,2102 **** gfc_code *c; if (io_code == NULL) ! io_code = &new_st; c = gfc_get_code (); c->op = EXEC_DT_END; --- 2160,2166 ---- gfc_code *c; if (io_code == NULL) ! io_code = new_st.block; c = gfc_get_code (); c->op = EXEC_DT_END; *************** terminate_io (gfc_code * io_code) *** 2107,2112 **** --- 2171,2335 ---- } + /* Check the constraints for a data transfer statement. The majority of the + constraints appearing in 9.4 of the standard appear here. Some are handled + in resolve_tag and others in gfc_resolve_dt. */ + + static match + check_io_constraints (io_kind k, gfc_dt *dt, gfc_code * io_code, locus * spec_end) + { + #define io_constraint(condition,msg,arg)\ + if (condition) \ + {\ + gfc_error(msg,arg);\ + m = MATCH_ERROR;\ + } + + match m; + gfc_expr * expr; + gfc_symbol * sym = NULL; + + m = MATCH_YES; + + expr = dt->io_unit; + if (expr && expr->expr_type == EXPR_VARIABLE + && expr->ts.type == BT_CHARACTER) + { + sym = expr->symtree->n.sym; + + io_constraint (k == M_WRITE && sym->attr.intent == INTENT_IN, + "Internal file at %L must not be INTENT(IN)", + &expr->where); + + io_constraint (gfc_has_vector_index (dt->io_unit), + "Internal file incompatible with vector subscript at %L", + &expr->where); + + io_constraint (dt->rec != NULL, + "REC tag at %L is incompatible with internal file", + &dt->rec->where); + + io_constraint (dt->namelist != NULL, + "Internal file at %L is incompatible with namelist", + &expr->where); + + io_constraint (dt->advance != NULL, + "ADVANCE tag at %L is incompatible with internal file", + &dt->advance->where); + } + + if (expr && expr->ts.type != BT_CHARACTER) + { + + io_constraint (gfc_pure (NULL) + && (k == M_READ || k == M_WRITE), + "IO UNIT in %s statement at %C must be " + "an internal file in a PURE procedure", + io_kind_name (k)); + } + + + if (k != M_READ) + { + io_constraint (dt->end, + "END tag not allowed with output at %L", + &dt->end_where); + + io_constraint (dt->eor, + "EOR tag not allowed with output at %L", + &dt->eor_where); + + io_constraint (k != M_READ && dt->size, + "SIZE=specifier not allowed with output at %L", + &dt->size->where); + } + else + { + io_constraint (dt->size && dt->advance == NULL, + "SIZE tag at %L requires an ADVANCE tag", + &dt->size->where); + + io_constraint (dt->eor && dt->advance == NULL, + "EOR tag at %L requires an ADVANCE tag", + &dt->eor_where); + } + + + + if (dt->namelist) + { + io_constraint (io_code && dt->namelist, + "NAMELIST cannot be followed by IO-list at %L", + &io_code->loc); + + io_constraint (dt->format_expr, + "IO spec-list cannot contain both NAMELIST group name " + "and format specification at %L.", + &dt->format_expr->where); + + io_constraint (dt->format_label, + "IO spec-list cannot contain both NAMELIST group name " + "and format label at %L", spec_end); + + io_constraint (dt->rec, + "NAMELIST IO is not allowed with a REC=specifier " + "at %L.", &dt->rec->where); + + io_constraint (dt->advance, + "NAMELIST IO is not allowed with a ADVANCE=specifier " + "at %L.", &dt->advance->where); + } + + if (dt->rec) + { + io_constraint (dt->end, + "An END tag is not allowed with a " + "REC=specifier at %L.", &dt->end_where); + + + io_constraint (dt->format_label == &format_asterisk, + "FMT=* is not allowed with a REC=specifier " + "at %L.", spec_end); + } + + if (dt->advance) + { + const char * advance; + int not_yes, not_no; + expr = dt->advance; + advance = expr->value.character.string; + + io_constraint (dt->format_label == &format_asterisk, + "List directed format(*) is not allowed with a " + "ADVANCE=specifier at %L.", &expr->where); + + not_no = strncasecmp (advance, "no", 2) != 0; + not_yes = strncasecmp (advance, "yes", 2) != 0; + + io_constraint (expr->expr_type == EXPR_CONSTANT + && not_no && not_yes, + "ADVANCE=specifier at %L must have value = " + "YES or NO.", &expr->where); + + io_constraint (dt->size && expr->expr_type == EXPR_CONSTANT + && not_no && k == M_READ, + "SIZE tag at %L requires an ADVANCE = 'NO'", + &dt->size->where); + + io_constraint (dt->eor && expr->expr_type == EXPR_CONSTANT + && not_no && k == M_READ, + "EOR tag at %L requires an ADVANCE = 'NO'", + &dt->eor_where); + } + + expr = dt->format_expr; + if (expr != NULL && expr->expr_type == EXPR_CONSTANT) + check_format_string (expr); + + return m; + } + #undef io_constraint + /* Match a READ, WRITE or PRINT statement. */ static match *************** match_io (io_kind k) *** 2115,2173 **** char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_code *io_code; gfc_symbol *sym; - gfc_expr *expr; int comma_flag, c; locus where; gfc_dt *dt; match m; comma_flag = 0; current_dt = dt = gfc_getmem (sizeof (gfc_dt)); - if (gfc_match_char ('(') == MATCH_NO) { if (k == M_WRITE) goto syntax; ! else if (k == M_PRINT ! && (gfc_current_form == FORM_FIXED ! || gfc_peek_char () == ' ')) { /* Treat the non-standard case of PRINT namelist. */ ! where = gfc_current_locus; ! if ((gfc_match_name (name) == MATCH_YES) ! && !gfc_find_symbol (name, NULL, 1, &sym) ! && sym->attr.flavor == FL_NAMELIST) { ! if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at " ! "%C is an extension") == FAILURE) ! { ! m = MATCH_ERROR; ! goto cleanup; ! } ! if (gfc_match_eos () == MATCH_NO) { ! gfc_error ("Namelist followed by I/O list at %C"); ! m = MATCH_ERROR; ! goto cleanup; ! } ! dt->io_unit = default_unit (k); ! dt->namelist = sym; ! goto get_io_list; } - else - gfc_current_locus = where; } if (gfc_current_form == FORM_FREE) ! { ! c = gfc_peek_char(); ! if (c != ' ' && c != '*' && c != '\'' && c != '"') ! { ! m = MATCH_NO; ! goto cleanup; ! } ! } m = match_dt_format (dt); if (m == MATCH_ERROR) --- 2338,2391 ---- char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_code *io_code; gfc_symbol *sym; int comma_flag, c; locus where; + locus spec_end; gfc_dt *dt; match m; + where = gfc_current_locus; comma_flag = 0; current_dt = dt = gfc_getmem (sizeof (gfc_dt)); if (gfc_match_char ('(') == MATCH_NO) { + where = gfc_current_locus; if (k == M_WRITE) goto syntax; ! else if (k == M_PRINT) { /* Treat the non-standard case of PRINT namelist. */ ! if ((gfc_current_form == FORM_FIXED || gfc_peek_char () == ' ') ! && gfc_match_name (name) == MATCH_YES) { ! gfc_find_symbol (name, NULL, 1, &sym); ! if (sym && sym->attr.flavor == FL_NAMELIST) { ! if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at " ! "%C is an extension") == FAILURE) ! { ! m = MATCH_ERROR; ! goto cleanup; ! } ! dt->io_unit = default_unit (k); ! dt->namelist = sym; ! goto get_io_list; ! } ! else ! gfc_current_locus = where; } } if (gfc_current_form == FORM_FREE) ! { ! c = gfc_peek_char(); ! if (c != ' ' && c != '*' && c != '\'' && c != '"') ! { ! m = MATCH_NO; ! goto cleanup; ! } ! } m = match_dt_format (dt); if (m == MATCH_ERROR) *************** match_io (io_kind k) *** 2205,2221 **** where = gfc_current_locus; ! if (gfc_match_name (name) == MATCH_YES ! && !gfc_find_symbol (name, NULL, 1, &sym) ! && sym->attr.flavor == FL_NAMELIST) { ! dt->namelist = sym; ! if (k == M_READ && check_namelist (sym)) { ! m = MATCH_ERROR; ! goto cleanup; } - goto next; } gfc_current_locus = where; --- 2423,2442 ---- where = gfc_current_locus; ! m = gfc_match_name (name); ! if (m == MATCH_YES) { ! gfc_find_symbol (name, NULL, 1, &sym); ! if (sym && sym->attr.flavor == FL_NAMELIST) { ! dt->namelist = sym; ! if (k == M_READ && check_namelist (sym)) ! { ! m = MATCH_ERROR; ! goto cleanup; ! } ! goto next; } } gfc_current_locus = where; *************** loop: *** 2244,2249 **** --- 2465,2474 ---- } get_io_list: + + /* Used in check_io_constraints, where no locus is available. */ + spec_end = gfc_current_locus; + /* Optional leading comma (non-standard). */ if (!comma_flag && gfc_match_char (',') == MATCH_YES *************** get_io_list: *** 2269,2305 **** goto syntax; } ! /* A full IO statement has been matched. */ ! if (dt->io_unit->expr_type == EXPR_VARIABLE ! && k == M_WRITE ! && dt->io_unit->ts.type == BT_CHARACTER ! && dt->io_unit->symtree->n.sym->attr.intent == INTENT_IN) ! { ! gfc_error ("Internal file '%s' at %L is INTENT(IN)", ! dt->io_unit->symtree->n.sym->name, &dt->io_unit->where); ! m = MATCH_ERROR; ! goto cleanup; ! } ! ! expr = dt->format_expr; ! ! if (expr != NULL && expr->expr_type == EXPR_CONSTANT) ! check_format_string (expr); ! if (gfc_pure (NULL) ! && (k == M_READ || k == M_WRITE) ! && dt->io_unit->ts.type != BT_CHARACTER) ! { ! gfc_error ! ("io-unit in %s statement at %C must be an internal file in a " ! "PURE procedure", io_kind_name (k)); ! m = MATCH_ERROR; ! goto cleanup; ! } new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE; new_st.ext.dt = dt; ! new_st.next = io_code; terminate_io (io_code); --- 2494,2511 ---- goto syntax; } ! /* A full IO statement has been matched. Check the constraints. spec_end is ! supplied for cases where no locus is supplied. */ ! m = check_io_constraints (k, dt, io_code, &spec_end); ! if (m == MATCH_ERROR) ! goto cleanup; new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE; new_st.ext.dt = dt; ! new_st.block = gfc_get_code (); ! new_st.block->op = new_st.op; ! new_st.block->next = io_code; terminate_io (io_code); *************** gfc_free_inquire (gfc_inquire * inquire) *** 2357,2362 **** --- 2563,2569 ---- gfc_free_expr (inquire->unit); gfc_free_expr (inquire->file); + gfc_free_expr (inquire->iomsg); gfc_free_expr (inquire->iostat); gfc_free_expr (inquire->exist); gfc_free_expr (inquire->opened); *************** gfc_free_inquire (gfc_inquire * inquire) *** 2380,2385 **** --- 2587,2593 ---- gfc_free_expr (inquire->delim); gfc_free_expr (inquire->pad); gfc_free_expr (inquire->iolength); + gfc_free_expr (inquire->convert); gfc_free (inquire); } *************** match_inquire_element (gfc_inquire * inq *** 2397,2402 **** --- 2605,2611 ---- m = match_etag (&tag_unit, &inquire->unit); RETM m = match_etag (&tag_file, &inquire->file); RETM m = match_ltag (&tag_err, &inquire->err); + RETM m = match_out_tag (&tag_iomsg, &inquire->iomsg); RETM m = match_out_tag (&tag_iostat, &inquire->iostat); RETM m = match_vtag (&tag_exist, &inquire->exist); RETM m = match_vtag (&tag_opened, &inquire->opened); *************** match_inquire_element (gfc_inquire * inq *** 2420,2425 **** --- 2629,2635 ---- RETM m = match_vtag (&tag_s_delim, &inquire->delim); RETM m = match_vtag (&tag_s_pad, &inquire->pad); RETM m = match_vtag (&tag_iolength, &inquire->iolength); + RETM m = match_vtag (&tag_convert, &inquire->convert); RETM return MATCH_NO; } *************** gfc_match_inquire (void) *** 2466,2473 **** if (m == MATCH_NO) goto syntax; - terminate_io (code); - new_st.op = EXEC_IOLENGTH; new_st.expr = inquire->iolength; new_st.ext.inquire = inquire; --- 2676,2681 ---- *************** gfc_match_inquire (void) *** 2479,2485 **** return MATCH_ERROR; } ! new_st.next = code; return MATCH_YES; } --- 2687,2696 ---- return MATCH_ERROR; } ! new_st.block = gfc_get_code (); ! new_st.block->op = EXEC_IOLENGTH; ! terminate_io (code); ! new_st.block->next = code; return MATCH_YES; } *************** gfc_resolve_inquire (gfc_inquire * inqui *** 2548,2553 **** --- 2759,2765 ---- RESOLVE_TAG (&tag_unit, inquire->unit); RESOLVE_TAG (&tag_file, inquire->file); + RESOLVE_TAG (&tag_iomsg, inquire->iomsg); RESOLVE_TAG (&tag_iostat, inquire->iostat); RESOLVE_TAG (&tag_exist, inquire->exist); RESOLVE_TAG (&tag_opened, inquire->opened); *************** gfc_resolve_inquire (gfc_inquire * inqui *** 2571,2576 **** --- 2783,2789 ---- RESOLVE_TAG (&tag_s_delim, inquire->delim); RESOLVE_TAG (&tag_s_pad, inquire->pad); RESOLVE_TAG (&tag_iolength, inquire->iolength); + RESOLVE_TAG (&tag_convert, inquire->convert); if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE) return FAILURE; diff -Nrcpad gcc-4.0.2/gcc/fortran/ioparm.def gcc-4.1.0/gcc/fortran/ioparm.def *** gcc-4.0.2/gcc/fortran/ioparm.def Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/gcc/fortran/ioparm.def Tue Dec 13 21:11:23 2005 *************** *** 0 **** --- 1,69 ---- + #ifndef IOPARM_common_libreturn_mask + #define IOPARM_common_libreturn_mask 3 + #define IOPARM_common_libreturn_ok 0 + #define IOPARM_common_libreturn_error 1 + #define IOPARM_common_libreturn_end 2 + #define IOPARM_common_libreturn_eor 3 + #define IOPARM_common_err (1 << 2) + #define IOPARM_common_end (1 << 3) + #define IOPARM_common_eor (1 << 4) + #endif + IOPARM (common, flags, 0, int4) + IOPARM (common, unit, 0, int4) + IOPARM (common, filename, 0, pchar) + IOPARM (common, line, 0, int4) + IOPARM (common, iomsg, 1 << 6, char2) + IOPARM (common, iostat, 1 << 5, pint4) + IOPARM (open, common, 0, common) + IOPARM (open, recl_in, 1 << 7, int4) + IOPARM (open, file, 1 << 8, char2) + IOPARM (open, status, 1 << 9, char1) + IOPARM (open, access, 1 << 10, char2) + IOPARM (open, form, 1 << 11, char1) + IOPARM (open, blank, 1 << 12, char2) + IOPARM (open, position, 1 << 13, char1) + IOPARM (open, action, 1 << 14, char2) + IOPARM (open, delim, 1 << 15, char1) + IOPARM (open, pad, 1 << 16, char2) + IOPARM (open, convert, 1 << 17, char1) + IOPARM (close, common, 0, common) + IOPARM (close, status, 1 << 7, char1) + IOPARM (filepos, common, 0, common) + IOPARM (inquire, common, 0, common) + IOPARM (inquire, exist, 1 << 7, pint4) + IOPARM (inquire, opened, 1 << 8, pint4) + IOPARM (inquire, number, 1 << 9, pint4) + IOPARM (inquire, named, 1 << 10, pint4) + IOPARM (inquire, nextrec, 1 << 11, pint4) + IOPARM (inquire, recl_out, 1 << 12, pint4) + IOPARM (inquire, file, 1 << 13, char1) + IOPARM (inquire, access, 1 << 14, char2) + IOPARM (inquire, form, 1 << 15, char1) + IOPARM (inquire, blank, 1 << 16, char2) + IOPARM (inquire, position, 1 << 17, char1) + IOPARM (inquire, action, 1 << 18, char2) + IOPARM (inquire, delim, 1 << 19, char1) + IOPARM (inquire, pad, 1 << 20, char2) + IOPARM (inquire, name, 1 << 21, char1) + IOPARM (inquire, sequential, 1 << 22, char2) + IOPARM (inquire, direct, 1 << 23, char1) + IOPARM (inquire, formatted, 1 << 24, char2) + IOPARM (inquire, unformatted, 1 << 25, char1) + IOPARM (inquire, read, 1 << 26, char2) + IOPARM (inquire, write, 1 << 27, char1) + IOPARM (inquire, readwrite, 1 << 28, char2) + IOPARM (inquire, convert, 1 << 29, char1) + #ifndef IOPARM_dt_list_format + #define IOPARM_dt_list_format (1 << 7) + #define IOPARM_dt_namelist_read_mode (1 << 8) + #endif + IOPARM (dt, common, 0, common) + IOPARM (dt, rec, 1 << 9, int4) + IOPARM (dt, size, 1 << 10, pint4) + IOPARM (dt, iolength, 1 << 11, pint4) + IOPARM (dt, internal_unit_desc, 0, parray) + IOPARM (dt, format, 1 << 12, char1) + IOPARM (dt, advance, 1 << 13, char2) + IOPARM (dt, internal_unit, 1 << 14, char1) + IOPARM (dt, namelist_name, 1 << 15, char2) + IOPARM (dt, u, 0, pad) diff -Nrcpad gcc-4.0.2/gcc/fortran/iresolve.c gcc-4.1.0/gcc/fortran/iresolve.c *** gcc-4.0.2/gcc/fortran/iresolve.c Wed Aug 10 20:24:50 2005 --- gcc-4.1.0/gcc/fortran/iresolve.c Fri Dec 2 15:50:30 2005 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Assign name and types to intrinsic procedures. For functions, the --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Assign name and types to intrinsic procedures. For functions, the *************** gfc_get_string (const char *format, ...) *** 59,64 **** --- 59,79 ---- return IDENTIFIER_POINTER (ident); } + /* MERGE and SPREAD need to have source charlen's present for passing + to the result expression. */ + static void + check_charlen_present (gfc_expr *source) + { + if (source->expr_type == EXPR_CONSTANT && source->ts.cl == NULL) + { + source->ts.cl = gfc_get_charlen (); + source->ts.cl->next = gfc_current_ns->cl_list; + gfc_current_ns->cl_list = source->ts.cl; + source->ts.cl->length = gfc_int_expr (source->value.character.length); + source->rank = 0; + } + } + /********************** Resolution functions **********************/ *************** gfc_resolve_acos (gfc_expr * f, gfc_expr *** 84,89 **** --- 99,113 ---- void + gfc_resolve_acosh (gfc_expr * f, gfc_expr * x) + { + f->ts = x->ts; + f->value.function.name = + gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + } + + + void gfc_resolve_aimag (gfc_expr * f, gfc_expr * x) { f->ts.type = BT_REAL; *************** gfc_resolve_aimag (gfc_expr * f, gfc_exp *** 94,104 **** --- 118,156 ---- void + gfc_resolve_and (gfc_expr * f, gfc_expr * i, gfc_expr * j) + { + f->ts.type = i->ts.type; + f->ts.kind = gfc_kind_max (i,j); + + if (i->ts.kind != j->ts.kind) + { + if (i->ts.kind == gfc_kind_max (i,j)) + gfc_convert_type(j, &i->ts, 2); + else + gfc_convert_type(i, &j->ts, 2); + } + + f->value.function.name = gfc_get_string ("__and_%c%d", + gfc_type_letter (i->ts.type), + f->ts.kind); + } + + + void gfc_resolve_aint (gfc_expr * f, gfc_expr * a, gfc_expr * kind) { + gfc_typespec ts; + f->ts.type = a->ts.type; f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer); + if (a->ts.kind != f->ts.kind) + { + ts.type = f->ts.type; + ts.kind = f->ts.kind; + gfc_convert_type (a, &ts, 2); + } /* The resolved name is only used for specific intrinsics where the return kind is the same as the arg kind. */ f->value.function.name = *************** gfc_resolve_all (gfc_expr * f, gfc_expr *** 134,142 **** --- 186,203 ---- void gfc_resolve_anint (gfc_expr * f, gfc_expr * a, gfc_expr * kind) { + gfc_typespec ts; + f->ts.type = a->ts.type; f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer); + if (a->ts.kind != f->ts.kind) + { + ts.type = f->ts.type; + ts.kind = f->ts.kind; + gfc_convert_type (a, &ts, 2); + } + /* The resolved name is only used for specific intrinsics where the return kind is the same as the arg kind. */ f->value.function.name = *************** gfc_resolve_asin (gfc_expr * f, gfc_expr *** 177,182 **** --- 238,250 ---- gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); } + void + gfc_resolve_asinh (gfc_expr * f, gfc_expr * x) + { + f->ts = x->ts; + f->value.function.name = + gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + } void gfc_resolve_atan (gfc_expr * f, gfc_expr * x) *************** gfc_resolve_atan (gfc_expr * f, gfc_expr *** 186,191 **** --- 254,266 ---- gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); } + void + gfc_resolve_atanh (gfc_expr * f, gfc_expr * x) + { + f->ts = x->ts; + f->value.function.name = + gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + } void gfc_resolve_atan2 (gfc_expr * f, gfc_expr * x, *************** gfc_resolve_dcmplx (gfc_expr * f, gfc_ex *** 302,307 **** --- 377,412 ---- } void + gfc_resolve_complex (gfc_expr * f, gfc_expr * x, gfc_expr * y) + { + int kind; + + if (x->ts.type == BT_INTEGER) + { + if (y->ts.type == BT_INTEGER) + kind = gfc_default_real_kind; + else + kind = y->ts.kind; + } + else + { + if (y->ts.type == BT_REAL) + kind = (x->ts.kind > y->ts.kind) ? x->ts.kind : y->ts.kind; + else + kind = x->ts.kind; + } + + f->ts.type = BT_COMPLEX; + f->ts.kind = kind; + + f->value.function.name = + gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind, + gfc_type_letter (x->ts.type), x->ts.kind, + gfc_type_letter (y->ts.type), y->ts.kind); + } + + + void gfc_resolve_conjg (gfc_expr * f, gfc_expr * x) { f->ts = x->ts; *************** gfc_resolve_cshift (gfc_expr * f, gfc_ex *** 380,386 **** gfc_convert_type_warn (dim, &shift->ts, 2, 0); } f->value.function.name = ! gfc_get_string (PREFIX("cshift%d_%d"), n, shift->ts.kind); } --- 485,514 ---- gfc_convert_type_warn (dim, &shift->ts, 2, 0); } f->value.function.name = ! gfc_get_string (PREFIX("cshift%d_%d%s"), n, shift->ts.kind, ! array->ts.type == BT_CHARACTER ? "_char" : ""); ! } ! ! ! void ! gfc_resolve_ctime (gfc_expr * f, gfc_expr * time) ! { ! gfc_typespec ts; ! ! f->ts.type = BT_CHARACTER; ! f->ts.kind = gfc_default_character_kind; ! ! /* ctime TIME argument is a INTEGER(KIND=8), says the doc */ ! if (time->ts.kind != 8) ! { ! ts.type = BT_INTEGER; ! ts.kind = 8; ! ts.derived = NULL; ! ts.cl = NULL; ! gfc_convert_type (time, &ts, 2); ! } ! ! f->value.function.name = gfc_get_string (PREFIX("ctime")); } *************** gfc_resolve_dble (gfc_expr * f, gfc_expr *** 395,406 **** void ! gfc_resolve_dim (gfc_expr * f, gfc_expr * x, ! gfc_expr * y ATTRIBUTE_UNUSED) { ! f->ts = x->ts; f->value.function.name = ! gfc_get_string ("__dim_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); } --- 523,546 ---- void ! gfc_resolve_dim (gfc_expr * f, gfc_expr * a, gfc_expr * p) { ! f->ts.type = a->ts.type; ! if (p != NULL) ! f->ts.kind = gfc_kind_max (a,p); ! else ! f->ts.kind = a->ts.kind; ! ! if (p != NULL && a->ts.kind != p->ts.kind) ! { ! if (a->ts.kind == gfc_kind_max (a,p)) ! gfc_convert_type(p, &a->ts, 2); ! else ! gfc_convert_type(a, &p->ts, 2); ! } ! f->value.function.name = ! gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); } *************** gfc_resolve_eoshift (gfc_expr * f, gfc_e *** 480,486 **** } f->value.function.name = ! gfc_get_string (PREFIX("eoshift%d_%d"), n, shift->ts.kind); } --- 620,627 ---- } f->value.function.name = ! gfc_get_string (PREFIX("eoshift%d_%d%s"), n, shift->ts.kind, ! array->ts.type == BT_CHARACTER ? "_char" : ""); } *************** gfc_resolve_exponent (gfc_expr * f, gfc_ *** 504,509 **** --- 645,659 ---- void + gfc_resolve_fdate (gfc_expr * f) + { + f->ts.type = BT_CHARACTER; + f->ts.kind = gfc_default_character_kind; + f->value.function.name = gfc_get_string (PREFIX("fdate")); + } + + + void gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind) { f->ts.type = BT_INTEGER; *************** gfc_resolve_link (gfc_expr * f, gfc_expr *** 814,819 **** --- 964,978 ---- void + gfc_resolve_loc (gfc_expr *f, gfc_expr *x) + { + f->ts.type= BT_INTEGER; + f->ts.kind = gfc_index_integer_kind; + f->value.function.name = gfc_get_string ("__loc_%d", x->ts.kind); + } + + + void gfc_resolve_log (gfc_expr * f, gfc_expr * x) { f->ts = x->ts; *************** gfc_resolve_logical (gfc_expr * f, gfc_e *** 846,851 **** --- 1005,1028 ---- void + gfc_resolve_malloc (gfc_expr * f, gfc_expr * size) + { + if (size->ts.kind < gfc_index_integer_kind) + { + gfc_typespec ts; + + ts.type = BT_INTEGER; + ts.kind = gfc_index_integer_kind; + gfc_convert_type_warn (size, &ts, 2, 0); + } + + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_index_integer_kind; + f->value.function.name = gfc_get_string (PREFIX("malloc")); + } + + + void gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b) { gfc_expr temp; *************** gfc_resolve_merge (gfc_expr * f, gfc_exp *** 954,959 **** --- 1131,1139 ---- gfc_expr * fsource ATTRIBUTE_UNUSED, gfc_expr * mask ATTRIBUTE_UNUSED) { + if (tsource->ts.type == BT_CHARACTER) + check_charlen_present (tsource); + f->ts = tsource->ts; f->value.function.name = gfc_get_string ("__merge_%c%d", gfc_type_letter (tsource->ts.type), *************** gfc_resolve_minval (gfc_expr * f, gfc_ex *** 1011,1033 **** void ! gfc_resolve_mod (gfc_expr * f, gfc_expr * a, ! gfc_expr * p ATTRIBUTE_UNUSED) { ! f->ts = a->ts; f->value.function.name = ! gfc_get_string ("__mod_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); } void ! gfc_resolve_modulo (gfc_expr * f, gfc_expr * a, ! gfc_expr * p ATTRIBUTE_UNUSED) { ! f->ts = a->ts; f->value.function.name = ! gfc_get_string ("__modulo_%c%d", gfc_type_letter (a->ts.type), ! a->ts.kind); } void --- 1191,1237 ---- void ! gfc_resolve_mod (gfc_expr * f, gfc_expr * a, gfc_expr * p) { ! f->ts.type = a->ts.type; ! if (p != NULL) ! f->ts.kind = gfc_kind_max (a,p); ! else ! f->ts.kind = a->ts.kind; ! ! if (p != NULL && a->ts.kind != p->ts.kind) ! { ! if (a->ts.kind == gfc_kind_max (a,p)) ! gfc_convert_type(p, &a->ts, 2); ! else ! gfc_convert_type(a, &p->ts, 2); ! } ! f->value.function.name = ! gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); } void ! gfc_resolve_modulo (gfc_expr * f, gfc_expr * a, gfc_expr * p) { ! f->ts.type = a->ts.type; ! if (p != NULL) ! f->ts.kind = gfc_kind_max (a,p); ! else ! f->ts.kind = a->ts.kind; ! ! if (p != NULL && a->ts.kind != p->ts.kind) ! { ! if (a->ts.kind == gfc_kind_max (a,p)) ! gfc_convert_type(p, &a->ts, 2); ! else ! gfc_convert_type(a, &p->ts, 2); ! } ! f->value.function.name = ! gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type), ! f->ts.kind); } void *************** gfc_resolve_not (gfc_expr * f, gfc_expr *** 1060,1075 **** void ! gfc_resolve_pack (gfc_expr * f, ! gfc_expr * array ATTRIBUTE_UNUSED, ! gfc_expr * mask, gfc_expr * vector ATTRIBUTE_UNUSED) { f->ts = array->ts; f->rank = 1; if (mask->rank != 0) ! f->value.function.name = PREFIX("pack"); else { /* We convert mask to default logical only in the scalar case. --- 1264,1299 ---- void ! gfc_resolve_or (gfc_expr * f, gfc_expr * i, gfc_expr * j) ! { ! f->ts.type = i->ts.type; ! f->ts.kind = gfc_kind_max (i,j); ! ! if (i->ts.kind != j->ts.kind) ! { ! if (i->ts.kind == gfc_kind_max (i,j)) ! gfc_convert_type(j, &i->ts, 2); ! else ! gfc_convert_type(i, &j->ts, 2); ! } ! ! f->value.function.name = gfc_get_string ("__or_%c%d", ! gfc_type_letter (i->ts.type), ! f->ts.kind); ! } ! ! ! void ! gfc_resolve_pack (gfc_expr * f, gfc_expr * array, gfc_expr * mask, gfc_expr * vector ATTRIBUTE_UNUSED) { f->ts = array->ts; f->rank = 1; if (mask->rank != 0) ! f->value.function.name = (array->ts.type == BT_CHARACTER ! ? PREFIX("pack_char") ! : PREFIX("pack")); else { /* We convert mask to default logical only in the scalar case. *************** gfc_resolve_pack (gfc_expr * f, *** 1084,1090 **** gfc_convert_type (mask, &ts, 2); } ! f->value.function.name = PREFIX("pack_s"); } } --- 1308,1316 ---- gfc_convert_type (mask, &ts, 2); } ! f->value.function.name = (array->ts.type == BT_CHARACTER ! ? PREFIX("pack_s_char") ! : PREFIX("pack_s")); } } *************** gfc_resolve_real (gfc_expr * f, gfc_expr *** 1125,1130 **** --- 1351,1367 ---- void + gfc_resolve_realpart (gfc_expr * f, gfc_expr * a) + { + f->ts.type = BT_REAL; + f->ts.kind = a->ts.kind; + f->value.function.name = + gfc_get_string ("__real_%d_%c%d", f->ts.kind, + gfc_type_letter (a->ts.type), a->ts.kind); + } + + + void gfc_resolve_rename (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED, gfc_expr * p2 ATTRIBUTE_UNUSED) { *************** gfc_resolve_reshape (gfc_expr * f, gfc_e *** 1179,1185 **** { case 4: case 8: ! /* case 16: */ if (source->ts.type == BT_COMPLEX) f->value.function.name = gfc_get_string (PREFIX("reshape_%c%d"), --- 1416,1423 ---- { case 4: case 8: ! case 10: ! case 16: if (source->ts.type == BT_COMPLEX) f->value.function.name = gfc_get_string (PREFIX("reshape_%c%d"), *************** gfc_resolve_reshape (gfc_expr * f, gfc_e *** 1191,1197 **** break; default: ! f->value.function.name = PREFIX("reshape"); break; } --- 1429,1437 ---- break; default: ! f->value.function.name = (source->ts.type == BT_CHARACTER ! ? PREFIX("reshape_char") ! : PREFIX("reshape")); break; } *************** gfc_resolve_scan (gfc_expr * f, gfc_expr *** 1264,1269 **** --- 1504,1518 ---- void + gfc_resolve_secnds (gfc_expr * t1, gfc_expr * t0) + { + t1->ts = t0->ts; + t1->value.function.name = + gfc_get_string (PREFIX("secnds")); + } + + + void gfc_resolve_set_exponent (gfc_expr * f, gfc_expr * x, gfc_expr * i) { f->ts = x->ts; *************** gfc_resolve_sign (gfc_expr * f, gfc_expr *** 1307,1312 **** --- 1556,1582 ---- void + gfc_resolve_signal (gfc_expr * f, gfc_expr *number, gfc_expr *handler) + { + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_c_int_kind; + + /* handler can be either BT_INTEGER or BT_PROCEDURE */ + if (handler->ts.type == BT_INTEGER) + { + if (handler->ts.kind != gfc_c_int_kind) + gfc_convert_type (handler, &f->ts, 2); + f->value.function.name = gfc_get_string (PREFIX("signal_func_int")); + } + else + f->value.function.name = gfc_get_string (PREFIX("signal_func")); + + if (number->ts.kind != gfc_c_int_kind) + gfc_convert_type (number, &f->ts, 2); + } + + + void gfc_resolve_sin (gfc_expr * f, gfc_expr * x) { f->ts = x->ts; *************** gfc_resolve_spread (gfc_expr * f, gfc_ex *** 1337,1345 **** gfc_expr * dim, gfc_expr * ncopies) { f->ts = source->ts; f->rank = source->rank + 1; ! f->value.function.name = PREFIX("spread"); gfc_resolve_dim_arg (dim); gfc_resolve_index (ncopies, 1); --- 1607,1625 ---- gfc_expr * dim, gfc_expr * ncopies) { + if (source->ts.type == BT_CHARACTER) + check_charlen_present (source); + f->ts = source->ts; f->rank = source->rank + 1; ! if (source->rank == 0) ! f->value.function.name = (source->ts.type == BT_CHARACTER ! ? PREFIX("spread_char_scalar") ! : PREFIX("spread_scalar")); ! else ! f->value.function.name = (source->ts.type == BT_CHARACTER ! ? PREFIX("spread_char") ! : PREFIX("spread")); gfc_resolve_dim_arg (dim); gfc_resolve_index (ncopies, 1); *************** gfc_resolve_fstat (gfc_expr * f, gfc_exp *** 1380,1385 **** --- 1660,1743 ---- void + gfc_resolve_fgetc (gfc_expr * f, gfc_expr * u, gfc_expr * c ATTRIBUTE_UNUSED) + { + gfc_typespec ts; + + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_c_int_kind; + if (u->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (u, &ts, 2); + } + + f->value.function.name = gfc_get_string (PREFIX("fgetc")); + } + + + void + gfc_resolve_fget (gfc_expr * f, gfc_expr * c ATTRIBUTE_UNUSED) + { + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_c_int_kind; + f->value.function.name = gfc_get_string (PREFIX("fget")); + } + + + void + gfc_resolve_fputc (gfc_expr * f, gfc_expr * u, gfc_expr * c ATTRIBUTE_UNUSED) + { + gfc_typespec ts; + + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_c_int_kind; + if (u->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (u, &ts, 2); + } + + f->value.function.name = gfc_get_string (PREFIX("fputc")); + } + + + void + gfc_resolve_fput (gfc_expr * f, gfc_expr * c ATTRIBUTE_UNUSED) + { + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_c_int_kind; + f->value.function.name = gfc_get_string (PREFIX("fput")); + } + + + void + gfc_resolve_ftell (gfc_expr * f, gfc_expr * u) + { + gfc_typespec ts; + + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_index_integer_kind; + if (u->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (u, &ts, 2); + } + + f->value.function.name = gfc_get_string (PREFIX("ftell")); + } + + + void gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim, gfc_expr * mask) { *************** gfc_resolve_transpose (gfc_expr * f, gfc *** 1496,1501 **** --- 1854,1861 ---- { case 4: case 8: + case 10: + case 16: switch (matrix->ts.type) { case BT_COMPLEX: *************** gfc_resolve_transpose (gfc_expr * f, gfc *** 1519,1525 **** break; default: ! f->value.function.name = PREFIX("transpose"); } } --- 1879,1888 ---- break; default: ! f->value.function.name = (matrix->ts.type == BT_CHARACTER ! ? PREFIX("transpose_char") ! : PREFIX("transpose")); ! break; } } *************** gfc_resolve_unlink (gfc_expr * f, gfc_ex *** 1574,1589 **** f->value.function.name = gfc_get_string (PREFIX("unlink")); } void gfc_resolve_unpack (gfc_expr * f, gfc_expr * vector, gfc_expr * mask, gfc_expr * field ATTRIBUTE_UNUSED) { ! f->ts.type = vector->ts.type; ! f->ts.kind = vector->ts.kind; f->rank = mask->rank; f->value.function.name = ! gfc_get_string (PREFIX("unpack%d"), field->rank > 0 ? 1 : 0); } --- 1937,1974 ---- f->value.function.name = gfc_get_string (PREFIX("unlink")); } + + void + gfc_resolve_ttynam (gfc_expr * f, gfc_expr * unit) + { + gfc_typespec ts; + + f->ts.type = BT_CHARACTER; + f->ts.kind = gfc_default_character_kind; + + if (unit->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (unit, &ts, 2); + } + + f->value.function.name = gfc_get_string (PREFIX("ttynam")); + } + + void gfc_resolve_unpack (gfc_expr * f, gfc_expr * vector, gfc_expr * mask, gfc_expr * field ATTRIBUTE_UNUSED) { ! f->ts = vector->ts; f->rank = mask->rank; f->value.function.name = ! gfc_get_string (PREFIX("unpack%d%s"), field->rank > 0 ? 1 : 0, ! vector->ts.type == BT_CHARACTER ? "_char" : ""); } *************** gfc_resolve_verify (gfc_expr * f, gfc_ex *** 1598,1606 **** --- 1983,2042 ---- } + void + gfc_resolve_xor (gfc_expr * f, gfc_expr * i, gfc_expr * j) + { + f->ts.type = i->ts.type; + f->ts.kind = gfc_kind_max (i,j); + + if (i->ts.kind != j->ts.kind) + { + if (i->ts.kind == gfc_kind_max (i,j)) + gfc_convert_type(j, &i->ts, 2); + else + gfc_convert_type(i, &j->ts, 2); + } + + f->value.function.name = gfc_get_string ("__xor_%c%d", + gfc_type_letter (i->ts.type), + f->ts.kind); + } + + /* Intrinsic subroutine resolution. */ void + gfc_resolve_alarm_sub (gfc_code * c) + { + const char *name; + gfc_expr *seconds, *handler, *status; + gfc_typespec ts; + + seconds = c->ext.actual->expr; + handler = c->ext.actual->next->expr; + status = c->ext.actual->next->next->expr; + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + + /* handler can be either BT_INTEGER or BT_PROCEDURE */ + if (handler->ts.type == BT_INTEGER) + { + if (handler->ts.kind != gfc_c_int_kind) + gfc_convert_type (handler, &ts, 2); + name = gfc_get_string (PREFIX("alarm_sub_int")); + } + else + name = gfc_get_string (PREFIX("alarm_sub")); + + if (seconds->ts.kind != gfc_c_int_kind) + gfc_convert_type (seconds, &ts, 2); + if (status != NULL && status->ts.kind != gfc_c_int_kind) + gfc_convert_type (status, &ts, 2); + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); + } + + void gfc_resolve_cpu_time (gfc_code * c ATTRIBUTE_UNUSED) { const char *name; *************** gfc_resolve_get_environment_variable (gf *** 1826,1831 **** --- 2262,2298 ---- code->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } + void + gfc_resolve_signal_sub (gfc_code * c) + { + const char *name; + gfc_expr *number, *handler, *status; + gfc_typespec ts; + + number = c->ext.actual->expr; + handler = c->ext.actual->next->expr; + status = c->ext.actual->next->next->expr; + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + + /* handler can be either BT_INTEGER or BT_PROCEDURE */ + if (handler->ts.type == BT_INTEGER) + { + if (handler->ts.kind != gfc_c_int_kind) + gfc_convert_type (handler, &ts, 2); + name = gfc_get_string (PREFIX("signal_sub_int")); + } + else + name = gfc_get_string (PREFIX("signal_sub")); + + if (number->ts.kind != gfc_c_int_kind) + gfc_convert_type (number, &ts, 2); + if (status != NULL && status->ts.kind != gfc_c_int_kind) + gfc_convert_type (status, &ts, 2); + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); + } + /* Resolve the SYSTEM intrinsic subroutine. */ void *************** gfc_resolve_flush (gfc_code * c) *** 1897,1902 **** --- 2364,2411 ---- void + gfc_resolve_free (gfc_code * c) + { + gfc_typespec ts; + gfc_expr *n; + + ts.type = BT_INTEGER; + ts.kind = gfc_index_integer_kind; + n = c->ext.actual->expr; + if (n->ts.kind != ts.kind) + gfc_convert_type (n, &ts, 2); + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("free")); + } + + + void + gfc_resolve_ctime_sub (gfc_code * c) + { + gfc_typespec ts; + + /* ctime TIME argument is a INTEGER(KIND=8), says the doc */ + if (c->ext.actual->expr->ts.kind != 8) + { + ts.type = BT_INTEGER; + ts.kind = 8; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (c->ext.actual->expr, &ts, 2); + } + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("ctime_sub")); + } + + + void + gfc_resolve_fdate_sub (gfc_code * c) + { + c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub")); + } + + + void gfc_resolve_gerror (gfc_code * c) { c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror")); *************** gfc_resolve_fstat_sub (gfc_code * c) *** 1961,1966 **** --- 2470,2588 ---- void + gfc_resolve_fgetc_sub (gfc_code * c) + { + const char *name; + gfc_typespec ts; + gfc_expr *u, *st; + + u = c->ext.actual->expr; + st = c->ext.actual->next->next->expr; + + if (u->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (u, &ts, 2); + } + + if (st != NULL) + name = gfc_get_string (PREFIX("fgetc_i%d_sub"), st->ts.kind); + else + name = gfc_get_string (PREFIX("fgetc_i%d_sub"), gfc_default_integer_kind); + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); + } + + + void + gfc_resolve_fget_sub (gfc_code * c) + { + const char *name; + gfc_expr *st; + + st = c->ext.actual->next->expr; + if (st != NULL) + name = gfc_get_string (PREFIX("fget_i%d_sub"), st->ts.kind); + else + name = gfc_get_string (PREFIX("fget_i%d_sub"), gfc_default_integer_kind); + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); + } + + + void + gfc_resolve_fputc_sub (gfc_code * c) + { + const char *name; + gfc_typespec ts; + gfc_expr *u, *st; + + u = c->ext.actual->expr; + st = c->ext.actual->next->next->expr; + + if (u->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (u, &ts, 2); + } + + if (st != NULL) + name = gfc_get_string (PREFIX("fputc_i%d_sub"), st->ts.kind); + else + name = gfc_get_string (PREFIX("fputc_i%d_sub"), gfc_default_integer_kind); + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); + } + + + void + gfc_resolve_fput_sub (gfc_code * c) + { + const char *name; + gfc_expr *st; + + st = c->ext.actual->next->expr; + if (st != NULL) + name = gfc_get_string (PREFIX("fput_i%d_sub"), st->ts.kind); + else + name = gfc_get_string (PREFIX("fput_i%d_sub"), gfc_default_integer_kind); + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); + } + + + void + gfc_resolve_ftell_sub (gfc_code * c) + { + const char *name; + gfc_expr *unit; + gfc_expr *offset; + gfc_typespec ts; + + unit = c->ext.actual->expr; + offset = c->ext.actual->next->expr; + + if (unit->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (unit, &ts, 2); + } + + name = gfc_get_string (PREFIX("ftell_i%d_sub"), offset->ts.kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); + } + + + void gfc_resolve_ttynam_sub (gfc_code * c) { gfc_typespec ts; diff -Nrcpad gcc-4.0.2/gcc/fortran/lang-specs.h gcc-4.1.0/gcc/fortran/lang-specs.h *** gcc-4.0.2/gcc/fortran/lang-specs.h Sat May 15 17:31:32 2004 --- gcc-4.1.0/gcc/fortran/lang-specs.h Fri Jan 27 20:03:59 2006 *************** *** 1,6 **** /* Contribution to the specs for the GNU Compiler Collection from GNU Fortran 95 compiler. ! Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. This file is licensed under the GPL. */ --- 1,6 ---- /* Contribution to the specs for the GNU Compiler Collection from GNU Fortran 95 compiler. ! Copyright (C) 2002, 2003, 2004, 2006 Free Software Foundation, Inc. This file is licensed under the GPL. */ *************** This file is licensed under the GPL. */ *** 11,29 **** {".fpp", "@f77-cpp-input", 0, 0, 0}, {".FPP", "@f77-cpp-input", 0, 0, 0}, {"@f77-cpp-input", ! "cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ %{E|M|MM:%(cpp_debug_options)}\ %{!M:%{!MM:%{!E: -o %|.f |\n\ f951 %|.f %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\ ! %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0}, {".F90", "@f95-cpp-input", 0, 0, 0}, {".F95", "@f95-cpp-input", 0, 0, 0}, {"@f95-cpp-input", ! "cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ %{E|M|MM:%(cpp_debug_options)}\ %{!M:%{!MM:%{!E: -o %|.f95 |\n\ f951 %|.f95 %(cc1_options) %{J*} %{I*}\ ! %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0}, {".f90", "@f95", 0, 0, 0}, {".f95", "@f95", 0, 0, 0}, {"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\ --- 11,29 ---- {".fpp", "@f77-cpp-input", 0, 0, 0}, {".FPP", "@f77-cpp-input", 0, 0, 0}, {"@f77-cpp-input", ! "cc1 -E -lang-fortran -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ %{E|M|MM:%(cpp_debug_options)}\ %{!M:%{!MM:%{!E: -o %|.f |\n\ f951 %|.f %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\ ! -fpreprocessed %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0}, {".F90", "@f95-cpp-input", 0, 0, 0}, {".F95", "@f95-cpp-input", 0, 0, 0}, {"@f95-cpp-input", ! "cc1 -E -lang-fortran -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ %{E|M|MM:%(cpp_debug_options)}\ %{!M:%{!MM:%{!E: -o %|.f95 |\n\ f951 %|.f95 %(cc1_options) %{J*} %{I*}\ ! -fpreprocessed %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0}, {".f90", "@f95", 0, 0, 0}, {".f95", "@f95", 0, 0, 0}, {"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\ diff -Nrcpad gcc-4.0.2/gcc/fortran/lang.opt gcc-4.1.0/gcc/fortran/lang.opt *** gcc-4.0.2/gcc/fortran/lang.opt Wed Aug 31 12:39:27 2005 --- gcc-4.1.0/gcc/fortran/lang.opt Wed Feb 8 20:14:00 2006 *************** *** 1,5 **** ; Options for the Fortran 95 front end. ! ; Copyright (C) 2003, 2004 Free Software Foundation, Inc. ; ; This file is part of GCC. ; --- 1,5 ---- ; Options for the Fortran 95 front end. ! ; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc. ; ; This file is part of GCC. ; *************** *** 15,176 **** ; ; You should have received a copy of the GNU General Public License ; along with GCC; see the file COPYING. If not, write to the Free ! ; Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! ; 02111-1307, USA. ! ; See c.opt for a description of this file's format. ; Please try to keep this file in ASCII collating order. Language ! F95 I ! F95 Joined -I Add a directory for INCLUDE and MODULE searching J ! F95 Joined -J Put MODULE files in 'directory' Wall ! F95 RejectNegative ; Documented in C Waliasing ! F95 Warn about possible aliasing of dummy arguments Wconversion ! F95 Warn about implicit conversion Wimplicit-interface ! F95 Warn about calls with implicit interface Wline-truncation ! F95 Warn about truncated source lines Wnonstd-intrinsics ! F95 Warn about usage of non-standard intrinsics Wsurprising ! F95 Warn about \"suspicious\" constructs Wunderflow ! F95 Warn about underflow of numerical constant expressions Wunused-labels ! F95 Warn when a label is unused fdefault-double-8 ! F95 Set the default double precision kind to an 8 byte wide type fdefault-integer-8 ! F95 Set the default integer kind to an 8 byte wide type fdefault-real-8 ! F95 Set the default real kind to an 8 byte wide type ! fdollar-ok ! F95 ! Allow dollar signs in entity names ! fautomatic ! F95 ! Do not treat local variables and COMMON blocks as if they were named in SAVE statements ! fbackslash ! F95 ! Specify that backslash in string introduces an escape character fdump-parse-tree ! F95 ! Display the code tree after parsing. ff2c ! F95 ! Use f2c calling convention. ffixed-form ! F95 Assume that the source file is fixed form ffree-form ! F95 Assume that the source file is free form funderscoring ! F95 Append underscores to externally visible names fsecond-underscore ! F95 Append a second underscore if the name already contains an underscore fimplicit-none ! F95 Specify that no implicit typing is allowed, unless overridden by explicit IMPLICIT statements ffixed-line-length-none ! F95 RejectNegative Allow arbitrary character line width in fixed mode ffixed-line-length- ! F95 RejectNegative Joined UInteger -ffixed-line-length- Use n as character line width in fixed mode fmax-identifier-length= ! F95 RejectNegative Joined UInteger ! -fmax-identifier-length= Maximum identifier length. fmax-stack-var-size= ! F95 RejectNegative Joined UInteger -fmax-stack-var-size= Size in bytes of the largest array that will be put on the stack fmodule-private ! F95 Set default accessibility of module entities to PRIVATE fno-backend ! F95 RejectNegative Don't generate code, just do syntax and semantics checking fpack-derived ! F95 Try to layout derived types as compact as possible frepack-arrays ! F95 Copy array sections into a contiguous block on procedure entry qkind= ! F95 RejectNegative Joined UInteger -qkind= Set the kind for a real with the 'q' exponent to 'n' std=f95 ! F95 ! Conform to the ISO Fortran 95 standard. std=f2003 ! F95 ! Conform to the ISO Fortran 2003 standard. std=gnu ! F95 ! Conform nothing in particular. std=legacy ! F95 ! Accept extensions to support legacy code. ; This comment is to ensure we retain the blank line above. --- 15,224 ---- ; ; You should have received a copy of the GNU General Public License ; along with GCC; see the file COPYING. If not, write to the Free ! ; Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! ; 02110-1301, USA. ! ; See the GCC internals manual for a description of this file's format. ; Please try to keep this file in ASCII collating order. Language ! Fortran I ! Fortran Joined -I Add a directory for INCLUDE and MODULE searching J ! Fortran Joined -J Put MODULE files in 'directory' Wall ! Fortran RejectNegative ; Documented in C Waliasing ! Fortran Warn about possible aliasing of dummy arguments Wconversion ! Fortran Warn about implicit conversion Wimplicit-interface ! Fortran Warn about calls with implicit interface Wline-truncation ! Fortran Warn about truncated source lines Wnonstd-intrinsics ! Fortran Warn about usage of non-standard intrinsics Wsurprising ! Fortran Warn about \"suspicious\" constructs Wunderflow ! Fortran Warn about underflow of numerical constant expressions Wunused-labels ! Fortran Warn when a label is unused + fautomatic + Fortran + Do not treat local variables and COMMON blocks as if they were named in SAVE statements + + fbackslash + Fortran + Specify that backslash in string introduces an escape character + fdefault-double-8 ! Fortran Set the default double precision kind to an 8 byte wide type fdefault-integer-8 ! Fortran Set the default integer kind to an 8 byte wide type fdefault-real-8 ! Fortran Set the default real kind to an 8 byte wide type ! fd-lines-as-code ! Fortran RejectNegative ! Ignore 'D' in column one in fixed form ! fd-lines-as-comments ! Fortran RejectNegative ! Treat lines with 'D' in column one as comments ! fdollar-ok ! Fortran ! Allow dollar signs in entity names fdump-parse-tree ! Fortran ! Display the code tree after parsing ff2c ! Fortran ! Use f2c calling convention ffixed-form ! Fortran Assume that the source file is fixed form ffree-form ! Fortran Assume that the source file is free form funderscoring ! Fortran Append underscores to externally visible names + fcray-pointer + Fortran + Use the Cray Pointer extension + fsecond-underscore ! Fortran Append a second underscore if the name already contains an underscore fimplicit-none ! Fortran Specify that no implicit typing is allowed, unless overridden by explicit IMPLICIT statements ffixed-line-length-none ! Fortran RejectNegative Allow arbitrary character line width in fixed mode ffixed-line-length- ! Fortran RejectNegative Joined UInteger -ffixed-line-length- Use n as character line width in fixed mode + ffree-line-length-none + Fortran RejectNegative + Allow arbitrary character line width in free mode + + ffree-line-length- + Fortran RejectNegative Joined UInteger + -ffree-line-length- Use n as character line width in free mode + fmax-identifier-length= ! Fortran RejectNegative Joined UInteger ! -fmax-identifier-length= Maximum identifier length fmax-stack-var-size= ! Fortran RejectNegative Joined UInteger -fmax-stack-var-size= Size in bytes of the largest array that will be put on the stack fmodule-private ! Fortran Set default accessibility of module entities to PRIVATE fno-backend ! Fortran RejectNegative Don't generate code, just do syntax and semantics checking fpack-derived ! Fortran Try to layout derived types as compact as possible frepack-arrays ! Fortran Copy array sections into a contiguous block on procedure entry + fpreprocessed + Fortran + Treat the input file as preprocessed + qkind= ! Fortran RejectNegative Joined UInteger -qkind= Set the kind for a real with the 'q' exponent to 'n' + ffpe-trap= + Fortran RejectNegative JoinedOrMissing + -ffpe-trap=[..] Stop on following floating point exceptions + std=f95 ! Fortran ! Conform to the ISO Fortran 95 standard std=f2003 ! Fortran ! Conform to the ISO Fortran 2003 standard std=gnu ! Fortran ! Conform nothing in particular std=legacy ! Fortran ! Accept extensions to support legacy code ! ! fshort-enums ! Fortran ! Use the narrowest integer type possible for enumeration types ! ! fconvert=little-endian ! Fortran RejectNegative ! Use little-endian format for unformatted files ! ! fconvert=big-endian ! Fortran RejectNegative ! Use big-endian format for unformatted files ! ! fconvert=native ! Fortran RejectNegative ! Use native format for unformatted files ! ! fconvert=swap ! Fortran RejectNegative ! Swap endianness for unformatted files ; This comment is to ensure we retain the blank line above. diff -Nrcpad gcc-4.0.2/gcc/fortran/match.c gcc-4.1.0/gcc/fortran/match.c *** gcc-4.0.2/gcc/fortran/match.c Fri Sep 9 09:05:52 2005 --- gcc-4.1.0/gcc/fortran/match.c Sun Feb 12 18:31:40 2006 *************** *** 1,6 **** /* Matching subroutines in all sizes, shapes and colors. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, ! Inc. Contributed by Andy Vaught This file is part of GCC. --- 1,6 ---- /* Matching subroutines in all sizes, shapes and colors. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 ! Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** mstring intrinsic_operators[] = { *** 58,63 **** --- 58,64 ---- minit (".gt.", INTRINSIC_GT), minit (">", INTRINSIC_GT), minit (".not.", INTRINSIC_NOT), + minit ("parens", INTRINSIC_PARENTHESES), minit (NULL, INTRINSIC_NONE) }; *************** gfc_match_eos (void) *** 141,156 **** old-style character length specifications. */ match ! gfc_match_small_literal_int (int *value) { locus old_loc; char c; ! int i; old_loc = gfc_current_locus; gfc_gobble_whitespace (); c = gfc_next_char (); if (!ISDIGIT (c)) { --- 142,158 ---- old-style character length specifications. */ match ! gfc_match_small_literal_int (int *value, int *cnt) { locus old_loc; char c; ! int i, j; old_loc = gfc_current_locus; gfc_gobble_whitespace (); c = gfc_next_char (); + *cnt = 0; if (!ISDIGIT (c)) { *************** gfc_match_small_literal_int (int *value) *** 159,164 **** --- 161,167 ---- } i = c - '0'; + j = 1; for (;;) { *************** gfc_match_small_literal_int (int *value) *** 169,174 **** --- 172,178 ---- break; i = 10 * i + c - '0'; + j++; if (i > 99999999) { *************** gfc_match_small_literal_int (int *value) *** 180,185 **** --- 184,190 ---- gfc_current_locus = old_loc; *value = i; + *cnt = j; return MATCH_YES; } *************** gfc_match_small_int (int *value) *** 217,241 **** do most of the work. */ match ! gfc_match_st_label (gfc_st_label ** label, int allow_zero) { locus old_loc; match m; ! int i; old_loc = gfc_current_locus; ! m = gfc_match_small_literal_int (&i); if (m != MATCH_YES) return m; ! if (((i == 0) && allow_zero) || i <= 99999) { ! *label = gfc_get_st_label (i); ! return MATCH_YES; } ! gfc_error ("Statement label at %C is out of range"); gfc_current_locus = old_loc; return MATCH_ERROR; } --- 222,256 ---- do most of the work. */ match ! gfc_match_st_label (gfc_st_label ** label) { locus old_loc; match m; ! int i, cnt; old_loc = gfc_current_locus; ! m = gfc_match_small_literal_int (&i, &cnt); if (m != MATCH_YES) return m; ! if (cnt > 5) { ! gfc_error ("Too many digits in statement label at %C"); ! goto cleanup; } ! if (i == 0) ! { ! gfc_error ("Statement label at %C is zero"); ! goto cleanup; ! } ! ! *label = gfc_get_st_label (i); ! return MATCH_YES; ! ! cleanup: ! gfc_current_locus = old_loc; return MATCH_ERROR; } *************** gfc_match_symbol (gfc_symbol ** matched_ *** 447,452 **** --- 462,469 ---- else *matched_symbol = NULL; } + else + *matched_symbol = NULL; return m; } *************** loop: *** 688,694 **** case 'l': label = va_arg (argp, gfc_st_label **); ! n = gfc_match_st_label (label, 0); if (n != MATCH_YES) { m = n; --- 705,711 ---- case 'l': label = va_arg (argp, gfc_st_label **); ! n = gfc_match_st_label (label); if (n != MATCH_YES) { m = n; *************** gfc_match_if (gfc_statement * if_type) *** 1072,1077 **** --- 1089,1095 ---- match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE) match ("end file", gfc_match_endfile, ST_END_FILE) match ("exit", gfc_match_exit, ST_EXIT) + match ("flush", gfc_match_flush, ST_FLUSH) match ("forall", match_simple_forall, ST_FORALL) match ("go to", gfc_match_goto, ST_GOTO) match ("if", match_arithmetic_if, ST_ARITHMETIC_IF) *************** gfc_match_do (void) *** 1239,1245 **** if (gfc_match (" do") != MATCH_YES) return MATCH_NO; ! m = gfc_match_st_label (&label, 0); if (m == MATCH_ERROR) goto cleanup; --- 1257,1263 ---- if (gfc_match (" do") != MATCH_YES) return MATCH_NO; ! m = gfc_match_st_label (&label); if (m == MATCH_ERROR) goto cleanup; *************** gfc_match_do (void) *** 1272,1278 **** gfc_match_label (); /* This won't error */ gfc_match (" do "); /* This will work */ ! gfc_match_st_label (&label, 0); /* Can't error out */ gfc_match_char (','); /* Optional comma */ m = gfc_match_iterator (&iter, 0); --- 1290,1296 ---- gfc_match_label (); /* This won't error */ gfc_match (" do "); /* This will work */ ! gfc_match_st_label (&label); /* Can't error out */ gfc_match_char (','); /* Optional comma */ m = gfc_match_iterator (&iter, 0); *************** gfc_match_stopcode (gfc_statement st) *** 1401,1419 **** int stop_code; gfc_expr *e; match m; ! stop_code = 0; e = NULL; if (gfc_match_eos () != MATCH_YES) { ! m = gfc_match_small_literal_int (&stop_code); if (m == MATCH_ERROR) goto cleanup; ! if (m == MATCH_YES && stop_code > 99999) { ! gfc_error ("STOP code out of range at %C"); goto cleanup; } --- 1419,1438 ---- int stop_code; gfc_expr *e; match m; + int cnt; ! stop_code = -1; e = NULL; if (gfc_match_eos () != MATCH_YES) { ! m = gfc_match_small_literal_int (&stop_code, &cnt); if (m == MATCH_ERROR) goto cleanup; ! if (m == MATCH_YES && cnt > 5) { ! gfc_error ("Too many digits in STOP code at %C"); goto cleanup; } *************** gfc_match_goto (void) *** 1582,1588 **** do { ! m = gfc_match_st_label (&label, 0); if (m != MATCH_YES) goto syntax; --- 1601,1607 ---- do { ! m = gfc_match_st_label (&label); if (m != MATCH_YES) goto syntax; *************** gfc_match_goto (void) *** 1628,1634 **** do { ! m = gfc_match_st_label (&label, 0); if (m != MATCH_YES) goto syntax; --- 1647,1653 ---- do { ! m = gfc_match_st_label (&label); if (m != MATCH_YES) goto syntax; *************** syntax: *** 1869,1875 **** gfc_syntax_error (ST_NULLIFY); cleanup: ! gfc_free_statements (tail); return MATCH_ERROR; } --- 1888,1894 ---- gfc_syntax_error (ST_NULLIFY); cleanup: ! gfc_free_statements (new_st.next); return MATCH_ERROR; } *************** done: *** 2031,2042 **** /* Match a CALL statement. The tricky part here are possible alternate return specifiers. We handle these by having all - gfc_enclosing_unit (&s); - if (s == COMP_PROGRAM - && gfc_notify_std (GFC_STD_GNU, "Extension: RETURN statement in " - "main program at %C") == FAILURE) - return MATCH_ERROR; - "subroutines" actually return an integer via a register that gives the return number. If the call specifies alternate returns, we generate code for a SELECT statement whose case clauses contain --- 2050,2055 ---- *************** gfc_match_common (void) *** 2235,2240 **** --- 2248,2254 ---- gfc_array_spec *as; gfc_equiv * e1, * e2; match m; + gfc_gsymbol *gsym; old_blank_common = gfc_current_ns->blank_common.head; if (old_blank_common) *************** gfc_match_common (void) *** 2251,2256 **** --- 2265,2287 ---- if (m == MATCH_ERROR) goto cleanup; + gsym = gfc_get_gsymbol (name); + if (gsym->type != GSYM_UNKNOWN && gsym->type != GSYM_COMMON) + { + gfc_error ("Symbol '%s' at %C is already an external symbol that is not COMMON", + sym->name); + goto cleanup; + } + + if (gsym->type == GSYM_UNKNOWN) + { + gsym->type = GSYM_COMMON; + gsym->where = gfc_current_locus; + gsym->defined = 1; + } + + gsym->used = 1; + if (name[0] == '\0') { t = &gfc_current_ns->blank_common; *************** gfc_match_namelist (void) *** 2492,2497 **** --- 2523,2536 ---- return MATCH_ERROR; } + if (group_name->attr.flavor == FL_NAMELIST + && group_name->attr.use_assoc + && gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' " + "at %C already is USE associated and can" + "not be respecified.", group_name->name) + == FAILURE) + return MATCH_ERROR; + if (group_name->attr.flavor != FL_NAMELIST && gfc_add_flavor (&group_name->attr, FL_NAMELIST, group_name->name, NULL) == FAILURE) *************** gfc_match_namelist (void) *** 2509,2514 **** --- 2548,2568 ---- && gfc_add_in_namelist (&sym->attr, sym->name, NULL) == FAILURE) goto error; + /* Use gfc_error_check here, rather than goto error, so that this + these are the only errors for the next two lines. */ + if (sym->as && sym->as->type == AS_ASSUMED_SIZE) + { + gfc_error ("Assumed size array '%s' in namelist '%s'at " + "%C is not allowed.", sym->name, group_name->name); + gfc_error_check (); + } + + if (sym->as && sym->as->type == AS_ASSUMED_SHAPE + && gfc_notify_std (GFC_STD_GNU, "Assumed shape array '%s' in " + "namelist '%s' at %C is an extension.", + sym->name, group_name->name) == FAILURE) + gfc_error_check (); + nl = gfc_get_namelist (); nl->sym = sym; *************** gfc_match_equivalence (void) *** 2599,2604 **** --- 2653,2659 ---- match m; gfc_common_head *common_head = NULL; bool common_flag; + int cnt; tail = NULL; *************** gfc_match_equivalence (void) *** 2616,2621 **** --- 2671,2677 ---- set = eq; common_flag = FALSE; + cnt = 0; for (;;) { *************** gfc_match_equivalence (void) *** 2625,2630 **** --- 2681,2696 ---- if (m == MATCH_NO) goto syntax; + /* count the number of objects. */ + cnt++; + + if (gfc_match_char ('%') == MATCH_YES) + { + gfc_error ("Derived type component %C is not a " + "permitted EQUIVALENCE member"); + goto cleanup; + } + for (ref = set->expr->ref; ref; ref = ref->next) if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION) { *************** gfc_match_equivalence (void) *** 2634,2649 **** goto cleanup; } ! if (set->expr->symtree->n.sym->attr.in_common) { common_flag = TRUE; ! common_head = set->expr->symtree->n.sym->common_head; } - set->expr->symtree->n.sym->attr.in_equivalence = 1; - if (gfc_match_char (')') == MATCH_YES) break; if (gfc_match_char (',') != MATCH_YES) goto syntax; --- 2700,2720 ---- goto cleanup; } ! sym = set->expr->symtree->n.sym; ! ! if (gfc_add_in_equivalence (&sym->attr, sym->name, NULL) ! == FAILURE) ! goto cleanup; ! ! if (sym->attr.in_common) { common_flag = TRUE; ! common_head = sym->common_head; } if (gfc_match_char (')') == MATCH_YES) break; + if (gfc_match_char (',') != MATCH_YES) goto syntax; *************** gfc_match_equivalence (void) *** 2651,2656 **** --- 2722,2733 ---- set = set->eq; } + if (cnt < 2) + { + gfc_error ("EQUIVALENCE at %C requires two or more objects"); + goto cleanup; + } + /* If one of the members of an equivalence is in common, then mark them all as being in common. Before doing this, check that members of the equivalence group are not in different *************** cleanup: *** 2692,2697 **** --- 2769,2859 ---- return MATCH_ERROR; } + /* Check that a statement function is not recursive. This is done by looking + for the statement function symbol(sym) by looking recursively through its + expression(e). If a reference to sym is found, true is returned. */ + static bool + recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym) + { + gfc_actual_arglist *arg; + gfc_ref *ref; + int i; + + if (e == NULL) + return false; + + switch (e->expr_type) + { + case EXPR_FUNCTION: + for (arg = e->value.function.actual; arg; arg = arg->next) + { + if (sym->name == arg->name + || recursive_stmt_fcn (arg->expr, sym)) + return true; + } + + if (e->symtree == NULL) + return false; + + /* Check the name before testing for nested recursion! */ + if (sym->name == e->symtree->n.sym->name) + return true; + + /* Catch recursion via other statement functions. */ + if (e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION + && e->symtree->n.sym->value + && recursive_stmt_fcn (e->symtree->n.sym->value, sym)) + return true; + + break; + + case EXPR_VARIABLE: + if (e->symtree && sym->name == e->symtree->n.sym->name) + return true; + break; + + case EXPR_OP: + if (recursive_stmt_fcn (e->value.op.op1, sym) + || recursive_stmt_fcn (e->value.op.op2, sym)) + return true; + break; + + default: + break; + } + + /* Component references do not need to be checked. */ + if (e->ref) + { + for (ref = e->ref; ref; ref = ref->next) + { + switch (ref->type) + { + case REF_ARRAY: + for (i = 0; i < ref->u.ar.dimen; i++) + { + if (recursive_stmt_fcn (ref->u.ar.start[i], sym) + || recursive_stmt_fcn (ref->u.ar.end[i], sym) + || recursive_stmt_fcn (ref->u.ar.stride[i], sym)) + return true; + } + break; + + case REF_SUBSTRING: + if (recursive_stmt_fcn (ref->u.ss.start, sym) + || recursive_stmt_fcn (ref->u.ss.end, sym)) + return true; + + break; + + default: + break; + } + } + } + return false; + } + /* Match a statement function declaration. It is so easy to match non-statement function statements with a MATCH_ERROR as opposed to *************** gfc_match_st_function (void) *** 2726,2731 **** --- 2888,2900 ---- if (m == MATCH_ERROR) return m; + if (recursive_stmt_fcn (expr, sym)) + { + gfc_error ("Statement function at %L is recursive", + &expr->where); + return MATCH_ERROR; + } + sym->value = expr; return MATCH_YES; *************** static match *** 3196,3207 **** match_forall_header (gfc_forall_iterator ** phead, gfc_expr ** mask) { gfc_forall_iterator *head, *tail, *new; match m; gfc_gobble_whitespace (); head = tail = NULL; ! *mask = NULL; if (gfc_match_char ('(') != MATCH_YES) return MATCH_NO; --- 3365,3377 ---- match_forall_header (gfc_forall_iterator ** phead, gfc_expr ** mask) { gfc_forall_iterator *head, *tail, *new; + gfc_expr *msk; match m; gfc_gobble_whitespace (); head = tail = NULL; ! msk = NULL; if (gfc_match_char ('(') != MATCH_YES) return MATCH_NO; *************** match_forall_header (gfc_forall_iterator *** 3222,3227 **** --- 3392,3398 ---- m = match_forall_iterator (&new); if (m == MATCH_ERROR) goto cleanup; + if (m == MATCH_YES) { tail->next = new; *************** match_forall_header (gfc_forall_iterator *** 3231,3237 **** /* Have to have a mask expression */ ! m = gfc_match_expr (mask); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) --- 3402,3408 ---- /* Have to have a mask expression */ ! m = gfc_match_expr (&msk); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) *************** match_forall_header (gfc_forall_iterator *** 3244,3256 **** goto syntax; *phead = head; return MATCH_YES; syntax: gfc_syntax_error (ST_FORALL); cleanup: ! gfc_free_expr (*mask); gfc_free_forall_iterator (head); return MATCH_ERROR; --- 3415,3428 ---- goto syntax; *phead = head; + *mask = msk; return MATCH_YES; syntax: gfc_syntax_error (ST_FORALL); cleanup: ! gfc_free_expr (msk); gfc_free_forall_iterator (head); return MATCH_ERROR; diff -Nrcpad gcc-4.0.2/gcc/fortran/match.h gcc-4.1.0/gcc/fortran/match.h *** gcc-4.0.2/gcc/fortran/match.h Fri Sep 9 09:05:52 2005 --- gcc-4.1.0/gcc/fortran/match.h Sat Dec 31 18:55:30 2005 *************** *** 1,5 **** /* All matcher functions. ! Copyright (C) 2003 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. --- 1,5 ---- /* All matcher functions. ! Copyright (C) 2003, 2005 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef GFC_MATCH_H --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #ifndef GFC_MATCH_H *************** extern gfc_st_label *gfc_statement_label *** 40,47 **** /* Generic match subroutines */ match gfc_match_space (void); match gfc_match_eos (void); ! match gfc_match_small_literal_int (int *); ! match gfc_match_st_label (gfc_st_label **, int); match gfc_match_label (void); match gfc_match_small_int (int *); int gfc_match_strings (mstring *); --- 40,47 ---- /* Generic match subroutines */ match gfc_match_space (void); match gfc_match_eos (void); ! match gfc_match_small_literal_int (int *, int *); ! match gfc_match_st_label (gfc_st_label **); match gfc_match_label (void); match gfc_match_small_int (int *); int gfc_match_strings (mstring *); *************** match gfc_match_close (void); *** 155,160 **** --- 155,161 ---- match gfc_match_endfile (void); match gfc_match_backspace (void); match gfc_match_rewind (void); + match gfc_match_flush (void); match gfc_match_inquire (void); match gfc_match_read (void); match gfc_match_write (void); diff -Nrcpad gcc-4.0.2/gcc/fortran/matchexp.c gcc-4.1.0/gcc/fortran/matchexp.c *** gcc-4.0.2/gcc/fortran/matchexp.c Wed Feb 23 21:34:11 2005 --- gcc-4.1.0/gcc/fortran/matchexp.c Sun Feb 12 18:31:40 2006 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** Software Foundation, 59 Temple Place - S *** 26,32 **** #include "arith.h" #include "match.h" ! static char expression_syntax[] = "Syntax error in expression at %C"; /* Match a user-defined operator name. This is a normal name with a --- 26,32 ---- #include "arith.h" #include "match.h" ! static char expression_syntax[] = N_("Syntax error in expression at %C"); /* Match a user-defined operator name. This is a normal name with a *************** static match *** 128,133 **** --- 128,135 ---- match_primary (gfc_expr ** result) { match m; + gfc_expr *e; + locus where; m = gfc_match_literal_constant (result, 0); if (m != MATCH_NO) *************** match_primary (gfc_expr ** result) *** 141,151 **** if (m != MATCH_NO) return m; ! /* Match an expression in parenthesis. */ if (gfc_match_char ('(') != MATCH_YES) return MATCH_NO; ! m = gfc_match_expr (result); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) --- 143,155 ---- if (m != MATCH_NO) return m; ! /* Match an expression in parentheses. */ ! where = gfc_current_locus; ! if (gfc_match_char ('(') != MATCH_YES) return MATCH_NO; ! m = gfc_match_expr (&e); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) *************** match_primary (gfc_expr ** result) *** 155,160 **** --- 159,184 ---- if (m == MATCH_NO) gfc_error ("Expected a right parenthesis in expression at %C"); + /* Now we have the expression inside the parentheses, build the + expression pointing to it. By 7.1.7.2 the integrity of + parentheses is only conserved in numerical calculations, so we + don't bother to keep the parentheses otherwise. */ + if(!gfc_numeric_ts(&e->ts)) + *result = e; + else + { + gfc_expr *e2 = gfc_get_expr(); + + e2->expr_type = EXPR_OP; + e2->ts = e->ts; + e2->rank = e->rank; + e2->where = where; + e2->value.op.operator = INTRINSIC_PARENTHESES; + e2->value.op.op1 = e; + e2->value.op.op2 = NULL; + *result = e2; + } + if (m != MATCH_YES) { gfc_free_expr (*result); *************** gfc_match_expr (gfc_expr ** result) *** 852,857 **** --- 876,882 ---- for (;;) { + uop = NULL; m = match_defined_operator (&uop); if (m == MATCH_NO) break; diff -Nrcpad gcc-4.0.2/gcc/fortran/mathbuiltins.def gcc-4.1.0/gcc/fortran/mathbuiltins.def *** gcc-4.0.2/gcc/fortran/mathbuiltins.def Sun Aug 29 15:58:13 2004 --- gcc-4.1.0/gcc/fortran/mathbuiltins.def Fri Jun 24 23:12:32 2005 *************** *** 6,13 **** --- 6,16 ---- Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are also available. */ DEFINE_MATH_BUILTIN_C (ACOS, "acos", 0) + DEFINE_MATH_BUILTIN (ACOSH, "acosh", 0) DEFINE_MATH_BUILTIN_C (ASIN, "asin", 0) + DEFINE_MATH_BUILTIN (ASINH, "asinh", 0) DEFINE_MATH_BUILTIN_C (ATAN, "atan", 0) + DEFINE_MATH_BUILTIN (ATANH, "atanh", 0) DEFINE_MATH_BUILTIN (ATAN2, "atan2", 1) DEFINE_MATH_BUILTIN_C (COS, "cos", 0) DEFINE_MATH_BUILTIN_C (COSH, "cosh", 0) diff -Nrcpad gcc-4.0.2/gcc/fortran/misc.c gcc-4.1.0/gcc/fortran/misc.c *** gcc-4.0.2/gcc/fortran/misc.c Tue Jul 12 01:50:48 2005 --- gcc-4.1.0/gcc/fortran/misc.c Sat Sep 17 18:58:01 2005 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** gfc_open_file (const char *name) *** 105,140 **** } - /* Given a word, return the correct article. */ - - const char * - gfc_article (const char *word) - { - const char *p; - - switch (*word) - { - case 'a': - case 'A': - case 'e': - case 'E': - case 'i': - case 'I': - case 'o': - case 'O': - case 'u': - case 'U': - p = "an"; - break; - - default: - p = "a"; - } - - return p; - } - - /* Return a string for each type. */ const char * --- 105,110 ---- diff -Nrcpad gcc-4.0.2/gcc/fortran/module.c gcc-4.1.0/gcc/fortran/module.c *** gcc-4.0.2/gcc/fortran/module.c Fri Sep 9 09:05:53 2005 --- gcc-4.1.0/gcc/fortran/module.c Sun Feb 12 18:31:40 2006 *************** static char *atom_string, atom_name[MAX_ *** 827,853 **** static void bad_module (const char *) ATTRIBUTE_NORETURN; static void ! bad_module (const char *message) { ! const char *p; switch (iomode) { case IO_INPUT: ! p = "Reading"; break; case IO_OUTPUT: ! p = "Writing"; break; default: ! p = "???"; break; } - - fclose (module_fp); - - gfc_fatal_error ("%s module %s at line %d column %d: %s", p, - module_name, module_line, module_column, message); } --- 827,851 ---- static void bad_module (const char *) ATTRIBUTE_NORETURN; static void ! bad_module (const char *msgid) { ! fclose (module_fp); switch (iomode) { case IO_INPUT: ! gfc_fatal_error ("Reading module %s at line %d column %d: %s", ! module_name, module_line, module_column, msgid); break; case IO_OUTPUT: ! gfc_fatal_error ("Writing module %s at line %d column %d: %s", ! module_name, module_line, module_column, msgid); break; default: ! gfc_fatal_error ("Module %s at line %d column %d: %s", ! module_name, module_line, module_column, msgid); break; } } *************** require_atom (atom_type type) *** 1154,1172 **** switch (type) { case ATOM_NAME: ! p = "Expected name"; break; case ATOM_LPAREN: ! p = "Expected left parenthesis"; break; case ATOM_RPAREN: ! p = "Expected right parenthesis"; break; case ATOM_INTEGER: ! p = "Expected integer"; break; case ATOM_STRING: ! p = "Expected string"; break; default: gfc_internal_error ("require_atom(): bad atom type required"); --- 1152,1170 ---- switch (type) { case ATOM_NAME: ! p = _("Expected name"); break; case ATOM_LPAREN: ! p = _("Expected left parenthesis"); break; case ATOM_RPAREN: ! p = _("Expected right parenthesis"); break; case ATOM_INTEGER: ! p = _("Expected integer"); break; case ATOM_STRING: ! p = _("Expected string"); break; default: gfc_internal_error ("require_atom(): bad atom type required"); *************** typedef enum *** 1433,1439 **** AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE, ! AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT } ab_attribute; --- 1431,1438 ---- AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE, ! AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER, ! AB_CRAY_POINTEE } ab_attribute; *************** static const mstring attr_bits[] = *** 1460,1465 **** --- 1459,1466 ---- minit ("RECURSIVE", AB_RECURSIVE), minit ("GENERIC", AB_GENERIC), minit ("ALWAYS_EXPLICIT", AB_ALWAYS_EXPLICIT), + minit ("CRAY_POINTER", AB_CRAY_POINTER), + minit ("CRAY_POINTEE", AB_CRAY_POINTEE), minit (NULL, -1) }; *************** mio_symbol_attribute (symbol_attribute * *** 1544,1549 **** --- 1545,1554 ---- MIO_NAME(ab_attribute) (AB_RECURSIVE, attr_bits); if (attr->always_explicit) MIO_NAME(ab_attribute) (AB_ALWAYS_EXPLICIT, attr_bits); + if (attr->cray_pointer) + MIO_NAME(ab_attribute) (AB_CRAY_POINTER, attr_bits); + if (attr->cray_pointee) + MIO_NAME(ab_attribute) (AB_CRAY_POINTEE, attr_bits); mio_rparen (); *************** mio_symbol_attribute (symbol_attribute * *** 1624,1629 **** --- 1629,1640 ---- case AB_ALWAYS_EXPLICIT: attr->always_explicit = 1; break; + case AB_CRAY_POINTER: + attr->cray_pointer = 1; + break; + case AB_CRAY_POINTEE: + attr->cray_pointee = 1; + break; } } } *************** mio_component_ref (gfc_component ** cp, *** 1875,1880 **** --- 1886,1897 ---- { mio_internal_string (name); + /* It can happen that a component reference can be read before the + associated derived type symbol has been loaded. Return now and + wait for a later iteration of load_needed. */ + if (sym == NULL) + return; + if (sym->components != NULL && p->u.pointer == NULL) { /* Symbol already loaded, so search by name. */ *************** mio_symtree_ref (gfc_symtree ** stp) *** 2087,2096 **** { pointer_info *p; fixup_t *f; if (iomode == IO_OUTPUT) { ! mio_symbol_ref (&(*stp)->n.sym); } else { --- 2104,2129 ---- { pointer_info *p; fixup_t *f; + gfc_symtree * ns_st = NULL; if (iomode == IO_OUTPUT) { ! /* If this is a symtree for a symbol that came from a contained module ! namespace, it has a unique name and we should look in the current ! namespace to see if the required, non-contained symbol is available ! yet. If so, the latter should be written. */ ! if ((*stp)->n.sym && check_unique_name((*stp)->name)) ! ns_st = gfc_find_symtree (gfc_current_ns->sym_root, ! (*stp)->n.sym->name); ! ! /* On the other hand, if the existing symbol is the module name or the ! new symbol is a dummy argument, do not do the promotion. */ ! if (ns_st && ns_st->n.sym ! && ns_st->n.sym->attr.flavor != FL_MODULE ! && !(*stp)->n.sym->attr.dummy) ! mio_symbol_ref (&ns_st->n.sym); ! else ! mio_symbol_ref (&(*stp)->n.sym); } else { *************** static const mstring intrinsics[] = *** 2422,2427 **** --- 2455,2461 ---- minit ("LT", INTRINSIC_LT), minit ("LE", INTRINSIC_LE), minit ("NOT", INTRINSIC_NOT), + minit ("PARENTHESES", INTRINSIC_PARENTHESES), minit (NULL, -1) }; *************** mio_expr (gfc_expr ** ep) *** 2480,2485 **** --- 2514,2520 ---- case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: case INTRINSIC_NOT: + case INTRINSIC_PARENTHESES: mio_expr (&e->value.op.op1); break; *************** mio_symbol (gfc_symbol * sym) *** 2803,2808 **** --- 2838,2846 ---- mio_symbol_ref (&sym->result); + if (sym->attr.cray_pointee) + mio_symbol_ref (&sym->cp_pointer); + /* Note that components are always saved, even if they are supposed to be private. Component access is checked during searching. */ *************** read_module (void) *** 3101,3107 **** const char *p; char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_intrinsic_op i; ! int ambiguous, symbol, j, nuse; pointer_info *info; gfc_use_rename *u; gfc_symtree *st; --- 3139,3145 ---- const char *p; char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_intrinsic_op i; ! int ambiguous, j, nuse, symbol; pointer_info *info; gfc_use_rename *u; gfc_symtree *st; *************** read_module (void) *** 3144,3150 **** being loaded again. */ sym = find_true_name (info->u.rsym.true_name, info->u.rsym.module); ! if (sym == NULL) continue; info->u.rsym.state = USED; --- 3182,3198 ---- being loaded again. */ sym = find_true_name (info->u.rsym.true_name, info->u.rsym.module); ! ! /* See if the symbol has already been loaded by a previous module. ! If so, we reference the existing symbol and prevent it from ! being loaded again. This should not happen if the symbol being ! read is an index for an assumed shape dummy array (ns != 1). */ ! ! sym = find_true_name (info->u.rsym.true_name, info->u.rsym.module); ! ! if (sym == NULL ! || (sym->attr.flavor == FL_VARIABLE ! && info->u.rsym.ns !=1)) continue; info->u.rsym.state = USED; *************** read_module (void) *** 3206,3213 **** if (sym == NULL) { sym = info->u.rsym.sym = ! gfc_new_symbol (info->u.rsym.true_name ! , gfc_current_ns); sym->module = gfc_get_string (info->u.rsym.module); } --- 3254,3261 ---- if (sym == NULL) { sym = info->u.rsym.sym = ! gfc_new_symbol (info->u.rsym.true_name, ! gfc_current_ns); sym->module = gfc_get_string (info->u.rsym.module); } *************** write_symbol1 (pointer_info * p) *** 3487,3497 **** if (p->type != P_SYMBOL || p->u.wsym.state != NEEDS_WRITE) return 0; - /* FIXME: This shouldn't be necessary, but it works around - deficiencies in the module loader or/and symbol handling. */ - if (p->u.wsym.sym->module == NULL && p->u.wsym.sym->attr.dummy) - p->u.wsym.sym->module = gfc_get_string (module_name); - p->u.wsym.state = WRITTEN; write_symbol (p->integer, p->u.wsym.sym); --- 3535,3540 ---- *************** gfc_use_module (void) *** 3700,3706 **** strcpy (filename, module_name); strcat (filename, MODULE_EXTENSION); ! module_fp = gfc_open_included_file (filename); if (module_fp == NULL) gfc_fatal_error ("Can't open module file '%s' for reading at %C: %s", filename, strerror (errno)); --- 3743,3749 ---- strcpy (filename, module_name); strcat (filename, MODULE_EXTENSION); ! module_fp = gfc_open_included_file (filename, true); if (module_fp == NULL) gfc_fatal_error ("Can't open module file '%s' for reading at %C: %s", filename, strerror (errno)); diff -Nrcpad gcc-4.0.2/gcc/fortran/options.c gcc-4.1.0/gcc/fortran/options.c *** gcc-4.0.2/gcc/fortran/options.c Wed Aug 31 12:39:27 2005 --- gcc-4.1.0/gcc/fortran/options.c Wed Feb 8 20:14:00 2006 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** Software Foundation, 59 Temple Place - S *** 32,37 **** --- 32,38 ---- #include "tree-inline.h" #include "gfortran.h" + #include "target.h" gfc_option_t gfc_option; *************** unsigned int *** 42,51 **** gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, const char **argv ATTRIBUTE_UNUSED) { ! gfc_option.source = NULL; gfc_option.module_dir = NULL; gfc_option.source_form = FORM_UNKNOWN; ! gfc_option.fixed_line_length = 72; gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN; gfc_option.verbose = 0; --- 43,53 ---- gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, const char **argv ATTRIBUTE_UNUSED) { ! gfc_source_file = NULL; gfc_option.module_dir = NULL; gfc_option.source_form = FORM_UNKNOWN; ! gfc_option.fixed_line_length = -1; ! gfc_option.free_line_length = -1; gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN; gfc_option.verbose = 0; *************** gfc_init_options (unsigned int argc ATTR *** 70,80 **** --- 72,87 ---- gfc_option.flag_no_backend = 0; gfc_option.flag_pack_derived = 0; gfc_option.flag_repack_arrays = 0; + gfc_option.flag_preprocessed = 0; gfc_option.flag_automatic = 1; gfc_option.flag_backslash = 1; + gfc_option.flag_cray_pointer = 0; + gfc_option.flag_d_lines = -1; gfc_option.q_kind = gfc_default_double_kind; + gfc_option.fpe = 0; + flag_argument_noalias = 2; flag_errno_math = 0; *************** gfc_init_options (unsigned int argc ATTR *** 86,92 **** gfc_option.warn_nonstd_intrinsics = 0; ! return CL_F95; } --- 93,170 ---- gfc_option.warn_nonstd_intrinsics = 0; ! /* -fshort-enums can be default on some targets. */ ! gfc_option.fshort_enums = targetm.default_short_enums (); ! ! return CL_Fortran; ! } ! ! ! /* Determine the source form from the filename extension. We assume ! case insensitivity. */ ! ! static gfc_source_form ! form_from_filename (const char *filename) ! { ! ! static const struct ! { ! const char *extension; ! gfc_source_form form; ! } ! exttype[] = ! { ! { ! ".f90", FORM_FREE} ! , ! { ! ".f95", FORM_FREE} ! , ! { ! ".f", FORM_FIXED} ! , ! { ! ".for", FORM_FIXED} ! , ! { ! "", FORM_UNKNOWN} ! }; /* sentinel value */ ! ! gfc_source_form f_form; ! const char *fileext; ! int i; ! ! /* Find end of file name. Note, filename is either a NULL pointer or ! a NUL terminated string. */ ! i = 0; ! while (filename[i] != '\0') ! i++; ! ! /* Find last period. */ ! while (i >= 0 && (filename[i] != '.')) ! i--; ! ! /* Did we see a file extension? */ ! if (i < 0) ! return FORM_UNKNOWN; /* Nope */ ! ! /* Get file extension and compare it to others. */ ! fileext = &(filename[i]); ! ! i = -1; ! f_form = FORM_UNKNOWN; ! do ! { ! i++; ! if (strcasecmp (fileext, exttype[i].extension) == 0) ! { ! f_form = exttype[i].form; ! break; ! } ! } ! while (exttype[i].form != FORM_UNKNOWN); ! ! return f_form; } *************** gfc_init_options (unsigned int argc ATTR *** 95,101 **** bool gfc_post_options (const char **pfilename) { ! const char *filename = *pfilename; /* Verify the input file name. */ if (!filename || strcmp (filename, "-") == 0) --- 173,181 ---- bool gfc_post_options (const char **pfilename) { ! const char *filename = *pfilename, *canon_source_file = NULL; ! char *source_path; ! int i; /* Verify the input file name. */ if (!filename || strcmp (filename, "-") == 0) *************** gfc_post_options (const char **pfilename *** 103,109 **** filename = ""; } ! gfc_option.source = filename; flag_inline_trees = 1; --- 183,249 ---- filename = ""; } ! if (gfc_option.flag_preprocessed) ! { ! /* For preprocessed files, if the first tokens are of the form # NUM. ! handle the directives so we know the original file name. */ ! gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file); ! if (gfc_source_file == NULL) ! gfc_source_file = filename; ! else ! *pfilename = gfc_source_file; ! } ! else ! gfc_source_file = filename; ! ! if (canon_source_file == NULL) ! canon_source_file = gfc_source_file; ! ! /* Adds the path where the source file is to the list of include files. */ ! ! i = strlen (canon_source_file); ! while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i])) ! i--; ! if (i != 0) ! { ! source_path = alloca (i + 1); ! memcpy (source_path, canon_source_file, i); ! source_path[i] = 0; ! gfc_add_include_path (source_path); ! } ! else ! gfc_add_include_path ("."); ! ! if (canon_source_file != gfc_source_file) ! gfc_free ((void *) canon_source_file); ! ! /* Decide which form the file will be read in as. */ ! ! if (gfc_option.source_form != FORM_UNKNOWN) ! gfc_current_form = gfc_option.source_form; ! else ! { ! gfc_current_form = form_from_filename (filename); ! ! if (gfc_current_form == FORM_UNKNOWN) ! { ! gfc_current_form = FORM_FREE; ! gfc_warning_now ("Reading file '%s' as free form.", ! (filename[0] == '\0') ? "" : filename); ! } ! } ! ! /* If the user specified -fd-lines-as-{code|comments} verify that we're ! in fixed form. */ ! if (gfc_current_form == FORM_FREE) ! { ! if (gfc_option.flag_d_lines == 0) ! gfc_warning_now ("'-fd-lines-as-comments' has no effect " ! "in free form."); ! else if (gfc_option.flag_d_lines == 1) ! gfc_warning_now ("'-fd-lines-as-code' has no effect " ! "in free form."); ! } flag_inline_trees = 1; *************** gfc_post_options (const char **pfilename *** 126,131 **** --- 266,275 ---- if (gfc_option.flag_second_underscore == -1) gfc_option.flag_second_underscore = gfc_option.flag_f2c; + /* Implement -fno-automatic as -fmax-stack-var-size=0. */ + if (!gfc_option.flag_automatic) + gfc_option.flag_max_stack_var_size = 0; + return false; } *************** gfc_handle_module_path_options (const ch *** 177,182 **** --- 321,361 ---- strcat (gfc_option.module_dir, "/"); } + static void + gfc_handle_fpe_trap_option (const char *arg) + { + int result, pos = 0, n; + static const char * const exception[] = { "invalid", "denormal", "zero", + "overflow", "underflow", + "precision", NULL }; + static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL, + GFC_FPE_ZERO, GFC_FPE_OVERFLOW, + GFC_FPE_UNDERFLOW, GFC_FPE_PRECISION, + 0 }; + + while (*arg) + { + while (*arg == ',') + arg++; + while (arg[pos] && arg[pos] != ',') + pos++; + result = 0; + for (n = 0; exception[n] != NULL; n++) + { + if (exception[n] && strncmp (exception[n], arg, pos) == 0) + { + gfc_option.fpe |= opt_exception[n]; + arg += pos; + pos = 0; + result = 1; + break; + } + } + if (! result) + gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg); + } + } + /* Handle command-line options. Returns 0 if unrecognized, 1 if recognized and handled. */ int *************** gfc_handle_option (size_t scode, const c *** 226,231 **** --- 405,414 ---- case OPT_Wunused_labels: gfc_option.warn_unused_labels = value; break; + + case OPT_fcray_pointer: + gfc_option.flag_cray_pointer = value; + break; case OPT_ff2c: gfc_option.flag_f2c = value; *************** gfc_handle_option (size_t scode, const c *** 243,248 **** --- 426,439 ---- gfc_option.flag_backslash = value; break; + case OPT_fd_lines_as_code: + gfc_option.flag_d_lines = 1; + break; + + case OPT_fd_lines_as_comments: + gfc_option.flag_d_lines = 0; + break; + case OPT_fdump_parse_tree: gfc_option.verbose = value; break; *************** gfc_handle_option (size_t scode, const c *** 251,260 **** --- 442,469 ---- gfc_option.source_form = FORM_FIXED; break; + case OPT_ffixed_line_length_none: + gfc_option.fixed_line_length = 0; + break; + + case OPT_ffixed_line_length_: + if (value != 0 && value < 7) + gfc_fatal_error ("Fixed line length must be at least seven."); + gfc_option.fixed_line_length = value; + break; + case OPT_ffree_form: gfc_option.source_form = FORM_FREE; break; + case OPT_ffree_line_length_none: + gfc_option.free_line_length = 0; + break; + + case OPT_ffree_line_length_: + gfc_option.free_line_length = value; + break; + case OPT_funderscoring: gfc_option.flag_underscoring = value; break; *************** gfc_handle_option (size_t scode, const c *** 287,300 **** gfc_option.flag_repack_arrays = value; break; ! case OPT_ffixed_line_length_none: ! gfc_option.fixed_line_length = 0; ! break; ! ! case OPT_ffixed_line_length_: ! if (value != 0 && value < 7) ! gfc_fatal_error ("Fixed line length must be at least seven."); ! gfc_option.fixed_line_length = value; break; case OPT_fmax_identifier_length_: --- 496,503 ---- gfc_option.flag_repack_arrays = value; break; ! case OPT_fpreprocessed: ! gfc_option.flag_preprocessed = value; break; case OPT_fmax_identifier_length_: *************** gfc_handle_option (size_t scode, const c *** 331,336 **** --- 534,543 ---- gfc_handle_module_path_options (arg); break; + case OPT_ffpe_trap_: + gfc_handle_fpe_trap_option (arg); + break; + case OPT_std_f95: gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77; gfc_option.warn_std = GFC_STD_F95_OBS; *************** gfc_handle_option (size_t scode, const c *** 362,367 **** --- 569,594 ---- case OPT_Wnonstd_intrinsics: gfc_option.warn_nonstd_intrinsics = 1; break; + + case OPT_fshort_enums: + gfc_option.fshort_enums = 1; + break; + + case OPT_fconvert_little_endian: + gfc_option.convert = CONVERT_LITTLE; + break; + + case OPT_fconvert_big_endian: + gfc_option.convert = CONVERT_BIG; + break; + + case OPT_fconvert_native: + gfc_option.convert = CONVERT_NATIVE; + break; + + case OPT_fconvert_swap: + gfc_option.convert = CONVERT_SWAP; + break; } return result; diff -Nrcpad gcc-4.0.2/gcc/fortran/parse.c gcc-4.1.0/gcc/fortran/parse.c *** gcc-4.0.2/gcc/fortran/parse.c Sat Apr 23 14:08:55 2005 --- gcc-4.1.0/gcc/fortran/parse.c Fri Jan 27 22:16:04 2006 *************** *** 1,6 **** /* Main parser. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, ! Inc. Contributed by Andy Vaught This file is part of GCC. --- 1,6 ---- /* Main parser. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 ! Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** match_word (const char *str, match (*sub *** 75,87 **** /* Figure out what the next statement is, (mostly) regardless of ! proper ordering. */ #define match(keyword, subr, st) \ ! if (match_word(keyword, subr, &old_locus) == MATCH_YES) \ ! return st; \ ! else \ ! undo_new_statement (); static gfc_statement decode_statement (void) --- 75,90 ---- /* Figure out what the next statement is, (mostly) regardless of ! proper ordering. The do...while(0) is there to prevent if/else ! ambiguity. */ #define match(keyword, subr, st) \ ! do { \ ! if (match_word(keyword, subr, &old_locus) == MATCH_YES) \ ! return st; \ ! else \ ! undo_new_statement (); \ ! } while (0); static gfc_statement decode_statement (void) *************** decode_statement (void) *** 129,134 **** --- 132,138 ---- match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION); match (NULL, gfc_match_data_decl, ST_DATA_DECL); + match (NULL, gfc_match_enumerator_def, ST_ENUMERATOR); /* Try to match a subroutine statement, which has the same optional prefixes that functions can have. */ *************** decode_statement (void) *** 202,207 **** --- 206,212 ---- match ("else", gfc_match_else, ST_ELSE); match ("else where", gfc_match_elsewhere, ST_ELSEWHERE); match ("else if", gfc_match_elseif, ST_ELSEIF); + match ("enum , bind ( c )", gfc_match_enum, ST_ENUM); if (gfc_match_end (&st) == MATCH_YES) return st; *************** decode_statement (void) *** 212,217 **** --- 217,223 ---- break; case 'f': + match ("flush", gfc_match_flush, ST_FLUSH); match ("format", gfc_match_format, ST_FORMAT); break; *************** static gfc_statement *** 303,309 **** next_free (void) { match m; ! int c, d; gfc_gobble_whitespace (); --- 309,315 ---- next_free (void) { match m; ! int c, d, cnt; gfc_gobble_whitespace (); *************** next_free (void) *** 312,341 **** if (ISDIGIT (c)) { /* Found a statement label? */ ! m = gfc_match_st_label (&gfc_statement_label, 0); d = gfc_peek_char (); if (m != MATCH_YES || !gfc_is_whitespace (d)) { do ! { ! /* Skip the bad statement label. */ ! gfc_warning_now ("Ignoring bad statement label at %C"); ! c = gfc_next_char (); ! } ! while (ISDIGIT (c)); } else { label_locus = gfc_current_locus; - if (gfc_statement_label->value == 0) - { - gfc_warning_now ("Ignoring statement label of zero at %C"); - gfc_free_st_label (gfc_statement_label); - gfc_statement_label = NULL; - } - gfc_gobble_whitespace (); if (gfc_match_eos () == MATCH_YES) --- 318,348 ---- if (ISDIGIT (c)) { /* Found a statement label? */ ! m = gfc_match_st_label (&gfc_statement_label); d = gfc_peek_char (); if (m != MATCH_YES || !gfc_is_whitespace (d)) { + gfc_match_small_literal_int (&c, &cnt); + + if (cnt > 5) + gfc_error_now ("Too many digits in statement label at %C"); + + if (c == 0) + gfc_error_now ("Statement label at %C is zero"); + do ! c = gfc_next_char (); ! while (ISDIGIT(c)); ! ! if (!gfc_is_whitespace (c)) ! gfc_error_now ("Non-numeric character in statement label at %C"); ! } else { label_locus = gfc_current_locus; gfc_gobble_whitespace (); if (gfc_match_eos () == MATCH_YES) *************** next_statement (void) *** 526,532 **** case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \ case ST_PAUSE: case ST_STOP: case ST_WRITE: case ST_ASSIGNMENT: \ case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \ ! case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: case ST_LABEL_ASSIGNMENT /* Statements that mark other executable statements. */ --- 533,540 ---- case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \ case ST_PAUSE: case ST_STOP: case ST_WRITE: case ST_ASSIGNMENT: \ case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \ ! case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ ! case ST_LABEL_ASSIGNMENT: case ST_FLUSH /* Statements that mark other executable statements. */ *************** gfc_ascii_statement (gfc_statement st) *** 726,738 **** switch (st) { case ST_ARITHMETIC_IF: ! p = "arithmetic IF"; break; case ST_ALLOCATE: p = "ALLOCATE"; break; case ST_ATTR_DECL: ! p = "attribute declaration"; break; case ST_BACKSPACE: p = "BACKSPACE"; --- 734,746 ---- switch (st) { case ST_ARITHMETIC_IF: ! p = _("arithmetic IF"); break; case ST_ALLOCATE: p = "ALLOCATE"; break; case ST_ATTR_DECL: ! p = _("attribute declaration"); break; case ST_BACKSPACE: p = "BACKSPACE"; *************** gfc_ascii_statement (gfc_statement st) *** 762,768 **** p = "CYCLE"; break; case ST_DATA_DECL: ! p = "data declaration"; break; case ST_DATA: p = "DATA"; --- 770,776 ---- p = "CYCLE"; break; case ST_DATA_DECL: ! p = _("data declaration"); break; case ST_DATA: p = "DATA"; *************** gfc_ascii_statement (gfc_statement st) *** 771,777 **** p = "DEALLOCATE"; break; case ST_DERIVED_DECL: ! p = "Derived type declaration"; break; case ST_DO: p = "DO"; --- 779,785 ---- p = "DEALLOCATE"; break; case ST_DERIVED_DECL: ! p = _("derived type declaration"); break; case ST_DO: p = "DO"; *************** gfc_ascii_statement (gfc_statement st) *** 833,838 **** --- 841,849 ---- case ST_EXIT: p = "EXIT"; break; + case ST_FLUSH: + p = "FLUSH"; + break; case ST_FORALL_BLOCK: /* Fall through */ case ST_FORALL: p = "FORALL"; *************** gfc_ascii_statement (gfc_statement st) *** 847,853 **** p = "GOTO"; break; case ST_IF_BLOCK: ! p = "block IF"; break; case ST_IMPLICIT: p = "IMPLICIT"; --- 858,864 ---- p = "GOTO"; break; case ST_IF_BLOCK: ! p = _("block IF"); break; case ST_IMPLICIT: p = "IMPLICIT"; *************** gfc_ascii_statement (gfc_statement st) *** 856,862 **** p = "IMPLICIT NONE"; break; case ST_IMPLIED_ENDDO: ! p = "implied END DO"; break; case ST_INQUIRE: p = "INQUIRE"; --- 867,873 ---- p = "IMPLICIT NONE"; break; case ST_IMPLIED_ENDDO: ! p = _("implied END DO"); break; case ST_INQUIRE: p = "INQUIRE"; *************** gfc_ascii_statement (gfc_statement st) *** 923,932 **** p = "WRITE"; break; case ST_ASSIGNMENT: ! p = "assignment"; break; case ST_POINTER_ASSIGNMENT: ! p = "pointer assignment"; break; case ST_SELECT_CASE: p = "SELECT CASE"; --- 934,943 ---- p = "WRITE"; break; case ST_ASSIGNMENT: ! p = _("assignment"); break; case ST_POINTER_ASSIGNMENT: ! p = _("pointer assignment"); break; case ST_SELECT_CASE: p = "SELECT CASE"; *************** gfc_ascii_statement (gfc_statement st) *** 935,941 **** p = "SEQUENCE"; break; case ST_SIMPLE_IF: ! p = "Simple IF"; break; case ST_STATEMENT_FUNCTION: p = "STATEMENT FUNCTION"; --- 946,952 ---- p = "SEQUENCE"; break; case ST_SIMPLE_IF: ! p = _("simple IF"); break; case ST_STATEMENT_FUNCTION: p = "STATEMENT FUNCTION"; *************** gfc_ascii_statement (gfc_statement st) *** 943,948 **** --- 954,968 ---- case ST_LABEL_ASSIGNMENT: p = "LABEL ASSIGNMENT"; break; + case ST_ENUM: + p = "ENUM DEFINITION"; + break; + case ST_ENUMERATOR: + p = "ENUMERATOR DEFINITION"; + break; + case ST_END_ENUM: + p = "END ENUM"; + break; default: gfc_internal_error ("gfc_ascii_statement(): Bad statement code"); } *************** gfc_ascii_statement (gfc_statement st) *** 951,1010 **** } ! /* Return the name of a compile state. */ ! ! const char * ! gfc_state_name (gfc_compile_state state) { ! const char *p; ! ! switch (state) ! { ! case COMP_PROGRAM: ! p = "a PROGRAM"; ! break; ! case COMP_MODULE: ! p = "a MODULE"; ! break; ! case COMP_SUBROUTINE: ! p = "a SUBROUTINE"; ! break; ! case COMP_FUNCTION: ! p = "a FUNCTION"; ! break; ! case COMP_BLOCK_DATA: ! p = "a BLOCK DATA"; ! break; ! case COMP_INTERFACE: ! p = "an INTERFACE"; ! break; ! case COMP_DERIVED: ! p = "a DERIVED TYPE block"; ! break; ! case COMP_IF: ! p = "an IF-THEN block"; ! break; ! case COMP_DO: ! p = "a DO block"; ! break; ! case COMP_SELECT: ! p = "a SELECT block"; ! break; ! case COMP_FORALL: ! p = "a FORALL block"; ! break; ! case COMP_WHERE: ! p = "a WHERE block"; ! break; ! case COMP_CONTAINS: ! p = "a contained subprogram"; ! break; ! ! default: ! gfc_internal_error ("gfc_state_name(): Bad state"); ! } ! return p; } --- 971,995 ---- } ! /* Create a symbol for the main program and assign it to ns->proc_name. */ ! ! static void ! main_program_symbol (gfc_namespace * ns) { ! gfc_symbol *main_program; ! symbol_attribute attr; ! gfc_get_symbol ("MAIN__", ns, &main_program); ! gfc_clear_attr (&attr); ! attr.flavor = FL_PROCEDURE; ! attr.proc = PROC_UNKNOWN; ! attr.subroutine = 1; ! attr.access = ACCESS_PUBLIC; ! attr.is_main_program = 1; ! main_program->attr = attr; ! main_program->declared_at = gfc_current_locus; ! ns->proc_name = main_program; ! gfc_commit_symbols (); } *************** parse_derived (void) *** 1384,1389 **** --- 1369,1424 ---- + /* Parse an ENUM. */ + + static void + parse_enum (void) + { + int error_flag; + gfc_statement st; + int compiling_enum; + gfc_state_data s; + int seen_enumerator = 0; + + error_flag = 0; + + push_state (&s, COMP_ENUM, gfc_new_block); + + compiling_enum = 1; + + while (compiling_enum) + { + st = next_statement (); + switch (st) + { + case ST_NONE: + unexpected_eof (); + break; + + case ST_ENUMERATOR: + seen_enumerator = 1; + accept_statement (st); + break; + + case ST_END_ENUM: + compiling_enum = 0; + if (!seen_enumerator) + { + gfc_error ("ENUM declaration at %C has no ENUMERATORS"); + error_flag = 1; + } + accept_statement (st); + break; + + default: + gfc_free_enum_history (); + unexpected_statement (st); + break; + } + } + pop_state (); + } + /* Parse an interface. We must be able to deal with the possibility of recursive interfaces. The parse_spec() subroutine is mutually recursive with parse_interface(). */ *************** loop: *** 1589,1594 **** --- 1624,1635 ---- st = next_statement (); goto loop; + case ST_ENUM: + accept_statement (st); + parse_enum(); + st = next_statement (); + goto loop; + default: break; } *************** parse_where_block (void) *** 1631,1637 **** case ST_WHERE_BLOCK: parse_where_block (); ! /* Fall through */ case ST_ASSIGNMENT: case ST_WHERE: --- 1672,1678 ---- case ST_WHERE_BLOCK: parse_where_block (); ! break; case ST_ASSIGNMENT: case ST_WHERE: *************** gfc_fixup_sibling_symbols (gfc_symbol * *** 2157,2163 **** gfc_free_symbol (old_sym); } ! /* Do the same for any contined procedures. */ gfc_fixup_sibling_symbols (sym, ns->contained); } } --- 2198,2204 ---- gfc_free_symbol (old_sym); } ! /* Do the same for any contained procedures. */ gfc_fixup_sibling_symbols (sym, ns->contained); } } *************** done: *** 2355,2361 **** /* Come here to complain about a global symbol already in use as something else. */ ! static void global_used (gfc_gsymbol *sym, locus *where) { const char *name; --- 2396,2402 ---- /* Come here to complain about a global symbol already in use as something else. */ ! void global_used (gfc_gsymbol *sym, locus *where) { const char *name; *************** global_used (gfc_gsymbol *sym, locus *wh *** 2389,2395 **** } gfc_error("Global name '%s' at %L is already being used as a %s at %L", ! gfc_new_block->name, where, name, &sym->where); } --- 2430,2436 ---- } gfc_error("Global name '%s' at %L is already being used as a %s at %L", ! sym->name, where, name, &sym->where); } *************** parse_block_data (void) *** 2420,2431 **** else { s = gfc_get_gsymbol (gfc_new_block->name); ! if (s->type != GSYM_UNKNOWN) global_used(s, NULL); else { s->type = GSYM_BLOCK_DATA; s->where = gfc_current_locus; } } --- 2461,2473 ---- else { s = gfc_get_gsymbol (gfc_new_block->name); ! if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA)) global_used(s, NULL); else { s->type = GSYM_BLOCK_DATA; s->where = gfc_current_locus; + s->defined = 1; } } *************** parse_module (void) *** 2450,2461 **** gfc_gsymbol *s; s = gfc_get_gsymbol (gfc_new_block->name); ! if (s->type != GSYM_UNKNOWN) global_used(s, NULL); else { s->type = GSYM_MODULE; s->where = gfc_current_locus; } st = parse_spec (ST_NONE); --- 2492,2504 ---- gfc_gsymbol *s; s = gfc_get_gsymbol (gfc_new_block->name); ! if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE)) global_used(s, NULL); else { s->type = GSYM_MODULE; s->where = gfc_current_locus; + s->defined = 1; } st = parse_spec (ST_NONE); *************** add_global_procedure (int sub) *** 2494,2505 **** s = gfc_get_gsymbol(gfc_new_block->name); ! if (s->type != GSYM_UNKNOWN) global_used(s, NULL); else { s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; s->where = gfc_current_locus; } } --- 2537,2550 ---- s = gfc_get_gsymbol(gfc_new_block->name); ! if (s->defined ! || (s->type != GSYM_UNKNOWN && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION))) global_used(s, NULL); else { s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; s->where = gfc_current_locus; + s->defined = 1; } } *************** add_global_program (void) *** 2515,2526 **** return; s = gfc_get_gsymbol (gfc_new_block->name); ! if (s->type != GSYM_UNKNOWN) global_used(s, NULL); else { s->type = GSYM_PROGRAM; s->where = gfc_current_locus; } } --- 2560,2572 ---- return; s = gfc_get_gsymbol (gfc_new_block->name); ! if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM)) global_used(s, NULL); else { s->type = GSYM_PROGRAM; s->where = gfc_current_locus; + s->defined = 1; } } *************** gfc_parse_file (void) *** 2552,2557 **** --- 2598,2607 ---- seen_program = 0; + /* Exit early for empty files. */ + if (gfc_at_eof ()) + goto done; + loop: gfc_init_2 (); st = next_statement (); *************** loop: *** 2568,2573 **** --- 2618,2624 ---- prog_locus = gfc_current_locus; push_state (&s, COMP_PROGRAM, gfc_new_block); + main_program_symbol(gfc_current_ns); accept_statement (st); add_global_program (); parse_progunit (ST_NONE); *************** loop: *** 2609,2614 **** --- 2660,2666 ---- prog_locus = gfc_current_locus; push_state (&s, COMP_PROGRAM, gfc_new_block); + main_program_symbol(gfc_current_ns); parse_progunit (st); break; } diff -Nrcpad gcc-4.0.2/gcc/fortran/parse.h gcc-4.1.0/gcc/fortran/parse.h *** gcc-4.0.2/gcc/fortran/parse.h Mon Nov 8 14:56:39 2004 --- gcc-4.1.0/gcc/fortran/parse.h Sun Oct 30 18:09:55 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef GFC_PARSE_H --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #ifndef GFC_PARSE_H *************** typedef enum *** 30,36 **** { COMP_NONE, COMP_PROGRAM, COMP_MODULE, COMP_SUBROUTINE, COMP_FUNCTION, COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_IF, COMP_DO, ! COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS } gfc_compile_state; --- 30,36 ---- { COMP_NONE, COMP_PROGRAM, COMP_MODULE, COMP_SUBROUTINE, COMP_FUNCTION, COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_IF, COMP_DO, ! COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM } gfc_compile_state; *************** int gfc_check_do_variable (gfc_symtree * *** 63,68 **** try gfc_find_state (gfc_compile_state); gfc_state_data *gfc_enclosing_unit (gfc_compile_state *); const char *gfc_ascii_statement (gfc_statement); ! const char *gfc_state_name (gfc_compile_state); #endif /* GFC_PARSE_H */ --- 63,70 ---- try gfc_find_state (gfc_compile_state); gfc_state_data *gfc_enclosing_unit (gfc_compile_state *); const char *gfc_ascii_statement (gfc_statement); ! match gfc_match_enum (void); ! match gfc_match_enumerator_def (void); ! void gfc_free_enum_history (void); #endif /* GFC_PARSE_H */ diff -Nrcpad gcc-4.0.2/gcc/fortran/primary.c gcc-4.1.0/gcc/fortran/primary.c *** gcc-4.0.2/gcc/fortran/primary.c Fri Sep 9 09:05:53 2005 --- gcc-4.1.0/gcc/fortran/primary.c Sat Dec 31 18:55:30 2005 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** match_kind_param (int *kind) *** 40,47 **** gfc_symbol *sym; const char *p; match m; ! m = gfc_match_small_literal_int (kind); if (m != MATCH_NO) return m; --- 40,49 ---- gfc_symbol *sym; const char *p; match m; + int cnt; ! /* cnt is unused, here. */ ! m = gfc_match_small_literal_int (kind, &cnt); if (m != MATCH_NO) return m; *************** match_hollerith_constant (gfc_expr ** re *** 271,277 **** } else { ! buffer = (char *)gfc_getmem (sizeof(char)*num+1); for (i = 0; i < num; i++) { buffer[i] = gfc_next_char_literal (1); --- 273,279 ---- } else { ! buffer = (char *) gfc_getmem (sizeof(char) * num + 1); for (i = 0; i < num; i++) { buffer[i] = gfc_next_char_literal (1); *************** cleanup: *** 298,334 **** /* Match a binary, octal or hexadecimal constant that can be found in ! a DATA statement. */ static match match_boz_constant (gfc_expr ** result) { ! int radix, delim, length, x_hex, kind; ! locus old_loc; char *buffer; gfc_expr *e; - const char *rname; ! old_loc = gfc_current_locus; gfc_gobble_whitespace (); x_hex = 0; ! switch (gfc_next_char ()) { case 'b': radix = 2; ! rname = "binary"; break; case 'o': radix = 8; ! rname = "octal"; break; case 'x': x_hex = 1; /* Fall through. */ case 'z': radix = 16; ! rname = "hexadecimal"; break; default: goto backup; --- 300,345 ---- /* Match a binary, octal or hexadecimal constant that can be found in ! a DATA statement. The standard permits b'010...', o'73...', and ! z'a1...' where b, o, and z can be capital letters. This function ! also accepts postfixed forms of the constants: '01...'b, '73...'o, ! and 'a1...'z. An additional extension is the use of x for z. */ static match match_boz_constant (gfc_expr ** result) { ! int post, radix, delim, length, x_hex, kind; ! locus old_loc, start_loc; char *buffer; gfc_expr *e; ! start_loc = old_loc = gfc_current_locus; gfc_gobble_whitespace (); x_hex = 0; ! switch (post = gfc_next_char ()) { case 'b': radix = 2; ! post = 0; break; case 'o': radix = 8; ! post = 0; break; case 'x': x_hex = 1; /* Fall through. */ case 'z': radix = 16; ! post = 0; ! break; ! case '\'': ! /* Fall through. */ ! case '\"': ! delim = post; ! post = 1; ! radix = 16; /* Set to accept any valid digit string. */ break; default: goto backup; *************** match_boz_constant (gfc_expr ** result) *** 336,342 **** /* No whitespace allowed here. */ ! delim = gfc_next_char (); if (delim != '\'' && delim != '\"') goto backup; --- 347,355 ---- /* No whitespace allowed here. */ ! if (post == 0) ! delim = gfc_next_char (); ! if (delim != '\'' && delim != '\"') goto backup; *************** match_boz_constant (gfc_expr ** result) *** 351,374 **** length = match_digits (0, radix, NULL); if (length == -1) { ! gfc_error ("Empty set of digits in %s constants at %C", rname); return MATCH_ERROR; } if (gfc_next_char () != delim) { ! gfc_error ("Illegal character in %s constant at %C.", rname); return MATCH_ERROR; } gfc_current_locus = old_loc; buffer = alloca (length + 1); memset (buffer, '\0', length + 1); match_digits (0, radix, buffer); ! gfc_next_char (); /* Eat delimiter. */ ! /* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find "If a data-stmt-constant is a boz-literal-constant, the corresponding --- 364,410 ---- length = match_digits (0, radix, NULL); if (length == -1) { ! gfc_error ("Empty set of digits in BOZ constant at %C"); return MATCH_ERROR; } if (gfc_next_char () != delim) { ! gfc_error ("Illegal character in BOZ constant at %C"); return MATCH_ERROR; } + if (post == 1) + { + switch (gfc_next_char ()) + { + case 'b': + radix = 2; + break; + case 'o': + radix = 8; + break; + case 'x': + /* Fall through. */ + case 'z': + radix = 16; + break; + default: + goto backup; + } + gfc_notify_std (GFC_STD_GNU, "Extension: BOZ constant " + "at %C uses non-standard postfix syntax."); + } + gfc_current_locus = old_loc; buffer = alloca (length + 1); memset (buffer, '\0', length + 1); match_digits (0, radix, buffer); ! gfc_next_char (); /* Eat delimiter. */ ! if (post == 1) ! gfc_next_char (); /* Eat postfixed b, o, z, or x. */ /* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find "If a data-stmt-constant is a boz-literal-constant, the corresponding *************** match_boz_constant (gfc_expr ** result) *** 383,389 **** if (gfc_range_check (e) != ARITH_OK) { gfc_error ("Integer too big for integer kind %i at %C", kind); - gfc_free_expr (e); return MATCH_ERROR; } --- 419,424 ---- *************** match_boz_constant (gfc_expr ** result) *** 392,398 **** return MATCH_YES; backup: ! gfc_current_locus = old_loc; return MATCH_NO; } --- 427,433 ---- return MATCH_YES; backup: ! gfc_current_locus = start_loc; return MATCH_NO; } *************** next_string_char (char delimiter) *** 760,766 **** /* Special case of gfc_match_name() that matches a parameter kind name before a string constant. This takes case of the weird but legal ! case of: weird case of: kind_____'string' --- 795,801 ---- /* Special case of gfc_match_name() that matches a parameter kind name before a string constant. This takes case of the weird but legal ! case of: kind_____'string' *************** got_delim: *** 933,938 **** --- 968,980 ---- length++; } + /* Peek at the next character to see if it is a b, o, z, or x for the + postfixed BOZ literal constants. */ + c = gfc_peek_char (); + if (c == 'b' || c == 'o' || c =='z' || c == 'x') + goto no_match; + + e = gfc_get_expr (); e->expr_type = EXPR_CONSTANT; *************** match_actual_arg (gfc_expr ** result) *** 1308,1318 **** /* If the symbol is a function with itself as the result and is being defined, then we have a variable. */ ! if (sym->result == sym ! && (gfc_current_ns->proc_name == sym || (gfc_current_ns->parent != NULL ! && gfc_current_ns->parent->proc_name == sym))) ! break; } e = gfc_get_expr (); /* Leave it unknown for now */ --- 1350,1376 ---- /* If the symbol is a function with itself as the result and is being defined, then we have a variable. */ ! if (sym->attr.function && sym->result == sym) ! { ! if (gfc_current_ns->proc_name == sym || (gfc_current_ns->parent != NULL ! && gfc_current_ns->parent->proc_name == sym)) ! break; ! ! if (sym->attr.entry ! && (sym->ns == gfc_current_ns ! || sym->ns == gfc_current_ns->parent)) ! { ! gfc_entry_list *el = NULL; ! ! for (el = sym->ns->entries; el; el = el->next) ! if (sym == el->sym) ! break; ! ! if (el) ! break; ! } ! } } e = gfc_get_expr (); /* Leave it unknown for now */ *************** gfc_match_actual_arglist (int sub_flag, *** 1418,1424 **** if (sub_flag && gfc_match_char ('*') == MATCH_YES) { ! m = gfc_match_st_label (&label, 0); if (m == MATCH_NO) gfc_error ("Expected alternate return label at %C"); if (m != MATCH_YES) --- 1476,1482 ---- if (sub_flag && gfc_match_char ('*') == MATCH_YES) { ! m = gfc_match_st_label (&label); if (m == MATCH_NO) gfc_error ("Expected alternate return label at %C"); if (m != MATCH_YES) *************** match_varspec (gfc_expr * primary, int e *** 1596,1601 **** --- 1654,1668 ---- } check_substring: + if (primary->ts.type == BT_UNKNOWN) + { + if (gfc_get_default_type (sym, sym->ns)->type == BT_CHARACTER) + { + gfc_set_default_type (sym, 0, sym->ns); + primary->ts = sym->ts; + } + } + if (primary->ts.type == BT_CHARACTER) { switch (match_substring (primary->ts.cl, equiv_flag, &substring)) diff -Nrcpad gcc-4.0.2/gcc/fortran/resolve.c gcc-4.1.0/gcc/fortran/resolve.c *** gcc-4.0.2/gcc/fortran/resolve.c Wed Aug 31 12:39:27 2005 --- gcc-4.1.0/gcc/fortran/resolve.c Tue Feb 14 07:18:44 2006 *************** *** 1,5 **** /* Perform type resolution on the various stuctures. ! Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. --- 1,6 ---- /* Perform type resolution on the various stuctures. ! Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, ! Inc. Contributed by Andy Vaught This file is part of GCC. *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330,Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor,Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** Software Foundation, 59 Temple Place - S *** 25,30 **** --- 26,38 ---- #include "gfortran.h" #include "arith.h" /* For gfc_compare_expr(). */ + /* Types used in equivalence statements. */ + + typedef enum seq_type + { + SEQ_NONDEFAULT, SEQ_NUMERIC, SEQ_CHARACTER, SEQ_MIXED + } + seq_type; /* Stack to push the current if we descend into a block during resolution. See resolve_branch() and resolve_code(). */ *************** static code_stack *cs_base = NULL; *** 43,48 **** --- 51,66 ---- static int forall_flag; + /* Nonzero if we are processing a formal arglist. The corresponding function + resets the flag each time that it is read. */ + static int formal_arg_flag = 0; + + int + gfc_is_formal_arg (void) + { + return formal_arg_flag; + } + /* Resolve types of formal argument lists. These have to be done early so that the formal argument lists of module procedures can be copied to the containing module before the individual procedures are resolved *************** resolve_formal_arglist (gfc_symbol * pro *** 71,76 **** --- 89,96 ---- || (sym->as && sym->as->rank > 0)) proc->attr.always_explicit = 1; + formal_arg_flag = 1; + for (f = proc->formal; f; f = f->next) { sym = f->sym; *************** resolve_formal_arglist (gfc_symbol * pro *** 117,132 **** { if (!sym->attr.function || sym->result == sym) gfc_set_default_type (sym, 1, sym->ns); - else - { - /* Set the type of the RESULT, then copy. */ - if (sym->result->ts.type == BT_UNKNOWN) - gfc_set_default_type (sym->result, 1, sym->result->ns); - - sym->ts = sym->result->ts; - if (sym->as == NULL) - sym->as = gfc_copy_array_spec (sym->result->as); - } } gfc_resolve_array_spec (sym->as, 0); --- 137,142 ---- *************** resolve_formal_arglist (gfc_symbol * pro *** 217,222 **** --- 227,233 ---- } } } + formal_arg_flag = 0; } *************** resolve_contained_fntype (gfc_symbol * s *** 274,279 **** --- 285,298 ---- sym->attr.untyped = 1; } } + + if (sym->ts.type == BT_CHARACTER) + { + gfc_charlen *cl = sym->ts.cl; + if (!cl || !cl->length) + gfc_error ("Character-valued internal function '%s' at %L must " + "not be assumed length", sym->name, &sym->declared_at); + } } *************** resolve_entries (gfc_namespace * ns) *** 404,423 **** } else { ! /* Otherwise the result will be passed through an union by reference. */ proc->attr.mixed_entry_master = 1; for (el = ns->entries; el; el = el->next) { sym = el->sym->result; if (sym->attr.dimension) ! gfc_error ("%s result %s can't be an array in FUNCTION %s at %L", ! el == ns->entries ? "FUNCTION" : "ENTRY", sym->name, ! ns->entries->sym->name, &sym->declared_at); else if (sym->attr.pointer) ! gfc_error ("%s result %s can't be a POINTER in FUNCTION %s at %L", ! el == ns->entries ? "FUNCTION" : "ENTRY", sym->name, ! ns->entries->sym->name, &sym->declared_at); else { ts = &sym->ts; --- 423,456 ---- } else { ! /* Otherwise the result will be passed through a union by reference. */ proc->attr.mixed_entry_master = 1; for (el = ns->entries; el; el = el->next) { sym = el->sym->result; if (sym->attr.dimension) ! { ! if (el == ns->entries) ! gfc_error ! ("FUNCTION result %s can't be an array in FUNCTION %s at %L", ! sym->name, ns->entries->sym->name, &sym->declared_at); ! else ! gfc_error ! ("ENTRY result %s can't be an array in FUNCTION %s at %L", ! sym->name, ns->entries->sym->name, &sym->declared_at); ! } else if (sym->attr.pointer) ! { ! if (el == ns->entries) ! gfc_error ! ("FUNCTION result %s can't be a POINTER in FUNCTION %s at %L", ! sym->name, ns->entries->sym->name, &sym->declared_at); ! else ! gfc_error ! ("ENTRY result %s can't be a POINTER in FUNCTION %s at %L", ! sym->name, ns->entries->sym->name, &sym->declared_at); ! } else { ts = &sym->ts; *************** resolve_entries (gfc_namespace * ns) *** 450,459 **** break; } if (sym) ! gfc_error ("%s result %s can't be of type %s in FUNCTION %s at %L", ! el == ns->entries ? "FUNCTION" : "ENTRY", sym->name, ! gfc_typename (ts), ns->entries->sym->name, ! &sym->declared_at); } } } --- 483,500 ---- break; } if (sym) ! { ! if (el == ns->entries) ! gfc_error ! ("FUNCTION result %s can't be of type %s in FUNCTION %s at %L", ! sym->name, gfc_typename (ts), ns->entries->sym->name, ! &sym->declared_at); ! else ! gfc_error ! ("ENTRY result %s can't be of type %s in FUNCTION %s at %L", ! sym->name, gfc_typename (ts), ns->entries->sym->name, ! &sym->declared_at); ! } } } } *************** resolve_structure_cons (gfc_expr * expr) *** 542,550 **** /* If we don't have the right type, try to convert it. */ ! if (!gfc_compare_types (&cons->expr->ts, &comp->ts) ! && gfc_convert_type (cons->expr, &comp->ts, 1) == FAILURE) ! t = FAILURE; } return t; --- 583,600 ---- /* If we don't have the right type, try to convert it. */ ! if (!gfc_compare_types (&cons->expr->ts, &comp->ts)) ! { ! t = FAILURE; ! if (comp->pointer && cons->expr->ts.type != BT_UNKNOWN) ! gfc_error ("The element in the derived type constructor at %L, " ! "for pointer component '%s', is %s but should be %s", ! &cons->expr->where, comp->name, ! gfc_basic_typename (cons->expr->ts.type), ! gfc_basic_typename (comp->ts.type)); ! else ! t = gfc_convert_type (cons->expr, &comp->ts, 1); ! } } return t; *************** procedure_kind (gfc_symbol * sym) *** 640,645 **** --- 690,758 ---- return PTYPE_UNKNOWN; } + /* Check references to assumed size arrays. The flag need_full_assumed_size + is non-zero when matching actual arguments. */ + + static int need_full_assumed_size = 0; + + static bool + check_assumed_size_reference (gfc_symbol * sym, gfc_expr * e) + { + gfc_ref * ref; + int dim; + int last = 1; + + if (need_full_assumed_size + || !(sym->as && sym->as->type == AS_ASSUMED_SIZE)) + return false; + + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY) + for (dim = 0; dim < ref->u.ar.as->rank; dim++) + last = (ref->u.ar.end[dim] == NULL) && (ref->u.ar.type == DIMEN_ELEMENT); + + if (last) + { + gfc_error ("The upper bound in the last dimension must " + "appear in the reference to the assumed size " + "array '%s' at %L.", sym->name, &e->where); + return true; + } + return false; + } + + + /* Look for bad assumed size array references in argument expressions + of elemental and array valued intrinsic procedures. Since this is + called from procedure resolution functions, it only recurses at + operators. */ + + static bool + resolve_assumed_size_actual (gfc_expr *e) + { + if (e == NULL) + return false; + + switch (e->expr_type) + { + case EXPR_VARIABLE: + if (e->symtree + && check_assumed_size_reference (e->symtree->n.sym, e)) + return true; + break; + + case EXPR_OP: + if (resolve_assumed_size_actual (e->value.op.op1) + || resolve_assumed_size_actual (e->value.op.op2)) + return true; + break; + + default: + break; + } + return false; + } + /* Resolve an actual argument list. Most of the time, this is just resolving the expressions in the list. *************** resolve_actual_arglist (gfc_actual_argli *** 690,700 **** || sym->attr.external) { ! if (sym->attr.proc == PROC_ST_FUNCTION) ! { ! gfc_error ("Statement function '%s' at %L is not allowed as an " ! "actual argument", sym->name, &e->where); ! } /* If the symbol is the function that names the current (or parent) scope, then we really have a variable reference. */ --- 803,827 ---- || sym->attr.external) { ! if (sym->attr.proc == PROC_ST_FUNCTION) ! { ! gfc_error ("Statement function '%s' at %L is not allowed as an " ! "actual argument", sym->name, &e->where); ! } ! ! if (sym->attr.contained && !sym->attr.use_assoc ! && sym->ns->proc_name->attr.flavor != FL_MODULE) ! { ! gfc_error ("Internal procedure '%s' is not allowed as an " ! "actual argument at %L", sym->name, &e->where); ! } ! ! if (sym->attr.elemental && !sym->attr.intrinsic) ! { ! gfc_error ("ELEMENTAL non-INTRINSIC procedure '%s' is not " ! "allowed as an actual argument at %L", sym->name, ! &e->where); ! } /* If the symbol is the function that names the current (or parent) scope, then we really have a variable reference. */ *************** resolve_actual_arglist (gfc_actual_argli *** 748,753 **** --- 875,910 ---- return SUCCESS; } + /* This function does the checking of references to global procedures + as defined in sections 18.1 and 14.1, respectively, of the Fortran + 77 and 95 standards. It checks for a gsymbol for the name, making + one if it does not already exist. If it already exists, then the + reference being resolved must correspond to the type of gsymbol. + Otherwise, the new symbol is equipped with the attributes of the + reference. The corresponding code that is called in creating + global entities is parse.c. */ + + static void + resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) + { + gfc_gsymbol * gsym; + uint type; + + type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; + + gsym = gfc_get_gsymbol (sym->name); + + if ((gsym->type != GSYM_UNKNOWN && gsym->type != type)) + global_used (gsym, where); + + if (gsym->type == GSYM_UNKNOWN) + { + gsym->type = type; + gsym->where = *where; + } + + gsym->used = 1; + } /************* Function resolution *************/ *************** static try *** 1016,1040 **** resolve_function (gfc_expr * expr) { gfc_actual_arglist *arg; const char *name; try t; if (resolve_actual_arglist (expr->value.function.actual) == FAILURE) return FAILURE; /* See if function is already resolved. */ if (expr->value.function.name != NULL) { if (expr->ts.type == BT_UNKNOWN) ! expr->ts = expr->symtree->n.sym->ts; t = SUCCESS; } else { /* Apply the rules of section 14.1.2. */ ! switch (procedure_kind (expr->symtree->n.sym)) { case PTYPE_GENERIC: t = resolve_generic_f (expr); --- 1173,1242 ---- resolve_function (gfc_expr * expr) { gfc_actual_arglist *arg; + gfc_symbol * sym; const char *name; try t; + int temp; + + sym = NULL; + if (expr->symtree) + sym = expr->symtree->n.sym; + + /* If the procedure is not internal, a statement function or a module + procedure,it must be external and should be checked for usage. */ + if (sym && !sym->attr.dummy && !sym->attr.contained + && sym->attr.proc != PROC_ST_FUNCTION + && !sym->attr.use_assoc) + resolve_global_procedure (sym, &expr->where, 0); + + /* Switch off assumed size checking and do this again for certain kinds + of procedure, once the procedure itself is resolved. */ + need_full_assumed_size++; if (resolve_actual_arglist (expr->value.function.actual) == FAILURE) return FAILURE; + /* Resume assumed_size checking. */ + need_full_assumed_size--; + + if (sym && sym->ts.type == BT_CHARACTER + && sym->ts.cl && sym->ts.cl->length == NULL) + { + if (sym->attr.if_source == IFSRC_IFBODY) + { + /* This follows from a slightly odd requirement at 5.1.1.5 in the + standard that allows assumed character length functions to be + declared in interfaces but not used. Picking up the symbol here, + rather than resolve_symbol, accomplishes that. */ + gfc_error ("Function '%s' can be declared in an interface to " + "return CHARACTER(*) but cannot be used at %L", + sym->name, &expr->where); + return FAILURE; + } + + /* Internal procedures are taken care of in resolve_contained_fntype. */ + if (!sym->attr.dummy && !sym->attr.contained) + { + gfc_error ("Function '%s' is declared CHARACTER(*) and cannot " + "be used at %L since it is not a dummy argument", + sym->name, &expr->where); + return FAILURE; + } + } + /* See if function is already resolved. */ if (expr->value.function.name != NULL) { if (expr->ts.type == BT_UNKNOWN) ! expr->ts = sym->ts; t = SUCCESS; } else { /* Apply the rules of section 14.1.2. */ ! switch (procedure_kind (sym)) { case PTYPE_GENERIC: t = resolve_generic_f (expr); *************** resolve_function (gfc_expr * expr) *** 1059,1064 **** --- 1261,1269 ---- if (expr->expr_type != EXPR_FUNCTION) return t; + temp = need_full_assumed_size; + need_full_assumed_size = 0; + if (expr->value.function.actual != NULL && ((expr->value.function.esym != NULL && expr->value.function.esym->attr.elemental) *************** resolve_function (gfc_expr * expr) *** 1067,1073 **** { /* The rank of an elemental is the rank of its array argument(s). */ - for (arg = expr->value.function.actual; arg; arg = arg->next) { if (arg->expr != NULL && arg->expr->rank > 0) --- 1272,1277 ---- *************** resolve_function (gfc_expr * expr) *** 1076,1083 **** --- 1280,1326 ---- break; } } + + /* Being elemental, the last upper bound of an assumed size array + argument must be present. */ + for (arg = expr->value.function.actual; arg; arg = arg->next) + { + if (arg->expr != NULL + && arg->expr->rank > 0 + && resolve_assumed_size_actual (arg->expr)) + return FAILURE; + } + } + + else if (expr->value.function.actual != NULL + && expr->value.function.isym != NULL + && expr->value.function.isym->generic_id != GFC_ISYM_LBOUND + && expr->value.function.isym->generic_id != GFC_ISYM_LOC + && expr->value.function.isym->generic_id != GFC_ISYM_PRESENT) + { + /* Array instrinsics must also have the last upper bound of an + asumed size array argument. UBOUND and SIZE have to be + excluded from the check if the second argument is anything + than a constant. */ + int inquiry; + inquiry = expr->value.function.isym->generic_id == GFC_ISYM_UBOUND + || expr->value.function.isym->generic_id == GFC_ISYM_SIZE; + + for (arg = expr->value.function.actual; arg; arg = arg->next) + { + if (inquiry && arg->next != NULL && arg->next->expr + && arg->next->expr->expr_type != EXPR_CONSTANT) + break; + + if (arg->expr != NULL + && arg->expr->rank > 0 + && resolve_assumed_size_actual (arg->expr)) + return FAILURE; + } } + need_full_assumed_size = temp; + if (!pure_function (expr, &name)) { if (forall_flag) *************** resolve_function (gfc_expr * expr) *** 1095,1100 **** --- 1338,1353 ---- } } + /* Character lengths of use associated functions may contains references to + symbols not referenced from the current program unit otherwise. Make sure + those symbols are marked as referenced. */ + + if (expr->ts.type == BT_CHARACTER && expr->value.function.esym + && expr->value.function.esym->attr.use_assoc) + { + gfc_expr_set_symbols_referenced (expr->ts.cl->length); + } + return t; } *************** resolve_call (gfc_code * c) *** 1314,1322 **** --- 1567,1599 ---- { try t; + if (c->symtree && c->symtree->n.sym + && c->symtree->n.sym->ts.type != BT_UNKNOWN) + { + gfc_error ("'%s' at %L has a type, which is not consistent with " + "the CALL at %L", c->symtree->n.sym->name, + &c->symtree->n.sym->declared_at, &c->loc); + return FAILURE; + } + + /* If the procedure is not internal or module, it must be external and + should be checked for usage. */ + if (c->symtree && c->symtree->n.sym + && !c->symtree->n.sym->attr.dummy + && !c->symtree->n.sym->attr.contained + && !c->symtree->n.sym->attr.use_assoc) + resolve_global_procedure (c->symtree->n.sym, &c->loc, 1); + + /* Switch off assumed size checking and do this again for certain kinds + of procedure, once the procedure itself is resolved. */ + need_full_assumed_size++; + if (resolve_actual_arglist (c->ext.actual) == FAILURE) return FAILURE; + /* Resume assumed_size checking. */ + need_full_assumed_size--; + if (c->resolved_sym != NULL) return SUCCESS; *************** resolve_call (gfc_code * c) *** 1338,1343 **** --- 1615,1635 ---- gfc_internal_error ("resolve_subroutine(): bad function type"); } + if (c->ext.actual != NULL + && c->symtree->n.sym->attr.elemental) + { + gfc_actual_arglist * a; + /* Being elemental, the last upper bound of an assumed size array + argument must be present. */ + for (a = c->ext.actual; a; a = a->next) + { + if (a->expr != NULL + && a->expr->rank > 0 + && resolve_assumed_size_actual (a->expr)) + return FAILURE; + } + } + return t; } *************** resolve_operator (gfc_expr * e) *** 1395,1400 **** --- 1687,1693 ---- case INTRINSIC_NOT: case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: + case INTRINSIC_PARENTHESES: if (gfc_resolve_expr (e->value.op.op1) == FAILURE) return FAILURE; break; *************** resolve_operator (gfc_expr * e) *** 1417,1423 **** break; } ! sprintf (msg, "Operand of unary numeric operator '%s' at %%L is %s", gfc_op2string (e->value.op.operator), gfc_typename (&e->ts)); goto bad_op; --- 1710,1716 ---- break; } ! sprintf (msg, _("Operand of unary numeric operator '%s' at %%L is %s"), gfc_op2string (e->value.op.operator), gfc_typename (&e->ts)); goto bad_op; *************** resolve_operator (gfc_expr * e) *** 1433,1439 **** } sprintf (msg, ! "Operands of binary numeric operator '%s' at %%L are %s/%s", gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; --- 1726,1732 ---- } sprintf (msg, ! _("Operands of binary numeric operator '%s' at %%L are %s/%s"), gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; *************** resolve_operator (gfc_expr * e) *** 1447,1453 **** } sprintf (msg, ! "Operands of string concatenation operator at %%L are %s/%s", gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; --- 1740,1746 ---- } sprintf (msg, ! _("Operands of string concatenation operator at %%L are %s/%s"), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; *************** resolve_operator (gfc_expr * e) *** 1466,1472 **** break; } ! sprintf (msg, "Operands of logical operator '%s' at %%L are %s/%s", gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); --- 1759,1765 ---- break; } ! sprintf (msg, _("Operands of logical operator '%s' at %%L are %s/%s"), gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); *************** resolve_operator (gfc_expr * e) *** 1480,1486 **** break; } ! sprintf (msg, "Operand of .NOT. operator at %%L is %s", gfc_typename (&op1->ts)); goto bad_op; --- 1773,1779 ---- break; } ! sprintf (msg, _("Operand of .NOT. operator at %%L is %s"), gfc_typename (&op1->ts)); goto bad_op; *************** resolve_operator (gfc_expr * e) *** 1490,1496 **** case INTRINSIC_LE: if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX) { ! strcpy (msg, "COMPLEX quantities cannot be compared at %L"); goto bad_op; } --- 1783,1789 ---- case INTRINSIC_LE: if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX) { ! strcpy (msg, _("COMPLEX quantities cannot be compared at %L")); goto bad_op; } *************** resolve_operator (gfc_expr * e) *** 1515,1525 **** } if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL) ! sprintf (msg, "Logicals at %%L must be compared with %s instead of %s", e->value.op.operator == INTRINSIC_EQ ? ".EQV." : ".NEQV.", gfc_op2string (e->value.op.operator)); else ! sprintf (msg, "Operands of comparison operator '%s' at %%L are %s/%s", gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); --- 1808,1820 ---- } if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL) ! sprintf (msg, ! _("Logicals at %%L must be compared with %s instead of %s"), e->value.op.operator == INTRINSIC_EQ ? ".EQV." : ".NEQV.", gfc_op2string (e->value.op.operator)); else ! sprintf (msg, ! _("Operands of comparison operator '%s' at %%L are %s/%s"), gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); *************** resolve_operator (gfc_expr * e) *** 1527,1541 **** case INTRINSIC_USER: if (op2 == NULL) ! sprintf (msg, "Operand of user operator '%s' at %%L is %s", e->value.op.uop->name, gfc_typename (&op1->ts)); else ! sprintf (msg, "Operands of user operator '%s' at %%L are %s/%s", e->value.op.uop->name, gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; default: gfc_internal_error ("resolve_operator(): Bad intrinsic"); } --- 1822,1839 ---- case INTRINSIC_USER: if (op2 == NULL) ! sprintf (msg, _("Operand of user operator '%s' at %%L is %s"), e->value.op.uop->name, gfc_typename (&op1->ts)); else ! sprintf (msg, _("Operands of user operator '%s' at %%L are %s/%s"), e->value.op.uop->name, gfc_typename (&op1->ts), gfc_typename (&op2->ts)); goto bad_op; + case INTRINSIC_PARENTHESES: + break; + default: gfc_internal_error ("resolve_operator(): Bad intrinsic"); } *************** resolve_operator (gfc_expr * e) *** 1612,1617 **** --- 1910,1916 ---- case INTRINSIC_NOT: case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: + case INTRINSIC_PARENTHESES: e->rank = op1->rank; if (e->shape == NULL) *************** gfc_resolve_index (gfc_expr * index, int *** 1819,1824 **** --- 2118,2124 ---- if (index->ts.kind != gfc_index_integer_kind || index->ts.type != BT_INTEGER) { + gfc_clear_ts (&ts); ts.type = BT_INTEGER; ts.kind = gfc_index_integer_kind; *************** find_array_spec (gfc_expr * e) *** 1881,1887 **** gfc_ref *ref; as = e->symtree->n.sym->as; - c = e->symtree->n.sym->components; for (ref = e->ref; ref; ref = ref->next) switch (ref->type) --- 2181,2186 ---- *************** find_array_spec (gfc_expr * e) *** 1895,1901 **** break; case REF_COMPONENT: ! for (; c; c = c->next) if (c == ref->u.c.component) break; --- 2194,2200 ---- break; case REF_COMPONENT: ! for (c = e->symtree->n.sym->ts.derived->components; c; c = c->next) if (c == ref->u.c.component) break; *************** find_array_spec (gfc_expr * e) *** 1909,1915 **** as = c->as; } - c = c->ts.derived->components; break; case REF_SUBSTRING: --- 2208,2213 ---- *************** resolve_array_ref (gfc_array_ref * ar) *** 1971,1977 **** } } ! if (compare_spec_to_ref (ar) == FAILURE) return FAILURE; return SUCCESS; --- 2269,2275 ---- } } ! if (!ar->as->cray_pointee && compare_spec_to_ref (ar) == FAILURE) return FAILURE; return SUCCESS; *************** resolve_variable (gfc_expr * e) *** 2262,2267 **** --- 2560,2568 ---- e->ts = sym->ts; } + if (check_assumed_size_reference (sym, e)) + return FAILURE; + return SUCCESS; } *************** gfc_resolve_expr (gfc_expr * e) *** 2342,2365 **** INTEGER or (optionally) REAL type. */ static try ! gfc_resolve_iterator_expr (gfc_expr * expr, bool real_ok, const char * name) { if (gfc_resolve_expr (expr) == FAILURE) return FAILURE; if (expr->rank != 0) { ! gfc_error ("%s at %L must be a scalar", name, &expr->where); return FAILURE; } if (!(expr->ts.type == BT_INTEGER || (expr->ts.type == BT_REAL && real_ok))) { ! gfc_error ("%s at %L must be INTEGER%s", ! name, ! &expr->where, ! real_ok ? " or REAL" : ""); return FAILURE; } return SUCCESS; --- 2643,2668 ---- INTEGER or (optionally) REAL type. */ static try ! gfc_resolve_iterator_expr (gfc_expr * expr, bool real_ok, ! const char * name_msgid) { if (gfc_resolve_expr (expr) == FAILURE) return FAILURE; if (expr->rank != 0) { ! gfc_error ("%s at %L must be a scalar", _(name_msgid), &expr->where); return FAILURE; } if (!(expr->ts.type == BT_INTEGER || (expr->ts.type == BT_REAL && real_ok))) { ! if (real_ok) ! gfc_error ("%s at %L must be INTEGER or REAL", _(name_msgid), ! &expr->where); ! else ! gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where); return FAILURE; } return SUCCESS; *************** gfc_resolve_iterator (gfc_iterator * ite *** 2431,2437 **** } ! /* Resolve a list of FORALL iterators. */ static void resolve_forall_iterators (gfc_forall_iterator * iter) --- 2734,2742 ---- } ! /* Resolve a list of FORALL iterators. The FORALL index-name is constrained ! to be a scalar INTEGER variable. The subscripts and stride are scalar ! INTEGERs, and if stride is a constant it must be nonzero. */ static void resolve_forall_iterators (gfc_forall_iterator * iter) *************** resolve_forall_iterators (gfc_forall_ite *** 2440,2467 **** while (iter) { if (gfc_resolve_expr (iter->var) == SUCCESS ! && iter->var->ts.type != BT_INTEGER) ! gfc_error ("FORALL Iteration variable at %L must be INTEGER", &iter->var->where); if (gfc_resolve_expr (iter->start) == SUCCESS ! && iter->start->ts.type != BT_INTEGER) ! gfc_error ("FORALL start expression at %L must be INTEGER", &iter->start->where); if (iter->var->ts.kind != iter->start->ts.kind) gfc_convert_type (iter->start, &iter->var->ts, 2); if (gfc_resolve_expr (iter->end) == SUCCESS ! && iter->end->ts.type != BT_INTEGER) ! gfc_error ("FORALL end expression at %L must be INTEGER", &iter->end->where); if (iter->var->ts.kind != iter->end->ts.kind) gfc_convert_type (iter->end, &iter->var->ts, 2); ! if (gfc_resolve_expr (iter->stride) == SUCCESS ! && iter->stride->ts.type != BT_INTEGER) ! gfc_error ("FORALL Stride expression at %L must be INTEGER", ! &iter->stride->where); if (iter->var->ts.kind != iter->stride->ts.kind) gfc_convert_type (iter->stride, &iter->var->ts, 2); --- 2745,2779 ---- while (iter) { if (gfc_resolve_expr (iter->var) == SUCCESS ! && (iter->var->ts.type != BT_INTEGER || iter->var->rank != 0)) ! gfc_error ("FORALL index-name at %L must be a scalar INTEGER", &iter->var->where); if (gfc_resolve_expr (iter->start) == SUCCESS ! && (iter->start->ts.type != BT_INTEGER || iter->start->rank != 0)) ! gfc_error ("FORALL start expression at %L must be a scalar INTEGER", &iter->start->where); if (iter->var->ts.kind != iter->start->ts.kind) gfc_convert_type (iter->start, &iter->var->ts, 2); if (gfc_resolve_expr (iter->end) == SUCCESS ! && (iter->end->ts.type != BT_INTEGER || iter->end->rank != 0)) ! gfc_error ("FORALL end expression at %L must be a scalar INTEGER", &iter->end->where); if (iter->var->ts.kind != iter->end->ts.kind) gfc_convert_type (iter->end, &iter->var->ts, 2); ! if (gfc_resolve_expr (iter->stride) == SUCCESS) ! { ! if (iter->stride->ts.type != BT_INTEGER || iter->stride->rank != 0) ! gfc_error ("FORALL stride expression at %L must be a scalar %s", ! &iter->stride->where, "INTEGER"); ! ! if (iter->stride->expr_type == EXPR_CONSTANT ! && mpz_cmp_ui(iter->stride->value.integer, 0) == 0) ! gfc_error ("FORALL stride expression at %L cannot be zero", ! &iter->stride->where); ! } if (iter->var->ts.kind != iter->stride->ts.kind) gfc_convert_type (iter->stride, &iter->var->ts, 2); *************** derived_pointer (gfc_symbol * sym) *** 2492,2497 **** --- 2804,2832 ---- } + /* Given a pointer to a symbol that is a derived type, see if it's + inaccessible, i.e. if it's defined in another module and the components are + PRIVATE. The search is recursive if necessary. Returns zero if no + inaccessible components are found, nonzero otherwise. */ + + static int + derived_inaccessible (gfc_symbol *sym) + { + gfc_component *c; + + if (sym->attr.use_assoc && sym->component_access == ACCESS_PRIVATE) + return 1; + + for (c = sym->components; c; c = c->next) + { + if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.derived)) + return 1; + } + + return 0; + } + + /* Resolve the argument of a deallocate expression. The expression must be a pointer or a full array. */ *************** resolve_deallocate_expr (gfc_expr * e) *** 2542,2558 **** } /* Resolve the expression in an ALLOCATE statement, doing the additional checks to see whether the expression is OK or not. The expression must have a trailing array reference that gives the size of the array. */ static try ! resolve_allocate_expr (gfc_expr * e) { int i, pointer, allocatable, dimension; symbol_attribute attr; gfc_ref *ref, *ref2; gfc_array_ref *ar; if (gfc_resolve_expr (e) == FAILURE) return FAILURE; --- 2877,2925 ---- } + /* Given the expression node e for an allocatable/pointer of derived type to be + allocated, get the expression node to be initialized afterwards (needed for + derived types with default initializers). */ + + static gfc_expr * + expr_to_initialize (gfc_expr * e) + { + gfc_expr *result; + gfc_ref *ref; + int i; + + result = gfc_copy_expr (e); + + /* Change the last array reference from AR_ELEMENT to AR_FULL. */ + for (ref = result->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->next == NULL) + { + ref->u.ar.type = AR_FULL; + + for (i = 0; i < ref->u.ar.dimen; i++) + ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL; + + result->rank = ref->u.ar.dimen; + break; + } + + return result; + } + + /* Resolve the expression in an ALLOCATE statement, doing the additional checks to see whether the expression is OK or not. The expression must have a trailing array reference that gives the size of the array. */ static try ! resolve_allocate_expr (gfc_expr * e, gfc_code * code) { int i, pointer, allocatable, dimension; symbol_attribute attr; gfc_ref *ref, *ref2; gfc_array_ref *ar; + gfc_code *init_st; + gfc_expr *init_e; if (gfc_resolve_expr (e) == FAILURE) return FAILURE; *************** resolve_allocate_expr (gfc_expr * e) *** 2607,2612 **** --- 2974,2992 ---- return FAILURE; } + /* Add default initializer for those derived types that need them. */ + if (e->ts.type == BT_DERIVED && (init_e = gfc_default_initializer (&e->ts))) + { + init_st = gfc_get_code (); + init_st->loc = code->loc; + init_st->op = EXEC_ASSIGN; + init_st->expr = expr_to_initialize (e); + init_st->expr2 = init_e; + + init_st->next = code->next; + code->next = init_st; + } + if (pointer && dimension == 0) return SUCCESS; *************** resolve_select (gfc_code * code) *** 3158,3164 **** /* Resolve a transfer statement. This is making sure that: -- a derived type being transferred has only non-pointer components ! -- a derived type being transferred doesn't have private components -- we're not trying to transfer a whole assumed size array. */ static void --- 3538,3545 ---- /* Resolve a transfer statement. This is making sure that: -- a derived type being transferred has only non-pointer components ! -- a derived type being transferred doesn't have private components, unless ! it's being transferred from the module where the type was defined -- we're not trying to transfer a whole assumed size array. */ static void *************** resolve_transfer (gfc_code * code) *** 3193,3199 **** return; } ! if (ts->derived->component_access == ACCESS_PRIVATE) { gfc_error ("Data transfer element at %L cannot have " "PRIVATE components",&code->loc); --- 3574,3580 ---- return; } ! if (derived_inaccessible (ts->derived)) { gfc_error ("Data transfer element at %L cannot have " "PRIVATE components",&code->loc); *************** resolve_branch (gfc_st_label * label, gf *** 3276,3284 **** if (found == NULL) { ! /* still nothing, so illegal. */ ! gfc_error_now ("Label at %L is not in the same block as the " ! "GOTO statement at %L", &lp->where, &code->loc); return; } --- 3657,3668 ---- if (found == NULL) { ! /* The label is not in an enclosing block, so illegal. This was ! allowed in Fortran 66, so we allow it as extension. We also ! forego further checks if we run into this. */ ! gfc_notify_std (GFC_STD_LEGACY, ! "Label at %L is not in the same block as the " ! "GOTO statement at %L", &lp->where, &code->loc); return; } *************** resolve_blocks (gfc_code * b, gfc_namesp *** 3766,3771 **** --- 4150,4158 ---- case EXEC_FORALL: case EXEC_DO: case EXEC_DO_WHILE: + case EXEC_READ: + case EXEC_WRITE: + case EXEC_IOLENGTH: break; default: *************** resolve_code (gfc_code * code, gfc_names *** 3854,3860 **** break; if (gfc_extend_assign (code, ns) == SUCCESS) ! goto call; if (gfc_pure (NULL)) { --- 4241,4256 ---- break; if (gfc_extend_assign (code, ns) == SUCCESS) ! { ! if (gfc_pure (NULL) && !gfc_pure (code->symtree->n.sym)) ! { ! gfc_error ("Subroutine '%s' called instead of assignment at " ! "%L must be PURE", code->symtree->n.sym->name, ! &code->loc); ! break; ! } ! goto call; ! } if (gfc_pure (NULL)) { *************** resolve_code (gfc_code * code, gfc_names *** 3954,3960 **** "of type INTEGER", &code->expr->where); for (a = code->ext.alloc_list; a; a = a->next) ! resolve_allocate_expr (a->expr); break; --- 4350,4356 ---- "of type INTEGER", &code->expr->where); for (a = code->ext.alloc_list; a; a = a->next) ! resolve_allocate_expr (a->expr, code); break; *************** resolve_code (gfc_code * code, gfc_names *** 3987,3992 **** --- 4383,4389 ---- case EXEC_BACKSPACE: case EXEC_ENDFILE: case EXEC_REWIND: + case EXEC_FLUSH: if (gfc_resolve_filepos (code->ext.filepos) == FAILURE) break; *************** resolve_values (gfc_symbol * sym) *** 4057,4062 **** --- 4454,4893 ---- } + /* Resolve an index expression. */ + + static try + resolve_index_expr (gfc_expr * e) + { + + if (gfc_resolve_expr (e) == FAILURE) + return FAILURE; + + if (gfc_simplify_expr (e, 0) == FAILURE) + return FAILURE; + + if (gfc_specification_expr (e) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + /* Resolve a charlen structure. */ + + static try + resolve_charlen (gfc_charlen *cl) + { + if (cl->resolved) + return SUCCESS; + + cl->resolved = 1; + + if (resolve_index_expr (cl->length) == FAILURE) + return FAILURE; + + return SUCCESS; + } + + + /* Resolution of common features of flavors variable and procedure. */ + + static try + resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) + { + /* Constraints on deferred shape variable. */ + if (sym->as == NULL || sym->as->type != AS_DEFERRED) + { + if (sym->attr.allocatable) + { + if (sym->attr.dimension) + gfc_error ("Allocatable array '%s' at %L must have " + "a deferred shape", sym->name, &sym->declared_at); + else + gfc_error ("Scalar object '%s' at %L may not be ALLOCATABLE", + sym->name, &sym->declared_at); + return FAILURE; + } + + if (sym->attr.pointer && sym->attr.dimension) + { + gfc_error ("Array pointer '%s' at %L must have a deferred shape", + sym->name, &sym->declared_at); + return FAILURE; + } + + } + else + { + if (!mp_flag && !sym->attr.allocatable + && !sym->attr.pointer && !sym->attr.dummy) + { + gfc_error ("Array '%s' at %L cannot have a deferred shape", + sym->name, &sym->declared_at); + return FAILURE; + } + } + return SUCCESS; + } + + /* Resolve symbols with flavor variable. */ + + static try + resolve_fl_variable (gfc_symbol *sym, int mp_flag) + { + int flag; + int i; + gfc_expr *e; + gfc_expr *constructor_expr; + + if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE) + return FAILURE; + + /* The shape of a main program or module array needs to be constant. */ + if (sym->as != NULL + && sym->ns->proc_name + && (sym->ns->proc_name->attr.flavor == FL_MODULE + || sym->ns->proc_name->attr.is_main_program) + && !sym->attr.use_assoc + && !sym->attr.allocatable + && !sym->attr.pointer) + { + /* Unfortunately, !gfc_is_compile_time_shape hits a legal case that + has not been simplified; parameter array references. Do the + simplification now. */ + flag = 0; + for (i = 0; i < sym->as->rank; i++) + { + e = sym->as->lower[i]; + if (e && (resolve_index_expr (e) == FAILURE + || !gfc_is_constant_expr (e))) + { + flag = 1; + break; + } + + e = sym->as->upper[i]; + if (e && (resolve_index_expr (e) == FAILURE + || !gfc_is_constant_expr (e))) + { + flag = 1; + break; + } + } + + if (flag) + { + gfc_error ("The module or main program array '%s' at %L must " + "have constant shape", sym->name, &sym->declared_at); + return FAILURE; + } + } + + if (sym->ts.type == BT_CHARACTER) + { + /* Make sure that character string variables with assumed length are + dummy arguments. */ + e = sym->ts.cl->length; + if (e == NULL && !sym->attr.dummy && !sym->attr.result) + { + gfc_error ("Entity with assumed character length at %L must be a " + "dummy argument or a PARAMETER", &sym->declared_at); + return FAILURE; + } + + if (!gfc_is_constant_expr (e) + && !(e->expr_type == EXPR_VARIABLE + && e->symtree->n.sym->attr.flavor == FL_PARAMETER) + && sym->ns->proc_name + && (sym->ns->proc_name->attr.flavor == FL_MODULE + || sym->ns->proc_name->attr.is_main_program) + && !sym->attr.use_assoc) + { + gfc_error ("'%s' at %L must have constant character length " + "in this context", sym->name, &sym->declared_at); + return FAILURE; + } + } + + /* Can the symbol have an initializer? */ + flag = 0; + if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy + || sym->attr.intrinsic || sym->attr.result) + flag = 1; + else if (sym->attr.dimension && !sym->attr.pointer) + { + /* Don't allow initialization of automatic arrays. */ + for (i = 0; i < sym->as->rank; i++) + { + if (sym->as->lower[i] == NULL + || sym->as->lower[i]->expr_type != EXPR_CONSTANT + || sym->as->upper[i] == NULL + || sym->as->upper[i]->expr_type != EXPR_CONSTANT) + { + flag = 1; + break; + } + } + } + + /* Reject illegal initializers. */ + if (sym->value && flag) + { + if (sym->attr.allocatable) + gfc_error ("Allocatable '%s' at %L cannot have an initializer", + sym->name, &sym->declared_at); + else if (sym->attr.external) + gfc_error ("External '%s' at %L cannot have an initializer", + sym->name, &sym->declared_at); + else if (sym->attr.dummy) + gfc_error ("Dummy '%s' at %L cannot have an initializer", + sym->name, &sym->declared_at); + else if (sym->attr.intrinsic) + gfc_error ("Intrinsic '%s' at %L cannot have an initializer", + sym->name, &sym->declared_at); + else if (sym->attr.result) + gfc_error ("Function result '%s' at %L cannot have an initializer", + sym->name, &sym->declared_at); + else + gfc_error ("Automatic array '%s' at %L cannot have an initializer", + sym->name, &sym->declared_at); + return FAILURE; + } + + /* 4th constraint in section 11.3: "If an object of a type for which + component-initialization is specified (R429) appears in the + specification-part of a module and does not have the ALLOCATABLE + or POINTER attribute, the object shall have the SAVE attribute." */ + + constructor_expr = NULL; + if (sym->ts.type == BT_DERIVED && !(sym->value || flag)) + constructor_expr = gfc_default_initializer (&sym->ts); + + if (sym->ns->proc_name + && sym->ns->proc_name->attr.flavor == FL_MODULE + && constructor_expr + && !sym->ns->save_all && !sym->attr.save + && !sym->attr.pointer && !sym->attr.allocatable) + { + gfc_error("Object '%s' at %L must have the SAVE attribute %s", + sym->name, &sym->declared_at, + "for default initialization of a component"); + return FAILURE; + } + + /* Assign default initializer. */ + if (sym->ts.type == BT_DERIVED && !(sym->value || flag) + && !sym->attr.pointer) + sym->value = gfc_default_initializer (&sym->ts); + + return SUCCESS; + } + + + /* Resolve a procedure. */ + + static try + resolve_fl_procedure (gfc_symbol *sym, int mp_flag) + { + gfc_formal_arglist *arg; + + if (sym->attr.function + && resolve_fl_var_and_proc (sym, mp_flag) == FAILURE) + return FAILURE; + + if (sym->attr.proc == PROC_ST_FUNCTION) + { + if (sym->ts.type == BT_CHARACTER) + { + gfc_charlen *cl = sym->ts.cl; + if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT) + { + gfc_error ("Character-valued statement function '%s' at %L must " + "have constant length", sym->name, &sym->declared_at); + return FAILURE; + } + } + } + + /* Ensure that derived type formal arguments of a public procedure + are not of a private type. */ + if (gfc_check_access(sym->attr.access, sym->ns->default_access)) + { + for (arg = sym->formal; arg; arg = arg->next) + { + if (arg->sym + && arg->sym->ts.type == BT_DERIVED + && !arg->sym->ts.derived->attr.use_assoc + && !gfc_check_access(arg->sym->ts.derived->attr.access, + arg->sym->ts.derived->ns->default_access)) + { + gfc_error_now ("'%s' is of a PRIVATE type and cannot be " + "a dummy argument of '%s', which is " + "PUBLIC at %L", arg->sym->name, sym->name, + &sym->declared_at); + /* Stop this message from recurring. */ + arg->sym->ts.derived->attr.access = ACCESS_PUBLIC; + return FAILURE; + } + } + } + + /* An external symbol may not have an intializer because it is taken to be + a procedure. */ + if (sym->attr.external && sym->value) + { + gfc_error ("External object '%s' at %L may not have an initializer", + sym->name, &sym->declared_at); + return FAILURE; + } + + /* 5.1.1.5 of the Standard: A function name declared with an asterisk + char-len-param shall not be array-valued, pointer-valued, recursive + or pure. ....snip... A character value of * may only be used in the + following ways: (i) Dummy arg of procedure - dummy associates with + actual length; (ii) To declare a named constant; or (iii) External + function - but length must be declared in calling scoping unit. */ + if (sym->attr.function + && sym->ts.type == BT_CHARACTER + && sym->ts.cl && sym->ts.cl->length == NULL) + { + if ((sym->as && sym->as->rank) || (sym->attr.pointer) + || (sym->attr.recursive) || (sym->attr.pure)) + { + if (sym->as && sym->as->rank) + gfc_error ("CHARACTER(*) function '%s' at %L cannot be " + "array-valued", sym->name, &sym->declared_at); + + if (sym->attr.pointer) + gfc_error ("CHARACTER(*) function '%s' at %L cannot be " + "pointer-valued", sym->name, &sym->declared_at); + + if (sym->attr.pure) + gfc_error ("CHARACTER(*) function '%s' at %L cannot be " + "pure", sym->name, &sym->declared_at); + + if (sym->attr.recursive) + gfc_error ("CHARACTER(*) function '%s' at %L cannot be " + "recursive", sym->name, &sym->declared_at); + + return FAILURE; + } + + /* Appendix B.2 of the standard. Contained functions give an + error anyway. Fixed-form is likely to be F77/legacy. */ + if (!sym->attr.contained && gfc_current_form != FORM_FIXED) + gfc_notify_std (GFC_STD_F95_OBS, "CHARACTER(*) function " + "'%s' at %L is obsolescent in fortran 95", + sym->name, &sym->declared_at); + } + return SUCCESS; + } + + + /* Resolve the components of a derived type. */ + + static try + resolve_fl_derived (gfc_symbol *sym) + { + gfc_component *c; + gfc_dt_list * dt_list; + int i; + + for (c = sym->components; c != NULL; c = c->next) + { + if (c->ts.type == BT_CHARACTER) + { + if (c->ts.cl->length == NULL + || (resolve_charlen (c->ts.cl) == FAILURE) + || !gfc_is_constant_expr (c->ts.cl->length)) + { + gfc_error ("Character length of component '%s' needs to " + "be a constant specification expression at %L.", + c->name, + c->ts.cl->length ? &c->ts.cl->length->where : &c->loc); + return FAILURE; + } + } + + if (c->ts.type == BT_DERIVED + && sym->component_access != ACCESS_PRIVATE + && gfc_check_access(sym->attr.access, sym->ns->default_access) + && !c->ts.derived->attr.use_assoc + && !gfc_check_access(c->ts.derived->attr.access, + c->ts.derived->ns->default_access)) + { + gfc_error ("The component '%s' is a PRIVATE type and cannot be " + "a component of '%s', which is PUBLIC at %L", + c->name, sym->name, &sym->declared_at); + return FAILURE; + } + + if (c->pointer || c->as == NULL) + continue; + + for (i = 0; i < c->as->rank; i++) + { + if (c->as->lower[i] == NULL + || !gfc_is_constant_expr (c->as->lower[i]) + || (resolve_index_expr (c->as->lower[i]) == FAILURE) + || c->as->upper[i] == NULL + || (resolve_index_expr (c->as->upper[i]) == FAILURE) + || !gfc_is_constant_expr (c->as->upper[i])) + { + gfc_error ("Component '%s' of '%s' at %L must have " + "constant array bounds.", + c->name, sym->name, &c->loc); + return FAILURE; + } + } + } + + /* Add derived type to the derived type list. */ + dt_list = gfc_get_dt_list (); + dt_list->next = sym->ns->derived_types; + dt_list->derived = sym; + sym->ns->derived_types = dt_list; + + return SUCCESS; + } + + + static try + resolve_fl_parameter (gfc_symbol *sym) + { + /* A parameter array's shape needs to be constant. */ + if (sym->as != NULL && !gfc_is_compile_time_shape (sym->as)) + { + gfc_error ("Parameter array '%s' at %L cannot be automatic " + "or assumed shape", sym->name, &sym->declared_at); + return FAILURE; + } + + /* Make sure a parameter that has been implicitly typed still + matches the implicit type, since PARAMETER statements can precede + IMPLICIT statements. */ + if (sym->attr.implicit_type + && !gfc_compare_types (&sym->ts, + gfc_get_default_type (sym, sym->ns))) + { + gfc_error ("Implicitly typed PARAMETER '%s' at %L doesn't match a " + "later IMPLICIT type", sym->name, &sym->declared_at); + return FAILURE; + } + + /* Make sure the types of derived parameters are consistent. This + type checking is deferred until resolution because the type may + refer to a derived type from the host. */ + if (sym->ts.type == BT_DERIVED + && !gfc_compare_types (&sym->ts, &sym->value->ts)) + { + gfc_error ("Incompatible derived type in PARAMETER at %L", + &sym->value->where); + return FAILURE; + } + return SUCCESS; + } + + /* Do anything necessary to resolve a symbol. Right now, we just assume that an otherwise unknown symbol is a variable. This sort of thing commonly happens for symbols in module. */ *************** resolve_symbol (gfc_symbol * sym) *** 4067,4078 **** /* Zero if we are checking a formal namespace. */ static int formal_ns_flag = 1; int formal_ns_save, check_constant, mp_flag; - int i; - const char *whynot; gfc_namelist *nl; ! gfc_symtree * symtree; ! gfc_symtree * this_symtree; ! gfc_namespace * ns; if (sym->attr.flavor == FL_UNKNOWN) { --- 4898,4908 ---- /* Zero if we are checking a formal namespace. */ static int formal_ns_flag = 1; int formal_ns_save, check_constant, mp_flag; gfc_namelist *nl; ! gfc_symtree *symtree; ! gfc_symtree *this_symtree; ! gfc_namespace *ns; ! gfc_component *c; if (sym->attr.flavor == FL_UNKNOWN) { *************** resolve_symbol (gfc_symbol * sym) *** 4108,4113 **** --- 4938,4946 ---- } } + if (sym->attr.flavor == FL_DERIVED && resolve_fl_derived (sym) == FAILURE) + return; + /* Symbols that are module procedures with results (functions) have the types and array specification copied for type checking in procedures that call them, as well as for saving to a module *************** resolve_symbol (gfc_symbol * sym) *** 4123,4130 **** if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function) { if (!mp_flag) ! gfc_set_default_type (sym, 0, NULL); else { /* Result may be in another namespace. */ --- 4956,4965 ---- if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function) { + /* The specific case of an external procedure should emit an error + in the case that there is no implicit type. */ if (!mp_flag) ! gfc_set_default_type (sym, sym->attr.external, NULL); else { /* Result may be in another namespace. */ *************** resolve_symbol (gfc_symbol * sym) *** 4132,4139 **** sym->ts = sym->result->ts; sym->as = gfc_copy_array_spec (sym->result->as); ! sym->attr.dimension = sym->result->attr.dimension; ! sym->attr.pointer = sym->result->attr.pointer; } } } --- 4967,4974 ---- sym->ts = sym->result->ts; sym->as = gfc_copy_array_spec (sym->result->as); ! sym->attr.dimension = sym->result->attr.dimension; ! sym->attr.pointer = sym->result->attr.pointer; } } } *************** resolve_symbol (gfc_symbol * sym) *** 4146,4204 **** || sym->as->type == AS_ASSUMED_SHAPE) && sym->attr.dummy == 0) { ! gfc_error ("Assumed %s array at %L must be a dummy argument", ! sym->as->type == AS_ASSUMED_SIZE ? "size" : "shape", ! &sym->declared_at); ! return; ! } ! ! /* A parameter array's shape needs to be constant. */ ! ! if (sym->attr.flavor == FL_PARAMETER && sym->as != NULL ! && !gfc_is_compile_time_shape (sym->as)) ! { ! gfc_error ("Parameter array '%s' at %L cannot be automatic " ! "or assumed shape", sym->name, &sym->declared_at); ! return; ! } ! ! /* Make sure that character string variables with assumed length are ! dummy arguments. */ ! ! if (sym->attr.flavor == FL_VARIABLE && !sym->attr.result ! && sym->ts.type == BT_CHARACTER ! && sym->ts.cl->length == NULL && sym->attr.dummy == 0) ! { ! gfc_error ("Entity with assumed character length at %L must be a " ! "dummy argument or a PARAMETER", &sym->declared_at); return; } - /* Make sure a parameter that has been implicitly typed still - matches the implicit type, since PARAMETER statements can precede - IMPLICIT statements. */ - - if (sym->attr.flavor == FL_PARAMETER - && sym->attr.implicit_type - && !gfc_compare_types (&sym->ts, gfc_get_default_type (sym, sym->ns))) - gfc_error ("Implicitly typed PARAMETER '%s' at %L doesn't match a " - "later IMPLICIT type", sym->name, &sym->declared_at); - - /* Make sure the types of derived parameters are consistent. This - type checking is deferred until resolution because the type may - refer to a derived type from the host. */ - - if (sym->attr.flavor == FL_PARAMETER - && sym->ts.type == BT_DERIVED - && !gfc_compare_types (&sym->ts, &sym->value->ts)) - gfc_error ("Incompatible derived type in PARAMETER at %L", - &sym->value->where); - /* Make sure symbols with known intent or optional are really dummy variable. Because of ENTRY statement, this has to be deferred until resolution time. */ ! if (! sym->attr.dummy && (sym->attr.optional || sym->attr.intent != INTENT_UNKNOWN)) { --- 4981,5000 ---- || sym->as->type == AS_ASSUMED_SHAPE) && sym->attr.dummy == 0) { ! if (sym->as->type == AS_ASSUMED_SIZE) ! gfc_error ("Assumed size array at %L must be a dummy argument", ! &sym->declared_at); ! else ! gfc_error ("Assumed shape array at %L must be a dummy argument", ! &sym->declared_at); return; } /* Make sure symbols with known intent or optional are really dummy variable. Because of ENTRY statement, this has to be deferred until resolution time. */ ! if (!sym->attr.dummy && (sym->attr.optional || sym->attr.intent != INTENT_UNKNOWN)) { *************** resolve_symbol (gfc_symbol * sym) *** 4206,4258 **** return; } ! if (sym->attr.proc == PROC_ST_FUNCTION) { ! if (sym->ts.type == BT_CHARACTER) ! { ! gfc_charlen *cl = sym->ts.cl; ! if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT) ! { ! gfc_error ("Character-valued statement function '%s' at %L must " ! "have constant length", sym->name, &sym->declared_at); ! return; ! } ! } } ! /* Constraints on deferred shape variable. */ ! if (sym->attr.flavor == FL_VARIABLE ! || (sym->attr.flavor == FL_PROCEDURE ! && sym->attr.function)) { ! if (sym->as == NULL || sym->as->type != AS_DEFERRED) ! { ! if (sym->attr.allocatable) ! { ! if (sym->attr.dimension) ! gfc_error ("Allocatable array at %L must have a deferred shape", ! &sym->declared_at); ! else ! gfc_error ("Object at %L may not be ALLOCATABLE", ! &sym->declared_at); ! return; ! } ! ! if (sym->attr.pointer && sym->attr.dimension) ! { ! gfc_error ("Pointer to array at %L must have a deferred shape", ! &sym->declared_at); ! return; ! } ! ! } ! else { ! if (!mp_flag && !sym->attr.allocatable ! && !sym->attr.pointer && !sym->attr.dummy) { ! gfc_error ("Array at %L cannot have a deferred shape", ! &sym->declared_at); return; } } --- 5002,5040 ---- return; } ! /* If a derived type symbol has reached this point, without its ! type being declared, we have an error. Notice that most ! conditions that produce undefined derived types have already ! been dealt with. However, the likes of: ! implicit type(t) (t) ..... call foo (t) will get us here if ! the type is not declared in the scope of the implicit ! statement. Change the type to BT_UNKNOWN, both because it is so ! and to prevent an ICE. */ ! if (sym->ts.type == BT_DERIVED ! && sym->ts.derived->components == NULL) { ! gfc_error ("The derived type '%s' at %L is of type '%s', " ! "which has not been defined.", sym->name, ! &sym->declared_at, sym->ts.derived->name); ! sym->ts.type = BT_UNKNOWN; ! return; } ! /* An assumed-size array with INTENT(OUT) shall not be of a type for which ! default initialization is defined (5.1.2.4.4). */ ! if (sym->ts.type == BT_DERIVED ! && sym->attr.dummy ! && sym->attr.intent == INTENT_OUT ! && sym->as ! && sym->as->type == AS_ASSUMED_SIZE) { ! for (c = sym->ts.derived->components; c; c = c->next) { ! if (c->initializer) { ! gfc_error ("The INTENT(OUT) dummy argument '%s' at %L is " ! "ASSUMED SIZE and so cannot have a default initializer", ! sym->name, &sym->declared_at); return; } } *************** resolve_symbol (gfc_symbol * sym) *** 4261,4305 **** switch (sym->attr.flavor) { case FL_VARIABLE: ! /* Can the sybol have an initializer? */ ! whynot = NULL; ! if (sym->attr.allocatable) ! whynot = "Allocatable"; ! else if (sym->attr.external) ! whynot = "External"; ! else if (sym->attr.dummy) ! whynot = "Dummy"; ! else if (sym->attr.intrinsic) ! whynot = "Intrinsic"; ! else if (sym->attr.result) ! whynot = "Function Result"; ! else if (sym->attr.dimension && !sym->attr.pointer) ! { ! /* Don't allow initialization of automatic arrays. */ ! for (i = 0; i < sym->as->rank; i++) ! { ! if (sym->as->lower[i] == NULL ! || sym->as->lower[i]->expr_type != EXPR_CONSTANT ! || sym->as->upper[i] == NULL ! || sym->as->upper[i]->expr_type != EXPR_CONSTANT) ! { ! whynot = "Automatic array"; ! break; ! } ! } ! } ! ! /* Reject illegal initializers. */ ! if (sym->value && whynot) ! { ! gfc_error ("%s '%s' at %L cannot have an initializer", ! whynot, sym->name, &sym->declared_at); ! return; ! } ! /* Assign default initializer. */ ! if (sym->ts.type == BT_DERIVED && !(sym->value || whynot)) ! sym->value = gfc_default_initializer (&sym->ts); break; case FL_NAMELIST: --- 5043,5055 ---- switch (sym->attr.flavor) { case FL_VARIABLE: ! if (resolve_fl_variable (sym, mp_flag) == FAILURE) ! return; ! break; ! case FL_PROCEDURE: ! if (resolve_fl_procedure (sym, mp_flag) == FAILURE) ! return; break; case FL_NAMELIST: *************** resolve_symbol (gfc_symbol * sym) *** 4308,4323 **** { for (nl = sym->namelist; nl; nl = nl->next) { ! if (!gfc_check_access(nl->sym->attr.access, nl->sym->ns->default_access)) gfc_error ("PRIVATE symbol '%s' cannot be member of " "PUBLIC namelist at %L", nl->sym->name, &sym->declared_at); } } break; default: break; } --- 5058,5085 ---- { for (nl = sym->namelist; nl; nl = nl->next) { ! if (!nl->sym->attr.use_assoc ! && ! !(sym->ns->parent == nl->sym->ns) ! && ! !gfc_check_access(nl->sym->attr.access, nl->sym->ns->default_access)) gfc_error ("PRIVATE symbol '%s' cannot be member of " "PUBLIC namelist at %L", nl->sym->name, &sym->declared_at); } } + + break; + + case FL_PARAMETER: + if (resolve_fl_parameter (sym) == FAILURE) + return; + break; default: + break; } *************** check_data_variable (gfc_data_variable * *** 4398,4403 **** --- 5160,5172 ---- if (e->expr_type != EXPR_VARIABLE) gfc_internal_error ("check_data_variable(): Bad expression"); + if (e->symtree->n.sym->ns->is_block_data + && !e->symtree->n.sym->attr.in_common) + { + gfc_error ("BLOCK DATA element '%s' at %L must be in COMMON", + e->symtree->n.sym->name, &e->symtree->n.sym->declared_at); + } + if (e->rank == 0) { mpz_init_set_ui (size, 1); *************** warn_unused_label (gfc_namespace * ns) *** 4747,4752 **** --- 5516,5580 ---- } + /* Returns the sequence type of a symbol or sequence. */ + + static seq_type + sequence_type (gfc_typespec ts) + { + seq_type result; + gfc_component *c; + + switch (ts.type) + { + case BT_DERIVED: + + if (ts.derived->components == NULL) + return SEQ_NONDEFAULT; + + result = sequence_type (ts.derived->components->ts); + for (c = ts.derived->components->next; c; c = c->next) + if (sequence_type (c->ts) != result) + return SEQ_MIXED; + + return result; + + case BT_CHARACTER: + if (ts.kind != gfc_default_character_kind) + return SEQ_NONDEFAULT; + + return SEQ_CHARACTER; + + case BT_INTEGER: + if (ts.kind != gfc_default_integer_kind) + return SEQ_NONDEFAULT; + + return SEQ_NUMERIC; + + case BT_REAL: + if (!(ts.kind == gfc_default_real_kind + || ts.kind == gfc_default_double_kind)) + return SEQ_NONDEFAULT; + + return SEQ_NUMERIC; + + case BT_COMPLEX: + if (ts.kind != gfc_default_complex_kind) + return SEQ_NONDEFAULT; + + return SEQ_NUMERIC; + + case BT_LOGICAL: + if (ts.kind != gfc_default_logical_kind) + return SEQ_NONDEFAULT; + + return SEQ_NUMERIC; + + default: + return SEQ_NONDEFAULT; + } + } + + /* Resolve derived type EQUIVALENCE object. */ static try *************** resolve_equivalence_derived (gfc_symbol *** 4776,4782 **** in the structure. */ if (c->pointer) { ! gfc_error ("Derived type variable '%s' at %L has pointer componet(s) " "cannot be an EQUIVALENCE object", sym->name, &e->where); return FAILURE; } --- 5604,5617 ---- in the structure. */ if (c->pointer) { ! gfc_error ("Derived type variable '%s' at %L with pointer component(s) " ! "cannot be an EQUIVALENCE object", sym->name, &e->where); ! return FAILURE; ! } ! ! if (c->initializer) ! { ! gfc_error ("Derived type variable '%s' at %L with default initializer " "cannot be an EQUIVALENCE object", sym->name, &e->where); return FAILURE; } *************** resolve_equivalence_derived (gfc_symbol *** 4786,4807 **** /* Resolve equivalence object. ! An EQUIVALENCE object shall not be a dummy argument, a pointer, an ! allocatable array, an object of nonsequence derived type, an object of sequence derived type containing a pointer at any level of component selection, an automatic object, a function name, an entry name, a result name, a named constant, a structure component, or a subobject of any of ! the preceding objects. A substring shall not have length zero. */ static void resolve_equivalence (gfc_equiv *eq) { gfc_symbol *sym; gfc_symbol *derived; gfc_expr *e; gfc_ref *r; ! for (; eq; eq = eq->eq) { e = eq->expr; --- 5621,5658 ---- /* Resolve equivalence object. ! An EQUIVALENCE object shall not be a dummy argument, a pointer, a target, ! an allocatable array, an object of nonsequence derived type, an object of sequence derived type containing a pointer at any level of component selection, an automatic object, a function name, an entry name, a result name, a named constant, a structure component, or a subobject of any of ! the preceding objects. A substring shall not have length zero. A ! derived type shall not have components with default initialization nor ! shall two objects of an equivalence group be initialized. ! The simple constraints are done in symbol.c(check_conflict) and the rest ! are implemented here. */ static void resolve_equivalence (gfc_equiv *eq) { gfc_symbol *sym; gfc_symbol *derived; + gfc_symbol *first_sym; gfc_expr *e; gfc_ref *r; + locus *last_where = NULL; + seq_type eq_type, last_eq_type; + gfc_typespec *last_ts; + int object; + const char *value_name; + const char *msg; ! value_name = NULL; ! last_ts = &eq->expr->symtree->n.sym->ts; ! ! first_sym = eq->expr->symtree->n.sym; ! ! for (object = 1; eq; eq = eq->eq, object++) { e = eq->expr; *************** resolve_equivalence (gfc_equiv *eq) *** 4871,4910 **** continue; sym = e->symtree->n.sym; - - /* Shall not be a dummy argument. */ - if (sym->attr.dummy) - { - gfc_error ("Dummy argument '%s' at %L cannot be an EQUIVALENCE " - "object", sym->name, &e->where); - continue; - } ! /* Shall not be an allocatable array. */ ! if (sym->attr.allocatable) ! { ! gfc_error ("Allocatable array '%s' at %L cannot be an EQUIVALENCE " ! "object", sym->name, &e->where); ! continue; ! } ! /* Shall not be a pointer. */ ! if (sym->attr.pointer) ! { ! gfc_error ("Pointer '%s' at %L cannot be an EQUIVALENCE object", ! sym->name, &e->where); ! continue; ! } ! ! /* Shall not be a function name, ... */ ! if (sym->attr.function || sym->attr.result || sym->attr.entry ! || sym->attr.subroutine) { ! gfc_error ("Entity '%s' at %L cannot be an EQUIVALENCE object", ! sym->name, &e->where); ! continue; } ! /* Shall not be a named constant. */ if (e->expr_type == EXPR_CONSTANT) { --- 5722,5754 ---- continue; sym = e->symtree->n.sym; ! /* An equivalence statement cannot have more than one initialized ! object. */ ! if (sym->value) ! { ! if (value_name != NULL) ! { ! gfc_error ("Initialized objects '%s' and '%s' cannot both " ! "be in the EQUIVALENCE statement at %L", ! value_name, sym->name, &e->where); ! continue; ! } ! else ! value_name = sym->name; ! } ! /* Shall not equivalence common block variables in a PURE procedure. */ ! if (sym->ns->proc_name ! && sym->ns->proc_name->attr.pure ! && sym->attr.in_common) { ! gfc_error ("Common block member '%s' at %L cannot be an EQUIVALENCE " ! "object in the pure procedure '%s'", ! sym->name, &e->where, sym->ns->proc_name->name); ! break; } ! /* Shall not be a named constant. */ if (e->expr_type == EXPR_CONSTANT) { *************** resolve_equivalence (gfc_equiv *eq) *** 4917,4922 **** --- 5761,5829 ---- if (derived && resolve_equivalence_derived (derived, sym, e) == FAILURE) continue; + /* Check that the types correspond correctly: + Note 5.28: + A numeric sequence structure may be equivalenced to another sequence + structure, an object of default integer type, default real type, double + precision real type, default logical type such that components of the + structure ultimately only become associated to objects of the same + kind. A character sequence structure may be equivalenced to an object + of default character kind or another character sequence structure. + Other objects may be equivalenced only to objects of the same type and + kind parameters. */ + + /* Identical types are unconditionally OK. */ + if (object == 1 || gfc_compare_types (last_ts, &sym->ts)) + goto identical_types; + + last_eq_type = sequence_type (*last_ts); + eq_type = sequence_type (sym->ts); + + /* Since the pair of objects is not of the same type, mixed or + non-default sequences can be rejected. */ + + msg = "Sequence %s with mixed components in EQUIVALENCE " + "statement at %L with different type objects"; + if ((object ==2 + && last_eq_type == SEQ_MIXED + && gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, + last_where) == FAILURE) + || (eq_type == SEQ_MIXED + && gfc_notify_std (GFC_STD_GNU, msg,sym->name, + &e->where) == FAILURE)) + continue; + + msg = "Non-default type object or sequence %s in EQUIVALENCE " + "statement at %L with objects of different type"; + if ((object ==2 + && last_eq_type == SEQ_NONDEFAULT + && gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, + last_where) == FAILURE) + || (eq_type == SEQ_NONDEFAULT + && gfc_notify_std (GFC_STD_GNU, msg, sym->name, + &e->where) == FAILURE)) + continue; + + msg ="Non-CHARACTER object '%s' in default CHARACTER " + "EQUIVALENCE statement at %L"; + if (last_eq_type == SEQ_CHARACTER + && eq_type != SEQ_CHARACTER + && gfc_notify_std (GFC_STD_GNU, msg, sym->name, + &e->where) == FAILURE) + continue; + + msg ="Non-NUMERIC object '%s' in default NUMERIC " + "EQUIVALENCE statement at %L"; + if (last_eq_type == SEQ_NUMERIC + && eq_type != SEQ_NUMERIC + && gfc_notify_std (GFC_STD_GNU, msg, sym->name, + &e->where) == FAILURE) + continue; + + identical_types: + last_ts =&sym->ts; + last_where = &e->where; + if (!e->ref) continue; *************** resolve_fntype (gfc_namespace * ns) *** 4984,4989 **** --- 5891,5905 ---- sym->attr.untyped = 1; } + if (sym->ts.type == BT_DERIVED && !sym->ts.derived->attr.use_assoc + && !gfc_check_access (sym->ts.derived->attr.access, + sym->ts.derived->ns->default_access) + && gfc_check_access (sym->attr.access, sym->ns->default_access)) + { + gfc_error ("PUBLIC function '%s' at %L cannot be of PRIVATE type '%s'", + sym->name, &sym->declared_at, sym->ts.derived->name); + } + if (ns->entries) for (el = ns->entries->next; el; el = el->next) { *************** gfc_resolve (gfc_namespace * ns) *** 5039,5058 **** gfc_check_interfaces (ns); for (cl = ns->cl_list; cl; cl = cl->next) ! { ! if (cl->length == NULL || gfc_resolve_expr (cl->length) == FAILURE) ! continue; ! ! if (gfc_simplify_expr (cl->length, 0) == FAILURE) ! continue; ! ! if (gfc_specification_expr (cl->length) == FAILURE) ! continue; ! } gfc_traverse_ns (ns, resolve_values); ! if (!gfc_option.flag_automatic || ns->save_all) gfc_save_all (ns); iter_stack = NULL; --- 5955,5965 ---- gfc_check_interfaces (ns); for (cl = ns->cl_list; cl; cl = cl->next) ! resolve_charlen (cl); gfc_traverse_ns (ns, resolve_values); ! if (ns->save_all) gfc_save_all (ns); iter_stack = NULL; diff -Nrcpad gcc-4.0.2/gcc/fortran/scanner.c gcc-4.1.0/gcc/fortran/scanner.c *** gcc-4.0.2/gcc/fortran/scanner.c Fri Aug 19 15:50:43 2005 --- gcc-4.1.0/gcc/fortran/scanner.c Fri Jan 27 20:03:59 2006 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Set of subroutines to (ultimately) return the next character to the various matching subroutines. This file's job is to read files and --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Set of subroutines to (ultimately) return the next character to the various matching subroutines. This file's job is to read files and *************** Software Foundation, 59 Temple Place - S *** 45,50 **** --- 45,51 ---- #include "config.h" #include "system.h" #include "gfortran.h" + #include "toplev.h" /* Structure for holding module and include file search path. */ typedef struct gfc_directorylist *************** gfc_source_form gfc_current_form; *** 65,72 **** static gfc_linebuf *line_head, *line_tail; locus gfc_current_locus; ! char *gfc_source_file; ! /* Main scanner initialization. */ --- 66,75 ---- static gfc_linebuf *line_head, *line_tail; locus gfc_current_locus; ! const char *gfc_source_file; ! static FILE *gfc_src_file; ! static char *gfc_src_preprocessor_lines[2]; ! /* Main scanner initialization. */ *************** gfc_release_include_path (void) *** 159,176 **** } /* Opens file for reading, searching through the include directories ! given if necessary. */ FILE * ! gfc_open_included_file (const char *name) { char *fullname; gfc_directorylist *p; FILE *f; ! f = gfc_open_file (name); ! if (f != NULL) ! return f; for (p = include_dirs; p; p = p->next) { --- 162,183 ---- } /* Opens file for reading, searching through the include directories ! given if necessary. If the include_cwd argument is true, we try ! to open the file in the current directory first. */ FILE * ! gfc_open_included_file (const char *name, const bool include_cwd) { char *fullname; gfc_directorylist *p; FILE *f; ! if (include_cwd) ! { ! f = gfc_open_file (name); ! if (f != NULL) ! return f; ! } for (p = include_dirs; p; p = p->next) { *************** skip_free_comments (void) *** 355,361 **** /* Skip comment lines in fixed source mode. We have the same rules as in skip_free_comment(), except that we can have a 'c', 'C' or '*' ! in column 1, and a '!' cannot be in column 6. */ static void skip_fixed_comments (void) --- 362,369 ---- /* Skip comment lines in fixed source mode. We have the same rules as in skip_free_comment(), except that we can have a 'c', 'C' or '*' ! in column 1, and a '!' cannot be in column 6. Also, we deal with ! lines with 'd' or 'D' in column 1, if the user requested this. */ static void skip_fixed_comments (void) *************** skip_fixed_comments (void) *** 383,395 **** continue; } col = 1; ! do { c = next_char (); col++; } - while (gfc_is_whitespace (c)); if (c == '\n') { --- 391,414 ---- continue; } + if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D')) + { + if (gfc_option.flag_d_lines == 0) + { + skip_comment_line (); + continue; + } + else + *start.nextc = c = ' '; + } + col = 1; ! ! while (gfc_is_whitespace (c)) { c = next_char (); col++; } if (c == '\n') { *************** gfc_gobble_whitespace (void) *** 678,684 **** In fixed mode, we expand a tab that occurs within the statement label region to expand to spaces that leave the next character in the source region. ! load_line returns wether the line was truncated. */ static int load_line (FILE * input, char **pbuf, int *pbuflen) --- 697,703 ---- In fixed mode, we expand a tab that occurs within the statement label region to expand to spaces that leave the next character in the source region. ! load_line returns whether the line was truncated. */ static int load_line (FILE * input, char **pbuf, int *pbuflen) *************** load_line (FILE * input, char **pbuf, in *** 687,697 **** int trunc_flag = 0; char *buffer; ! /* Determine the maximum allowed line length. */ if (gfc_current_form == FORM_FREE) ! maxlen = GFC_MAX_LINE; else ! maxlen = gfc_option.fixed_line_length; if (*pbuf == NULL) { --- 706,730 ---- int trunc_flag = 0; char *buffer; ! /* Determine the maximum allowed line length. ! The default for free-form is GFC_MAX_LINE, for fixed-form or for ! unknown form it is 72. Refer to the documentation in gfc_option_t. */ if (gfc_current_form == FORM_FREE) ! { ! if (gfc_option.free_line_length == -1) ! maxlen = GFC_MAX_LINE; ! else ! maxlen = gfc_option.free_line_length; ! } ! else if (gfc_current_form == FORM_FIXED) ! { ! if (gfc_option.fixed_line_length == -1) ! maxlen = 72; ! else ! maxlen = gfc_option.fixed_line_length; ! } else ! maxlen = 72; if (*pbuf == NULL) { *************** load_line (FILE * input, char **pbuf, in *** 762,768 **** } } else if (i >= maxlen) ! { /* Truncate the rest of the line. */ for (;;) { --- 795,801 ---- } } else if (i >= maxlen) ! { /* Truncate the rest of the line. */ for (;;) { *************** load_line (FILE * input, char **pbuf, in *** 779,789 **** /* Pad lines to the selected line length in fixed form. */ if (gfc_current_form == FORM_FIXED ! && gfc_option.fixed_line_length > 0 && !preprocessor_flag && c != EOF) ! while (i++ < gfc_option.fixed_line_length) ! *buffer++ = ' '; *buffer = '\0'; *pbuflen = buflen; --- 812,824 ---- /* Pad lines to the selected line length in fixed form. */ if (gfc_current_form == FORM_FIXED ! && gfc_option.fixed_line_length != 0 && !preprocessor_flag && c != EOF) ! { ! while (i++ < maxlen) ! *buffer++ = ' '; ! } *buffer = '\0'; *pbuflen = buflen; *************** load_line (FILE * input, char **pbuf, in *** 796,802 **** the file stack. */ static gfc_file * ! get_file (char *name, enum lc_reason reason ATTRIBUTE_UNUSED) { gfc_file *f; --- 831,837 ---- the file stack. */ static gfc_file * ! get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED) { gfc_file *f; *************** preprocessor_line (char *c) *** 829,835 **** int i, line; char *filename; gfc_file *f; ! int escaped; c++; while (*c == ' ' || *c == '\t') --- 864,870 ---- int i, line; char *filename; gfc_file *f; ! int escaped, unescape; c++; while (*c == ' ' || *c == '\t') *************** preprocessor_line (char *c) *** 860,872 **** filename = c; /* Make filename end at quote. */ escaped = false; while (*c && ! (! escaped && *c == '"')) { if (escaped) escaped = false; ! else ! escaped = *c == '\\'; ++c; } --- 895,911 ---- filename = c; /* Make filename end at quote. */ + unescape = 0; escaped = false; while (*c && ! (! escaped && *c == '"')) { if (escaped) escaped = false; ! else if (*c == '\\') ! { ! escaped = true; ! unescape++; ! } ++c; } *************** preprocessor_line (char *c) *** 876,882 **** --- 915,937 ---- *c++ = '\0'; + /* Undo effects of cpp_quote_string. */ + if (unescape) + { + char *s = filename; + char *d = gfc_getmem (c - filename - unescape); + filename = d; + while (*s) + { + if (*s == '\\') + *d++ = *++s; + else + *d++ = *s; + s++; + } + *d = '\0'; + } /* Get flags. */ *************** preprocessor_line (char *c) *** 912,917 **** --- 967,974 ---- gfc_warning_now ("%s:%d: file %s left but not entered", current_file->filename, current_file->line, filename); + if (unescape) + gfc_free (filename); return; } current_file = current_file->up; *************** preprocessor_line (char *c) *** 929,934 **** --- 986,993 ---- /* Set new line number. */ current_file->line = line; + if (unescape) + gfc_free (filename); return; bad_cpp_line: *************** preprocessor_line (char *c) *** 938,944 **** } ! static try load_file (char *, bool); /* include_line()-- Checks a line buffer to see if it is an include line. If so, we call load_file() recursively to load the included --- 997,1003 ---- } ! static try load_file (const char *, bool); /* include_line()-- Checks a line buffer to see if it is an include line. If so, we call load_file() recursively to load the included *************** include_line (char *line) *** 996,1002 **** /* Load a file into memory by calling load_line until the file ends. */ static try ! load_file (char *filename, bool initial) { char *line; gfc_linebuf *b; --- 1055,1061 ---- /* Load a file into memory by calling load_line until the file ends. */ static try ! load_file (const char *filename, bool initial) { char *line; gfc_linebuf *b; *************** load_file (char *filename, bool initial) *** 1013,1019 **** if (initial) { ! input = gfc_open_file (filename); if (input == NULL) { gfc_error_now ("Can't open file '%s'", filename); --- 1072,1084 ---- if (initial) { ! if (gfc_src_file) ! { ! input = gfc_src_file; ! gfc_src_file = NULL; ! } ! else ! input = gfc_open_file (filename); if (input == NULL) { gfc_error_now ("Can't open file '%s'", filename); *************** load_file (char *filename, bool initial) *** 1022,1028 **** } else { ! input = gfc_open_included_file (filename); if (input == NULL) { gfc_error_now ("Can't open included file '%s'", filename); --- 1087,1093 ---- } else { ! input = gfc_open_included_file (filename, false); if (input == NULL) { gfc_error_now ("Can't open included file '%s'", filename); *************** load_file (char *filename, bool initial) *** 1039,1045 **** line = NULL; line_len = 0; ! for (;;) { int trunc = load_line (input, &line, &line_len); --- 1104,1123 ---- line = NULL; line_len = 0; ! if (initial && gfc_src_preprocessor_lines[0]) ! { ! preprocessor_line (gfc_src_preprocessor_lines[0]); ! gfc_free (gfc_src_preprocessor_lines[0]); ! gfc_src_preprocessor_lines[0] = NULL; ! if (gfc_src_preprocessor_lines[1]) ! { ! preprocessor_line (gfc_src_preprocessor_lines[1]); ! gfc_free (gfc_src_preprocessor_lines[1]); ! gfc_src_preprocessor_lines[1] = NULL; ! } ! } ! ! for (;;) { int trunc = load_line (input, &line, &line_len); *************** load_file (char *filename, bool initial) *** 1097,1204 **** } - /* Determine the source form from the filename extension. We assume - case insensitivity. */ - - static gfc_source_form - form_from_filename (const char *filename) - { - - static const struct - { - const char *extension; - gfc_source_form form; - } - exttype[] = - { - { - ".f90", FORM_FREE} - , - { - ".f95", FORM_FREE} - , - { - ".f", FORM_FIXED} - , - { - ".for", FORM_FIXED} - , - { - "", FORM_UNKNOWN} - }; /* sentinel value */ - - gfc_source_form f_form; - const char *fileext; - int i; - - /* Find end of file name. Note, filename is either a NULL pointer or - a NUL terminated string. */ - i = 0; - while (filename[i] != '\0') - i++; - - /* Find last period. */ - while (i >= 0 && (filename[i] != '.')) - i--; - - /* Did we see a file extension? */ - if (i < 0) - return FORM_UNKNOWN; /* Nope */ - - /* Get file extension and compare it to others. */ - fileext = &(filename[i]); - - i = -1; - f_form = FORM_UNKNOWN; - do - { - i++; - if (strcasecmp (fileext, exttype[i].extension) == 0) - { - f_form = exttype[i].form; - break; - } - } - while (exttype[i].form != FORM_UNKNOWN); - - return f_form; - } - - /* Open a new file and start scanning from that file. Returns SUCCESS if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN it tries to determine the source form from the filename, defaulting to free form. */ try ! gfc_new_file (const char *filename, gfc_source_form form) { try result; - if (filename != NULL) - { - gfc_source_file = gfc_getmem (strlen (filename) + 1); - strcpy (gfc_source_file, filename); - } - else - gfc_source_file = NULL; - - /* Decide which form the file will be read in as. */ - - if (form != FORM_UNKNOWN) - gfc_current_form = form; - else - { - gfc_current_form = form_from_filename (filename); - - if (gfc_current_form == FORM_UNKNOWN) - { - gfc_current_form = FORM_FREE; - gfc_warning_now ("Reading file '%s' as free form.", - (filename[0] == '\0') ? "" : filename); - } - } - result = load_file (gfc_source_file, true); gfc_current_locus.lb = line_head; --- 1175,1190 ---- } /* Open a new file and start scanning from that file. Returns SUCCESS if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN it tries to determine the source form from the filename, defaulting to free form. */ try ! gfc_new_file (void) { try result; result = load_file (gfc_source_file, true); gfc_current_locus.lb = line_head; *************** gfc_new_file (const char *filename, gfc_ *** 1219,1221 **** --- 1205,1316 ---- return result; } + + static char * + unescape_filename (const char *ptr) + { + const char *p = ptr, *s; + char *d, *ret; + int escaped, unescape = 0; + + /* Make filename end at quote. */ + escaped = false; + while (*p && ! (! escaped && *p == '"')) + { + if (escaped) + escaped = false; + else if (*p == '\\') + { + escaped = true; + unescape++; + } + ++p; + } + + if (! *p || p[1]) + return NULL; + + /* Undo effects of cpp_quote_string. */ + s = ptr; + d = gfc_getmem (p + 1 - ptr - unescape); + ret = d; + + while (s != p) + { + if (*s == '\\') + *d++ = *++s; + else + *d++ = *s; + s++; + } + *d = '\0'; + return ret; + } + + /* For preprocessed files, if the first tokens are of the form # NUM. + handle the directives so we know the original file name. */ + + const char * + gfc_read_orig_filename (const char *filename, const char **canon_source_file) + { + int c, len; + char *dirname; + + gfc_src_file = gfc_open_file (filename); + if (gfc_src_file == NULL) + return NULL; + + c = fgetc (gfc_src_file); + ungetc (c, gfc_src_file); + + if (c != '#') + return NULL; + + len = 0; + load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len); + + if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0) + return NULL; + + filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5); + if (filename == NULL) + return NULL; + + c = fgetc (gfc_src_file); + ungetc (c, gfc_src_file); + + if (c != '#') + return filename; + + len = 0; + load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len); + + if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0) + return filename; + + dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5); + if (dirname == NULL) + return filename; + + len = strlen (dirname); + if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/') + { + gfc_free (dirname); + return filename; + } + dirname[len - 2] = '\0'; + set_src_pwd (dirname); + + if (! IS_ABSOLUTE_PATH (filename)) + { + char *p = gfc_getmem (len + strlen (filename)); + + memcpy (p, dirname, len - 2); + p[len - 2] = '/'; + strcpy (p + len - 1, filename); + *canon_source_file = p; + } + + gfc_free (dirname); + return filename; + } diff -Nrcpad gcc-4.0.2/gcc/fortran/simplify.c gcc-4.1.0/gcc/fortran/simplify.c *** gcc-4.0.2/gcc/fortran/simplify.c Tue Jul 12 01:50:48 2005 --- gcc-4.1.0/gcc/fortran/simplify.c Fri Feb 10 20:09:41 2006 *************** *** 1,6 **** /* Simplify intrinsic functions at compile-time. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, ! Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. --- 1,6 ---- /* Simplify intrinsic functions at compile-time. ! Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software ! Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" #include "system.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" #include "system.h" *************** gfc_simplify_acos (gfc_expr * x) *** 263,268 **** --- 263,289 ---- return range_check (result, "ACOS"); } + gfc_expr * + gfc_simplify_acosh (gfc_expr * x) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + if (mpfr_cmp_si (x->value.real, 1) < 0) + { + gfc_error ("Argument of ACOSH at %L must not be less than 1", + &x->where); + return &gfc_bad_expr; + } + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + + mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ACOSH"); + } gfc_expr * gfc_simplify_adjustl (gfc_expr * e) *************** gfc_simplify_adjustr (gfc_expr * e) *** 351,356 **** --- 372,378 ---- gfc_expr * gfc_simplify_aimag (gfc_expr * e) { + gfc_expr *result; if (e->expr_type != EXPR_CONSTANT) *************** gfc_simplify_dint (gfc_expr * e) *** 409,417 **** gfc_expr * gfc_simplify_anint (gfc_expr * e, gfc_expr * k) { ! gfc_expr *rtrunc, *result; ! int kind, cmp; ! mpfr_t half; kind = get_kind (BT_REAL, k, "ANINT", e->ts.kind); if (kind == -1) --- 431,438 ---- gfc_expr * gfc_simplify_anint (gfc_expr * e, gfc_expr * k) { ! gfc_expr *result; ! int kind; kind = get_kind (BT_REAL, k, "ANINT", e->ts.kind); if (kind == -1) *************** gfc_simplify_anint (gfc_expr * e, gfc_ex *** 422,491 **** result = gfc_constant_result (e->ts.type, kind, &e->where); ! rtrunc = gfc_copy_expr (e); ! cmp = mpfr_cmp_ui (e->value.real, 0); - gfc_set_model_kind (kind); - mpfr_init (half); - mpfr_set_str (half, "0.5", 10, GFC_RND_MODE); ! if (cmp > 0) { ! mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE); ! mpfr_trunc (result->value.real, rtrunc->value.real); } ! else if (cmp < 0) { ! mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE); ! mpfr_trunc (result->value.real, rtrunc->value.real); } - else - mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); - - gfc_free_expr (rtrunc); - mpfr_clear (half); ! return range_check (result, "ANINT"); } gfc_expr * gfc_simplify_dnint (gfc_expr * e) { ! gfc_expr *rtrunc, *result; ! int cmp; ! mpfr_t half; if (e->expr_type != EXPR_CONSTANT) return NULL; ! result = ! gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where); ! ! rtrunc = gfc_copy_expr (e); ! ! cmp = mpfr_cmp_ui (e->value.real, 0); ! ! gfc_set_model_kind (gfc_default_double_kind); ! mpfr_init (half); ! mpfr_set_str (half, "0.5", 10, GFC_RND_MODE); ! ! if (cmp > 0) ! { ! mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE); ! mpfr_trunc (result->value.real, rtrunc->value.real); ! } ! else if (cmp < 0) ! { ! mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE); ! mpfr_trunc (result->value.real, rtrunc->value.real); ! } ! else ! mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); ! gfc_free_expr (rtrunc); ! mpfr_clear (half); return range_check (result, "DNINT"); } --- 443,490 ---- result = gfc_constant_result (e->ts.type, kind, &e->where); ! mpfr_round (result->value.real, e->value.real); ! return range_check (result, "ANINT"); ! } ! gfc_expr * ! gfc_simplify_and (gfc_expr * x, gfc_expr * y) ! { ! gfc_expr *result; ! int kind; ! ! if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) ! return NULL; ! ! kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; ! if (x->ts.type == BT_INTEGER) { ! result = gfc_constant_result (BT_INTEGER, kind, &x->where); ! mpz_and (result->value.integer, x->value.integer, y->value.integer); } ! else /* BT_LOGICAL */ { ! result = gfc_constant_result (BT_LOGICAL, kind, &x->where); ! result->value.logical = x->value.logical && y->value.logical; } ! return range_check (result, "AND"); } gfc_expr * gfc_simplify_dnint (gfc_expr * e) { ! gfc_expr *result; if (e->expr_type != EXPR_CONSTANT) return NULL; ! result = gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where); ! mpfr_round (result->value.real, e->value.real); return range_check (result, "DNINT"); } *************** gfc_simplify_asin (gfc_expr * x) *** 515,521 **** gfc_expr * ! gfc_simplify_atan (gfc_expr * x) { gfc_expr *result; --- 514,520 ---- gfc_expr * ! gfc_simplify_asinh (gfc_expr * x) { gfc_expr *result; *************** gfc_simplify_atan (gfc_expr * x) *** 524,533 **** --- 523,571 ---- result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_asinh(result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ASINH"); + } + + + gfc_expr * + gfc_simplify_atan (gfc_expr * x) + { + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_atan(result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "ATAN"); + } + + + gfc_expr * + gfc_simplify_atanh (gfc_expr * x) + { + gfc_expr *result; + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + if (mpfr_cmp_si (x->value.real, 1) >= 0 || + mpfr_cmp_si (x->value.real, -1) <= 0) + { + gfc_error ("Argument of ATANH at %L must be inside the range -1 to 1", + &x->where); + return &gfc_bad_expr; + } + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + + mpfr_atanh(result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ATANH"); } *************** gfc_simplify_atan2 (gfc_expr * y, gfc_ex *** 553,559 **** arctangent2 (y->value.real, x->value.real, result->value.real); return range_check (result, "ATAN2"); - } --- 591,596 ---- *************** gfc_simplify_char (gfc_expr * e, gfc_exp *** 625,631 **** if (e->expr_type != EXPR_CONSTANT) return NULL; ! if (gfc_extract_int (e, &c) != NULL || c < 0 || c > 255) { gfc_error ("Bad character in CHAR function at %L", &e->where); return &gfc_bad_expr; --- 662,668 ---- if (e->expr_type != EXPR_CONSTANT) return NULL; ! if (gfc_extract_int (e, &c) != NULL || c < 0 || c > UCHAR_MAX) { gfc_error ("Bad character in CHAR function at %L", &e->where); return &gfc_bad_expr; *************** gfc_simplify_cmplx (gfc_expr * x, gfc_ex *** 712,717 **** --- 749,782 ---- gfc_expr * + gfc_simplify_complex (gfc_expr * x, gfc_expr * y) + { + int kind; + + if (x->expr_type != EXPR_CONSTANT + || (y != NULL && y->expr_type != EXPR_CONSTANT)) + return NULL; + + if (x->ts.type == BT_INTEGER) + { + if (y->ts.type == BT_INTEGER) + kind = gfc_default_real_kind; + else + kind = y->ts.kind; + } + else + { + if (y->ts.type == BT_REAL) + kind = (x->ts.kind > y->ts.kind) ? x->ts.kind : y->ts.kind; + else + kind = x->ts.kind; + } + + return simplify_cmplx ("COMPLEX", x, y, kind); + } + + + gfc_expr * gfc_simplify_conjg (gfc_expr * e) { gfc_expr *result; *************** gfc_expr * *** 855,865 **** gfc_simplify_dim (gfc_expr * x, gfc_expr * y) { gfc_expr *result; if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; ! result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); switch (x->ts.type) { --- 920,932 ---- gfc_simplify_dim (gfc_expr * x, gfc_expr * y) { gfc_expr *result; + int kind; if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; ! kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; ! result = gfc_constant_result (x->ts.type, kind, &x->where); switch (x->ts.type) { *************** gfc_simplify_ibset (gfc_expr * x, gfc_ex *** 1281,1286 **** --- 1348,1356 ---- result = gfc_copy_expr (x); mpz_setbit (result->value.integer, pos); + + twos_complement (result->value.integer, gfc_integer_kinds[k].bit_size); + return range_check (result, "IBSET"); } *************** gfc_simplify_ichar (gfc_expr * e) *** 1300,1308 **** return &gfc_bad_expr; } ! index = (int) e->value.character.string[0]; ! if (index < CHAR_MIN || index > CHAR_MAX) { gfc_error ("Argument of ICHAR at %L out of range of this processor", &e->where); --- 1370,1378 ---- return &gfc_bad_expr; } ! index = (unsigned char) e->value.character.string[0]; ! if (index < 0 || index > UCHAR_MAX) { gfc_error ("Argument of ICHAR at %L out of range of this processor", &e->where); *************** simplify_bound (gfc_expr * array, gfc_ex *** 1823,1829 **** continue; } } ! gcc_unreachable (); done: --- 1893,1899 ---- continue; } } ! gcc_unreachable (); done: *************** gfc_simplify_mod (gfc_expr * a, gfc_expr *** 2185,2195 **** { gfc_expr *result; mpfr_t quot, iquot, term; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) return NULL; ! result = gfc_constant_result (a->ts.type, a->ts.kind, &a->where); switch (a->ts.type) { --- 2255,2267 ---- { gfc_expr *result; mpfr_t quot, iquot, term; + int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) return NULL; ! kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; ! result = gfc_constant_result (a->ts.type, kind, &a->where); switch (a->ts.type) { *************** gfc_simplify_mod (gfc_expr * a, gfc_expr *** 2213,2219 **** return &gfc_bad_expr; } ! gfc_set_model_kind (a->ts.kind); mpfr_init (quot); mpfr_init (iquot); mpfr_init (term); --- 2285,2291 ---- return &gfc_bad_expr; } ! gfc_set_model_kind (kind); mpfr_init (quot); mpfr_init (iquot); mpfr_init (term); *************** gfc_simplify_modulo (gfc_expr * a, gfc_e *** 2241,2251 **** { gfc_expr *result; mpfr_t quot, iquot, term; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) return NULL; ! result = gfc_constant_result (a->ts.type, a->ts.kind, &a->where); switch (a->ts.type) { --- 2313,2325 ---- { gfc_expr *result; mpfr_t quot, iquot, term; + int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) return NULL; ! kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; ! result = gfc_constant_result (a->ts.type, kind, &a->where); switch (a->ts.type) { *************** gfc_simplify_modulo (gfc_expr * a, gfc_e *** 2271,2277 **** return &gfc_bad_expr; } ! gfc_set_model_kind (a->ts.kind); mpfr_init (quot); mpfr_init (iquot); mpfr_init (term); --- 2345,2351 ---- return &gfc_bad_expr; } ! gfc_set_model_kind (kind); mpfr_init (quot); mpfr_init (iquot); mpfr_init (term); *************** gfc_expr * *** 2310,2373 **** gfc_simplify_nearest (gfc_expr * x, gfc_expr * s) { gfc_expr *result; ! float rval; ! double val, eps; ! int p, i, k, match_float; ! ! /* FIXME: This implementation is dopey and probably not quite right, ! but it's a start. */ ! if (x->expr_type != EXPR_CONSTANT) return NULL; ! k = gfc_validate_kind (x->ts.type, x->ts.kind, false); ! ! result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); ! val = mpfr_get_d (x->value.real, GFC_RND_MODE); ! p = gfc_real_kinds[k].digits; ! eps = 1.; ! for (i = 1; i < p; ++i) { ! eps = eps / 2.; } ! /* TODO we should make sure that 'float' matches kind 4 */ ! match_float = gfc_real_kinds[k].kind == 4; ! if (mpfr_cmp_ui (s->value.real, 0) > 0) { ! if (match_float) ! { ! rval = (float) val; ! rval = rval + eps; ! mpfr_set_d (result->value.real, rval, GFC_RND_MODE); ! } else ! { ! val = val + eps; ! mpfr_set_d (result->value.real, val, GFC_RND_MODE); ! } } ! else if (mpfr_cmp_ui (s->value.real, 0) < 0) { ! if (match_float) { ! rval = (float) val; ! rval = rval - eps; ! mpfr_set_d (result->value.real, rval, GFC_RND_MODE); } else { ! val = val - eps; ! mpfr_set_d (result->value.real, val, GFC_RND_MODE); } ! } ! else ! { ! gfc_error ("Invalid second argument of NEAREST at %L", &s->where); ! gfc_free (result); ! return &gfc_bad_expr; } return range_check (result, "NEAREST"); --- 2384,2454 ---- gfc_simplify_nearest (gfc_expr * x, gfc_expr * s) { gfc_expr *result; ! mpfr_t tmp; ! int direction, sgn; ! if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT) return NULL; ! gfc_set_model_kind (x->ts.kind); ! result = gfc_copy_expr (x); ! direction = mpfr_sgn (s->value.real); ! if (direction == 0) { ! gfc_error ("Second argument of NEAREST at %L may not be zero", ! &s->where); ! gfc_free (result); ! return &gfc_bad_expr; } ! /* TODO: Use mpfr_nextabove and mpfr_nextbelow once we move to a ! newer version of mpfr. */ ! ! sgn = mpfr_sgn (x->value.real); ! ! if (sgn == 0) { ! int k = gfc_validate_kind (BT_REAL, x->ts.kind, 0); ! ! if (direction > 0) ! mpfr_add (result->value.real, ! x->value.real, gfc_real_kinds[k].subnormal, GFC_RND_MODE); else ! mpfr_sub (result->value.real, ! x->value.real, gfc_real_kinds[k].subnormal, GFC_RND_MODE); } ! else { ! if (sgn < 0) { ! direction = -direction; ! mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE); } + + if (direction > 0) + mpfr_add_one_ulp (result->value.real, GFC_RND_MODE); else { ! /* In this case the exponent can shrink, which makes us skip ! over one number because we subtract one ulp with the ! larger exponent. Thus we need to compensate for this. */ ! mpfr_init_set (tmp, result->value.real, GFC_RND_MODE); ! ! mpfr_sub_one_ulp (result->value.real, GFC_RND_MODE); ! mpfr_add_one_ulp (result->value.real, GFC_RND_MODE); ! ! /* If we're back to where we started, the spacing is one ! ulp, and we get the correct result by subtracting. */ ! if (mpfr_cmp (tmp, result->value.real) == 0) ! mpfr_sub_one_ulp (result->value.real, GFC_RND_MODE); ! ! mpfr_clear (tmp); } ! ! if (sgn < 0) ! mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE); } return range_check (result, "NEAREST"); *************** gfc_simplify_nearest (gfc_expr * x, gfc_ *** 2377,2385 **** static gfc_expr * simplify_nint (const char *name, gfc_expr * e, gfc_expr * k) { ! gfc_expr *rtrunc, *itrunc, *result; ! int kind, cmp; ! mpfr_t half; kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind); if (kind == -1) --- 2458,2465 ---- static gfc_expr * simplify_nint (const char *name, gfc_expr * e, gfc_expr * k) { ! gfc_expr *itrunc, *result; ! int kind; kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind); if (kind == -1) *************** simplify_nint (const char *name, gfc_exp *** 2390,2422 **** result = gfc_constant_result (BT_INTEGER, kind, &e->where); - rtrunc = gfc_copy_expr (e); itrunc = gfc_copy_expr (e); ! cmp = mpfr_cmp_ui (e->value.real, 0); ! ! gfc_set_model (e->value.real); ! mpfr_init (half); ! mpfr_set_str (half, "0.5", 10, GFC_RND_MODE); ! ! if (cmp > 0) ! { ! mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE); ! mpfr_trunc (itrunc->value.real, rtrunc->value.real); ! } ! else if (cmp < 0) ! { ! mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE); ! mpfr_trunc (itrunc->value.real, rtrunc->value.real); ! } ! else ! mpfr_set_ui (itrunc->value.real, 0, GFC_RND_MODE); gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real); gfc_free_expr (itrunc); - gfc_free_expr (rtrunc); - mpfr_clear (half); return range_check (result, name); } --- 2470,2482 ---- result = gfc_constant_result (BT_INTEGER, kind, &e->where); itrunc = gfc_copy_expr (e); ! mpfr_round(itrunc->value.real, e->value.real); gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real); gfc_free_expr (itrunc); return range_check (result, name); } *************** gfc_simplify_not (gfc_expr * e) *** 2457,2462 **** --- 2517,2524 ---- mpz_and (result->value.integer, result->value.integer, gfc_integer_kinds[i].max_int); + twos_complement (result->value.integer, gfc_integer_kinds[i].bit_size); + return range_check (result, "NOT"); } *************** gfc_simplify_null (gfc_expr * mold) *** 2466,2487 **** { gfc_expr *result; - result = gfc_get_expr (); - result->expr_type = EXPR_NULL; - if (mold == NULL) - result->ts.type = BT_UNKNOWN; - else { ! result->ts = mold->ts; ! result->where = mold->where; } return result; } gfc_expr * gfc_simplify_precision (gfc_expr * e) { gfc_expr *result; --- 2528,2572 ---- { gfc_expr *result; if (mold == NULL) { ! result = gfc_get_expr (); ! result->ts.type = BT_UNKNOWN; } + else + result = gfc_copy_expr (mold); + result->expr_type = EXPR_NULL; return result; } gfc_expr * + gfc_simplify_or (gfc_expr * x, gfc_expr * y) + { + gfc_expr *result; + int kind; + + if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) + return NULL; + + kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; + if (x->ts.type == BT_INTEGER) + { + result = gfc_constant_result (BT_INTEGER, kind, &x->where); + mpz_ior (result->value.integer, x->value.integer, y->value.integer); + } + else /* BT_LOGICAL */ + { + result = gfc_constant_result (BT_LOGICAL, kind, &x->where); + result->value.logical = x->value.logical || y->value.logical; + } + + return range_check (result, "OR"); + } + + + gfc_expr * gfc_simplify_precision (gfc_expr * e) { gfc_expr *result; *************** gfc_simplify_real (gfc_expr * e, gfc_exp *** 2594,2599 **** --- 2679,2699 ---- return range_check (result, "REAL"); } + + gfc_expr * + gfc_simplify_realpart (gfc_expr * e) + { + gfc_expr *result; + + if (e->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); + mpfr_set (result->value.real, e->value.complex.r, GFC_RND_MODE); + + return range_check (result, "REALPART"); + } + gfc_expr * gfc_simplify_repeat (gfc_expr * e, gfc_expr * n) { *************** inc: *** 2861,2867 **** for (i = 0; i < rank; i++) mpz_init_set_ui (e->shape[i], shape[i]); ! e->ts = head->expr->ts; e->rank = rank; return e; --- 2961,2967 ---- for (i = 0; i < rank; i++) mpz_init_set_ui (e->shape[i], shape[i]); ! e->ts = source->ts; e->rank = rank; return e; *************** gfc_simplify_verify (gfc_expr * s, gfc_e *** 3693,3698 **** --- 3793,3826 ---- return result; } + + gfc_expr * + gfc_simplify_xor (gfc_expr * x, gfc_expr * y) + { + gfc_expr *result; + int kind; + + if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) + return NULL; + + kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; + if (x->ts.type == BT_INTEGER) + { + result = gfc_constant_result (BT_INTEGER, kind, &x->where); + mpz_xor (result->value.integer, x->value.integer, y->value.integer); + } + else /* BT_LOGICAL */ + { + result = gfc_constant_result (BT_LOGICAL, kind, &x->where); + result->value.logical = (x->value.logical && ! y->value.logical) + || (! x->value.logical && y->value.logical); + } + + return range_check (result, "XOR"); + } + + + /****************** Constant simplification *****************/ /* Master function to convert one constant to another. While this is diff -Nrcpad gcc-4.0.2/gcc/fortran/st.c gcc-4.1.0/gcc/fortran/st.c *** gcc-4.0.2/gcc/fortran/st.c Wed Feb 23 15:14:46 2005 --- gcc-4.1.0/gcc/fortran/st.c Sun Aug 7 22:56:19 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Executable statements are strung together into a singly linked list of code structures. These structures are later translated into GCC --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Executable statements are strung together into a singly linked list of code structures. These structures are later translated into GCC *************** gfc_free_statement (gfc_code * p) *** 139,144 **** --- 139,145 ---- case EXEC_BACKSPACE: case EXEC_ENDFILE: case EXEC_REWIND: + case EXEC_FLUSH: gfc_free_filepos (p->ext.filepos); break; diff -Nrcpad gcc-4.0.2/gcc/fortran/symbol.c gcc-4.1.0/gcc/fortran/symbol.c *** gcc-4.0.2/gcc/fortran/symbol.c Wed Sep 7 21:19:13 2005 --- gcc-4.1.0/gcc/fortran/symbol.c Fri Feb 10 23:20:10 2006 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** gfc_set_implicit_none (void) *** 106,111 **** --- 106,119 ---- { int i; + if (gfc_current_ns->seen_implicit_none) + { + gfc_error ("Duplicate IMPLICIT NONE statement at %C"); + return; + } + + gfc_current_ns->seen_implicit_none = 1; + for (i = 0; i < GFC_LETTERS; i++) { gfc_clear_ts (&gfc_current_ns->default_type[i]); *************** gfc_merge_new_implicit (gfc_typespec * t *** 160,165 **** --- 168,179 ---- { int i; + if (gfc_current_ns->seen_implicit_none) + { + gfc_error ("Cannot specify IMPLICIT at %C after IMPLICIT NONE"); + return FAILURE; + } + for (i = 0; i < GFC_LETTERS; i++) { if (new_flag[i]) *************** check_conflict (symbol_attribute * attr, *** 248,254 **** *in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST", *public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY", *function = "FUNCTION", *subroutine = "SUBROUTINE", ! *dimension = "DIMENSION"; const char *a1, *a2; --- 262,270 ---- *in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST", *public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY", *function = "FUNCTION", *subroutine = "SUBROUTINE", ! *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE", ! *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER", ! *cray_pointee = "CRAY POINTEE", *data = "DATA"; const char *a1, *a2; *************** check_conflict (symbol_attribute * attr, *** 267,272 **** --- 283,290 ---- { a1 = NULL; + if (attr->in_namelist) + a1 = in_namelist; if (attr->allocatable) a1 = allocatable; if (attr->external) *************** check_conflict (symbol_attribute * attr, *** 293,303 **** --- 311,330 ---- conf (pointer, target); conf (pointer, external); conf (pointer, intrinsic); + conf (pointer, elemental); + conf (target, external); conf (target, intrinsic); conf (external, dimension); /* See Fortran 95's R504. */ conf (external, intrinsic); + + if (attr->if_source || attr->contained) + { + conf (external, subroutine); + conf (external, function); + } + conf (allocatable, pointer); conf (allocatable, dummy); /* TODO: Allowed in Fortran 200x. */ conf (allocatable, function); /* TODO: Allowed in Fortran 200x. */ *************** check_conflict (symbol_attribute * attr, *** 307,314 **** --- 334,353 ---- conf (in_common, dummy); conf (in_common, allocatable); conf (in_common, result); + conf (in_common, save); + conf (result, save); + conf (dummy, result); + conf (in_equivalence, use_assoc); + conf (in_equivalence, dummy); + conf (in_equivalence, target); + conf (in_equivalence, pointer); + conf (in_equivalence, function); + conf (in_equivalence, result); + conf (in_equivalence, entry); + conf (in_equivalence, allocatable); + conf (in_namelist, pointer); conf (in_namelist, allocatable); *************** check_conflict (symbol_attribute * attr, *** 316,321 **** --- 355,393 ---- conf (function, subroutine); + /* Cray pointer/pointee conflicts. */ + conf (cray_pointer, cray_pointee); + conf (cray_pointer, dimension); + conf (cray_pointer, pointer); + conf (cray_pointer, target); + conf (cray_pointer, allocatable); + conf (cray_pointer, external); + conf (cray_pointer, intrinsic); + conf (cray_pointer, in_namelist); + conf (cray_pointer, function); + conf (cray_pointer, subroutine); + conf (cray_pointer, entry); + + conf (cray_pointee, allocatable); + conf (cray_pointee, intent); + conf (cray_pointee, optional); + conf (cray_pointee, dummy); + conf (cray_pointee, target); + conf (cray_pointee, external); + conf (cray_pointee, intrinsic); + conf (cray_pointee, pointer); + conf (cray_pointee, function); + conf (cray_pointee, subroutine); + conf (cray_pointee, entry); + conf (cray_pointee, in_common); + conf (cray_pointee, in_equivalence); + + conf (data, dummy); + conf (data, function); + conf (data, result); + conf (data, allocatable); + conf (data, use_assoc); + a1 = gfc_code2string (flavors, attr->flavor); if (attr->in_namelist *************** duplicate_attr (const char *attr, locus *** 520,525 **** --- 592,609 ---- gfc_error ("Duplicate %s attribute specified at %L", attr, where); } + /* Called from decl.c (attr_decl1) to check attributes, when declared separately. */ + + try + gfc_add_attribute (symbol_attribute * attr, locus * where, uint attr_intent) + { + + if (check_used (attr, NULL, where) + || (attr_intent == 0 && check_done (attr, where))) + return FAILURE; + + return check_conflict (attr, NULL, where); + } try gfc_add_allocatable (symbol_attribute * attr, locus * where) *************** gfc_add_pointer (symbol_attribute * attr *** 626,631 **** --- 710,746 ---- try + gfc_add_cray_pointer (symbol_attribute * attr, locus * where) + { + + if (check_used (attr, NULL, where) || check_done (attr, where)) + return FAILURE; + + attr->cray_pointer = 1; + return check_conflict (attr, NULL, where); + } + + + try + gfc_add_cray_pointee (symbol_attribute * attr, locus * where) + { + + if (check_used (attr, NULL, where) || check_done (attr, where)) + return FAILURE; + + if (attr->cray_pointee) + { + gfc_error ("Cray Pointee at %L appears in multiple pointer()" + " statements.", where); + return FAILURE; + } + + attr->cray_pointee = 1; + return check_conflict (attr, NULL, where); + } + + + try gfc_add_result (symbol_attribute * attr, const char *name, locus * where) { *************** gfc_add_save (symbol_attribute * attr, c *** 654,661 **** if (attr->save) { ! duplicate_attr ("SAVE", where); ! return FAILURE; } attr->save = 1; --- 769,779 ---- if (attr->save) { ! if (gfc_notify_std (GFC_STD_LEGACY, ! "Duplicate SAVE attribute specified at %L", ! where) ! == FAILURE) ! return FAILURE; } attr->save = 1; *************** gfc_add_in_common (symbol_attribute * at *** 712,717 **** --- 830,850 ---- return gfc_add_flavor (attr, FL_VARIABLE, name, where); } + try + gfc_add_in_equivalence (symbol_attribute * attr, const char *name, locus * where) + { + + /* Duplicate attribute already checked for. */ + attr->in_equivalence = 1; + if (check_conflict (attr, name, where) == FAILURE) + return FAILURE; + + if (attr->flavor == FL_VARIABLE) + return SUCCESS; + + return gfc_add_flavor (attr, FL_VARIABLE, name, where); + } + try gfc_add_data (symbol_attribute *attr, const char *name, locus *where) *************** gfc_add_procedure (symbol_attribute * at *** 891,899 **** if (attr->proc != PROC_UNKNOWN) { ! gfc_error ("%s procedure at %L is already %s %s procedure", gfc_code2string (procedures, t), where, - gfc_article (gfc_code2string (procedures, attr->proc)), gfc_code2string (procedures, attr->proc)); return FAILURE; --- 1024,1031 ---- if (attr->proc != PROC_UNKNOWN) { ! gfc_error ("%s procedure at %L is already declared as %s procedure", gfc_code2string (procedures, t), where, gfc_code2string (procedures, attr->proc)); return FAILURE; *************** gfc_copy_attr (symbol_attribute * dest, *** 1105,1110 **** --- 1237,1247 ---- if (gfc_missing_attr (dest, where) == FAILURE) goto fail; + if (src->cray_pointer && gfc_add_cray_pointer (dest, where) == FAILURE) + goto fail; + if (src->cray_pointee && gfc_add_cray_pointee (dest, where) == FAILURE) + goto fail; + /* The subroutines that set these bits also cause flavors to be set, and that has already happened in the original, so don't let it happen again. */ *************** switch_types (gfc_symtree * st, gfc_symb *** 1208,1214 **** gfc_symbol * gfc_use_derived (gfc_symbol * sym) { ! gfc_symbol *s, *p; gfc_typespec *t; gfc_symtree *st; int i; --- 1345,1351 ---- gfc_symbol * gfc_use_derived (gfc_symbol * sym) { ! gfc_symbol *s; gfc_typespec *t; gfc_symtree *st; int i; *************** gfc_use_derived (gfc_symbol * sym) *** 1242,1256 **** s->refs++; /* Unlink from list of modified symbols. */ ! if (changed_syms == sym) ! changed_syms = sym->tlink; ! else ! for (p = changed_syms; p; p = p->tlink) ! if (p->tlink == sym) ! { ! p->tlink = sym->tlink; ! break; ! } switch_types (sym->ns->sym_root, sym, s); --- 1379,1385 ---- s->refs++; /* Unlink from list of modified symbols. */ ! gfc_commit_symbol (sym); switch_types (sym->ns->sym_root, sym, s); *************** gfc_get_component_attr (symbol_attribute *** 1357,1377 **** occurs. */ void ! gfc_free_st_label (gfc_st_label * l) { ! if (l == NULL) return; ! if (l->prev) ! (l->prev->next = l->next); ! if (l->next) ! (l->next->prev = l->prev); ! if (l->format != NULL) ! gfc_free_expr (l->format); ! gfc_free (l); } /* Free a whole list of gfc_st_label structures. */ --- 1486,1510 ---- occurs. */ void ! gfc_free_st_label (gfc_st_label * label) { ! if (label == NULL) return; ! if (label->prev) ! label->prev->next = label->next; ! if (label->next) ! label->next->prev = label->prev; ! if (gfc_current_ns->st_labels == label) ! gfc_current_ns->st_labels = label->next; ! ! if (label->format != NULL) ! gfc_free_expr (label->format); ! ! gfc_free (label); } /* Free a whole list of gfc_st_label structures. */ *************** gfc_undo_symbols (void) *** 2090,2095 **** --- 2223,2254 ---- } + /* Free sym->old_symbol. sym->old_symbol is mostly a shallow copy of sym; the + components of old_symbol that might need deallocation are the "allocatables" + that are restored in gfc_undo_symbols(), with two exceptions: namelist and + namelist_tail. In case these differ between old_symbol and sym, it's just + because sym->namelist has gotten a few more items. */ + + static void + free_old_symbol (gfc_symbol * sym) + { + if (sym->old_symbol == NULL) + return; + + if (sym->old_symbol->as != sym->as) + gfc_free_array_spec (sym->old_symbol->as); + + if (sym->old_symbol->value != sym->value) + gfc_free_expr (sym->old_symbol->value); + + if (sym->old_symbol->formal != sym->formal) + gfc_free_formal_arglist (sym->old_symbol->formal); + + gfc_free (sym->old_symbol); + sym->old_symbol = NULL; + } + + /* Makes the changes made in the current statement permanent-- gets rid of undo information. */ *************** gfc_commit_symbols (void) *** 2105,2121 **** p->mark = 0; p->new = 0; ! if (p->old_symbol != NULL) ! { ! gfc_free (p->old_symbol); ! p->old_symbol = NULL; ! } } - changed_syms = NULL; } /* Recursive function that deletes an entire tree and all the common head structures it points to. */ --- 2264,2303 ---- p->mark = 0; p->new = 0; ! free_old_symbol (p); } changed_syms = NULL; } + /* Makes the changes made in one symbol permanent -- gets rid of undo + information. */ + + void + gfc_commit_symbol (gfc_symbol * sym) + { + gfc_symbol *p; + + if (changed_syms == sym) + changed_syms = sym->tlink; + else + { + for (p = changed_syms; p; p = p->tlink) + if (p->tlink == sym) + { + p->tlink = sym->tlink; + break; + } + } + + sym->tlink = NULL; + sym->mark = 0; + sym->new = 0; + + free_old_symbol (sym); + } + + /* Recursive function that deletes an entire tree and all the common head structures it points to. */ *************** free_sym_tree (gfc_symtree * sym_tree) *** 2191,2196 **** --- 2373,2393 ---- } + /* Free a derived type list. */ + + static void + gfc_free_dt_list (gfc_dt_list * dt) + { + gfc_dt_list *n; + + for (; dt; dt = n) + { + n = dt->next; + gfc_free (dt); + } + } + + /* Free a namespace structure and everything below it. Interface lists associated with intrinsic operators are not freed. These are taken care of when a specific name is freed. */ *************** gfc_free_namespace (gfc_namespace * ns) *** 2227,2232 **** --- 2424,2431 ---- gfc_free_equiv (ns->equiv); + gfc_free_dt_list (ns->derived_types); + for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++) gfc_free_interface (ns->operator[i]); *************** gfc_is_var_automatic (gfc_symbol * sym) *** 2329,2338 **** if (sym->attr.dimension && sym->as && !gfc_is_compile_time_shape (sym->as)) return true; ! /* Check for non-constant length character vairables. */ if (sym->ts.type == BT_CHARACTER && sym->ts.cl ! && gfc_is_constant_expr (sym->ts.cl->length)) return true; return false; } --- 2528,2537 ---- if (sym->attr.dimension && sym->as && !gfc_is_compile_time_shape (sym->as)) return true; ! /* Check for non-constant length character variables. */ if (sym->ts.type == BT_CHARACTER && sym->ts.cl ! && !gfc_is_constant_expr (sym->ts.cl->length)) return true; return false; } *************** gfc_get_gsymbol (const char *name) *** 2432,2438 **** s = gfc_getmem (sizeof (gfc_gsymbol)); s->type = GSYM_UNKNOWN; ! strcpy (s->name, name); gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare); --- 2631,2637 ---- s = gfc_getmem (sizeof (gfc_gsymbol)); s->type = GSYM_UNKNOWN; ! s->name = gfc_get_string (name); gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare); diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-array.c gcc-4.1.0/gcc/fortran/trans-array.c *** gcc-4.0.2/gcc/fortran/trans-array.c Tue Sep 13 19:02:44 2005 --- gcc-4.1.0/gcc/fortran/trans-array.c Tue Feb 14 17:34:07 2006 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* trans-array.c-- Various array related code, including scalarization, allocation, initialization and other support routines. */ --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* trans-array.c-- Various array related code, including scalarization, allocation, initialization and other support routines. */ *************** Software Foundation, 59 Temple Place - S *** 94,99 **** --- 94,100 ---- #include "dependency.h" static gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *); + static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor *); /* The contents of this structure aren't actually used, just the address. */ static gfc_ss gfc_ss_terminator_var; *************** gfc_array_dataptr_type (tree desc) *** 134,155 **** #define LBOUND_SUBFIELD 1 #define UBOUND_SUBFIELD 2 tree ! gfc_conv_descriptor_data (tree desc) { ! tree field; ! tree type; type = TREE_TYPE (desc); gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); field = TYPE_FIELDS (type); gcc_assert (DATA_FIELD == 0); - gcc_assert (field != NULL_TREE - && TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE - && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == ARRAY_TYPE); ! return build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); } tree --- 135,194 ---- #define LBOUND_SUBFIELD 1 #define UBOUND_SUBFIELD 2 + /* This provides READ-ONLY access to the data field. The field itself + doesn't have the proper type. */ + tree ! gfc_conv_descriptor_data_get (tree desc) { ! tree field, type, t; type = TREE_TYPE (desc); gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); field = TYPE_FIELDS (type); gcc_assert (DATA_FIELD == 0); ! t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); ! t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t); ! ! return t; ! } ! ! /* This provides WRITE access to the data field. */ ! ! void ! gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value) ! { ! tree field, type, t; ! ! type = TREE_TYPE (desc); ! gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); ! ! field = TYPE_FIELDS (type); ! gcc_assert (DATA_FIELD == 0); ! ! t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); ! gfc_add_modify_expr (block, t, fold_convert (TREE_TYPE (field), value)); ! } ! ! ! /* This provides address access to the data field. This should only be ! used by array allocation, passing this on to the runtime. */ ! ! tree ! gfc_conv_descriptor_data_addr (tree desc) ! { ! tree field, type, t; ! ! type = TREE_TYPE (desc); ! gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); ! ! field = TYPE_FIELDS (type); ! gcc_assert (DATA_FIELD == 0); ! ! t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); ! return gfc_build_addr_expr (NULL, t); } tree *************** gfc_conv_descriptor_ubound (tree desc, t *** 248,254 **** } ! /* Build an null array descriptor constructor. */ tree gfc_build_null_descriptor (tree type) --- 287,293 ---- } ! /* Build a null array descriptor constructor. */ tree gfc_build_null_descriptor (tree type) *************** gfc_build_null_descriptor (tree type) *** 261,268 **** field = TYPE_FIELDS (type); /* Set a NULL data pointer. */ ! tmp = tree_cons (field, null_pointer_node, NULL_TREE); ! tmp = build1 (CONSTRUCTOR, type, tmp); TREE_CONSTANT (tmp) = 1; TREE_INVARIANT (tmp) = 1; /* All other fields are ignored. */ --- 300,306 ---- field = TYPE_FIELDS (type); /* Set a NULL data pointer. */ ! tmp = build_constructor_single (type, field, null_pointer_node); TREE_CONSTANT (tmp) = 1; TREE_INVARIANT (tmp) = 1; /* All other fields are ignored. */ *************** gfc_free_ss (gfc_ss * ss) *** 323,329 **** switch (ss->type) { case GFC_SS_SECTION: - case GFC_SS_VECTOR: for (n = 0; n < GFC_MAX_DIMENSIONS; n++) { if (ss->data.info.subscript[n]) --- 361,366 ---- *************** gfc_trans_static_array_pointer (gfc_symb *** 391,446 **** gcc_assert (TREE_STATIC (sym->backend_decl)); /* Just zero the data member. */ type = TREE_TYPE (sym->backend_decl); ! DECL_INITIAL (sym->backend_decl) =gfc_build_null_descriptor (type); } /* Generate code to allocate an array temporary, or create a variable to ! hold the data. If size is NULL zero the descriptor so that so that the ! callee will allocate the array. Also generates code to free the array ! afterwards. */ static void ! gfc_trans_allocate_array_storage (gfc_loopinfo * loop, gfc_ss_info * info, ! tree size, tree nelem) { tree tmp; tree args; tree desc; - tree data; bool onstack; desc = info->descriptor; ! data = gfc_conv_descriptor_data (desc); ! if (size == NULL_TREE) { /* A callee allocated array. */ ! gfc_add_modify_expr (&loop->pre, data, convert (TREE_TYPE (data), ! gfc_index_zero_node)); ! info->data = data; ! info->offset = gfc_index_zero_node; onstack = FALSE; } else { /* Allocate the temporary. */ ! onstack = gfc_can_put_var_on_stack (size); if (onstack) { /* Make a temporary variable to hold the data. */ ! tmp = fold (build2 (MINUS_EXPR, TREE_TYPE (nelem), nelem, ! integer_one_node)); tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)), tmp); tmp = gfc_create_var (tmp, "A"); ! tmp = gfc_build_addr_expr (TREE_TYPE (data), tmp); ! gfc_add_modify_expr (&loop->pre, data, tmp); ! info->data = data; ! info->offset = gfc_index_zero_node; ! } else { --- 428,526 ---- gcc_assert (TREE_STATIC (sym->backend_decl)); /* Just zero the data member. */ type = TREE_TYPE (sym->backend_decl); ! DECL_INITIAL (sym->backend_decl) = gfc_build_null_descriptor (type); ! } ! ! ! /* If the bounds of SE's loop have not yet been set, see if they can be ! determined from array spec AS, which is the array spec of a called ! function. MAPPING maps the callee's dummy arguments to the values ! that the caller is passing. Add any initialization and finalization ! code to SE. */ ! ! void ! gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, ! gfc_se * se, gfc_array_spec * as) ! { ! int n, dim; ! gfc_se tmpse; ! tree lower; ! tree upper; ! tree tmp; ! ! if (as && as->type == AS_EXPLICIT) ! for (dim = 0; dim < se->loop->dimen; dim++) ! { ! n = se->loop->order[dim]; ! if (se->loop->to[n] == NULL_TREE) ! { ! /* Evaluate the lower bound. */ ! gfc_init_se (&tmpse, NULL); ! gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]); ! gfc_add_block_to_block (&se->pre, &tmpse.pre); ! gfc_add_block_to_block (&se->post, &tmpse.post); ! lower = tmpse.expr; ! ! /* ...and the upper bound. */ ! gfc_init_se (&tmpse, NULL); ! gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); ! gfc_add_block_to_block (&se->pre, &tmpse.pre); ! gfc_add_block_to_block (&se->post, &tmpse.post); ! upper = tmpse.expr; ! ! /* Set the upper bound of the loop to UPPER - LOWER. */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, upper, lower); ! tmp = gfc_evaluate_now (tmp, &se->pre); ! se->loop->to[n] = tmp; ! } ! } } /* Generate code to allocate an array temporary, or create a variable to ! hold the data. If size is NULL, zero the descriptor so that the ! callee will allocate the array. If DEALLOC is true, also generate code to ! free the array afterwards. ! ! Initialization code is added to PRE and finalization code to POST. ! DYNAMIC is true if the caller may want to extend the array later ! using realloc. This prevents us from putting the array on the stack. */ static void ! gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, ! gfc_ss_info * info, tree size, tree nelem, ! bool dynamic, bool dealloc) { tree tmp; tree args; tree desc; bool onstack; desc = info->descriptor; ! info->offset = gfc_index_zero_node; ! if (size == NULL_TREE || integer_zerop (size)) { /* A callee allocated array. */ ! gfc_conv_descriptor_data_set (pre, desc, null_pointer_node); onstack = FALSE; } else { /* Allocate the temporary. */ ! onstack = !dynamic && gfc_can_put_var_on_stack (size); if (onstack) { /* Make a temporary variable to hold the data. */ ! tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (nelem), nelem, ! integer_one_node); tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)), tmp); tmp = gfc_create_var (tmp, "A"); ! tmp = gfc_build_addr_expr (NULL, tmp); ! gfc_conv_descriptor_data_set (pre, desc, tmp); } else { *************** gfc_trans_allocate_array_storage (gfc_lo *** 454,479 **** else gcc_unreachable (); tmp = gfc_build_function_call (tmp, args); ! tmp = convert (TREE_TYPE (data), tmp); ! gfc_add_modify_expr (&loop->pre, data, tmp); ! ! info->data = data; ! info->offset = gfc_index_zero_node; } } /* The offset is zero because we create temporaries with a zero lower bound. */ tmp = gfc_conv_descriptor_offset (desc); ! gfc_add_modify_expr (&loop->pre, tmp, gfc_index_zero_node); ! if (!onstack) { /* Free the temporary. */ ! tmp = convert (pvoid_type_node, info->data); tmp = gfc_chainon_list (NULL_TREE, tmp); tmp = gfc_build_function_call (gfor_fndecl_internal_free, tmp); ! gfc_add_expr_to_block (&loop->post, tmp); } } --- 534,558 ---- else gcc_unreachable (); tmp = gfc_build_function_call (tmp, args); ! tmp = gfc_evaluate_now (tmp, pre); ! gfc_conv_descriptor_data_set (pre, desc, tmp); } } + info->data = gfc_conv_descriptor_data_get (desc); /* The offset is zero because we create temporaries with a zero lower bound. */ tmp = gfc_conv_descriptor_offset (desc); ! gfc_add_modify_expr (pre, tmp, gfc_index_zero_node); ! if (dealloc && !onstack) { /* Free the temporary. */ ! tmp = gfc_conv_descriptor_data_get (desc); ! tmp = fold_convert (pvoid_type_node, tmp); tmp = gfc_chainon_list (NULL_TREE, tmp); tmp = gfc_build_function_call (gfor_fndecl_internal_free, tmp); ! gfc_add_expr_to_block (post, tmp); } } *************** gfc_trans_allocate_array_storage (gfc_lo *** 483,493 **** functions returning arrays. Adjusts the loop variables to be zero-based, and calculates the loop bounds for callee allocated arrays. Also fills in the descriptor, data and offset fields of info if known. ! Returns the size of the array, or NULL for a callee allocated array. */ tree ! gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info, ! tree eltype) { tree type; tree desc; --- 562,576 ---- functions returning arrays. Adjusts the loop variables to be zero-based, and calculates the loop bounds for callee allocated arrays. Also fills in the descriptor, data and offset fields of info if known. ! Returns the size of the array, or NULL for a callee allocated array. ! ! PRE, POST, DYNAMIC and DEALLOC are as for gfc_trans_allocate_array_storage. ! */ tree ! gfc_trans_allocate_temp_array (stmtblock_t * pre, stmtblock_t * post, ! gfc_loopinfo * loop, gfc_ss_info * info, ! tree eltype, bool dynamic, bool dealloc) { tree type; tree desc; *************** gfc_trans_allocate_temp_array (gfc_loopi *** 508,515 **** { /* Callee allocated arrays may not have a known bound yet. */ if (loop->to[n]) ! loop->to[n] = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! loop->to[n], loop->from[n])); loop->from[n] = gfc_index_zero_node; } --- 591,598 ---- { /* Callee allocated arrays may not have a known bound yet. */ if (loop->to[n]) ! loop->to[n] = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! loop->to[n], loop->from[n]); loop->from[n] = gfc_index_zero_node; } *************** gfc_trans_allocate_temp_array (gfc_loopi *** 530,536 **** /* Fill in the array dtype. */ tmp = gfc_conv_descriptor_dtype (desc); ! gfc_add_modify_expr (&loop->pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); /* Fill in the bounds and stride. This is a packed array, so: --- 613,619 ---- /* Fill in the array dtype. */ tmp = gfc_conv_descriptor_dtype (desc); ! gfc_add_modify_expr (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); /* Fill in the bounds and stride. This is a packed array, so: *************** gfc_trans_allocate_temp_array (gfc_loopi *** 561,588 **** /* Store the stride and bound components in the descriptor. */ tmp = gfc_conv_descriptor_stride (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (&loop->pre, tmp, size); tmp = gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (&loop->pre, tmp, gfc_index_zero_node); tmp = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (&loop->pre, tmp, loop->to[n]); ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! loop->to[n], gfc_index_one_node)); ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, size, tmp)); ! size = gfc_evaluate_now (size, &loop->pre); } /* Get the size of the array. */ nelem = size; if (size) ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, size, ! TYPE_SIZE_UNIT (gfc_get_element_type (type)))); ! gfc_trans_allocate_array_storage (loop, info, size, nelem); if (info->dimen > loop->temp_dim) loop->temp_dim = info->dimen; --- 644,672 ---- /* Store the stride and bound components in the descriptor. */ tmp = gfc_conv_descriptor_stride (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (pre, tmp, size); tmp = gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (pre, tmp, gfc_index_zero_node); tmp = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]); ! gfc_add_modify_expr (pre, tmp, loop->to[n]); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! loop->to[n], gfc_index_one_node); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); ! size = gfc_evaluate_now (size, pre); } /* Get the size of the array. */ nelem = size; if (size) ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, ! TYPE_SIZE_UNIT (gfc_get_element_type (type))); ! gfc_trans_allocate_array_storage (pre, post, info, size, nelem, dynamic, ! dealloc); if (info->dimen > loop->temp_dim) loop->temp_dim = info->dimen; *************** gfc_trans_allocate_temp_array (gfc_loopi *** 591,596 **** --- 675,823 ---- } + /* Return the number of iterations in a loop that starts at START, + ends at END, and has step STEP. */ + + static tree + gfc_get_iteration_count (tree start, tree end, tree step) + { + tree tmp; + tree type; + + type = TREE_TYPE (step); + tmp = fold_build2 (MINUS_EXPR, type, end, start); + tmp = fold_build2 (FLOOR_DIV_EXPR, type, tmp, step); + tmp = fold_build2 (PLUS_EXPR, type, tmp, build_int_cst (type, 1)); + tmp = fold_build2 (MAX_EXPR, type, tmp, build_int_cst (type, 0)); + return fold_convert (gfc_array_index_type, tmp); + } + + + /* Extend the data in array DESC by EXTRA elements. */ + + static void + gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra) + { + tree args; + tree tmp; + tree size; + tree ubound; + + if (integer_zerop (extra)) + return; + + ubound = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[0]); + + /* Add EXTRA to the upper bound. */ + tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, extra); + gfc_add_modify_expr (pblock, ubound, tmp); + + /* Get the value of the current data pointer. */ + tmp = gfc_conv_descriptor_data_get (desc); + args = gfc_chainon_list (NULL_TREE, tmp); + + /* Calculate the new array size. */ + size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); + tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, gfc_index_one_node); + tmp = build2 (MULT_EXPR, gfc_array_index_type, tmp, size); + args = gfc_chainon_list (args, tmp); + + /* Pick the appropriate realloc function. */ + if (gfc_index_integer_kind == 4) + tmp = gfor_fndecl_internal_realloc; + else if (gfc_index_integer_kind == 8) + tmp = gfor_fndecl_internal_realloc64; + else + gcc_unreachable (); + + /* Set the new data pointer. */ + tmp = gfc_build_function_call (tmp, args); + gfc_conv_descriptor_data_set (pblock, desc, tmp); + } + + + /* Return true if the bounds of iterator I can only be determined + at run time. */ + + static inline bool + gfc_iterator_has_dynamic_bounds (gfc_iterator * i) + { + return (i->start->expr_type != EXPR_CONSTANT + || i->end->expr_type != EXPR_CONSTANT + || i->step->expr_type != EXPR_CONSTANT); + } + + + /* Split the size of constructor element EXPR into the sum of two terms, + one of which can be determined at compile time and one of which must + be calculated at run time. Set *SIZE to the former and return true + if the latter might be nonzero. */ + + static bool + gfc_get_array_constructor_element_size (mpz_t * size, gfc_expr * expr) + { + if (expr->expr_type == EXPR_ARRAY) + return gfc_get_array_constructor_size (size, expr->value.constructor); + else if (expr->rank > 0) + { + /* Calculate everything at run time. */ + mpz_set_ui (*size, 0); + return true; + } + else + { + /* A single element. */ + mpz_set_ui (*size, 1); + return false; + } + } + + + /* Like gfc_get_array_constructor_element_size, but applied to the whole + of array constructor C. */ + + static bool + gfc_get_array_constructor_size (mpz_t * size, gfc_constructor * c) + { + gfc_iterator *i; + mpz_t val; + mpz_t len; + bool dynamic; + + mpz_set_ui (*size, 0); + mpz_init (len); + mpz_init (val); + + dynamic = false; + for (; c; c = c->next) + { + i = c->iterator; + if (i && gfc_iterator_has_dynamic_bounds (i)) + dynamic = true; + else + { + dynamic |= gfc_get_array_constructor_element_size (&len, c->expr); + if (i) + { + /* Multiply the static part of the element size by the + number of iterations. */ + mpz_sub (val, i->end->value.integer, i->start->value.integer); + mpz_fdiv_q (val, val, i->step->value.integer); + mpz_add_ui (val, val, 1); + if (mpz_sgn (val) > 0) + mpz_mul (len, len, val); + else + mpz_set_ui (len, 0); + } + mpz_add (*size, *size, len); + } + } + mpz_clear (len); + mpz_clear (val); + return dynamic; + } + + /* Make sure offset is a variable. */ static void *************** gfc_put_offset_into_var (stmtblock_t * p *** 609,615 **** /* Assign an element of an array constructor. */ static void ! gfc_trans_array_ctor_element (stmtblock_t * pblock, tree pointer, tree offset, gfc_se * se, gfc_expr * expr) { tree tmp; --- 836,842 ---- /* Assign an element of an array constructor. */ static void ! gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, tree offset, gfc_se * se, gfc_expr * expr) { tree tmp; *************** gfc_trans_array_ctor_element (stmtblock_ *** 618,624 **** gfc_conv_expr (se, expr); /* Store the value. */ ! tmp = gfc_build_indirect_ref (pointer); tmp = gfc_build_array_ref (tmp, offset); if (expr->ts.type == BT_CHARACTER) { --- 845,851 ---- gfc_conv_expr (se, expr); /* Store the value. */ ! tmp = gfc_build_indirect_ref (gfc_conv_descriptor_data_get (desc)); tmp = gfc_build_array_ref (tmp, offset); if (expr->ts.type == BT_CHARACTER) { *************** gfc_trans_array_ctor_element (stmtblock_ *** 655,673 **** } ! /* Add the contents of an array to the constructor. */ static void gfc_trans_array_constructor_subarray (stmtblock_t * pblock, tree type ATTRIBUTE_UNUSED, ! tree pointer, gfc_expr * expr, ! tree * poffset, tree * offsetvar) { gfc_se se; gfc_ss *ss; gfc_loopinfo loop; stmtblock_t body; tree tmp; /* We need this to be a variable so we can increment it. */ gfc_put_offset_into_var (pblock, poffset, offsetvar); --- 882,904 ---- } ! /* Add the contents of an array to the constructor. DYNAMIC is as for ! gfc_trans_array_constructor_value. */ static void gfc_trans_array_constructor_subarray (stmtblock_t * pblock, tree type ATTRIBUTE_UNUSED, ! tree desc, gfc_expr * expr, ! tree * poffset, tree * offsetvar, ! bool dynamic) { gfc_se se; gfc_ss *ss; gfc_loopinfo loop; stmtblock_t body; tree tmp; + tree size; + int n; /* We need this to be a variable so we can increment it. */ gfc_put_offset_into_var (pblock, poffset, offsetvar); *************** gfc_trans_array_constructor_subarray (st *** 686,691 **** --- 917,938 ---- gfc_conv_ss_startstride (&loop); gfc_conv_loop_setup (&loop); + /* Make sure the constructed array has room for the new data. */ + if (dynamic) + { + /* Set SIZE to the total number of elements in the subarray. */ + size = gfc_index_one_node; + for (n = 0; n < loop.dimen; n++) + { + tmp = gfc_get_iteration_count (loop.from[n], loop.to[n], + gfc_index_one_node); + size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); + } + + /* Grow the constructed array by SIZE elements. */ + gfc_grow_array (&loop.pre, desc, size); + } + /* Make the loop body. */ gfc_mark_ss_chain_used (ss, 1); gfc_start_scalarized_body (&loop, &body); *************** gfc_trans_array_constructor_subarray (st *** 695,701 **** if (expr->ts.type == BT_CHARACTER) gfc_todo_error ("character arrays in constructors"); ! gfc_trans_array_ctor_element (&body, pointer, *poffset, &se, expr); gcc_assert (se.ss == gfc_ss_terminator); /* Increment the offset. */ --- 942,948 ---- if (expr->ts.type == BT_CHARACTER) gfc_todo_error ("character arrays in constructors"); ! gfc_trans_array_ctor_element (&body, desc, *poffset, &se, expr); gcc_assert (se.ss == gfc_ss_terminator); /* Increment the offset. */ *************** gfc_trans_array_constructor_subarray (st *** 712,728 **** } ! /* Assign the values to the elements of an array constructor. */ static void gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, ! tree pointer, gfc_constructor * c, ! tree * poffset, tree * offsetvar) { tree tmp; stmtblock_t body; gfc_se se; for (; c; c = c->next) { /* If this is an iterator or an array, the offset must be a variable. */ --- 959,981 ---- } ! /* Assign the values to the elements of an array constructor. DYNAMIC ! is true if descriptor DESC only contains enough data for the static ! size calculated by gfc_get_array_constructor_size. When true, memory ! for the dynamic parts must be allocated using realloc. */ static void gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, ! tree desc, gfc_constructor * c, ! tree * poffset, tree * offsetvar, ! bool dynamic) { tree tmp; stmtblock_t body; gfc_se se; + mpz_t size; + mpz_init (size); for (; c; c = c->next) { /* If this is an iterator or an array, the offset must be a variable. */ *************** gfc_trans_array_constructor_value (stmtb *** 734,747 **** if (c->expr->expr_type == EXPR_ARRAY) { /* Array constructors can be nested. */ ! gfc_trans_array_constructor_value (&body, type, pointer, c->expr->value.constructor, ! poffset, offsetvar); } else if (c->expr->rank > 0) { ! gfc_trans_array_constructor_subarray (&body, type, pointer, ! c->expr, poffset, offsetvar); } else { --- 987,1000 ---- if (c->expr->expr_type == EXPR_ARRAY) { /* Array constructors can be nested. */ ! gfc_trans_array_constructor_value (&body, type, desc, c->expr->value.constructor, ! poffset, offsetvar, dynamic); } else if (c->expr->rank > 0) { ! gfc_trans_array_constructor_subarray (&body, type, desc, c->expr, ! poffset, offsetvar, dynamic); } else { *************** gfc_trans_array_constructor_value (stmtb *** 761,771 **** { /* Scalar values. */ gfc_init_se (&se, NULL); ! gfc_trans_array_ctor_element (&body, pointer, *poffset, &se, ! c->expr); ! *poffset = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! *poffset, gfc_index_one_node)); } else { --- 1014,1024 ---- { /* Scalar values. */ gfc_init_se (&se, NULL); ! gfc_trans_array_ctor_element (&body, desc, *poffset, ! &se, c->expr); ! *poffset = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! *poffset, gfc_index_one_node); } else { *************** gfc_trans_array_constructor_value (stmtb *** 784,796 **** gfc_init_se (&se, NULL); gfc_conv_constant (&se, p->expr); if (p->expr->ts.type == BT_CHARACTER ! && POINTER_TYPE_P (TREE_TYPE (TREE_TYPE ! (TREE_TYPE (pointer))))) { /* For constant character array constructors we build an array of pointers. */ se.expr = gfc_build_addr_expr (pchar_type_node, ! se.expr); } list = tree_cons (NULL_TREE, se.expr, list); --- 1037,1048 ---- gfc_init_se (&se, NULL); gfc_conv_constant (&se, p->expr); if (p->expr->ts.type == BT_CHARACTER ! && POINTER_TYPE_P (type)) { /* For constant character array constructors we build an array of pointers. */ se.expr = gfc_build_addr_expr (pchar_type_node, ! se.expr); } list = tree_cons (NULL_TREE, se.expr, list); *************** gfc_trans_array_constructor_value (stmtb *** 804,810 **** gfc_index_zero_node, bound); tmptype = build_array_type (type, tmptype); ! init = build1 (CONSTRUCTOR, tmptype, nreverse (list)); TREE_CONSTANT (init) = 1; TREE_INVARIANT (init) = 1; TREE_STATIC (init) = 1; --- 1056,1062 ---- gfc_index_zero_node, bound); tmptype = build_array_type (type, tmptype); ! init = build_constructor_from_list (tmptype, nreverse (list)); TREE_CONSTANT (init) = 1; TREE_INVARIANT (init) = 1; TREE_STATIC (init) = 1; *************** gfc_trans_array_constructor_value (stmtb *** 817,823 **** init = tmp; /* Use BUILTIN_MEMCPY to assign the values. */ ! tmp = gfc_build_indirect_ref (pointer); tmp = gfc_build_array_ref (tmp, *poffset); tmp = gfc_build_addr_expr (NULL, tmp); init = gfc_build_addr_expr (NULL, init); --- 1069,1076 ---- init = tmp; /* Use BUILTIN_MEMCPY to assign the values. */ ! tmp = gfc_conv_descriptor_data_get (desc); ! tmp = gfc_build_indirect_ref (tmp); tmp = gfc_build_array_ref (tmp, *poffset); tmp = gfc_build_addr_expr (NULL, tmp); init = gfc_build_addr_expr (NULL, init); *************** gfc_trans_array_constructor_value (stmtb *** 831,838 **** tmp); gfc_add_expr_to_block (&body, tmp); ! *poffset = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! *poffset, build_int_cst (NULL_TREE, n))); } if (!INTEGER_CST_P (*poffset)) { --- 1084,1091 ---- tmp); gfc_add_expr_to_block (&body, tmp); ! *poffset = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! *poffset, build_int_cst (NULL_TREE, n)); } if (!INTEGER_CST_P (*poffset)) { *************** gfc_trans_array_constructor_value (stmtb *** 858,863 **** --- 1111,1117 ---- tree loopvar; tree exit_label; tree loopbody; + tree tmp2; loopbody = gfc_finish_block (&body); *************** gfc_trans_array_constructor_value (stmtb *** 882,887 **** --- 1136,1158 ---- gfc_add_block_to_block (pblock, &se.pre); step = gfc_evaluate_now (se.expr, pblock); + /* If this array expands dynamically, and the number of iterations + is not constant, we won't have allocated space for the static + part of C->EXPR's size. Do that now. */ + if (dynamic && gfc_iterator_has_dynamic_bounds (c->iterator)) + { + /* Get the number of iterations. */ + tmp = gfc_get_iteration_count (loopvar, end, step); + + /* Get the static part of C->EXPR's size. */ + gfc_get_array_constructor_element_size (&size, c->expr); + tmp2 = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind); + + /* Grow the array by TMP * TMP2 elements. */ + tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, tmp2); + gfc_grow_array (pblock, desc, tmp); + } + /* Generate the loop body. */ exit_label = gfc_build_label_decl (NULL_TREE); gfc_start_block (&body); *************** gfc_trans_array_constructor_value (stmtb *** 889,901 **** /* Generate the exit condition. Depending on the sign of the step variable we have to generate the correct comparison. */ ! tmp = fold (build2 (GT_EXPR, boolean_type_node, step, ! build_int_cst (TREE_TYPE (step), 0))); ! cond = fold (build3 (COND_EXPR, boolean_type_node, tmp, ! build2 (GT_EXPR, boolean_type_node, ! loopvar, end), ! build2 (LT_EXPR, boolean_type_node, ! loopvar, end))); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); --- 1160,1172 ---- /* Generate the exit condition. Depending on the sign of the step variable we have to generate the correct comparison. */ ! tmp = fold_build2 (GT_EXPR, boolean_type_node, step, ! build_int_cst (TREE_TYPE (step), 0)); ! cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, ! build2 (GT_EXPR, boolean_type_node, ! loopvar, end), ! build2 (LT_EXPR, boolean_type_node, ! loopvar, end)); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); *************** gfc_trans_array_constructor_value (stmtb *** 918,990 **** gfc_add_expr_to_block (pblock, tmp); } } ! } ! ! ! /* Get the size of an expression. Returns -1 if the size isn't constant. ! Implied do loops with non-constant bounds are tricky because we must only ! evaluate the bounds once. */ ! ! static void ! gfc_get_array_cons_size (mpz_t * size, gfc_constructor * c) ! { ! gfc_iterator *i; ! mpz_t val; ! mpz_t len; ! ! mpz_set_ui (*size, 0); ! mpz_init (len); ! mpz_init (val); ! ! for (; c; c = c->next) ! { ! if (c->expr->expr_type == EXPR_ARRAY) ! { ! /* A nested array constructor. */ ! gfc_get_array_cons_size (&len, c->expr->value.constructor); ! if (mpz_sgn (len) < 0) ! { ! mpz_set (*size, len); ! mpz_clear (len); ! mpz_clear (val); ! return; ! } ! } ! else ! { ! if (c->expr->rank > 0) ! { ! mpz_set_si (*size, -1); ! mpz_clear (len); ! mpz_clear (val); ! return; ! } ! mpz_set_ui (len, 1); ! } ! ! if (c->iterator) ! { ! i = c->iterator; ! ! if (i->start->expr_type != EXPR_CONSTANT ! || i->end->expr_type != EXPR_CONSTANT ! || i->step->expr_type != EXPR_CONSTANT) ! { ! mpz_set_si (*size, -1); ! mpz_clear (len); ! mpz_clear (val); ! return; ! } ! ! mpz_add (val, i->end->value.integer, i->start->value.integer); ! mpz_tdiv_q (val, val, i->step->value.integer); ! mpz_add_ui (val, val, 1); ! mpz_mul (len, len, val); ! } ! mpz_add (*size, *size, len); ! } ! mpz_clear (len); ! mpz_clear (val); } --- 1189,1195 ---- gfc_add_expr_to_block (pblock, tmp); } } ! mpz_clear (size); } *************** get_array_ctor_var_strlen (gfc_expr * ex *** 1007,1013 **** switch (ref->type) { case REF_ARRAY: ! /* Array references don't change teh sting length. */ break; case COMPONENT_REF: --- 1212,1218 ---- switch (ref->type) { case REF_ARRAY: ! /* Array references don't change the string length. */ break; case COMPONENT_REF: *************** get_array_ctor_strlen (gfc_constructor * *** 1075,1093 **** static void gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) { tree offset; tree offsetvar; tree desc; - tree size; tree type; bool const_string; ss->data.info.dimen = loop->dimen; if (ss->expr->ts.type == BT_CHARACTER) { ! const_string = get_array_ctor_strlen (ss->expr->value.constructor, ! &ss->string_length); if (!ss->string_length) gfc_todo_error ("complex character array constructors"); --- 1280,1299 ---- static void gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) { + gfc_constructor *c; tree offset; tree offsetvar; tree desc; tree type; bool const_string; + bool dynamic; ss->data.info.dimen = loop->dimen; + c = ss->expr->value.constructor; if (ss->expr->ts.type == BT_CHARACTER) { ! const_string = get_array_ctor_strlen (c, &ss->string_length); if (!ss->string_length) gfc_todo_error ("complex character array constructors"); *************** gfc_trans_array_constructor (gfc_loopinf *** 1101,1116 **** type = gfc_typenode_for_spec (&ss->expr->ts); } ! size = gfc_trans_allocate_temp_array (loop, &ss->data.info, type); desc = ss->data.info.descriptor; offset = gfc_index_zero_node; offsetvar = gfc_create_var_np (gfc_array_index_type, "offset"); TREE_USED (offsetvar) = 0; ! gfc_trans_array_constructor_value (&loop->pre, type, ! ss->data.info.data, ! ss->expr->value.constructor, &offset, ! &offsetvar); if (TREE_USED (offsetvar)) pushdecl (offsetvar); --- 1307,1346 ---- type = gfc_typenode_for_spec (&ss->expr->ts); } ! /* See if the constructor determines the loop bounds. */ ! dynamic = false; ! if (loop->to[0] == NULL_TREE) ! { ! mpz_t size; ! ! /* We should have a 1-dimensional, zero-based loop. */ ! gcc_assert (loop->dimen == 1); ! gcc_assert (integer_zerop (loop->from[0])); ! ! /* Split the constructor size into a static part and a dynamic part. ! Allocate the static size up-front and record whether the dynamic ! size might be nonzero. */ ! mpz_init (size); ! dynamic = gfc_get_array_constructor_size (&size, c); ! mpz_sub_ui (size, size, 1); ! loop->to[0] = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind); ! mpz_clear (size); ! } ! ! gfc_trans_allocate_temp_array (&loop->pre, &loop->post, loop, ! &ss->data.info, type, dynamic, true); desc = ss->data.info.descriptor; offset = gfc_index_zero_node; offsetvar = gfc_create_var_np (gfc_array_index_type, "offset"); TREE_USED (offsetvar) = 0; ! gfc_trans_array_constructor_value (&loop->pre, type, desc, c, ! &offset, &offsetvar, dynamic); ! ! /* If the array grows dynamically, the upper bound of the loop variable ! is determined by the array's final upper bound. */ ! if (dynamic) ! loop->to[0] = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[0]); if (TREE_USED (offsetvar)) pushdecl (offsetvar); *************** gfc_trans_array_constructor (gfc_loopinf *** 1126,1131 **** --- 1356,1402 ---- } + /* INFO describes a GFC_SS_SECTION in loop LOOP, and this function is + called after evaluating all of INFO's vector dimensions. Go through + each such vector dimension and see if we can now fill in any missing + loop bounds. */ + + static void + gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info) + { + gfc_se se; + tree tmp; + tree desc; + tree zero; + int n; + int dim; + + for (n = 0; n < loop->dimen; n++) + { + dim = info->dim[n]; + if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR + && loop->to[n] == NULL) + { + /* Loop variable N indexes vector dimension DIM, and we don't + yet know the upper bound of loop variable N. Set it to the + difference between the vector's upper and lower bounds. */ + gcc_assert (loop->from[n] == gfc_index_zero_node); + gcc_assert (info->subscript[dim] + && info->subscript[dim]->type == GFC_SS_VECTOR); + + gfc_init_se (&se, NULL); + desc = info->subscript[dim]->data.info.descriptor; + zero = gfc_rank_cst[0]; + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, + gfc_conv_descriptor_ubound (desc, zero), + gfc_conv_descriptor_lbound (desc, zero)); + tmp = gfc_evaluate_now (tmp, &loop->pre); + loop->to[n] = tmp; + } + } + } + + /* Add the pre and post chains for all the scalar expressions in a SS chain to loop. This is called after the loop parameters have been calculated, but before the actual scalarizing loops. */ *************** gfc_add_loop_ss_code (gfc_loopinfo * loo *** 1181,1194 **** break; case GFC_SS_SECTION: ! case GFC_SS_VECTOR: ! /* Scalarized expression. Evaluate any scalar subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) ! { ! /* Add the expressions for scalar subscripts. */ ! if (ss->data.info.subscript[n]) ! gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true); ! } break; case GFC_SS_INTRINSIC: --- 1452,1472 ---- break; case GFC_SS_SECTION: ! /* Add the expressions for scalar and vector subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) ! if (ss->data.info.subscript[n]) ! gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true); ! ! gfc_set_vector_loop_bounds (loop, &ss->data.info); ! break; ! ! case GFC_SS_VECTOR: ! /* Get the vector's descriptor and store it in SS. */ ! gfc_init_se (&se, NULL); ! gfc_conv_expr_descriptor (&se, ss->expr, gfc_walk_expr (ss->expr)); ! gfc_add_block_to_block (&loop->pre, &se.pre); ! gfc_add_block_to_block (&loop->post, &se.post); ! ss->data.info.descriptor = se.expr; break; case GFC_SS_INTRINSIC: *************** gfc_add_loop_ss_code (gfc_loopinfo * loo *** 1204,1209 **** --- 1482,1488 ---- gfc_conv_expr (&se, ss->expr); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); + ss->string_length = se.string_length; break; case GFC_SS_CONSTRUCTOR: *************** gfc_conv_array_data (tree descriptor) *** 1308,1314 **** } } else ! return gfc_conv_descriptor_data (descriptor); } --- 1587,1593 ---- } } else ! return gfc_conv_descriptor_data_get (descriptor); } *************** gfc_conv_array_ubound (tree descriptor, *** 1390,1430 **** } - /* Translate an array reference. The descriptor should be in se->expr. - Do not use this function, it wil be removed soon. */ - /*GCC ARRAYS*/ - - static void - gfc_conv_array_index_ref (gfc_se * se, tree pointer, tree * indices, - tree offset, int dimen) - { - tree array; - tree tmp; - tree index; - int n; - - array = gfc_build_indirect_ref (pointer); - - index = offset; - for (n = 0; n < dimen; n++) - { - /* index = index + stride[n]*indices[n] */ - tmp = gfc_conv_array_stride (se->expr, n); - tmp = fold (build2 (MULT_EXPR, gfc_array_index_type, indices[n], tmp)); - - index = fold (build2 (PLUS_EXPR, gfc_array_index_type, index, tmp)); - } - - /* Result = data[index]. */ - tmp = gfc_build_array_ref (array, index); - - /* Check we've used the correct number of dimensions. */ - gcc_assert (TREE_CODE (TREE_TYPE (tmp)) != ARRAY_TYPE); - - se->expr = tmp; - } - - /* Generate code to perform an array index bound check. */ static tree --- 1669,1674 ---- *************** gfc_trans_array_bound_check (gfc_se * se *** 1440,1450 **** index = gfc_evaluate_now (index, &se->pre); /* Check lower bound. */ tmp = gfc_conv_array_lbound (descriptor, n); ! fault = fold (build2 (LT_EXPR, boolean_type_node, index, tmp)); /* Check upper bound. */ tmp = gfc_conv_array_ubound (descriptor, n); ! cond = fold (build2 (GT_EXPR, boolean_type_node, index, tmp)); ! fault = fold (build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond)); gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre); --- 1684,1694 ---- index = gfc_evaluate_now (index, &se->pre); /* Check lower bound. */ tmp = gfc_conv_array_lbound (descriptor, n); ! fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp); /* Check upper bound. */ tmp = gfc_conv_array_ubound (descriptor, n); ! cond = fold_build2 (GT_EXPR, boolean_type_node, index, tmp); ! fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond); gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre); *************** gfc_trans_array_bound_check (gfc_se * se *** 1452,1512 **** } - /* A reference to an array vector subscript. Uses recursion to handle nested - vector subscripts. */ - - static tree - gfc_conv_vector_array_index (gfc_se * se, tree index, gfc_ss * ss) - { - tree descsave; - tree indices[GFC_MAX_DIMENSIONS]; - gfc_array_ref *ar; - gfc_ss_info *info; - int n; - - gcc_assert (ss && ss->type == GFC_SS_VECTOR); - - /* Save the descriptor. */ - descsave = se->expr; - info = &ss->data.info; - se->expr = info->descriptor; - - ar = &info->ref->u.ar; - for (n = 0; n < ar->dimen; n++) - { - switch (ar->dimen_type[n]) - { - case DIMEN_ELEMENT: - gcc_assert (info->subscript[n] != gfc_ss_terminator - && info->subscript[n]->type == GFC_SS_SCALAR); - indices[n] = info->subscript[n]->data.scalar.expr; - break; - - case DIMEN_RANGE: - indices[n] = index; - break; - - case DIMEN_VECTOR: - index = gfc_conv_vector_array_index (se, index, info->subscript[n]); - - indices[n] = - gfc_trans_array_bound_check (se, info->descriptor, index, n); - break; - - default: - gcc_unreachable (); - } - } - /* Get the index from the vector. */ - gfc_conv_array_index_ref (se, info->data, indices, info->offset, ar->dimen); - index = se->expr; - /* Put the descriptor back. */ - se->expr = descsave; - - return index; - } - - /* Return the offset for an index. Performs bound checking for elemental dimensions. Single element references are processed separately. */ --- 1696,1701 ---- *************** gfc_conv_array_index_offset (gfc_se * se *** 1515,1560 **** gfc_array_ref * ar, tree stride) { tree index; /* Get the index into the array for this dimension. */ if (ar) { gcc_assert (ar->type != AR_ELEMENT); ! if (ar->dimen_type[dim] == DIMEN_ELEMENT) { gcc_assert (i == -1); /* Elemental dimension. */ gcc_assert (info->subscript[dim] ! && info->subscript[dim]->type == GFC_SS_SCALAR); /* We've already translated this value outside the loop. */ index = info->subscript[dim]->data.scalar.expr; index = gfc_trans_array_bound_check (se, info->descriptor, index, dim); ! } ! else ! { /* Scalarized dimension. */ gcc_assert (info && se->loop); ! /* Multiply the loop variable by the stride and dela. */ index = se->loop->loopvar[i]; ! index = fold (build2 (MULT_EXPR, gfc_array_index_type, index, ! info->stride[i])); ! index = fold (build2 (PLUS_EXPR, gfc_array_index_type, index, ! info->delta[i])); ! if (ar->dimen_type[dim] == DIMEN_VECTOR) ! { ! /* Handle vector subscripts. */ ! index = gfc_conv_vector_array_index (se, index, ! info->subscript[dim]); ! index = ! gfc_trans_array_bound_check (se, info->descriptor, index, ! dim); ! } ! else ! gcc_assert (ar->dimen_type[dim] == DIMEN_RANGE); } } else --- 1704,1768 ---- gfc_array_ref * ar, tree stride) { tree index; + tree desc; + tree data; /* Get the index into the array for this dimension. */ if (ar) { gcc_assert (ar->type != AR_ELEMENT); ! switch (ar->dimen_type[dim]) { + case DIMEN_ELEMENT: gcc_assert (i == -1); /* Elemental dimension. */ gcc_assert (info->subscript[dim] ! && info->subscript[dim]->type == GFC_SS_SCALAR); /* We've already translated this value outside the loop. */ index = info->subscript[dim]->data.scalar.expr; index = gfc_trans_array_bound_check (se, info->descriptor, index, dim); ! break; ! ! case DIMEN_VECTOR: ! gcc_assert (info && se->loop); ! gcc_assert (info->subscript[dim] ! && info->subscript[dim]->type == GFC_SS_VECTOR); ! desc = info->subscript[dim]->data.info.descriptor; ! ! /* Get a zero-based index into the vector. */ ! index = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! se->loop->loopvar[i], se->loop->from[i]); ! ! /* Multiply the index by the stride. */ ! index = fold_build2 (MULT_EXPR, gfc_array_index_type, ! index, gfc_conv_array_stride (desc, 0)); ! ! /* Read the vector to get an index into info->descriptor. */ ! data = gfc_build_indirect_ref (gfc_conv_array_data (desc)); ! index = gfc_build_array_ref (data, index); ! index = gfc_evaluate_now (index, &se->pre); ! ! /* Do any bounds checking on the final info->descriptor index. */ ! index = gfc_trans_array_bound_check (se, info->descriptor, ! index, dim); ! break; ! ! case DIMEN_RANGE: /* Scalarized dimension. */ gcc_assert (info && se->loop); ! /* Multiply the loop variable by the stride and delta. */ index = se->loop->loopvar[i]; ! index = fold_build2 (MULT_EXPR, gfc_array_index_type, index, ! info->stride[i]); ! index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index, ! info->delta[i]); ! break; ! default: ! gcc_unreachable (); } } else *************** gfc_conv_array_index_offset (gfc_se * se *** 1563,1574 **** gcc_assert (se->loop); index = se->loop->loopvar[se->loop->order[i]]; if (!integer_zerop (info->delta[i])) ! index = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! index, info->delta[i])); } /* Multiply by the stride. */ ! index = fold (build2 (MULT_EXPR, gfc_array_index_type, index, stride)); return index; } --- 1771,1782 ---- gcc_assert (se->loop); index = se->loop->loopvar[se->loop->order[i]]; if (!integer_zerop (info->delta[i])) ! index = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! index, info->delta[i]); } /* Multiply by the stride. */ ! index = fold_build2 (MULT_EXPR, gfc_array_index_type, index, stride); return index; } *************** gfc_conv_scalarized_array_ref (gfc_se * *** 1594,1600 **** info->stride0); /* Add the offset for this dimension to the stored offset for all other dimensions. */ ! index = fold (build2 (PLUS_EXPR, gfc_array_index_type, index, info->offset)); tmp = gfc_build_indirect_ref (info->data); se->expr = gfc_build_array_ref (tmp, index); --- 1802,1808 ---- info->stride0); /* Add the offset for this dimension to the stored offset for all other dimensions. */ ! index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index, info->offset); tmp = gfc_build_indirect_ref (info->data); se->expr = gfc_build_array_ref (tmp, index); *************** gfc_conv_array_ref (gfc_se * se, gfc_arr *** 1631,1636 **** --- 1839,1845 ---- if (ar->type != AR_ELEMENT) { gfc_conv_scalarized_array_ref (se, ar); + gfc_advance_se_ss_chain (se); return; } *************** gfc_conv_array_ref (gfc_se * se, gfc_arr *** 1642,1648 **** for (n = 0; n < ar->dimen; n++) { /* Calculate the index for this dimension. */ ! gfc_init_se (&indexse, NULL); gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type); gfc_add_block_to_block (&se->pre, &indexse.pre); --- 1851,1857 ---- for (n = 0; n < ar->dimen; n++) { /* Calculate the index for this dimension. */ ! gfc_init_se (&indexse, se); gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type); gfc_add_block_to_block (&se->pre, &indexse.pre); *************** gfc_conv_array_ref (gfc_se * se, gfc_arr *** 1654,1678 **** indexse.expr = gfc_evaluate_now (indexse.expr, &se->pre); tmp = gfc_conv_array_lbound (se->expr, n); ! cond = fold (build2 (LT_EXPR, boolean_type_node, ! indexse.expr, tmp)); fault = ! fold (build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond)); tmp = gfc_conv_array_ubound (se->expr, n); ! cond = fold (build2 (GT_EXPR, boolean_type_node, ! indexse.expr, tmp)); fault = ! fold (build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond)); } /* Multiply the index by the stride. */ stride = gfc_conv_array_stride (se->expr, n); ! tmp = fold (build2 (MULT_EXPR, gfc_array_index_type, indexse.expr, ! stride)); /* And add it to the total. */ ! index = fold (build2 (PLUS_EXPR, gfc_array_index_type, index, tmp)); } if (flag_bounds_check) --- 1863,1887 ---- indexse.expr = gfc_evaluate_now (indexse.expr, &se->pre); tmp = gfc_conv_array_lbound (se->expr, n); ! cond = fold_build2 (LT_EXPR, boolean_type_node, ! indexse.expr, tmp); fault = ! fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond); tmp = gfc_conv_array_ubound (se->expr, n); ! cond = fold_build2 (GT_EXPR, boolean_type_node, ! indexse.expr, tmp); fault = ! fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond); } /* Multiply the index by the stride. */ stride = gfc_conv_array_stride (se->expr, n); ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, indexse.expr, ! stride); /* And add it to the total. */ ! index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index, tmp); } if (flag_bounds_check) *************** gfc_conv_array_ref (gfc_se * se, gfc_arr *** 1680,1686 **** tmp = gfc_conv_array_offset (se->expr); if (!integer_zerop (tmp)) ! index = fold (build2 (PLUS_EXPR, gfc_array_index_type, index, tmp)); /* Access the calculated element. */ tmp = gfc_conv_array_data (se->expr); --- 1889,1895 ---- tmp = gfc_conv_array_offset (se->expr); if (!integer_zerop (tmp)) ! index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index, tmp); /* Access the calculated element. */ tmp = gfc_conv_array_data (se->expr); *************** gfc_trans_preloop_setup (gfc_loopinfo * *** 1741,1748 **** stride); gfc_add_block_to_block (pblock, &se.pre); ! info->offset = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! info->offset, index)); info->offset = gfc_evaluate_now (info->offset, pblock); } --- 1950,1957 ---- stride); gfc_add_block_to_block (pblock, &se.pre); ! info->offset = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! info->offset, index); info->offset = gfc_evaluate_now (info->offset, pblock); } *************** gfc_trans_preloop_setup (gfc_loopinfo * *** 1780,1787 **** index = gfc_conv_array_index_offset (&se, info, info->dim[i], i, ar, stride); gfc_add_block_to_block (pblock, &se.pre); ! info->offset = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! info->offset, index)); info->offset = gfc_evaluate_now (info->offset, pblock); } --- 1989,1996 ---- index = gfc_conv_array_index_offset (&se, info, info->dim[i], i, ar, stride); gfc_add_block_to_block (pblock, &se.pre); ! info->offset = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! info->offset, index); info->offset = gfc_evaluate_now (info->offset, pblock); } *************** static tree *** 1964,1990 **** gfc_conv_section_upper_bound (gfc_ss * ss, int n, stmtblock_t * pblock) { int dim; - gfc_ss *vecss; gfc_expr *end; tree desc; tree bound; gfc_se se; gcc_assert (ss->type == GFC_SS_SECTION); ! /* For vector array subscripts we want the size of the vector. */ ! dim = ss->data.info.dim[n]; ! vecss = ss; ! while (vecss->data.info.ref->u.ar.dimen_type[dim] == DIMEN_VECTOR) ! { ! vecss = vecss->data.info.subscript[dim]; ! gcc_assert (vecss && vecss->type == GFC_SS_VECTOR); ! dim = vecss->data.info.dim[0]; ! } ! gcc_assert (vecss->data.info.ref->u.ar.dimen_type[dim] == DIMEN_RANGE); ! end = vecss->data.info.ref->u.ar.end[dim]; ! desc = vecss->data.info.descriptor; if (end) { --- 2173,2197 ---- gfc_conv_section_upper_bound (gfc_ss * ss, int n, stmtblock_t * pblock) { int dim; gfc_expr *end; tree desc; tree bound; gfc_se se; + gfc_ss_info *info; gcc_assert (ss->type == GFC_SS_SECTION); ! info = &ss->data.info; ! dim = info->dim[n]; ! if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR) ! /* We'll calculate the upper bound once we have access to the ! vector's descriptor. */ ! return NULL; ! ! gcc_assert (info->ref->u.ar.dimen_type[dim] == DIMEN_RANGE); ! desc = info->descriptor; ! end = info->ref->u.ar.end[dim]; if (end) { *************** gfc_conv_section_startstride (gfc_loopin *** 2011,2042 **** { gfc_expr *start; gfc_expr *stride; - gfc_ss *vecss; tree desc; gfc_se se; gfc_ss_info *info; int dim; ! info = &ss->data.info; dim = info->dim[n]; ! /* For vector array subscripts we want the size of the vector. */ ! vecss = ss; ! while (vecss->data.info.ref->u.ar.dimen_type[dim] == DIMEN_VECTOR) { ! vecss = vecss->data.info.subscript[dim]; ! gcc_assert (vecss && vecss->type == GFC_SS_VECTOR); ! /* Get the descriptors for the vector subscripts as well. */ ! if (!vecss->data.info.descriptor) ! gfc_conv_ss_descriptor (&loop->pre, vecss, !loop->array_parameter); ! dim = vecss->data.info.dim[0]; } ! gcc_assert (vecss->data.info.ref->u.ar.dimen_type[dim] == DIMEN_RANGE); ! start = vecss->data.info.ref->u.ar.start[dim]; ! stride = vecss->data.info.ref->u.ar.stride[dim]; ! desc = vecss->data.info.descriptor; /* Calculate the start of the range. For vector subscripts this will be the range of the vector. */ --- 2218,2245 ---- { gfc_expr *start; gfc_expr *stride; tree desc; gfc_se se; gfc_ss_info *info; int dim; ! gcc_assert (ss->type == GFC_SS_SECTION); + info = &ss->data.info; dim = info->dim[n]; ! if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR) { ! /* We use a zero-based index to access the vector. */ ! info->start[n] = gfc_index_zero_node; ! info->stride[n] = gfc_index_one_node; ! return; } ! gcc_assert (info->ref->u.ar.dimen_type[dim] == DIMEN_RANGE); ! desc = info->descriptor; ! start = info->ref->u.ar.start[dim]; ! stride = info->ref->u.ar.stride[dim]; /* Calculate the start of the range. For vector subscripts this will be the range of the vector. */ *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 2078,2084 **** int n; tree tmp; gfc_ss *ss; - gfc_ss *vecss; tree desc; loop->dimen = 0; --- 2281,2286 ---- *************** gfc_conv_ss_startstride (gfc_loopinfo * *** 2159,2206 **** /* TODO: range checking for mapped dimensions. */ info = &ss->data.info; ! /* This only checks scalarized dimensions, elemental dimensions are ! checked later. */ for (n = 0; n < loop->dimen; n++) { dim = info->dim[n]; ! vecss = ss; ! while (vecss->data.info.ref->u.ar.dimen_type[dim] ! == DIMEN_VECTOR) ! { ! vecss = vecss->data.info.subscript[dim]; ! gcc_assert (vecss && vecss->type == GFC_SS_VECTOR); ! dim = vecss->data.info.dim[0]; ! } ! gcc_assert (vecss->data.info.ref->u.ar.dimen_type[dim] ! == DIMEN_RANGE); ! desc = vecss->data.info.descriptor; /* Check lower bound. */ bound = gfc_conv_array_lbound (desc, dim); tmp = info->start[n]; ! tmp = fold (build2 (LT_EXPR, boolean_type_node, tmp, bound)); ! fault = fold (build2 (TRUTH_OR_EXPR, boolean_type_node, fault, ! tmp)); /* Check the upper bound. */ bound = gfc_conv_array_ubound (desc, dim); end = gfc_conv_section_upper_bound (ss, n, &block); ! tmp = fold (build2 (GT_EXPR, boolean_type_node, end, bound)); ! fault = fold (build2 (TRUTH_OR_EXPR, boolean_type_node, fault, ! tmp)); /* Check the section sizes match. */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, end, ! info->start[n])); ! tmp = fold (build2 (FLOOR_DIV_EXPR, gfc_array_index_type, tmp, ! info->stride[n])); /* We remember the size of the first section, and check all the others against this. */ if (size[n]) { tmp = ! fold (build2 (NE_EXPR, boolean_type_node, tmp, size[n])); fault = build2 (TRUTH_OR_EXPR, boolean_type_node, fault, tmp); } --- 2361,2401 ---- /* TODO: range checking for mapped dimensions. */ info = &ss->data.info; ! /* This code only checks ranges. Elemental and vector ! dimensions are checked later. */ for (n = 0; n < loop->dimen; n++) { dim = info->dim[n]; ! if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE) ! continue; ! ! desc = ss->data.info.descriptor; /* Check lower bound. */ bound = gfc_conv_array_lbound (desc, dim); tmp = info->start[n]; ! tmp = fold_build2 (LT_EXPR, boolean_type_node, tmp, bound); ! fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, ! tmp); /* Check the upper bound. */ bound = gfc_conv_array_ubound (desc, dim); end = gfc_conv_section_upper_bound (ss, n, &block); ! tmp = fold_build2 (GT_EXPR, boolean_type_node, end, bound); ! fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, ! tmp); /* Check the section sizes match. */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end, ! info->start[n]); ! tmp = fold_build2 (FLOOR_DIV_EXPR, gfc_array_index_type, tmp, ! info->stride[n]); /* We remember the size of the first section, and check all the others against this. */ if (size[n]) { tmp = ! fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]); fault = build2 (TRUTH_OR_EXPR, boolean_type_node, fault, tmp); } *************** gfc_conv_resolve_dependencies (gfc_loopi *** 2349,2358 **** if (nDepend == 1) { loop->temp_ss = gfc_get_ss (); loop->temp_ss->type = GFC_SS_TEMP; ! loop->temp_ss->data.temp.type = ! gfc_get_element_type (TREE_TYPE (dest->data.info.descriptor)); loop->temp_ss->string_length = dest->string_length; loop->temp_ss->data.temp.dimen = loop->dimen; loop->temp_ss->next = gfc_ss_terminator; --- 2544,2556 ---- if (nDepend == 1) { + tree base_type = gfc_typenode_for_spec (&dest->expr->ts); + if (GFC_ARRAY_TYPE_P (base_type) + || GFC_DESCRIPTOR_TYPE_P (base_type)) + base_type = gfc_get_element_type (base_type); loop->temp_ss = gfc_get_ss (); loop->temp_ss->type = GFC_SS_TEMP; ! loop->temp_ss->data.temp.type = base_type; loop->temp_ss->string_length = dest->string_length; loop->temp_ss->data.temp.dimen = loop->dimen; loop->temp_ss->next = gfc_ss_terminator; *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2380,2385 **** --- 2578,2585 ---- tree tmp; tree len; gfc_ss *loopspec[GFC_MAX_DIMENSIONS]; + bool dynamic[GFC_MAX_DIMENSIONS]; + gfc_constructor *c; mpz_t *cshape; mpz_t i; *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2387,2392 **** --- 2587,2593 ---- for (n = 0; n < loop->dimen; n++) { loopspec[n] = NULL; + dynamic[n] = false; /* We use one SS term, and use that to determine the bounds of the loop for this dimension. We try to pick the simplest term. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2404,2420 **** Higher rank constructors will either have known shape, or still be wrapped in a call to reshape. */ gcc_assert (loop->dimen == 1); ! /* Try to figure out the size of the constructor. */ ! /* TODO: avoid this by making the frontend set the shape. */ ! gfc_get_array_cons_size (&i, ss->expr->value.constructor); ! /* A negative value means we failed. */ ! if (mpz_sgn (i) > 0) ! { ! mpz_sub_ui (i, i, 1); ! loop->to[n] = ! gfc_conv_mpz_to_tree (i, gfc_index_integer_kind); ! loopspec[n] = ss; ! } continue; } --- 2605,2619 ---- Higher rank constructors will either have known shape, or still be wrapped in a call to reshape. */ gcc_assert (loop->dimen == 1); ! ! /* Always prefer to use the constructor bounds if the size ! can be determined at compile time. Prefer not to otherwise, ! since the general case involves realloc, and it's better to ! avoid that overhead if possible. */ ! c = ss->expr->value.constructor; ! dynamic[n] = gfc_get_array_constructor_size (&i, c); ! if (!dynamic[n] || !loopspec[n]) ! loopspec[n] = ss; continue; } *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2435,2465 **** specinfo = NULL; info = &ss->data.info; /* Criteria for choosing a loop specifier (most important first): stride of one known stride known lower bound known upper bound */ ! if (!specinfo) loopspec[n] = ss; ! /* TODO: Is != constructor correct? */ ! else if (loopspec[n]->type != GFC_SS_CONSTRUCTOR) ! { ! if (integer_onep (info->stride[n]) ! && !integer_onep (specinfo->stride[n])) ! loopspec[n] = ss; ! else if (INTEGER_CST_P (info->stride[n]) ! && !INTEGER_CST_P (specinfo->stride[n])) ! loopspec[n] = ss; ! else if (INTEGER_CST_P (info->start[n]) ! && !INTEGER_CST_P (specinfo->start[n])) ! loopspec[n] = ss; ! /* We don't work out the upper bound. ! else if (INTEGER_CST_P (info->finish[n]) ! && ! INTEGER_CST_P (specinfo->finish[n])) ! loopspec[n] = ss; */ ! } } if (!loopspec[n]) --- 2634,2663 ---- specinfo = NULL; info = &ss->data.info; + if (!specinfo) + loopspec[n] = ss; /* Criteria for choosing a loop specifier (most important first): + doesn't need realloc stride of one known stride known lower bound known upper bound */ ! else if (loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n]) loopspec[n] = ss; ! else if (integer_onep (info->stride[n]) ! && !integer_onep (specinfo->stride[n])) ! loopspec[n] = ss; ! else if (INTEGER_CST_P (info->stride[n]) ! && !INTEGER_CST_P (specinfo->stride[n])) ! loopspec[n] = ss; ! else if (INTEGER_CST_P (info->start[n]) ! && !INTEGER_CST_P (specinfo->start[n])) ! loopspec[n] = ss; ! /* We don't work out the upper bound. ! else if (INTEGER_CST_P (info->finish[n]) ! && ! INTEGER_CST_P (specinfo->finish[n])) ! loopspec[n] = ss; */ } if (!loopspec[n]) *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2478,2487 **** /* To = from + (size - 1) * stride. */ tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind); if (!integer_onep (info->stride[n])) ! tmp = fold (build2 (MULT_EXPR, gfc_array_index_type, ! tmp, info->stride[n])); ! loop->to[n] = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! loop->from[n], tmp)); } else { --- 2676,2685 ---- /* To = from + (size - 1) * stride. */ tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind); if (!integer_onep (info->stride[n])) ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, ! tmp, info->stride[n]); ! loop->to[n] = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! loop->from[n], tmp); } else { *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2489,2496 **** switch (loopspec[n]->type) { case GFC_SS_CONSTRUCTOR: ! gcc_assert (info->dimen == 1); ! gcc_assert (loop->to[n]); break; case GFC_SS_SECTION: --- 2687,2695 ---- switch (loopspec[n]->type) { case GFC_SS_CONSTRUCTOR: ! /* The upper bound is calculated when we expand the ! constructor. */ ! gcc_assert (loop->to[n] == NULL_TREE); break; case GFC_SS_SECTION: *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2519,2528 **** with start = 0, this simplifies to last = end / step; for (i = 0; i<=last; i++){...}; */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! loop->to[n], loop->from[n])); ! tmp = fold (build2 (TRUNC_DIV_EXPR, gfc_array_index_type, ! tmp, info->stride[n])); loop->to[n] = gfc_evaluate_now (tmp, &loop->pre); /* Make the loop variable start at 0. */ loop->from[n] = gfc_index_zero_node; --- 2718,2727 ---- with start = 0, this simplifies to last = end / step; for (i = 0; i<=last; i++){...}; */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! loop->to[n], loop->from[n]); ! tmp = fold_build2 (TRUNC_DIV_EXPR, gfc_array_index_type, ! tmp, info->stride[n]); loop->to[n] = gfc_evaluate_now (tmp, &loop->pre); /* Make the loop variable start at 0. */ loop->from[n] = gfc_index_zero_node; *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2544,2550 **** memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info)); loop->temp_ss->type = GFC_SS_SECTION; loop->temp_ss->data.info.dimen = n; ! gfc_trans_allocate_temp_array (loop, &loop->temp_ss->data.info, tmp); } for (n = 0; n < loop->temp_dim; n++) --- 2743,2751 ---- memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info)); loop->temp_ss->type = GFC_SS_SECTION; loop->temp_ss->data.info.dimen = n; ! gfc_trans_allocate_temp_array (&loop->pre, &loop->post, loop, ! &loop->temp_ss->data.info, tmp, false, ! true); } for (n = 0; n < loop->temp_dim; n++) *************** gfc_conv_loop_setup (gfc_loopinfo * loop *** 2574,2585 **** { /* Calculate the offset relative to the loop variable. First multiply by the stride. */ ! tmp = fold (build2 (MULT_EXPR, gfc_array_index_type, ! loop->from[n], info->stride[n])); /* Then subtract this from our starting value. */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! info->start[n], tmp)); info->delta[n] = gfc_evaluate_now (tmp, &loop->pre); } --- 2775,2786 ---- { /* Calculate the offset relative to the loop variable. First multiply by the stride. */ ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, ! loop->from[n], info->stride[n]); /* Then subtract this from our starting value. */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! info->start[n], tmp); info->delta[n] = gfc_evaluate_now (tmp, &loop->pre); } *************** gfc_array_init_size (tree descriptor, in *** 2661,2668 **** gfc_add_modify_expr (pblock, tmp, se.expr); /* Work out the offset for this component. */ ! tmp = fold (build2 (MULT_EXPR, gfc_array_index_type, se.expr, stride)); ! offset = fold (build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp)); /* Start the calculation for the size of this dimension. */ size = build2 (MINUS_EXPR, gfc_array_index_type, --- 2862,2869 ---- gfc_add_modify_expr (pblock, tmp, se.expr); /* Work out the offset for this component. */ ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, se.expr, stride); ! offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp); /* Start the calculation for the size of this dimension. */ size = build2 (MINUS_EXPR, gfc_array_index_type, *************** gfc_array_init_size (tree descriptor, in *** 2682,2698 **** gfc_add_modify_expr (pblock, tmp, stride); /* Calculate the size of this dimension. */ ! size = fold (build2 (PLUS_EXPR, gfc_array_index_type, se.expr, size)); /* Multiply the stride by the number of elements in this dimension. */ ! stride = fold (build2 (MULT_EXPR, gfc_array_index_type, stride, size)); stride = gfc_evaluate_now (stride, pblock); } /* The stride is the number of elements in the array, so multiply by the size of an element to get the total size. */ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, stride, tmp)); if (poffset != NULL) { --- 2883,2899 ---- gfc_add_modify_expr (pblock, tmp, stride); /* Calculate the size of this dimension. */ ! size = fold_build2 (PLUS_EXPR, gfc_array_index_type, se.expr, size); /* Multiply the stride by the number of elements in this dimension. */ ! stride = fold_build2 (MULT_EXPR, gfc_array_index_type, stride, size); stride = gfc_evaluate_now (stride, pblock); } /* The stride is the number of elements in the array, so multiply by the size of an element to get the total size. */ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, stride, tmp); if (poffset != NULL) { *************** gfc_array_allocate (gfc_se * se, gfc_ref *** 2749,2757 **** lower, upper, &se->pre); /* Allocate memory to store the data. */ ! tmp = gfc_conv_descriptor_data (se->expr); ! pointer = gfc_build_addr_expr (NULL, tmp); ! pointer = gfc_evaluate_now (pointer, &se->pre); if (TYPE_PRECISION (gfc_array_index_type) == 32) allocate = gfor_fndecl_allocate; --- 2950,2957 ---- lower, upper, &se->pre); /* Allocate memory to store the data. */ ! tmp = gfc_conv_descriptor_data_addr (se->expr); ! pointer = gfc_evaluate_now (tmp, &se->pre); if (TYPE_PRECISION (gfc_array_index_type) == 32) allocate = gfor_fndecl_allocate; *************** gfc_array_allocate (gfc_se * se, gfc_ref *** 2766,2773 **** tmp = gfc_build_function_call (allocate, tmp); gfc_add_expr_to_block (&se->pre, tmp); - pointer = gfc_conv_descriptor_data (se->expr); - tmp = gfc_conv_descriptor_offset (se->expr); gfc_add_modify_expr (&se->pre, tmp, offset); } --- 2966,2971 ---- *************** gfc_array_deallocate (tree descriptor, t *** 2786,2795 **** gfc_start_block (&block); /* Get a pointer to the data. */ ! tmp = gfc_conv_descriptor_data (descriptor); ! tmp = gfc_build_addr_expr (NULL, tmp); ! var = gfc_create_var (TREE_TYPE (tmp), "ptr"); ! gfc_add_modify_expr (&block, var, tmp); /* Parameter is the address of the data component. */ tmp = gfc_chainon_list (NULL_TREE, var); --- 2984,2991 ---- gfc_start_block (&block); /* Get a pointer to the data. */ ! tmp = gfc_conv_descriptor_data_addr (descriptor); ! var = gfc_evaluate_now (tmp, &block); /* Parameter is the address of the data component. */ tmp = gfc_chainon_list (NULL_TREE, var); *************** tree *** 2808,2822 **** gfc_conv_array_initializer (tree type, gfc_expr * expr) { gfc_constructor *c; - tree list; tree tmp; mpz_t maxval; gfc_se se; HOST_WIDE_INT hi; unsigned HOST_WIDE_INT lo; tree index, range; - list = NULL_TREE; switch (expr->expr_type) { case EXPR_CONSTANT: --- 3004,3017 ---- gfc_conv_array_initializer (tree type, gfc_expr * expr) { gfc_constructor *c; tree tmp; mpz_t maxval; gfc_se se; HOST_WIDE_INT hi; unsigned HOST_WIDE_INT lo; tree index, range; + VEC(constructor_elt,gc) *v = NULL; switch (expr->expr_type) { case EXPR_CONSTANT: *************** gfc_conv_array_initializer (tree type, g *** 2840,2846 **** /* This will probably eat buckets of memory for large arrays. */ while (hi != 0 || lo != 0) { ! list = tree_cons (NULL_TREE, se.expr, list); if (lo == 0) hi--; lo--; --- 3035,3041 ---- /* This will probably eat buckets of memory for large arrays. */ while (hi != 0 || lo != 0) { ! CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, se.expr); if (lo == 0) hi--; lo--; *************** gfc_conv_array_initializer (tree type, g *** 2848,2854 **** break; case EXPR_ARRAY: ! /* Create a list of all the elements. */ for (c = expr->value.constructor; c; c = c->next) { if (c->iterator) --- 3043,3049 ---- break; case EXPR_ARRAY: ! /* Create a vector of all the elements. */ for (c = expr->value.constructor; c; c = c->next) { if (c->iterator) *************** gfc_conv_array_initializer (tree type, g *** 2892,2917 **** case EXPR_CONSTANT: gfc_conv_constant (&se, c->expr); if (range == NULL_TREE) ! list = tree_cons (index, se.expr, list); else { if (index != NULL_TREE) ! list = tree_cons (index, se.expr, list); ! list = tree_cons (range, se.expr, list); } break; case EXPR_STRUCTURE: gfc_conv_structure (&se, c->expr, 1); ! list = tree_cons (index, se.expr, list); break; default: gcc_unreachable (); } } - /* We created the list in reverse order. */ - list = nreverse (list); break; default: --- 3087,3110 ---- case EXPR_CONSTANT: gfc_conv_constant (&se, c->expr); if (range == NULL_TREE) ! CONSTRUCTOR_APPEND_ELT (v, index, se.expr); else { if (index != NULL_TREE) ! CONSTRUCTOR_APPEND_ELT (v, index, se.expr); ! CONSTRUCTOR_APPEND_ELT (v, range, se.expr); } break; case EXPR_STRUCTURE: gfc_conv_structure (&se, c->expr, 1); ! CONSTRUCTOR_APPEND_ELT (v, index, se.expr); break; default: gcc_unreachable (); } } break; default: *************** gfc_conv_array_initializer (tree type, g *** 2919,2925 **** } /* Create a constructor from the list of elements. */ ! tmp = build1 (CONSTRUCTOR, type, list); TREE_CONSTANT (tmp) = 1; TREE_INVARIANT (tmp) = 1; return tmp; --- 3112,3118 ---- } /* Create a constructor from the list of elements. */ ! tmp = build_constructor (type, v); TREE_CONSTANT (tmp) = 1; TREE_INVARIANT (tmp) = 1; return tmp; *************** gfc_trans_array_bounds (tree type, gfc_s *** 2968,2975 **** gfc_add_modify_expr (pblock, ubound, se.expr); } /* The offset of this dimension. offset = offset - lbound * stride. */ ! tmp = fold (build2 (MULT_EXPR, gfc_array_index_type, lbound, size)); ! offset = fold (build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp)); /* The size of this dimension, and the stride of the next. */ if (dim + 1 < as->rank) --- 3161,3168 ---- gfc_add_modify_expr (pblock, ubound, se.expr); } /* The offset of this dimension. offset = offset - lbound * stride. */ ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, lbound, size); ! offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp); /* The size of this dimension, and the stride of the next. */ if (dim + 1 < as->rank) *************** gfc_trans_array_bounds (tree type, gfc_s *** 2980,2989 **** if (ubound != NULL_TREE && !(stride && INTEGER_CST_P (stride))) { /* Calculate stride = size * (ubound + 1 - lbound). */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, lbound)); ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ubound, tmp)); ! tmp = fold (build2 (MULT_EXPR, gfc_array_index_type, size, tmp)); if (stride) gfc_add_modify_expr (pblock, stride, tmp); else --- 3173,3182 ---- if (ubound != NULL_TREE && !(stride && INTEGER_CST_P (stride))) { /* Calculate stride = size * (ubound + 1 - lbound). */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, lbound); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ubound, tmp); ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); if (stride) gfc_add_modify_expr (pblock, stride, tmp); else *************** gfc_trans_auto_array_allocation (tree de *** 3053,3062 **** size = gfc_trans_array_bounds (type, sym, &offset, &block); /* The size is the number of elements in the array, so multiply by the size of an element to get the total size. */ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, size, tmp)); /* Allocate memory to hold the data. */ tmp = gfc_chainon_list (NULL_TREE, size); --- 3246,3264 ---- size = gfc_trans_array_bounds (type, sym, &offset, &block); + /* Don't actually allocate space for Cray Pointees. */ + if (sym->attr.cray_pointee) + { + if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) + gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), offset); + gfc_add_expr_to_block (&block, fnbody); + return gfc_finish_block (&block); + } + /* The size is the number of elements in the array, so multiply by the size of an element to get the total size. */ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); /* Allocate memory to hold the data. */ tmp = gfc_chainon_list (NULL_TREE, size); *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 3214,3220 **** partial = gfc_create_var (boolean_type_node, "partial"); TREE_USED (partial) = 1; tmp = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]); ! tmp = fold (build2 (EQ_EXPR, boolean_type_node, tmp, integer_one_node)); gfc_add_modify_expr (&block, partial, tmp); } else --- 3416,3422 ---- partial = gfc_create_var (boolean_type_node, "partial"); TREE_USED (partial) = 1; tmp = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]); ! tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, integer_one_node); gfc_add_modify_expr (&block, partial, tmp); } else *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 3253,3259 **** /* This is for the case where the array data is used directly without calling the repack function. */ if (no_repack || partial != NULL_TREE) ! stmt_packed = gfc_conv_descriptor_data (dumdesc); else stmt_packed = NULL_TREE; --- 3455,3461 ---- /* This is for the case where the array data is used directly without calling the repack function. */ if (no_repack || partial != NULL_TREE) ! stmt_packed = gfc_conv_descriptor_data_get (dumdesc); else stmt_packed = NULL_TREE; *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 3315,3325 **** { /* Check (ubound(a) - lbound(a) == ubound(b) - lbound(b)). */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! ubound, lbound)); stride = build2 (MINUS_EXPR, gfc_array_index_type, dubound, dlbound); ! tmp = fold (build2 (NE_EXPR, gfc_array_index_type, tmp, stride)); gfc_trans_runtime_check (tmp, gfc_strconst_bounds, &block); } } --- 3517,3527 ---- { /* Check (ubound(a) - lbound(a) == ubound(b) - lbound(b)). */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! ubound, lbound); stride = build2 (MINUS_EXPR, gfc_array_index_type, dubound, dlbound); ! tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride); gfc_trans_runtime_check (tmp, gfc_strconst_bounds, &block); } } *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 3328,3339 **** /* For assumed shape arrays move the upper bound by the same amount as the lower bound. */ tmp = build2 (MINUS_EXPR, gfc_array_index_type, dubound, dlbound); ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, tmp, lbound)); gfc_add_modify_expr (&block, ubound, tmp); } /* The offset of this dimension. offset = offset - lbound * stride. */ ! tmp = fold (build2 (MULT_EXPR, gfc_array_index_type, lbound, stride)); ! offset = fold (build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp)); /* The size of this dimension, and the stride of the next. */ if (n + 1 < sym->as->rank) --- 3530,3541 ---- /* For assumed shape arrays move the upper bound by the same amount as the lower bound. */ tmp = build2 (MINUS_EXPR, gfc_array_index_type, dubound, dlbound); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, lbound); gfc_add_modify_expr (&block, ubound, tmp); } /* The offset of this dimension. offset = offset - lbound * stride. */ ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, lbound, stride); ! offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp); /* The size of this dimension, and the stride of the next. */ if (n + 1 < sym->as->rank) *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 3354,3365 **** else { /* Calculate stride = size * (ubound + 1 - lbound). */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, lbound)); ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! ubound, tmp)); ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, ! size, tmp)); stmt_packed = size; } --- 3556,3567 ---- else { /* Calculate stride = size * (ubound + 1 - lbound). */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, lbound); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! ubound, tmp); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, ! size, tmp); stmt_packed = size; } *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 3420,3426 **** /* Only do the cleanup if the array was repacked. */ tmp = gfc_build_indirect_ref (dumdesc); ! tmp = gfc_conv_descriptor_data (tmp); tmp = build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc); stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); --- 3622,3628 ---- /* Only do the cleanup if the array was repacked. */ tmp = gfc_build_indirect_ref (dumdesc); ! tmp = gfc_conv_descriptor_data_get (tmp); tmp = build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc); stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); *************** gfc_trans_dummy_array_bias (gfc_symbol * *** 3437,3447 **** } ! /* Convert an array for passing as an actual parameter. Expressions and vector subscripts are evaluated and stored in a temporary, which is then passed. For whole arrays the descriptor is passed. For array sections a modified copy of the descriptor is passed, but using the original data. ! Also used for array pointer assignments by setting se->direct_byref. */ void gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) --- 3639,3666 ---- } ! /* Convert an array for passing as an actual argument. Expressions and vector subscripts are evaluated and stored in a temporary, which is then passed. For whole arrays the descriptor is passed. For array sections a modified copy of the descriptor is passed, but using the original data. ! ! This function is also used for array pointer assignments, and there ! are three cases: ! ! - want_pointer && !se->direct_byref ! EXPR is an actual argument. On exit, se->expr contains a ! pointer to the array descriptor. ! ! - !want_pointer && !se->direct_byref ! EXPR is an actual argument to an intrinsic function or the ! left-hand side of a pointer assignment. On exit, se->expr ! contains the descriptor for EXPR. ! ! - !want_pointer && se->direct_byref ! EXPR is the right-hand side of a pointer assignment and ! se->expr is the descriptor for the previously-evaluated ! left-hand side. The function creates an assignment from ! EXPR to se->expr. */ void gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3457,3463 **** tree start; tree offset; int full; - gfc_ss *vss; gfc_ref *ref; gcc_assert (ss != gfc_ss_terminator); --- 3676,3681 ---- *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3476,3496 **** secss = secss->next; gcc_assert (secss != gfc_ss_terminator); - - need_tmp = 0; - for (n = 0; n < secss->data.info.dimen; n++) - { - vss = secss->data.info.subscript[secss->data.info.dim[n]]; - if (vss && vss->type == GFC_SS_VECTOR) - need_tmp = 1; - } - info = &secss->data.info; /* Get the descriptor for the array. */ gfc_conv_ss_descriptor (&se->pre, secss, 0); desc = info->descriptor; ! if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) { /* Create a new descriptor if the array doesn't have one. */ full = 0; --- 3694,3709 ---- secss = secss->next; gcc_assert (secss != gfc_ss_terminator); info = &secss->data.info; /* Get the descriptor for the array. */ gfc_conv_ss_descriptor (&se->pre, secss, 0); desc = info->descriptor; ! ! need_tmp = gfc_ref_needs_temporary_p (expr->ref); ! if (need_tmp) ! full = 0; ! else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) { /* Create a new descriptor if the array doesn't have one. */ full = 0; *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3520,3542 **** } } - /* Check for substring references. */ - ref = expr->ref; - if (!need_tmp && ref && expr->ts.type == BT_CHARACTER) - { - while (ref->next) - ref = ref->next; - if (ref->type == REF_SUBSTRING) - { - /* In general character substrings need a copy. Character - array strides are expressed as multiples of the element - size (consistent with other array types), not in - characters. */ - full = 0; - need_tmp = 1; - } - } - if (full) { if (se->direct_byref) --- 3733,3738 ---- *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3616,3622 **** if (!need_tmp) loop.array_parameter = 1; else ! gcc_assert (se->want_pointer && !se->direct_byref); /* Setup the scalarizing loops and bounds. */ gfc_conv_ss_startstride (&loop); --- 3812,3819 ---- if (!need_tmp) loop.array_parameter = 1; else ! /* The right-hand side of a pointer assignment mustn't use a temporary. */ ! gcc_assert (!se->direct_byref); /* Setup the scalarizing loops and bounds. */ gfc_conv_ss_startstride (&loop); *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3697,3715 **** gfc_add_modify_expr (&loop.pre, tmp, gfc_index_zero_node); gcc_assert (is_gimple_lvalue (desc)); - se->expr = gfc_build_addr_expr (NULL, desc); } else if (expr->expr_type == EXPR_FUNCTION) { desc = info->descriptor; ! ! if (se->want_pointer) ! se->expr = gfc_build_addr_expr (NULL_TREE, desc); ! else ! se->expr = desc; ! ! if (expr->ts.type == BT_CHARACTER) ! se->string_length = expr->symtree->n.sym->ts.cl->backend_decl; } else { --- 3894,3904 ---- gfc_add_modify_expr (&loop.pre, tmp, gfc_index_zero_node); gcc_assert (is_gimple_lvalue (desc)); } else if (expr->expr_type == EXPR_FUNCTION) { desc = info->descriptor; ! se->string_length = ss->string_length; } else { *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3790,3799 **** } tmp = gfc_conv_array_lbound (desc, n); ! tmp = fold (build2 (MINUS_EXPR, TREE_TYPE (tmp), start, tmp)); ! tmp = fold (build2 (MULT_EXPR, TREE_TYPE (tmp), tmp, stride)); ! offset = fold (build2 (PLUS_EXPR, TREE_TYPE (tmp), offset, tmp)); if (info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT) { --- 3979,3988 ---- } tmp = gfc_conv_array_lbound (desc, n); ! tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (tmp), start, tmp); ! tmp = fold_build2 (MULT_EXPR, TREE_TYPE (tmp), tmp, stride); ! offset = fold_build2 (PLUS_EXPR, TREE_TYPE (tmp), offset, tmp); if (info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT) { *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3807,3818 **** /* Set the new lower bound. */ from = loop.from[dim]; to = loop.to[dim]; ! if (!integer_onep (from)) { ! /* Make sure the new section starts at 1. */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, from)); ! to = fold (build2 (PLUS_EXPR, gfc_array_index_type, to, tmp)); from = gfc_index_one_node; } tmp = gfc_conv_descriptor_lbound (parm, gfc_rank_cst[dim]); --- 3996,4011 ---- /* Set the new lower bound. */ from = loop.from[dim]; to = loop.to[dim]; ! ! /* If we have an array section or are assigning to a pointer, ! make sure that the lower bound is 1. References to the full ! array should otherwise keep the original bounds. */ ! if ((info->ref->u.ar.type != AR_FULL || se->direct_byref) ! && !integer_onep (from)) { ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, from); ! to = fold_build2 (PLUS_EXPR, gfc_array_index_type, to, tmp); from = gfc_index_one_node; } tmp = gfc_conv_descriptor_lbound (parm, gfc_rank_cst[dim]); *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3824,3835 **** /* Multiply the stride by the section stride to get the total stride. */ ! stride = fold (build2 (MULT_EXPR, gfc_array_index_type, ! stride, info->stride[dim])); if (se->direct_byref) ! base = fold (build2 (MINUS_EXPR, TREE_TYPE (base), ! base, stride)); /* Store the new stride. */ tmp = gfc_conv_descriptor_stride (parm, gfc_rank_cst[dim]); --- 4017,4028 ---- /* Multiply the stride by the section stride to get the total stride. */ ! stride = fold_build2 (MULT_EXPR, gfc_array_index_type, ! stride, info->stride[dim]); if (se->direct_byref) ! base = fold_build2 (MINUS_EXPR, TREE_TYPE (base), ! base, stride); /* Store the new stride. */ tmp = gfc_conv_descriptor_stride (parm, gfc_rank_cst[dim]); *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3843,3852 **** tmp = gfc_build_indirect_ref (tmp); tmp = gfc_build_array_ref (tmp, offset); offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp); ! ! tmp = gfc_conv_descriptor_data (parm); ! gfc_add_modify_expr (&loop.pre, tmp, ! fold_convert (TREE_TYPE (tmp), offset)); if (se->direct_byref) { --- 4036,4042 ---- tmp = gfc_build_indirect_ref (tmp); tmp = gfc_build_array_ref (tmp, offset); offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp); ! gfc_conv_descriptor_data_set (&loop.pre, parm, offset); if (se->direct_byref) { *************** gfc_conv_expr_descriptor (gfc_se * se, g *** 3861,3875 **** tmp = gfc_conv_descriptor_offset (parm); gfc_add_modify_expr (&loop.pre, tmp, gfc_index_zero_node); } ! if (!se->direct_byref) ! { ! /* Get a pointer to the new descriptor. */ ! if (se->want_pointer) ! se->expr = gfc_build_addr_expr (NULL, parm); ! else ! se->expr = parm; ! } } gfc_add_block_to_block (&se->pre, &loop.pre); --- 4051,4066 ---- tmp = gfc_conv_descriptor_offset (parm); gfc_add_modify_expr (&loop.pre, tmp, gfc_index_zero_node); } + desc = parm; + } ! if (!se->direct_byref) ! { ! /* Get a pointer to the new descriptor. */ ! if (se->want_pointer) ! se->expr = gfc_build_addr_expr (NULL, desc); ! else ! se->expr = desc; } gfc_add_block_to_block (&se->pre, &loop.pre); *************** gfc_conv_array_parameter (gfc_se * se, g *** 3899,3904 **** --- 4090,4096 ---- { sym = expr->symtree->n.sym; tmp = gfc_get_symbol_decl (sym); + if (sym->ts.type == BT_CHARACTER) se->string_length = sym->ts.cl->backend_decl; if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE *************** gfc_conv_array_parameter (gfc_se * se, g *** 3964,3970 **** } ! /* NULLIFY an allocated/pointer array on function entry, free it on exit. */ tree gfc_trans_deferred_array (gfc_symbol * sym, tree body) --- 4156,4162 ---- } ! /* NULLIFY an allocatable/pointer array on function entry, free it on exit. */ tree gfc_trans_deferred_array (gfc_symbol * sym, tree body) *************** gfc_trans_deferred_array (gfc_symbol * s *** 3984,3995 **** gfc_init_block (&fnblock); ! gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL); if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) gfc_trans_init_string_length (sym->ts.cl, &fnblock); ! /* Parameter and use associated variables don't need anything special. */ if (sym->attr.dummy || sym->attr.use_assoc) { gfc_add_expr_to_block (&fnblock, body); --- 4176,4189 ---- gfc_init_block (&fnblock); ! gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL ! || TREE_CODE (sym->backend_decl) == PARM_DECL); ! if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) gfc_trans_init_string_length (sym->ts.cl, &fnblock); ! /* Dummy and use associated variables don't need anything special. */ if (sym->attr.dummy || sym->attr.use_assoc) { gfc_add_expr_to_block (&fnblock, body); *************** gfc_trans_deferred_array (gfc_symbol * s *** 4013,4021 **** gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); /* NULLIFY the data pointer. */ ! tmp = gfc_conv_descriptor_data (descriptor); ! gfc_add_modify_expr (&fnblock, tmp, ! convert (TREE_TYPE (tmp), integer_zero_node)); gfc_add_expr_to_block (&fnblock, body); --- 4207,4213 ---- gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); /* NULLIFY the data pointer. */ ! gfc_conv_descriptor_data_set (&fnblock, descriptor, null_pointer_node); gfc_add_expr_to_block (&fnblock, body); *************** gfc_trans_deferred_array (gfc_symbol * s *** 4028,4034 **** /* Deallocate if still allocated at the end of the procedure. */ deallocate = gfc_array_deallocate (descriptor, null_pointer_node); ! tmp = gfc_conv_descriptor_data (descriptor); tmp = build2 (NE_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); tmp = build3_v (COND_EXPR, tmp, deallocate, build_empty_stmt ()); --- 4220,4226 ---- /* Deallocate if still allocated at the end of the procedure. */ deallocate = gfc_array_deallocate (descriptor, null_pointer_node); ! tmp = gfc_conv_descriptor_data_get (descriptor); tmp = build2 (NE_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); tmp = build3_v (COND_EXPR, tmp, deallocate, build_empty_stmt ()); *************** gfc_walk_variable_expr (gfc_ss * ss, gfc *** 4066,4073 **** int n; for (ref = expr->ref; ref; ref = ref->next) { ! /* We're only interested in array sections. */ if (ref->type != REF_ARRAY) continue; --- 4258,4284 ---- int n; for (ref = expr->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) + break; + + for (; ref; ref = ref->next) { ! if (ref->type == REF_SUBSTRING) ! { ! newss = gfc_get_ss (); ! newss->type = GFC_SS_SCALAR; ! newss->expr = ref->u.ss.start; ! newss->next = ss; ! ss = newss; ! ! newss = gfc_get_ss (); ! newss->type = GFC_SS_SCALAR; ! newss->expr = ref->u.ss.end; ! newss->next = ss; ! ss = newss; ! } ! ! /* We're only interested in array sections from now on. */ if (ref->type != REF_ARRAY) continue; *************** gfc_walk_variable_expr (gfc_ss * ss, gfc *** 4075,4082 **** switch (ar->type) { case AR_ELEMENT: ! /* TODO: Take elemental array references out of scalarization ! loop. */ break; case AR_FULL: --- 4286,4299 ---- switch (ar->type) { case AR_ELEMENT: ! for (n = 0; n < ar->dimen; n++) ! { ! newss = gfc_get_ss (); ! newss->type = GFC_SS_SCALAR; ! newss->expr = ar->start[n]; ! newss->next = ss; ! ss = newss; ! } break; case AR_FULL: *************** gfc_walk_variable_expr (gfc_ss * ss, gfc *** 4099,4105 **** gcc_assert (ar->end[n] == NULL); gcc_assert (ar->stride[n] == NULL); } ! return newss; case AR_SECTION: newss = gfc_get_ss (); --- 4316,4323 ---- gcc_assert (ar->end[n] == NULL); gcc_assert (ar->stride[n] == NULL); } ! ss = newss; ! break; case AR_SECTION: newss = gfc_get_ss (); *************** gfc_walk_variable_expr (gfc_ss * ss, gfc *** 4137,4160 **** break; case DIMEN_VECTOR: ! /* Get a SS for the vector. This will not be added to the ! chain directly. */ ! indexss = gfc_walk_expr (ar->start[n]); ! if (indexss == gfc_ss_terminator) ! internal_error ("scalar vector subscript???"); ! ! /* We currently only handle really simple vector ! subscripts. */ ! if (indexss->next != gfc_ss_terminator) ! gfc_todo_error ("vector subscript expressions"); ! indexss->loop_chain = gfc_ss_terminator; ! ! /* Mark this as a vector subscript. We don't add this ! directly into the chain, but as a subscript of the ! existing SS for this term. */ indexss->type = GFC_SS_VECTOR; newss->data.info.subscript[n] = indexss; - /* Also remember this dimension. */ newss->data.info.dim[newss->data.info.dimen] = n; newss->data.info.dimen++; break; --- 4355,4368 ---- break; case DIMEN_VECTOR: ! /* Create a GFC_SS_VECTOR index in which we can store ! the vector's descriptor. */ ! indexss = gfc_get_ss (); indexss->type = GFC_SS_VECTOR; + indexss->expr = ar->start[n]; + indexss->next = gfc_ss_terminator; + indexss->loop_chain = gfc_ss_terminator; newss->data.info.subscript[n] = indexss; newss->data.info.dim[newss->data.info.dimen] = n; newss->data.info.dimen++; break; *************** gfc_walk_variable_expr (gfc_ss * ss, gfc *** 4166,4172 **** } /* We should have at least one non-elemental dimension. */ gcc_assert (newss->data.info.dimen > 0); ! return head; break; default: --- 4374,4380 ---- } /* We should have at least one non-elemental dimension. */ gcc_assert (newss->data.info.dimen > 0); ! ss = newss; break; default: *************** gfc_walk_op_expr (gfc_ss * ss, gfc_expr *** 4235,4241 **** /* Reverse a SS chain. */ ! static gfc_ss * gfc_reverse_ss (gfc_ss * ss) { gfc_ss *next; --- 4443,4449 ---- /* Reverse a SS chain. */ ! gfc_ss * gfc_reverse_ss (gfc_ss * ss) { gfc_ss *next; *************** gfc_reverse_ss (gfc_ss * ss) *** 4261,4270 **** /* Walk the arguments of an elemental function. */ gfc_ss * ! gfc_walk_elemental_function_args (gfc_ss * ss, gfc_expr * expr, gfc_ss_type type) { - gfc_actual_arglist *arg; int scalar; gfc_ss *head; gfc_ss *tail; --- 4469,4477 ---- /* Walk the arguments of an elemental function. */ gfc_ss * ! gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, gfc_ss_type type) { int scalar; gfc_ss *head; gfc_ss *tail; *************** gfc_walk_elemental_function_args (gfc_ss *** 4273,4279 **** head = gfc_ss_terminator; tail = NULL; scalar = 1; ! for (arg = expr->value.function.actual; arg; arg = arg->next) { if (!arg->expr) continue; --- 4480,4486 ---- head = gfc_ss_terminator; tail = NULL; scalar = 1; ! for (; arg; arg = arg->next) { if (!arg->expr) continue; *************** gfc_walk_function_expr (gfc_ss * ss, gfc *** 4350,4356 **** /* Walk the parameters of an elemental function. For now we always pass by reference. */ if (sym->attr.elemental) ! return gfc_walk_elemental_function_args (ss, expr, GFC_SS_REFERENCE); /* Scalar functions are OK as these are evaluated outside the scalarization loop. Pass back and let the caller deal with it. */ --- 4557,4564 ---- /* Walk the parameters of an elemental function. For now we always pass by reference. */ if (sym->attr.elemental) ! return gfc_walk_elemental_function_args (ss, expr->value.function.actual, ! GFC_SS_REFERENCE); /* Scalar functions are OK as these are evaluated outside the scalarization loop. Pass back and let the caller deal with it. */ *************** gfc_walk_array_constructor (gfc_ss * ss, *** 4379,4385 **** /* Walk an expression. Add walked expressions to the head of the SS chain. ! A wholy scalar expression will not be added. */ static gfc_ss * gfc_walk_subexpr (gfc_ss * ss, gfc_expr * expr) --- 4587,4593 ---- /* Walk an expression. Add walked expressions to the head of the SS chain. ! A wholly scalar expression will not be added. */ static gfc_ss * gfc_walk_subexpr (gfc_ss * ss, gfc_expr * expr) *************** gfc_walk_expr (gfc_expr * expr) *** 4435,4438 **** res = gfc_walk_subexpr (gfc_ss_terminator, expr); return gfc_reverse_ss (res); } - --- 4643,4645 ---- diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-array.h gcc-4.1.0/gcc/fortran/trans-array.h *** gcc-4.0.2/gcc/fortran/trans-array.h Fri Jul 8 21:19:28 2005 --- gcc-4.1.0/gcc/fortran/trans-array.h Tue Feb 14 17:34:07 2006 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Generate code to free an array. */ tree gfc_array_deallocate (tree, tree); --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Generate code to free an array. */ tree gfc_array_deallocate (tree, tree); *************** tree gfc_array_deallocate (tree, tree); *** 26,33 **** se, which should contain an expression for the array descriptor. */ void gfc_array_allocate (gfc_se *, gfc_ref *, tree); /* Generate code to allocate a temporary array. */ ! tree gfc_trans_allocate_temp_array (gfc_loopinfo *, gfc_ss_info *, tree); /* Generate function entry code for allocation of compiler allocated array variables. */ --- 26,39 ---- se, which should contain an expression for the array descriptor. */ void gfc_array_allocate (gfc_se *, gfc_ref *, tree); + /* Allow the bounds of a loop to be set from a callee's array spec. */ + void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, + gfc_se *, gfc_array_spec *); + /* Generate code to allocate a temporary array. */ ! tree gfc_trans_allocate_temp_array (stmtblock_t *, stmtblock_t *, ! gfc_loopinfo *, gfc_ss_info *, tree, bool, ! bool); /* Generate function entry code for allocation of compiler allocated array variables. */ *************** void gfc_trans_static_array_pointer (gfc *** 43,53 **** /* Generate scalarization information for an expression. */ gfc_ss *gfc_walk_expr (gfc_expr *); ! /* Walk the arguments of an intrinsic function. */ ! gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_expr *, gfc_ss_type); /* Walk an intrinsic function. */ gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *, gfc_intrinsic_sym *); /* Free the SS associated with a loop. */ void gfc_cleanup_loop (gfc_loopinfo *); --- 49,62 ---- /* Generate scalarization information for an expression. */ gfc_ss *gfc_walk_expr (gfc_expr *); ! /* Walk the arguments of an elemental function. */ ! gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *, ! gfc_ss_type); /* Walk an intrinsic function. */ gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *, gfc_intrinsic_sym *); + /* Reverse the order of an SS chain. */ + gfc_ss *gfc_reverse_ss (gfc_ss *); /* Free the SS associated with a loop. */ void gfc_cleanup_loop (gfc_loopinfo *); *************** void gfc_trans_scalarized_loop_boundary *** 72,78 **** void gfc_conv_loop_setup (gfc_loopinfo *); /* Resolve array assignment dependencies. */ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); ! /* Build an null array descriptor constructor. */ tree gfc_build_null_descriptor (tree); /* Get a single array element. */ --- 81,87 ---- void gfc_conv_loop_setup (gfc_loopinfo *); /* Resolve array assignment dependencies. */ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); ! /* Build a null array descriptor constructor. */ tree gfc_build_null_descriptor (tree); /* Get a single array element. */ *************** tree gfc_conv_array_lbound (tree, int); *** 96,102 **** tree gfc_conv_array_ubound (tree, int); /* Build expressions for accessing components of an array descriptor. */ ! tree gfc_conv_descriptor_data (tree); tree gfc_conv_descriptor_offset (tree); tree gfc_conv_descriptor_dtype (tree); tree gfc_conv_descriptor_stride (tree, tree); --- 105,113 ---- tree gfc_conv_array_ubound (tree, int); /* Build expressions for accessing components of an array descriptor. */ ! tree gfc_conv_descriptor_data_get (tree); ! void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree); ! tree gfc_conv_descriptor_data_addr (tree); tree gfc_conv_descriptor_offset (tree); tree gfc_conv_descriptor_dtype (tree); tree gfc_conv_descriptor_stride (tree, tree); diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-common.c gcc-4.1.0/gcc/fortran/trans-common.c *** gcc-4.0.2/gcc/fortran/trans-common.c Fri Sep 9 09:05:53 2005 --- gcc-4.1.0/gcc/fortran/trans-common.c Wed Oct 12 06:18:12 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* The core algorithm is based on Andy Vaught's g95 tree. Also the way to build UNION_TYPE is borrowed from Richard Henderson. --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* The core algorithm is based on Andy Vaught's g95 tree. Also the way to build UNION_TYPE is borrowed from Richard Henderson. *************** Software Foundation, 59 Temple Place - S *** 105,111 **** #include "trans-const.h" ! /* Holds a single variable in a equivalence set. */ typedef struct segment_info { gfc_symbol *sym; --- 105,111 ---- #include "trans-const.h" ! /* Holds a single variable in an equivalence set. */ typedef struct segment_info { gfc_symbol *sym; *************** build_field (segment_info *h, tree union *** 241,247 **** DECL_FIELD_OFFSET (field), DECL_SIZE_UNIT (field))); /* If this field is assigned to a label, we create another two variables. ! One will hold the address of taget label or format label. The other will hold the length of format label string. */ if (h->sym->attr.assign) { --- 241,247 ---- DECL_FIELD_OFFSET (field), DECL_SIZE_UNIT (field))); /* If this field is assigned to a label, we create another two variables. ! One will hold the address of target label or format label. The other will hold the length of format label string. */ if (h->sym->attr.assign) { *************** build_field (segment_info *h, tree union *** 268,274 **** /* Get storage for local equivalence. */ static tree ! build_equiv_decl (tree union_type, bool is_init) { tree decl; char name[15]; --- 268,274 ---- /* Get storage for local equivalence. */ static tree ! build_equiv_decl (tree union_type, bool is_init, bool is_saved) { tree decl; char name[15]; *************** build_equiv_decl (tree union_type, bool *** 286,292 **** DECL_ARTIFICIAL (decl) = 1; DECL_IGNORED_P (decl) = 1; ! if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))) TREE_STATIC (decl) = 1; TREE_ADDRESSABLE (decl) = 1; --- 286,293 ---- DECL_ARTIFICIAL (decl) = 1; DECL_IGNORED_P (decl) = 1; ! if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) ! || is_saved) TREE_STATIC (decl) = 1; TREE_ADDRESSABLE (decl) = 1; *************** create_common (gfc_common_head *com, seg *** 385,390 **** --- 386,392 ---- record_layout_info rli; tree decl; bool is_init = false; + bool is_saved = false; /* Declare the variables inside the common block. If the current common block contains any equivalence object, then *************** create_common (gfc_common_head *com, seg *** 410,429 **** /* Has initial value. */ if (s->sym->value) is_init = true; } finish_record_layout (rli, true); if (com) decl = build_common_decl (com, union_type, is_init); else ! decl = build_equiv_decl (union_type, is_init); if (is_init) { ! tree list, ctor, tmp; HOST_WIDE_INT offset = 0; - list = NULL_TREE; for (s = head; s; s = s->next) { if (s->sym->value) --- 412,435 ---- /* Has initial value. */ if (s->sym->value) is_init = true; + + /* Has SAVE attribute. */ + if (s->sym->attr.save) + is_saved = true; } finish_record_layout (rli, true); if (com) decl = build_common_decl (com, union_type, is_init); else ! decl = build_equiv_decl (union_type, is_init, is_saved); if (is_init) { ! tree ctor, tmp; HOST_WIDE_INT offset = 0; + VEC(constructor_elt,gc) *v = NULL; for (s = head; s; s = s->next) { if (s->sym->value) *************** create_common (gfc_common_head *com, seg *** 440,467 **** tmp = gfc_conv_initializer (s->sym->value, &s->sym->ts, TREE_TYPE (s->field), s->sym->attr.dimension, s->sym->attr.pointer || s->sym->attr.allocatable); ! list = tree_cons (s->field, tmp, list); offset = s->offset + s->length; } } ! gcc_assert (list); ! ctor = build1 (CONSTRUCTOR, union_type, nreverse(list)); TREE_CONSTANT (ctor) = 1; TREE_INVARIANT (ctor) = 1; TREE_STATIC (ctor) = 1; DECL_INITIAL (decl) = ctor; #ifdef ENABLE_CHECKING ! for (tmp = CONSTRUCTOR_ELTS (ctor); tmp; tmp = TREE_CHAIN (tmp)) ! gcc_assert (TREE_CODE (TREE_PURPOSE (tmp)) == FIELD_DECL); #endif } /* Build component reference for each variable. */ for (s = head; s; s = next_s) { ! s->sym->backend_decl = build3 (COMPONENT_REF, TREE_TYPE (s->field), ! decl, s->field, NULL_TREE); next_s = s->next; gfc_free (s); --- 446,508 ---- tmp = gfc_conv_initializer (s->sym->value, &s->sym->ts, TREE_TYPE (s->field), s->sym->attr.dimension, s->sym->attr.pointer || s->sym->attr.allocatable); ! ! CONSTRUCTOR_APPEND_ELT (v, s->field, tmp); offset = s->offset + s->length; } } ! gcc_assert (!VEC_empty (constructor_elt, v)); ! ctor = build_constructor (union_type, v); TREE_CONSTANT (ctor) = 1; TREE_INVARIANT (ctor) = 1; TREE_STATIC (ctor) = 1; DECL_INITIAL (decl) = ctor; #ifdef ENABLE_CHECKING ! { ! tree field, value; ! unsigned HOST_WIDE_INT idx; ! FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (ctor), idx, field, value) ! gcc_assert (TREE_CODE (field) == FIELD_DECL); ! } #endif } /* Build component reference for each variable. */ for (s = head; s; s = next_s) { ! tree var_decl; ! ! var_decl = build_decl (VAR_DECL, DECL_NAME (s->field), ! TREE_TYPE (s->field)); ! gfc_set_decl_location (var_decl, &s->sym->declared_at); ! TREE_PUBLIC (var_decl) = TREE_PUBLIC (decl); ! TREE_STATIC (var_decl) = TREE_STATIC (decl); ! TREE_USED (var_decl) = TREE_USED (decl); ! if (s->sym->attr.target) ! TREE_ADDRESSABLE (var_decl) = 1; ! /* This is a fake variable just for debugging purposes. */ ! TREE_ASM_WRITTEN (var_decl) = 1; ! ! if (com) ! var_decl = pushdecl_top_level (var_decl); ! else ! gfc_add_decl_to_function (var_decl); ! ! SET_DECL_VALUE_EXPR (var_decl, ! build3 (COMPONENT_REF, TREE_TYPE (s->field), ! decl, s->field, NULL_TREE)); ! DECL_HAS_VALUE_EXPR_P (var_decl) = 1; ! ! if (s->sym->attr.assign) ! { ! gfc_allocate_lang_decl (var_decl); ! GFC_DECL_ASSIGN (var_decl) = 1; ! GFC_DECL_STRING_LEN (var_decl) = GFC_DECL_STRING_LEN (s->field); ! GFC_DECL_ASSIGN_ADDR (var_decl) = GFC_DECL_ASSIGN_ADDR (s->field); ! } ! ! s->sym->backend_decl = var_decl; next_s = s->next; gfc_free (s); diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-const.c gcc-4.1.0/gcc/fortran/trans-const.c *** gcc-4.0.2/gcc/fortran/trans-const.c Tue Jul 12 01:50:48 2005 --- gcc-4.1.0/gcc/fortran/trans-const.c Sat Sep 17 18:58:01 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* trans-const.c -- convert constant values */ --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* trans-const.c -- convert constant values */ *************** gfc_build_string_const (int length, cons *** 86,97 **** return str; } ! /* Build a Fortran character constant from a zero-terminated string. */ ! tree ! gfc_build_cstring_const (const char *s) { ! return gfc_build_string_const (strlen (s) + 1, s); } /* Return a string constant with the given length. Used for static --- 86,98 ---- return str; } ! /* Build a Fortran character constant from a zero-terminated string. ! Since this is mainly used for error messages, the string will get ! translated. */ tree ! gfc_build_cstring_const (const char *msgid) { ! return gfc_build_string_const (strlen (msgid) + 1, _(msgid)); } /* Return a string constant with the given length. Used for static *************** gfc_init_constants (void) *** 163,169 **** gfc_build_cstring_const ("Incorrect function return value"); gfc_strconst_current_filename = ! gfc_build_cstring_const (gfc_option.source); } /* Converts a GMP integer into a backend tree node. */ --- 164,170 ---- gfc_build_cstring_const ("Incorrect function return value"); gfc_strconst_current_filename = ! gfc_build_cstring_const (gfc_source_file); } /* Converts a GMP integer into a backend tree node. */ *************** gfc_conv_mpz_to_tree (mpz_t i, int kind) *** 185,193 **** size_t count; /* Since we know that the value is not zero (mpz_fits_slong_p), ! we know that at one word will be written, but we don't know about the second. It's quicker to zero the second word before ! that conditionally clear it later. */ words[1] = 0; /* Extract the absolute value into words. */ --- 186,194 ---- size_t count; /* Since we know that the value is not zero (mpz_fits_slong_p), ! we know that at least one word will be written, but we don't know about the second. It's quicker to zero the second word before ! than conditionally clear it later. */ words[1] = 0; /* Extract the absolute value into words. */ *************** gfc_conv_mpfr_to_tree (mpfr_t f, int kin *** 223,279 **** tree res; tree type; mp_exp_t exp; ! char *p; ! char *q; int n; - int edigits; - - for (n = 0; gfc_real_kinds[n].kind != 0; n++) - { - if (gfc_real_kinds[n].kind == kind) - break; - } - gcc_assert (gfc_real_kinds[n].kind); ! n = MAX (abs (gfc_real_kinds[n].min_exponent), ! abs (gfc_real_kinds[n].max_exponent)); ! edigits = 1; ! while (n > 0) ! { ! n = n / 10; ! edigits += 3; ! } ! if (kind == gfc_default_double_kind) ! p = mpfr_get_str (NULL, &exp, 10, 17, f, GFC_RND_MODE); ! else ! p = mpfr_get_str (NULL, &exp, 10, 8, f, GFC_RND_MODE); ! /* We also have one minus sign, "e", "." and a null terminator. */ ! q = (char *) gfc_getmem (strlen (p) + edigits + 4); ! if (p[0]) ! { ! if (p[0] == '-') ! { ! strcpy (&q[2], &p[1]); ! q[0] = '-'; ! q[1] = '.'; ! } ! else ! { ! strcpy (&q[1], p); ! q[0] = '.'; ! } ! strcat (q, "e"); ! sprintf (&q[strlen (q)], "%d", (int) exp); ! } else ! { ! strcpy (q, "0"); ! } type = gfc_get_real_type (kind); res = build_real (type, REAL_VALUE_ATOF (q, TYPE_MODE (type))); --- 224,255 ---- tree res; tree type; mp_exp_t exp; ! char *p, *q; int n; ! n = gfc_validate_kind (BT_REAL, kind, false); ! gcc_assert (gfc_real_kinds[n].radix == 2); ! /* mpfr chooses too small a number of hexadecimal digits if the ! number of binary digits is not divisible by four, therefore we ! have to explicitly request a sufficient number of digits here. */ ! p = mpfr_get_str (NULL, &exp, 16, gfc_real_kinds[n].digits / 4 + 1, ! f, GFC_RND_MODE); + /* REAL_VALUE_ATOF expects the exponent for mantissa * 2**exp, + mpfr_get_str returns the exponent for mantissa * 16**exp, adjust + for that. */ + exp *= 4; ! /* The additional 12 characters add space for the sprintf below. ! This leaves 6 digits for the exponent which is certainly enough. */ ! q = (char *) gfc_getmem (strlen (p) + 12); ! if (p[0] == '-') ! sprintf (q, "-0x.%sp%d", &p[1], (int) exp); else ! sprintf (q, "0x.%sp%d", p, (int) exp); type = gfc_get_real_type (kind); res = build_real (type, REAL_VALUE_ATOF (q, TYPE_MODE (type))); diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-const.h gcc-4.1.0/gcc/fortran/trans-const.h *** gcc-4.0.2/gcc/fortran/trans-const.h Mon Oct 4 20:55:49 2004 --- gcc-4.1.0/gcc/fortran/trans-const.h Sat Jun 25 00:40:37 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Returns an INT_CST. */ tree gfc_conv_mpz_to_tree (mpz_t, int); --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Returns an INT_CST. */ tree gfc_conv_mpz_to_tree (mpz_t, int); diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-decl.c gcc-4.1.0/gcc/fortran/trans-decl.c *** gcc-4.0.2/gcc/fortran/trans-decl.c Fri Sep 9 09:05:53 2005 --- gcc-4.1.0/gcc/fortran/trans-decl.c Tue Feb 14 14:50:40 2006 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* trans-decl.c -- Handling of backend function and variable decls, etc */ --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* trans-decl.c -- Handling of backend function and variable decls, etc */ *************** Software Foundation, 59 Temple Place - S *** 32,38 **** #include "tm.h" #include "target.h" #include "function.h" - #include "errors.h" #include "flags.h" #include "cgraph.h" #include "gfortran.h" --- 32,37 ---- *************** tree gfc_static_ctors; *** 74,79 **** --- 73,80 ---- tree gfor_fndecl_internal_malloc; tree gfor_fndecl_internal_malloc64; + tree gfor_fndecl_internal_realloc; + tree gfor_fndecl_internal_realloc64; tree gfor_fndecl_internal_free; tree gfor_fndecl_allocate; tree gfor_fndecl_allocate64; *************** tree gfor_fndecl_stop_numeric; *** 84,90 **** --- 85,96 ---- tree gfor_fndecl_stop_string; tree gfor_fndecl_select_string; tree gfor_fndecl_runtime_error; + tree gfor_fndecl_set_fpe; tree gfor_fndecl_set_std; + tree gfor_fndecl_set_convert; + tree gfor_fndecl_ctime; + tree gfor_fndecl_fdate; + tree gfor_fndecl_ttynam; tree gfor_fndecl_in_pack; tree gfor_fndecl_in_unpack; tree gfor_fndecl_associated; *************** tree gfor_fndecl_associated; *** 93,105 **** /* Math functions. Many other math functions are handled in trans-intrinsic.c. */ ! gfc_powdecl_list gfor_fndecl_math_powi[3][2]; tree gfor_fndecl_math_cpowf; tree gfor_fndecl_math_cpow; tree gfor_fndecl_math_ishftc4; tree gfor_fndecl_math_ishftc8; tree gfor_fndecl_math_exponent4; tree gfor_fndecl_math_exponent8; /* String functions. */ --- 99,116 ---- /* Math functions. Many other math functions are handled in trans-intrinsic.c. */ ! gfc_powdecl_list gfor_fndecl_math_powi[4][3]; tree gfor_fndecl_math_cpowf; tree gfor_fndecl_math_cpow; + tree gfor_fndecl_math_cpowl10; + tree gfor_fndecl_math_cpowl16; tree gfor_fndecl_math_ishftc4; tree gfor_fndecl_math_ishftc8; + tree gfor_fndecl_math_ishftc16; tree gfor_fndecl_math_exponent4; tree gfor_fndecl_math_exponent8; + tree gfor_fndecl_math_exponent10; + tree gfor_fndecl_math_exponent16; /* String functions. */ *************** gfc_can_put_var_on_stack (tree size) *** 344,349 **** --- 355,398 ---- } + /* gfc_finish_cray_pointee sets DECL_VALUE_EXPR for a Cray pointee to + an expression involving its corresponding pointer. There are + 2 cases; one for variable size arrays, and one for everything else, + because variable-sized arrays require one fewer level of + indirection. */ + + static void + gfc_finish_cray_pointee (tree decl, gfc_symbol *sym) + { + tree ptr_decl = gfc_get_symbol_decl (sym->cp_pointer); + tree value; + + /* Parameters need to be dereferenced. */ + if (sym->cp_pointer->attr.dummy) + ptr_decl = gfc_build_indirect_ref (ptr_decl); + + /* Check to see if we're dealing with a variable-sized array. */ + if (sym->attr.dimension + && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) + { + /* These decls will be dereferenced later, so we don't dereference + them here. */ + value = convert (TREE_TYPE (decl), ptr_decl); + } + else + { + ptr_decl = convert (build_pointer_type (TREE_TYPE (decl)), + ptr_decl); + value = gfc_build_indirect_ref (ptr_decl); + } + + SET_DECL_VALUE_EXPR (decl, value); + DECL_HAS_VALUE_EXPR_P (decl) = 1; + /* This is a fake variable just for debugging purposes. */ + TREE_ASM_WRITTEN (decl) = 1; + } + + /* Finish processing of a declaration and install its initial value. */ static void *************** gfc_finish_var_decl (tree decl, gfc_symb *** 409,414 **** --- 458,468 ---- This is the equivalent of the TARGET variables. We also need to set this if the variable is passed by reference in a CALL statement. */ + + /* Set DECL_VALUE_EXPR for Cray Pointees. */ + if (sym->attr.cray_pointee) + gfc_finish_cray_pointee (decl, sym); + if (sym->attr.target) TREE_ADDRESSABLE (decl) = 1; /* If it wasn't used we wouldn't be getting it. */ *************** gfc_finish_var_decl (tree decl, gfc_symb *** 419,430 **** function scope. */ if (current_function_decl != NULL_TREE) { ! if (sym->ns->proc_name->backend_decl == current_function_decl) gfc_add_decl_to_function (decl); else gfc_add_decl_to_parent_function (decl); } /* If a variable is USE associated, it's always external. */ if (sym->attr.use_assoc) { --- 473,488 ---- function scope. */ if (current_function_decl != NULL_TREE) { ! if (sym->ns->proc_name->backend_decl == current_function_decl ! || sym->result == sym) gfc_add_decl_to_function (decl); else gfc_add_decl_to_parent_function (decl); } + if (sym->attr.cray_pointee) + return; + /* If a variable is USE associated, it's always external. */ if (sym->attr.use_assoc) { *************** gfc_finish_var_decl (tree decl, gfc_symb *** 434,440 **** else if (sym->module && !sym->attr.result && !sym->attr.dummy) { /* TODO: Don't set sym->module for result or dummy variables. */ ! gcc_assert (current_function_decl == NULL_TREE); /* This is the declaration of a module variable. */ TREE_PUBLIC (decl) = 1; TREE_STATIC (decl) = 1; --- 492,498 ---- else if (sym->module && !sym->attr.result && !sym->attr.dummy) { /* TODO: Don't set sym->module for result or dummy variables. */ ! gcc_assert (current_function_decl == NULL_TREE || sym->result == sym); /* This is the declaration of a module variable. */ TREE_PUBLIC (decl) = 1; TREE_STATIC (decl) = 1; *************** gfc_build_qualified_array (tree decl, gf *** 538,544 **** { if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE) GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest); ! /* Don't try to use the unkown bound for assumed shape arrays. */ if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE && (sym->as->type != AS_ASSUMED_SIZE || dim < GFC_TYPE_ARRAY_RANK (type) - 1)) --- 596,602 ---- { if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE) GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest); ! /* Don't try to use the unknown bound for assumed shape arrays. */ if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE && (sym->as->type != AS_ASSUMED_SIZE || dim < GFC_TYPE_ARRAY_RANK (type) - 1)) *************** gfc_create_string_length (gfc_symbol * s *** 711,716 **** --- 769,807 ---- return sym->ts.cl->backend_decl; } + /* If a variable is assigned a label, we add another two auxiliary + variables. */ + + static void + gfc_add_assign_aux_vars (gfc_symbol * sym) + { + tree addr; + tree length; + tree decl; + + gcc_assert (sym->backend_decl); + + decl = sym->backend_decl; + gfc_allocate_lang_decl (decl); + GFC_DECL_ASSIGN (decl) = 1; + length = build_decl (VAR_DECL, create_tmp_var_name (sym->name), + gfc_charlen_type_node); + addr = build_decl (VAR_DECL, create_tmp_var_name (sym->name), + pvoid_type_node); + gfc_finish_var_decl (length, sym); + gfc_finish_var_decl (addr, sym); + /* STRING_LENGTH is also used as flag. Less than -1 means that + ASSIGN_ADDR can not be used. Equal -1 means that ASSIGN_ADDR is the + target label's address. Otherwise, value is the length of a format string + and ASSIGN_ADDR is its address. */ + if (TREE_STATIC (length)) + DECL_INITIAL (length) = build_int_cst (NULL_TREE, -2); + else + gfc_defer_symbol_init (sym); + + GFC_DECL_STRING_LEN (decl) = length; + GFC_DECL_ASSIGN_ADDR (decl) = addr; + } /* Return the decl for a gfc_symbol, create it if it doesn't already exist. */ *************** tree *** 719,725 **** --- 810,818 ---- gfc_get_symbol_decl (gfc_symbol * sym) { tree decl; + tree etype = NULL_TREE; tree length = NULL_TREE; + tree tmp = NULL_TREE; int byref; gcc_assert (sym->attr.referenced); *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 758,763 **** --- 851,871 ---- gfc_defer_symbol_init (sym); } } + + /* Set the element size of automatic and assumed character length + length, dummy, pointer arrays. */ + if (sym->attr.pointer && sym->attr.dummy + && sym->attr.dimension) + { + tmp = gfc_build_indirect_ref (sym->backend_decl); + etype = gfc_get_element_type (TREE_TYPE (tmp)); + if (TYPE_SIZE_UNIT (etype) == NULL_TREE) + { + tmp = TYPE_SIZE_UNIT (gfc_character1_type_node); + tmp = fold_convert (TREE_TYPE (tmp), sym->ts.cl->backend_decl); + TYPE_SIZE_UNIT (etype) = tmp; + } + } } /* Use a copy of the descriptor for dummy arrays. */ *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 768,773 **** --- 876,885 ---- } TREE_USED (sym->backend_decl) = 1; + if (sym->attr.assign && GFC_DECL_ASSIGN (sym->backend_decl) == 0) + { + gfc_add_assign_aux_vars (sym); + } return sym->backend_decl; } *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 814,835 **** gfc_finish_var_decl (decl, sym); - if (sym->attr.assign) - { - gfc_allocate_lang_decl (decl); - GFC_DECL_ASSIGN (decl) = 1; - length = gfc_create_var (gfc_charlen_type_node, sym->name); - GFC_DECL_STRING_LEN (decl) = length; - GFC_DECL_ASSIGN_ADDR (decl) = gfc_create_var (pvoid_type_node, sym->name); - /* TODO: Need to check we don't change TREE_STATIC (decl) later. */ - TREE_STATIC (length) = TREE_STATIC (decl); - /* STRING_LENGTH is also used as flag. Less than -1 means that - ASSIGN_ADDR can not be used. Equal -1 means that ASSIGN_ADDR is the - target label's address. Other value is the length of format string - and ASSIGN_ADDR is the address of format string. */ - DECL_INITIAL (length) = build_int_cst (NULL_TREE, -2); - } - if (sym->ts.type == BT_CHARACTER) { /* Character variables need special handling. */ --- 926,931 ---- *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 854,859 **** --- 950,960 ---- } sym->backend_decl = decl; + if (sym->attr.assign) + { + gfc_add_assign_aux_vars (sym); + } + if (TREE_STATIC (decl) && !sym->attr.use_assoc) { /* Add static initializer. */ *************** gfc_get_extern_function_decl (gfc_symbol *** 993,999 **** sense. */ if (sym->attr.pure || sym->attr.elemental) { ! if (sym->attr.function) DECL_IS_PURE (fndecl) = 1; /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT) parameters and don't use alternate returns (is this --- 1094,1100 ---- sense. */ if (sym->attr.pure || sym->attr.elemental) { ! if (sym->attr.function && !gfc_return_by_reference (sym)) DECL_IS_PURE (fndecl) = 1; /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT) parameters and don't use alternate returns (is this *************** gfc_get_extern_function_decl (gfc_symbol *** 1002,1007 **** --- 1103,1112 ---- TREE_SIDE_EFFECTS (fndecl) = 0; } + /* Mark non-returning functions. */ + if (sym->attr.noreturn) + TREE_THIS_VOLATILE(fndecl) = 1; + sym->backend_decl = fndecl; if (DECL_CONTEXT (fndecl) == NULL_TREE) *************** build_function_decl (gfc_symbol * sym) *** 1116,1122 **** /* TODO: check if a pure SUBROUTINE has no INTENT(OUT) arguments including a alternate return. In that case it can also be marked as PURE. See also in gfc_get_extern_function_decl(). */ ! if (attr.function) DECL_IS_PURE (fndecl) = 1; TREE_SIDE_EFFECTS (fndecl) = 0; } --- 1221,1227 ---- /* TODO: check if a pure SUBROUTINE has no INTENT(OUT) arguments including a alternate return. In that case it can also be marked as PURE. See also in gfc_get_extern_function_decl(). */ ! if (attr.function && !gfc_return_by_reference (sym)) DECL_IS_PURE (fndecl) = 1; TREE_SIDE_EFFECTS (fndecl) = 0; } *************** create_function_arglist (gfc_symbol * sy *** 1219,1225 **** /* Fill in arg stuff. */ DECL_CONTEXT (parm) = fndecl; DECL_ARG_TYPE (parm) = type; - DECL_ARG_TYPE_AS_WRITTEN (parm) = type; /* All implementation args are read-only. */ TREE_READONLY (parm) = 1; --- 1324,1329 ---- *************** gfc_build_intrinsic_function_decls (void *** 1687,1697 **** --- 1791,1807 ---- { tree gfc_int4_type_node = gfc_get_int_type (4); tree gfc_int8_type_node = gfc_get_int_type (8); + tree gfc_int16_type_node = gfc_get_int_type (16); tree gfc_logical4_type_node = gfc_get_logical_type (4); tree gfc_real4_type_node = gfc_get_real_type (4); tree gfc_real8_type_node = gfc_get_real_type (8); + tree gfc_real10_type_node = gfc_get_real_type (10); + tree gfc_real16_type_node = gfc_get_real_type (16); tree gfc_complex4_type_node = gfc_get_complex_type (4); tree gfc_complex8_type_node = gfc_get_complex_type (8); + tree gfc_complex10_type_node = gfc_get_complex_type (10); + tree gfc_complex16_type_node = gfc_get_complex_type (16); + tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind); /* String functions. */ gfor_fndecl_copy_string = *************** gfc_build_intrinsic_function_decls (void *** 1761,1766 **** --- 1871,1899 ---- pchar_type_node, gfc_int4_type_node); + gfor_fndecl_ttynam = + gfc_build_library_function_decl (get_identifier (PREFIX("ttynam")), + void_type_node, + 3, + pchar_type_node, + gfc_charlen_type_node, + gfc_c_int_type_node); + + gfor_fndecl_fdate = + gfc_build_library_function_decl (get_identifier (PREFIX("fdate")), + void_type_node, + 2, + pchar_type_node, + gfc_charlen_type_node); + + gfor_fndecl_ctime = + gfc_build_library_function_decl (get_identifier (PREFIX("ctime")), + void_type_node, + 3, + pchar_type_node, + gfc_charlen_type_node, + gfc_int8_type_node); + gfor_fndecl_adjustl = gfc_build_library_function_decl (get_identifier (PREFIX("adjustl")), void_type_node, *************** gfc_build_intrinsic_function_decls (void *** 1789,1825 **** /* Power functions. */ { ! tree type; ! tree itype; ! int kind; ! int ikind; ! static int kinds[2] = {4, 8}; ! char name[PREFIX_LEN + 10]; /* _gfortran_pow_?n_?n */ ! for (ikind=0; ikind < 2; ikind++) { ! itype = gfc_get_int_type (kinds[ikind]); ! for (kind = 0; kind < 2; kind ++) { ! type = gfc_get_int_type (kinds[kind]); ! sprintf(name, PREFIX("pow_i%d_i%d"), kinds[kind], kinds[ikind]); ! gfor_fndecl_math_powi[kind][ikind].integer = ! gfc_build_library_function_decl (get_identifier (name), ! type, 2, type, itype); ! type = gfc_get_real_type (kinds[kind]); ! sprintf(name, PREFIX("pow_r%d_i%d"), kinds[kind], kinds[ikind]); ! gfor_fndecl_math_powi[kind][ikind].real = ! gfc_build_library_function_decl (get_identifier (name), ! type, 2, type, itype); ! type = gfc_get_complex_type (kinds[kind]); ! sprintf(name, PREFIX("pow_c%d_i%d"), kinds[kind], kinds[ikind]); ! gfor_fndecl_math_powi[kind][ikind].cmplx = ! gfc_build_library_function_decl (get_identifier (name), ! type, 2, type, itype); } } } gfor_fndecl_math_cpowf = --- 1922,1977 ---- /* Power functions. */ { ! tree ctype, rtype, itype, jtype; ! int rkind, ikind, jkind; ! #define NIKINDS 3 ! #define NRKINDS 4 ! static int ikinds[NIKINDS] = {4, 8, 16}; ! static int rkinds[NRKINDS] = {4, 8, 10, 16}; ! char name[PREFIX_LEN + 12]; /* _gfortran_pow_?n_?n */ ! for (ikind=0; ikind < NIKINDS; ikind++) { ! itype = gfc_get_int_type (ikinds[ikind]); ! ! for (jkind=0; jkind < NIKINDS; jkind++) { ! jtype = gfc_get_int_type (ikinds[jkind]); ! if (itype && jtype) ! { ! sprintf(name, PREFIX("pow_i%d_i%d"), ikinds[ikind], ! ikinds[jkind]); ! gfor_fndecl_math_powi[jkind][ikind].integer = ! gfc_build_library_function_decl (get_identifier (name), ! jtype, 2, jtype, itype); ! } ! } ! for (rkind = 0; rkind < NRKINDS; rkind ++) ! { ! rtype = gfc_get_real_type (rkinds[rkind]); ! if (rtype && itype) ! { ! sprintf(name, PREFIX("pow_r%d_i%d"), rkinds[rkind], ! ikinds[ikind]); ! gfor_fndecl_math_powi[rkind][ikind].real = ! gfc_build_library_function_decl (get_identifier (name), ! rtype, 2, rtype, itype); ! } ! ctype = gfc_get_complex_type (rkinds[rkind]); ! if (ctype && itype) ! { ! sprintf(name, PREFIX("pow_c%d_i%d"), rkinds[rkind], ! ikinds[ikind]); ! gfor_fndecl_math_powi[rkind][ikind].cmplx = ! gfc_build_library_function_decl (get_identifier (name), ! ctype, 2,ctype, itype); ! } } } + #undef NIKINDS + #undef NRKINDS } gfor_fndecl_math_cpowf = *************** gfc_build_intrinsic_function_decls (void *** 1830,1835 **** --- 1982,1998 ---- gfc_build_library_function_decl (get_identifier ("cpow"), gfc_complex8_type_node, 1, gfc_complex8_type_node); + if (gfc_complex10_type_node) + gfor_fndecl_math_cpowl10 = + gfc_build_library_function_decl (get_identifier ("cpowl"), + gfc_complex10_type_node, 1, + gfc_complex10_type_node); + if (gfc_complex16_type_node) + gfor_fndecl_math_cpowl16 = + gfc_build_library_function_decl (get_identifier ("cpowl"), + gfc_complex16_type_node, 1, + gfc_complex16_type_node); + gfor_fndecl_math_ishftc4 = gfc_build_library_function_decl (get_identifier (PREFIX("ishftc4")), gfc_int4_type_node, *************** gfc_build_intrinsic_function_decls (void *** 1839,1845 **** gfc_build_library_function_decl (get_identifier (PREFIX("ishftc8")), gfc_int8_type_node, 3, gfc_int8_type_node, ! gfc_int8_type_node, gfc_int8_type_node); gfor_fndecl_math_exponent4 = gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r4")), gfc_int4_type_node, --- 2002,2016 ---- gfc_build_library_function_decl (get_identifier (PREFIX("ishftc8")), gfc_int8_type_node, 3, gfc_int8_type_node, ! gfc_int4_type_node, gfc_int4_type_node); ! if (gfc_int16_type_node) ! gfor_fndecl_math_ishftc16 = ! gfc_build_library_function_decl (get_identifier (PREFIX("ishftc16")), ! gfc_int16_type_node, 3, ! gfc_int16_type_node, ! gfc_int4_type_node, ! gfc_int4_type_node); ! gfor_fndecl_math_exponent4 = gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r4")), gfc_int4_type_node, *************** gfc_build_intrinsic_function_decls (void *** 1848,1853 **** --- 2019,2034 ---- gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r8")), gfc_int4_type_node, 1, gfc_real8_type_node); + if (gfc_real10_type_node) + gfor_fndecl_math_exponent10 = + gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r10")), + gfc_int4_type_node, 1, + gfc_real10_type_node); + if (gfc_real16_type_node) + gfor_fndecl_math_exponent16 = + gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r16")), + gfc_int4_type_node, 1, + gfc_real16_type_node); /* Other functions. */ gfor_fndecl_size0 = *************** gfc_build_intrinsic_function_decls (void *** 1872,1890 **** --- 2053,2087 ---- void gfc_build_builtin_function_decls (void) { + tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind); tree gfc_int4_type_node = gfc_get_int_type (4); tree gfc_int8_type_node = gfc_get_int_type (8); tree gfc_logical4_type_node = gfc_get_logical_type (4); tree gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node); + /* Treat these two internal malloc wrappers as malloc. */ gfor_fndecl_internal_malloc = gfc_build_library_function_decl (get_identifier (PREFIX("internal_malloc")), pvoid_type_node, 1, gfc_int4_type_node); + DECL_IS_MALLOC (gfor_fndecl_internal_malloc) = 1; gfor_fndecl_internal_malloc64 = gfc_build_library_function_decl (get_identifier (PREFIX("internal_malloc64")), pvoid_type_node, 1, gfc_int8_type_node); + DECL_IS_MALLOC (gfor_fndecl_internal_malloc64) = 1; + + gfor_fndecl_internal_realloc = + gfc_build_library_function_decl (get_identifier + (PREFIX("internal_realloc")), + pvoid_type_node, 2, pvoid_type_node, + gfc_int4_type_node); + + gfor_fndecl_internal_realloc64 = + gfc_build_library_function_decl (get_identifier + (PREFIX("internal_realloc64")), + pvoid_type_node, 2, pvoid_type_node, + gfc_int8_type_node); gfor_fndecl_internal_free = gfc_build_library_function_decl (get_identifier (PREFIX("internal_free")), *************** gfc_build_builtin_function_decls (void) *** 1909,1918 **** --- 2106,2120 ---- gfc_build_library_function_decl (get_identifier (PREFIX("stop_numeric")), void_type_node, 1, gfc_int4_type_node); + /* Stop doesn't return. */ + TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1; + gfor_fndecl_stop_string = gfc_build_library_function_decl (get_identifier (PREFIX("stop_string")), void_type_node, 2, pchar_type_node, gfc_int4_type_node); + /* Stop doesn't return. */ + TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1; gfor_fndecl_pause_numeric = gfc_build_library_function_decl (get_identifier (PREFIX("pause_numeric")), *************** gfc_build_builtin_function_decls (void) *** 1933,1946 **** 3, pchar_type_node, pchar_type_node, gfc_int4_type_node); gfor_fndecl_set_std = gfc_build_library_function_decl (get_identifier (PREFIX("set_std")), void_type_node, ! 2, gfc_int4_type_node, gfc_int4_type_node); gfor_fndecl_in_pack = gfc_build_library_function_decl ( get_identifier (PREFIX("internal_pack")), pvoid_type_node, 1, pvoid_type_node); --- 2135,2159 ---- 3, pchar_type_node, pchar_type_node, gfc_int4_type_node); + /* The runtime_error function does not return. */ + TREE_THIS_VOLATILE (gfor_fndecl_runtime_error) = 1; + + gfor_fndecl_set_fpe = + gfc_build_library_function_decl (get_identifier (PREFIX("set_fpe")), + void_type_node, 1, gfc_c_int_type_node); gfor_fndecl_set_std = gfc_build_library_function_decl (get_identifier (PREFIX("set_std")), void_type_node, ! 3, ! gfc_int4_type_node, gfc_int4_type_node, gfc_int4_type_node); + gfor_fndecl_set_convert = + gfc_build_library_function_decl (get_identifier (PREFIX("set_convert")), + void_type_node, 1, gfc_c_int_type_node); + gfor_fndecl_in_pack = gfc_build_library_function_decl ( get_identifier (PREFIX("internal_pack")), pvoid_type_node, 1, pvoid_type_node); *************** gfc_trans_auto_character_variable (gfc_s *** 2010,2021 **** return gfc_finish_block (&body); } /* Generate function entry and exit code, and add it to the function body. This includes: Allocation and initialization of array variables. Allocation of character string variables. ! Initialization and possibly repacking of dummy arrays. */ static tree gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) --- 2223,2254 ---- return gfc_finish_block (&body); } + /* Set the initial value of ASSIGN statement auxiliary variable explicitly. */ + + static tree + gfc_trans_assign_aux_var (gfc_symbol * sym, tree fnbody) + { + stmtblock_t body; + + gcc_assert (sym->backend_decl); + gfc_start_block (&body); + + /* Set the initial value to length. See the comments in + function gfc_add_assign_aux_vars in this file. */ + gfc_add_modify_expr (&body, GFC_DECL_STRING_LEN (sym->backend_decl), + build_int_cst (NULL_TREE, -2)); + + gfc_add_expr_to_block (&body, fnbody); + return gfc_finish_block (&body); + } + /* Generate function entry and exit code, and add it to the function body. This includes: Allocation and initialization of array variables. Allocation of character string variables. ! Initialization and possibly repacking of dummy arrays. ! Initialization of ASSIGN statement auxiliary variable. */ static tree gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) *************** gfc_trans_deferred_vars (gfc_symbol * pr *** 2037,2043 **** break; } if (el == NULL) ! warning ("Function does not return a value"); } else if (proc_sym->as) { --- 2270,2276 ---- break; } if (el == NULL) ! warning (0, "Function does not return a value"); } else if (proc_sym->as) { *************** gfc_trans_deferred_vars (gfc_symbol * pr *** 2116,2121 **** --- 2349,2361 ---- fnbody = gfc_trans_auto_character_variable (sym, fnbody); gfc_set_backend_locus (&loc); } + else if (sym->attr.assign) + { + gfc_get_backend_locus (&loc); + gfc_set_backend_locus (&sym->declared_at); + fnbody = gfc_trans_assign_aux_var (sym, fnbody); + gfc_set_backend_locus (&loc); + } else gcc_unreachable (); } *************** gfc_create_module_variable (gfc_symbol * *** 2149,2155 **** return; /* Equivalenced variables arrive here after creation. */ ! if (sym->backend_decl && sym->equiv_built) return; if (sym->backend_decl) --- 2389,2396 ---- return; /* Equivalenced variables arrive here after creation. */ ! if (sym->backend_decl ! && (sym->equiv_built || sym->attr.in_equivalence)) return; if (sym->backend_decl) *************** generate_local_decl (gfc_symbol * sym) *** 2235,2246 **** if (sym->attr.referenced) gfc_get_symbol_decl (sym); else if (sym->attr.dummy && warn_unused_parameter) ! warning ("unused parameter %qs", sym->name); /* Warn for unused variables, but not if they're inside a common block or are use-associated. */ else if (warn_unused_variable && !(sym->attr.in_common || sym->attr.use_assoc)) ! warning ("unused variable %qs", sym->name); } } --- 2476,2487 ---- if (sym->attr.referenced) gfc_get_symbol_decl (sym); else if (sym->attr.dummy && warn_unused_parameter) ! warning (0, "unused parameter %qs", sym->name); /* Warn for unused variables, but not if they're inside a common block or are use-associated. */ else if (warn_unused_variable && !(sym->attr.in_common || sym->attr.use_assoc)) ! warning (0, "unused variable %qs", sym->name); } } *************** gfc_generate_function_code (gfc_namespac *** 2323,2331 **** trans_function_start (sym); - /* Will be created as needed. */ - current_fake_result_decl = NULL_TREE; - gfc_start_block (&block); if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER) --- 2564,2569 ---- *************** gfc_generate_function_code (gfc_namespac *** 2347,2362 **** gfc_generate_contained_functions (ns); generate_local_vars (ns); ! current_function_return_label = NULL; /* Now generate the code for the body of this function. */ gfc_init_block (&body); ! /* If this is the main program and we compile with -pedantic, add a call ! to set_std to set up the runtime library Fortran language standard ! parameters. */ ! if (sym->attr.is_main_program && pedantic) { tree arglist, gfc_int4_type_node; --- 2585,2602 ---- gfc_generate_contained_functions (ns); generate_local_vars (ns); ! ! /* Will be created as needed. */ ! current_fake_result_decl = NULL_TREE; current_function_return_label = NULL; /* Now generate the code for the body of this function. */ gfc_init_block (&body); ! /* If this is the main program, add a call to set_std to set up the ! runtime library Fortran language standard parameters. */ ! ! if (sym->attr.is_main_program) { tree arglist, gfc_int4_type_node; *************** gfc_generate_function_code (gfc_namespac *** 2367,2376 **** arglist = gfc_chainon_list (arglist, build_int_cst (gfc_int4_type_node, gfc_option.allow_std)); ! tmp = gfc_build_function_call (gfor_fndecl_set_std, arglist); gfc_add_expr_to_block (&body, tmp); } if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node && sym->attr.subroutine) { --- 2607,2650 ---- arglist = gfc_chainon_list (arglist, build_int_cst (gfc_int4_type_node, gfc_option.allow_std)); ! arglist = gfc_chainon_list (arglist, ! build_int_cst (gfc_int4_type_node, ! pedantic)); ! tmp = build_function_call_expr (gfor_fndecl_set_std, arglist); gfc_add_expr_to_block (&body, tmp); } + /* If this is the main program and a -ffpe-trap option was provided, + add a call to set_fpe so that the library will raise a FPE when + needed. */ + if (sym->attr.is_main_program && gfc_option.fpe != 0) + { + tree arglist, gfc_c_int_type_node; + + gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind); + arglist = gfc_chainon_list (NULL_TREE, + build_int_cst (gfc_c_int_type_node, + gfc_option.fpe)); + tmp = gfc_build_function_call (gfor_fndecl_set_fpe, arglist); + gfc_add_expr_to_block (&body, tmp); + } + + /* If this is the main program and an -fconvert option was provided, + add a call to set_convert. */ + + if (sym->attr.is_main_program && gfc_option.convert != CONVERT_NATIVE) + { + tree arglist, gfc_c_int_type_node; + + gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind); + arglist = gfc_chainon_list (NULL_TREE, + build_int_cst (gfc_c_int_type_node, + gfc_option.convert)); + tmp = build_function_call_expr (gfor_fndecl_set_convert, arglist); + gfc_add_expr_to_block (&body, tmp); + } + + if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node && sym->attr.subroutine) { *************** gfc_generate_function_code (gfc_namespac *** 2412,2418 **** result = sym->result->backend_decl; if (result == NULL_TREE) ! warning ("Function return value not set"); else { /* Set the return value to the dummy result variable. */ --- 2686,2692 ---- result = sym->result->backend_decl; if (result == NULL_TREE) ! warning (0, "Function return value not set"); else { /* Set the return value to the dummy result variable. */ *************** gfc_generate_block_data (gfc_namespace * *** 2567,2570 **** --- 2841,2845 ---- rest_of_decl_compilation (decl, 1, 0); } + #include "gt-fortran-trans-decl.h" diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-expr.c gcc-4.1.0/gcc/fortran/trans-expr.c *** gcc-4.0.2/gcc/fortran/trans-expr.c Tue Aug 16 13:27:35 2005 --- gcc-4.1.0/gcc/fortran/trans-expr.c Tue Feb 14 17:34:07 2006 *************** *** 1,5 **** /* Expression translation ! Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher --- 1,5 ---- /* Expression translation ! Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* trans-expr.c-- generate GENERIC trees for gfc_expr. */ --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* trans-expr.c-- generate GENERIC trees for gfc_expr. */ *************** Software Foundation, 59 Temple Place - S *** 39,46 **** --- 39,49 ---- #include "trans-array.h" /* Only for gfc_trans_assign and gfc_trans_pointer_assign. */ #include "trans-stmt.h" + #include "dependency.h" static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr); + static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *, + gfc_expr *); /* Copy the scalarization loop variables. */ *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 305,311 **** /* A scalarized term. We already know the descriptor. */ se->expr = se->ss->data.info.descriptor; se->string_length = se->ss->string_length; ! ref = se->ss->data.info.ref; } else { --- 308,316 ---- /* A scalarized term. We already know the descriptor. */ se->expr = se->ss->data.info.descriptor; se->string_length = se->ss->string_length; ! for (ref = se->ss->data.info.ref; ref; ref = ref->next) ! if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) ! break; } else { *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 356,361 **** --- 361,367 ---- return; } + /* Dereference the expression, where needed. Since characters are entirely different from other types, they are treated separately. */ *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 371,388 **** } else { ! /* Dereference non-character scalar dummy arguments. */ if (sym->attr.dummy && !sym->attr.dimension) se->expr = gfc_build_indirect_ref (se->expr); ! /* Dereference scalar hidden result. */ ! if (gfc_option.flag_f2c && (sym->attr.function || sym->attr.result) ! && sym->ts.type == BT_COMPLEX ! && !sym->attr.dimension) se->expr = gfc_build_indirect_ref (se->expr); ! /* Dereference non-character pointer variables. These must be dummies, results, or scalars. */ if ((sym->attr.pointer || sym->attr.allocatable) && (sym->attr.dummy --- 377,393 ---- } else { ! /* Dereference non-character scalar dummy arguments. */ if (sym->attr.dummy && !sym->attr.dimension) se->expr = gfc_build_indirect_ref (se->expr); ! /* Dereference scalar hidden result. */ ! if (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX && (sym->attr.function || sym->attr.result) ! && !sym->attr.dimension && !sym->attr.pointer) se->expr = gfc_build_indirect_ref (se->expr); ! /* Dereference non-character pointer variables. These must be dummies, results, or scalars. */ if ((sym->attr.pointer || sym->attr.allocatable) && (sym->attr.dummy *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 398,404 **** /* For character variables, also get the length. */ if (sym->ts.type == BT_CHARACTER) { ! se->string_length = sym->ts.cl->backend_decl; gcc_assert (se->string_length); } --- 403,414 ---- /* For character variables, also get the length. */ if (sym->ts.type == BT_CHARACTER) { ! /* If the character length of an entry isn't set, get the length from ! the master function instead. */ ! if (sym->attr.entry && !sym->ts.cl->backend_decl) ! se->string_length = sym->ns->proc_name->ts.cl->backend_decl; ! else ! se->string_length = sym->ts.cl->backend_decl; gcc_assert (se->string_length); } *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 444,451 **** else se->expr = gfc_build_addr_expr (NULL, se->expr); } - if (se->ss != NULL) - gfc_advance_se_ss_chain (se); } --- 454,459 ---- *************** gfc_conv_powi (gfc_se * se, int n, tree *** 559,565 **** op1 = op0; } ! tmp = fold (build2 (MULT_EXPR, TREE_TYPE (op0), op0, op1)); tmp = gfc_evaluate_now (tmp, &se->pre); if (n < POWI_TABLE_SIZE) --- 567,573 ---- op1 = op0; } ! tmp = fold_build2 (MULT_EXPR, TREE_TYPE (op0), op0, op1); tmp = gfc_evaluate_now (tmp, &se->pre); if (n < POWI_TABLE_SIZE) *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 688,693 **** --- 696,705 ---- ikind = 1; break; + case 16: + ikind = 2; + break; + default: gcc_unreachable (); } *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 709,714 **** --- 721,734 ---- kind = 1; break; + case 10: + kind = 2; + break; + + case 16: + kind = 3; + break; + default: gcc_unreachable (); } *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 716,721 **** --- 736,743 ---- switch (expr->value.op.op1->ts.type) { case BT_INTEGER: + if (kind == 3) /* Case 16 was not handled properly above. */ + kind = 2; fndecl = gfor_fndecl_math_powi[kind][ikind].integer; break; *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 741,746 **** --- 763,772 ---- case 8: fndecl = built_in_decls[BUILT_IN_POW]; break; + case 10: + case 16: + fndecl = built_in_decls[BUILT_IN_POWL]; + break; default: gcc_unreachable (); } *************** gfc_conv_power_op (gfc_se * se, gfc_expr *** 755,760 **** --- 781,792 ---- case 8: fndecl = gfor_fndecl_math_cpow; break; + case 10: + fndecl = gfor_fndecl_math_cpowl10; + break; + case 16: + fndecl = gfor_fndecl_math_cpowl16; + break; default: gcc_unreachable (); } *************** gfc_conv_string_tmp (gfc_se * se, tree t *** 785,793 **** if (gfc_can_put_var_on_stack (len)) { /* Create a temporary variable to hold the result. */ ! tmp = fold (build2 (MINUS_EXPR, gfc_charlen_type_node, len, ! convert (gfc_charlen_type_node, ! integer_one_node))); tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (gfc_character1_type_node, tmp); var = gfc_create_var (tmp, "str"); --- 817,824 ---- if (gfc_can_put_var_on_stack (len)) { /* Create a temporary variable to hold the result. */ ! tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, len, ! convert (gfc_charlen_type_node, integer_one_node)); tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (gfc_character1_type_node, tmp); var = gfc_create_var (tmp, "str"); *************** gfc_conv_concat_op (gfc_se * se, gfc_exp *** 844,851 **** len = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); if (len == NULL_TREE) { ! len = fold (build2 (PLUS_EXPR, TREE_TYPE (lse.string_length), ! lse.string_length, rse.string_length)); } type = build_pointer_type (type); --- 875,882 ---- len = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); if (len == NULL_TREE) { ! len = fold_build2 (PLUS_EXPR, TREE_TYPE (lse.string_length), ! lse.string_length, rse.string_length); } type = build_pointer_type (type); *************** gfc_conv_concat_op (gfc_se * se, gfc_exp *** 871,877 **** se->string_length = len; } - /* Translates an op expression. Common (binary) cases are handled by this function, others are passed on. Recursion is used in either case. We use the fact that (op1.ts == op2.ts) (except for the power --- 902,907 ---- *************** gfc_conv_expr_op (gfc_se * se, gfc_expr *** 896,901 **** --- 926,932 ---- switch (expr->value.op.operator) { case INTRINSIC_UPLUS: + case INTRINSIC_PARENTHESES: gfc_conv_expr (se, expr->value.op.op1); return; *************** gfc_conv_expr_op (gfc_se * se, gfc_expr *** 1013,1035 **** gfc_conv_expr (&rse, expr->value.op.op2); gfc_add_block_to_block (&se->pre, &rse.pre); - /* For string comparisons we generate a library call, and compare the return - value with 0. */ if (checkstring) { gfc_conv_string_parameter (&lse); gfc_conv_string_parameter (&rse); - tmp = NULL_TREE; - tmp = gfc_chainon_list (tmp, lse.string_length); - tmp = gfc_chainon_list (tmp, lse.expr); - tmp = gfc_chainon_list (tmp, rse.string_length); - tmp = gfc_chainon_list (tmp, rse.expr); - - /* Build a call for the comparison. */ - lse.expr = gfc_build_function_call (gfor_fndecl_compare_string, tmp); - gfc_add_block_to_block (&lse.post, &rse.post); rse.expr = integer_zero_node; } type = gfc_typenode_for_spec (&expr->ts); --- 1044,1058 ---- gfc_conv_expr (&rse, expr->value.op.op2); gfc_add_block_to_block (&se->pre, &rse.pre); if (checkstring) { gfc_conv_string_parameter (&lse); gfc_conv_string_parameter (&rse); + lse.expr = gfc_build_compare_string (lse.string_length, lse.expr, + rse.string_length, rse.expr); rse.expr = integer_zero_node; + gfc_add_block_to_block (&lse.post, &rse.post); } type = gfc_typenode_for_spec (&expr->ts); *************** gfc_conv_expr_op (gfc_se * se, gfc_expr *** 1037,1053 **** if (lop) { /* The result of logical ops is always boolean_type_node. */ ! tmp = fold (build2 (code, type, lse.expr, rse.expr)); se->expr = convert (type, tmp); } else ! se->expr = fold (build2 (code, type, lse.expr, rse.expr)); /* Add the post blocks. */ gfc_add_block_to_block (&se->post, &rse.post); gfc_add_block_to_block (&se->post, &lse.post); } static void gfc_conv_function_val (gfc_se * se, gfc_symbol * sym) --- 1060,1133 ---- if (lop) { /* The result of logical ops is always boolean_type_node. */ ! tmp = fold_build2 (code, type, lse.expr, rse.expr); se->expr = convert (type, tmp); } else ! se->expr = fold_build2 (code, type, lse.expr, rse.expr); /* Add the post blocks. */ gfc_add_block_to_block (&se->post, &rse.post); gfc_add_block_to_block (&se->post, &lse.post); } + /* If a string's length is one, we convert it to a single character. */ + + static tree + gfc_to_single_character (tree len, tree str) + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (str))); + + if (INTEGER_CST_P (len) && TREE_INT_CST_LOW (len) == 1 + && TREE_INT_CST_HIGH (len) == 0) + { + str = fold_convert (pchar_type_node, str); + return build_fold_indirect_ref (str); + } + + return NULL_TREE; + } + + /* Compare two strings. If they are all single characters, the result is the + subtraction of them. Otherwise, we build a library call. */ + + tree + gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2) + { + tree sc1; + tree sc2; + tree type; + tree tmp; + + gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1))); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2))); + + type = gfc_get_int_type (gfc_default_integer_kind); + + sc1 = gfc_to_single_character (len1, str1); + sc2 = gfc_to_single_character (len2, str2); + + /* Deal with single character specially. */ + if (sc1 != NULL_TREE && sc2 != NULL_TREE) + { + sc1 = fold_convert (type, sc1); + sc2 = fold_convert (type, sc2); + tmp = fold_build2 (MINUS_EXPR, type, sc1, sc2); + } + else + { + tmp = NULL_TREE; + tmp = gfc_chainon_list (tmp, len1); + tmp = gfc_chainon_list (tmp, str1); + tmp = gfc_chainon_list (tmp, len2); + tmp = gfc_chainon_list (tmp, str2); + + /* Build a call for the comparison. */ + tmp = build_function_call_expr (gfor_fndecl_compare_string, tmp); + } + + return tmp; + } static void gfc_conv_function_val (gfc_se * se, gfc_symbol * sym) *************** gfc_conv_function_val (gfc_se * se, gfc_ *** 1059,1066 **** tmp = gfc_get_symbol_decl (sym); gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE && TREE_CODE (TREE_TYPE (TREE_TYPE (tmp))) == FUNCTION_TYPE); - - se->expr = tmp; } else { --- 1139,1144 ---- *************** gfc_conv_function_val (gfc_se * se, gfc_ *** 1068,1088 **** sym->backend_decl = gfc_get_extern_function_decl (sym); tmp = sym->backend_decl; ! gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL); ! se->expr = gfc_build_addr_expr (NULL, tmp); } } /* Generate code for a procedure call. Note can return se->post != NULL. If se->direct_byref is set then se->expr contains the return parameter. ! Return non-zero, if the call has alternate specifiers. */ int gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, gfc_actual_arglist * arg) { tree arglist; tree tmp; tree fntype; gfc_se parmse; --- 1146,1768 ---- sym->backend_decl = gfc_get_extern_function_decl (sym); tmp = sym->backend_decl; ! if (!POINTER_TYPE_P (TREE_TYPE (tmp))) ! { ! gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL); ! tmp = gfc_build_addr_expr (NULL, tmp); ! } ! } ! se->expr = tmp; ! } ! ! ! /* Initialize MAPPING. */ ! ! void ! gfc_init_interface_mapping (gfc_interface_mapping * mapping) ! { ! mapping->syms = NULL; ! mapping->charlens = NULL; ! } ! ! ! /* Free all memory held by MAPPING (but not MAPPING itself). */ ! ! void ! gfc_free_interface_mapping (gfc_interface_mapping * mapping) ! { ! gfc_interface_sym_mapping *sym; ! gfc_interface_sym_mapping *nextsym; ! gfc_charlen *cl; ! gfc_charlen *nextcl; ! ! for (sym = mapping->syms; sym; sym = nextsym) ! { ! nextsym = sym->next; ! gfc_free_symbol (sym->new->n.sym); ! gfc_free (sym->new); ! gfc_free (sym); ! } ! for (cl = mapping->charlens; cl; cl = nextcl) ! { ! nextcl = cl->next; ! gfc_free_expr (cl->length); ! gfc_free (cl); ! } ! } ! ! ! /* Return a copy of gfc_charlen CL. Add the returned structure to ! MAPPING so that it will be freed by gfc_free_interface_mapping. */ ! ! static gfc_charlen * ! gfc_get_interface_mapping_charlen (gfc_interface_mapping * mapping, ! gfc_charlen * cl) ! { ! gfc_charlen *new; ! ! new = gfc_get_charlen (); ! new->next = mapping->charlens; ! new->length = gfc_copy_expr (cl->length); ! ! mapping->charlens = new; ! return new; ! } ! ! ! /* A subroutine of gfc_add_interface_mapping. Return a descriptorless ! array variable that can be used as the actual argument for dummy ! argument SYM. Add any initialization code to BLOCK. PACKED is as ! for gfc_get_nodesc_array_type and DATA points to the first element ! in the passed array. */ ! ! static tree ! gfc_get_interface_mapping_array (stmtblock_t * block, gfc_symbol * sym, ! int packed, tree data) ! { ! tree type; ! tree var; ! ! type = gfc_typenode_for_spec (&sym->ts); ! type = gfc_get_nodesc_array_type (type, sym->as, packed); ! ! var = gfc_create_var (type, "ifm"); ! gfc_add_modify_expr (block, var, fold_convert (type, data)); ! ! return var; ! } ! ! ! /* A subroutine of gfc_add_interface_mapping. Set the stride, upper bounds ! and offset of descriptorless array type TYPE given that it has the same ! size as DESC. Add any set-up code to BLOCK. */ ! ! static void ! gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc) ! { ! int n; ! tree dim; ! tree offset; ! tree tmp; ! ! offset = gfc_index_zero_node; ! for (n = 0; n < GFC_TYPE_ARRAY_RANK (type); n++) ! { ! GFC_TYPE_ARRAY_STRIDE (type, n) = gfc_conv_array_stride (desc, n); ! if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE) ! { ! dim = gfc_rank_cst[n]; ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_conv_descriptor_ubound (desc, dim), ! gfc_conv_descriptor_lbound (desc, dim)); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! GFC_TYPE_ARRAY_LBOUND (type, n), ! tmp); ! tmp = gfc_evaluate_now (tmp, block); ! GFC_TYPE_ARRAY_UBOUND (type, n) = tmp; ! } ! tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, ! GFC_TYPE_ARRAY_LBOUND (type, n), ! GFC_TYPE_ARRAY_STRIDE (type, n)); ! offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp); } + offset = gfc_evaluate_now (offset, block); + GFC_TYPE_ARRAY_OFFSET (type) = offset; } + /* Extend MAPPING so that it maps dummy argument SYM to the value stored + in SE. The caller may still use se->expr and se->string_length after + calling this function. */ + + void + gfc_add_interface_mapping (gfc_interface_mapping * mapping, + gfc_symbol * sym, gfc_se * se) + { + gfc_interface_sym_mapping *sm; + tree desc; + tree tmp; + tree value; + gfc_symbol *new_sym; + gfc_symtree *root; + gfc_symtree *new_symtree; + + /* Create a new symbol to represent the actual argument. */ + new_sym = gfc_new_symbol (sym->name, NULL); + new_sym->ts = sym->ts; + new_sym->attr.referenced = 1; + new_sym->attr.dimension = sym->attr.dimension; + new_sym->attr.pointer = sym->attr.pointer; + new_sym->attr.flavor = sym->attr.flavor; + + /* Create a fake symtree for it. */ + root = NULL; + new_symtree = gfc_new_symtree (&root, sym->name); + new_symtree->n.sym = new_sym; + gcc_assert (new_symtree == root); + + /* Create a dummy->actual mapping. */ + sm = gfc_getmem (sizeof (*sm)); + sm->next = mapping->syms; + sm->old = sym; + sm->new = new_symtree; + mapping->syms = sm; + + /* Stabilize the argument's value. */ + se->expr = gfc_evaluate_now (se->expr, &se->pre); + + if (sym->ts.type == BT_CHARACTER) + { + /* Create a copy of the dummy argument's length. */ + new_sym->ts.cl = gfc_get_interface_mapping_charlen (mapping, sym->ts.cl); + + /* If the length is specified as "*", record the length that + the caller is passing. We should use the callee's length + in all other cases. */ + if (!new_sym->ts.cl->length) + { + se->string_length = gfc_evaluate_now (se->string_length, &se->pre); + new_sym->ts.cl->backend_decl = se->string_length; + } + } + + /* Use the passed value as-is if the argument is a function. */ + if (sym->attr.flavor == FL_PROCEDURE) + value = se->expr; + + /* If the argument is either a string or a pointer to a string, + convert it to a boundless character type. */ + else if (!sym->attr.dimension && sym->ts.type == BT_CHARACTER) + { + tmp = gfc_get_character_type_len (sym->ts.kind, NULL); + tmp = build_pointer_type (tmp); + if (sym->attr.pointer) + tmp = build_pointer_type (tmp); + + value = fold_convert (tmp, se->expr); + if (sym->attr.pointer) + value = gfc_build_indirect_ref (value); + } + + /* If the argument is a scalar or a pointer to an array, dereference it. */ + else if (!sym->attr.dimension || sym->attr.pointer) + value = gfc_build_indirect_ref (se->expr); + + /* If the argument is an array descriptor, use it to determine + information about the actual argument's shape. */ + else if (POINTER_TYPE_P (TREE_TYPE (se->expr)) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se->expr)))) + { + /* Get the actual argument's descriptor. */ + desc = gfc_build_indirect_ref (se->expr); + + /* Create the replacement variable. */ + tmp = gfc_conv_descriptor_data_get (desc); + value = gfc_get_interface_mapping_array (&se->pre, sym, 0, tmp); + + /* Use DESC to work out the upper bounds, strides and offset. */ + gfc_set_interface_mapping_bounds (&se->pre, TREE_TYPE (value), desc); + } + else + /* Otherwise we have a packed array. */ + value = gfc_get_interface_mapping_array (&se->pre, sym, 2, se->expr); + + new_sym->backend_decl = value; + } + + + /* Called once all dummy argument mappings have been added to MAPPING, + but before the mapping is used to evaluate expressions. Pre-evaluate + the length of each argument, adding any initialization code to PRE and + any finalization code to POST. */ + + void + gfc_finish_interface_mapping (gfc_interface_mapping * mapping, + stmtblock_t * pre, stmtblock_t * post) + { + gfc_interface_sym_mapping *sym; + gfc_expr *expr; + gfc_se se; + + for (sym = mapping->syms; sym; sym = sym->next) + if (sym->new->n.sym->ts.type == BT_CHARACTER + && !sym->new->n.sym->ts.cl->backend_decl) + { + expr = sym->new->n.sym->ts.cl->length; + gfc_apply_interface_mapping_to_expr (mapping, expr); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, expr); + + se.expr = gfc_evaluate_now (se.expr, &se.pre); + gfc_add_block_to_block (pre, &se.pre); + gfc_add_block_to_block (post, &se.post); + + sym->new->n.sym->ts.cl->backend_decl = se.expr; + } + } + + + /* Like gfc_apply_interface_mapping_to_expr, but applied to + constructor C. */ + + static void + gfc_apply_interface_mapping_to_cons (gfc_interface_mapping * mapping, + gfc_constructor * c) + { + for (; c; c = c->next) + { + gfc_apply_interface_mapping_to_expr (mapping, c->expr); + if (c->iterator) + { + gfc_apply_interface_mapping_to_expr (mapping, c->iterator->start); + gfc_apply_interface_mapping_to_expr (mapping, c->iterator->end); + gfc_apply_interface_mapping_to_expr (mapping, c->iterator->step); + } + } + } + + + /* Like gfc_apply_interface_mapping_to_expr, but applied to + reference REF. */ + + static void + gfc_apply_interface_mapping_to_ref (gfc_interface_mapping * mapping, + gfc_ref * ref) + { + int n; + + for (; ref; ref = ref->next) + switch (ref->type) + { + case REF_ARRAY: + for (n = 0; n < ref->u.ar.dimen; n++) + { + gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.start[n]); + gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.end[n]); + gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.stride[n]); + } + gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.offset); + break; + + case REF_COMPONENT: + break; + + case REF_SUBSTRING: + gfc_apply_interface_mapping_to_expr (mapping, ref->u.ss.start); + gfc_apply_interface_mapping_to_expr (mapping, ref->u.ss.end); + break; + } + } + + + /* EXPR is a copy of an expression that appeared in the interface + associated with MAPPING. Walk it recursively looking for references to + dummy arguments that MAPPING maps to actual arguments. Replace each such + reference with a reference to the associated actual argument. */ + + static void + gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping, + gfc_expr * expr) + { + gfc_interface_sym_mapping *sym; + gfc_actual_arglist *actual; + + if (!expr) + return; + + /* Copying an expression does not copy its length, so do that here. */ + if (expr->ts.type == BT_CHARACTER && expr->ts.cl) + { + expr->ts.cl = gfc_get_interface_mapping_charlen (mapping, expr->ts.cl); + gfc_apply_interface_mapping_to_expr (mapping, expr->ts.cl->length); + } + + /* Apply the mapping to any references. */ + gfc_apply_interface_mapping_to_ref (mapping, expr->ref); + + /* ...and to the expression's symbol, if it has one. */ + if (expr->symtree) + for (sym = mapping->syms; sym; sym = sym->next) + if (sym->old == expr->symtree->n.sym) + expr->symtree = sym->new; + + /* ...and to subexpressions in expr->value. */ + switch (expr->expr_type) + { + case EXPR_VARIABLE: + case EXPR_CONSTANT: + case EXPR_NULL: + case EXPR_SUBSTRING: + break; + + case EXPR_OP: + gfc_apply_interface_mapping_to_expr (mapping, expr->value.op.op1); + gfc_apply_interface_mapping_to_expr (mapping, expr->value.op.op2); + break; + + case EXPR_FUNCTION: + for (sym = mapping->syms; sym; sym = sym->next) + if (sym->old == expr->value.function.esym) + expr->value.function.esym = sym->new->n.sym; + + for (actual = expr->value.function.actual; actual; actual = actual->next) + gfc_apply_interface_mapping_to_expr (mapping, actual->expr); + break; + + case EXPR_ARRAY: + case EXPR_STRUCTURE: + gfc_apply_interface_mapping_to_cons (mapping, expr->value.constructor); + break; + } + } + + + /* Evaluate interface expression EXPR using MAPPING. Store the result + in SE. */ + + void + gfc_apply_interface_mapping (gfc_interface_mapping * mapping, + gfc_se * se, gfc_expr * expr) + { + expr = gfc_copy_expr (expr); + gfc_apply_interface_mapping_to_expr (mapping, expr); + gfc_conv_expr (se, expr); + se->expr = gfc_evaluate_now (se->expr, &se->pre); + gfc_free_expr (expr); + } + + /* Returns a reference to a temporary array into which a component of + an actual argument derived type array is copied and then returned + after the function call. + TODO Get rid of this kludge, when array descriptors are capable of + handling aliased arrays. */ + + static void + gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr, int g77) + { + gfc_se lse; + gfc_se rse; + gfc_ss *lss; + gfc_ss *rss; + gfc_loopinfo loop; + gfc_loopinfo loop2; + gfc_ss_info *info; + tree offset; + tree tmp_index; + tree tmp; + tree base_type; + stmtblock_t body; + int n; + + gcc_assert (expr->expr_type == EXPR_VARIABLE); + + gfc_init_se (&lse, NULL); + gfc_init_se (&rse, NULL); + + /* Walk the argument expression. */ + rss = gfc_walk_expr (expr); + + gcc_assert (rss != gfc_ss_terminator); + + /* Initialize the scalarizer. */ + gfc_init_loopinfo (&loop); + gfc_add_ss_to_loop (&loop, rss); + + /* Calculate the bounds of the scalarization. */ + gfc_conv_ss_startstride (&loop); + + /* Build an ss for the temporary. */ + base_type = gfc_typenode_for_spec (&expr->ts); + if (GFC_ARRAY_TYPE_P (base_type) + || GFC_DESCRIPTOR_TYPE_P (base_type)) + base_type = gfc_get_element_type (base_type); + + loop.temp_ss = gfc_get_ss ();; + loop.temp_ss->type = GFC_SS_TEMP; + loop.temp_ss->data.temp.type = base_type; + + if (expr->ts.type == BT_CHARACTER) + loop.temp_ss->string_length = expr->ts.cl->backend_decl; + + loop.temp_ss->data.temp.dimen = loop.dimen; + loop.temp_ss->next = gfc_ss_terminator; + + /* Associate the SS with the loop. */ + gfc_add_ss_to_loop (&loop, loop.temp_ss); + + /* Setup the scalarizing loops. */ + gfc_conv_loop_setup (&loop); + + /* Pass the temporary descriptor back to the caller. */ + info = &loop.temp_ss->data.info; + parmse->expr = info->descriptor; + + /* Setup the gfc_se structures. */ + gfc_copy_loopinfo_to_se (&lse, &loop); + gfc_copy_loopinfo_to_se (&rse, &loop); + + rse.ss = rss; + lse.ss = loop.temp_ss; + gfc_mark_ss_chain_used (rss, 1); + gfc_mark_ss_chain_used (loop.temp_ss, 1); + + /* Start the scalarized loop body. */ + gfc_start_scalarized_body (&loop, &body); + + /* Translate the expression. */ + gfc_conv_expr (&rse, expr); + + gfc_conv_tmp_array_ref (&lse); + gfc_advance_se_ss_chain (&lse); + + tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts.type); + gfc_add_expr_to_block (&body, tmp); + + gcc_assert (rse.ss == gfc_ss_terminator); + + gfc_trans_scalarizing_loops (&loop, &body); + + /* Add the post block after the second loop, so that any + freeing of allocated memory is done at the right time. */ + gfc_add_block_to_block (&parmse->pre, &loop.pre); + + /**********Copy the temporary back again.*********/ + + gfc_init_se (&lse, NULL); + gfc_init_se (&rse, NULL); + + /* Walk the argument expression. */ + lss = gfc_walk_expr (expr); + rse.ss = loop.temp_ss; + lse.ss = lss; + + /* Initialize the scalarizer. */ + gfc_init_loopinfo (&loop2); + gfc_add_ss_to_loop (&loop2, lss); + + /* Calculate the bounds of the scalarization. */ + gfc_conv_ss_startstride (&loop2); + + /* Setup the scalarizing loops. */ + gfc_conv_loop_setup (&loop2); + + gfc_copy_loopinfo_to_se (&lse, &loop2); + gfc_copy_loopinfo_to_se (&rse, &loop2); + + gfc_mark_ss_chain_used (lss, 1); + gfc_mark_ss_chain_used (loop.temp_ss, 1); + + /* Declare the variable to hold the temporary offset and start the + scalarized loop body. */ + offset = gfc_create_var (gfc_array_index_type, NULL); + gfc_start_scalarized_body (&loop2, &body); + + /* Build the offsets for the temporary from the loop variables. The + temporary array has lbounds of zero and strides of one in all + dimensions, so this is very simple. The offset is only computed + outside the innermost loop, so the overall transfer could be + optimised further. */ + info = &rse.ss->data.info; + + tmp_index = gfc_index_zero_node; + for (n = info->dimen - 1; n > 0; n--) + { + tree tmp_str; + tmp = rse.loop->loopvar[n]; + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, + tmp, rse.loop->from[n]); + tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, + tmp, tmp_index); + + tmp_str = fold_build2 (MINUS_EXPR, gfc_array_index_type, + rse.loop->to[n-1], rse.loop->from[n-1]); + tmp_str = fold_build2 (PLUS_EXPR, gfc_array_index_type, + tmp_str, gfc_index_one_node); + + tmp_index = fold_build2 (MULT_EXPR, gfc_array_index_type, + tmp, tmp_str); + } + + tmp_index = fold_build2 (MINUS_EXPR, gfc_array_index_type, + tmp_index, rse.loop->from[0]); + gfc_add_modify_expr (&rse.loop->code[0], offset, tmp_index); + + tmp_index = fold_build2 (PLUS_EXPR, gfc_array_index_type, + rse.loop->loopvar[0], offset); + + /* Now use the offset for the reference. */ + tmp = build_fold_indirect_ref (info->data); + rse.expr = gfc_build_array_ref (tmp, tmp_index); + + if (expr->ts.type == BT_CHARACTER) + rse.string_length = expr->ts.cl->backend_decl; + + gfc_conv_expr (&lse, expr); + + gcc_assert (lse.ss == gfc_ss_terminator); + + tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts.type); + gfc_add_expr_to_block (&body, tmp); + + /* Generate the copying loops. */ + gfc_trans_scalarizing_loops (&loop2, &body); + + /* Wrap the whole thing up by adding the second loop to the post-block + and following it by the post-block of the fist loop. In this way, + if the temporary needs freeing, it is done after use! */ + gfc_add_block_to_block (&parmse->post, &loop2.pre); + gfc_add_block_to_block (&parmse->post, &loop2.post); + + gfc_add_block_to_block (&parmse->post, &loop.post); + + gfc_cleanup_loop (&loop); + gfc_cleanup_loop (&loop2); + + /* Pass the string length to the argument expression. */ + if (expr->ts.type == BT_CHARACTER) + parmse->string_length = expr->ts.cl->backend_decl; + + /* We want either the address for the data or the address of the descriptor, + depending on the mode of passing array arguments. */ + if (g77) + parmse->expr = gfc_conv_descriptor_data_get (parmse->expr); + else + parmse->expr = build_fold_addr_expr (parmse->expr); + + return; + } + + /* Is true if the last array reference is followed by a component reference. */ + + static bool + is_aliased_array (gfc_expr * e) + { + gfc_ref * ref; + bool seen_array; + + seen_array = false; + for (ref = e->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY) + seen_array = true; + + if (ref->next == NULL && ref->type == REF_COMPONENT) + return seen_array; + } + return false; + } + /* Generate code for a procedure call. Note can return se->post != NULL. If se->direct_byref is set then se->expr contains the return parameter. ! Return nonzero, if the call has alternate specifiers. */ int gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, gfc_actual_arglist * arg) { + gfc_interface_mapping mapping; tree arglist; + tree retargs; tree tmp; tree fntype; gfc_se parmse; *************** gfc_conv_function_call (gfc_se * se, gfc *** 1095,1115 **** tree stringargs; gfc_formal_arglist *formal; int has_alternate_specifier = 0; arglist = NULL_TREE; stringargs = NULL_TREE; var = NULL_TREE; len = NULL_TREE; - /* Obtain the string length now because it is needed often below. */ - if (sym->ts.type == BT_CHARACTER) - { - gcc_assert (sym->ts.cl && sym->ts.cl->length - && sym->ts.cl->length->expr_type == EXPR_CONSTANT); - len = gfc_conv_mpz_to_tree - (sym->ts.cl->length->value.integer, sym->ts.cl->length->ts.kind); - } - if (se->ss != NULL) { if (!sym->attr.elemental) --- 1775,1790 ---- tree stringargs; gfc_formal_arglist *formal; int has_alternate_specifier = 0; + bool need_interface_mapping; + gfc_typespec ts; + gfc_charlen cl; arglist = NULL_TREE; + retargs = NULL_TREE; stringargs = NULL_TREE; var = NULL_TREE; len = NULL_TREE; if (se->ss != NULL) { if (!sym->attr.elemental) *************** gfc_conv_function_call (gfc_se * se, gfc *** 1124,1132 **** /* Access the previously obtained result. */ gfc_conv_tmp_array_ref (se); gfc_advance_se_ss_chain (se); - - /* Bundle in the string length. */ - se->string_length = len; return 0; } } --- 1799,1804 ---- *************** gfc_conv_function_call (gfc_se * se, gfc *** 1135,1225 **** else info = NULL; ! byref = gfc_return_by_reference (sym); ! if (byref) ! { ! if (se->direct_byref) ! { ! arglist = gfc_chainon_list (arglist, se->expr); ! ! /* Add string length to argument list. */ ! if (sym->ts.type == BT_CHARACTER) ! { ! sym->ts.cl->backend_decl = len; ! arglist = gfc_chainon_list (arglist, ! convert (gfc_charlen_type_node, len)); ! } ! } ! else if (sym->result->attr.dimension) ! { ! gcc_assert (se->loop && se->ss); ! ! /* Set the type of the array. */ ! tmp = gfc_typenode_for_spec (&sym->ts); ! info->dimen = se->loop->dimen; ! ! /* Allocate a temporary to store the result. */ ! gfc_trans_allocate_temp_array (se->loop, info, tmp); ! ! /* Zero the first stride to indicate a temporary. */ ! tmp = ! gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]); ! gfc_add_modify_expr (&se->pre, tmp, ! convert (TREE_TYPE (tmp), integer_zero_node)); ! ! /* Pass the temporary as the first argument. */ ! tmp = info->descriptor; ! tmp = gfc_build_addr_expr (NULL, tmp); ! arglist = gfc_chainon_list (arglist, tmp); ! ! /* Add string length to argument list. */ ! if (sym->ts.type == BT_CHARACTER) ! { ! sym->ts.cl->backend_decl = len; ! arglist = gfc_chainon_list (arglist, ! convert (gfc_charlen_type_node, len)); ! } ! ! } ! else if (sym->ts.type == BT_CHARACTER) ! { ! ! /* Pass the string length. */ ! sym->ts.cl->backend_decl = len; ! type = gfc_get_character_type (sym->ts.kind, sym->ts.cl); ! type = build_pointer_type (type); ! ! /* Return an address to a char[0:len-1]* temporary for character pointers. */ ! if (sym->attr.pointer || sym->attr.allocatable) ! { ! /* Build char[0:len-1] * pstr. */ ! tmp = fold (build2 (MINUS_EXPR, gfc_charlen_type_node, len, ! build_int_cst (gfc_charlen_type_node, 1))); ! tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); ! tmp = build_array_type (gfc_character1_type_node, tmp); ! var = gfc_create_var (build_pointer_type (tmp), "pstr"); ! ! /* Provide an address expression for the function arguments. */ ! var = gfc_build_addr_expr (NULL, var); ! } ! else ! { ! var = gfc_conv_string_tmp (se, type, len); ! } ! arglist = gfc_chainon_list (arglist, var); ! arglist = gfc_chainon_list (arglist, ! convert (gfc_charlen_type_node, len)); ! } ! else ! { ! gcc_assert (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX); ! ! type = gfc_get_complex_type (sym->ts.kind); ! var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx")); ! arglist = gfc_chainon_list (arglist, var); ! } ! } ! formal = sym->formal; /* Evaluate the arguments. */ for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL) --- 1807,1818 ---- else info = NULL; ! gfc_init_interface_mapping (&mapping); ! need_interface_mapping = ((sym->ts.type == BT_CHARACTER ! && sym->ts.cl->length ! && sym->ts.cl->length->expr_type ! != EXPR_CONSTANT) ! || sym->attr.dimension); formal = sym->formal; /* Evaluate the arguments. */ for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL) *************** gfc_conv_function_call (gfc_se * se, gfc *** 1244,1255 **** gfc_init_se (&parmse, NULL); parmse.expr = null_pointer_node; if (arg->missing_arg_type == BT_CHARACTER) ! { ! stringargs = ! gfc_chainon_list (stringargs, ! convert (gfc_charlen_type_node, ! integer_zero_node)); ! } } } else if (se->ss && se->ss->useflags) --- 1837,1844 ---- gfc_init_se (&parmse, NULL); parmse.expr = null_pointer_node; if (arg->missing_arg_type == BT_CHARACTER) ! parmse.string_length = convert (gfc_charlen_type_node, ! integer_zero_node); } } else if (se->ss && se->ss->useflags) *************** gfc_conv_function_call (gfc_se * se, gfc *** 1290,1299 **** && !formal->sym->attr.pointer && formal->sym->as->type != AS_ASSUMED_SHAPE; f = f || !sym->attr.always_explicit; ! gfc_conv_array_parameter (&parmse, arg->expr, argss, f); } } gfc_add_block_to_block (&se->pre, &parmse.pre); gfc_add_block_to_block (&se->post, &parmse.post); --- 1879,1899 ---- && !formal->sym->attr.pointer && formal->sym->as->type != AS_ASSUMED_SHAPE; f = f || !sym->attr.always_explicit; ! if (arg->expr->expr_type == EXPR_VARIABLE ! && is_aliased_array (arg->expr)) ! /* The actual argument is a component reference to an ! array of derived types. In this case, the argument ! is converted to a temporary, which is passed and then ! written back after the procedure call. */ ! gfc_conv_aliased_arg (&parmse, arg->expr, f); ! else ! gfc_conv_array_parameter (&parmse, arg->expr, argss, f); } } + if (formal && need_interface_mapping) + gfc_add_interface_mapping (&mapping, formal->sym, &parmse); + gfc_add_block_to_block (&se->pre, &parmse.pre); gfc_add_block_to_block (&se->post, &parmse.post); *************** gfc_conv_function_call (gfc_se * se, gfc *** 1304,1309 **** --- 1904,2018 ---- arglist = gfc_chainon_list (arglist, parmse.expr); } + gfc_finish_interface_mapping (&mapping, &se->pre, &se->post); + + ts = sym->ts; + if (ts.type == BT_CHARACTER) + { + if (sym->ts.cl->length == NULL) + { + /* Assumed character length results are not allowed by 5.1.1.5 of the + standard and are trapped in resolve.c; except in the case of SPREAD + (and other intrinsics?). In this case, we take the character length + of the first argument for the result. */ + cl.backend_decl = TREE_VALUE (stringargs); + } + else + { + /* Calculate the length of the returned string. */ + gfc_init_se (&parmse, NULL); + if (need_interface_mapping) + gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.cl->length); + else + gfc_conv_expr (&parmse, sym->ts.cl->length); + gfc_add_block_to_block (&se->pre, &parmse.pre); + gfc_add_block_to_block (&se->post, &parmse.post); + cl.backend_decl = fold_convert (gfc_charlen_type_node, parmse.expr); + } + + /* Set up a charlen structure for it. */ + cl.next = NULL; + cl.length = NULL; + ts.cl = &cl; + + len = cl.backend_decl; + } + + byref = gfc_return_by_reference (sym); + if (byref) + { + if (se->direct_byref) + retargs = gfc_chainon_list (retargs, se->expr); + else if (sym->result->attr.dimension) + { + gcc_assert (se->loop && info); + + /* Set the type of the array. */ + tmp = gfc_typenode_for_spec (&ts); + info->dimen = se->loop->dimen; + + /* Evaluate the bounds of the result, if known. */ + gfc_set_loop_bounds_from_array_spec (&mapping, se, sym->result->as); + + /* Allocate a temporary to store the result. In case the function + returns a pointer, the temporary will be a shallow copy and + mustn't be deallocated. */ + gfc_trans_allocate_temp_array (&se->pre, &se->post, se->loop, info, + tmp, false, !sym->attr.pointer); + + /* Zero the first stride to indicate a temporary. */ + tmp = gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]); + gfc_add_modify_expr (&se->pre, tmp, + convert (TREE_TYPE (tmp), integer_zero_node)); + + /* Pass the temporary as the first argument. */ + tmp = info->descriptor; + tmp = gfc_build_addr_expr (NULL, tmp); + retargs = gfc_chainon_list (retargs, tmp); + } + else if (ts.type == BT_CHARACTER) + { + /* Pass the string length. */ + type = gfc_get_character_type (ts.kind, ts.cl); + type = build_pointer_type (type); + + /* Return an address to a char[0:len-1]* temporary for + character pointers. */ + if (sym->attr.pointer || sym->attr.allocatable) + { + /* Build char[0:len-1] * pstr. */ + tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, len, + build_int_cst (gfc_charlen_type_node, 1)); + tmp = build_range_type (gfc_array_index_type, + gfc_index_zero_node, tmp); + tmp = build_array_type (gfc_character1_type_node, tmp); + var = gfc_create_var (build_pointer_type (tmp), "pstr"); + + /* Provide an address expression for the function arguments. */ + var = gfc_build_addr_expr (NULL, var); + } + else + var = gfc_conv_string_tmp (se, type, len); + + retargs = gfc_chainon_list (retargs, var); + } + else + { + gcc_assert (gfc_option.flag_f2c && ts.type == BT_COMPLEX); + + type = gfc_get_complex_type (ts.kind); + var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx")); + retargs = gfc_chainon_list (retargs, var); + } + + /* Add the string length to the argument list. */ + if (ts.type == BT_CHARACTER) + retargs = gfc_chainon_list (retargs, len); + } + gfc_free_interface_mapping (&mapping); + + /* Add the return arguments. */ + arglist = chainon (retargs, arglist); /* Add the hidden string length parameters to the arguments. */ arglist = chainon (arglist, stringargs); *************** gfc_conv_function_call (gfc_se * se, gfc *** 1327,1335 **** se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr, arglist, NULL_TREE); - if (sym->result) - sym = sym->result; - /* If we have a pointer function, but we don't want a pointer, e.g. something like x = f() --- 2036,2041 ---- *************** gfc_conv_function_call (gfc_se * se, gfc *** 1368,1374 **** { /* Check the data pointer hasn't been modified. This would happen in a function returning a pointer. */ ! tmp = gfc_conv_descriptor_data (info->descriptor); tmp = build2 (NE_EXPR, boolean_type_node, tmp, info->data); gfc_trans_runtime_check (tmp, gfc_strconst_fault, &se->pre); } --- 2074,2080 ---- { /* Check the data pointer hasn't been modified. This would happen in a function returning a pointer. */ ! tmp = gfc_conv_descriptor_data_get (info->descriptor); tmp = build2 (NE_EXPR, boolean_type_node, tmp, info->data); gfc_trans_runtime_check (tmp, gfc_strconst_fault, &se->pre); } *************** gfc_trans_string_copy (stmtblock_t * blo *** 1405,1410 **** --- 2111,2127 ---- tree slen, tree src) { tree tmp; + tree dsc; + tree ssc; + + /* Deal with single character specially. */ + dsc = gfc_to_single_character (dlen, dest); + ssc = gfc_to_single_character (slen, src); + if (dsc != NULL_TREE && ssc != NULL_TREE) + { + gfc_add_modify_expr (block, dsc, ssc); + return; + } tmp = NULL_TREE; tmp = gfc_chainon_list (tmp, dlen); *************** gfc_trans_subcomponent_assign (tree dest *** 1731,1742 **** { /* Array pointer. */ if (expr->expr_type == EXPR_NULL) ! { ! dest = gfc_conv_descriptor_data (dest); ! tmp = fold_convert (TREE_TYPE (se.expr), ! null_pointer_node); ! gfc_add_modify_expr (&block, dest, tmp); ! } else { rss = gfc_walk_expr (expr); --- 2448,2454 ---- { /* Array pointer. */ if (expr->expr_type == EXPR_NULL) ! gfc_conv_descriptor_data_set (&block, dest, null_pointer_node); else { rss = gfc_walk_expr (expr); *************** gfc_conv_structure (gfc_se * se, gfc_exp *** 1822,1832 **** { gfc_constructor *c; gfc_component *cm; - tree head; - tree tail; tree val; tree type; tree tmp; gcc_assert (se->ss == NULL); gcc_assert (expr->expr_type == EXPR_STRUCTURE); --- 2534,2543 ---- { gfc_constructor *c; gfc_component *cm; tree val; tree type; tree tmp; + VEC(constructor_elt,gc) *v = NULL; gcc_assert (se->ss == NULL); gcc_assert (expr->expr_type == EXPR_STRUCTURE); *************** gfc_conv_structure (gfc_se * se, gfc_exp *** 1841,1849 **** return; } - head = build1 (CONSTRUCTOR, type, NULL_TREE); - tail = NULL_TREE; - cm = expr->ts.derived->components; for (c = expr->value.constructor; c; c = c->next, cm = cm->next) { --- 2552,2557 ---- *************** gfc_conv_structure (gfc_se * se, gfc_exp *** 1854,1872 **** val = gfc_conv_initializer (c->expr, &cm->ts, TREE_TYPE (cm->backend_decl), cm->dimension, cm->pointer); ! /* Build a TREE_CHAIN to hold it. */ ! val = tree_cons (cm->backend_decl, val, NULL_TREE); ! ! /* Add it to the list. */ ! if (tail == NULL_TREE) ! TREE_OPERAND(head, 0) = tail = val; ! else ! { ! TREE_CHAIN (tail) = val; ! tail = val; ! } } ! se->expr = head; } --- 2562,2571 ---- val = gfc_conv_initializer (c->expr, &cm->ts, TREE_TYPE (cm->backend_decl), cm->dimension, cm->pointer); ! /* Append it to the constructor list. */ ! CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val); } ! se->expr = build_constructor (type, v); } *************** gfc_trans_pointer_assignment (gfc_expr * *** 2063,2068 **** --- 2762,2769 ---- gfc_ss *lss; gfc_ss *rss; stmtblock_t block; + tree desc; + tree tmp; gfc_start_block (&block); *************** gfc_trans_pointer_assignment (gfc_expr * *** 2090,2106 **** { /* Array pointer. */ gfc_conv_expr_descriptor (&lse, expr1, lss); ! /* Implement Nullify. */ ! if (expr2->expr_type == EXPR_NULL) ! { ! lse.expr = gfc_conv_descriptor_data (lse.expr); ! rse.expr = fold_convert (TREE_TYPE (lse.expr), null_pointer_node); ! gfc_add_modify_expr (&block, lse.expr, rse.expr); ! } ! else ! { lse.direct_byref = 1; ! gfc_conv_expr_descriptor (&lse, expr2, rss); } gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &lse.post); --- 2791,2820 ---- { /* Array pointer. */ gfc_conv_expr_descriptor (&lse, expr1, lss); ! switch (expr2->expr_type) ! { ! case EXPR_NULL: ! /* Just set the data pointer to null. */ ! gfc_conv_descriptor_data_set (&block, lse.expr, null_pointer_node); ! break; ! ! case EXPR_VARIABLE: ! /* Assign directly to the pointer's descriptor. */ lse.direct_byref = 1; ! gfc_conv_expr_descriptor (&lse, expr2, rss); ! break; ! ! default: ! /* Assign to a temporary descriptor and then copy that ! temporary to the pointer. */ ! desc = lse.expr; ! tmp = gfc_create_var (TREE_TYPE (desc), "ptrtemp"); ! ! lse.expr = tmp; ! lse.direct_byref = 1; ! gfc_conv_expr_descriptor (&lse, expr2, rss); ! gfc_add_modify_expr (&lse.pre, desc, tmp); ! break; } gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &lse.post); *************** gfc_trans_arrayfunc_assign (gfc_expr * e *** 2185,2199 **** { gfc_se se; gfc_ss *ss; /* The caller has already checked rank>0 and expr_type == EXPR_FUNCTION. */ if (expr2->value.function.isym && !gfc_is_intrinsic_libcall (expr2)) return NULL; /* Elemental functions don't need a temporary anyway. */ ! if (expr2->symtree->n.sym->attr.elemental) return NULL; /* Check for a dependency. */ if (gfc_check_fncall_dependency (expr1, expr2)) return NULL; --- 2899,2938 ---- { gfc_se se; gfc_ss *ss; + gfc_ref * ref; + bool seen_array_ref; /* The caller has already checked rank>0 and expr_type == EXPR_FUNCTION. */ if (expr2->value.function.isym && !gfc_is_intrinsic_libcall (expr2)) return NULL; /* Elemental functions don't need a temporary anyway. */ ! if (expr2->value.function.esym != NULL ! && expr2->value.function.esym->attr.elemental) ! return NULL; ! ! /* Fail if EXPR1 can't be expressed as a descriptor. */ ! if (gfc_ref_needs_temporary_p (expr1->ref)) ! return NULL; ! ! /* Functions returning pointers need temporaries. */ ! if (expr2->symtree->n.sym->attr.pointer) return NULL; + /* Check that no LHS component references appear during an array + reference. This is needed because we do not have the means to + span any arbitrary stride with an array descriptor. This check + is not needed for the rhs because the function result has to be + a complete type. */ + seen_array_ref = false; + for (ref = expr1->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY) + seen_array_ref= true; + else if (ref->type == REF_COMPONENT && seen_array_ref) + return NULL; + } + /* Check for a dependency. */ if (gfc_check_fncall_dependency (expr1, expr2)) return NULL; *************** gfc_trans_assignment (gfc_expr * expr1, *** 2287,2293 **** /* Calculate the bounds of the scalarization. */ gfc_conv_ss_startstride (&loop); /* Resolve any data dependencies in the statement. */ ! gfc_conv_resolve_dependencies (&loop, lss_section, rss); /* Setup the scalarizing loops. */ gfc_conv_loop_setup (&loop); --- 3026,3032 ---- /* Calculate the bounds of the scalarization. */ gfc_conv_ss_startstride (&loop); /* Resolve any data dependencies in the statement. */ ! gfc_conv_resolve_dependencies (&loop, lss, rss); /* Setup the scalarizing loops. */ gfc_conv_loop_setup (&loop); diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-intrinsic.c gcc-4.1.0/gcc/fortran/trans-intrinsic.c *** gcc-4.0.2/gcc/fortran/trans-intrinsic.c Tue Aug 9 17:44:03 2005 --- gcc-4.1.0/gcc/fortran/trans-intrinsic.c Sat Jan 14 06:31:08 2006 *************** *** 1,5 **** /* Intrinsic translation ! Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher --- 1,5 ---- /* Intrinsic translation ! Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* trans-intrinsic.c-- generate GENERIC trees for calls to intrinsics. */ --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* trans-intrinsic.c-- generate GENERIC trees for calls to intrinsics. */ *************** typedef struct gfc_intrinsic_map_t GTY(( *** 52,65 **** /* Enum value from the "language-independent", aka C-centric, part of gcc, or END_BUILTINS of no such value set. */ ! /* ??? There are now complex variants in builtins.def, though we ! don't currently do anything with them. */ ! enum built_in_function code4; ! enum built_in_function code8; /* True if the naming pattern is to prepend "c" for complex and append "f" for kind=4. False if the naming pattern is to ! prepend "_gfortran_" and append "[rc][48]". */ bool libm_name; /* True if a complex version of the function exists. */ --- 52,69 ---- /* Enum value from the "language-independent", aka C-centric, part of gcc, or END_BUILTINS of no such value set. */ ! enum built_in_function code_r4; ! enum built_in_function code_r8; ! enum built_in_function code_r10; ! enum built_in_function code_r16; ! enum built_in_function code_c4; ! enum built_in_function code_c8; ! enum built_in_function code_c10; ! enum built_in_function code_c16; /* True if the naming pattern is to prepend "c" for complex and append "f" for kind=4. False if the naming pattern is to ! prepend "_gfortran_" and append "[rc](4|8|10|16)". */ bool libm_name; /* True if a complex version of the function exists. */ *************** typedef struct gfc_intrinsic_map_t GTY(( *** 74,105 **** /* Cache decls created for the various operand types. */ tree real4_decl; tree real8_decl; tree complex4_decl; tree complex8_decl; } gfc_intrinsic_map_t; /* ??? The NARGS==1 hack here is based on the fact that (c99 at least) defines complex variants of all of the entries in mathbuiltins.def except for atan2. */ ! #define BUILT_IN_FUNCTION(ID, NAME, HAVE_COMPLEX) \ ! { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, true, \ ! HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE}, ! ! #define DEFINE_MATH_BUILTIN(id, name, argtype) \ ! BUILT_IN_FUNCTION (id, name, false) ! /* TODO: Use builtin function for complex intrinsics. */ ! #define DEFINE_MATH_BUILTIN_C(id, name, argtype) \ ! BUILT_IN_FUNCTION (id, name, true) #define LIBM_FUNCTION(ID, NAME, HAVE_COMPLEX) \ ! { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, true, HAVE_COMPLEX, true, \ ! NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE } #define LIBF_FUNCTION(ID, NAME, HAVE_COMPLEX) \ ! { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, false, HAVE_COMPLEX, true, \ ! NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE } static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] = { --- 78,119 ---- /* Cache decls created for the various operand types. */ tree real4_decl; tree real8_decl; + tree real10_decl; + tree real16_decl; tree complex4_decl; tree complex8_decl; + tree complex10_decl; + tree complex16_decl; } gfc_intrinsic_map_t; /* ??? The NARGS==1 hack here is based on the fact that (c99 at least) defines complex variants of all of the entries in mathbuiltins.def except for atan2. */ ! #define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE) \ ! { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \ ! BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, 0, 0, 0, 0, true, \ ! false, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \ ! NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE}, ! #define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE) \ ! { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \ ! BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, BUILT_IN_C ## ID ## F, \ ! BUILT_IN_C ## ID, BUILT_IN_C ## ID ## L, BUILT_IN_C ## ID ## L, true, \ ! true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \ ! NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE}, #define LIBM_FUNCTION(ID, NAME, HAVE_COMPLEX) \ ! { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ ! END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ ! true, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \ ! NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE } #define LIBF_FUNCTION(ID, NAME, HAVE_COMPLEX) \ ! { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ ! END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ ! false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \ ! NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE } static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] = { *************** static GTY(()) gfc_intrinsic_map_t gfc_i *** 122,128 **** }; #undef DEFINE_MATH_BUILTIN #undef DEFINE_MATH_BUILTIN_C - #undef BUILT_IN_FUNCTION #undef LIBM_FUNCTION #undef LIBF_FUNCTION --- 136,141 ---- *************** gfc_conv_intrinsic_function_args (gfc_se *** 158,164 **** args = NULL_TREE; for (actual = expr->value.function.actual; actual; actual = actual->next) { ! /* Skip ommitted optional arguments. */ if (!actual->expr) continue; --- 171,177 ---- args = NULL_TREE; for (actual = expr->value.function.actual; actual; actual = actual->next) { ! /* Skip omitted optional arguments. */ if (!actual->expr) continue; *************** build_round_expr (stmtblock_t * pblock, *** 264,274 **** neg = build_real (argtype, r); tmp = gfc_build_const (argtype, integer_zero_node); ! cond = fold (build2 (GT_EXPR, boolean_type_node, arg, tmp)); ! tmp = fold (build3 (COND_EXPR, argtype, cond, pos, neg)); ! tmp = fold (build2 (PLUS_EXPR, argtype, arg, tmp)); ! return fold (build1 (FIX_TRUNC_EXPR, type, tmp)); } --- 277,287 ---- neg = build_real (argtype, r); tmp = gfc_build_const (argtype, integer_zero_node); ! cond = fold_build2 (GT_EXPR, boolean_type_node, arg, tmp); ! tmp = fold_build3 (COND_EXPR, argtype, cond, pos, neg); ! tmp = fold_build2 (PLUS_EXPR, argtype, arg, tmp); ! return fold_build1 (FIX_TRUNC_EXPR, type, tmp); } *************** gfc_conv_intrinsic_aint (gfc_se * se, gf *** 336,341 **** --- 349,359 ---- case 8: n = BUILT_IN_ROUND; break; + + case 10: + case 16: + n = BUILT_IN_ROUNDL; + break; } break; *************** gfc_conv_intrinsic_aint (gfc_se * se, gf *** 349,354 **** --- 367,377 ---- case 8: n = BUILT_IN_TRUNC; break; + + case 10: + case 16: + n = BUILT_IN_TRUNCL; + break; } break; *************** gfc_build_intrinsic_lib_fndecls (void) *** 469,478 **** /* Add GCC builtin functions. */ for (m = gfc_intrinsic_map; m->id != GFC_ISYM_NONE; m++) { ! if (m->code4 != END_BUILTINS) ! m->real4_decl = built_in_decls[m->code4]; ! if (m->code8 != END_BUILTINS) ! m->real8_decl = built_in_decls[m->code8]; } } --- 492,513 ---- /* Add GCC builtin functions. */ for (m = gfc_intrinsic_map; m->id != GFC_ISYM_NONE; m++) { ! if (m->code_r4 != END_BUILTINS) ! m->real4_decl = built_in_decls[m->code_r4]; ! if (m->code_r8 != END_BUILTINS) ! m->real8_decl = built_in_decls[m->code_r8]; ! if (m->code_r10 != END_BUILTINS) ! m->real10_decl = built_in_decls[m->code_r10]; ! if (m->code_r16 != END_BUILTINS) ! m->real16_decl = built_in_decls[m->code_r16]; ! if (m->code_c4 != END_BUILTINS) ! m->complex4_decl = built_in_decls[m->code_c4]; ! if (m->code_c8 != END_BUILTINS) ! m->complex8_decl = built_in_decls[m->code_c8]; ! if (m->code_c10 != END_BUILTINS) ! m->complex10_decl = built_in_decls[m->code_c10]; ! if (m->code_c16 != END_BUILTINS) ! m->complex16_decl = built_in_decls[m->code_c16]; } } *************** gfc_get_intrinsic_lib_fndecl (gfc_intrin *** 501,506 **** --- 536,547 ---- case 8: pdecl = &m->real8_decl; break; + case 10: + pdecl = &m->real10_decl; + break; + case 16: + pdecl = &m->real16_decl; + break; default: gcc_unreachable (); } *************** gfc_get_intrinsic_lib_fndecl (gfc_intrin *** 517,522 **** --- 558,569 ---- case 8: pdecl = &m->complex8_decl; break; + case 10: + pdecl = &m->complex10_decl; + break; + case 16: + pdecl = &m->complex16_decl; + break; default: gcc_unreachable (); } *************** gfc_get_intrinsic_lib_fndecl (gfc_intrin *** 529,535 **** if (m->libm_name) { ! gcc_assert (ts->kind == 4 || ts->kind == 8); snprintf (name, sizeof (name), "%s%s%s", ts->type == BT_COMPLEX ? "c" : "", m->name, --- 576,583 ---- if (m->libm_name) { ! gcc_assert (ts->kind == 4 || ts->kind == 8 || ts->kind == 10 ! || ts->kind == 16); snprintf (name, sizeof (name), "%s%s%s", ts->type == BT_COMPLEX ? "c" : "", m->name, *************** gfc_conv_intrinsic_exponent (gfc_se * se *** 615,620 **** --- 663,674 ---- case 8: fndecl = gfor_fndecl_math_exponent8; break; + case 10: + fndecl = gfor_fndecl_math_exponent10; + break; + case 16: + fndecl = gfor_fndecl_math_exponent16; + break; default: gcc_unreachable (); } *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 639,645 **** gfc_ss *ss; int i; - gfc_init_se (&argse, NULL); arg = expr->value.function.actual; arg2 = arg->next; --- 693,698 ---- *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 651,658 **** gcc_assert (se->ss->expr == expr); gfc_advance_se_ss_chain (se); bound = se->loop->loopvar[0]; ! bound = fold (build2 (MINUS_EXPR, gfc_array_index_type, bound, ! se->loop->from[0])); } else { --- 704,711 ---- gcc_assert (se->ss->expr == expr); gfc_advance_se_ss_chain (se); bound = se->loop->loopvar[0]; ! bound = fold_build2 (MINUS_EXPR, gfc_array_index_type, bound, ! se->loop->from[0]); } else { *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 663,677 **** gfc_add_block_to_block (&se->pre, &argse.pre); bound = argse.expr; /* Convert from one based to zero based. */ ! bound = fold (build2 (MINUS_EXPR, gfc_array_index_type, bound, ! gfc_index_one_node)); } /* TODO: don't re-evaluate the descriptor on each iteration. */ /* Get a descriptor for the first parameter. */ ss = gfc_walk_expr (arg->expr); gcc_assert (ss != gfc_ss_terminator); ! argse.want_pointer = 0; gfc_conv_expr_descriptor (&argse, arg->expr, ss); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); --- 716,730 ---- gfc_add_block_to_block (&se->pre, &argse.pre); bound = argse.expr; /* Convert from one based to zero based. */ ! bound = fold_build2 (MINUS_EXPR, gfc_array_index_type, bound, ! gfc_index_one_node); } /* TODO: don't re-evaluate the descriptor on each iteration. */ /* Get a descriptor for the first parameter. */ ss = gfc_walk_expr (arg->expr); gcc_assert (ss != gfc_ss_terminator); ! gfc_init_se (&argse, NULL); gfc_conv_expr_descriptor (&argse, arg->expr, ss); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); *************** gfc_conv_intrinsic_bound (gfc_se * se, g *** 689,699 **** if (flag_bounds_check) { bound = gfc_evaluate_now (bound, &se->pre); ! cond = fold (build2 (LT_EXPR, boolean_type_node, ! bound, build_int_cst (TREE_TYPE (bound), 0))); tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; ! tmp = fold (build2 (GE_EXPR, boolean_type_node, bound, tmp)); ! cond = fold(build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp)); gfc_trans_runtime_check (cond, gfc_strconst_fault, &se->pre); } } --- 742,752 ---- if (flag_bounds_check) { bound = gfc_evaluate_now (bound, &se->pre); ! cond = fold_build2 (LT_EXPR, boolean_type_node, ! bound, build_int_cst (TREE_TYPE (bound), 0)); tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; ! tmp = fold_build2 (GE_EXPR, boolean_type_node, bound, tmp); ! cond = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp); gfc_trans_runtime_check (cond, gfc_strconst_fault, &se->pre); } } *************** gfc_conv_intrinsic_abs (gfc_se * se, gfc *** 735,740 **** --- 788,797 ---- case 8: n = BUILT_IN_CABS; break; + case 10: + case 16: + n = BUILT_IN_CABSL; + break; default: gcc_unreachable (); } *************** gfc_conv_intrinsic_cmplx (gfc_se * se, g *** 771,777 **** else imag = build_real_from_int_cst (TREE_TYPE (type), integer_zero_node); ! se->expr = fold (build2 (COMPLEX_EXPR, type, real, imag)); } /* Remainder function MOD(A, P) = A - INT(A / P) * P --- 828,834 ---- else imag = build_real_from_int_cst (TREE_TYPE (type), integer_zero_node); ! se->expr = fold_build2 (COMPLEX_EXPR, type, real, imag); } /* Remainder function MOD(A, P) = A - INT(A / P) * P *************** gfc_conv_intrinsic_sign (gfc_se * se, gf *** 897,902 **** --- 954,963 ---- case 8: tmp = built_in_decls[BUILT_IN_COPYSIGN]; break; + case 10: + case 16: + tmp = built_in_decls[BUILT_IN_COPYSIGNL]; + break; default: gcc_unreachable (); } *************** gfc_conv_intrinsic_sign (gfc_se * se, gf *** 909,919 **** type = TREE_TYPE (arg); zero = gfc_build_const (type, integer_zero_node); ! testa = fold (build2 (GE_EXPR, boolean_type_node, arg, zero)); ! testb = fold (build2 (GE_EXPR, boolean_type_node, arg2, zero)); ! tmp = fold (build2 (TRUTH_XOR_EXPR, boolean_type_node, testa, testb)); ! se->expr = fold (build3 (COND_EXPR, type, tmp, ! build1 (NEGATE_EXPR, type, arg), arg)); } --- 970,980 ---- type = TREE_TYPE (arg); zero = gfc_build_const (type, integer_zero_node); ! testa = fold_build2 (GE_EXPR, boolean_type_node, arg, zero); ! testb = fold_build2 (GE_EXPR, boolean_type_node, arg2, zero); ! tmp = fold_build2 (TRUTH_XOR_EXPR, boolean_type_node, testa, testb); ! se->expr = fold_build3 (COND_EXPR, type, tmp, ! build1 (NEGATE_EXPR, type, arg), arg); } *************** gfc_conv_intrinsic_char (gfc_se * se, gf *** 976,981 **** --- 1037,1152 ---- } + static void + gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr) + { + tree var; + tree len; + tree tmp; + tree arglist; + tree type; + tree cond; + tree gfc_int8_type_node = gfc_get_int_type (8); + + type = build_pointer_type (gfc_character1_type_node); + var = gfc_create_var (type, "pstr"); + len = gfc_create_var (gfc_int8_type_node, "len"); + + tmp = gfc_conv_intrinsic_function_args (se, expr); + arglist = gfc_chainon_list (NULL_TREE, gfc_build_addr_expr (NULL, var)); + arglist = gfc_chainon_list (arglist, gfc_build_addr_expr (NULL, len)); + arglist = chainon (arglist, tmp); + + tmp = gfc_build_function_call (gfor_fndecl_ctime, arglist); + gfc_add_expr_to_block (&se->pre, tmp); + + /* Free the temporary afterwards, if necessary. */ + cond = build2 (GT_EXPR, boolean_type_node, len, + build_int_cst (TREE_TYPE (len), 0)); + arglist = gfc_chainon_list (NULL_TREE, var); + tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist); + tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); + gfc_add_expr_to_block (&se->post, tmp); + + se->expr = var; + se->string_length = len; + } + + + static void + gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr) + { + tree var; + tree len; + tree tmp; + tree arglist; + tree type; + tree cond; + tree gfc_int4_type_node = gfc_get_int_type (4); + + type = build_pointer_type (gfc_character1_type_node); + var = gfc_create_var (type, "pstr"); + len = gfc_create_var (gfc_int4_type_node, "len"); + + tmp = gfc_conv_intrinsic_function_args (se, expr); + arglist = gfc_chainon_list (NULL_TREE, gfc_build_addr_expr (NULL, var)); + arglist = gfc_chainon_list (arglist, gfc_build_addr_expr (NULL, len)); + arglist = chainon (arglist, tmp); + + tmp = gfc_build_function_call (gfor_fndecl_fdate, arglist); + gfc_add_expr_to_block (&se->pre, tmp); + + /* Free the temporary afterwards, if necessary. */ + cond = build2 (GT_EXPR, boolean_type_node, len, + build_int_cst (TREE_TYPE (len), 0)); + arglist = gfc_chainon_list (NULL_TREE, var); + tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist); + tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); + gfc_add_expr_to_block (&se->post, tmp); + + se->expr = var; + se->string_length = len; + } + + + /* Return a character string containing the tty name. */ + + static void + gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr) + { + tree var; + tree len; + tree tmp; + tree arglist; + tree type; + tree cond; + tree gfc_int4_type_node = gfc_get_int_type (4); + + type = build_pointer_type (gfc_character1_type_node); + var = gfc_create_var (type, "pstr"); + len = gfc_create_var (gfc_int4_type_node, "len"); + + tmp = gfc_conv_intrinsic_function_args (se, expr); + arglist = gfc_chainon_list (NULL_TREE, gfc_build_addr_expr (NULL, var)); + arglist = gfc_chainon_list (arglist, gfc_build_addr_expr (NULL, len)); + arglist = chainon (arglist, tmp); + + tmp = gfc_build_function_call (gfor_fndecl_ttynam, arglist); + gfc_add_expr_to_block (&se->pre, tmp); + + /* Free the temporary afterwards, if necessary. */ + cond = build2 (GT_EXPR, boolean_type_node, len, + build_int_cst (TREE_TYPE (len), 0)); + arglist = gfc_chainon_list (NULL_TREE, var); + tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist); + tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); + gfc_add_expr_to_block (&se->post, tmp); + + se->expr = var; + se->string_length = len; + } + + /* Get the minimum/maximum value of all the parameters. minmax (a1, a2, a3, ...) { *************** gfc_conv_intrinsic_minmaxloc (gfc_se * s *** 1439,1445 **** /* Most negative(+HUGE) for maxval, most negative (-HUGE) for minval. */ if (op == GT_EXPR) ! tmp = fold (build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp)); gfc_add_modify_expr (&se->pre, limit, tmp); /* Initialize the scalarizer. */ --- 1610,1616 ---- /* Most negative(+HUGE) for maxval, most negative (-HUGE) for minval. */ if (op == GT_EXPR) ! tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp); gfc_add_modify_expr (&se->pre, limit, tmp); /* Initialize the scalarizer. */ *************** gfc_conv_intrinsic_minmaxloc (gfc_se * s *** 1458,1469 **** size we need to return zero. Otherwise use the first element of the array, in case all elements are equal to the limit. i.e. pos = (ubound >= lbound) ? lbound, lbound - 1; */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! loop.from[0], gfc_index_one_node)); ! cond = fold (build2 (GE_EXPR, boolean_type_node, ! loop.to[0], loop.from[0])); ! tmp = fold (build3 (COND_EXPR, gfc_array_index_type, cond, ! loop.from[0], tmp)); gfc_add_modify_expr (&loop.pre, pos, tmp); gfc_mark_ss_chain_used (arrayss, 1); --- 1629,1640 ---- size we need to return zero. Otherwise use the first element of the array, in case all elements are equal to the limit. i.e. pos = (ubound >= lbound) ? lbound, lbound - 1; */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! loop.from[0], gfc_index_one_node); ! cond = fold_build2 (GE_EXPR, boolean_type_node, ! loop.to[0], loop.from[0]); ! tmp = fold_build3 (COND_EXPR, gfc_array_index_type, cond, ! loop.from[0], tmp); gfc_add_modify_expr (&loop.pre, pos, tmp); gfc_mark_ss_chain_used (arrayss, 1); *************** gfc_conv_intrinsic_minmaxloc (gfc_se * s *** 1527,1535 **** gfc_cleanup_loop (&loop); /* Return a value in the range 1..SIZE(array). */ ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, loop.from[0], ! gfc_index_one_node)); ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, pos, tmp)); /* And convert to the required type. */ se->expr = convert (type, tmp); } --- 1698,1706 ---- gfc_cleanup_loop (&loop); /* Return a value in the range 1..SIZE(array). */ ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, loop.from[0], ! gfc_index_one_node); ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, pos, tmp); /* And convert to the required type. */ se->expr = convert (type, tmp); } *************** gfc_conv_intrinsic_minmaxval (gfc_se * s *** 1579,1585 **** /* Most negative(-HUGE) for maxval, most positive (-HUGE) for minval. */ if (op == GT_EXPR) ! tmp = fold (build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp)); gfc_add_modify_expr (&se->pre, limit, tmp); /* Walk the arguments. */ --- 1750,1756 ---- /* Most negative(-HUGE) for maxval, most positive (-HUGE) for minval. */ if (op == GT_EXPR) ! tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp); gfc_add_modify_expr (&se->pre, limit, tmp); /* Walk the arguments. */ *************** gfc_conv_intrinsic_btest (gfc_se * se, g *** 1676,1683 **** tmp = build2 (LSHIFT_EXPR, type, build_int_cst (type, 1), arg2); tmp = build2 (BIT_AND_EXPR, type, arg, tmp); ! tmp = fold (build2 (NE_EXPR, boolean_type_node, tmp, ! build_int_cst (type, 0))); type = gfc_typenode_for_spec (&expr->ts); se->expr = convert (type, tmp); } --- 1847,1854 ---- tmp = build2 (LSHIFT_EXPR, type, build_int_cst (type, 1), arg2); tmp = build2 (BIT_AND_EXPR, type, arg, tmp); ! tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, ! build_int_cst (type, 0)); type = gfc_typenode_for_spec (&expr->ts); se->expr = convert (type, tmp); } *************** gfc_conv_intrinsic_bitop (gfc_se * se, g *** 1695,1701 **** arg = TREE_VALUE (arg); type = TREE_TYPE (arg); ! se->expr = fold (build2 (op, type, arg, arg2)); } /* Bitwise not. */ --- 1866,1872 ---- arg = TREE_VALUE (arg); type = TREE_TYPE (arg); ! se->expr = fold_build2 (op, type, arg, arg2); } /* Bitwise not. */ *************** gfc_conv_intrinsic_singlebitop (gfc_se * *** 1725,1739 **** arg = TREE_VALUE (arg); type = TREE_TYPE (arg); ! tmp = fold (build2 (LSHIFT_EXPR, type, build_int_cst (type, 1), arg2)); if (set) op = BIT_IOR_EXPR; else { op = BIT_AND_EXPR; ! tmp = fold (build1 (BIT_NOT_EXPR, type, tmp)); } ! se->expr = fold (build2 (op, type, arg, tmp)); } /* Extract a sequence of bits. --- 1896,1910 ---- arg = TREE_VALUE (arg); type = TREE_TYPE (arg); ! tmp = fold_build2 (LSHIFT_EXPR, type, build_int_cst (type, 1), arg2); if (set) op = BIT_IOR_EXPR; else { op = BIT_AND_EXPR; ! tmp = fold_build1 (BIT_NOT_EXPR, type, tmp); } ! se->expr = fold_build2 (op, type, arg, tmp); } /* Extract a sequence of bits. *************** gfc_conv_intrinsic_ibits (gfc_se * se, g *** 1761,1767 **** tmp = build2 (RSHIFT_EXPR, type, arg, arg2); ! se->expr = fold (build2 (BIT_AND_EXPR, type, tmp, mask)); } /* ISHFT (I, SHIFT) = (abs (shift) >= BIT_SIZE (i)) --- 1932,1938 ---- tmp = build2 (RSHIFT_EXPR, type, arg, arg2); ! se->expr = fold_build2 (BIT_AND_EXPR, type, tmp, mask); } /* ISHFT (I, SHIFT) = (abs (shift) >= BIT_SIZE (i)) *************** gfc_conv_intrinsic_ishft (gfc_se * se, g *** 1788,1797 **** type = TREE_TYPE (arg); utype = gfc_unsigned_type (type); ! width = fold (build1 (ABS_EXPR, TREE_TYPE (arg2), arg2)); /* Left shift if positive. */ ! lshift = fold (build2 (LSHIFT_EXPR, type, arg, width)); /* Right shift if negative. We convert to an unsigned type because we want a logical shift. --- 1959,1968 ---- type = TREE_TYPE (arg); utype = gfc_unsigned_type (type); ! width = fold_build1 (ABS_EXPR, TREE_TYPE (arg2), arg2); /* Left shift if positive. */ ! lshift = fold_build2 (LSHIFT_EXPR, type, arg, width); /* Right shift if negative. We convert to an unsigned type because we want a logical shift. *************** gfc_conv_intrinsic_ishft (gfc_se * se, g *** 1801,1818 **** rshift = fold_convert (type, build2 (RSHIFT_EXPR, utype, convert (utype, arg), width)); ! tmp = fold (build2 (GE_EXPR, boolean_type_node, arg2, ! build_int_cst (TREE_TYPE (arg2), 0))); ! tmp = fold (build3 (COND_EXPR, type, tmp, lshift, rshift)); /* The Fortran standard allows shift widths <= BIT_SIZE(I), whereas gcc requires a shift width < BIT_SIZE(I), so we have to catch this special case. */ num_bits = build_int_cst (TREE_TYPE (arg2), TYPE_PRECISION (type)); ! cond = fold (build2 (GE_EXPR, boolean_type_node, width, num_bits)); ! se->expr = fold (build3 (COND_EXPR, type, cond, ! build_int_cst (type, 0), tmp)); } /* Circular shift. AKA rotate or barrel shift. */ --- 1972,1989 ---- rshift = fold_convert (type, build2 (RSHIFT_EXPR, utype, convert (utype, arg), width)); ! tmp = fold_build2 (GE_EXPR, boolean_type_node, arg2, ! build_int_cst (TREE_TYPE (arg2), 0)); ! tmp = fold_build3 (COND_EXPR, type, tmp, lshift, rshift); /* The Fortran standard allows shift widths <= BIT_SIZE(I), whereas gcc requires a shift width < BIT_SIZE(I), so we have to catch this special case. */ num_bits = build_int_cst (TREE_TYPE (arg2), TYPE_PRECISION (type)); ! cond = fold_build2 (GE_EXPR, boolean_type_node, width, num_bits); ! se->expr = fold_build3 (COND_EXPR, type, cond, ! build_int_cst (type, 0), tmp); } /* Circular shift. AKA rotate or barrel shift. */ *************** gfc_conv_intrinsic_ishftc (gfc_se * se, *** 1862,1867 **** --- 2033,2041 ---- case 8: tmp = gfor_fndecl_math_ishftc8; break; + case 16: + tmp = gfor_fndecl_math_ishftc16; + break; default: gcc_unreachable (); } *************** gfc_conv_intrinsic_ishftc (gfc_se * se, *** 1878,1896 **** type = TREE_TYPE (arg); /* Rotate left if positive. */ ! lrot = fold (build2 (LROTATE_EXPR, type, arg, arg2)); /* Rotate right if negative. */ ! tmp = fold (build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2)); ! rrot = fold (build2 (RROTATE_EXPR, type, arg, tmp)); zero = build_int_cst (TREE_TYPE (arg2), 0); ! tmp = fold (build2 (GT_EXPR, boolean_type_node, arg2, zero)); ! rrot = fold (build3 (COND_EXPR, type, tmp, lrot, rrot)); /* Do nothing if shift == 0. */ ! tmp = fold (build2 (EQ_EXPR, boolean_type_node, arg2, zero)); ! se->expr = fold (build3 (COND_EXPR, type, tmp, arg, rrot)); } /* The length of a character string. */ --- 2052,2070 ---- type = TREE_TYPE (arg); /* Rotate left if positive. */ ! lrot = fold_build2 (LROTATE_EXPR, type, arg, arg2); /* Rotate right if negative. */ ! tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2); ! rrot = fold_build2 (RROTATE_EXPR, type, arg, tmp); zero = build_int_cst (TREE_TYPE (arg2), 0); ! tmp = fold_build2 (GT_EXPR, boolean_type_node, arg2, zero); ! rrot = fold_build3 (COND_EXPR, type, tmp, lrot, rrot); /* Do nothing if shift == 0. */ ! tmp = fold_build2 (EQ_EXPR, boolean_type_node, arg2, zero); ! se->expr = fold_build3 (COND_EXPR, type, tmp, arg, rrot); } /* The length of a character string. */ *************** gfc_conv_intrinsic_merge (gfc_se * se, g *** 2043,2049 **** se->string_length = len; } type = TREE_TYPE (tsource); ! se->expr = fold (build3 (COND_EXPR, type, mask, tsource, fsource)); } --- 2217,2223 ---- se->string_length = len; } type = TREE_TYPE (tsource); ! se->expr = fold_build3 (COND_EXPR, type, mask, tsource, fsource); } *************** gfc_conv_intrinsic_strcmp (gfc_se * se, *** 2093,2105 **** { tree type; tree args; args = gfc_conv_intrinsic_function_args (se, expr); ! /* Build a call for the comparison. */ ! se->expr = gfc_build_function_call (gfor_fndecl_compare_string, args); type = gfc_typenode_for_spec (&expr->ts); ! se->expr = build2 (op, type, se->expr, build_int_cst (TREE_TYPE (se->expr), 0)); } --- 2267,2283 ---- { tree type; tree args; + tree arg2; args = gfc_conv_intrinsic_function_args (se, expr); ! arg2 = TREE_CHAIN (TREE_CHAIN (args)); + se->expr = gfc_build_compare_string (TREE_VALUE (args), + TREE_VALUE (TREE_CHAIN (args)), TREE_VALUE (arg2), + TREE_VALUE (TREE_CHAIN (arg2))); + type = gfc_typenode_for_spec (&expr->ts); ! se->expr = fold_build2 (op, type, se->expr, build_int_cst (TREE_TYPE (se->expr), 0)); } *************** gfc_conv_intrinsic_adjust (gfc_se * se, *** 2128,2134 **** /* Scalar transfer statement. ! TRANSFER (source, mold) = *(typeof *)&source */ static void gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) --- 2306,2312 ---- /* Scalar transfer statement. ! TRANSFER (source, mold) = *(typeof *)&source. */ static void gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) *************** gfc_conv_allocated (gfc_se *se, gfc_expr *** 2189,2195 **** arg1se.descriptor_only = 1; gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); ! tmp = gfc_conv_descriptor_data (arg1se.expr); tmp = build2 (NE_EXPR, boolean_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); --- 2367,2373 ---- arg1se.descriptor_only = 1; gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); ! tmp = gfc_conv_descriptor_data_get (arg1se.expr); tmp = build2 (NE_EXPR, boolean_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); *************** gfc_conv_associated (gfc_se *se, gfc_exp *** 2235,2241 **** /* A pointer to an array. */ arg1se.descriptor_only = 1; gfc_conv_expr_lhs (&arg1se, arg1->expr); ! tmp2 = gfc_conv_descriptor_data (arg1se.expr); } tmp = build2 (NE_EXPR, boolean_type_node, tmp2, fold_convert (TREE_TYPE (tmp2), null_pointer_node)); --- 2413,2419 ---- /* A pointer to an array. */ arg1se.descriptor_only = 1; gfc_conv_expr_lhs (&arg1se, arg1->expr); ! tmp2 = gfc_conv_descriptor_data_get (arg1se.expr); } tmp = build2 (NE_EXPR, boolean_type_node, tmp2, fold_convert (TREE_TYPE (tmp2), null_pointer_node)); *************** prepare_arg_info (gfc_se * se, gfc_expr *** 2380,2397 **** rcs->fdigits = convert (masktype, tmp); wbits = build_int_cst (NULL_TREE, TYPE_PRECISION (rcs->type) - 1); wbits = convert (masktype, wbits); ! rcs->edigits = fold (build2 (MINUS_EXPR, masktype, wbits, tmp)); /* Form masks for exponent/fraction/sign */ one = gfc_build_const (masktype, integer_one_node); ! rcs->smask = fold (build2 (LSHIFT_EXPR, masktype, one, wbits)); ! rcs->f1 = fold (build2 (LSHIFT_EXPR, masktype, one, rcs->fdigits)); ! rcs->emask = fold (build2 (MINUS_EXPR, masktype, rcs->smask, rcs->f1)); ! rcs->fmask = fold (build2 (MINUS_EXPR, masktype, rcs->f1, one)); /* Form bias. */ ! tmp = fold (build2 (MINUS_EXPR, masktype, rcs->edigits, one)); ! tmp = fold (build2 (LSHIFT_EXPR, masktype, one, tmp)); ! rcs->bias = fold (build2 (MINUS_EXPR, masktype, tmp ,one)); if (all) { --- 2558,2575 ---- rcs->fdigits = convert (masktype, tmp); wbits = build_int_cst (NULL_TREE, TYPE_PRECISION (rcs->type) - 1); wbits = convert (masktype, wbits); ! rcs->edigits = fold_build2 (MINUS_EXPR, masktype, wbits, tmp); /* Form masks for exponent/fraction/sign */ one = gfc_build_const (masktype, integer_one_node); ! rcs->smask = fold_build2 (LSHIFT_EXPR, masktype, one, wbits); ! rcs->f1 = fold_build2 (LSHIFT_EXPR, masktype, one, rcs->fdigits); ! rcs->emask = fold_build2 (MINUS_EXPR, masktype, rcs->smask, rcs->f1); ! rcs->fmask = fold_build2 (MINUS_EXPR, masktype, rcs->f1, one); /* Form bias. */ ! tmp = fold_build2 (MINUS_EXPR, masktype, rcs->edigits, one); ! tmp = fold_build2 (LSHIFT_EXPR, masktype, one, tmp); ! rcs->bias = fold_build2 (MINUS_EXPR, masktype, tmp ,one); if (all) { *************** gfc_conv_intrinsic_rrspacing (gfc_se * s *** 2516,2522 **** fraction = rcs.frac; one = gfc_build_const (masktype, integer_one_node); zero = gfc_build_const (masktype, integer_zero_node); ! t2 = fold (build2 (PLUS_EXPR, masktype, rcs.edigits, one)); t1 = call_builtin_clz (masktype, fraction); tmp = build2 (PLUS_EXPR, masktype, t1, one); --- 2694,2700 ---- fraction = rcs.frac; one = gfc_build_const (masktype, integer_one_node); zero = gfc_build_const (masktype, integer_zero_node); ! t2 = fold_build2 (PLUS_EXPR, masktype, rcs.edigits, one); t1 = call_builtin_clz (masktype, fraction); tmp = build2 (PLUS_EXPR, masktype, t1, one); *************** gfc_conv_intrinsic_rrspacing (gfc_se * s *** 2525,2532 **** cond = build2 (EQ_EXPR, boolean_type_node, rcs.expn, zero); fraction = build3 (COND_EXPR, masktype, cond, tmp, fraction); ! tmp = fold (build2 (PLUS_EXPR, masktype, rcs.bias, fdigits)); ! tmp = fold (build2 (LSHIFT_EXPR, masktype, tmp, fdigits)); tmp = build2 (BIT_IOR_EXPR, masktype, tmp, fraction); cond2 = build2 (EQ_EXPR, boolean_type_node, rcs.frac, zero); --- 2703,2710 ---- cond = build2 (EQ_EXPR, boolean_type_node, rcs.expn, zero); fraction = build3 (COND_EXPR, masktype, cond, tmp, fraction); ! tmp = fold_build2 (PLUS_EXPR, masktype, rcs.bias, fdigits); ! tmp = fold_build2 (LSHIFT_EXPR, masktype, tmp, fdigits); tmp = build2 (BIT_IOR_EXPR, masktype, tmp, fraction); cond2 = build2 (EQ_EXPR, boolean_type_node, rcs.frac, zero); *************** gfc_conv_intrinsic_repeat (gfc_se * se, *** 2640,2646 **** len = TREE_VALUE (args); tmp = gfc_advance_chain (args, 2); ncopies = TREE_VALUE (tmp); ! len = fold (build2 (MULT_EXPR, gfc_int4_type_node, len, ncopies)); type = gfc_get_character_type (expr->ts.kind, expr->ts.cl); var = gfc_conv_string_tmp (se, build_pointer_type (type), len); --- 2818,2824 ---- len = TREE_VALUE (args); tmp = gfc_advance_chain (args, 2); ncopies = TREE_VALUE (tmp); ! len = fold_build2 (MULT_EXPR, gfc_int4_type_node, len, ncopies); type = gfc_get_character_type (expr->ts.kind, expr->ts.cl); var = gfc_conv_string_tmp (se, build_pointer_type (type), len); *************** gfc_conv_intrinsic_iargc (gfc_se * se, g *** 2675,2680 **** --- 2853,2888 ---- se->expr = tmp; } + + /* The loc intrinsic returns the address of its argument as + gfc_index_integer_kind integer. */ + + static void + gfc_conv_intrinsic_loc(gfc_se * se, gfc_expr * expr) + { + tree temp_var; + gfc_expr *arg_expr; + gfc_ss *ss; + + gcc_assert (!se->ss); + + arg_expr = expr->value.function.actual->expr; + ss = gfc_walk_expr (arg_expr); + if (ss == gfc_ss_terminator) + gfc_conv_expr_reference (se, arg_expr); + else + gfc_conv_array_parameter (se, arg_expr, ss, 1); + se->expr= convert (gfc_unsigned_type (long_integer_type_node), + se->expr); + + /* Create a temporary variable for loc return value. Without this, + we get an error an ICE in gcc/expr.c(expand_expr_addr_expr_1). */ + temp_var = gfc_create_var (gfc_unsigned_type (long_integer_type_node), + NULL); + gfc_add_modify_expr (&se->pre, temp_var, se->expr); + se->expr = temp_var; + } + /* Generate code for an intrinsic function. Some map directly to library calls, others get special handling. In some cases the name of the function used depends on the type specifiers. */ *************** gfc_conv_intrinsic_function (gfc_se * se *** 2779,2784 **** --- 2987,2996 ---- gfc_conv_intrinsic_aint (se, expr, FIX_ROUND_EXPR); break; + case GFC_ISYM_AND: + gfc_conv_intrinsic_bitop (se, expr, BIT_AND_EXPR); + break; + case GFC_ISYM_ANY: gfc_conv_intrinsic_anyall (se, expr, NE_EXPR); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 2833,2838 **** --- 3045,3054 ---- gfc_conv_intrinsic_iargc (se, expr); break; + case GFC_ISYM_COMPLEX: + gfc_conv_intrinsic_cmplx (se, expr, 1); + break; + case GFC_ISYM_CONJG: gfc_conv_intrinsic_conjg (se, expr); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 2841,2846 **** --- 3057,3066 ---- gfc_conv_intrinsic_count (se, expr); break; + case GFC_ISYM_CTIME: + gfc_conv_intrinsic_ctime (se, expr); + break; + case GFC_ISYM_DIM: gfc_conv_intrinsic_dim (se, expr); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 2849,2854 **** --- 3069,3078 ---- gfc_conv_intrinsic_dprod (se, expr); break; + case GFC_ISYM_FDATE: + gfc_conv_intrinsic_fdate (se, expr); + break; + case GFC_ISYM_IAND: gfc_conv_intrinsic_bitop (se, expr, BIT_AND_EXPR); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 2955,2960 **** --- 3179,3188 ---- gfc_conv_intrinsic_not (se, expr); break; + case GFC_ISYM_OR: + gfc_conv_intrinsic_bitop (se, expr, BIT_IOR_EXPR); + break; + case GFC_ISYM_PRESENT: gfc_conv_intrinsic_present (se, expr); break; *************** gfc_conv_intrinsic_function (gfc_se * se *** 2979,2993 **** --- 3207,3238 ---- gfc_conv_intrinsic_transfer (se, expr); break; + case GFC_ISYM_TTYNAM: + gfc_conv_intrinsic_ttynam (se, expr); + break; + case GFC_ISYM_UBOUND: gfc_conv_intrinsic_bound (se, expr, 1); break; + case GFC_ISYM_XOR: + gfc_conv_intrinsic_bitop (se, expr, BIT_XOR_EXPR); + break; + + case GFC_ISYM_LOC: + gfc_conv_intrinsic_loc (se, expr); + break; + case GFC_ISYM_CHDIR: case GFC_ISYM_DOT_PRODUCT: case GFC_ISYM_ETIME: + case GFC_ISYM_FGET: + case GFC_ISYM_FGETC: case GFC_ISYM_FNUM: + case GFC_ISYM_FPUT: + case GFC_ISYM_FPUTC: case GFC_ISYM_FSTAT: + case GFC_ISYM_FTELL: case GFC_ISYM_GETCWD: case GFC_ISYM_GETGID: case GFC_ISYM_GETPID: *************** gfc_conv_intrinsic_function (gfc_se * se *** 2998,3007 **** --- 3243,3255 ---- case GFC_ISYM_IRAND: case GFC_ISYM_ISATTY: case GFC_ISYM_LINK: + case GFC_ISYM_MALLOC: case GFC_ISYM_MATMUL: case GFC_ISYM_RAND: case GFC_ISYM_RENAME: case GFC_ISYM_SECOND: + case GFC_ISYM_SECNDS: + case GFC_ISYM_SIGNAL: case GFC_ISYM_STAT: case GFC_ISYM_SYMLNK: case GFC_ISYM_SYSTEM: *************** gfc_walk_intrinsic_function (gfc_ss * ss *** 3126,3132 **** gcc_assert (isym); if (isym->elemental) ! return gfc_walk_elemental_function_args (ss, expr, GFC_SS_SCALAR); if (expr->rank == 0) return ss; --- 3374,3380 ---- gcc_assert (isym); if (isym->elemental) ! return gfc_walk_elemental_function_args (ss, expr->value.function.actual, GFC_SS_SCALAR); if (expr->rank == 0) return ss; diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-io.c gcc-4.1.0/gcc/fortran/trans-io.c *** gcc-4.0.2/gcc/fortran/trans-io.c Tue Jul 12 01:50:48 2005 --- gcc-4.1.0/gcc/fortran/trans-io.c Tue Jan 31 20:45:40 2006 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** Software Foundation, 59 Temple Place - S *** 38,367 **** /* Members of the ioparm structure. */ ! static GTY(()) tree ioparm_unit; ! static GTY(()) tree ioparm_err; ! static GTY(()) tree ioparm_end; ! static GTY(()) tree ioparm_eor; ! static GTY(()) tree ioparm_list_format; ! static GTY(()) tree ioparm_library_return; ! static GTY(()) tree ioparm_iostat; ! static GTY(()) tree ioparm_exist; ! static GTY(()) tree ioparm_opened; ! static GTY(()) tree ioparm_number; ! static GTY(()) tree ioparm_named; ! static GTY(()) tree ioparm_rec; ! static GTY(()) tree ioparm_nextrec; ! static GTY(()) tree ioparm_size; ! static GTY(()) tree ioparm_recl_in; ! static GTY(()) tree ioparm_recl_out; ! static GTY(()) tree ioparm_iolength; ! static GTY(()) tree ioparm_file; ! static GTY(()) tree ioparm_file_len; ! static GTY(()) tree ioparm_status; ! static GTY(()) tree ioparm_status_len; ! static GTY(()) tree ioparm_access; ! static GTY(()) tree ioparm_access_len; ! static GTY(()) tree ioparm_form; ! static GTY(()) tree ioparm_form_len; ! static GTY(()) tree ioparm_blank; ! static GTY(()) tree ioparm_blank_len; ! static GTY(()) tree ioparm_position; ! static GTY(()) tree ioparm_position_len; ! static GTY(()) tree ioparm_action; ! static GTY(()) tree ioparm_action_len; ! static GTY(()) tree ioparm_delim; ! static GTY(()) tree ioparm_delim_len; ! static GTY(()) tree ioparm_pad; ! static GTY(()) tree ioparm_pad_len; ! static GTY(()) tree ioparm_format; ! static GTY(()) tree ioparm_format_len; ! static GTY(()) tree ioparm_advance; ! static GTY(()) tree ioparm_advance_len; ! static GTY(()) tree ioparm_name; ! static GTY(()) tree ioparm_name_len; ! static GTY(()) tree ioparm_internal_unit; ! static GTY(()) tree ioparm_internal_unit_len; ! static GTY(()) tree ioparm_sequential; ! static GTY(()) tree ioparm_sequential_len; ! static GTY(()) tree ioparm_direct; ! static GTY(()) tree ioparm_direct_len; ! static GTY(()) tree ioparm_formatted; ! static GTY(()) tree ioparm_formatted_len; ! static GTY(()) tree ioparm_unformatted; ! static GTY(()) tree ioparm_unformatted_len; ! static GTY(()) tree ioparm_read; ! static GTY(()) tree ioparm_read_len; ! static GTY(()) tree ioparm_write; ! static GTY(()) tree ioparm_write_len; ! static GTY(()) tree ioparm_readwrite; ! static GTY(()) tree ioparm_readwrite_len; ! static GTY(()) tree ioparm_namelist_name; ! static GTY(()) tree ioparm_namelist_name_len; ! static GTY(()) tree ioparm_namelist_read_mode; ! /* The global I/O variables */ ! static GTY(()) tree ioparm_var; ! static GTY(()) tree locus_file; ! static GTY(()) tree locus_line; /* Library I/O subroutines */ ! static GTY(()) tree iocall_read; ! static GTY(()) tree iocall_read_done; ! static GTY(()) tree iocall_write; ! static GTY(()) tree iocall_write_done; ! static GTY(()) tree iocall_x_integer; ! static GTY(()) tree iocall_x_logical; ! static GTY(()) tree iocall_x_character; ! static GTY(()) tree iocall_x_real; ! static GTY(()) tree iocall_x_complex; ! static GTY(()) tree iocall_open; ! static GTY(()) tree iocall_close; ! static GTY(()) tree iocall_inquire; ! static GTY(()) tree iocall_iolength; ! static GTY(()) tree iocall_iolength_done; ! static GTY(()) tree iocall_rewind; ! static GTY(()) tree iocall_backspace; ! static GTY(()) tree iocall_endfile; ! static GTY(()) tree iocall_set_nml_val; ! static GTY(()) tree iocall_set_nml_val_dim; /* Variable for keeping track of what the last data transfer statement was. Used for deciding which subroutine to call when the data transfer is complete. */ static enum { READ, WRITE, IOLENGTH } last_dt; ! #define ADD_FIELD(name, type) \ ! ioparm_ ## name = gfc_add_field_to_struct \ ! (&(TYPE_FIELDS (ioparm_type)), ioparm_type, \ ! get_identifier (stringize(name)), type) ! #define ADD_STRING(name) \ ! ioparm_ ## name = gfc_add_field_to_struct \ ! (&(TYPE_FIELDS (ioparm_type)), ioparm_type, \ ! get_identifier (stringize(name)), pchar_type_node); \ ! ioparm_ ## name ## _len = gfc_add_field_to_struct \ ! (&(TYPE_FIELDS (ioparm_type)), ioparm_type, \ ! get_identifier (stringize(name) "_len"), gfc_charlen_type_node) /* Create function decls for IO library functions. */ void gfc_build_io_library_fndecls (void) { ! tree gfc_int4_type_node; ! tree gfc_pint4_type_node; ! tree ioparm_type; ! ! gfc_int4_type_node = gfc_get_int_type (4); ! gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node); ! ! /* Build the st_parameter structure. Information associated with I/O ! calls are transferred here. This must match the one defined in the ! library exactly. */ ! ! ioparm_type = make_node (RECORD_TYPE); ! TYPE_NAME (ioparm_type) = get_identifier ("_gfc_ioparm"); ! ! ADD_FIELD (unit, gfc_int4_type_node); ! ADD_FIELD (err, gfc_int4_type_node); ! ADD_FIELD (end, gfc_int4_type_node); ! ADD_FIELD (eor, gfc_int4_type_node); ! ADD_FIELD (list_format, gfc_int4_type_node); ! ADD_FIELD (library_return, gfc_int4_type_node); ! ! ADD_FIELD (iostat, gfc_pint4_type_node); ! ADD_FIELD (exist, gfc_pint4_type_node); ! ADD_FIELD (opened, gfc_pint4_type_node); ! ADD_FIELD (number, gfc_pint4_type_node); ! ADD_FIELD (named, gfc_pint4_type_node); ! ADD_FIELD (rec, gfc_int4_type_node); ! ADD_FIELD (nextrec, gfc_pint4_type_node); ! ADD_FIELD (size, gfc_pint4_type_node); ! ! ADD_FIELD (recl_in, gfc_int4_type_node); ! ADD_FIELD (recl_out, gfc_pint4_type_node); ! ! ADD_FIELD (iolength, gfc_pint4_type_node); ! ! ADD_STRING (file); ! ADD_STRING (status); ! ! ADD_STRING (access); ! ADD_STRING (form); ! ADD_STRING (blank); ! ADD_STRING (position); ! ADD_STRING (action); ! ADD_STRING (delim); ! ADD_STRING (pad); ! ADD_STRING (format); ! ADD_STRING (advance); ! ADD_STRING (name); ! ADD_STRING (internal_unit); ! ADD_STRING (sequential); ! ! ADD_STRING (direct); ! ADD_STRING (formatted); ! ADD_STRING (unformatted); ! ADD_STRING (read); ! ADD_STRING (write); ! ADD_STRING (readwrite); ! ! ADD_STRING (namelist_name); ! ADD_FIELD (namelist_read_mode, gfc_int4_type_node); ! ! gfc_finish_type (ioparm_type); ! ! ioparm_var = build_decl (VAR_DECL, get_identifier (PREFIX("ioparm")), ! ioparm_type); ! DECL_EXTERNAL (ioparm_var) = 1; ! TREE_PUBLIC (ioparm_var) = 1; ! locus_line = build_decl (VAR_DECL, get_identifier (PREFIX("line")), ! gfc_int4_type_node); ! DECL_EXTERNAL (locus_line) = 1; ! TREE_PUBLIC (locus_line) = 1; ! locus_file = build_decl (VAR_DECL, get_identifier (PREFIX("filename")), ! pchar_type_node); ! DECL_EXTERNAL (locus_file) = 1; ! TREE_PUBLIC (locus_file) = 1; /* Define the transfer functions. */ ! iocall_x_integer = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_integer")), ! void_type_node, 2, pvoid_type_node, ! gfc_int4_type_node); ! iocall_x_logical = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_logical")), ! void_type_node, 2, pvoid_type_node, ! gfc_int4_type_node); ! iocall_x_character = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_character")), ! void_type_node, 2, pvoid_type_node, ! gfc_int4_type_node); ! iocall_x_real = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_real")), ! void_type_node, 2, pvoid_type_node, gfc_int4_type_node); ! iocall_x_complex = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_complex")), ! void_type_node, 2, pvoid_type_node, ! gfc_int4_type_node); /* Library entry points */ ! iocall_read = gfc_build_library_function_decl (get_identifier (PREFIX("st_read")), ! void_type_node, 0); ! iocall_write = gfc_build_library_function_decl (get_identifier (PREFIX("st_write")), ! void_type_node, 0); ! iocall_open = gfc_build_library_function_decl (get_identifier (PREFIX("st_open")), ! void_type_node, 0); ! iocall_close = gfc_build_library_function_decl (get_identifier (PREFIX("st_close")), ! void_type_node, 0); ! iocall_inquire = gfc_build_library_function_decl (get_identifier (PREFIX("st_inquire")), ! gfc_int4_type_node, 0); ! iocall_iolength = gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")), ! void_type_node, 0); ! iocall_rewind = gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")), ! gfc_int4_type_node, 0); ! iocall_backspace = gfc_build_library_function_decl (get_identifier (PREFIX("st_backspace")), ! gfc_int4_type_node, 0); ! iocall_endfile = gfc_build_library_function_decl (get_identifier (PREFIX("st_endfile")), ! gfc_int4_type_node, 0); /* Library helpers */ ! iocall_read_done = gfc_build_library_function_decl (get_identifier (PREFIX("st_read_done")), ! gfc_int4_type_node, 0); ! iocall_write_done = gfc_build_library_function_decl (get_identifier (PREFIX("st_write_done")), ! gfc_int4_type_node, 0); ! iocall_iolength_done = gfc_build_library_function_decl (get_identifier (PREFIX("st_iolength_done")), ! gfc_int4_type_node, 0); ! iocall_set_nml_val = gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var")), ! void_type_node, 5, ! pvoid_type_node, pvoid_type_node, ! gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node); ! iocall_set_nml_val_dim = gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_dim")), ! void_type_node, 4, gfc_int4_type_node, gfc_int4_type_node, gfc_int4_type_node, gfc_int4_type_node); } ! /* Generate code to store an non-string I/O parameter into the ! ioparm structure. This is a pass by value. */ ! static void ! set_parameter_value (stmtblock_t * block, tree var, gfc_expr * e) { gfc_se se; tree tmp; gfc_init_se (&se, NULL); ! gfc_conv_expr_type (&se, e, TREE_TYPE (var)); gfc_add_block_to_block (block, &se.pre); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE); gfc_add_modify_expr (block, tmp, se.expr); } ! /* Generate code to store an non-string I/O parameter into the ! ioparm structure. This is pass by reference. */ ! static void ! set_parameter_ref (stmtblock_t * block, tree var, gfc_expr * e) { gfc_se se; ! tree tmp; gfc_init_se (&se, NULL); ! se.want_pointer = 1; - gfc_conv_expr_type (&se, e, TREE_TYPE (var)); gfc_add_block_to_block (block, &se.pre); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE); ! gfc_add_modify_expr (block, tmp, se.expr); } /* Given an array expr, find its address and length to get a string. If the --- 38,440 ---- /* Members of the ioparm structure. */ ! enum ioparam_type ! { ! IOPARM_ptype_common, ! IOPARM_ptype_open, ! IOPARM_ptype_close, ! IOPARM_ptype_filepos, ! IOPARM_ptype_inquire, ! IOPARM_ptype_dt, ! IOPARM_ptype_num ! }; ! enum iofield_type ! { ! IOPARM_type_int4, ! IOPARM_type_pint4, ! IOPARM_type_pchar, ! IOPARM_type_parray, ! IOPARM_type_pad, ! IOPARM_type_char1, ! IOPARM_type_char2, ! IOPARM_type_common, ! IOPARM_type_num ! }; ! typedef struct gfc_st_parameter_field GTY(()) ! { ! const char *name; ! unsigned int mask; ! enum ioparam_type param_type; ! enum iofield_type type; ! tree field; ! tree field_len; ! } ! gfc_st_parameter_field; ! ! typedef struct gfc_st_parameter GTY(()) ! { ! const char *name; ! tree type; ! } ! gfc_st_parameter; ! ! enum iofield ! { ! #define IOPARM(param_type, name, mask, type) IOPARM_##param_type##_##name, ! #include "ioparm.def" ! #undef IOPARM ! IOPARM_field_num ! }; + static GTY(()) gfc_st_parameter st_parameter[] = + { + { "common", NULL }, + { "open", NULL }, + { "close", NULL }, + { "filepos", NULL }, + { "inquire", NULL }, + { "dt", NULL } + }; + + static GTY(()) gfc_st_parameter_field st_parameter_field[] = + { + #define IOPARM(param_type, name, mask, type) \ + { #name, mask, IOPARM_ptype_##param_type, IOPARM_type_##type, NULL, NULL }, + #include "ioparm.def" + #undef IOPARM + { NULL, 0, 0, 0, NULL, NULL } + }; /* Library I/O subroutines */ ! enum iocall ! { ! IOCALL_READ, ! IOCALL_READ_DONE, ! IOCALL_WRITE, ! IOCALL_WRITE_DONE, ! IOCALL_X_INTEGER, ! IOCALL_X_LOGICAL, ! IOCALL_X_CHARACTER, ! IOCALL_X_REAL, ! IOCALL_X_COMPLEX, ! IOCALL_X_ARRAY, ! IOCALL_OPEN, ! IOCALL_CLOSE, ! IOCALL_INQUIRE, ! IOCALL_IOLENGTH, ! IOCALL_IOLENGTH_DONE, ! IOCALL_REWIND, ! IOCALL_BACKSPACE, ! IOCALL_ENDFILE, ! IOCALL_FLUSH, ! IOCALL_SET_NML_VAL, ! IOCALL_SET_NML_VAL_DIM, ! IOCALL_NUM ! }; ! ! static GTY(()) tree iocall[IOCALL_NUM]; /* Variable for keeping track of what the last data transfer statement was. Used for deciding which subroutine to call when the data transfer is complete. */ static enum { READ, WRITE, IOLENGTH } last_dt; ! /* The data transfer parameter block that should be shared by all ! data transfer calls belonging to the same read/write/iolength. */ ! static GTY(()) tree dt_parm; ! static stmtblock_t *dt_post_end_block; ! static void ! gfc_build_st_parameter (enum ioparam_type ptype, tree *types) ! { ! enum iofield type; ! gfc_st_parameter_field *p; ! char name[64]; ! size_t len; ! tree t = make_node (RECORD_TYPE); ! ! len = strlen (st_parameter[ptype].name); ! gcc_assert (len <= sizeof (name) - sizeof ("__st_parameter_")); ! memcpy (name, "__st_parameter_", sizeof ("__st_parameter_")); ! memcpy (name + sizeof ("__st_parameter_") - 1, st_parameter[ptype].name, ! len + 1); ! TYPE_NAME (t) = get_identifier (name); ! ! for (type = 0, p = st_parameter_field; type < IOPARM_field_num; type++, p++) ! if (p->param_type == ptype) ! switch (p->type) ! { ! case IOPARM_type_int4: ! case IOPARM_type_pint4: ! case IOPARM_type_parray: ! case IOPARM_type_pchar: ! case IOPARM_type_pad: ! p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, ! get_identifier (p->name), ! types[p->type]); ! break; ! case IOPARM_type_char1: ! p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, ! get_identifier (p->name), ! pchar_type_node); ! /* FALLTHROUGH */ ! case IOPARM_type_char2: ! len = strlen (p->name); ! gcc_assert (len <= sizeof (name) - sizeof ("_len")); ! memcpy (name, p->name, len); ! memcpy (name + len, "_len", sizeof ("_len")); ! p->field_len = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, ! get_identifier (name), ! gfc_charlen_type_node); ! if (p->type == IOPARM_type_char2) ! p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, ! get_identifier (p->name), ! pchar_type_node); ! break; ! case IOPARM_type_common: ! p->field ! = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, ! get_identifier (p->name), ! st_parameter[IOPARM_ptype_common].type); ! break; ! case IOPARM_type_num: ! gcc_unreachable (); ! } + gfc_finish_type (t); + st_parameter[ptype].type = t; + } /* Create function decls for IO library functions. */ void gfc_build_io_library_fndecls (void) { ! tree types[IOPARM_type_num], pad_idx, gfc_int4_type_node; ! tree parm_type, dt_parm_type; ! tree gfc_c_int_type_node; ! HOST_WIDE_INT pad_size; ! enum ioparam_type ptype; ! types[IOPARM_type_int4] = gfc_int4_type_node = gfc_get_int_type (4); ! types[IOPARM_type_pint4] = build_pointer_type (gfc_int4_type_node); ! types[IOPARM_type_parray] = pchar_type_node; ! types[IOPARM_type_pchar] = pchar_type_node; ! pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node)); ! pad_size += 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (integer_type_node)); ! pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size)); ! types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx); ! gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind); ! for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++) ! gfc_build_st_parameter (ptype, types); /* Define the transfer functions. */ ! dt_parm_type = build_pointer_type (st_parameter[IOPARM_ptype_dt].type); ! ! iocall[IOCALL_X_INTEGER] = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_integer")), ! void_type_node, 3, dt_parm_type, ! pvoid_type_node, gfc_int4_type_node); ! iocall[IOCALL_X_LOGICAL] = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_logical")), ! void_type_node, 3, dt_parm_type, ! pvoid_type_node, gfc_int4_type_node); ! iocall[IOCALL_X_CHARACTER] = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_character")), ! void_type_node, 3, dt_parm_type, ! pvoid_type_node, gfc_int4_type_node); ! iocall[IOCALL_X_REAL] = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_real")), ! void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); ! iocall[IOCALL_X_COMPLEX] = gfc_build_library_function_decl (get_identifier (PREFIX("transfer_complex")), ! void_type_node, 3, dt_parm_type, ! pvoid_type_node, gfc_int4_type_node); ! ! iocall[IOCALL_X_ARRAY] = ! gfc_build_library_function_decl (get_identifier ! (PREFIX("transfer_array")), ! void_type_node, 4, dt_parm_type, ! pvoid_type_node, gfc_c_int_type_node, ! gfc_charlen_type_node); /* Library entry points */ ! iocall[IOCALL_READ] = gfc_build_library_function_decl (get_identifier (PREFIX("st_read")), ! void_type_node, 1, dt_parm_type); ! iocall[IOCALL_WRITE] = gfc_build_library_function_decl (get_identifier (PREFIX("st_write")), ! void_type_node, 1, dt_parm_type); ! ! parm_type = build_pointer_type (st_parameter[IOPARM_ptype_open].type); ! iocall[IOCALL_OPEN] = gfc_build_library_function_decl (get_identifier (PREFIX("st_open")), ! void_type_node, 1, parm_type); ! ! parm_type = build_pointer_type (st_parameter[IOPARM_ptype_close].type); ! iocall[IOCALL_CLOSE] = gfc_build_library_function_decl (get_identifier (PREFIX("st_close")), ! void_type_node, 1, parm_type); ! parm_type = build_pointer_type (st_parameter[IOPARM_ptype_inquire].type); ! iocall[IOCALL_INQUIRE] = gfc_build_library_function_decl (get_identifier (PREFIX("st_inquire")), ! gfc_int4_type_node, 1, parm_type); ! iocall[IOCALL_IOLENGTH] = gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")), ! void_type_node, 1, dt_parm_type); ! parm_type = build_pointer_type (st_parameter[IOPARM_ptype_filepos].type); ! iocall[IOCALL_REWIND] = gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")), ! gfc_int4_type_node, 1, parm_type); ! iocall[IOCALL_BACKSPACE] = gfc_build_library_function_decl (get_identifier (PREFIX("st_backspace")), ! gfc_int4_type_node, 1, parm_type); ! iocall[IOCALL_ENDFILE] = gfc_build_library_function_decl (get_identifier (PREFIX("st_endfile")), ! gfc_int4_type_node, 1, parm_type); ! ! iocall[IOCALL_FLUSH] = ! gfc_build_library_function_decl (get_identifier (PREFIX("st_flush")), ! gfc_int4_type_node, 1, parm_type); ! /* Library helpers */ ! iocall[IOCALL_READ_DONE] = gfc_build_library_function_decl (get_identifier (PREFIX("st_read_done")), ! gfc_int4_type_node, 1, dt_parm_type); ! iocall[IOCALL_WRITE_DONE] = gfc_build_library_function_decl (get_identifier (PREFIX("st_write_done")), ! gfc_int4_type_node, 1, dt_parm_type); ! iocall[IOCALL_IOLENGTH_DONE] = gfc_build_library_function_decl (get_identifier (PREFIX("st_iolength_done")), ! gfc_int4_type_node, 1, dt_parm_type); ! iocall[IOCALL_SET_NML_VAL] = gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var")), ! void_type_node, 6, dt_parm_type, ! pvoid_type_node, pvoid_type_node, ! gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node); ! iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_dim")), ! void_type_node, 5, dt_parm_type, gfc_int4_type_node, gfc_int4_type_node, gfc_int4_type_node, gfc_int4_type_node); } ! /* Generate code to store an integer constant into the ! st_parameter_XXX structure. */ ! static unsigned int ! set_parameter_const (stmtblock_t *block, tree var, enum iofield type, ! unsigned int val) ! { ! tree tmp; ! gfc_st_parameter_field *p = &st_parameter_field[type]; ! ! if (p->param_type == IOPARM_ptype_common) ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! gfc_add_modify_expr (block, tmp, build_int_cst (TREE_TYPE (p->field), val)); ! return p->mask; ! } ! ! ! /* Generate code to store a non-string I/O parameter into the ! st_parameter_XXX structure. This is a pass by value. */ ! ! static unsigned int ! set_parameter_value (stmtblock_t *block, tree var, enum iofield type, ! gfc_expr *e) { gfc_se se; tree tmp; + gfc_st_parameter_field *p = &st_parameter_field[type]; gfc_init_se (&se, NULL); ! gfc_conv_expr_type (&se, e, TREE_TYPE (p->field)); gfc_add_block_to_block (block, &se.pre); ! if (p->param_type == IOPARM_ptype_common) ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); gfc_add_modify_expr (block, tmp, se.expr); + return p->mask; } ! /* Generate code to store a non-string I/O parameter into the ! st_parameter_XXX structure. This is pass by reference. */ ! static unsigned int ! set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock, ! tree var, enum iofield type, gfc_expr *e) { gfc_se se; ! tree tmp, addr; ! gfc_st_parameter_field *p = &st_parameter_field[type]; + gcc_assert (e->ts.type == BT_INTEGER || e->ts.type == BT_LOGICAL); gfc_init_se (&se, NULL); ! gfc_conv_expr_lhs (&se, e); gfc_add_block_to_block (block, &se.pre); ! if (TYPE_MODE (TREE_TYPE (se.expr)) ! == TYPE_MODE (TREE_TYPE (TREE_TYPE (p->field)))) ! addr = convert (TREE_TYPE (p->field), ! gfc_build_addr_expr (NULL, se.expr)); ! else ! { ! /* The type used by the library has different size ! from the type of the variable supplied by the user. ! Need to use a temporary. */ ! tree tmpvar ! = gfc_create_var (TREE_TYPE (TREE_TYPE (p->field)), ! st_parameter_field[type].name); ! addr = gfc_build_addr_expr (NULL, tmpvar); ! tmp = convert (TREE_TYPE (se.expr), tmpvar); ! gfc_add_modify_expr (postblock, se.expr, tmp); ! } ! ! if (p->param_type == IOPARM_ptype_common) ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! tmp = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! gfc_add_modify_expr (block, tmp, addr); ! return p->mask; } /* Given an array expr, find its address and length to get a string. If the *************** gfc_convert_array_to_string (gfc_se * se *** 403,414 **** { gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); size = gfc_conv_array_stride (array, rank); ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, gfc_conv_array_ubound (array, rank), ! gfc_conv_array_lbound (array, rank))); ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, tmp, ! gfc_index_one_node)); ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, tmp, size)); } gcc_assert (size); --- 476,487 ---- { gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); size = gfc_conv_array_stride (array, rank); ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, gfc_conv_array_ubound (array, rank), ! gfc_conv_array_lbound (array, rank)); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, ! gfc_index_one_node); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, size); } gcc_assert (size); *************** gfc_convert_array_to_string (gfc_se * se *** 416,449 **** /* If it is an element, we need the its address and size of the rest. */ if (e->ref->u.ar.type == AR_ELEMENT) { ! size = fold (build2 (MINUS_EXPR, gfc_array_index_type, size, ! TREE_OPERAND (se->expr, 1))); se->expr = gfc_build_addr_expr (NULL, se->expr); } tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, size, tmp)); se->string_length = fold_convert (gfc_charlen_type_node, size); } /* Generate code to store a string and its length into the ! ioparm structure. */ ! static void set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, ! tree var_len, gfc_expr * e) { gfc_se se; tree tmp; tree msg; tree io; tree len; gfc_init_se (&se, NULL); ! io = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE); ! len = build3 (COMPONENT_REF, TREE_TYPE (var_len), ioparm_var, var_len, NULL_TREE); /* Integer variable assigned a format label. */ --- 489,528 ---- /* If it is an element, we need the its address and size of the rest. */ if (e->ref->u.ar.type == AR_ELEMENT) { ! size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, ! TREE_OPERAND (se->expr, 1)); se->expr = gfc_build_addr_expr (NULL, se->expr); } tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); se->string_length = fold_convert (gfc_charlen_type_node, size); } + /* Generate code to store a string and its length into the ! st_parameter_XXX structure. */ ! static unsigned int set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, ! enum iofield type, gfc_expr * e) { gfc_se se; tree tmp; tree msg; tree io; tree len; + gfc_st_parameter_field *p = &st_parameter_field[type]; gfc_init_se (&se, NULL); ! if (p->param_type == IOPARM_ptype_common) ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! io = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! len = build3 (COMPONENT_REF, TREE_TYPE (p->field_len), var, p->field_len, NULL_TREE); /* Integer variable assigned a format label. */ *************** set_string (stmtblock_t * block, stmtblo *** 478,496 **** gfc_add_block_to_block (block, &se.pre); gfc_add_block_to_block (postblock, &se.post); } ! /* Set a member of the ioparm structure to one. */ ! static void ! set_flag (stmtblock_t *block, tree var) { ! tree tmp, type = TREE_TYPE (var); ! tmp = build3 (COMPONENT_REF, type, ioparm_var, var, NULL_TREE); ! gfc_add_modify_expr (block, tmp, convert (type, integer_one_node)); ! } /* Add a case to a IO-result switch. */ --- 557,625 ---- gfc_add_block_to_block (block, &se.pre); gfc_add_block_to_block (postblock, &se.post); + return p->mask; } ! /* Generate code to store the character (array) and the character length ! for an internal unit. */ ! ! static unsigned int ! set_internal_unit (stmtblock_t * block, tree var, gfc_expr * e) { ! gfc_se se; ! tree io; ! tree len; ! tree desc; ! tree tmp; ! gfc_st_parameter_field *p; ! unsigned int mask; ! gfc_init_se (&se, NULL); + p = &st_parameter_field[IOPARM_dt_internal_unit]; + mask = p->mask; + io = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, + NULL_TREE); + len = build3 (COMPONENT_REF, TREE_TYPE (p->field_len), var, p->field_len, + NULL_TREE); + p = &st_parameter_field[IOPARM_dt_internal_unit_desc]; + desc = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, + NULL_TREE); + + gcc_assert (e->ts.type == BT_CHARACTER); + + /* Character scalars. */ + if (e->rank == 0) + { + gfc_conv_expr (&se, e); + gfc_conv_string_parameter (&se); + tmp = se.expr; + se.expr = fold_convert (pchar_type_node, integer_zero_node); + } + + /* Character array. */ + else if (e->rank > 0) + { + se.ss = gfc_walk_expr (e); + + /* Return the data pointer and rank from the descriptor. */ + gfc_conv_expr_descriptor (&se, e, se.ss); + tmp = gfc_conv_descriptor_data_get (se.expr); + se.expr = gfc_build_addr_expr (pchar_type_node, se.expr); + } + else + gcc_unreachable (); + + /* The cast is needed for character substrings and the descriptor + data. */ + gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), tmp)); + gfc_add_modify_expr (&se.pre, len, se.string_length); + gfc_add_modify_expr (&se.pre, desc, se.expr); + + gfc_add_block_to_block (block, &se.pre); + return mask; + } /* Add a case to a IO-result switch. */ *************** add_case (int label_value, gfc_st_label *** 524,534 **** be created anyway. */ static void ! io_result (stmtblock_t * block, gfc_st_label * err_label, gfc_st_label * end_label, gfc_st_label * eor_label) { stmtblock_t body; tree tmp, rc; /* If no labels are specified, ignore the result instead of building an empty switch. */ --- 653,664 ---- be created anyway. */ static void ! io_result (stmtblock_t * block, tree var, gfc_st_label * err_label, gfc_st_label * end_label, gfc_st_label * eor_label) { stmtblock_t body; tree tmp, rc; + gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags]; /* If no labels are specified, ignore the result instead of building an empty switch. */ *************** io_result (stmtblock_t * block, gfc_st_l *** 548,555 **** tmp = gfc_finish_block (&body); ! rc = build3 (COMPONENT_REF, TREE_TYPE (ioparm_library_return), ioparm_var, ! ioparm_library_return, NULL_TREE); tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE); --- 678,689 ---- tmp = gfc_finish_block (&body); ! var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, ! var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); ! rc = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, ! NULL_TREE); ! rc = build2 (BIT_AND_EXPR, TREE_TYPE (rc), rc, ! build_int_cst (TREE_TYPE (rc), IOPARM_common_libreturn_mask)); tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE); *************** io_result (stmtblock_t * block, gfc_st_l *** 561,584 **** library call goes awry, we can tell the user where the problem is. */ static void ! set_error_locus (stmtblock_t * block, locus * where) { gfc_file *f; ! tree tmp; int line; f = where->lb->file; ! tmp = gfc_build_cstring_const (f->filename); ! tmp = gfc_build_addr_expr (pchar_type_node, tmp); ! gfc_add_modify_expr (block, locus_file, tmp); #ifdef USE_MAPPED_LOCATION line = LOCATION_LINE (where->lb->location); #else line = where->lb->linenum; #endif ! gfc_add_modify_expr (block, locus_line, build_int_cst (NULL_TREE, line)); } --- 695,723 ---- library call goes awry, we can tell the user where the problem is. */ static void ! set_error_locus (stmtblock_t * block, tree var, locus * where) { gfc_file *f; ! tree str, locus_file; int line; + gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename]; + locus_file = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, + var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); + locus_file = build3 (COMPONENT_REF, TREE_TYPE (p->field), locus_file, + p->field, NULL_TREE); f = where->lb->file; ! str = gfc_build_cstring_const (f->filename); ! str = gfc_build_addr_expr (pchar_type_node, str); ! gfc_add_modify_expr (block, locus_file, str); #ifdef USE_MAPPED_LOCATION line = LOCATION_LINE (where->lb->location); #else line = where->lb->linenum; #endif ! set_parameter_const (block, var, IOPARM_common_line, line); } *************** gfc_trans_open (gfc_code * code) *** 589,653 **** { stmtblock_t block, post_block; gfc_open *p; ! tree tmp; ! gfc_init_block (&block); gfc_init_block (&post_block); ! set_error_locus (&block, &code->loc); p = code->ext.open; if (p->unit) ! set_parameter_value (&block, ioparm_unit, p->unit); if (p->file) ! set_string (&block, &post_block, ioparm_file, ioparm_file_len, p->file); if (p->status) ! set_string (&block, &post_block, ioparm_status, ! ioparm_status_len, p->status); if (p->access) ! set_string (&block, &post_block, ioparm_access, ! ioparm_access_len, p->access); if (p->form) ! set_string (&block, &post_block, ioparm_form, ioparm_form_len, p->form); if (p->recl) ! set_parameter_value (&block, ioparm_recl_in, p->recl); if (p->blank) ! set_string (&block, &post_block, ioparm_blank, ioparm_blank_len, ! p->blank); if (p->position) ! set_string (&block, &post_block, ioparm_position, ! ioparm_position_len, p->position); if (p->action) ! set_string (&block, &post_block, ioparm_action, ! ioparm_action_len, p->action); if (p->delim) ! set_string (&block, &post_block, ioparm_delim, ioparm_delim_len, ! p->delim); if (p->pad) ! set_string (&block, &post_block, ioparm_pad, ioparm_pad_len, p->pad); if (p->iostat) ! set_parameter_ref (&block, ioparm_iostat, p->iostat); if (p->err) ! set_flag (&block, ioparm_err); ! tmp = gfc_build_function_call (iocall_open, NULL_TREE); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &post_block); ! io_result (&block, p->err, NULL, NULL); return gfc_finish_block (&block); } --- 728,810 ---- { stmtblock_t block, post_block; gfc_open *p; ! tree tmp, var; ! unsigned int mask = 0; ! gfc_start_block (&block); gfc_init_block (&post_block); ! var = gfc_create_var (st_parameter[IOPARM_ptype_open].type, "open_parm"); ! ! set_error_locus (&block, var, &code->loc); p = code->ext.open; if (p->unit) ! set_parameter_value (&block, var, IOPARM_common_unit, p->unit); ! else ! set_parameter_const (&block, var, IOPARM_common_unit, 0); if (p->file) ! mask |= set_string (&block, &post_block, var, IOPARM_open_file, p->file); if (p->status) ! mask |= set_string (&block, &post_block, var, IOPARM_open_status, ! p->status); if (p->access) ! mask |= set_string (&block, &post_block, var, IOPARM_open_access, ! p->access); if (p->form) ! mask |= set_string (&block, &post_block, var, IOPARM_open_form, p->form); if (p->recl) ! mask |= set_parameter_value (&block, var, IOPARM_open_recl_in, p->recl); if (p->blank) ! mask |= set_string (&block, &post_block, var, IOPARM_open_blank, ! p->blank); if (p->position) ! mask |= set_string (&block, &post_block, var, IOPARM_open_position, ! p->position); if (p->action) ! mask |= set_string (&block, &post_block, var, IOPARM_open_action, ! p->action); if (p->delim) ! mask |= set_string (&block, &post_block, var, IOPARM_open_delim, ! p->delim); if (p->pad) ! mask |= set_string (&block, &post_block, var, IOPARM_open_pad, p->pad); ! ! if (p->iomsg) ! mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg, ! p->iomsg); if (p->iostat) ! mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat, ! p->iostat); if (p->err) ! mask |= IOPARM_common_err; ! if (p->convert) ! mask |= set_string (&block, &post_block, var, IOPARM_open_convert, ! p->convert); ! ! set_parameter_const (&block, var, IOPARM_common_flags, mask); ! ! tmp = gfc_build_addr_expr (NULL_TREE, var); ! tmp = gfc_chainon_list (NULL_TREE, tmp); ! tmp = gfc_build_function_call (iocall[IOCALL_OPEN], tmp); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &post_block); ! io_result (&block, var, p->err, NULL, NULL); return gfc_finish_block (&block); } *************** gfc_trans_close (gfc_code * code) *** 660,692 **** { stmtblock_t block, post_block; gfc_close *p; ! tree tmp; ! gfc_init_block (&block); gfc_init_block (&post_block); ! set_error_locus (&block, &code->loc); p = code->ext.close; if (p->unit) ! set_parameter_value (&block, ioparm_unit, p->unit); if (p->status) ! set_string (&block, &post_block, ioparm_status, ! ioparm_status_len, p->status); if (p->iostat) ! set_parameter_ref (&block, ioparm_iostat, p->iostat); if (p->err) ! set_flag (&block, ioparm_err); ! tmp = gfc_build_function_call (iocall_close, NULL_TREE); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &post_block); ! io_result (&block, p->err, NULL, NULL); return gfc_finish_block (&block); } --- 817,863 ---- { stmtblock_t block, post_block; gfc_close *p; ! tree tmp, var; ! unsigned int mask = 0; ! gfc_start_block (&block); gfc_init_block (&post_block); ! var = gfc_create_var (st_parameter[IOPARM_ptype_close].type, "close_parm"); ! ! set_error_locus (&block, var, &code->loc); p = code->ext.close; if (p->unit) ! set_parameter_value (&block, var, IOPARM_common_unit, p->unit); ! else ! set_parameter_const (&block, var, IOPARM_common_unit, 0); if (p->status) ! mask |= set_string (&block, &post_block, var, IOPARM_close_status, ! p->status); ! ! if (p->iomsg) ! mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg, ! p->iomsg); if (p->iostat) ! mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat, ! p->iostat); if (p->err) ! mask |= IOPARM_common_err; ! set_parameter_const (&block, var, IOPARM_common_flags, mask); ! ! tmp = gfc_build_addr_expr (NULL_TREE, var); ! tmp = gfc_chainon_list (NULL_TREE, tmp); ! tmp = gfc_build_function_call (iocall[IOCALL_CLOSE], tmp); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &post_block); ! io_result (&block, var, p->err, NULL, NULL); return gfc_finish_block (&block); } *************** gfc_trans_close (gfc_code * code) *** 697,725 **** static tree build_filepos (tree function, gfc_code * code) { ! stmtblock_t block; gfc_filepos *p; ! tree tmp; p = code->ext.filepos; ! gfc_init_block (&block); ! set_error_locus (&block, &code->loc); if (p->unit) ! set_parameter_value (&block, ioparm_unit, p->unit); if (p->iostat) ! set_parameter_ref (&block, ioparm_iostat, p->iostat); if (p->err) ! set_flag (&block, ioparm_err); ! tmp = gfc_build_function_call (function, NULL); gfc_add_expr_to_block (&block, tmp); ! io_result (&block, p->err, NULL, NULL); return gfc_finish_block (&block); } --- 868,914 ---- static tree build_filepos (tree function, gfc_code * code) { ! stmtblock_t block, post_block; gfc_filepos *p; ! tree tmp, var; ! unsigned int mask = 0; p = code->ext.filepos; ! gfc_start_block (&block); ! gfc_init_block (&post_block); ! var = gfc_create_var (st_parameter[IOPARM_ptype_filepos].type, ! "filepos_parm"); ! ! set_error_locus (&block, var, &code->loc); if (p->unit) ! set_parameter_value (&block, var, IOPARM_common_unit, p->unit); ! else ! set_parameter_const (&block, var, IOPARM_common_unit, 0); ! ! if (p->iomsg) ! mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg, ! p->iomsg); if (p->iostat) ! mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat, ! p->iostat); if (p->err) ! mask |= IOPARM_common_err; ! set_parameter_const (&block, var, IOPARM_common_flags, mask); ! ! tmp = gfc_build_addr_expr (NULL_TREE, var); ! tmp = gfc_chainon_list (NULL_TREE, tmp); ! tmp = gfc_build_function_call (function, tmp); gfc_add_expr_to_block (&block, tmp); ! gfc_add_block_to_block (&block, &post_block); ! ! io_result (&block, var, p->err, NULL, NULL); return gfc_finish_block (&block); } *************** build_filepos (tree function, gfc_code * *** 730,737 **** tree gfc_trans_backspace (gfc_code * code) { ! ! return build_filepos (iocall_backspace, code); } --- 919,925 ---- tree gfc_trans_backspace (gfc_code * code) { ! return build_filepos (iocall[IOCALL_BACKSPACE], code); } *************** gfc_trans_backspace (gfc_code * code) *** 740,747 **** tree gfc_trans_endfile (gfc_code * code) { ! ! return build_filepos (iocall_endfile, code); } --- 928,934 ---- tree gfc_trans_endfile (gfc_code * code) { ! return build_filepos (iocall[IOCALL_ENDFILE], code); } *************** gfc_trans_endfile (gfc_code * code) *** 750,757 **** tree gfc_trans_rewind (gfc_code * code) { ! return build_filepos (iocall_rewind, code); } --- 937,952 ---- tree gfc_trans_rewind (gfc_code * code) { + return build_filepos (iocall[IOCALL_REWIND], code); + } ! ! /* Translate a FLUSH statement. */ ! ! tree ! gfc_trans_flush (gfc_code * code) ! { ! return build_filepos (iocall[IOCALL_FLUSH], code); } *************** gfc_trans_inquire (gfc_code * code) *** 762,868 **** { stmtblock_t block, post_block; gfc_inquire *p; ! tree tmp; ! gfc_init_block (&block); gfc_init_block (&post_block); ! set_error_locus (&block, &code->loc); p = code->ext.inquire; if (p->unit) ! set_parameter_value (&block, ioparm_unit, p->unit); if (p->file) ! set_string (&block, &post_block, ioparm_file, ioparm_file_len, p->file); if (p->iostat) ! set_parameter_ref (&block, ioparm_iostat, p->iostat); if (p->exist) ! set_parameter_ref (&block, ioparm_exist, p->exist); if (p->opened) ! set_parameter_ref (&block, ioparm_opened, p->opened); if (p->number) ! set_parameter_ref (&block, ioparm_number, p->number); if (p->named) ! set_parameter_ref (&block, ioparm_named, p->named); if (p->name) ! set_string (&block, &post_block, ioparm_name, ioparm_name_len, p->name); if (p->access) ! set_string (&block, &post_block, ioparm_access, ! ioparm_access_len, p->access); if (p->sequential) ! set_string (&block, &post_block, ioparm_sequential, ! ioparm_sequential_len, p->sequential); if (p->direct) ! set_string (&block, &post_block, ioparm_direct, ! ioparm_direct_len, p->direct); if (p->form) ! set_string (&block, &post_block, ioparm_form, ioparm_form_len, p->form); if (p->formatted) ! set_string (&block, &post_block, ioparm_formatted, ! ioparm_formatted_len, p->formatted); if (p->unformatted) ! set_string (&block, &post_block, ioparm_unformatted, ! ioparm_unformatted_len, p->unformatted); if (p->recl) ! set_parameter_ref (&block, ioparm_recl_out, p->recl); if (p->nextrec) ! set_parameter_ref (&block, ioparm_nextrec, p->nextrec); if (p->blank) ! set_string (&block, &post_block, ioparm_blank, ioparm_blank_len, ! p->blank); if (p->position) ! set_string (&block, &post_block, ioparm_position, ! ioparm_position_len, p->position); if (p->action) ! set_string (&block, &post_block, ioparm_action, ! ioparm_action_len, p->action); if (p->read) ! set_string (&block, &post_block, ioparm_read, ioparm_read_len, p->read); if (p->write) ! set_string (&block, &post_block, ioparm_write, ! ioparm_write_len, p->write); if (p->readwrite) ! set_string (&block, &post_block, ioparm_readwrite, ! ioparm_readwrite_len, p->readwrite); if (p->delim) ! set_string (&block, &post_block, ioparm_delim, ioparm_delim_len, ! p->delim); if (p->pad) ! set_string (&block, &post_block, ioparm_pad, ioparm_pad_len, ! p->pad); if (p->err) ! set_flag (&block, ioparm_err); ! tmp = gfc_build_function_call (iocall_inquire, NULL); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &post_block); ! io_result (&block, p->err, NULL, NULL); return gfc_finish_block (&block); } --- 957,1096 ---- { stmtblock_t block, post_block; gfc_inquire *p; ! tree tmp, var; ! unsigned int mask = 0; ! gfc_start_block (&block); gfc_init_block (&post_block); ! var = gfc_create_var (st_parameter[IOPARM_ptype_inquire].type, ! "inquire_parm"); ! ! set_error_locus (&block, var, &code->loc); p = code->ext.inquire; + /* Sanity check. */ + if (p->unit && p->file) + gfc_error ("INQUIRE statement at %L cannot contain both FILE and UNIT specifiers.", &code->loc); + if (p->unit) ! set_parameter_value (&block, var, IOPARM_common_unit, p->unit); ! else ! set_parameter_const (&block, var, IOPARM_common_unit, 0); if (p->file) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_file, ! p->file); ! ! if (p->iomsg) ! mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg, ! p->iomsg); if (p->iostat) ! mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat, ! p->iostat); if (p->exist) ! mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist, ! p->exist); if (p->opened) ! mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_opened, ! p->opened); if (p->number) ! mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_number, ! p->number); if (p->named) ! mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_named, ! p->named); if (p->name) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_name, ! p->name); if (p->access) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_access, ! p->access); if (p->sequential) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_sequential, ! p->sequential); if (p->direct) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_direct, ! p->direct); if (p->form) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_form, ! p->form); if (p->formatted) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_formatted, ! p->formatted); if (p->unformatted) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_unformatted, ! p->unformatted); if (p->recl) ! mask |= set_parameter_ref (&block, &post_block, var, ! IOPARM_inquire_recl_out, p->recl); if (p->nextrec) ! mask |= set_parameter_ref (&block, &post_block, var, ! IOPARM_inquire_nextrec, p->nextrec); if (p->blank) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_blank, ! p->blank); if (p->position) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_position, ! p->position); if (p->action) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_action, ! p->action); if (p->read) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_read, ! p->read); if (p->write) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_write, ! p->write); if (p->readwrite) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_readwrite, ! p->readwrite); if (p->delim) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_delim, ! p->delim); if (p->pad) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_pad, ! p->pad); if (p->err) ! mask |= IOPARM_common_err; ! if (p->convert) ! mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert, ! p->convert); ! ! set_parameter_const (&block, var, IOPARM_common_flags, mask); ! ! tmp = gfc_build_addr_expr (NULL_TREE, var); ! tmp = gfc_chainon_list (NULL_TREE, tmp); ! tmp = gfc_build_function_call (iocall[IOCALL_INQUIRE], tmp); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &post_block); ! io_result (&block, var, p->err, NULL, NULL); return gfc_finish_block (&block); } *************** nml_get_addr_expr (gfc_symbol * sym, gfc *** 976,983 **** } /* For an object VAR_NAME whose base address is BASE_ADDR, generate a ! call to iocall_set_nml_val. For derived type variable, recursively ! generate calls to iocall_set_nml_val for each component. */ #define NML_FIRST_ARG(a) args = gfc_chainon_list (NULL_TREE, a) #define NML_ADD_ARG(a) args = gfc_chainon_list (args, a) --- 1204,1211 ---- } /* For an object VAR_NAME whose base address is BASE_ADDR, generate a ! call to iocall[IOCALL_SET_NML_VAL]. For derived type variable, recursively ! generate calls to iocall[IOCALL_SET_NML_VAL] for each component. */ #define NML_FIRST_ARG(a) args = gfc_chainon_list (NULL_TREE, a) #define NML_ADD_ARG(a) args = gfc_chainon_list (args, a) *************** transfer_namelist_element (stmtblock_t * *** 996,1001 **** --- 1224,1230 ---- tree tmp; tree args; tree dtype; + tree dt_parm_addr; int n_dim; int itype; int rank = 0; *************** transfer_namelist_element (stmtblock_t * *** 1058,1064 **** The call for the scalar part transfers: (address, name, type, kind or string_length, dtype) */ ! NML_FIRST_ARG (addr_expr); NML_ADD_ARG (string); NML_ADD_ARG (IARG (ts->kind)); --- 1287,1295 ---- The call for the scalar part transfers: (address, name, type, kind or string_length, dtype) */ ! dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm); ! NML_FIRST_ARG (dt_parm_addr); ! NML_ADD_ARG (addr_expr); NML_ADD_ARG (string); NML_ADD_ARG (IARG (ts->kind)); *************** transfer_namelist_element (stmtblock_t * *** 1068,1074 **** NML_ADD_ARG (convert (gfc_charlen_type_node, integer_zero_node)); NML_ADD_ARG (dtype); ! tmp = gfc_build_function_call (iocall_set_nml_val, args); gfc_add_expr_to_block (block, tmp); /* If the object is an array, transfer rank times: --- 1299,1305 ---- NML_ADD_ARG (convert (gfc_charlen_type_node, integer_zero_node)); NML_ADD_ARG (dtype); ! tmp = gfc_build_function_call (iocall[IOCALL_SET_NML_VAL], args); gfc_add_expr_to_block (block, tmp); /* If the object is an array, transfer rank times: *************** transfer_namelist_element (stmtblock_t * *** 1076,1086 **** for ( n_dim = 0 ; n_dim < rank ; n_dim++ ) { ! NML_FIRST_ARG (IARG (n_dim)); NML_ADD_ARG (GFC_TYPE_ARRAY_STRIDE (dt, n_dim)); NML_ADD_ARG (GFC_TYPE_ARRAY_LBOUND (dt, n_dim)); NML_ADD_ARG (GFC_TYPE_ARRAY_UBOUND (dt, n_dim)); ! tmp = gfc_build_function_call (iocall_set_nml_val_dim, args); gfc_add_expr_to_block (block, tmp); } --- 1307,1318 ---- for ( n_dim = 0 ; n_dim < rank ; n_dim++ ) { ! NML_FIRST_ARG (dt_parm_addr); ! NML_ADD_ARG (IARG (n_dim)); NML_ADD_ARG (GFC_TYPE_ARRAY_STRIDE (dt, n_dim)); NML_ADD_ARG (GFC_TYPE_ARRAY_LBOUND (dt, n_dim)); NML_ADD_ARG (GFC_TYPE_ARRAY_UBOUND (dt, n_dim)); ! tmp = gfc_build_function_call (iocall[IOCALL_SET_NML_VAL_DIM], args); gfc_add_expr_to_block (block, tmp); } *************** transfer_namelist_element (stmtblock_t * *** 1112,1202 **** out by now. */ static tree ! build_dt (tree * function, gfc_code * code) { ! stmtblock_t block, post_block; gfc_dt *dt; ! tree tmp; gfc_expr *nmlname; gfc_namelist *nml; ! gfc_init_block (&block); gfc_init_block (&post_block); ! set_error_locus (&block, &code->loc); ! dt = code->ext.dt; ! gcc_assert (dt != NULL); ! if (dt->io_unit) { if (dt->io_unit->ts.type == BT_CHARACTER) { ! set_string (&block, &post_block, ioparm_internal_unit, ! ioparm_internal_unit_len, dt->io_unit); } else ! set_parameter_value (&block, ioparm_unit, dt->io_unit); } ! if (dt->rec) ! set_parameter_value (&block, ioparm_rec, dt->rec); ! if (dt->advance) ! set_string (&block, &post_block, ioparm_advance, ioparm_advance_len, ! dt->advance); ! if (dt->format_expr) ! set_string (&block, &post_block, ioparm_format, ioparm_format_len, ! dt->format_expr); ! if (dt->format_label) ! { ! if (dt->format_label == &format_asterisk) ! set_flag (&block, ioparm_list_format); ! else ! set_string (&block, &post_block, ioparm_format, ! ioparm_format_len, dt->format_label->format); ! } ! if (dt->iostat) ! set_parameter_ref (&block, ioparm_iostat, dt->iostat); ! if (dt->size) ! set_parameter_ref (&block, ioparm_size, dt->size); ! if (dt->err) ! set_flag (&block, ioparm_err); ! if (dt->eor) ! set_flag(&block, ioparm_eor); ! if (dt->end) ! set_flag(&block, ioparm_end); ! if (dt->namelist) ! { ! if (dt->format_expr || dt->format_label) ! gfc_internal_error ("build_dt: format with namelist"); ! nmlname = gfc_new_nml_name_expr(dt->namelist->name); ! set_string (&block, &post_block, ioparm_namelist_name, ! ioparm_namelist_name_len, nmlname); ! if (last_dt == READ) ! set_flag (&block, ioparm_namelist_read_mode); ! for (nml = dt->namelist->namelist; nml; nml = nml->next) ! transfer_namelist_element (&block, nml->sym->name, nml->sym, ! NULL, NULL); } ! tmp = gfc_build_function_call (*function, NULL_TREE); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &post_block); return gfc_finish_block (&block); } --- 1344,1485 ---- out by now. */ static tree ! build_dt (tree function, gfc_code * code) { ! stmtblock_t block, post_block, post_end_block; gfc_dt *dt; ! tree tmp, var; gfc_expr *nmlname; gfc_namelist *nml; + unsigned int mask = 0; ! gfc_start_block (&block); gfc_init_block (&post_block); + gfc_init_block (&post_end_block); ! var = gfc_create_var (st_parameter[IOPARM_ptype_dt].type, "dt_parm"); ! set_error_locus (&block, var, &code->loc); ! if (last_dt == IOLENGTH) ! { ! gfc_inquire *inq; ! ! inq = code->ext.inquire; ! ! /* First check that preconditions are met. */ ! gcc_assert (inq != NULL); ! gcc_assert (inq->iolength != NULL); ! ! /* Connect to the iolength variable. */ ! mask |= set_parameter_ref (&block, &post_end_block, var, ! IOPARM_dt_iolength, inq->iolength); ! dt = NULL; ! } ! else ! { ! dt = code->ext.dt; ! gcc_assert (dt != NULL); ! } ! ! if (dt && dt->io_unit) { if (dt->io_unit->ts.type == BT_CHARACTER) { ! mask |= set_internal_unit (&block, var, dt->io_unit); ! set_parameter_const (&block, var, IOPARM_common_unit, 0); } else ! set_parameter_value (&block, var, IOPARM_common_unit, dt->io_unit); } + else + set_parameter_const (&block, var, IOPARM_common_unit, 0); ! if (dt) ! { ! if (dt->rec) ! mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec); ! if (dt->advance) ! mask |= set_string (&block, &post_block, var, IOPARM_dt_advance, ! dt->advance); ! if (dt->format_expr) ! mask |= set_string (&block, &post_block, var, IOPARM_dt_format, ! dt->format_expr); ! if (dt->format_label) ! { ! if (dt->format_label == &format_asterisk) ! mask |= IOPARM_dt_list_format; ! else ! mask |= set_string (&block, &post_block, var, IOPARM_dt_format, ! dt->format_label->format); ! } ! if (dt->iomsg) ! mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg, ! dt->iomsg); ! if (dt->iostat) ! mask |= set_parameter_ref (&block, &post_end_block, var, ! IOPARM_common_iostat, dt->iostat); ! if (dt->size) ! mask |= set_parameter_ref (&block, &post_end_block, var, ! IOPARM_dt_size, dt->size); ! if (dt->err) ! mask |= IOPARM_common_err; ! if (dt->eor) ! mask |= IOPARM_common_eor; ! if (dt->end) ! mask |= IOPARM_common_end; ! if (dt->namelist) ! { ! if (dt->format_expr || dt->format_label) ! gfc_internal_error ("build_dt: format with namelist"); ! nmlname = gfc_new_nml_name_expr (dt->namelist->name); ! mask |= set_string (&block, &post_block, var, IOPARM_dt_namelist_name, ! nmlname); ! if (last_dt == READ) ! mask |= IOPARM_dt_namelist_read_mode; ! ! set_parameter_const (&block, var, IOPARM_common_flags, mask); ! ! dt_parm = var; ! ! for (nml = dt->namelist->namelist; nml; nml = nml->next) ! transfer_namelist_element (&block, nml->sym->name, nml->sym, ! NULL, NULL); ! } ! else ! set_parameter_const (&block, var, IOPARM_common_flags, mask); } + else + set_parameter_const (&block, var, IOPARM_common_flags, mask); ! tmp = gfc_build_addr_expr (NULL_TREE, var); ! tmp = gfc_chainon_list (NULL_TREE, tmp); ! tmp = gfc_build_function_call (function, tmp); gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &post_block); + dt_parm = var; + dt_post_end_block = &post_end_block; + + gfc_add_expr_to_block (&block, gfc_trans_code (code->block->next)); + + dt_parm = NULL; + dt_post_end_block = NULL; + return gfc_finish_block (&block); } *************** build_dt (tree * function, gfc_code * co *** 1208,1238 **** tree gfc_trans_iolength (gfc_code * code) { - stmtblock_t block; - gfc_inquire *inq; - tree dt; - - gfc_init_block (&block); - - set_error_locus (&block, &code->loc); - - inq = code->ext.inquire; - - /* First check that preconditions are met. */ - gcc_assert (inq != NULL); - gcc_assert (inq->iolength != NULL); - - /* Connect to the iolength variable. */ - if (inq->iolength) - set_parameter_ref (&block, ioparm_iolength, inq->iolength); - - /* Actual logic. */ last_dt = IOLENGTH; ! dt = build_dt(&iocall_iolength, code); ! ! gfc_add_expr_to_block (&block, dt); ! ! return gfc_finish_block (&block); } --- 1491,1498 ---- tree gfc_trans_iolength (gfc_code * code) { last_dt = IOLENGTH; ! return build_dt (iocall[IOCALL_IOLENGTH], code); } *************** gfc_trans_iolength (gfc_code * code) *** 1241,1249 **** tree gfc_trans_read (gfc_code * code) { - last_dt = READ; ! return build_dt (&iocall_read, code); } --- 1501,1508 ---- tree gfc_trans_read (gfc_code * code) { last_dt = READ; ! return build_dt (iocall[IOCALL_READ], code); } *************** gfc_trans_read (gfc_code * code) *** 1252,1260 **** tree gfc_trans_write (gfc_code * code) { - last_dt = WRITE; ! return build_dt (&iocall_write, code); } --- 1511,1518 ---- tree gfc_trans_write (gfc_code * code) { last_dt = WRITE; ! return build_dt (iocall[IOCALL_WRITE], code); } *************** gfc_trans_dt_end (gfc_code * code) *** 1271,1298 **** switch (last_dt) { case READ: ! function = iocall_read_done; break; case WRITE: ! function = iocall_write_done; break; case IOLENGTH: ! function = iocall_iolength_done; break; default: gcc_unreachable (); } ! tmp = gfc_build_function_call (function, NULL); gfc_add_expr_to_block (&block, tmp); if (last_dt != IOLENGTH) { gcc_assert (code->ext.dt != NULL); ! io_result (&block, code->ext.dt->err, code->ext.dt->end, code->ext.dt->eor); } --- 1529,1560 ---- switch (last_dt) { case READ: ! function = iocall[IOCALL_READ_DONE]; break; case WRITE: ! function = iocall[IOCALL_WRITE_DONE]; break; case IOLENGTH: ! function = iocall[IOCALL_IOLENGTH_DONE]; break; default: gcc_unreachable (); } ! tmp = gfc_build_addr_expr (NULL_TREE, dt_parm); ! tmp = gfc_chainon_list (NULL_TREE, tmp); ! tmp = gfc_build_function_call (function, tmp); gfc_add_expr_to_block (&block, tmp); + gfc_add_block_to_block (&block, dt_post_end_block); + gfc_init_block (dt_post_end_block); if (last_dt != IOLENGTH) { gcc_assert (code->ext.dt != NULL); ! io_result (&block, dt_parm, code->ext.dt->err, code->ext.dt->end, code->ext.dt->eor); } *************** transfer_expr (gfc_se * se, gfc_typespec *** 1407,1428 **** { case BT_INTEGER: arg2 = build_int_cst (NULL_TREE, kind); ! function = iocall_x_integer; break; case BT_REAL: arg2 = build_int_cst (NULL_TREE, kind); ! function = iocall_x_real; break; case BT_COMPLEX: arg2 = build_int_cst (NULL_TREE, kind); ! function = iocall_x_complex; break; case BT_LOGICAL: arg2 = build_int_cst (NULL_TREE, kind); ! function = iocall_x_logical; break; case BT_CHARACTER: --- 1669,1690 ---- { case BT_INTEGER: arg2 = build_int_cst (NULL_TREE, kind); ! function = iocall[IOCALL_X_INTEGER]; break; case BT_REAL: arg2 = build_int_cst (NULL_TREE, kind); ! function = iocall[IOCALL_X_REAL]; break; case BT_COMPLEX: arg2 = build_int_cst (NULL_TREE, kind); ! function = iocall[IOCALL_X_COMPLEX]; break; case BT_LOGICAL: arg2 = build_int_cst (NULL_TREE, kind); ! function = iocall[IOCALL_X_LOGICAL]; break; case BT_CHARACTER: *************** transfer_expr (gfc_se * se, gfc_typespec *** 1434,1440 **** gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE); arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp))); } ! function = iocall_x_character; break; case BT_DERIVED: --- 1696,1702 ---- gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE); arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp))); } ! function = iocall[IOCALL_X_CHARACTER]; break; case BT_DERIVED: *************** transfer_expr (gfc_se * se, gfc_typespec *** 1468,1474 **** internal_error ("Bad IO basetype (%d)", ts->type); } ! args = gfc_chainon_list (NULL_TREE, addr_expr); args = gfc_chainon_list (args, arg2); tmp = gfc_build_function_call (function, args); --- 1730,1738 ---- internal_error ("Bad IO basetype (%d)", ts->type); } ! tmp = gfc_build_addr_expr (NULL_TREE, dt_parm); ! args = gfc_chainon_list (NULL_TREE, tmp); ! args = gfc_chainon_list (args, addr_expr); args = gfc_chainon_list (args, arg2); tmp = gfc_build_function_call (function, args); *************** transfer_expr (gfc_se * se, gfc_typespec *** 1478,1483 **** --- 1742,1773 ---- } + /* Generate a call to pass an array descriptor to the IO library. The + array should be of one of the intrinsic types. */ + + static void + transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr) + { + tree args, tmp, charlen_arg, kind_arg; + + if (ts->type == BT_CHARACTER) + charlen_arg = se->string_length; + else + charlen_arg = build_int_cstu (NULL_TREE, 0); + + kind_arg = build_int_cst (NULL_TREE, ts->kind); + + tmp = gfc_build_addr_expr (NULL_TREE, dt_parm); + args = gfc_chainon_list (NULL_TREE, tmp); + args = gfc_chainon_list (args, addr_expr); + args = gfc_chainon_list (args, kind_arg); + args = gfc_chainon_list (args, charlen_arg); + tmp = gfc_build_function_call (iocall[IOCALL_X_ARRAY], args); + gfc_add_expr_to_block (&se->pre, tmp); + gfc_add_block_to_block (&se->pre, &se->post); + } + + /* gfc_trans_transfer()-- Translate a TRANSFER code node */ tree *************** gfc_trans_transfer (gfc_code * code) *** 1486,1506 **** stmtblock_t block, body; gfc_loopinfo loop; gfc_expr *expr; gfc_ss *ss; gfc_se se; tree tmp; gfc_start_block (&block); expr = code->expr; ss = gfc_walk_expr (expr); gfc_init_se (&se, NULL); if (ss == gfc_ss_terminator) ! gfc_init_block (&body); else { /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, ss); --- 1776,1822 ---- stmtblock_t block, body; gfc_loopinfo loop; gfc_expr *expr; + gfc_ref *ref; gfc_ss *ss; gfc_se se; tree tmp; gfc_start_block (&block); + gfc_init_block (&body); expr = code->expr; ss = gfc_walk_expr (expr); + ref = NULL; gfc_init_se (&se, NULL); if (ss == gfc_ss_terminator) ! { ! /* Transfer a scalar value. */ ! gfc_conv_expr_reference (&se, expr); ! transfer_expr (&se, &expr->ts, se.expr); ! } else { + /* Transfer an array. If it is an array of an intrinsic + type, pass the descriptor to the library. Otherwise + scalarize the transfer. */ + if (expr->ref) + { + for (ref = expr->ref; ref && ref->type != REF_ARRAY; + ref = ref->next); + gcc_assert (ref->type == REF_ARRAY); + } + + if (expr->ts.type != BT_DERIVED && ref && ref->next == NULL) + { + /* Get the descriptor. */ + gfc_conv_expr_descriptor (&se, expr, ss); + tmp = gfc_build_addr_expr (NULL, se.expr); + transfer_array_desc (&se, &expr->ts, tmp); + goto finish_block_label; + } + /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, ss); *************** gfc_trans_transfer (gfc_code * code) *** 1515,1525 **** gfc_copy_loopinfo_to_se (&se, &loop); se.ss = ss; - } ! gfc_conv_expr_reference (&se, expr); ! transfer_expr (&se, &expr->ts, se.expr); gfc_add_block_to_block (&body, &se.pre); gfc_add_block_to_block (&body, &se.post); --- 1831,1842 ---- gfc_copy_loopinfo_to_se (&se, &loop); se.ss = ss; ! gfc_conv_expr_reference (&se, expr); ! transfer_expr (&se, &expr->ts, se.expr); ! } ! finish_block_label: gfc_add_block_to_block (&body, &se.pre); gfc_add_block_to_block (&body, &se.post); diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-stmt.c gcc-4.1.0/gcc/fortran/trans-stmt.c *** gcc-4.0.2/gcc/fortran/trans-stmt.c Mon Jul 11 07:36:58 2005 --- gcc-4.1.0/gcc/fortran/trans-stmt.c Mon Feb 13 19:32:02 2006 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" *************** gfc_conv_label_variable (gfc_se * se, gf *** 91,96 **** --- 91,99 ---- /* Deals with variable in common block. Get the field declaration. */ if (TREE_CODE (se->expr) == COMPONENT_REF) se->expr = TREE_OPERAND (se->expr, 1); + /* Deals with dummy argument. Get the parameter declaration. */ + else if (TREE_CODE (se->expr) == INDIRECT_REF) + se->expr = TREE_OPERAND (se->expr, 0); } /* Translate a label assignment statement. */ *************** gfc_trans_label_assign (gfc_code * code) *** 118,125 **** if (code->label->defined == ST_LABEL_TARGET) { - /* Shouldn't need to set this flag. Reserve for optimization bug. */ - DECL_ARTIFICIAL (label_tree) = 0; label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree); len_tree = integer_minus_one_node; } --- 121,126 ---- *************** gfc_trans_goto (gfc_code * code) *** 165,175 **** gfc_trans_runtime_check (tmp, assign_error, &se.pre); assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr); - target = build1 (GOTO_EXPR, void_type_node, assigned_goto); code = code->block; if (code == NULL) { gfc_add_expr_to_block (&se.pre, target); return gfc_finish_block (&se.pre); } --- 166,176 ---- gfc_trans_runtime_check (tmp, assign_error, &se.pre); assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr); code = code->block; if (code == NULL) { + target = build1 (GOTO_EXPR, void_type_node, assigned_goto); gfc_add_expr_to_block (&se.pre, target); return gfc_finish_block (&se.pre); } *************** gfc_trans_goto (gfc_code * code) *** 179,188 **** do { ! tmp = gfc_get_label_decl (code->label); ! tmp = gfc_build_addr_expr (pvoid_type_node, tmp); tmp = build2 (EQ_EXPR, boolean_type_node, tmp, assigned_goto); ! tmp = build3_v (COND_EXPR, tmp, target, build_empty_stmt ()); gfc_add_expr_to_block (&se.pre, tmp); code = code->block; } --- 180,191 ---- do { ! target = gfc_get_label_decl (code->label); ! tmp = gfc_build_addr_expr (pvoid_type_node, target); tmp = build2 (EQ_EXPR, boolean_type_node, tmp, assigned_goto); ! tmp = build3_v (COND_EXPR, tmp, ! build1 (GOTO_EXPR, void_type_node, target), ! build_empty_stmt ()); gfc_add_expr_to_block (&se.pre, tmp); code = code->block; } *************** tree *** 206,211 **** --- 209,215 ---- gfc_trans_call (gfc_code * code) { gfc_se se; + gfc_ss * ss; int has_alternate_specifier; /* A CALL starts a new block because the actual arguments may have to *************** gfc_trans_call (gfc_code * code) *** 215,242 **** gcc_assert (code->resolved_sym); ! /* Translate the call. */ ! has_alternate_specifier ! = gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual); ! ! /* A subroutine without side-effect, by definition, does nothing! */ ! TREE_SIDE_EFFECTS (se.expr) = 1; ! /* Chain the pieces together and return the block. */ ! if (has_alternate_specifier) { ! gfc_code *select_code; ! gfc_symbol *sym; ! select_code = code->next; ! gcc_assert(select_code->op == EXEC_SELECT); ! sym = select_code->expr->symtree->n.sym; ! se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr); ! gfc_add_modify_expr (&se.pre, sym->backend_decl, se.expr); } else ! gfc_add_expr_to_block (&se.pre, se.expr); - gfc_add_block_to_block (&se.pre, &se.post); return gfc_finish_block (&se.pre); } --- 219,299 ---- gcc_assert (code->resolved_sym); ! ss = gfc_ss_terminator; ! if (code->resolved_sym->attr.elemental) ! ss = gfc_walk_elemental_function_args (ss, code->ext.actual, GFC_SS_REFERENCE); ! /* Is not an elemental subroutine call with array valued arguments. */ ! if (ss == gfc_ss_terminator) { ! ! /* Translate the call. */ ! has_alternate_specifier ! = gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual); ! ! /* A subroutine without side-effect, by definition, does nothing! */ ! TREE_SIDE_EFFECTS (se.expr) = 1; ! ! /* Chain the pieces together and return the block. */ ! if (has_alternate_specifier) ! { ! gfc_code *select_code; ! gfc_symbol *sym; ! select_code = code->next; ! gcc_assert(select_code->op == EXEC_SELECT); ! sym = select_code->expr->symtree->n.sym; ! se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr); ! gfc_add_modify_expr (&se.pre, sym->backend_decl, se.expr); ! } ! else ! gfc_add_expr_to_block (&se.pre, se.expr); ! ! gfc_add_block_to_block (&se.pre, &se.post); } + else ! { ! /* An elemental subroutine call with array valued arguments has ! to be scalarized. */ ! gfc_loopinfo loop; ! stmtblock_t body; ! stmtblock_t block; ! gfc_se loopse; ! ! /* gfc_walk_elemental_function_args renders the ss chain in the ! reverse order to the actual argument order. */ ! ss = gfc_reverse_ss (ss); ! ! /* Initialize the loop. */ ! gfc_init_se (&loopse, NULL); ! gfc_init_loopinfo (&loop); ! gfc_add_ss_to_loop (&loop, ss); ! ! gfc_conv_ss_startstride (&loop); ! gfc_conv_loop_setup (&loop); ! gfc_mark_ss_chain_used (ss, 1); ! ! /* Generate the loop body. */ ! gfc_start_scalarized_body (&loop, &body); ! gfc_init_block (&block); ! gfc_copy_loopinfo_to_se (&loopse, &loop); ! loopse.ss = ss; ! ! /* Add the subroutine call to the block. */ ! gfc_conv_function_call (&loopse, code->resolved_sym, code->ext.actual); ! gfc_add_expr_to_block (&loopse.pre, loopse.expr); ! ! gfc_add_block_to_block (&block, &loopse.pre); ! gfc_add_block_to_block (&block, &loopse.post); ! ! /* Finish up the loop block and the loop. */ ! gfc_add_expr_to_block (&body, gfc_finish_block (&block)); ! gfc_trans_scalarizing_loops (&loop, &body); ! gfc_add_block_to_block (&se.pre, &loop.pre); ! gfc_add_block_to_block (&se.pre, &loop.post); ! gfc_cleanup_loop (&loop); ! } return gfc_finish_block (&se.pre); } *************** gfc_trans_if (gfc_code * code) *** 461,466 **** --- 518,531 ---- } else // cond > 0 goto label3; + + An optimized version can be generated in case of equal labels. + E.g., if label1 is equal to label2, we can translate it to + + if (cond <= 0) + goto label1; + else + goto label3; */ tree *************** gfc_trans_arithmetic_if (gfc_code * code *** 482,499 **** /* Build something to compare with. */ zero = gfc_build_const (TREE_TYPE (se.expr), integer_zero_node); ! /* If (cond < 0) take branch1 else take branch2. ! First build jumps to the COND .LT. 0 and the COND .EQ. 0 cases. */ ! branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label)); ! branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label2)); ! tmp = build2 (LT_EXPR, boolean_type_node, se.expr, zero); ! branch1 = build3_v (COND_EXPR, tmp, branch1, branch2); ! /* if (cond <= 0) take branch1 else take branch2. */ ! branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label3)); ! tmp = build2 (LE_EXPR, boolean_type_node, se.expr, zero); ! branch1 = build3_v (COND_EXPR, tmp, branch1, branch2); /* Append the COND_EXPR to the evaluation of COND, and return. */ gfc_add_expr_to_block (&se.pre, branch1); --- 547,577 ---- /* Build something to compare with. */ zero = gfc_build_const (TREE_TYPE (se.expr), integer_zero_node); ! if (code->label->value != code->label2->value) ! { ! /* If (cond < 0) take branch1 else take branch2. ! First build jumps to the COND .LT. 0 and the COND .EQ. 0 cases. */ ! branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label)); ! branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label2)); ! if (code->label->value != code->label3->value) ! tmp = build2 (LT_EXPR, boolean_type_node, se.expr, zero); ! else ! tmp = build2 (NE_EXPR, boolean_type_node, se.expr, zero); ! branch1 = build3_v (COND_EXPR, tmp, branch1, branch2); ! } ! else ! branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label)); ! ! if (code->label->value != code->label3->value ! && code->label2->value != code->label3->value) ! { ! /* if (cond <= 0) take branch1 else take branch2. */ ! branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label3)); ! tmp = build2 (LE_EXPR, boolean_type_node, se.expr, zero); ! branch1 = build3_v (COND_EXPR, tmp, branch1, branch2); ! } /* Append the COND_EXPR to the evaluation of COND, and return. */ gfc_add_expr_to_block (&se.pre, branch1); *************** gfc_trans_simple_do (gfc_code * code, st *** 588,596 **** /* Only execute the loop if the number of iterations is positive. */ if (tree_int_cst_sgn (step) > 0) ! cond = fold (build2 (LE_EXPR, boolean_type_node, dovar, to)); else ! cond = fold (build2 (GE_EXPR, boolean_type_node, dovar, to)); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (pblock, tmp); --- 666,674 ---- /* Only execute the loop if the number of iterations is positive. */ if (tree_int_cst_sgn (step) > 0) ! cond = fold_build2 (LE_EXPR, boolean_type_node, dovar, to); else ! cond = fold_build2 (GE_EXPR, boolean_type_node, dovar, to); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (pblock, tmp); *************** gfc_trans_do (gfc_code * code) *** 686,696 **** /* Initialize loop count. This code is executed before we enter the loop body. We generate: count = (to + step - from) / step. */ ! tmp = fold (build2 (MINUS_EXPR, type, step, from)); ! tmp = fold (build2 (PLUS_EXPR, type, to, tmp)); if (TREE_CODE (type) == INTEGER_TYPE) { ! tmp = fold (build2 (TRUNC_DIV_EXPR, type, tmp, step)); count = gfc_create_var (type, "count"); } else --- 764,774 ---- /* Initialize loop count. This code is executed before we enter the loop body. We generate: count = (to + step - from) / step. */ ! tmp = fold_build2 (MINUS_EXPR, type, step, from); ! tmp = fold_build2 (PLUS_EXPR, type, to, tmp); if (TREE_CODE (type) == INTEGER_TYPE) { ! tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step); count = gfc_create_var (type, "count"); } else *************** gfc_trans_do (gfc_code * code) *** 698,705 **** /* TODO: We could use the same width as the real type. This would probably cause more problems that it solves when we implement "long double" types. */ ! tmp = fold (build2 (RDIV_EXPR, type, tmp, step)); ! tmp = fold (build1 (FIX_TRUNC_EXPR, gfc_array_index_type, tmp)); count = gfc_create_var (gfc_array_index_type, "count"); } gfc_add_modify_expr (&block, count, tmp); --- 776,783 ---- /* TODO: We could use the same width as the real type. This would probably cause more problems that it solves when we implement "long double" types. */ ! tmp = fold_build2 (RDIV_EXPR, type, tmp, step); ! tmp = fold_build1 (FIX_TRUNC_EXPR, gfc_array_index_type, tmp); count = gfc_create_var (gfc_array_index_type, "count"); } gfc_add_modify_expr (&block, count, tmp); *************** gfc_trans_do_while (gfc_code * code) *** 811,817 **** gfc_init_se (&cond, NULL); gfc_conv_expr_val (&cond, code->expr); gfc_add_block_to_block (&block, &cond.pre); ! cond.expr = fold (build1 (TRUTH_NOT_EXPR, boolean_type_node, cond.expr)); /* Build "IF (! cond) GOTO exit_label". */ tmp = build1_v (GOTO_EXPR, exit_label); --- 889,895 ---- gfc_init_se (&cond, NULL); gfc_conv_expr_val (&cond, code->expr); gfc_add_block_to_block (&block, &cond.pre); ! cond.expr = fold_build1 (TRUTH_NOT_EXPR, boolean_type_node, cond.expr); /* Build "IF (! cond) GOTO exit_label". */ tmp = build1_v (GOTO_EXPR, exit_label); *************** gfc_trans_character_select (gfc_code *co *** 1222,1235 **** tmp = gfc_build_addr_expr (pvoid_type_node, labels[i]); node = tree_cons (ss_target, tmp, node); ! tmp = build1 (CONSTRUCTOR, select_struct, nreverse (node)); init = tree_cons (NULL_TREE, tmp, init); } type = build_array_type (select_struct, build_index_type (build_int_cst (NULL_TREE, n - 1))); ! init = build1 (CONSTRUCTOR, type, nreverse(init)); TREE_CONSTANT (init) = 1; TREE_INVARIANT (init) = 1; TREE_STATIC (init) = 1; --- 1300,1313 ---- tmp = gfc_build_addr_expr (pvoid_type_node, labels[i]); node = tree_cons (ss_target, tmp, node); ! tmp = build_constructor_from_list (select_struct, nreverse (node)); init = tree_cons (NULL_TREE, tmp, init); } type = build_array_type (select_struct, build_index_type (build_int_cst (NULL_TREE, n - 1))); ! init = build_constructor_from_list (type, nreverse(init)); TREE_CONSTANT (init) = 1; TREE_INVARIANT (init) = 1; TREE_STATIC (init) = 1; *************** gfc_trans_forall_loop (forall_info *fora *** 1393,1401 **** gfc_index_zero_node); /* Initialize the loop counter. */ ! tmp = fold (build2 (MINUS_EXPR, TREE_TYPE (var), step, start)); ! tmp = fold (build2 (PLUS_EXPR, TREE_TYPE (var), end, tmp)); ! tmp = fold (build2 (TRUNC_DIV_EXPR, TREE_TYPE (var), tmp, step)); gfc_add_modify_expr (&block, count, tmp); /* The loop expression. */ --- 1471,1479 ---- gfc_index_zero_node); /* Initialize the loop counter. */ ! tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (var), step, start); ! tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (var), end, tmp); ! tmp = fold_build2 (TRUNC_DIV_EXPR, TREE_TYPE (var), tmp, step); gfc_add_modify_expr (&block, count, tmp); /* The loop expression. */ *************** gfc_do_allocate (tree bytesize, tree siz *** 1484,1491 **** if (INTEGER_CST_P (size)) { ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, size, ! gfc_index_one_node)); } else tmp = NULL_TREE; --- 1562,1569 ---- if (INTEGER_CST_P (size)) { ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, ! gfc_index_one_node); } else tmp = NULL_TREE; *************** generate_loop_for_temp_to_lhs (gfc_expr *** 1552,1559 **** gfc_add_block_to_block (&block, &lse.post); /* Increment the count1. */ ! tmp = fold (build2 (PLUS_EXPR, TREE_TYPE (count1), count1, ! gfc_index_one_node)); gfc_add_modify_expr (&block, count1, tmp); tmp = gfc_finish_block (&block); --- 1630,1637 ---- gfc_add_block_to_block (&block, &lse.post); /* Increment the count1. */ ! tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, ! gfc_index_one_node); gfc_add_modify_expr (&block, count1, tmp); tmp = gfc_finish_block (&block); *************** generate_loop_for_temp_to_lhs (gfc_expr *** 1592,1624 **** /* Use the scalar assignment. */ tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts.type); ! /* Form the mask expression according to the mask tree list. */ ! if (wheremask) ! { ! wheremaskexpr = gfc_build_array_ref (wheremask, count3); ! tmp2 = TREE_CHAIN (wheremask); ! while (tmp2) ! { ! tmp1 = gfc_build_array_ref (tmp2, count3); ! wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1), ! wheremaskexpr, tmp1); ! tmp2 = TREE_CHAIN (tmp2); ! } ! tmp = build3_v (COND_EXPR, wheremaskexpr, tmp, build_empty_stmt ()); ! } gfc_add_expr_to_block (&body, tmp); /* Increment count1. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node)); gfc_add_modify_expr (&body, count1, tmp); /* Increment count3. */ if (count3) { ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count3, gfc_index_one_node)); gfc_add_modify_expr (&body, count3, tmp); } --- 1670,1702 ---- /* Use the scalar assignment. */ tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts.type); ! /* Form the mask expression according to the mask tree list. */ ! if (wheremask) ! { ! wheremaskexpr = gfc_build_array_ref (wheremask, count3); ! tmp2 = TREE_CHAIN (wheremask); ! while (tmp2) ! { ! tmp1 = gfc_build_array_ref (tmp2, count3); ! wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1), ! wheremaskexpr, tmp1); ! tmp2 = TREE_CHAIN (tmp2); ! } ! tmp = build3_v (COND_EXPR, wheremaskexpr, tmp, build_empty_stmt ()); ! } gfc_add_expr_to_block (&body, tmp); /* Increment count1. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node); gfc_add_modify_expr (&body, count1, tmp); /* Increment count3. */ if (count3) { ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count3, gfc_index_one_node); gfc_add_modify_expr (&body, count3, tmp); } *************** generate_loop_for_rhs_to_temp (gfc_expr *** 1711,1732 **** gfc_add_block_to_block (&block, &body1); /* Increment count1. */ ! tmp = fold (build2 (PLUS_EXPR, TREE_TYPE (count1), count1, ! gfc_index_one_node)); gfc_add_modify_expr (&block, count1, tmp); } else { /* Increment count1. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node)); gfc_add_modify_expr (&body1, count1, tmp); /* Increment count3. */ if (count3) { ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count3, gfc_index_one_node)); gfc_add_modify_expr (&body1, count3, tmp); } --- 1789,1810 ---- gfc_add_block_to_block (&block, &body1); /* Increment count1. */ ! tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, ! gfc_index_one_node); gfc_add_modify_expr (&block, count1, tmp); } else { /* Increment count1. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node); gfc_add_modify_expr (&body1, count1, tmp); /* Increment count3. */ if (count3) { ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count3, gfc_index_one_node); gfc_add_modify_expr (&body1, count3, tmp); } *************** compute_inner_temp_size (gfc_expr *expr1 *** 1795,1805 **** /* Figure out how many elements we need. */ for (i = 0; i < loop.dimen; i++) { ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, loop.from[i])); ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! tmp, loop.to[i])); ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, size, tmp)); } gfc_add_block_to_block (pblock, &loop.pre); size = gfc_evaluate_now (size, pblock); --- 1873,1883 ---- /* Figure out how many elements we need. */ for (i = 0; i < loop.dimen; i++) { ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ! gfc_index_one_node, loop.from[i]); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! tmp, loop.to[i]); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); } gfc_add_block_to_block (pblock, &loop.pre); size = gfc_evaluate_now (size, pblock); *************** allocate_temp_for_forall_nest_1 (tree ty *** 1860,1866 **** tree bytesize; unit = TYPE_SIZE_UNIT (type); ! bytesize = fold (build2 (MULT_EXPR, gfc_array_index_type, size, unit)); *ptemp1 = NULL; temp1 = gfc_do_allocate (bytesize, size, ptemp1, block, type); --- 1938,1944 ---- tree bytesize; unit = TYPE_SIZE_UNIT (type); ! bytesize = fold_build2 (MULT_EXPR, gfc_array_index_type, size, unit); *ptemp1 = NULL; temp1 = gfc_do_allocate (bytesize, size, ptemp1, block, type); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2044,2055 **** rse.want_pointer = 1; gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&body, &rse.pre); ! gfc_add_modify_expr (&body, lse.expr, rse.expr); gfc_add_block_to_block (&body, &rse.post); /* Increment count. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count, gfc_index_one_node)); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); --- 2122,2134 ---- rse.want_pointer = 1; gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&body, &rse.pre); ! gfc_add_modify_expr (&body, lse.expr, ! fold_convert (TREE_TYPE (lse.expr), rse.expr)); gfc_add_block_to_block (&body, &rse.post); /* Increment count. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count, gfc_index_one_node); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2072,2079 **** gfc_add_modify_expr (&body, lse.expr, rse.expr); gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count, gfc_index_one_node)); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); --- 2151,2158 ---- gfc_add_modify_expr (&body, lse.expr, rse.expr); gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count, gfc_index_one_node); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2116,2123 **** gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count, gfc_index_one_node)); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); --- 2195,2202 ---- gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count, gfc_index_one_node); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); *************** gfc_trans_pointer_assign_need_temp (gfc_ *** 2140,2147 **** gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count, gfc_index_one_node)); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); --- 2219,2226 ---- gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count, gfc_index_one_node); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); *************** gfc_trans_forall_1 (gfc_code * code, for *** 2318,2331 **** lenvar = NULL_TREE; /* size = (end + step - start) / step. */ ! tmp = fold (build2 (MINUS_EXPR, TREE_TYPE (start[n]), ! step[n], start[n])); ! tmp = fold (build2 (PLUS_EXPR, TREE_TYPE (end[n]), end[n], tmp)); ! tmp = fold (build2 (FLOOR_DIV_EXPR, TREE_TYPE (tmp), tmp, step[n])); tmp = convert (gfc_array_index_type, tmp); ! size = fold (build2 (MULT_EXPR, gfc_array_index_type, size, tmp)); } /* Record the nvar and size of current forall level. */ --- 2397,2410 ---- lenvar = NULL_TREE; /* size = (end + step - start) / step. */ ! tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (start[n]), ! step[n], start[n]); ! tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (end[n]), end[n], tmp); ! tmp = fold_build2 (FLOOR_DIV_EXPR, TREE_TYPE (tmp), tmp, step[n]); tmp = convert (gfc_array_index_type, tmp); ! size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); } /* Record the nvar and size of current forall level. */ *************** gfc_trans_forall_1 (gfc_code * code, for *** 2354,2361 **** = gfc_get_logical_type (gfc_logical_kinds[0].kind); /* Allocate the mask temporary. */ ! bytesize = fold (build2 (MULT_EXPR, gfc_array_index_type, size, ! TYPE_SIZE_UNIT (smallest_boolean_type_node))); mask = gfc_do_allocate (bytesize, size, &pmask, &block, smallest_boolean_type_node); --- 2433,2440 ---- = gfc_get_logical_type (gfc_logical_kinds[0].kind); /* Allocate the mask temporary. */ ! bytesize = fold_build2 (MULT_EXPR, gfc_array_index_type, size, ! TYPE_SIZE_UNIT (smallest_boolean_type_node)); mask = gfc_do_allocate (bytesize, size, &pmask, &block, smallest_boolean_type_node); *************** gfc_trans_forall_1 (gfc_code * code, for *** 2414,2420 **** case EXEC_ASSIGN: /* A scalar or array assignment. */ need_temp = gfc_check_dependency (c->expr, c->expr2, varexpr, nvar); ! /* Teporaries due to array assignment data dependencies introduce no end of problems. */ if (need_temp) gfc_trans_assign_need_temp (c->expr, c->expr2, NULL, --- 2493,2499 ---- case EXEC_ASSIGN: /* A scalar or array assignment. */ need_temp = gfc_check_dependency (c->expr, c->expr2, varexpr, nvar); ! /* Temporaries due to array assignment data dependencies introduce no end of problems. */ if (need_temp) gfc_trans_assign_need_temp (c->expr, c->expr2, NULL, *************** gfc_trans_forall_1 (gfc_code * code, for *** 2477,2482 **** --- 2556,2569 ---- gfc_add_expr_to_block (&block, tmp); break; + /* Explicit subroutine calls are prevented by the frontend but interface + assignments can legitimately produce them. */ + case EXEC_CALL: + assign = gfc_trans_call (c); + tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1, 1); + gfc_add_expr_to_block (&block, tmp); + break; + default: gcc_unreachable (); } *************** gfc_evaluate_where_mask (gfc_expr * me, *** 2634,2641 **** else { /* Increment count. */ ! tmp1 = fold (build2 (PLUS_EXPR, gfc_array_index_type, count, ! gfc_index_one_node)); gfc_add_modify_expr (&body1, count, tmp1); /* Generate the copying loops. */ --- 2721,2728 ---- else { /* Increment count. */ ! tmp1 = fold_build2 (PLUS_EXPR, gfc_array_index_type, count, ! gfc_index_one_node); gfc_add_modify_expr (&body1, count, tmp1); /* Generate the copying loops. */ *************** gfc_trans_where_assign (gfc_expr *expr1, *** 2800,2807 **** if (lss == gfc_ss_terminator) { /* Increment count1. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node)); gfc_add_modify_expr (&body, count1, tmp); /* Use the scalar assignment as is. */ --- 2887,2894 ---- if (lss == gfc_ss_terminator) { /* Increment count1. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node); gfc_add_modify_expr (&body, count1, tmp); /* Use the scalar assignment as is. */ *************** gfc_trans_where_assign (gfc_expr *expr1, *** 2816,2823 **** { /* Increment count1 before finish the main body of a scalarized expression. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node)); gfc_add_modify_expr (&body, count1, tmp); gfc_trans_scalarized_loop_boundary (&loop, &body); --- 2903,2910 ---- { /* Increment count1 before finish the main body of a scalarized expression. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node); gfc_add_modify_expr (&body, count1, tmp); gfc_trans_scalarized_loop_boundary (&loop, &body); *************** gfc_trans_where_assign (gfc_expr *expr1, *** 2859,2873 **** gfc_add_expr_to_block (&body, tmp); /* Increment count2. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count2, gfc_index_one_node)); gfc_add_modify_expr (&body, count2, tmp); } else { /* Increment count1. */ ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node)); gfc_add_modify_expr (&body, count1, tmp); } --- 2946,2960 ---- gfc_add_expr_to_block (&body, tmp); /* Increment count2. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count2, gfc_index_one_node); gfc_add_modify_expr (&body, count2, tmp); } else { /* Increment count1. */ ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ! count1, gfc_index_one_node); gfc_add_modify_expr (&body, count1, tmp); } *************** gfc_trans_where_assign (gfc_expr *expr1, *** 2885,2891 **** /* Translate the WHERE construct or statement. ! This fuction can be called iteratively to translate the nested WHERE construct or statement. MASK is the control mask, and PMASK is the pending control mask. TEMP records the temporary address which must be freed later. */ --- 2972,2978 ---- /* Translate the WHERE construct or statement. ! This function can be called iteratively to translate the nested WHERE construct or statement. MASK is the control mask, and PMASK is the pending control mask. TEMP records the temporary address which must be freed later. */ *************** gfc_trans_allocate (gfc_code * code) *** 3158,3163 **** --- 3245,3254 ---- gfc_add_modify_expr (&se.pre, val, tmp); tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr))); + + if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE) + tmp = se.string_length; + parm = gfc_chainon_list (NULL_TREE, val); parm = gfc_chainon_list (parm, tmp); parm = gfc_chainon_list (parm, pstat); *************** gfc_trans_deallocate (gfc_code * code) *** 3256,3262 **** se.descriptor_only = 1; gfc_conv_expr (&se, expr); ! if (expr->symtree->n.sym->attr.dimension) tmp = gfc_array_deallocate (se.expr, pstat); else { --- 3347,3353 ---- se.descriptor_only = 1; gfc_conv_expr (&se, expr); ! if (expr->rank) tmp = gfc_array_deallocate (se.expr, pstat); else { diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-stmt.h gcc-4.1.0/gcc/fortran/trans-stmt.h *** gcc-4.0.2/gcc/fortran/trans-stmt.h Tue Aug 17 15:34:09 2004 --- gcc-4.1.0/gcc/fortran/trans-stmt.h Sun Aug 7 22:56:19 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* Statement translators (gfc_trans_*) return a fully translated tree. Calls gfc_trans_*. */ --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* Statement translators (gfc_trans_*) return a fully translated tree. Calls gfc_trans_*. */ *************** tree gfc_trans_backspace (gfc_code *); *** 61,66 **** --- 61,67 ---- tree gfc_trans_endfile (gfc_code *); tree gfc_trans_inquire (gfc_code *); tree gfc_trans_rewind (gfc_code *); + tree gfc_trans_flush (gfc_code *); tree gfc_trans_transfer (gfc_code *); tree gfc_trans_dt_end (gfc_code *); diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-types.c gcc-4.1.0/gcc/fortran/trans-types.c *** gcc-4.0.2/gcc/fortran/trans-types.c Sat Jun 4 20:59:43 2005 --- gcc-4.1.0/gcc/fortran/trans-types.c Wed Jan 11 07:27:31 2006 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ /* trans-types.c -- gfortran backend types */ --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ /* trans-types.c -- gfortran backend types */ *************** static tree gfc_get_derived_type (gfc_sy *** 51,64 **** tree gfc_array_index_type; tree gfc_array_range_type; tree pvoid_type_node; tree ppvoid_type_node; tree pchar_type_node; ! tree gfc_character1_type_node; tree gfc_charlen_type_node; static GTY(()) tree gfc_desc_dim_type; static GTY(()) tree gfc_max_array_element_size; /* Arrays for all integral and real kinds. We'll fill this in at runtime after the target has a chance to process command-line options. */ --- 51,66 ---- tree gfc_array_index_type; tree gfc_array_range_type; + tree gfc_character1_type_node; tree pvoid_type_node; tree ppvoid_type_node; tree pchar_type_node; ! tree gfc_charlen_type_node; static GTY(()) tree gfc_desc_dim_type; static GTY(()) tree gfc_max_array_element_size; + static GTY(()) tree gfc_array_descriptor_base[GFC_MAX_DIMENSIONS]; /* Arrays for all integral and real kinds. We'll fill this in at runtime after the target has a chance to process command-line options. */ *************** gfc_logical_info gfc_logical_kinds[MAX_I *** 69,75 **** static GTY(()) tree gfc_integer_types[MAX_INT_KINDS + 1]; static GTY(()) tree gfc_logical_types[MAX_INT_KINDS + 1]; ! #define MAX_REAL_KINDS 4 gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1]; static GTY(()) tree gfc_real_types[MAX_REAL_KINDS + 1]; static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS + 1]; --- 71,77 ---- static GTY(()) tree gfc_integer_types[MAX_INT_KINDS + 1]; static GTY(()) tree gfc_logical_types[MAX_INT_KINDS + 1]; ! #define MAX_REAL_KINDS 5 gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1]; static GTY(()) tree gfc_real_types[MAX_REAL_KINDS + 1]; static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS + 1]; *************** gfc_init_kinds (void) *** 150,155 **** --- 152,165 ---- if (!targetm.scalar_mode_supported_p (mode)) continue; + /* Only let float/double/long double go through because the fortran + library assumes these are the only floating point types. */ + + if (mode != TYPE_MODE (float_type_node) + && (mode != TYPE_MODE (double_type_node)) + && (mode != TYPE_MODE (long_double_type_node))) + continue; + /* Let the kind equal the precision divided by 8, rounding up. Again, this insulates the programmer from the underlying byte size. *************** gfc_init_kinds (void) *** 182,187 **** --- 192,206 ---- gfc_real_kinds[r_index].digits = fmt->p; gfc_real_kinds[r_index].min_exponent = fmt->emin; gfc_real_kinds[r_index].max_exponent = fmt->emax; + if (fmt->pnan < fmt->p) + /* This is an IBM extended double format (or the MIPS variant) + made up of two IEEE doubles. The value of the long double is + the sum of the values of the two parts. The most significant + part is required to be the value of the long double rounded + to the nearest double. If we use emax of 1024 then we can't + represent huge(x) = (1 - b**(-p)) * b**(emax-1) * b, because + rounding will make the most significant part overflow. */ + gfc_real_kinds[r_index].max_exponent = fmt->emax - 1; gfc_real_kinds[r_index].mode_precision = GET_MODE_PRECISION (mode); r_index += 1; } *************** gfc_init_types (void) *** 529,534 **** --- 548,555 ---- pchar_type_node = build_pointer_type (gfc_character1_type_node); gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind); + /* We cannot use gfc_index_zero_node in definition of gfc_array_range_type, + since this function is called before gfc_init_constants. */ gfc_array_range_type = build_range_type (gfc_array_index_type, build_int_cst (gfc_array_index_type, 0), *************** gfc_init_types (void) *** 562,590 **** tree gfc_get_int_type (int kind) { ! int index = gfc_validate_kind (BT_INTEGER, kind, false); ! return gfc_integer_types[index]; } tree gfc_get_real_type (int kind) { ! int index = gfc_validate_kind (BT_REAL, kind, false); ! return gfc_real_types[index]; } tree gfc_get_complex_type (int kind) { ! int index = gfc_validate_kind (BT_COMPLEX, kind, false); ! return gfc_complex_types[index]; } tree gfc_get_logical_type (int kind) { ! int index = gfc_validate_kind (BT_LOGICAL, kind, false); ! return gfc_logical_types[index]; } /* Create a character type with the given kind and length. */ --- 583,611 ---- tree gfc_get_int_type (int kind) { ! int index = gfc_validate_kind (BT_INTEGER, kind, true); ! return index < 0 ? 0 : gfc_integer_types[index]; } tree gfc_get_real_type (int kind) { ! int index = gfc_validate_kind (BT_REAL, kind, true); ! return index < 0 ? 0 : gfc_real_types[index]; } tree gfc_get_complex_type (int kind) { ! int index = gfc_validate_kind (BT_COMPLEX, kind, true); ! return index < 0 ? 0 : gfc_complex_types[index]; } tree gfc_get_logical_type (int kind) { ! int index = gfc_validate_kind (BT_LOGICAL, kind, true); ! return index < 0 ? 0 : gfc_logical_types[index]; } /* Create a character type with the given kind and length. */ *************** gfc_get_element_type (tree type) *** 686,692 **** else { gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); ! element = TREE_TYPE (TYPE_FIELDS (type)); gcc_assert (TREE_CODE (element) == POINTER_TYPE); element = TREE_TYPE (element); --- 707,713 ---- else { gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); ! element = GFC_TYPE_ARRAY_DATAPTR_TYPE (type); gcc_assert (TREE_CODE (element) == POINTER_TYPE); element = TREE_TYPE (element); *************** gfc_get_dtype (tree type) *** 935,942 **** if (size && !INTEGER_CST_P (size)) { tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT); ! tmp = fold (build2 (LSHIFT_EXPR, gfc_array_index_type, size, tmp)); ! dtype = fold (build2 (PLUS_EXPR, gfc_array_index_type, tmp, dtype)); } /* If we don't know the size we leave it as zero. This should never happen for anything that is actually used. */ --- 956,963 ---- if (size && !INTEGER_CST_P (size)) { tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT); ! tmp = fold_build2 (LSHIFT_EXPR, gfc_array_index_type, size, tmp); ! dtype = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, dtype); } /* If we don't know the size we leave it as zero. This should never happen for anything that is actually used. */ *************** gfc_get_nodesc_array_type (tree etype, g *** 1093,1098 **** --- 1114,1174 ---- return type; } + /* Return or create the base type for an array descriptor. */ + + static tree + gfc_get_array_descriptor_base (int dimen) + { + tree fat_type, fieldlist, decl, arraytype; + char name[16 + GFC_RANK_DIGITS + 1]; + + gcc_assert (dimen >= 1 && dimen <= GFC_MAX_DIMENSIONS); + if (gfc_array_descriptor_base[dimen - 1]) + return gfc_array_descriptor_base[dimen - 1]; + + /* Build the type node. */ + fat_type = make_node (RECORD_TYPE); + + sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT, dimen); + TYPE_NAME (fat_type) = get_identifier (name); + + /* Add the data member as the first element of the descriptor. */ + decl = build_decl (FIELD_DECL, get_identifier ("data"), ptr_type_node); + + DECL_CONTEXT (decl) = fat_type; + fieldlist = decl; + + /* Add the base component. */ + decl = build_decl (FIELD_DECL, get_identifier ("offset"), + gfc_array_index_type); + DECL_CONTEXT (decl) = fat_type; + fieldlist = chainon (fieldlist, decl); + + /* Add the dtype component. */ + decl = build_decl (FIELD_DECL, get_identifier ("dtype"), + gfc_array_index_type); + DECL_CONTEXT (decl) = fat_type; + fieldlist = chainon (fieldlist, decl); + + /* Build the array type for the stride and bound components. */ + arraytype = + build_array_type (gfc_get_desc_dim_type (), + build_range_type (gfc_array_index_type, + gfc_index_zero_node, + gfc_rank_cst[dimen - 1])); + + decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype); + DECL_CONTEXT (decl) = fat_type; + fieldlist = chainon (fieldlist, decl); + + /* Finish off the type. */ + TYPE_FIELDS (fat_type) = fieldlist; + + gfc_finish_type (fat_type); + + gfc_array_descriptor_base[dimen - 1] = fat_type; + return fat_type; + } /* Build an array (descriptor) type with given bounds. */ *************** tree *** 1100,1124 **** gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, tree * ubound, int packed) { - tree fat_type, fat_pointer_type; - tree fieldlist; - tree arraytype; - tree decl; - int n; char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN]; const char *typename; ! tree lower; ! tree upper; ! tree stride; ! tree tmp; ! /* Build the type node. */ ! fat_type = make_node (RECORD_TYPE); ! GFC_DESCRIPTOR_TYPE_P (fat_type) = 1; ! TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *) ! ggc_alloc_cleared (sizeof (struct lang_type)); ! GFC_TYPE_ARRAY_RANK (fat_type) = dimen; ! GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE; tmp = TYPE_NAME (etype); if (tmp && TREE_CODE (tmp) == TYPE_DECL) --- 1176,1188 ---- gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, tree * ubound, int packed) { char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN]; + tree fat_type, base_type, arraytype, lower, upper, stride, tmp; const char *typename; ! int n; ! base_type = gfc_get_array_descriptor_base (dimen); ! fat_type = build_variant_type_copy (base_type); tmp = TYPE_NAME (etype); if (tmp && TREE_CODE (tmp) == TYPE_DECL) *************** gfc_get_array_type_bounds (tree etype, i *** 1127,1146 **** typename = IDENTIFIER_POINTER (tmp); else typename = "unknown"; - sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen, GFC_MAX_SYMBOL_LEN, typename); TYPE_NAME (fat_type) = get_identifier (name); - TYPE_PACKED (fat_type) = 0; ! fat_pointer_type = build_pointer_type (fat_type); /* Build an array descriptor record type. */ if (packed != 0) stride = gfc_index_one_node; else stride = NULL_TREE; - for (n = 0; n < dimen; n++) { GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride; --- 1191,1212 ---- typename = IDENTIFIER_POINTER (tmp); else typename = "unknown"; sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen, GFC_MAX_SYMBOL_LEN, typename); TYPE_NAME (fat_type) = get_identifier (name); ! GFC_DESCRIPTOR_TYPE_P (fat_type) = 1; ! TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *) ! ggc_alloc_cleared (sizeof (struct lang_type)); ! ! GFC_TYPE_ARRAY_RANK (fat_type) = dimen; ! GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE; /* Build an array descriptor record type. */ if (packed != 0) stride = gfc_index_one_node; else stride = NULL_TREE; for (n = 0; n < dimen; n++) { GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride; *************** gfc_get_array_type_bounds (tree etype, i *** 1169,1179 **** if (upper != NULL_TREE && lower != NULL_TREE && stride != NULL_TREE) { ! tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, upper, lower)); ! tmp = fold (build2 (PLUS_EXPR, gfc_array_index_type, tmp, ! gfc_index_one_node)); stride = ! fold (build2 (MULT_EXPR, gfc_array_index_type, tmp, stride)); /* Check the folding worked. */ gcc_assert (INTEGER_CST_P (stride)); } --- 1235,1245 ---- if (upper != NULL_TREE && lower != NULL_TREE && stride != NULL_TREE) { ! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, upper, lower); ! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, ! gfc_index_one_node); stride = ! fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, stride); /* Check the folding worked. */ gcc_assert (INTEGER_CST_P (stride)); } *************** gfc_get_array_type_bounds (tree etype, i *** 1181,1186 **** --- 1247,1253 ---- stride = NULL_TREE; } GFC_TYPE_ARRAY_SIZE (fat_type) = stride; + /* TODO: known offsets for descriptors. */ GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE; *************** gfc_get_array_type_bounds (tree etype, i *** 1191,1232 **** arraytype = build_pointer_type (arraytype); GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype; - /* The pointer to the array data. */ - decl = build_decl (FIELD_DECL, get_identifier ("data"), arraytype); - - DECL_CONTEXT (decl) = fat_type; - /* Add the data member as the first element of the descriptor. */ - fieldlist = decl; - - /* Add the base component. */ - decl = build_decl (FIELD_DECL, get_identifier ("offset"), - gfc_array_index_type); - DECL_CONTEXT (decl) = fat_type; - fieldlist = chainon (fieldlist, decl); - - /* Add the dtype component. */ - decl = build_decl (FIELD_DECL, get_identifier ("dtype"), - gfc_array_index_type); - DECL_CONTEXT (decl) = fat_type; - fieldlist = chainon (fieldlist, decl); - - /* Build the array type for the stride and bound components. */ - arraytype = - build_array_type (gfc_get_desc_dim_type (), - build_range_type (gfc_array_index_type, - gfc_index_zero_node, - gfc_rank_cst[dimen - 1])); - - decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype); - DECL_CONTEXT (decl) = fat_type; - DECL_INITIAL (decl) = NULL_TREE; - fieldlist = chainon (fieldlist, decl); - - /* Finish off the type. */ - TYPE_FIELDS (fat_type) = fieldlist; - - gfc_finish_type (fat_type); - return fat_type; } --- 1258,1263 ---- *************** gfc_sym_type (gfc_symbol * sym) *** 1266,1276 **** return TREE_TYPE (sym->backend_decl); } - /* The frontend doesn't set all the attributes for a function with an - explicit result value, so we use that instead when present. */ - if (sym->attr.function && sym->result) - sym = sym->result; - type = gfc_typenode_for_spec (&sym->ts); if (gfc_option.flag_f2c && sym->attr.function --- 1297,1302 ---- *************** gfc_sym_type (gfc_symbol * sym) *** 1297,1303 **** /* If this is a character argument of unknown length, just use the base type. */ if (sym->ts.type != BT_CHARACTER ! || !(sym->attr.dummy || sym->attr.function || sym->attr.result) || sym->ts.cl->backend_decl) { type = gfc_get_nodesc_array_type (type, sym->as, --- 1323,1329 ---- /* If this is a character argument of unknown length, just use the base type. */ if (sym->ts.type != BT_CHARACTER ! || !(sym->attr.dummy || sym->attr.function) || sym->ts.cl->backend_decl) { type = gfc_get_nodesc_array_type (type, sym->as, *************** gfc_add_field_to_struct (tree *fieldlist *** 1369,1381 **** } ! /* Build a tree node for a derived type. */ static tree gfc_get_derived_type (gfc_symbol * derived) { tree typenode, field, field_type, fieldlist; gfc_component *c; gcc_assert (derived && derived->attr.flavor == FL_DERIVED); --- 1395,1451 ---- } ! /* Copy the backend_decl and component backend_decls if ! the two derived type symbols are "equal", as described ! in 4.4.2 and resolved by gfc_compare_derived_types. */ ! ! static int ! copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to) ! { ! gfc_component *to_cm; ! gfc_component *from_cm; ! ! if (from->backend_decl == NULL ! || !gfc_compare_derived_types (from, to)) ! return 0; ! ! to->backend_decl = from->backend_decl; ! ! to_cm = to->components; ! from_cm = from->components; ! ! /* Copy the component declarations. If a component is itself ! a derived type, we need a copy of its component declarations. ! This is done by recursing into gfc_get_derived_type and ! ensures that the component's component declarations have ! been built. If it is a character, we need the character ! length, as well. */ ! for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next) ! { ! to_cm->backend_decl = from_cm->backend_decl; ! if (from_cm->ts.type == BT_DERIVED) ! gfc_get_derived_type (to_cm->ts.derived); ! ! else if (from_cm->ts.type == BT_CHARACTER) ! to_cm->ts.cl->backend_decl = from_cm->ts.cl->backend_decl; ! } ! ! return 1; ! } ! ! ! /* Build a tree node for a derived type. If there are equal ! derived types, with different local names, these are built ! at the same time. If an equal derived type has been built ! in a parent namespace, this is used. */ static tree gfc_get_derived_type (gfc_symbol * derived) { tree typenode, field, field_type, fieldlist; gfc_component *c; + gfc_dt_list *dt; + gfc_namespace * ns; gcc_assert (derived && derived->attr.flavor == FL_DERIVED); *************** gfc_get_derived_type (gfc_symbol * deriv *** 1391,1396 **** --- 1461,1489 ---- } else { + /* In a module, if an equal derived type is already available in the + specification block, use its backend declaration and those of its + components, rather than building anew so that potential dummy and + actual arguments use the same TREE_TYPE. Non-module structures, + need to be built, if found, because the order of visits to the + namespaces is different. */ + + for (ns = derived->ns->parent; ns; ns = ns->parent) + { + for (dt = ns->derived_types; dt; dt = dt->next) + { + if (derived->module == NULL + && dt->derived->backend_decl == NULL + && gfc_compare_derived_types (dt->derived, derived)) + gfc_get_derived_type (dt->derived); + + if (copy_dt_decls_ifequal (dt->derived, derived)) + break; + } + if (derived->backend_decl) + goto other_equal_dts; + } + /* We see this derived type first time, so build the type node. */ typenode = make_node (RECORD_TYPE); TYPE_NAME (typenode) = get_identifier (derived->name); *************** gfc_get_derived_type (gfc_symbol * deriv *** 1398,1418 **** derived->backend_decl = typenode; } /* Build the type member list. Install the newly created RECORD_TYPE node as DECL_CONTEXT of each FIELD_DECL. */ fieldlist = NULL_TREE; for (c = derived->components; c; c = c->next) { ! if (c->ts.type == BT_DERIVED && c->pointer) ! { ! if (c->ts.derived->backend_decl) ! /* We already saw this derived type so use the exiting type. ! It doesn't matter if it is incomplete. */ ! field_type = c->ts.derived->backend_decl; ! else ! /* Recurse into the type. */ ! field_type = gfc_get_derived_type (c->ts.derived); ! } else { if (c->ts.type == BT_CHARACTER) --- 1491,1520 ---- derived->backend_decl = typenode; } + /* Go through the derived type components, building them as + necessary. The reason for doing this now is that it is + possible to recurse back to this derived type through a + pointer component (PR24092). If this happens, the fields + will be built and so we can return the type. */ + for (c = derived->components; c; c = c->next) + { + if (c->ts.type != BT_DERIVED) + continue; + + if (!c->pointer || c->ts.derived->backend_decl == NULL) + c->ts.derived->backend_decl = gfc_get_derived_type (c->ts.derived); + } + + if (TYPE_FIELDS (derived->backend_decl)) + return derived->backend_decl; + /* Build the type member list. Install the newly created RECORD_TYPE node as DECL_CONTEXT of each FIELD_DECL. */ fieldlist = NULL_TREE; for (c = derived->components; c; c = c->next) { ! if (c->ts.type == BT_DERIVED) ! field_type = c->ts.derived->backend_decl; else { if (c->ts.type == BT_CHARACTER) *************** gfc_get_derived_type (gfc_symbol * deriv *** 1447,1454 **** DECL_PACKED (field) |= TYPE_PACKED (typenode); ! gcc_assert (!c->backend_decl); ! c->backend_decl = field; } /* Now we have the final fieldlist. Record it, then lay out the --- 1549,1557 ---- DECL_PACKED (field) |= TYPE_PACKED (typenode); ! gcc_assert (field); ! if (!c->backend_decl) ! c->backend_decl = field; } /* Now we have the final fieldlist. Record it, then lay out the *************** gfc_get_derived_type (gfc_symbol * deriv *** 1459,1481 **** derived->backend_decl = typenode; ! return typenode; } ! int gfc_return_by_reference (gfc_symbol * sym) { - gfc_symbol *result; - if (!sym->attr.function) return 0; ! result = sym->result ? sym->result : sym; ! ! if (result->attr.dimension) return 1; ! if (result->ts.type == BT_CHARACTER) return 1; /* Possibly return complex numbers by reference for g77 compatibility. --- 1562,1587 ---- derived->backend_decl = typenode; ! other_equal_dts: ! /* Add this backend_decl to all the other, equal derived types and ! their components in this namespace. */ ! for (dt = derived->ns->derived_types; dt; dt = dt->next) ! copy_dt_decls_ifequal (derived, dt->derived); ! ! return derived->backend_decl; } ! ! int gfc_return_by_reference (gfc_symbol * sym) { if (!sym->attr.function) return 0; ! if (sym->attr.dimension) return 1; ! if (sym->ts.type == BT_CHARACTER) return 1; /* Possibly return complex numbers by reference for g77 compatibility. *************** gfc_return_by_reference (gfc_symbol * sy *** 1484,1490 **** require an explicit interface, as no compatibility problems can arise there. */ if (gfc_option.flag_f2c ! && result->ts.type == BT_COMPLEX && !sym->attr.intrinsic && !sym->attr.always_explicit) return 1; --- 1590,1596 ---- require an explicit interface, as no compatibility problems can arise there. */ if (gfc_option.flag_f2c ! && sym->ts.type == BT_COMPLEX && !sym->attr.intrinsic && !sym->attr.always_explicit) return 1; *************** gfc_get_function_type (gfc_symbol * sym) *** 1609,1615 **** The problem arises if a function is called via an implicit prototype. In this situation the INTENT is not known. For this reason all parameters to global functions must be ! passed by reference. Passing by value would potentialy generate bad code. Worse there would be no way of telling that this code was bad, except that it would give incorrect results. --- 1715,1721 ---- The problem arises if a function is called via an implicit prototype. In this situation the INTENT is not known. For this reason all parameters to global functions must be ! passed by reference. Passing by value would potentially generate bad code. Worse there would be no way of telling that this code was bad, except that it would give incorrect results. diff -Nrcpad gcc-4.0.2/gcc/fortran/trans-types.h gcc-4.1.0/gcc/fortran/trans-types.h *** gcc-4.0.2/gcc/fortran/trans-types.h Sat Sep 10 21:40:00 2005 --- gcc-4.1.0/gcc/fortran/trans-types.h Fri Jul 29 00:02:38 2005 *************** for more details. *** 17,24 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef GFC_BACKEND_H --- 17,24 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #ifndef GFC_BACKEND_H diff -Nrcpad gcc-4.0.2/gcc/fortran/trans.c gcc-4.1.0/gcc/fortran/trans.c *** gcc-4.0.2/gcc/fortran/trans.c Thu Aug 11 13:53:19 2005 --- gcc-4.1.0/gcc/fortran/trans.c Tue Nov 1 21:40:06 2005 *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" #include "system.h" --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #include "config.h" #include "system.h" *************** gfc_add_modify_expr (stmtblock_t * pbloc *** 152,158 **** || AGGREGATE_TYPE_P (TREE_TYPE (lhs))); #endif ! tmp = fold (build2_v (MODIFY_EXPR, lhs, rhs)); gfc_add_expr_to_block (pblock, tmp); } --- 152,158 ---- || AGGREGATE_TYPE_P (TREE_TYPE (lhs))); #endif ! tmp = fold_build2 (MODIFY_EXPR, void_type_node, lhs, rhs); gfc_add_expr_to_block (pblock, tmp); } *************** gfc_build_array_ref (tree base, tree off *** 314,320 **** } ! /* Given a funcion declaration FNDECL and an argument list ARGLIST, build a CALL_EXPR. */ tree --- 314,320 ---- } ! /* Given a function declaration FNDECL and an argument list ARGLIST, build a CALL_EXPR. */ tree *************** gfc_trans_code (gfc_code * code) *** 557,562 **** --- 557,566 ---- res = gfc_trans_select (code); break; + case EXEC_FLUSH: + res = gfc_trans_flush (code); + break; + case EXEC_FORALL: res = gfc_trans_forall (code); break; *************** gfc_generate_code (gfc_namespace * ns) *** 652,681 **** return; } - /* Main program subroutine. */ - if (!ns->proc_name) - { - gfc_symbol *main_program; - symbol_attribute attr; - - /* Lots of things get upset if a subroutine doesn't have a symbol, so we - make one now. Hopefully we've set all the required fields. */ - gfc_get_symbol ("MAIN__", ns, &main_program); - gfc_clear_attr (&attr); - attr.flavor = FL_PROCEDURE; - attr.proc = PROC_UNKNOWN; - attr.subroutine = 1; - attr.access = ACCESS_PUBLIC; - attr.is_main_program = 1; - main_program->attr = attr; - - /* Set the location to the first line of code. */ - if (ns->code) - main_program->declared_at = ns->code->loc; - ns->proc_name = main_program; - gfc_commit_symbols (); - } - gfc_generate_function_code (ns); } --- 656,661 ---- diff -Nrcpad gcc-4.0.2/gcc/fortran/trans.h gcc-4.1.0/gcc/fortran/trans.h *** gcc-4.0.2/gcc/fortran/trans.h Thu Aug 11 13:53:19 2005 --- gcc-4.1.0/gcc/fortran/trans.h Mon Jan 9 02:54:25 2006 *************** *** 1,5 **** /* Header for code translation functions ! Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. --- 1,5 ---- /* Header for code translation functions ! Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. *************** for more details. *** 16,23 **** You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #ifndef GFC_TRANS_H #define GFC_TRANS_H --- 16,23 ---- You should have received a copy of the GNU General Public License along with GCC; see the file COPYING. If not, write to the Free ! Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. */ #ifndef GFC_TRANS_H #define GFC_TRANS_H *************** typedef enum *** 138,145 **** uses this temporary inside the scalarization loop. */ GFC_SS_CONSTRUCTOR, ! /* A vector subscript. Only used as the SS chain for a subscript. ! Similar int format to a GFC_SS_SECTION. */ GFC_SS_VECTOR, /* A temporary array allocated by the scalarizer. Its rank can be less --- 138,145 ---- uses this temporary inside the scalarization loop. */ GFC_SS_CONSTRUCTOR, ! /* A vector subscript. The vector's descriptor is cached in the ! "descriptor" field of the associated gfc_ss_info. */ GFC_SS_VECTOR, /* A temporary array allocated by the scalarizer. Its rank can be less *************** gfc_saved_var; *** 251,258 **** /* Advance the SS chain to the next term. */ void gfc_advance_se_ss_chain (gfc_se *); ! /* Call this to initialise a gfc_se structure before use ! first parameter is structure to initialise, second is parent to get scalarization data from, or NULL. */ void gfc_init_se (gfc_se *, gfc_se *); --- 251,258 ---- /* Advance the SS chain to the next term. */ void gfc_advance_se_ss_chain (gfc_se *); ! /* Call this to initialize a gfc_se structure before use ! first parameter is structure to initialize, second is parent to get scalarization data from, or NULL. */ void gfc_init_se (gfc_se *, gfc_se *); *************** void gfc_make_safe_expr (gfc_se * se); *** 268,278 **** /* Makes sure se is suitable for passing as a function string parameter. */ void gfc_conv_string_parameter (gfc_se * se); /* Add an item to the end of TREE_LIST. */ tree gfc_chainon_list (tree, tree); /* When using the gfc_conv_* make sure you understand what they do, i.e. ! when a POST chain may be created, and what the retured expression may be used for. Note that character strings have special handling. This should not be a problem as most statements/operations only deal with numeric/logical types. See the implementations in trans-expr.c --- 268,281 ---- /* Makes sure se is suitable for passing as a function string parameter. */ void gfc_conv_string_parameter (gfc_se * se); + /* Compare two strings. */ + tree gfc_build_compare_string (tree, tree, tree, tree); + /* Add an item to the end of TREE_LIST. */ tree gfc_chainon_list (tree, tree); /* When using the gfc_conv_* make sure you understand what they do, i.e. ! when a POST chain may be created, and what the returned expression may be used for. Note that character strings have special handling. This should not be a problem as most statements/operations only deal with numeric/logical types. See the implementations in trans-expr.c *************** void gfc_add_modify_expr (stmtblock_t *, *** 327,333 **** /* Initialize a statement block. */ void gfc_init_block (stmtblock_t *); ! /* Start a new satement block. Like gfc_init_block but also starts a new variable scope. */ void gfc_start_block (stmtblock_t *); /* Finish a statement block. Also closes the scope if the block was created --- 330,336 ---- /* Initialize a statement block. */ void gfc_init_block (stmtblock_t *); ! /* Start a new statement block. Like gfc_init_block but also starts a new variable scope. */ void gfc_start_block (stmtblock_t *); /* Finish a statement block. Also closes the scope if the block was created *************** tree gfc_build_indirect_ref (tree); *** 357,363 **** /* Build an ARRAY_REF. */ tree gfc_build_array_ref (tree, tree); ! /* Creates an label. Decl is artificial if label_id == NULL_TREE. */ tree gfc_build_label_decl (tree); /* Return the decl used to hold the function return value. --- 360,366 ---- /* Build an ARRAY_REF. */ tree gfc_build_array_ref (tree, tree); ! /* Creates a label. Decl is artificial if label_id == NULL_TREE. */ tree gfc_build_label_decl (tree); /* Return the decl used to hold the function return value. *************** void gfc_restore_sym (gfc_symbol *, gfc_ *** 391,397 **** /* Returns true if a variable of specified size should go on the stack. */ int gfc_can_put_var_on_stack (tree); ! /* Allocate the lang-spcific part of a decl node. */ void gfc_allocate_lang_decl (tree); /* Advance along a TREE_CHAIN. */ --- 394,400 ---- /* Returns true if a variable of specified size should go on the stack. */ int gfc_can_put_var_on_stack (tree); ! /* Allocate the lang-specific part of a decl node. */ void gfc_allocate_lang_decl (tree); /* Advance along a TREE_CHAIN. */ *************** void gfc_trans_runtime_check (tree, tree *** 420,426 **** /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *); ! /* Generate code for an pointer assignment. */ tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *); /* Initialize function decls for library functions. */ --- 423,429 ---- /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *); ! /* Generate code for a pointer assignment. */ tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *); /* Initialize function decls for library functions. */ *************** tree builtin_function (const char *, tre *** 443,448 **** --- 446,453 ---- /* Runtime library function decls. */ extern GTY(()) tree gfor_fndecl_internal_malloc; extern GTY(()) tree gfor_fndecl_internal_malloc64; + extern GTY(()) tree gfor_fndecl_internal_realloc; + extern GTY(()) tree gfor_fndecl_internal_realloc64; extern GTY(()) tree gfor_fndecl_internal_free; extern GTY(()) tree gfor_fndecl_allocate; extern GTY(()) tree gfor_fndecl_allocate64; *************** extern GTY(()) tree gfor_fndecl_stop_num *** 453,459 **** --- 458,468 ---- extern GTY(()) tree gfor_fndecl_stop_string; extern GTY(()) tree gfor_fndecl_select_string; extern GTY(()) tree gfor_fndecl_runtime_error; + extern GTY(()) tree gfor_fndecl_set_fpe; extern GTY(()) tree gfor_fndecl_set_std; + extern GTY(()) tree gfor_fndecl_ttynam; + extern GTY(()) tree gfor_fndecl_ctime; + extern GTY(()) tree gfor_fndecl_fdate; extern GTY(()) tree gfor_fndecl_in_pack; extern GTY(()) tree gfor_fndecl_in_unpack; extern GTY(()) tree gfor_fndecl_associated; *************** typedef struct gfc_powdecl_list GTY(()) *** 469,481 **** } gfc_powdecl_list; ! extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[3][2]; extern GTY(()) tree gfor_fndecl_math_cpowf; extern GTY(()) tree gfor_fndecl_math_cpow; extern GTY(()) tree gfor_fndecl_math_ishftc4; extern GTY(()) tree gfor_fndecl_math_ishftc8; extern GTY(()) tree gfor_fndecl_math_exponent4; extern GTY(()) tree gfor_fndecl_math_exponent8; /* String functions. */ extern GTY(()) tree gfor_fndecl_copy_string; --- 478,495 ---- } gfc_powdecl_list; ! extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3]; extern GTY(()) tree gfor_fndecl_math_cpowf; extern GTY(()) tree gfor_fndecl_math_cpow; + extern GTY(()) tree gfor_fndecl_math_cpowl10; + extern GTY(()) tree gfor_fndecl_math_cpowl16; extern GTY(()) tree gfor_fndecl_math_ishftc4; extern GTY(()) tree gfor_fndecl_math_ishftc8; + extern GTY(()) tree gfor_fndecl_math_ishftc16; extern GTY(()) tree gfor_fndecl_math_exponent4; extern GTY(()) tree gfor_fndecl_math_exponent8; + extern GTY(()) tree gfor_fndecl_math_exponent10; + extern GTY(()) tree gfor_fndecl_math_exponent16; /* String functions. */ extern GTY(()) tree gfor_fndecl_copy_string; *************** struct lang_decl GTY(()) *** 570,573 **** --- 584,657 ---- arg1, arg2) #define build3_v(code, arg1, arg2, arg3) build3(code, void_type_node, \ arg1, arg2, arg3) + + /* This group of functions allows a caller to evaluate an expression from + the callee's interface. It establishes a mapping between the interface's + dummy arguments and the caller's actual arguments, then applies that + mapping to a given gfc_expr. + + You can initialize a mapping structure like so: + + gfc_interface_mapping mapping; + ... + gfc_init_interface_mapping (&mapping); + + You should then evaluate each actual argument into a temporary + gfc_se structure, here called "se", and map the result to the + dummy argument's symbol, here called "sym": + + gfc_add_interface_mapping (&mapping, sym, &se); + + After adding all mappings, you should call: + + gfc_finish_interface_mapping (&mapping, pre, post); + + where "pre" and "post" are statement blocks for initialization + and finalization code respectively. You can then evaluate an + interface expression "expr" as follows: + + gfc_apply_interface_mapping (&mapping, se, expr); + + Once you've evaluated all expressions, you should free + the mapping structure with: + + gfc_free_interface_mapping (&mapping); */ + + + /* This structure represents a mapping from OLD to NEW, where OLD is a + dummy argument symbol and NEW is a symbol that represents the value + of an actual argument. Mappings are linked together using NEXT + (in no particular order). */ + typedef struct gfc_interface_sym_mapping + { + struct gfc_interface_sym_mapping *next; + gfc_symbol *old; + gfc_symtree *new; + } + gfc_interface_sym_mapping; + + + /* This structure is used by callers to evaluate an expression from + a callee's interface. */ + typedef struct gfc_interface_mapping + { + /* Maps the interface's dummy arguments to the values that the caller + is passing. The whole list is owned by this gfc_interface_mapping. */ + gfc_interface_sym_mapping *syms; + + /* A list of gfc_charlens that were needed when creating copies of + expressions. The whole list is owned by this gfc_interface_mapping. */ + gfc_charlen *charlens; + } + gfc_interface_mapping; + + void gfc_init_interface_mapping (gfc_interface_mapping *); + void gfc_free_interface_mapping (gfc_interface_mapping *); + void gfc_add_interface_mapping (gfc_interface_mapping *, + gfc_symbol *, gfc_se *); + void gfc_finish_interface_mapping (gfc_interface_mapping *, + stmtblock_t *, stmtblock_t *); + void gfc_apply_interface_mapping (gfc_interface_mapping *, + gfc_se *, gfc_expr *); + #endif /* GFC_TRANS_H */ diff -Nrcpad gcc-4.0.2/libgfortran/.cvsignore gcc-4.1.0/libgfortran/.cvsignore *** gcc-4.0.2/libgfortran/.cvsignore Mon Aug 23 23:51:56 2004 --- gcc-4.1.0/libgfortran/.cvsignore Thu Jan 1 00:00:00 1970 *************** *** 1 **** - autom4te.cache --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/ChangeLog gcc-4.1.0/libgfortran/ChangeLog *** gcc-4.0.2/libgfortran/ChangeLog Wed Sep 21 03:57:56 2005 --- gcc-4.1.0/libgfortran/ChangeLog Tue Feb 28 08:28:51 2006 *************** *** 1,22 **** ! 2005-09-20 Release Manager ! * GCC 4.0.2 released. 2005-09-11 Francois-Xavier Coudert - PR libfortran/19872 PR libfortran/20179 * io/unix.c (is_preconnected): Add function to test if a stream corresponds to a preconnected unit. * io/io.h: Add prototype for is_preconnected. ! * io/transfer.c (data_transfer_init): Truncate overwritten files ! on first write, but not preconnected units. 2005-09-09 Francois-Xavier Coudert PR libfortran/23784 * io/close.c (st_close): Call library_end even in case of error. 2005-09-07 Francois-Xavier Coudert PR libfortran/23262 --- 1,1213 ---- ! 2006-02-28 Release Manager ! * GCC 4.1.0 released. ! ! 2006-02-19 Roger Sayle ! ! * configure.ac (CFLAGS): Update to include -std=gnu99 so that ! the configure tests will be run with the same environment as ! used to compile the libgfortran source code. ! * configure: Regenerate. ! ! 2006-02-14 Janne Blomqvist ! ! PR libgfortran/25949 ! * io/io.h: Add set function pointer to struct stream. ! * io/unix.c (fd_seek): Only update offset, don't seek. ! (fd_sset): New function. ! (fd_read): Call lseek directly if necessary. ! (fd_write): Likewise. ! (fd_open): Set pointer to fd_sset. ! (mem_set): New function. ! (open_internal): Set pointer to mem_set. ! * io/transfer.c (write_block_direct): Rename to write_buf, add ! error return, non-pointer length argument. ! (unformatted_write): Update to use write_buf. ! (us_write): Simplify by using swrite instead of salloc_w. ! (write_us_marker): New function. ! (new_record_w): Use sset instead of memset, use write_us_marker, ! simplify by using swrite instead of salloc_w. ! ! 2006-02-14 Rainer Orth ! ! PR libfortran/15234: Backport from mainline ! ! 2006-01-02 Paolo Bonzini ! ! PR target/25259 ! * configure.ac: Use GCC_HEADER_STDINT. ! * libgfortran.h: Include gstdint.h. ! * aclocal.m4: Regenerate. ! * configure: Regenerate. ! ! 2006-02-14 Francois-Xavier Coudert ! ! PR libfortran/24685 ! * io/write.c (write_real): Widen the default format for real(10) ! variables output. ! ! 2006-02-14 Francois-Xavier Coudert ! ! PR libfortran/25425 ! * libgfortran.h: Add pedantic field to compile_options struct. ! * io/write.c (calculate_G_format): Depending on the standard, ! choose E or F format for list-directed output of 0.0. ! * runtime/error.c (notify_std): Make warning and error dependent ! on pedanticity. ! * runtime/compile_options.c (set_std): Use new pedantic argument. ! ! 2006-02-08 Thomas Koenig ! ! PR libfortran/23815 ! * runtime/environ.c (init_unformatted): Add GFORTRAN_CONVERT_UNIT ! environment variable. ! (top level): Add defines, type and static variables for ! GFORTRAN_CONVERT_UNIT handling. ! (search_unit): New function. ! (match_word): New function. ! (match_integer): New function. ! (next_token): New function. ! (push_token): New function. ! (mark_single): New function. ! (mark_range): New funciton. ! (do_parse): New function. ! (init_unformatted): New function. ! (get_unformatted_convert): New function. ! * runtime/compile_options.c: Add set_convert(). ! * libgfortran.h: Add convert to compile_options_t. ! * io/open.c (st_open): Call get_unformatted_convert to get ! unit default; if CONVERT_NONE is returned, check for ! the presence of a CONVERT specifier and use it. ! As default, use compile_options.convert. ! * io/io.h (top level): Add CONVERT_NONE to unit_convert, to signal ! "nothing has been set". ! (top level): Add prototype for get_unformatted_convert. ! ! 2006-02-07 Dale Ranta ! ! PR fortran/25577 ! * intrinsics/mvbits.c: Shift '(TYPE)1' type when building 'lenmask'. ! ! 2006-02-07 Rainer Emrich ! ! * intrinsics/c99_functions.c: Work around incompatible ! declarations of cabs{,f,l} on pre-C99 IRIX systems. ! ! 2006-01-28 Jerry DeLisle ! ! PR libgfortran/25835 ! * io/transfer.c (st_read_done): Flush buffers when read is done. ! ! 2006-01-20 Jerry DeLisle ! ! PR libgfortran/25697 ! * io/transfer.c (us_read): Detect end of file condition from previous ! operations and bail out (no need to pre-position). ! ! 2006-01-17 Jerry DeLisle ! ! PR libgfortran/25631 ! * io/transfer.c (formatted_transfer_scalar): Adjust pending_spaces and ! skips so that TL works correctly when no bytes_used yet. ! ! 2006-01-16 Roger Sayle ! ! * intrinsics/c99_functions.c: Add function prototypes to avoid ! warnings from -Wstrict-prototypes -Wmissing-prototypes. On Tru64 ! work around a brain-dead libm by redirecting calls to cabs{,f,l} ! to a local __gfc_cabs{,f,l}. ! ! 2006-01-11 Janne Blomqvist ! ! * configure.ac: Remove check for sys/mman.h. ! * configure: Regenerated. ! * Makefile.in: Regenerated. ! * config.h.in: Regenerated. ! * aclocal.m4: Regenerated. ! ! 2006-01-07 Jerry DeLisle ! ! PR libgfortran/25598 ! * io/file_pos.c (unformatted_backspace): Assure the new file position ! to seek is not less than zero. ! (st_backspace): Set unit bytes_left to zero. ! * io/transfer.c (next_record_r): Fix line lengths, no functional change. ! ! 2005-12-31 Jerry DeLisle ! ! PR libgfortran/25594 ! PR libgfortran/25419 ! * io/list_read.c (list_formatted_read_scalar): Test for comma to return ! a null value (default). Revert patch of 25419 on 2005-12-28. ! ! 2005-12-31 Jerry DeLisle ! ! PR libgfortran/25550 ! * io/file_pos.c (st_rewind): Reset bytes left so no error occurs in ! next_record_r. ! ! 2005-12-31 Jerry DeLisle ! ! PR libgfortran/25139 ! * io/unix.c (fd_truncate): Set s->active to zero. ! PR libgfortran/25510 ! * libgfortran.h: Add ERROR_INTERNAL and ERROR_INTERNAL_UNIT. ! * runtime/error.c (translate_error): Add messages for new errors. ! * io/list_read.c (next_char): Use new errors. ! * io/transfer.c (next_record_r) (next_record_w): Use new errors. ! ! 2005-12-22 Jerry DeLisle ! ! PR libgfortran/25307 ! * io/list_read.c (next_char): Handle end-of-file conditions for ! internal units and add support for internal character array units. ! ! 2005-12-20 Jerry DeLisle ! ! PR libgfortran/25463 ! * io/transfer.c (finalize_transfer): Fix execution order so that ! next_record is set to zero in all cases. ! ! 2005-12-17 Jerry DeLisle ! ! PR libgfortran/25264 ! PR libgfortran/25349 ! * io/unit.c (get_unit): Delete code that cleared the string when the ! unit was opened, which is too soon. ! * io/transfer.c (next_record_w): Pass done flag in. Change logic for ! setting max_pos. Add code to position unit and pad record as needed. ! ! 2005-12-16 Jerry DeLisle ! ! PR libgfortran/25039 ! * io/io.h: Create a new flag sf_read_comma to control comma ! separators in numeric reads. ! * io/transfer.c (formatted_transfer_scalar): Initialize the flag. ! (read_sf): Check for commas coming in and if the flag is set, ! shortcut the read. ! * io/read.c (read_a) (read_x): Clear the flag for character reads and ! reset it after the reads. ! ! 2005-12-13 Thomas Koenig ! ! PR fortran/23815 ! * io/file_pos.c (unformatted_backspace): If flags.convert ! does not equal CONVERT_NATIVE, reverse the record marker. ! * io/open.c: Add convert_opt[]. ! (st_open): If no convert option is given, set CONVERT_NATIVE. ! If CONVERT_BIG or CONVERT_LITTLE are given, set flags.convert to ! CONVERT_NATIVE or CONVERT_SWAP (depending on wether we have ! a big- or little-endian system). ! * io/transfer.c (unformatted_read): Remove unused attribute ! from arguments. ! If we need to reverse ! bytes, break up large transfers into a loop. Split complex ! numbers into its two parts. ! (unformatted_write): Likewise. ! (us_read): If flags.convert does not equal CONVERT_NATIVE, ! reverse the record marker. ! (next_record_w): Likewise. ! (reverse_memcpy): New function. ! * io/inquire.c (inquire_via_unit): Implement convert. ! * io/io.h (top level): Add enum unit_convert. ! Add convert to st_parameter_open and st_parameter_inquire. ! Define IOPARM_OPEN_HAS_CONVERT and IOPARM_INQUIRE_HAS_CONVERT. ! Increase padding for st_parameter_dt. ! Declare reverse_memcpy(). ! ! 2005-12-13 Jakub Jelinek ! ! PR libfortran/24991 ! * acinclude.m4: Include acx.m4 and no-executables.m4. ! * configure.ac: Add GCC_TOPLEVEL_SUBDIRS. ! * configure: Rebuilt. ! * Makefile.am (AM_CPPFLAGS): Use $(host_subdir) in build dir ! path. ! * Makefile.in: Rebuilt. ! ! 2005-12-09 Francois-Xavier Coudert ! ! PR libfortran/25116 ! * io/transfer.c (data_transfer_init): Don't set the default for ! namelist I/O on preconnected files to UNFORMATTED. ! ! 2005-12-04 Francois-Xavier Coudert ! ! * io/format.c: Removing unused code. ! * intrinsics/random.c: Likewise. ! ! 2005-12-02 Francois-Xavier Coudert ! ! PR libfortran/24919 ! * io/list_read.c (eat_separator, finish_separator, ! read_character): Handle CRLF separators correctly during reads. ! (nml_query): Use the HAVE_CRLF macro to print adequate newlines. ! * io/io.h (st_parameter_dt): Add comment about the possible ! values for sf_seen_eor. ! * io/unix.c (tempfile, regular_file): HAVE_CRLF doesn't imply ! that O_BINARY is defined, so we add that condition. ! (stream_at_bof): Fix typo in comment. ! * io/transfer.c (read_sf): Handle correctly CRLF, setting ! sf_seen_eor value to 2 instead of 1. ! (formatted_transfer_scalar): Use the sf_seen_eor value to ! handle CRLF the right way. ! * io/write.c (nml_write_obj, namelist_write): Use CRLF as newline ! when HAVE_CRLF is defined. ! ! 2005-12-01 Steven G. Kargl ! ! PR libgfortran/25149 ! * intrinsics/abort.c: Add external abort_ to allow linking when ! invoking -std=f95 in testsuite. ! ! 2005-11-30 Eric Botcazou ! ! * libgfortran.h (ILP32 typedefs): Define _UINT8_T, _UINT32_T and ! _UINT64_T on Solaris. ! ! 2005-11-29 Jerry DeLisle ! ! PR libgfortran/25109 ! * io/unit.c (init_units): Set default flag to BLANK_NULL per ! requirement of F95 standard. Set PAD_YES for stdin. ! ! 2005-11-29 David Edelsohn ! ! * intrinsics/random.c: Include config.h ! * io/size_from_kind.c: Include config.h and libgfortran.h ! * io/io.h: Revert 2005-11-25 change. ! ! 2005-11-28 Jakub Jelinek ! ! PR libfortran/24991 ! * acinclude.m4 (LIBGFOR_CHECK_PRAGMA_WEAK): Rename to... ! (LIBGFOR_GTHREAD_WEAK): ... this. Define SUPPORTS_WEAK rather ! than HAVE_PRAGMA_WEAK. Define GTHREAD_USE_WEAK to 0 on hosts ! that shouldn't use weak in gthr.h. ! * configure.ac: Use LIBGFOR_GTHREAD_WEAK instead of ! LIBGFOR_CHECK_PRAGMA_WEAK. ! * config.h.in: Regenerated. ! * configure: Regenerated. ! * io/io.h (SUPPORTS_WEAK): Don't define here. ! ! * intrinsics/ftell.c (ftell, FTELL_SUB): Add unlock_unit call. ! * intrinsics/fget.c (fgetc, fputs): Likewise. ! * intrinsics/tty.c (ttynam): Likewise. ! ! 2005-11-26 Richard Henderson ! ! * io/list_read.c (nml_parse_qualifier): Use ssize_t instead of int ! in dtp->u.p.value. ! ! 2005-11-26 Janne Blomqvist ! ! PR libgfortran/24945 ! * io/open.c (edit_modes): Check for STATUS_UNKNOWN flag. ! ! 2005-11-25 Richard Henderson ! ! * io/list_read.c (nml_parse_qualifier): Use memcpy to extract ! values from dtp->u.p.value. ! * io/io.h (struct st_parameter_dt): Change reversion_flag, first_item, ! seen_dollar, sf_seen_eor, eor_condition, no_leading_blank, char_flag, ! input_complete, at_eol, comma_flag, namelist_mode, nml_read_error to ! single-bit fields. Move value to where it'll be at least pointer ! aligned. ! ! 2005-11-25 David Edelsohn ! ! * io/io.h (_LARGE_FILES): Undefine for AIX. ! (_LARGE_FILE_API): Define for AIX. ! ! 2005-11-23 Alan Modra ! ! * io/open.c (new_unit): Use the right unit number when checking ! for stdin, stdout, stderr. ! ! 2005-11-22 Jerry DeLisle ! ! PR libgfortran/24794 ! * io/list_read.c (read_character): Add auto completion on short ! namelist reads. ! ! 2005-11-21 Jakub Jelinek ! ! PR fortran/24774 ! PR fortran/14943 ! PR fortran/21647 ! * Makefile.am (AM_CPPFLAGS): Add gcc directories as -I paths, ! add -D_GNU_SOURCE. ! * Makefile.in: Regenerated. ! * acinclude.m4 (LIBGFOR_CHECK_SYNC_FETCH_AND_ADD, ! LIBGFOR_CHECK_GTHR_DEFAULT, LIBGFOR_CHECK_PRAGMA_WEAK): New macros. ! * configure.ac: Add them. ! * configure: Rebuilt. ! * config.h.in: Rebuilt. ! * libtool-version: Bump libgfortran.so SONAME to libgfortran.so.1. ! * libgfortran.h (library_start, show_locus, internal_error, ! generate_error, find_option): Add st_parameter_common * argument. ! (library_end): Change into a dummy macro. ! * io/io.h: Include gthr.h. ! (SUPPORTS_WEAK): Define if HAVE_PRAGMA_WEAK. ! (CHARACTER): Remove define. ! (st_parameter, global_t): Remove typedef. ! (ioparm, g, ionml, current_unit): Remove variables. ! (init_error_stream): Remove prototype. ! (CHARACTER1, CHARACTER2): Define. ! (st_parameter_common, st_parameter_open, st_parameter_close, ! st_parameter_filepos, st_parameter_inquire, st_parameter_dt): New ! typedefs. ! (IOPARM_LIBRETURN_MASK, IOPARM_LIBRETURN_OK, IOPARM_LIBRETURN_ERROR, ! IOPARM_LIBRETURN_END, IOPARM_LIBRETURN_EOR, IOPARM_ERR, IOPARM_END, ! IOPARM_EOR, IOPARM_HAS_IOSTAT, IOPARM_HAS_IOMSG, IOPARM_COMMON_MASK, ! IOPARM_OPEN_HAS_RECL_IN, IOPARM_OPEN_HAS_FILE, IOPARM_OPEN_HAS_STATUS, ! IOPARM_OPEN_HAS_ACCESS, IOPARM_OPEN_HAS_FORM, IOPARM_OPEN_HAS_BLANK, ! IOPARM_OPEN_HAS_POSITION, IOPARM_OPEN_HAS_ACTION, ! IOPARM_OPEN_HAS_DELIM, IOPARM_OPEN_HAS_PAD, IOPARM_CLOSE_HAS_STATUS, ! IOPARM_INQUIRE_HAS_EXIST, IOPARM_INQUIRE_HAS_OPENED, ! IOPARM_INQUIRE_HAS_NUMBER, IOPARM_INQUIRE_HAS_NAMED, ! IOPARM_INQUIRE_HAS_NEXTREC, IOPARM_INQUIRE_HAS_RECL_OUT, ! IOPARM_INQUIRE_HAS_FILE, IOPARM_INQUIRE_HAS_ACCESS, ! IOPARM_INQUIRE_HAS_FORM, IOPARM_INQUIRE_HAS_BLANK, ! IOPARM_INQUIRE_HAS_POSITION, IOPARM_INQUIRE_HAS_ACTION, ! IOPARM_INQUIRE_HAS_DELIM, IOPARM_INQUIRE_HAS_PAD, ! IOPARM_INQUIRE_HAS_NAME, IOPARM_INQUIRE_HAS_SEQUENTIAL, ! IOPARM_INQUIRE_HAS_DIRECT, IOPARM_INQUIRE_HAS_FORMATTED, ! IOPARM_INQUIRE_HAS_UNFORMATTED, IOPARM_INQUIRE_HAS_READ, ! IOPARM_INQUIRE_HAS_WRITE, IOPARM_INQUIRE_HAS_READWRITE, ! IOPARM_DT_LIST_FORMAT, IOPARM_DT_NAMELIST_READ_MODE, ! IOPARM_DT_HAS_REC, IOPARM_DT_HAS_SIZE, IOPARM_DT_HAS_IOLENGTH, ! IOPARM_DT_HAS_FORMAT, IOPARM_DT_HAS_ADVANCE, ! IOPARM_DT_HAS_INTERNAL_UNIT, IOPARM_DT_HAS_NAMELIST_NAME, ! IOPARM_DT_IONML_SET): Define. ! (gfc_unit): Add lock, waiting and close fields. Change file ! from flexible array member into pointer to char. ! (open_external): Add st_parameter_open * argument. ! (find_file, file_exists): Add file and file_len arguments. ! (flush_all_units): New prototype. ! (max_offset, unit_root, unit_lock): New variable. ! (is_internal_unit, is_array_io, next_array_record, ! parse_format, next_format, unget_format, format_error, ! read_block, write_block, next_record, convert_real, ! read_a, read_f, read_l, read_x, read_radix, read_decimal, ! list_formatted_read, finish_list_read, namelist_read, ! namelist_write, write_a, write_b, write_d, write_e, write_en, ! write_es, write_f, write_i, write_l, write_o, write_x, write_z, ! list_formatted_write, get_unit): Add st_parameter_dt * argument. ! (insert_unit): Remove prototype. ! (find_or_create_unit, unlock_unit): New prototype. ! (new_unit): Return gfc_unit *. Add st_parameter_open * ! and gfc_unit * arguments. ! (free_fnodes): Remove prototype. ! (free_format_data): New prototype. ! (scratch): Remove. ! (init_at_eol): Remove prototype. ! (free_ionml): New prototype. ! (inc_waiting_locked, predec_waiting_locked, dec_waiting_unlocked): ! New inline functions. ! * io/unit.c (max_offset, unit_root, unit_lock): New variables. ! (insert): Adjust os_error caller. ! (insert_unit): Made static. Allocate memory here, initialize ! lock and after inserting it return it, locked. ! (delete_unit): Adjust for deletion of g. ! (find_unit_1): New function. ! (find_unit): Use it. ! (find_or_create_unit): New function. ! (get_unit): Add dtp argument, change meaning of the int argument ! as creation request flag. Adjust for different st_* calling ! conventions, lock internal unit's lock before returning it ! and removal of g. Call find_unit_1 instead of find_unit. ! (is_internal_unit, is_array_io): Add dtp argument, adjust for ! removal of most of global variables. ! (init_units): Initialize unit_lock. Adjust insert_unit callers ! and adjust for g removal. ! (close_unit_1): New function. ! (close_unit): Use it. ! (unlock_unit): New function. ! (close_units): Lock unit_lock, use close_unit_1 rather than ! close_unit. ! * io/close.c (st_close): Add clp argument. Adjust for new ! st_* calling conventions and internal function API changes. ! * io/file_pos.c (st_backspace, st_endfile, st_rewind, st_flush): ! Add fpp argument. Adjust for new st_* calling conventions and ! internal function API changes. ! (formatted_backspace, unformatted_backspace): Likewise. Add ! u argument. ! * io/open.c (edit_modes, st_open): Add opp argument. Adjust for ! new st_* calling conventions and internal function API changes. ! (already_open): Likewise. If not HAVE_UNLINK_OPEN_FILE, unlink ! scratch file. Instead of calling close_unit just call sclose, ! free u->file if any and clear a few u fields before calling ! new_unit. ! (new_unit): Return gfc_unit *. Add opp and u arguments. ! Adjust for new st_* calling conventions and internal function ! API changes. Don't allocate unit here, rather than work with ! already created unit u already locked on entry. In case ! of failure, close_unit it. ! * io/unix.c: Include unix.h. ! (BUFFER_SIZE, unix_stream): Moved to unix.h. ! (unit_to_fd): Add unlock_unit call. ! (tempfile): Add opp argument, use its fields rather than ioparm. ! (regular_file): Likewise. ! (open_external): Likewise. Only unlink file if fd >= 0. ! (init_error_stream): Add error argument, set structure it points ! to rather than filling static variable and returning its address. ! (FIND_FILE0_DECL, FIND_FILE0_ARGS): Define. ! (find_file0): Use them. Don't crash if u->s == NULL. ! (find_file): Add file and file_len arguments, use them instead ! of ioparm. Add locking. Pass either an array of 2 struct stat ! or file and file_len pair to find_file0. ! (flush_all_units_1, flush_all_units): New functions. ! (file_exists): Add file and file_len arguments, use them instead ! of ioparm. ! * io/unix.h: New file. ! * io/lock.c (ioparm, g, ionml): Remove variables. ! (library_start): Add cmp argument, adjust for new st_* calling ! conventions. ! (library_end): Remove. ! (free_ionml): New function. ! * io/inquire.c (inquire_via_unit, inquire_via_filename, ! st_inquire): Add iqp argument, adjust for new st_* calling ! conventions and internal function API changes. ! * io/format.c (FARRAY_SIZE): Decrease to 64. ! (fnode_array, format_data): New typedefs. ! (avail, array, format_string, string, error, saved_token, value, ! format_string_len, reversion_ok, saved_format): Remove variables. ! (colon_node): Add const. ! (free_fnode, free_fnodes): Remove. ! (free_format_data): New function. ! (next_char, unget_char, get_fnode, format_lex, parse_format_list, ! format_error, parse_format, revert, unget_format, next_test): Add ! fmt or dtp arguments, pass it all around, adjust for internal ! function API changes and adjust for removal of global variables. ! (next_format): Likewise. Constify return type. ! (next_format0): Constify return type. ! * io/transfer.c (current_unit, sf_seen_eor, eor_condition, max_pos, ! skips, pending_spaces, scratch, line_buffer, advance_status, ! transfer): Remove variables. ! (transfer_integer, transfer_real, transfer_logical, ! transfer_character, transfer_complex, transfer_array, current_mode, ! read_sf, read_block, read_block_direct, write_block, ! write_block_direct, unformatted_read, unformatted_write, ! type_name, write_constant_string, require_type, ! formatted_transfer_scalar, us_read, us_write, pre_position, ! data_transfer_init, next_record_r, next_record_w, next_record, ! finalize_transfer, iolength_transfer, iolength_transfer_init, ! st_iolength, st_iolength_done, st_read, st_read_done, st_write, ! st_write_done, st_set_nml_var, st_set_nml_var_dim, ! next_array_record): Add dtp argument, pass it all around, adjust for ! internal function API changes and removal of global variables. ! * io/list_read.c (repeat_count, saved_length, saved_used, ! input_complete, at_eol, comma_flag, last_char, saved_string, ! saved_type, namelist_mode, nml_read_error, value, parse_err_msg, ! nml_err_msg, prev_nl): Remove variables. ! (push_char, free_saved, next_char, unget_char, eat_spaces, ! eat_separator, finish_separator, nml_bad_return, convert_integer, ! parse_repeat, read_logical, read_integer, read_character, ! parse_real, read_complex, read_real, check_type, ! list_formatted_read_scalar, list_formatted_read, finish_list_read, ! find_nml_node, nml_untouch_nodes, nml_match_name, nml_query, ! namelist_read): Add dtp argument, pass it all around, adjust for ! internal function API changes and removal of global variables. ! (nml_parse_qualifier): Likewise. Add parse_err_msg argument. ! (nml_read_obj): Likewise. Add pprev_nl, nml_err_msg, clow and ! chigh arguments. ! (nml_get_obj_data): Likewise. Add pprev_nl and nml_err_msg ! arguments. ! (init_at_eol): Removed. ! * io/read.c (convert_real, read_l, read_a, next_char, read_decimal, ! read_radix, read_f, read_x): Add dtp argument, pass it all around, ! adjust for internal function API changes and removal of global ! variables. ! (set_integer): Adjust internal_error caller. ! * io/write.c (no_leading_blank, nml_delim): Remove variables. ! (write_a, calculate_sign, calculate_G_format, output_float, ! write_l, write_float, write_int, write_decimal, write_i, write_b, ! write_o, write_z, write_d, write_e, write_f, write_en, write_es, ! write_x, write_char, write_logical, write_integer, write_character, ! write_real, write_complex, write_separator, ! list_formatted_write_scalar, list_formatted_write, nml_write_obj, ! namelist_write): Add dtp argument, pass it all around, adjust for ! internal function API changes and removal of global variables. ! (extract_int, extract_uint, extract_real): Adjust internal_error ! callers. ! * runtime/fpu.c (_GNU_SOURCE): Don't define here. ! * runtime/error.c: Include ../io/unix.h. ! (filename, line): Remove variables. ! (st_printf): Pass address of a local variable to init_error_stream. ! (show_locus): Add cmp argument. Use fields it points to rather than ! filename and line variables. ! (os_error, runtime_error): Remove show_locus calls. ! (internal_error): Add cmp argument. Pass it down to show_locus. ! (generate_error): Likewise. Use flags bitmask instead of non-NULL ! check for iostat and iomsg parameter presence, adjust for st_* ! calling convention changes. ! * runtime/stop.c (stop_numeric, stop_string): Remove show_locus ! calls. ! * runtime/pause.c (pause_numeric, pause_string): Likewise. ! * runtime/string.c: Include ../io/io.h. ! (find_option): Add cmp argument. Pass it down to generate_error. ! * intrinsics/flush.c (recursive_flush): Remove. ! (flush_i4, flush_i8): Use flush_all_units. Add unlock_unit ! call. ! * intrinsics/rand.c: Include ../io/io.h. ! (rand_seed_lock): New variable. ! (srand, irand): Add locking. ! (init): New constructor function. ! * intrinsics/random.c: Include ../io/io.h. ! (random_lock): New variable. ! (random_r4, random_r8, arandom_r4, arandom_r8): Add locking. ! (random_seed): Likewise. open failed if fd < 0. Set i correctly. ! (init): New constructor function. ! * intrinsics/system_clock.c (tp0, t0): Remove. ! (system_clock_4, system_clock_8): Don't subtract tp0/t0 from current ! time, use just integer arithmetics. ! * intrinsics/tty.c (isatty_l4, isatty_l8, ttynam_sub): Add ! unlock_unit calls. ! ! 2005-11-20 Richard Henderson ! ! * Makefile.am: Revert 2005-11-14 change. Enable -free-vectorize ! via gmake per-target variables. ! * Makefile.in, aclocal.m4: Regenerate. ! ! 2005-11-18 Francois-Xavier Coudert ! ! * configure.ac: Add "-I ." to the AM_FCFLAGS. ! * configure: Regenerate. ! ! 2005-11-18 Hans-Peter Nilsson ! ! * config/fpu-glibc.h (set_fpu): Only call fedisableexcept for ! nonzero FE_ALL_EXCEPT. ! ! 2005-11-17 Francois-Xavier Coudert ! ! PR fortran/24892 ! * io/io.h (unit_access): Add ACCESS_APPEND. ! * io/open.c (access_opt): Add APPEND value for ACCESS keyword. ! (st_open): Use that new value to set the POSITION accordingly. ! ! 2005-11-14 Janne Blomqvist ! ! PR fortran/21468 ! * Makefile.am: Add -ftree-vectorize for compiling matmul. ! * m4/matmul.m4: Add const and restrict to type declarations as ! appropriate. ! * m4/matmull.m4: Likewise. ! * Makefile.in: Regenerated. ! * generated/matmul_*.c: Likewise. ! ! 2005-11-13 Francois-Xavier Coudert ! ! * intrinsics/fget.c: New file. ! * intrinsics/ftell.c: New file. ! * io/unix.c (stream_offset): New function. ! * io/io.h: Add prototype for stream_offset. ! * Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c. ! * Makefile.in: Regenerate. ! ! 2005-11-12 Steven G. Kargl ! ! PR libgfortran/24787 ! * intrinsics/string_intrinsics.c (string_scan): Off by one; Fix typos ! in nearby comment. ! ! 2005-11-10 Andreas Jaeger ! ! * libgfortran.h: Add proper defines where needed. ! ! 2005-11-10 Andreas Jaeger ! ! * libgfortran.h: Add missing prototypes for internal_pack ! functions. ! ! 2005-11-06 Janne Blomqvist ! ! PR fortran/24174 ! PR fortran/24305 ! * io/io.h: Add argument to prototypes, add prototypes for ! size_from_*_kind functions. ! * io/list_read.c (read_complex): Add size argument, use ! it. ! (list_formatted_read): Add size argument, cleanup. ! (list_formatted_read_scalar): Add size argument. ! (nml_read_obj): Fix for padding. ! * io/transfer.c: Add argument to transfer function pointer. ! (unformatted_read): Add size argument. ! (unformatted_write): Likewise. ! (formatted_transfer_scalar): Fix for padding with complex(10). ! (formatted_transfer): Add size argument, cleanup. ! (transfer_integer): Add size argument to transfer call. ! (transfer_real): Likewise. ! (transfer_logical): Likewise. ! (transfer_character): Likewise. ! (transfer_complex): Likewise. ! (transfer_array): New kind argument, use it. ! (data_transfer_init): Add size argument to formatted_transfer ! call. ! (iolength_transfer): Add size argument, cleanup. ! * io/write.c (write_complex): Add size argument, fix for padding ! with complex(10). ! (list_formatted_write): Add size argument, cleanup. ! (list_formatted_write_scalar): Add size argument, use it. ! (nml_write_obj): Fix for size vs. kind issue. ! * io/size_from_kind.c: New file. ! * Makefile.am: Add io/size_from_kind.c. ! * configure: Regenerate. ! * Makefile.in: Regenerate. ! ! 2005-11-06 Francois-Xavier Coudert ! ! * intrinsics/ctime.c: New file. ! * configure.ac: Add check for ctime. ! * Makefile.am: Add ctime.c ! * configure: Regenerate. ! * config.h.in: Regenerate. ! * Makefile.in: Regenerate. ! ! 2005-11-05 Richard Guenther ! ! * configure.ac: Use AM_FCFLAGS for extra flags, not FCFLAGS. ! * configure: Regenerate. ! ! 2005-11-05 Francois-Xavier Coudert ! ! * intrinsics/tty.c (ttynam): New function. ! ! 2005-11-04 Steven G. Kargl ! ! PR fortran/24636 ! * runtime/stop.c (stop_numeric): Use stop_code = -1. ! ! 2005-11-04 Francois-Xavier Coudert ! ! PR libfortran/22298 ! * runtime/main.c (stupid_function_name_for_static_linking): New ! function. ! * runtime/error.c (internal_error): Call ! stupid_function_name_for_static_linking. ! * libgfortran.h: Add prototype for ! stupid_function_name_for_static_linking. ! ! 2005-11-01 Paul Thomas ! ! PR fortran/14994 ! * libgfortran/intrinsics/date_and_time.c: Add interface to ! the functions date_and_time for the intrinsic function secnds. ! ! 2005-10-31 Jerry DeLisle ! ! PR libgfortran/24584 ! * io/list_read.c (free_saved): Set saved_used to zero. ! ! 2005-10-30 Francois-Xavier Coudert ! ! PR libfortran/20179 ! * io/unix.c (flush_if_preconnected): New function. ! * io/io.h: Add prototype for flush_if_preconnected. ! * io/transfer.c (data_transfer_init): Use flush_if_preconnected ! to workaround buggy mixed C-Fortran code. ! ! 2005-10-30 Francois-Xavier Coudert ! ! * Makefile.am: Add intrinsics/malloc.c file. ! * Makefile.in: Regenerate. ! * intrinsics/malloc.c: New file, with implementations for free ! and malloc library functions. ! ! 2005-10-29 Mike Stump ! ! * Makefile.am (kinds.h): Remove target, if command fails. ! (selected_int_kind.inc): Likewise. ! (selected_real_kind.inc): Likewise. ! * Makefile.in: Regenerate. ! ! 2005-10-28 Francois-Xavier Coudert ! ! ! * Makefile.am (intrinsics): Add signal.c. ! * Makefile.in: Regenerate. ! * configure.ac: Checks for signal and alarm. ! * config.h.in: Regenerate. ! * configure: Regenerate. ! * intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics. ! ! 2005-10-28 Francois-Xavier Coudert ! ! * acinclude.m4 (LIBGFOR_CHECK_FPSETMASK): New check. ! * configure.ac: Check for floatingpoint.h, fptrap.h and float.h ! headers. Use LIBGFOR_CHECK_FPSETMASK. Check for fp_trap and ! fp_enable functions. ! * configure.host: Add case for systems with fpsetmask and systems ! with fp_trap/fp_enable. ! * config/fpu-sysv.h: New file, FPU code using fpsetmask. ! * config/fpu-aix.h: New file, FPU code for AIX using fp_trap and ! fp_enable. ! * aclocal.m4: Regenerate. ! * configure: Regenerate. ! * config.h.in: Regenerate. ! ! 2005-10-24 Jerry DeLisle ! ! PR libgfortran/24224 ! * libgfortran.h: Remove array stride error code. ! * runtime/error.c: Remove array stride error. ! * io/io.h: Change name of 'nml_loop_spec' to 'array_loop_spec' to be ! generic. Add pointer to array_loop_spec and rank to gfc_unit ! structure. ! * io/list_read.c: Revise nml_loop_spec references to array_loop_spec. ! * io/transfer.c (init_loop_spec): New function to initialize ! an array_loop_spec. ! (next_array_record): New function to return the index to the next array ! record by incrementing through the array_loop_spec. ! (next_record_r): Use new function. ! (next_record_w): Use new function. ! (finalize_transfer): Free memory allocated for array_loop_spec. ! * io/unit.c (get_array_unit_len): Delete this function. Use new ! function init_loop_spec to initialize the array_loop_spec. ! ! 2005-10-24 Paul Thomas ! ! PR fortran/24416 ! * libgfortran/io/list_read.c (namelist_read): Exit with call to ! free_saved () so that character strings do not accumulate. ! ! 2005-10-23 Jerry DeLisle ! ! PR libgfortran/24489 ! * io/transfer.c (read_block): Change the order of execution to not read ! past end-of-record. ! (read_block_direct): Same change. ! ! 2005-10-23 Francois-Xavier Coudert ! ! PR libfortran/23272 ! * acinclude.m4 (LIBGFOR_CHECK_WORKING_STAT): New check. ! * configure.ac: Use LIBGFOR_CHECK_WORKING_STAT. ! * Makefile.in: Regenerate. ! * configure: Regenerate. ! * config.h.in: Regenerate. ! * aclocal.m4: Regenerate. ! * io/unix.c (compare_file_filename): Add fallback case for ! systems without working stat. ! * io/open.c (already_open): Correct call to ! compare_file_filename. ! * io/io.h: Correct proto for compare_file_filename. ! ! 2005-10-23 Francois-Xavier Coudert ! ! * runtime/fpu.c: Add _GNU_SOURCE definition. ! * config/fpu-glibc.h: Remove __USE_GNU definition. ! ! 2005-10-23 Paul Thomas ! ! PR fortran/24384 ! * intrinsics/spread_generic.c (spread_internal_scalar): New ! function that handles the special case of spread with a scalar ! source. This has new interface functions - ! (spread_scalar, spread_char_scalar): New functions to interface ! with the calls specified in gfc_resolve_spread. ! ! 2005-10-21 Francois-Xavier Coudert ! ! PR libfortran/24383 ! * io/unix.c: Add fallback definition for SSIZE_MAX. ! ! 2005-10-19 Francois-Xavier Coudert ! ! * c99_protos.h: Define preprocessor HAVE_ macros with value 1 ! instead of empty value. ! * intrinsics/c99_functions.c: Likewise. ! * intrinsics/getXid.c: Define HAVE_GETPID with value 1 instead of ! empty value. ! * intrinsics/sleep.c: Define HAVE_SLEEP with value 1 instead of ! empty value. ! ! 2005-10-19 Francois-Xavier Coudert ! ! PR libfortran/24432 ! * c99_protos.h: Define HAVE_ macros for all provided functions. ! ! 2005-10-14 Uros Bizjak ! ! * config/fpu-387.h (set_fpu): Remove extra ":" in stmxcsr. ! Change cw and cw_sse variables to unsigned. ! (SSE): New definition. ! (has_sse): Use it. ! ! 2005-10-13 Thomas Koenig ! ! * io/unix.c(fd_alloc_r_at): Use read() instead of do_read() ! only in case of special files (e.g. terminals). ! ! 2005-10-13 Uros Bizjak ! ! * config/fpu-387.h (set_fpu): Add "=m" for stmxcsr. ! ! 2005-10-12 Francois-Xavier Coudert ! ! * Makefile.am: Add fpu.c to the build process, and ! target-dependent code as fpu-target.h. ! * Makefile.in: Regenerate. ! * configure.ac: Add call to configure.host to set ! FPU_HOST_HEADER. ! * configure: Regenerate. ! * configure.host: New script to determine which host-dependent ! code should go in. ! * libgfortran.h: Add fpe option, remove previous fpu_ options. ! Add bitmasks for different FPE traps. Add prototype for set_fpu. ! * runtime/environ.c: Remove environment variables to control ! fpu behaviour. ! * runtime/fpu.c (set_fpe): New function for the front-end. ! * runtime/main.c (init): Set FPU state. ! * config: New directory to store host-dependent code. ! * config/fpu-387.h: New file with code handling the i387 FPU. ! * config/fpu-glibc.h: New file with code for glibc systems. ! * config/fpu-generic.h: Fallback for the most generic host. Issue ! warnings. ! ! 2005-10-12 Janne Blomqvist ! ! * io/unix.c(fd_alloc_r_at): Remove parts of patch of 2005/10/07 that ! cause input from the terminal to hang. ! ! 2005-10-11 Steven G. Kargl ! ! PR libgfortran/24313 ! * c99_functions.c (csqrtf, csqrt): Fix choice of branch cut. Note ! csqrt{f} were imported from glibc, and this bug is still present ! there. glibc PR is 1146. ! ! 2005-10-07 Janne Blomqvist ! ! PR fortran/16339 ! PR fortran/23363 ! * io/io.h: Add read and write members to stream, define access ! macros. ! * io/transfer.c (read_block_direct): New function. ! (write_block_direct): New function. ! (unformatted_read): Change to use read_block_direct. ! (unformatted_write): Change to use write_block_direct. ! * io/unix.c: Remove mmap includes and defines. ! (writen): Remove. ! (readn): Remove. ! (reset_stream): New function. ! (do_read): New function. ! (do_write): New function. ! (fd_flush): Change to use do_write() instead of writen(). ! (fd_alloc_r_at): Change to use do_read(). ! (fd_seek): Change return type to try, as the prototype. Add check ! to avoid syscall overhead if possible. ! (fd_read): New function. ! (fd_write): New function. ! (fd_open): Set pointers for new functions. ! (mem_read): New function. ! (mem_write): New function. ! (open_internal): Set pointers for new functions. ! (is_seekable): Clean up comment. ! ! 2005-10-07 Jerry DeLisle ! ! * io/transfer.c (write_block): Add test for end-of-file condition, ! removed from mem_alloc_w_at. (next_record_w): Clean up checks for ! NULL pointer returns from s_alloc_w. ! * io/unix.c (mem_alloc_w_at): Remove call to generate_error end-of-file. ! * io/write.c (write_float): Add checks for NULL pointer returns from ! write_block calls. (write_integer): Same. ! ! 2005-10-03 Jakub Jelinek ! ! * runtime/memory.c (allocate_size): Malloc 1 byte if size == 0. ! ! 2005-10-03 Francois-Xavier Coudert ! ! PR libfortran/19308 ! PR libfortran/22437 ! * Makefile.am: Add generated files for large real and integers ! kinds. Add a rule to create the kinds.inc c99_protos.inc files. ! Use kinds.inc to preprocess Fortran generated files. ! * libgfortran.h: Add macro definitions for GFC_INTEGER_16_HUGE, ! GFC_REAL_10_HUGE and GFC_REAL_16_HUGE. Add types gfc_array_i16, ! gfc_array_r10, gfc_array_r16, gfc_array_c10, gfc_array_c16, ! gfc_array_l16. ! * mk-kinds-h.sh: Define macros HAVE_GFC_LOGICAL_* and ! HAVE_GFC_COMPLEX_* when these types are available. ! * intrinsics/ishftc.c (ishftc16): New function for GFC_INTEGER_16. ! * m4/all.m4, m4/any.m4, m4/count.m4, m4/cshift1.m4, m4/dotprod.m4, ! m4/dotprodc.m4, m4/dotprodl.m4, m4/eoshift1.m4, m4/eoshift3.m4, ! m4/exponent.m4, m4/fraction.m4, m4/in_pack.m4, m4/in_unpack.m4, ! m4/matmul.m4, m4/matmull.m4, m4/maxloc0.m4, m4/maxloc1.m4, ! m4/maxval.m4, m4/minloc0.m4, m4/minloc1.m4, m4/minval.m4, m4/mtype.m4, ! m4/nearest.m4, m4/pow.m4, m4/product.m4, m4/reshape.m4, ! m4/set_exponent.m4, m4/shape.m4, m4/specific.m4, m4/specific2.m4, ! m4/sum.m4, m4/transpose.m4: Protect generated functions with ! appropriate "#if defined (HAVE_GFC_type_kind)" preprocessor directives. ! * Makefile.in: Regenerate. ! * all files in generated/: Regenerate. ! ! 2005-10-01 Jakub Jelinek ! ! * runtime/memory.c (malloc_t): Remove. ! (GFC_MALLOC_MAGIC, HEADER_SIZE, DATA_POINTER, DATA_HEADER): Remove. ! (mem_root, runtime_cleanup, malloc_with_header): Remove. ! (internal_malloc_size): Use just get_mem if size != 0, return NULL ! otherwise. ! (internal_free): Just free if non-NULL. ! (internal_realloc_size): Remove debugging stuff. ! (allocate_size): Use malloc directly, remove debugging stuff. ! (deallocate): Use free directly, fix error message wording. ! ! * libgfortran.h (GFC_ITOA_BUF_SIZE, GFC_XTOA_BUF_SIZE, ! GFC_OTOA_BUF_SIZE, GFC_BTOA_BUF_SIZE): Define. ! (gfc_itoa, xtoa): Add 2 extra arguments. ! * runtime/environ.c: Include stdio.h. ! (check_buffered): Use sprintf. ! * runtime/error.c: Include assert.h. ! (gfc_itoa, xtoa): Add 2 extra arguments, avoid using static ! buffers. ! (st_printf, st_sprintf): Adjust callers. ! * io/write.c (otoa, btoa): Add 2 extra arguments, avoid using ! static buffers. ! (write_int, write_decimal): Add 2 extra arguments to conv ! function pointer, adjust caller. ! (write_integer): Adjust gfc_itoa caller. ! ! * io/unit.c (get_array_unit_len): Return 0 rather than NULL. ! ! * io/read.c (read_f): Remove spurious pointer dereference. ! ! 2005-09-30 Janne Blomqvist ! ! PR 24112 ! * io/open.c (edit_modes): Check for correct flag. ! ! 2005-09-29 Jakub Jelinek ! ! * runtime/string.c (find_option): Change 3rd argument to ! const st_option *. ! * libgfortran.h (find_option): Likewise. ! * runtime/environ.c (rounding, precision, signal_choices): Constify. ! (init_choice, show_choice): Change 2nd argument to const choice *. ! * io/open.c (access_opt, action_opt, blank_opt, delim_opt, form_opt, ! position_opt, status_opt, pad_opt): Constify. ! * io/transfer.c (advance_opt): Likewise. ! * io/inquire.c (undefined): Likewise. ! * io/close.c (status_opt): Likewise. ! * io/format.c (posint_required, period_required, nonneg_required, ! unexpected_element, unexpected_end, bad_string, bad_hollerith, ! reversion_error): Likewise. ! * io/unix.c (yes, no, unknown): Change from const char * ! into const char []. ! ! 2005-09-27 Steve Ellcey ! ! PR target/23552 ! * acinclude.m4 (LIBGFOR_CHECK_FOR_BROKEN_ISFINITE): New. ! (LIBGFOR_CHECK_FOR_BROKEN_ISNAN): New. ! (LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY): New. ! * configure.ac (LIBGFOR_CHECK_FOR_BROKEN_ISFINITE): Add use. ! (LIBGFOR_CHECK_FOR_BROKEN_ISNAN): Add use. ! (LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY): Add use. ! * configure: Regenerate. ! * config.h.in: Regenerate. ! * libgfortan.h (isfinite): undef if broken, set if needed. ! (isnan): undef if broken, set if needed. ! (fpclassify): undef if broken, set if needed. ! * io/write.c: Remove TODO comment about working isfinite. ! * intrinsics/c99_functions.c (round): Use isfinite instead ! of fpclassify. ! * intrinsics/c99_functions.c (roundf): Ditto. ! ! 2005-09-24 Janne Blomqvist ! ! * io.h: Changed prototypes of list_formatted_{read|write}. ! * list_read.c (list_formatted_read): Renamed to ! list_formatted_read_scalar and made static. ! (list_formatted_read): New function. ! * transfer.c: Prototype for transfer_array. Changed transfer ! function pointer. ! (unformatted_read): Add nelems argument, use it. ! (unformatted_write): Likewise. ! (formatted_transfer): Changed name to formatted_transfer_scalar. ! (formatted_transfer): New function. ! (transfer_integer): Add nelems argument to transfer call, move ! updating item count to transfer functions. ! (transfer_real): Likewise. ! (transfer_logical): Likewise. ! (transfer_character): Likewise. ! (transfer_complex): Likewise. ! (transfer_array): New function. ! (data_transfer_init): Call formatted_transfer with new argument. ! (iolength_transfer): New argument, use it. ! * write.c (list_formatted_write): Renamed to ! list_formatted_write_scalar, made static. ! (list_formatted_write): New function. ! ! 2005-09-26 David Edelsohn ! ! * configure.ac: Add check for __clog. ! * configure: Regenerate. ! ! 2005-09-25 Francois-Xavier Coudert ! ! * c99_protos.h: Add prototypes for C99 complex functions. ! * libgfortran.h: Include complex.h before c99_protos.h. ! * intrinsics/c99_functions.c: Define HAVE_ macros for the ! fallback functions we provide. ! (cabsf, cabs, cabsl, cargf, carg, cargl, cexpf, cexp, cexpl, ! clogf, clog, clogl, clog10f, clog10, clog10l, cpowf, cpow, cpowl, ! cqsrtf, csqrt, csqrtl, csinhf, csinh, csinhl, ccoshf, ccosh, ! ccoshl, ctanhf, ctanh, ctanhl, csinf, csin, csinl, ccosf, ccos, ! ccosl, ctanf, ctan, ctanl): New fallback functions. ! * Makefile.am (gfor_math_trig_c, gfor_math_trig_obj, ! gfor_specific_c, gfor_cmath_src, gfor_cmath_obj): Remove. ! * Makefile.in: Regenerate. ! * configure.ac: Remove checks for csin. Add checks for all C99 ! complex functions. ! * config.h.in: Regenerate. ! * configure: Regenerate. ! * aclocal.m4: Regenerate. ! ! 2005-09-25 Francois-Xavier Coudert ! Danny Smith ! ! PR libfortran/23803 ! * intrinsics/getXid.c: Add getpid wrapper for MinGW. ! * intrinsics/getlog.c: Add getlogin wrapper for MinGW. ! * intrinsics/hostnm.c: Add gethostname wrapper for MinGW. ! ! 2005-09-24 Francois-Xavier Coudert ! ! PR libfortran/23802 ! * intrinsics/sleep.c: Add correct sleep macro for MinGW. ! ! 2005-09-24 Francois-Xavier Coudert ! ! PR libfortran/23380 ! * intrinsics/cpu_time.c (__cpu_time_1): Provide a MS Windows ! version. ! ! 2005-09-14 Jerry DeLisle ! ! PR target/19269 ! * intrinsics/cshift0.c (cshift0): Add an extra size argument. ! (cshift0_1, cshift0_2, cshift0_4, cshift0_8): Replace explicit ! implementations with... ! (DEFINE_CSHIFT): ...this new macro. Define character versions too. ! * intrinsics/eoshift0.c (zeros): Delete. ! (eoshift0): Add extra size and filler arguments. Use memset if no ! bound is provided. ! (eoshift0_1, eoshift0_2, eoshift0_4, eoshift0_8): Replace explicit ! implementations with... ! (DEFINE_EOSHIFT): ...this new macro. Define character versions too. ! * intrinsics/eoshift2.c (zeros): Delete. ! (eoshift2): Add extra size and filler arguments. Use memset if no ! bound is provided. ! (eoshift2_1, eoshift2_2, eoshift2_4, eoshift2_8): Replace explicit ! implementations with... ! (DEFINE_EOSHIFT): ...this new macro. Define character versions too. ! * intrinsics/pack.c (pack_internal): New static function, reusing ! the contents of pack and adding an extra size argument. Change ! "mptr" rather than "m" when calculating the array size. ! (pack): Redefine as a forwarder to pack_internal. ! (pack_s_internal): New static function, reusing the contents of ! pack_s and adding an extra size argument. ! (pack_s): Redefine as a forwarder to pack_s_internal. ! (pack_char, pack_s_char): New functions. ! * intrinsics/reshape.c (reshape_internal): New static function, ! reusing the contents of reshape and adding an extra size argument. ! (reshape): Redefine as a forwarder to reshape_internal. ! (reshape_char): New function. ! * intrinsics/spread.c (spread_internal): New static function, ! reusing the contents of spread and adding an extra size argument. ! (spread): Redefine as a forwarder to spread_internal. ! (spread_char): New function. ! * intrinsics/transpose.c (transpose_internal): New static function, ! reusing the contents of transpose and adding an extra size argument. ! (transpose): Redefine as a forwarder to transpose_internal. ! (transpose_char): New function. ! * intrinsics/unpack.c (unpack_internal): New static function, reusing ! the contents of unpack1 and adding extra size and fsize arguments. ! (unpack1): Redefine as a forwarder to unpack_internal. ! (unpack0): Call unpack_internal instead of unpack1. ! (unpack1_char, unpack0_char): New functions. ! * m4/cshift1.m4 (cshift1): New static function, reusing the contents ! of cshift1_ and adding an extra size argument. ! (cshift1_): Redefine as a forwarder to cshift1. ! (cshift1__char): New function. ! * m4/eoshift1.m4 (zeros): Delete. ! (eoshift1): New static function, reusing the contents of ! eoshift1_ and adding extra size and filler arguments. ! Fix calculation of hstride. Use memset if no bound is provided. ! (eoshift1_): Redefine as a forwarder to eoshift1. ! (eoshift1__char): New function. ! * m4/eoshift3.m4 (zeros): Delete. ! (eoshift3): New static function, reusing the contents of ! eoshift3_ and adding extra size and filler arguments. ! Use memset if no bound is provided. ! (eoshift3_): Redefine as a forwarder to eoshift3. ! (eoshift3__char): New function. ! * generated/cshift1_4.c, generated/cshift1_8.c, ! * generated/eoshift1_4.c, generated/eoshift1_8.c, ! * generated/eoshift3_4.c, generated/eoshift3_8.c: Regenerate. 2005-09-11 Francois-Xavier Coudert PR libfortran/20179 * io/unix.c (is_preconnected): Add function to test if a stream corresponds to a preconnected unit. * io/io.h: Add prototype for is_preconnected. ! * io/transfer.c (data_transfer_init): Do not truncate ! preconnected units. ! ! 2005-09-10 Janne Blomqvist ! ! * io/unix.c: Remove mmap code. 2005-09-09 Francois-Xavier Coudert PR libfortran/23784 * io/close.c (st_close): Call library_end even in case of error. + 2005-09-09 Thomas Koenig + + * io/io.h: Add iomsg as last field of st_parameter. + * runtime/error.c (generate_error): If iomsg is present, copy + the message there. + + 2005-09-09 Richard Sandiford + + PR fortran/12840 + * runtime/memory.c (internal_malloc_size): Return a null pointer + if the size is zero. + (internal_free): Do nothing if the pointer is null. + (internal_realloc_size, internal_realloc, internal_realloc64): New. + 2005-09-07 Francois-Xavier Coudert PR libfortran/23262 *************** *** 64,79 **** * config.h.in: Regenerate. * configure: Regenerate. ! 2005-09-02 Jakub Jelinek ! PR target/23556 ! * io/read.c (convert_real): Fix a typo from last change. ! 2005-09-01 Steve Ellcey PR target/23556 * io/read.c (convert_real): Use memcpy to fill buffer. - (set_integer): Use memcpy to fill buffer. 2005-08-29 Thomas Koenig --- 1255,1274 ---- * config.h.in: Regenerate. * configure: Regenerate. ! 2005-09-02 Andreas Jaeger ! * libgfortran.h: Add prototype for init_compile_options. ! * io/io.h: Add prototype for notify_std. ! ! 2005-08-31 Steve Ellcey ! ! * io/read.c (set_integer): Use memcpy to fill buffer. ! ! 2005-08-31 Steve Ellcey PR target/23556 * io/read.c (convert_real): Use memcpy to fill buffer. 2005-08-29 Thomas Koenig *************** *** 92,106 **** * aclocal.ac: Regenerate. * io/io.h: Add prototype for unpack_filename. * io/close.c (st_close): Delete file after closing unit if ! HAVE_UNLINK_OPEN_FILE is not defined. * io/unix.c (unpack_filename): Unlink scratch file after opening it only if HAVE_UNLINK_OPEN_FILE is defined. 2005-08-16 Thomas Koenig PR libfortran/23428 ! * io/transfer.c (iolength_transfer): Return correct length ! for inquire(iolength=) for complex variables. 2005-08-11 Francois-Xavier Coudert Steven Bosscher --- 1287,1306 ---- * aclocal.ac: Regenerate. * io/io.h: Add prototype for unpack_filename. * io/close.c (st_close): Delete file after closing unit if ! HAVE_UNLINK_OPEN_FILE is not defined. * io/unix.c (unpack_filename): Unlink scratch file after opening it only if HAVE_UNLINK_OPEN_FILE is defined. + 2005-08-17 Kelley Cook + + * All files: Update FSF address. + 2005-08-16 Thomas Koenig PR libfortran/23428 ! * io/transfer.c (iolength_transfer): Remove __attribute__ ((unused)) ! from type. Return correct length for inquire(iolength=) ! for complex variables. 2005-08-11 Francois-Xavier Coudert Steven Bosscher *************** *** 117,123 **** * io/format.c: Use the new notify_std function for the $ descriptor extension. ! 2005-08-07 Francois-Xavier Coudert * Makefile.am: Add file intrinsics/tty.c to Makefile process. * Makefile.in: Regenerate. * io/io.h: Prototypes for new functions stream_isatty and --- 1317,1323 ---- * io/format.c: Use the new notify_std function for the $ descriptor extension. ! 2005-08-09 Francois-Xavier Coudert * Makefile.am: Add file intrinsics/tty.c to Makefile process. * Makefile.in: Regenerate. * io/io.h: Prototypes for new functions stream_isatty and *************** *** 133,148 **** * io/transfer.c (data_transfer_init): Initialize current_unit->bytes_left for a read. 2005-08-07 Francois-Xavier Coudert * io/io.h: Change DEFAULT_TEMPDIR to /tmp instead of /var/tmp. * io/unix.c (tempfile): Look at the TEMP environment variable ! to find the temporary files directory. ! 2005-08-04 Francois-Xavier Coudert * io/unix.c: Add O_RDWR to open() call. 2005-08-03 Francois-Xavier Coudert * libgfortran.h: When isfinite is not provided by the system, --- 1333,1364 ---- * io/transfer.c (data_transfer_init): Initialize current_unit->bytes_left for a read. + 2005-08-07 Janne Blomqvist + + PR fortran/22390 + * io/backspace.c: File removed, contents moved to ... + * io/endfile.c: Ditto. + * io/rewind.c: Ditto. + * io/file_pos.c: New file, ... here. + * Makefile.am: Add file_pos.c to list, remove obsolete files. + * Makefile.in: Regenerated. + 2005-08-07 Francois-Xavier Coudert * io/io.h: Change DEFAULT_TEMPDIR to /tmp instead of /var/tmp. * io/unix.c (tempfile): Look at the TEMP environment variable ! to find the temporary files directory. Whitespace correction. ! 2005-08-06 Francois-Xavier Coudert * io/unix.c: Add O_RDWR to open() call. + 2005-08-04 Paul Thomas + + * transfer.c (data_transfer_init): Truncate file in + sequential WRITE when last_record == 0, rather than + current_record. Cures problem on RH9. + 2005-08-03 Francois-Xavier Coudert * libgfortran.h: When isfinite is not provided by the system, *************** *** 155,160 **** --- 1371,1388 ---- * intrinsics/flush.c (flush_i8): Add function flush_i8. Update copyright years. + 2005-07-31 Francois-Xavier Coudert + + PR libfortran/21787 + * intrinsics/abort.c (abort): Close units before aborting. + Updated copyright years. + + 2005-07-30 Francois-Xavier Coudert + + PR libfortran/22436 + * io/write.c (write_real): Add default formats for real(10) and + real(16). + 2005-07-30 Paul Thomas PR fortran/22570 and related issues. *************** *** 170,187 **** * io/write.c (write_float): Revise output of IEEE exceptional values to comply with F95 and F2003 standards. ! 2005-07-22 Jerry DeLisle PR libfortran/22570 * io/unit.c (init_units): Replace BLANK_ZERO with BLANK_UNSPECIFIED. * io/read.c (next_char): Return a ' ' character when BLANK_ZERO or BLANK_NULL are active. (read_decimal): Interpret ' ' character correctly for BZ or BN. (read_radix): Interpret ' ' character correctly for BZ or BN. (read_f): Interpret ' ' character correctly for BZ or BN. ! 2005-07-22 Paul Thomas PR libfortran/22570 * read.c (read_x): Correct the condition for doing the --- 1398,1419 ---- * io/write.c (write_float): Revise output of IEEE exceptional values to comply with F95 and F2003 standards. ! 2005-07-22 Jerry DeLisle PR libfortran/22570 * io/unit.c (init_units): Replace BLANK_ZERO with BLANK_UNSPECIFIED. + + 2005-07-22 Jerry DeLisle + + PR libfortran/21875 (FM111.f) * io/read.c (next_char): Return a ' ' character when BLANK_ZERO or BLANK_NULL are active. (read_decimal): Interpret ' ' character correctly for BZ or BN. (read_radix): Interpret ' ' character correctly for BZ or BN. (read_f): Interpret ' ' character correctly for BZ or BN. ! 2005-07-22 Paul Thomas PR libfortran/22570 * read.c (read_x): Correct the condition for doing the *************** *** 194,355 **** (next_record_w) Zero X- and T-editing counters. unconditionally. ! 2005-07-19 Thomas Koenig - Backport from mainline. PR libfortran/21593 ! io/unix.c: Add member special_file to type unix_stream. (fd_truncate): Don't call ftruncate or chsize if s refers to a special file. (fd_to_stream): initialize s->special_file. ! 2005-07-18 Thomas Koenig ! Backport from mainline. ! PR libfortran/21333 ! * Makefile.am: Add in_pack_c4.c, in_pack_c8.c, in_unpack_c4.c ! and in_unpack_c8.c. ! * Makefile.in: Regenerate. ! * libgfortran.h: Declare internal_pack_c4, internal_pack_c8, ! internal_unpack_c4 and internal_unpack_c8. ! * m4/in_pack.m4: Use rtype_ccode insteald of rtype_kind ! in function name. ! Use sizeof (rtype_name) as size for memory allocation. ! * m4/in_unpack.m4: Use rtype_ccode insteald of rtype_kind ! in function name. ! Use sizeof (rtype_name) for calculation of sizes for memcpy. ! * runtime/in_pack_generic.c: For real, integer and logical ! call internal_pack_4 if size==4 and internal_pack_8 if ! size==8. ! For complex, call internal_pack_c4 if size==8 and ! internal_pack_c8 if size==16. ! * runtime/in_unpack_generic.c: For real, integer and logical ! call internal_unpack_4 if size==4 and internal_unpack_8 if ! size==8. ! For complex, call internal_unpack_c4 if size==8 and ! internal_unpack_c8 if size==16. ! * generated/in_pack_i4.c: Regenerated. ! * generated/in_pack_i8.c: Regenerated. ! * generated/in_unpack_i4.c: Regenerated. ! * generated/in_unpack_i8.c: Regenerated. ! * generated/in_pack_c4.c: New file. ! * generated/in_pack_c8.c: New file. ! * generated/in_unpack_c4.c: New file. ! * generated/in_unpack_c8.c: New file. ! 2005-07-17 Thomas Koenig ! Backport from mainline. ! PR libfortran/21480 ! * m4/reshape.m4: Use sizeof (rtype_name) for sizes to be passed ! to reshape_packed. ! * generated/reshape_c4.c: Regenerated. ! * generated/reshape_c8.c: Regenerated. ! * generated/reshape_i4.c: Regenerated. ! * generated/reshape_i8.c: Regenerated. ! 2005-07-16 Andrew Pinski ! PR fortran/13257 ! * format.c (parse_format_list): Allow an optional comma ! between descriptors. ! 2005-07-15 Thomas Koenig ! Backport from mainline. ! PR libfortran/21926 ! PR libfortran/18857 ! * m4/matmul.m4: Correct zeroing of result for non-packed ! arrays with lowest stride is one. ! Remove incorrect assertions (original patch by pault@gcc.gnu.org). ! * generated/matmul_c4.c: Regenerated. ! * generated/matmul_c8.c: Regenerated. ! * generated/matmul_i4.c: Regenerated. ! * generated/matmul_i8.c: Regenerated. ! * generated/matmul_r4.c: Regenerated. ! * generated/matmul_r8.c: Regenerated. ! 2005-07-14 Thomas Koenig - Backport from mainline. PR libfortran/21594 - PR libfortran/22142 - PR libfortran/22144 * intrinsics/eoshift0.c: If abs(shift) > len, fill the the whole array with the boundary value, but don't overrun it. * intrinsics/eoshift2.c: Likewise. * m4/eoshift1.m4: Likewise. * m4/eoshift3.m4: Likewise. - * m4/eoshift1.m4: Correct bstride (it needs to be multiplied - by size since it's a char pointer). - * m4/eoshift3.m4: Likewise. - * m4/cshift1.m4: Remove const from argument ret. - Populate return array descriptor if ret->data is NULL. - * m4/eoshift1.m4: Likewise. * generated/eoshift1_4.c: Regenerated. * generated/eoshift1_8.c: Regenerated. * generated/eoshift3_4.c: Regenerated. * generated/eoshift3_8.c: Regenerated. ! 2005-07-14 David Edelsohn ! Backport from mainline. ! PR libgfortran/22412 ! * io/write.c (otoa): Bias p by SCRATCH_SIZE, not ! sizeof (SCRATCH_SIZE). ! (btoa): Same. ! 2005-07-14 Paul Thomas ! PR libfortran/16435 ! * transfer.c (formatted_transfer): Correct the problems ! with X- and T-editting that caused TLs followed by TRs ! to overwrite data, which caused NIST FM908.FOR to fail ! on many tests. ! (data_transfer_init): Zero X- and T-editting counters at ! the start of formatted IO. ! * write.c (write_x): Write specified number of skips with ! specified number of spaces at the end. ! 2005-07-14 Paul Thomas ! * io/read.c (read_complex): Prevent X formatting during reads ! from going beyond EOR to fix NIST fm908.FOR failure. ! * io/list_read.c (read_complex): Allow complex data in list- ! directed reads to have eols either side of the comma to ! fix NIST FM906.FOR failure. ! (nml_get_obj_data): Cure warnings about initializer braces. ! (namelist_read): Cure warnings about potentially uninitialized pointers. ! 2005-07-12 Feng Wang ! * runtime/string.c (compare0): Remove unused variable. ! * intrinsics/etime.c (etime_sub): Ditto. ! * intrinsics/getcwd.c (getcwd_i4_sub): Ditto. ! * intrinsics/stat.c (stat_i4_sub stat_i8_sub fstat_i4_sub ! fstat_i8_sub): Ditto. ! * intrinsics/unlink.c (unlink_i4_sub): Ditto. ! * io/unit.c (init_units): Ditto. ! Backport from mainline. ! 2005-07-07 Feng Wang ! PR fortran/16531 ! * io/transfer.c (formatted_transfer): Enable FMT_A on other types to ! support Hollerith constants. ! 2005-07-10 Jerry DeLisle ! PR libfortran/21875 (FM111.f) ! * io/read.c (next_char): Return a ' ' character when BLANK_ZERO or ! BLANK_NULL are active. ! (read_decimal): Interpret ' ' character correctly for BZ or BN. ! (read_radix): Interpret ' ' character correctly for BZ or BN. ! (read_f): Interpret ' ' character correctly for BZ or BN. ! * gfortran.dg/test (fmt_read_bz_bn.f90): New test case. ! 2005-07-07 Release Manager - * GCC 4.0.1 released. 2005-06-18 Janne Blomqvist --- 1426,1663 ---- (next_record_w) Zero X- and T-editing counters. unconditionally. ! 2005-07-17 Jerry DeLisle ! ! * io/write.c (write_float): Fix field width checks for ! printing 'Infinity' or 'Inf'. ! (output_float): Fix typo in comment. ! ! 2005-07-12 Paul Thomas ! ! PR libfortran/16435 ! * transfer.c (formatted_transfer): Correct the problems ! with X- and T-editting that caused TLs followed by TRs ! to overwrite data, which caused NIST FM908.FOR to fail ! on many tests. ! (data_transfer_init): Zero X- and T-editting counters at ! the start of formatted IO. ! * write.c (write_x): Write specified number of skips with ! specified number of spaces at the end. ! ! 2005-07-13 Paul Thomas ! ! * io/read.c (read_complex): Prevent X formatting during reads ! from going beyond EOR to fix NIST fm908.FOR failure. ! * io/list_read.c (read_complex): Allow complex data in list- ! directed reads to have eols either side of the comma to ! fix NIST FM906.FOR failure. ! ! 2005-07-12 Thomas Koenig PR libfortran/21593 ! * io/unix.c: Add member special_file to type unix_stream. (fd_truncate): Don't call ftruncate or chsize if s refers to a special file. (fd_to_stream): initialize s->special_file. ! 2005-07-11 David Edelsohn ! PR libgfortran/22412 ! * io/write.c (otoa): Bias p by SCRATCH_SIZE, not ! sizeof (SCRATCH_SIZE). ! (btoa): Same. ! 2005-07-09 Jerry DeLisle ! PR libfortran/21875 (FM111.f) ! * io/read.c (next_char): Return a ' ' character when BLANK_ZERO or ! BLANK_NULL are active. ! (read_decimal): Interpret ' ' character correctly for BZ or BN. ! (read_radix): Interpret ' ' character correctly for BZ or BN. ! (read_f): Interpret ' ' character correctly for BZ or BN. ! * gfortran.dg/test (fmt_read_bz_bn.f90): New test case. ! 2005-07-09 Francois-Xavier Coudert ! Thomas Koenig ! PR libfortran/22217 ! * io/write.c (extract_unit): New function; extract ! ints as unsigned signed int of the correct size. ! (write_int): Use it. ! * runtime/error.c: Adjust copyright years. ! Adjust size of buffer to maximum that can occur. ! 2005-07-07 Tobias Schl"uter ! * libgfortran.h (GFC_ARRAY_DESCRIPTOR): Replace 'type *base' by ! 'size_t offset'. ! * intrinsics/cshift0.c, intrinsics/eoshift0.c, ! intrinsics/eoshift2.c,intrinsics/pack_generic.c, ! intrinsics/reshape_generic.c, intrinsics/spread_generic.c, ! intrinsics/transpose_generic.c, intrinsics/unpack_generic, ! m4/cshift1.m4, m4/eoshift1.m4, m4/eoshift3.m4, m4/iforeach.m4, ! m4/ifunction.m4, m4/matmul.m4, m4/matmull.m4, m4/reshape.m4, ! m4,transpose.m4: Set renamed field 'offset' to zero instead of ! 'base'. ! * generated/all_l4.c, generated/all_l8.c, ! generated/any_l4.c, generated/any_l8.c, generated/count_4_l4.c, ! generated/count_4_l8.c, generated/count_8_l4.c, ! generated/count_8_l8.c, generated/chift1_4.c, ! generated/cshift1_8.c, generated/eoshift1_4.c, ! generated/eoshift1_8.c, generated/eoshift3_4.c, ! generated/eoshift3_8.c, generated/matmul_c4.c, ! generated/matmul_c8.c, generated/matmul_i4.c, matmul_i8.c, ! generated/matmul_l4.c, generated/matmul_l8.c, ! generated/matmul_r4.c, generated/matmul_r8.c, ! generated/maxloc0_4_i4.c, generated/maxloc0_4_i8.c, ! generated/maxloc0_4_r4.c, generated/maxloc0_4_r8.c, ! generated/maxloc0_8_i4.c, generated/maxloc0_8_i8.c, ! generated/maxloc0_8_r4.c, generated/maxloc0_8_r8.c, ! generated/maxloc1_4_i4.c, generated/maxloc1_4_i8.c, ! generated/maxloc1_4_r4.c, generated/maxloc1_4_r8.c, ! generated/maxloc1_8_i4.c, generated/maxloc1_8_i8.c, ! generated/maxloc1_8_r4.c, generated/maxloc1_8_r8.c, ! generated/maxval_i4.c, generated/maxval_i8.c, ! generated/maxval_r4.c, generated/maxval_r8.c, ! generated/minloc0_4_i4.c, generated/minloc0_4_i8.c, ! generated/minloc0_4_r4.c, generated/minloc0_4_r8.c, ! generated/minloc0_8_i4.c, generated/minloc0_8_i8.c, ! generated/minloc0_8_r4.c, generated/minloc0_8_r8.c, ! generated/minloc1_4_i4.c, generated/minloc1_4_i8.c, ! generated/minloc1_4_r4.c, generated/minloc1_4_r8.c, ! generated/minloc1_8_i4.c, generated/minloc1_8_i8.c, ! generated/minloc1_8_r4.c, generated/minloc1_8_r8.c, ! generated/minval_i4.c, generated/minval_i8.c, ! generated/minval_r4.c, generated/minval_r8.c, ! generated/product_c4.c, generated/product_c8.c, ! generated/product_i4.c, generated/product_i8.c, ! generated/product_r4.c, generated/product_r8.c, ! generated/reshape_c4.c, generated/reshape_c8.c, ! generated/reshape_i4.c, generated/reshape_i8.c, ! generated/sum_c4.c, generated/sum_c8.c, generated/sum_i4.c, ! generated/sum_i8.c, generated/sum_r4.c, generated/sum_r8.c, ! generated/transpose_c4.c, generated/transpose_c8.c, ! generated/transpose_i4.c, generated/transpose_i8.c: Regenerate: ! 2005-07-07 Thomas Koenig PR libfortran/21594 * intrinsics/eoshift0.c: If abs(shift) > len, fill the the whole array with the boundary value, but don't overrun it. * intrinsics/eoshift2.c: Likewise. * m4/eoshift1.m4: Likewise. * m4/eoshift3.m4: Likewise. * generated/eoshift1_4.c: Regenerated. * generated/eoshift1_8.c: Regenerated. * generated/eoshift3_4.c: Regenerated. * generated/eoshift3_8.c: Regenerated. ! 2005-07-07 Feng Wang ! PR fortran/16531 ! * io/transfer.c (formatted_transfer): Enable FMT_A on other types to ! support Hollerith constants. ! 2005-07-01 Andreas Jaeger ! * intrinsics/unpack_generic.c: Remove const from parameter. ! * io/transfer.c (formatted_transfer): Remove unused variable. ! 2005-06-28 Thomas Koenig ! PR libfortran/22142 ! * m4/eoshift1.m4: Correct bstride (it needs to be multiplied ! by size since it's a char pointer). ! * m4/eoshift1_4.c: Regenerated. ! * m4/eoshift1_8.c: Regenerated. ! 2005-06-28 Thomas Koenig ! PR libfortran/22142 ! * m4/eoshift3.m4: Correct bstride (it needs to be multiplied ! by size since it's a char pointer). ! * m4/eoshift3_4.c: Regenerated. ! * m4/eoshift3_8.c: Regenerated. ! 2005-06-28 Francois-Xavier Coudert ! PR libfortran/22170 ! * io/transfer.c (formatted_transfer): Do not iterate on the ! repeat count of a FMT_SLASH, since this is already done in ! next_format(). ! 2005-06-25 Thomas Koenig ! ! PR libfortran/22144 ! * m4/cshift1.m4: Remove const from argument ret. ! Populate return array descriptor if ret->data is NULL. ! * m4/eoshift1.m4: Likewise. ! * m4/eoshift3.m4: Likewise. ! * generated/cshift1_4.c: Regenerated. ! * generated/cshift1_8.c: Regenerated. ! * generated/eoshift1_4.c: Regenerated. ! * generated/eoshift1_8.c: Regenerated. ! * generated/eoshift3_4.c: Regenerated. ! * generated/eoshift3_8.c: Regenerated. ! ! 2005-06-24 Jerry DeLisle ! ! PR libfortran/21915 ! * Makefile.am: Include intrinsics/hyper.c. ! * c99_protos.h: Add prototypes for single precision versions of ! acosh, asinh, and atanh for platforms that do not have these. ! * config.h.in: Add #undef for wrappers. ! * configure.ac: Add checks for single precision versions. ! * aclocal.m4: Regenerated. ! * Makefile.in: Regenerated. ! * configure: Regenerated. ! * intrinsics/hyper.c: New file, adds new wrapper functions. ! ! 2005-06-23 Francois-Xavier Coudert ! ! * intrinsics/c99_functions.c (log10l): New log10l function for ! systems where this is not available. ! * c99_protos.h: Prototype for log10l function. ! * libgfortran.h: Use generated kinds.h to define GFC_INTEGER_*, ! GFC_UINTEGER_*, GFC_LOGICAL_*, GFC_REAL_*, GFC_COMPLEX_*. Update ! prototypes for gfc_itoa and xtoa. ! * io/io.h: Update prototypes for set_integer and max_value. ! * io/list_read.c (convert_integer): Use new ! GFC_(INTEGER|REAL)_LARGEST type. ! * io/read.c (set_integer): Likewise. ! (max_value): Likewise. ! (convert_real): Likewise. ! (real_l): Likewise. ! (next_char): Likewise. ! (read_decimal): Likewise. ! (read_radix): Likewise. ! (read_f): Likewise. ! * io/write.c (extract_int): Use new GFC_INTEGER_LARGEST type. ! (extract_real): Use new GFC_REAL_LARGEST type. ! (calculate_exp): Likewise. ! (calculate_G_format): Likewise. ! (output_float): Likewise. Use log10l for long double values. ! Add comment for sprintf format. Use GFC_REAL_LARGEST_FORMAT. ! (write_l): Use new GFC_INTEGER_LARGEST type. ! (write_float): Use new GFC_REAL_LARGEST type. ! (write_int): Remove useless special case for (len < 8). ! (write_decimal): Use GFC_INTEGER_LARGEST. ! (otoa): Use GFC_UINTEGER_LARGEST as argument. ! (btoa): Use GFC_UINTEGER_LARGEST as argument. ! * runtime/error.c (gfc_itoa): Use GFC_INTEGER_LARGEST as ! argument. ! (xtoa): Use GFC_UINTEGER_LARGEST as argument. ! * Makefile.am: Use mk-kinds-h.sh to generate header kinds.h ! with all Fortran kinds available. ! * configure.ac: Check for strtold and log10l. ! * Makefile.in: Regenerate. ! * aclocal.m4: Regenerate. ! * configure: Regenerate. ! * config.h.in: Regenerate. ! * mk-kinds-h.sh: Configuration script for available integer ! and real kinds. 2005-06-18 Janne Blomqvist *************** *** 371,381 **** 2005-06-17 Francois-Xavier Coudert - PR libfortran/19155 - * io/read.c (read_f): Take care of spaces after initial sign. - - 2005-06-17 Francois-Xavier Coudert - * io/transfer.c (formatted_transfer): Fix typo in error message. 2005-06-17 Francois-Xavier Coudert --- 1679,1684 ---- *************** *** 395,472 **** * c99_protos.h: Prototype for scalbn. * configure.ac: Add check for scalbn. * configure: Regenerate. ! * config.h.in: Likewise. ! ! 2005-06-11 David Edelsohn ! Backport from mainline: ! PR libfortran/20930 ! * io/rewind.c (st_rewind): Flush the stream when resetting the mode ! from WRITING to READING. ! 2005-06-05 Jakub Jelinek ! Backport from the mainline: ! 2005-04-18 Paul Thomas ! Jerry DeLisle ! * io/write.c (nml_write_obj): Provide 1 more byte for ext_name. ! * io/list_read.c (nml_get_obj_data): Put extra brackets in get_mem ! call for ext_name. These fix the bug reported by Jerry DeLisle to ! the fortran list and are based on his suggested fix. ! 2005-04-18 Paul Thomas ! * io/list_read.c (nml_touch_nodes, nml_read_obj, ! nml_get_obj_data): Fix memory leaks in code for derived types. ! 2005-04-17 Paul Thomas ! * io/list_read.c (eat_separator): at_eol = 1 replaced ! (zapped at some time?). ! 2005-04-17 Paul Thomas ! PR libgfortran/12884 ! PR libgfortran/17285 ! PR libgfortran/18122 ! PR libgfortran/18210 ! PR libgfortran/18392 ! PR libgfortran/18591 ! PR libgfortran/18879 ! * io/io.h (nml_ls): Declare. ! (namelist_info): Modify for arrays. ! * io/list_read.c (namelist_read): Reduced to call to new functions. ! (match_namelist_name): Simplified. ! (nml_query): Handles stdin queries ? and =?. New function. ! (nml_get_obj_data): Parses object name. New function. ! (touch_nml_nodes): Marks objects for read. New function. ! (untouch_nml_nodes): Resets objects. New function. ! (parse_qualifier): Parses and checks qualifiers. New function ! (nml_read_object): Reads and stores object data. New function. ! (eat_separator): No new_record on '/' in namelist. ! (finish_separator): No new_record on '/' in namelist. ! (read_logical): Error return for namelist. ! (read_integer): Error return for namelist. ! (read_complex): Error return for namelist. ! (read_real): Error return for namelist. ! * io/lock.c (library_end): Free extended namelist_info types. ! * io/transfer.c (st_set_nml_var): Modified for arrays. ! (st_set_nml_var_dim): Dimension descriptors. New function. ! * io/write.c (namelist_write): Reduced to call to new functions. ! (nml_write_obj): Writes output for object. New function. ! (write_integer): Suppress leading blanks for repeat counts. ! (write_int): Suppress leading blanks for repeat counts. ! (write_float): Suppress leading blanks for repeat counts. ! (output_float): Suppress leading blanks for repeat counts. ! 2005-06-01 Tobias Schl"uter ! * Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90' ! to dependencies. ! * aclocal.m4: Regenerate. * Makefile.in: Regenerate. ! * intrinsics/f2c_specific.F90: New file. 2005-05-30 Francois-Xavier Coudert --- 1698,1788 ---- * c99_protos.h: Prototype for scalbn. * configure.ac: Add check for scalbn. * configure: Regenerate. ! * config.h.in: Regenerate. ! 2005-06-14 Thomas Koenig ! * intrinsics/eoshift0.c: Removed prototype for eoshift0. ! * intrinsics/eoshift2.c: Removed prototype for eoshift2. ! 2005-06-14 Tom Tromey ! PR libgcj/19877: ! * configure, aclocal.m4, Makefile.in: Rebuilt. ! 2005-06-12 Thomas Koenig ! PR libfortran/21594 ! * intrinsics/eoshift0.c: Add prototype for eoshift0. ! * intrinsics/eoshift2.c: Add prototype for eoshift2. ! 2005-06-12 Steven G. Kargl ! Thomas Koenig ! PR libfortran/PR21797 ! * m4/cexp.m4 (csqrt`'q): Add type qualifyer to ! sqrt and fabs. ! * generated/exp_c4.c: Regenerated. ! 2005-06-12 Francois-Xavier Coudert ! PR libfortran/19155 ! * io/read.c (read_f): Take care of spaces after initial sign. ! 2005-06-11 Thomas Koenig ! PR libfortran/21333 ! * Makefile.am: Add in_pack_c4.c, in_pack_c8.c, in_unpack_c4.c ! and in_unpack_c8.c. * Makefile.in: Regenerate. ! * libgfortran.h: Declare internal_pack_c4, internal_pack_c8, ! internal_unpack_c4 and internal_unpack_c8. ! * m4/in_pack.m4: Use rtype_ccode insteald of rtype_kind ! in function name. ! Use sizeof (rtype_name) as size for memory allocation. ! * m4/in_unpack.m4: Use rtype_ccode insteald of rtype_kind ! in function name. ! Use sizeof (rtype_name) for calculation of sizes for memcpy. ! * runtime/in_pack_generic.c: For real, integer and logical ! call internal_pack_4 if size==4 and internal_pack_8 if ! size==8. ! For complex, call internal_pack_c4 if size==8 and ! internal_pack_c8 if size==16. ! * runtime/in_unpack_generic.c: For real, integer and logical ! call internal_unpack_4 if size==4 and internal_unpack_8 if ! size==8. ! For complex, call internal_unpack_c4 if size==8 and ! internal_unpack_c8 if size==16. ! * generated/in_pack_i4.c: Regenerated. ! * generated/in_pack_i8.c: Regenerated. ! * generated/in_unpack_i4.c: Regenerated. ! * generated/in_unpack_i8.c: Regenerated. ! * generated/in_pack_c4.c: New file. ! * generated/in_pack_c8.c: New file. ! * generated/in_unpack_c4.c: New file. ! * generated/in_unpack_c8.c: New file. ! ! 2005-06-09 Thomas Koenig ! ! PR libfortran/21480 ! * m4/reshape.m4: Use sizeof (rtype_name) for sizes to be passed ! to reshape_packed. ! * generated/reshape_c4.c: Regenerated. ! * generated/reshape_c8.c: Regenerated. ! * generated/reshape_i4.c: Regenerated. ! * generated/reshape_i8.c: Regenerated. ! ! 2005-06-07 Thomas Koenig ! ! PR libfortran/21926 ! * m4/matmul.m4: Correct zeroing of result for non-packed ! arrays with lowest stride is one. ! * generated/matmul_c4.c: Regenerated. ! * generated/matmul_c8.c: Regenerated. ! * generated/matmul_i4.c: Regenerated. ! * generated/matmul_i8.c: Regenerated. ! * generated/matmul_r4.c: Regenerated. ! * generated/matmul_r8.c: Regenerated. 2005-05-30 Francois-Xavier Coudert *************** *** 493,508 **** (in_unpack_generic): Change dimension of auxiliary arrays from GFC_MAX_DIMENSION - 1 to GFC_MAX_DIMENSION. - 2005-05-27 Eric Botcazou - - Backport from mainline: - 2005-05-21 Eric Botcazou - * configure.ac: Check for trunc and truncf in libm. - * configure: Regenerate. - * config.h.in: Likewise. - * intrinsics/c99_functions.c (trunc, truncf): New functions. - * c99_protos.h (trunc, truncf): Declare them. - 2005-05-26 Thomas Koenig PR libfortran/17283 --- 1809,1814 ---- *************** *** 512,540 **** rs: New variable, for calculating return sizes. Populate return array descriptor if ret->data is NULL. ! 2005-05-25 Thomas Koenig ! Backport from mainline: ! PR libfortran/18495 ! * intrinsics/spread_generic.c (spread): Remove const from ! return array descriptor. ! New variables: rrank (rank of return array), rs (for ! calculating the size of the return array), srank (rank ! of the source array). ! Generate runtime error if the dim= argument is larger than ! the rank of the return array. ! Generate runtime error if the needed rank of the return ! array is larger than 7. ! If ret->data is null, populate the return array descriptor ! and initialize the variables for the actual operation. ! Otherwise, set ret->dim[0].stride to one if it is zero. ! Change second, independent use of variable dim to srank. ! 2005-05-23 Thomas Koenig - Backport from mainline: PR libfortran/21354 - PR libfortran/21075 * m4/cshift1.m4: Change dimension of auxiliary arrays from GFC_MAX_DIMENSION - 1 to GFC_MAX_DIMENSION. * m4/eoshift1.m4: Likewise. --- 1818,2031 ---- rs: New variable, for calculating return sizes. Populate return array descriptor if ret->data is NULL. ! 2005-05-22 Peter Wainwright ! PR libfortran/21376 ! * io/write.c (output_float): Rework logic to avoid call to log10 ! with argument equal to zero. ! 2005-05-21 Eric Botcazou ! ! * configure.ac: Check for trunc and truncf in libm. ! * configure: Regenerate. ! * config.h.in: Likewise. ! * intrinsics/c99_functions.c (trunc, truncf): New functions. ! * c99_protos.h (trunc, truncf): Declare them. ! ! 2005-05-18 Thomas Koenig ! ! PR libfortran/21127 ! * Makefile.am: Really commit. ! * Makefile.in: Really commit. ! ! 2005-05-18 Thomas Koenig ! ! PR libfortran/21127 ! * Makefile.am: Add generated/reshape_c4.c and ! generated/reshape_c8.c. ! * Makefile.in: Regenerated. ! * m4/iparm.m4: Define rtype_ccode to be c4 or c8 for ! complex types, 4 or 8 otherwise. ! * m4/reshape.m4: Use rtype_ccode instead of rtype_kind ! in function name. ! * generated/reshape_c4.c: New file. ! * generated/reshape_c8.c: New file. ! ! 2005-05-16 Andreas Jaeger ! ! * configure.ac: Add additional warning flags. ! * configure: Regenerate. ! ! * io/write.c (calculate_G_format): Remove unused parameter. ! (output_float): Remove unused parameter. ! (write_float): Change callers. ! (nml_write_obj): Avoid signed warning. ! Make variable const to support -Wwrite-strings. ! ! * io/unix.c (fd_alloc, mmap_open, mmap_sfree, mem_sfree, ! mem_truncate): Mark argument as unused. ! ! * io/unit.c (get_unit): Mark argument as unused. ! (init_units): Avoid warning about signed comparision. ! ! * io/transfer.c (next_record_r): Remove unused parameter. ! (next_record_w): Remove unused parameter. ! (next_record): Change callers. ! (iolength_transfer): Mark arguments as unused. ! ! * io/open.c: Add initializer. ! ! * io/list_read.c (read_character): Mark argument as unused. ! (nml_match_name): Add const to make compile with -Wwrite-strings. ! ! * io/format.c: Add initializer. ! ! 2005-05-15 Andreas Jaeger ! ! * m4/eoshift1.m4: Initialize variables to avoid warnings. ! * m4/eoshift3.m4: Initialize variables to avoid warnings. ! * generated/eoshift1_4.c, generated/eoshift1_8.c, ! generated/eoshift3_4.c, generated/eoshift3_8.c: Regenerated. ! ! * intrinsics/spread_generic.c (spread): Initialize variables to ! avoid warnings. ! ! * intrinsics/eoshift0.c (eoshift0): Initialize variables to avoid ! warnings. ! * intrinsics/eoshift2.c (eoshift2): Initialize variables to avoid ! warnings. ! ! * io/list_read.c (nml_get_obj_data): Initialize variables to avoid ! warnings. ! ! * intrinsics/pack_generic.c (pack): Remove unneeded calculation. ! ! * m4/matmull.m4 (matmul_): Remove unneeded calculations, fix ! pointer cast to avoid warning. ! * generated/matmul_l4.c: Regenerated. ! * generated/matmul_l8.c: Regenerated. ! ! * Makefile.am: Remove AM_CFLAGS here. ! * configure.ac: Define AM_CFLAGS and AM_FCFLAGS so that warnings ! are set. Set additionally -Wstrict-prototypes for CFLAGS. ! * Makefile.in: Regenerated. ! * aclocal.m4: Regenerated. ! * configure: Regenerated. ! ! * intrinsics/system_clock.c (system_clock_4, system_clock_8): Add ! missing returns, reformat a bit. ! ! * io/write.c (nml_write_obj): Use %d again - and cast to int, ! st_sprintf does not handle %ld. ! ! * io/unit.c (is_internal_unit): Add void as parameter list. ! ! * io/transfer.c: Move prototype declarations before the functions. ! ! * runtime/normalize.c (almostone_r4, almostone_r8): Fix parameter ! list. ! ! * intrinsics/random.c (KISS_DEFAULT_SEED): Remove extra semicolon. ! ! * io/transfer.c: Do not use empty initializers for global objects. ! Add missing initializers. ! ! * io/lock.c: Do not use empty initializers for global objects. ! ! * io/close.c: Add missing initializers. ! ! * runtime/environ.c: Add missing initializers. Do not use empty ! initializers for global object. ! (init_string): Mark argument as unused. ! ! * runtime/main.c (cleanup): Fix parameter list. ! ! * io/io.h: Fix parameter lists. ! ! * m4/transpose.m4, m4/matmul.m4: Fix pointer cast to avoid ! warning. ! ! * generated/transpose_c4.c, generated/transpose_c8.c, ! generated/transpose_i4.c, generated/transpose_i8.c, ! generated/matmul_c4.c, generated/matmul_c8.c, ! generated/matmul_i4.c, generated/matmul_i8.c, ! generated/matmul_r4.c, generated/matmul_r8.c: Regenerated. ! ! * io/write.c (nml_write_obj): Fix 64-bit problem. ! ! * io/list_read.c (nml_get_obj_data): Add missing braces around ! initializer to avoid warnings. ! ! * intrinsics/etime.c (etime_sub): Remove unused variable. ! ! * intrinsics/chdir.c, intrinsics/getlog.c, intrinsics/link.c, ! intrinsics/symlnk.c, intrinsics/perror.c: Include for ! prototypes. ! ! * runtime/string.c (compare0): Remove unused variable. ! * io/unit.c (init_units): Remove unused variables. ! * intrinsics/getcwd.c (getcwd_i4_sub): Remove unused variable. ! * intrinsics/unlink.c (unlink_i4_sub): Remove unused variable. ! * intrinsics/stat.c (stat_i4_sub, fstat_i8_sub, fstat_i4_sub, ! stat_i8_sub): Remove unused variable. ! ! 2005-05-12 Thomas Koenig ! ! PR libfortran/21324 ! * runtime/memory.c: Don't define GFC_CLEAR_MEMORY (it's a ! performance hog). ! * io/open.c (new_unit): Zero freshly allocated memory for ! unit structure. ! * io/unit.c (init_units): Zero freshly allocated memory for ! STDIN, STDOUT and STDERR. ! * io/unix.c (open_internal): Zero freshly allocated memory ! for unix_stream. ! (fd_to_stream): Likewise. ! ! 2005-05-11 Bud Davis ! ! PR fortran/19478 ! * io/unix.c (fd_truncate): update positions when ftruncate ! fails (like writing to /dev/null). ! ! 2005-05-10 Francois-Xavier Coudert ! ! PR libfortran/21471 ! * open.c (new_unit): Take care of the case where POSITION_APPEND ! is specified (sseek to the end, and set u>-endfile). ! ! 2005-05-10 Tobias Schl"uter ! ! PR fortran/20178 ! * Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90' ! to dependencies. ! * Makefile.in: Regenerate. ! * intrinsics/f2c_specific.F90: New file. ! ! 2005-05-10 Francois-Xavier Coudert ! ! PR libfortran/20788 ! * io/unix.c (fd_to_stream): Add an avoid_mmap argument indicating ! we don't we to mmap this stream. Use fd_open instead of mmap_open ! in that case. ! (open_external): Call fd_to_stream with avoid_mmap = 0. ! (input_stream): Call fd_to_stream with avoid_mmap = 1. ! (output_stream): Likewise. ! (error_stream): Likewise. ! ! 2005-05-09 Mike Stump ! ! * configure: Regenerate. ! ! 2005-05-09 Francois-Xavier Coudert ! ! PR libfortran/19155 ! * io/read.c (read_f): Accept 'e', 'E', 'd' and 'D' as first ! non-blank characters of a real number. ! ! 2005-05-04 Thomas Koenig PR libfortran/21354 * m4/cshift1.m4: Change dimension of auxiliary arrays from GFC_MAX_DIMENSION - 1 to GFC_MAX_DIMENSION. * m4/eoshift1.m4: Likewise. *************** *** 542,553 **** * m4/ifunction.m4: Likewise. * m4/in_pack.m4: Likewise. * m4/in_unpack.m4: Likewise. - * m4/reshape.m4: Likewise. * intrinsics/cshift0.c: Likewise. * intrinsics/eoshift0.c: Likewise. * intrinsics/eoshift2.c: Likewise. * intrinsics/random.c: Likewise. - * intrinsics/reshape_generic.c: Likewise. * intrinsics/spread_generic.c: Likewise. * intrinsics/stat.c: Likewise. * generated/all_l4.c: Regenerated. --- 2033,2042 ---- *************** *** 568,573 **** --- 2057,2070 ---- * generated/in_pack_i8.c: Regenerated. * generated/in_unpack_i4.c: Regenerated. * generated/in_unpack_i8.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. * generated/maxloc1_4_i4.c: Regenerated. * generated/maxloc1_4_i8.c: Regenerated. * generated/maxloc1_4_r4.c: Regenerated. *************** *** 580,585 **** --- 2077,2090 ---- * generated/maxval_i8.c: Regenerated. * generated/maxval_r4.c: Regenerated. * generated/maxval_r8.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. * generated/minloc1_4_i4.c: Regenerated. * generated/minloc1_4_i8.c: Regenerated. * generated/minloc1_4_r4.c: Regenerated. *************** *** 598,607 **** * generated/product_i8.c: Regenerated. * generated/product_r4.c: Regenerated. * generated/product_r8.c: Regenerated. - * generated/reshape_c4.c: Regenerated. - * generated/reshape_c8.c: Regenerated. - * generated/reshape_i4.c: Regenerated. - * generated/reshape_i8.c: Regenerated. * generated/sum_c4.c: Regenerated. * generated/sum_c8.c: Regenerated. * generated/sum_i4.c: Regenerated. --- 2103,2108 ---- *************** *** 609,624 **** * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. ! 2005-05-22 Peter Wainwright ! PR libfortran/21376 ! * io/write.c (output_float): Rework logic to avoid call to log10 ! with argument equal to zero. ! 2005-05-21 Thomas Koenig - Backport from mainline: - PR libfortran/18495 PR libfortran/20074 PR libfortran/20436 PR libfortran/21108 --- 2110,2164 ---- * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. ! 2005-04-30 Thomas Koenig ! PR libfortran/18958 ! libgfortran.h: Change typedef of index_type from size_t ! to ssize_t. ! 2005-04-30 Paul Thomas ! ! PR libfortran/18857 ! * generated/matmul_r8.c: Remove incorrect assertions. ! * generated/matmul_c4.c: Regenerate ! * generated/matmul_c8.c: Regenerate ! * generated/matmul_i4.c: Regenerate ! * generated/matmul_i8.c: Regenerate ! * generated/matmul_r4.c: Regenerate ! * generated/matmul_r8.c: Regenerate ! ! 2005-04-29 Francois-Xavier Coudert ! ! * configure.ac: Check for ftruncate and chsize. ! * io/unix.c (fd_truncate): Provide chsize as alternative to ! ftruncate. ! * config.h.in: Regenerate. ! * configure: Regenerate. ! ! 2004-04-29 Tobias Schl"uter ! ! * intrinsics/rename.c: Add missing #includes. ! ! 2004-04-28 Tobias Schl"uter ! ! * AUTHORS, COPYING, INSTALL, NEWS, README: Remove. ! ! 2005-04-26 David Edelsohn ! ! PR libfortran/20930 ! * io/rewind.c (st_rewind): Flush the stream when resetting the mode ! from WRITING to READING. ! ! 2005-04-22 Paul Thomas ! Jerry DeLisle ! ! * io/write.c (nml_write_obj): Provide 1 more byte for ext_name. ! * io/list_read.c (nml_get_obj_data): Put extra brackets in get_mem ! call for ext_name. These fix the bug reported by Jerry DeLisle to ! the fortran list and are based on his suggested fix. ! ! 2005-04-22 Thomas Koenig PR libfortran/20074 PR libfortran/20436 PR libfortran/21108 *************** *** 633,644 **** * generated/reshape_i4.c: Regenerated. * generated/reshape_i8.c: Regenerated. ! 2005-05-20 Thomas Koenig - Backport from mainline: PR libfortran/19106 - PR libfortran/19014 - PR libfortran/19016 * m4/iforeach.c (name`'rtype_qual`_'atype_code): Add TODO that setting correct strides is a front end job. (`m'name`'rtype_qual`_'atype_code): Likewise. If mask has --- 2173,2263 ---- * generated/reshape_i4.c: Regenerated. * generated/reshape_i8.c: Regenerated. ! 2005-04-18 Paul Thomas ! ! * io/list_read.c (nml_touch_nodes, nml_read_obj, ! nml_get_obj_data): Fix memory leaks in code for derived types. ! ! 2005-04-11 Francois-Xavier Coudert ! ! PR libfortran/20950 ! * io/inquire.c (inquire_via_unit): Check for the gfc_unit being ! NULL when setting ioparm.sequential. ! ! 2005-04-17 Thomas Koenig ! ! PR libfortran/21075 ! * m4/reshape.m4 (reshape_`'rtype_kind): Change dimension ! of auxiliary arrays from GFC_MAX_DIMENSIONS - 1 to ! GFC_MAX_DIMENSIONS. ! * intrinsics/reshape_generic.c (reshape_generic): Likewise. ! * generated/reshape_i4.c: Regenerated. ! * generated/reshape_i8.c: Regenerated. ! ! 2005-04-17 Paul Thomas ! ! * io/list_read.c (eat_separator): at_eol = 1 replaced ! (zapped at some time?). ! ! 2005-04-17 Paul Thomas ! ! PR libgfortran/12884 ! PR libgfortran/17285 ! PR libgfortran/18122 ! PR libgfortran/18210 ! PR libgfortran/18392 ! PR libgfortran/18591 ! PR libgfortran/18879 ! * io/io.h (nml_ls): Declare. ! (namelist_info): Modify for arrays. ! * io/list_read.c (namelist_read): Reduced to call to new functions. ! (match_namelist_name): Simplified. ! (nml_query): Handles stdin queries ? and =?. New function. ! (nml_get_obj_data): Parses object name. New function. ! (touch_nml_nodes): Marks objects for read. New function. ! (untouch_nml_nodes): Resets objects. New function. ! (parse_qualifier): Parses and checks qualifiers. New function ! (nml_read_object): Reads and stores object data. New function. ! (eat_separator): No new_record on '/' in namelist. ! (finish_separator): No new_record on '/' in namelist. ! (read_logical): Error return for namelist. ! (read_integer): Error return for namelist. ! (read_complex): Error return for namelist. ! (read_real): Error return for namelist. ! * io/lock.c (library_end): Free extended namelist_info types. ! * io/transfer.c (st_set_nml_var): Modified for arrays. ! (st_set_nml_var_dim): Dimension descriptors. New function. ! * io/write.c (namelist_write): Reduced to call to new functions. ! (nml_write_obj): Writes output for object. New function. ! (write_integer): Suppress leading blanks for repeat counts. ! (write_int): Suppress leading blanks for repeat counts. ! (write_float): Suppress leading blanks for repeat counts. ! (output_float): Suppress leading blanks for repeat counts. ! ! 2005-04-15 Thomas Koenig ! ! PR libfortran/18495 ! * intrinsics/spread_generic.c (spread): Remove const from ! return array descriptor. ! New variables: rrank (rank of return array), rs (for ! calculating the size of the return array), srank (rank ! of the source array). ! Generate runtime error if the dim= argument is larger than ! the rank of the return array. ! Generate runtime error if the needed rank of the return ! array is larger than 7. ! If ret->data is null, populate the return array descriptor ! and initialize the variables for the actual operation. ! Otherwise, set ret->dim[0].stride to one if it is zero. ! Change second, independent use of variable dim to srank. ! ! 2005-04-12 Mike Stump ! ! * configure: Regenerate. ! ! 2005-04-13 Thomas Koenig PR libfortran/19106 * m4/iforeach.c (name`'rtype_qual`_'atype_code): Add TODO that setting correct strides is a front end job. (`m'name`'rtype_qual`_'atype_code): Likewise. If mask has *************** *** 647,653 **** that setting correct strides is a front end job. (`m'name`'rtype_qual`_'atype_code): Likewise. If mask has a lowest stride of 0, adjust to 1. ! * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): If retarray->data is NULL (i.e. the front end does not know the rank and dimenson of the array), fill in its properties and allocate memory. --- 2266,2368 ---- that setting correct strides is a front end job. (`m'name`'rtype_qual`_'atype_code): Likewise. If mask has a lowest stride of 0, adjust to 1. ! * maxloc0_4_i4.c: Regenerated ! * maxloc0_4_i8.c: Regenerated ! * maxloc0_4_r4.c: Regenerated ! * maxloc0_4_r8.c: Regenerated ! * maxloc0_8_i4.c: Regenerated ! * maxloc0_8_i8.c: Regenerated ! * maxloc0_8_r4.c: Regenerated ! * maxloc0_8_r8.c: Regenerated ! * maxloc1_4_i4.c: Regenerated ! * maxloc1_4_i8.c: Regenerated ! * maxloc1_4_r4.c: Regenerated ! * maxloc1_4_r8.c: Regenerated ! * maxloc1_8_i4.c: Regenerated ! * maxloc1_8_i8.c: Regenerated ! * maxloc1_8_r4.c: Regenerated ! * maxloc1_8_r8.c: Regenerated ! * maxval_i4.c: Regenerated ! * maxval_i8.c: Regenerated ! * maxval_r4.c: Regenerated ! * maxval_r8.c: Regenerated ! * minloc0_4_i4.c: Regenerated ! * minloc0_4_i8.c: Regenerated ! * minloc0_4_r4.c: Regenerated ! * minloc0_4_r8.c: Regenerated ! * minloc0_8_i4.c: Regenerated ! * minloc0_8_i8.c: Regenerated ! * minloc0_8_r4.c: Regenerated ! * minloc0_8_r8.c: Regenerated ! * minloc1_4_i4.c: Regenerated ! * minloc1_4_i8.c: Regenerated ! * minloc1_4_r4.c: Regenerated ! * minloc1_4_r8.c: Regenerated ! * minloc1_8_i4.c: Regenerated ! * minloc1_8_i8.c: Regenerated ! * minloc1_8_r4.c: Regenerated ! * minloc1_8_r8.c: Regenerated ! * minval_i4.c: Regenerated ! * minval_i8.c: Regenerated ! * minval_r4.c: Regenerated ! * minval_r8.c: Regenerated ! * product_c4.c: Regenerated ! * product_c8.c: Regenerated ! * product_i4.c: Regenerated ! * product_i8.c: Regenerated ! * product_r4.c: Regenerated ! * product_r8.c: Regenerated ! * sum_c4.c: Regenerated ! * sum_c8.c: Regenerated ! * sum_i4.c: Regenerated ! * sum_i8.c: Regenerated ! * sum_r4.c: Regenerated ! * sum_r8.c: Regenerated ! ! 2005-04-10 Francois-Xavier Coudert ! ! PR libfortran/20788 ! * runtime/environ.c (init_unsigned_integer): Function for ! environment variables we want to be positive. ! (init_integer): Function to allow negative environment ! variables (e.g. for GFORTRAN_STDIN_UNIT). ! ! 2005-04-10 Thomas Koenig ! ! PR libfortran/17992 ! PR libfortran/19568 ! PR libfortran/19595 ! PR libfortran/20005 ! PR libfortran/20092 ! PR libfortran/20131 ! PR libfortran/20661 ! PR libfortran/20744 ! * io/transfer.c (top level): eor_condition: New static variable. ! (read_sf): Remove unnecessary zeroing of buffer (there is enough ! information in its length). ! Return a string of length 0 (to be padded by caller) if EOR was ! seen previously. ! Remove erroneous special casing of EOR for standard input. ! Set eor_condition for non-advancing I/O if an end of line was ! detected. ! Increment ioparm.size if necessary. ! (formatted_transfer): Skip the function if there is an EOR condition. ! (data_transfer_init): Initialize eor_condition to zero (false). ! (next_record_r): Clear sf_seen_eor if a \n has been seen already. ! (finalize_transfer): If there is an EOR condition, raise the error. ! ! 2005-04-09 Bud Davis ! Steven G. Kargl ! ! PR fortran/19872 ! * io/transfer.c (data_transfer_init): truncate an existing ! file on the first write. ! ! 2005-04-09 Thomas Koenig ! ! PR libfortran/19106 ! PR libfortran/19014 ! * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto. If retarray->data is NULL (i.e. the front end does not know the rank and dimenson of the array), fill in its properties and allocate memory. *************** *** 719,864 **** * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. ! 2005-05-18 Thomas Koenig ! ! PR libfortran/21127 ! * Makefile.am: Add generated/reshape_c4.c and ! generated/reshape_c8.c. ! * Makefile.in: Regenerated. ! * m4/iparm.m4: Define rtype_ccode to be c4 or c8 for ! complex types, 4 or 8 otherwise. ! * m4/reshape.m4: Use rtype_ccode instead of rtype_kind ! in function name. ! * generated/reshape_c4.c: New file. ! * generated/reshape_c8.c: New file. ! ! 2005-05-15 Andreas Jaeger ! ! * intrinsics/pack_generic.c (pack): Remove unneeded calculation. ! ! * m4/matmull.m4 (matmul_): Remove unneeded calculations, fix ! pointer cast to avoid warning. ! * generated/matmul_l4.c: Regenerated. ! * generated/matmul_l8.c: Regenerated. ! ! * intrinsics/system_clock.c (system_clock_4, system_clock_8): Add ! missing returns, reformat a bit. ! ! * Makefile.am: Remove AM_CFLAGS here. ! * configure.ac: Define AM_CFLAGS and AM_FCFLAGS so that warnings ! are set. Set additionally -Wstrict-prototypes for CFLAGS. ! * Makefile.in: Regenerated. ! * aclocal.m4: Regenerated. ! * configure: Regenerated. ! ! 2005-05-15 Andreas Jaeger ! ! * intrinsics/chdir.c, intrinsics/getlog.c, intrinsics/link.c, ! intrinsics/symlnk.c, intrinsics/perror.c: Include for ! prototypes. ! ! 2005-05-12 Thomas Koenig ! ! PR libfortran/21324 ! * runtime/memory.c: Don't define GFC_CLEAR_MEMORY (it's a ! performance hog). ! * io/open.c (new_unit): Zero freshly allocated memory for ! unit structure. ! * io/unit.c (init_units): Zero freshly allocated memory for ! STDIN, STDOUT and STDERR. ! * io/unix.c (open_internal): Zero freshly allocated memory ! for unix_stream. ! (fd_to_stream): Likewise. ! ! 2005-05-11 Bud Davis ! ! PR fortran/19478 ! * io/unix.c (fd_truncate): update positions when ftruncate ! fails (like writing to /dev/null). ! ! 2005-05-10 Francois-Xavier Coudert ! ! PR libfortran/21471 ! * open.c (new_unit): Take care of the case where POSITION_APPEND ! is specified (sseek to the end, and set u>-endfile). ! ! 2005-05-10 Francois-Xavier Coudert ! ! PR libfortran/20788 ! * io/unix.c (fd_to_stream): Add an avoid_mmap argument indicating ! we don't we to mmap this stream. Use fd_open instead of mmap_open ! in that case. ! (open_external): Call fd_to_stream with avoid_mmap = 0. ! (input_stream): Call fd_to_stream with avoid_mmap = 1. ! (output_stream): Likewise. ! (error_stream): Likewise. ! ! 2005-05-09 Francois-Xavier Coudert ! ! PR libfortran/19155 ! * io/read.c (read_f): Accept 'e', 'E', 'd' and 'D' as first ! non-blank characters of a real number. ! ! 2005-05-06 Thomas Koenig ! ! Backport from mainline: ! PR libfortran/18958 ! libgfortran.h: Change typedef of index_type from size_t ! to ssize_t. ! ! 2005-05-03 Thomas Koenig ! ! Backport from mainline: ! PR libfortran/17992 ! PR libfortran/19568 ! PR libfortran/19595 ! PR libfortran/20005 ! PR libfortran/20092 ! PR libfortran/20131 ! PR libfortran/20661 ! PR libfortran/20744 ! * io/transfer.c (top level): eor_condition: New static variable. ! (read_sf): Remove unnecessary zeroing of buffer (there is enough ! information in its length). ! Return a string of length 0 (to be padded by caller) if EOR was ! seen previously. ! Remove erroneous special casing of EOR for standard input. ! Set eor_condition for non-advancing I/O if an end of line was ! detected. ! Increment ioparm.size if necessary. ! (formatted_transfer): Skip the function if there is an EOR condition. ! (data_transfer_init): Initialize eor_condition to zero (false). ! (next_record_r): Clear sf_seen_eor if a \n has been seen already. ! (finalize_transfer): If there is an EOR condition, raise the error. ! ! 2005-04-29 Francois-Xavier Coudert ! ! * configure.ac: Check for ftruncate and chsize. ! * io/unix.c (fd_truncate): Provide chsize as alternative to ! ftruncate. ! * config.h.in: Regenerate. ! * configure: Regenerate. ! ! 2004-04-28 Tobias Schl"uter ! ! * AUTHORS, COPYING, INSTALL, NEWS, README: Remove. ! ! 2005-04-27 Francois-Xavier Coudert ! ! PR libfortran/20950 ! * io/inquire.c (inquire_via_unit): Check for the gfc_unit being ! NULL when setting ioparm.sequential. ! ! 2005-04-20 Release Manager ! ! * GCC 4.0.0 released. ! ! 2005-04-13 Thomas Koenig PR libfortran/20163 * runtime/string.c (compare0): Use fstrlen() to strip trailing blanks from option string. 2005-04-08 Eric Botcazou --- 2434,2450 ---- * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. ! 2005-04-09 Thomas Koenig PR libfortran/20163 * runtime/string.c (compare0): Use fstrlen() to strip trailing blanks from option string. + 2005-04-09 Andrew Pinski + + PR fortran/13257 + * format.c (parse_format_list): Allow an optional comma + between descriptors. 2005-04-08 Eric Botcazou *************** *** 881,887 **** the scale factor, but it needs to be restored afterwards. 2005-04-03 Dale Ranta ! Francois-Xavier Coudert PR libfortran/20068 PR libfortran/20125 --- 2467,2473 ---- the scale factor, but it needs to be restored afterwards. 2005-04-03 Dale Ranta ! Francois-Xavier Coudert PR libfortran/20068 PR libfortran/20125 *************** *** 923,929 **** descriptor needs a repeat counter set to 1. 2005-02-24 Francois-Xavier Coudert ! * Makefile.in, config.h.in: Regenerate. 2005-02-23 Francois-Xavier Coudert --- 2509,2516 ---- descriptor needs a repeat counter set to 1. 2005-02-24 Francois-Xavier Coudert ! ! * config.h.in: Regenerate. 2005-02-23 Francois-Xavier Coudert *************** *** 935,940 **** --- 2522,2528 ---- * Makefile.am: Added new files. * Makefile.in: Regenerate. + * aclocal.m4: Regenerate. * configure.ac: add checks for signal.h headers file, as well as following functions: chdir, strerror, getlogin, gethostname, kill, link, symlink, perror, sleep, time. *************** *** 945,950 **** --- 2533,2546 ---- intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly implementend g77 intrinsics. + 2005-03-21 Zack Weinberg + + * configure.ac: Do not invoke TL_AC_GCC_VERSION. + In all substitutions, leave gcc_version to be expanded by the Makefile. + * aclocal.m4, configure: Regenerate. + * Makefile.am: Set gcc_version. + * Makefile.in: Regenerate. + 2005-03-16 Francois-Xavier Coudert PR libfortran/20257 *************** *** 965,979 **** the rounding of numbers less than 10^(-width). Fixes typo in an error message. Updates copyright years ! 2005-02-25 Peter O'Gorman ! Toon Moene ! PR libgfortran/17748 ! * runtime/environ.c: Remove references to environ. ! Update copyright years. ! (show_variables): remove GFORTRAN_UNBUFFERED_* and ! GFORTRAN_NAME_* because they require environ. ! (pattern_scan): Remove function. 2005-02-27 Francois-Xavier Coudert --- 2561,2573 ---- the rounding of numbers less than 10^(-width). Fixes typo in an error message. Updates copyright years ! 2005-02-27 Toon Moene ! * runtime/environ.c: Update copyright years. ! ! 2005-02-27 Tobias Schl"uter ! ! * io/write.c: Update copyright years. 2005-02-27 Francois-Xavier Coudert *************** *** 981,997 **** * io/write.c (output_float): Added special check for value 0.0 in PE format. ! 2005-02-27 Tobias Schl"uter * io/write.c (output_float): Fix typo in condition. ! 2005-02-22 Paul Thomas Bud Davis * io/list_read.c (read_real): Handle separators properly in list directed read. ! 2005-02-21 Bud Davis PR fortran/20086 * io/transfer.c (write_constant_string): accept an 'h' as --- 2575,2600 ---- * io/write.c (output_float): Added special check for value 0.0 in PE format. ! 2004-02-27 Tobias Schl"uter * io/write.c (output_float): Fix typo in condition. ! 2005-02-25 Peter O'Gorman ! Toon Moene ! ! PR libgfortran/17748 ! * runtime/environ.c: Remove references to environ. ! (show_variables): remove GFORTRAN_UNBUFFERED_* and ! GFORTRAN_NAME_* because they require environ. ! (pattern_scan): Remove function. ! ! 2004-02-22 Paul Thomas Bud Davis * io/list_read.c (read_real): Handle separators properly in list directed read. ! 2004-02-21 Bud Davis PR fortran/20086 * io/transfer.c (write_constant_string): accept an 'h' as *************** *** 1009,1020 **** 2005-02-20 Steven G. Kargl ! PR 20085 ! * intrinsic/args.c (iargc): Off by 1. 2005-02-19 Steven G. Kargl ! * intrinsic/date_and_time.c: Fix conformance problems. 2005-02-01 Paul Thomas --- 2612,2623 ---- 2005-02-20 Steven G. Kargl ! PR 20085 ! * intrinsic/args.c (iargc): Off by 1. 2005-02-19 Steven G. Kargl ! * intrinsic/date_and_time.c: Fix conformance problems. 2005-02-01 Paul Thomas *************** *** 1422,1428 **** * runtime/error.c (itoa): Same. 2004-12-15 Bud Davis ! Steven G. Kargl PR fortran/17597 * io/list_read.c (read_real): do not push back a comma when --- 3025,3031 ---- * runtime/error.c (itoa): Same. 2004-12-15 Bud Davis ! Steven G. Kargl PR fortran/17597 * io/list_read.c (read_real): do not push back a comma when *************** *** 2153,2159 **** (random_r8): fix infinite loop. 2004-06-12 Bud Davis ! Steve Kargl PR gfortran/15292 * intrinsics/c99_functions.c: New file. --- 3756,3762 ---- (random_r8): fix infinite loop. 2004-06-12 Bud Davis ! Steve Kargl PR gfortran/15292 * intrinsics/c99_functions.c: New file. diff -Nrcpad gcc-4.0.2/libgfortran/Makefile.am gcc-4.1.0/libgfortran/Makefile.am *** gcc-4.0.2/libgfortran/Makefile.am Thu Aug 11 13:53:21 2005 --- gcc-4.1.0/libgfortran/Makefile.am Tue Dec 13 08:18:54 2005 *************** *** 3,8 **** --- 3,11 ---- ACLOCAL_AMFLAGS = -I ../config + ## May be used by toolexeclibdir. + gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER) + toolexeclib_LTLIBRARIES = libgfortran.la libgfortranbegin.la libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` -lm $(extra_ldflags_libgfortran) *************** libgfortranbegin_la_LDFLAGS = -static *** 13,33 **** ## io.h conflicts with some a system header on some platforms, so ## use -iquote ! AM_CPPFLAGS = -iquote$(srcdir)/io ! ! libgfortranincludedir = $(includedir)/gforio gfor_io_src= \ - io/backspace.c \ io/close.c \ ! io/endfile.c \ io/format.c \ io/inquire.c \ io/list_read.c \ io/lock.c \ io/open.c \ io/read.c \ ! io/rewind.c \ io/transfer.c \ io/unit.c \ io/unix.c \ --- 16,35 ---- ## io.h conflicts with some a system header on some platforms, so ## use -iquote ! AM_CPPFLAGS = -iquote$(srcdir)/io -I$(srcdir)/$(MULTISRCTOP)../gcc \ ! -I$(srcdir)/$(MULTISRCTOP)../gcc/config \ ! -I$(MULTIBUILDTOP)../../$(host_subdir)/gcc -D_GNU_SOURCE gfor_io_src= \ io/close.c \ ! io/file_pos.c \ io/format.c \ io/inquire.c \ io/list_read.c \ io/lock.c \ io/open.c \ io/read.c \ ! io/size_from_kind.c \ io/transfer.c \ io/unit.c \ io/unix.c \ *************** intrinsics/c99_functions.c \ *** 45,50 **** --- 47,53 ---- intrinsics/chdir.c \ intrinsics/cpu_time.c \ intrinsics/cshift0.c \ + intrinsics/ctime.c \ intrinsics/date_and_time.c \ intrinsics/env.c \ intrinsics/erf.c \ *************** intrinsics/eoshift0.c \ *** 52,71 **** --- 55,79 ---- intrinsics/eoshift2.c \ intrinsics/etime.c \ intrinsics/exit.c \ + intrinsics/fget.c \ intrinsics/flush.c \ intrinsics/fnum.c \ + intrinsics/ftell.c \ intrinsics/gerror.c \ intrinsics/getcwd.c \ intrinsics/getlog.c \ intrinsics/getXid.c \ + intrinsics/hyper.c \ intrinsics/hostnm.c \ intrinsics/kill.c \ intrinsics/ierrno.c \ intrinsics/ishftc.c \ intrinsics/link.c \ + intrinsics/malloc.c \ intrinsics/mvbits.c \ intrinsics/pack_generic.c \ intrinsics/perror.c \ + intrinsics/signal.c \ intrinsics/size.c \ intrinsics/sleep.c \ intrinsics/spread_generic.c \ *************** gfor_src= \ *** 95,100 **** --- 103,109 ---- runtime/compile_options.c \ runtime/environ.c \ runtime/error.c \ + runtime/fpu.c \ runtime/main.c \ runtime/memory.c \ runtime/pause.c \ *************** libgfortran.h *** 106,286 **** i_all_c= \ generated/all_l4.c \ ! generated/all_l8.c i_any_c= \ generated/any_l4.c \ ! generated/any_l8.c i_count_c= \ generated/count_4_l4.c \ generated/count_8_l4.c \ generated/count_4_l8.c \ ! generated/count_8_l8.c i_maxloc0_c= \ generated/maxloc0_4_i4.c \ generated/maxloc0_8_i4.c \ generated/maxloc0_4_i8.c \ generated/maxloc0_8_i8.c \ generated/maxloc0_4_r4.c \ generated/maxloc0_8_r4.c \ generated/maxloc0_4_r8.c \ ! generated/maxloc0_8_r8.c i_maxloc1_c= \ generated/maxloc1_4_i4.c \ generated/maxloc1_8_i4.c \ generated/maxloc1_4_i8.c \ generated/maxloc1_8_i8.c \ generated/maxloc1_4_r4.c \ generated/maxloc1_8_r4.c \ generated/maxloc1_4_r8.c \ ! generated/maxloc1_8_r8.c i_maxval_c= \ generated/maxval_i4.c \ generated/maxval_i8.c \ generated/maxval_r4.c \ ! generated/maxval_r8.c i_minloc0_c= \ generated/minloc0_4_i4.c \ generated/minloc0_8_i4.c \ generated/minloc0_4_i8.c \ generated/minloc0_8_i8.c \ generated/minloc0_4_r4.c \ generated/minloc0_8_r4.c \ generated/minloc0_4_r8.c \ ! generated/minloc0_8_r8.c i_minloc1_c= \ generated/minloc1_4_i4.c \ generated/minloc1_8_i4.c \ generated/minloc1_4_i8.c \ generated/minloc1_8_i8.c \ generated/minloc1_4_r4.c \ generated/minloc1_8_r4.c \ generated/minloc1_4_r8.c \ ! generated/minloc1_8_r8.c i_minval_c= \ generated/minval_i4.c \ generated/minval_i8.c \ generated/minval_r4.c \ ! generated/minval_r8.c i_sum_c= \ generated/sum_i4.c \ generated/sum_i8.c \ generated/sum_r4.c \ generated/sum_r8.c \ generated/sum_c4.c \ ! generated/sum_c8.c i_product_c= \ generated/product_i4.c \ generated/product_i8.c \ generated/product_r4.c \ generated/product_r8.c \ generated/product_c4.c \ ! generated/product_c8.c i_dotprod_c= \ generated/dotprod_i4.c \ generated/dotprod_i8.c \ generated/dotprod_r4.c \ ! generated/dotprod_r8.c i_dotprodl_c= \ generated/dotprod_l4.c \ ! generated/dotprod_l8.c i_dotprodc_c= \ generated/dotprod_c4.c \ ! generated/dotprod_c8.c i_matmul_c= \ generated/matmul_i4.c \ generated/matmul_i8.c \ generated/matmul_r4.c \ generated/matmul_r8.c \ generated/matmul_c4.c \ ! generated/matmul_c8.c i_matmull_c= \ generated/matmul_l4.c \ ! generated/matmul_l8.c i_transpose_c= \ generated/transpose_i4.c \ generated/transpose_i8.c \ generated/transpose_c4.c \ ! generated/transpose_c8.c i_shape_c= \ generated/shape_i4.c \ ! generated/shape_i8.c i_reshape_c= \ generated/reshape_i4.c \ generated/reshape_i8.c \ generated/reshape_c4.c \ ! generated/reshape_c8.c i_eoshift1_c= \ generated/eoshift1_4.c \ ! generated/eoshift1_8.c i_eoshift3_c= \ generated/eoshift3_4.c \ ! generated/eoshift3_8.c i_cshift1_c= \ generated/cshift1_4.c \ ! generated/cshift1_8.c in_pack_c = \ generated/in_pack_i4.c \ generated/in_pack_i8.c \ generated/in_pack_c4.c \ ! generated/in_pack_c8.c in_unpack_c = \ generated/in_unpack_i4.c \ generated/in_unpack_i8.c \ generated/in_unpack_c4.c \ ! generated/in_unpack_c8.c i_exponent_c = \ generated/exponent_r4.c \ ! generated/exponent_r8.c i_fraction_c = \ generated/fraction_r4.c \ ! generated/fraction_r8.c i_nearest_c = \ generated/nearest_r4.c \ ! generated/nearest_r8.c i_set_exponent_c = \ generated/set_exponent_r4.c \ ! generated/set_exponent_r8.c i_pow_c = \ generated/pow_i4_i4.c \ generated/pow_i8_i4.c \ generated/pow_r4_i4.c \ generated/pow_r8_i4.c \ generated/pow_c4_i4.c \ generated/pow_c8_i4.c \ generated/pow_i4_i8.c \ generated/pow_i8_i8.c \ generated/pow_r4_i8.c \ generated/pow_r8_i8.c \ generated/pow_c4_i8.c \ ! generated/pow_c8_i8.c m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \ m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \ --- 115,427 ---- i_all_c= \ generated/all_l4.c \ ! generated/all_l8.c \ ! generated/all_l16.c i_any_c= \ generated/any_l4.c \ ! generated/any_l8.c \ ! generated/any_l16.c i_count_c= \ generated/count_4_l4.c \ generated/count_8_l4.c \ + generated/count_16_l4.c \ generated/count_4_l8.c \ ! generated/count_8_l8.c \ ! generated/count_16_l8.c \ ! generated/count_4_l16.c \ ! generated/count_8_l16.c \ ! generated/count_16_l16.c i_maxloc0_c= \ generated/maxloc0_4_i4.c \ generated/maxloc0_8_i4.c \ + generated/maxloc0_16_i4.c \ generated/maxloc0_4_i8.c \ generated/maxloc0_8_i8.c \ + generated/maxloc0_16_i8.c \ + generated/maxloc0_4_i16.c \ + generated/maxloc0_8_i16.c \ + generated/maxloc0_16_i16.c \ generated/maxloc0_4_r4.c \ generated/maxloc0_8_r4.c \ + generated/maxloc0_16_r4.c \ generated/maxloc0_4_r8.c \ ! generated/maxloc0_8_r8.c \ ! generated/maxloc0_16_r8.c \ ! generated/maxloc0_4_r10.c \ ! generated/maxloc0_8_r10.c \ ! generated/maxloc0_16_r10.c \ ! generated/maxloc0_4_r16.c \ ! generated/maxloc0_8_r16.c \ ! generated/maxloc0_16_r16.c i_maxloc1_c= \ generated/maxloc1_4_i4.c \ generated/maxloc1_8_i4.c \ + generated/maxloc1_16_i4.c \ generated/maxloc1_4_i8.c \ generated/maxloc1_8_i8.c \ + generated/maxloc1_16_i8.c \ + generated/maxloc1_4_i16.c \ + generated/maxloc1_8_i16.c \ + generated/maxloc1_16_i16.c \ generated/maxloc1_4_r4.c \ generated/maxloc1_8_r4.c \ + generated/maxloc1_16_r4.c \ generated/maxloc1_4_r8.c \ ! generated/maxloc1_8_r8.c \ ! generated/maxloc1_16_r8.c \ ! generated/maxloc1_4_r10.c \ ! generated/maxloc1_8_r10.c \ ! generated/maxloc1_16_r10.c \ ! generated/maxloc1_4_r16.c \ ! generated/maxloc1_8_r16.c \ ! generated/maxloc1_16_r16.c i_maxval_c= \ generated/maxval_i4.c \ generated/maxval_i8.c \ + generated/maxval_i16.c \ generated/maxval_r4.c \ ! generated/maxval_r8.c \ ! generated/maxval_r10.c \ ! generated/maxval_r16.c i_minloc0_c= \ generated/minloc0_4_i4.c \ generated/minloc0_8_i4.c \ + generated/minloc0_16_i4.c \ generated/minloc0_4_i8.c \ generated/minloc0_8_i8.c \ + generated/minloc0_16_i8.c \ + generated/minloc0_4_i16.c \ + generated/minloc0_8_i16.c \ + generated/minloc0_16_i16.c \ generated/minloc0_4_r4.c \ generated/minloc0_8_r4.c \ + generated/minloc0_16_r4.c \ generated/minloc0_4_r8.c \ ! generated/minloc0_8_r8.c \ ! generated/minloc0_16_r8.c \ ! generated/minloc0_4_r10.c \ ! generated/minloc0_8_r10.c \ ! generated/minloc0_16_r10.c \ ! generated/minloc0_4_r16.c \ ! generated/minloc0_8_r16.c \ ! generated/minloc0_16_r16.c i_minloc1_c= \ generated/minloc1_4_i4.c \ generated/minloc1_8_i4.c \ + generated/minloc1_16_i4.c \ generated/minloc1_4_i8.c \ generated/minloc1_8_i8.c \ + generated/minloc1_16_i8.c \ + generated/minloc1_4_i16.c \ + generated/minloc1_8_i16.c \ + generated/minloc1_16_i16.c \ generated/minloc1_4_r4.c \ generated/minloc1_8_r4.c \ + generated/minloc1_16_r4.c \ generated/minloc1_4_r8.c \ ! generated/minloc1_8_r8.c \ ! generated/minloc1_16_r8.c \ ! generated/minloc1_4_r10.c \ ! generated/minloc1_8_r10.c \ ! generated/minloc1_16_r10.c \ ! generated/minloc1_4_r16.c \ ! generated/minloc1_8_r16.c \ ! generated/minloc1_16_r16.c i_minval_c= \ generated/minval_i4.c \ generated/minval_i8.c \ + generated/minval_i16.c \ generated/minval_r4.c \ ! generated/minval_r8.c \ ! generated/minval_r10.c \ ! generated/minval_r16.c i_sum_c= \ generated/sum_i4.c \ generated/sum_i8.c \ + generated/sum_i16.c \ generated/sum_r4.c \ generated/sum_r8.c \ + generated/sum_r10.c \ + generated/sum_r16.c \ generated/sum_c4.c \ ! generated/sum_c8.c \ ! generated/sum_c10.c \ ! generated/sum_c16.c i_product_c= \ generated/product_i4.c \ generated/product_i8.c \ + generated/product_i16.c \ generated/product_r4.c \ generated/product_r8.c \ + generated/product_r10.c \ + generated/product_r16.c \ generated/product_c4.c \ ! generated/product_c8.c \ ! generated/product_c10.c \ ! generated/product_c16.c i_dotprod_c= \ generated/dotprod_i4.c \ generated/dotprod_i8.c \ + generated/dotprod_i16.c \ generated/dotprod_r4.c \ ! generated/dotprod_r8.c \ ! generated/dotprod_r10.c \ ! generated/dotprod_r16.c i_dotprodl_c= \ generated/dotprod_l4.c \ ! generated/dotprod_l8.c \ ! generated/dotprod_l16.c i_dotprodc_c= \ generated/dotprod_c4.c \ ! generated/dotprod_c8.c \ ! generated/dotprod_c10.c \ ! generated/dotprod_c16.c i_matmul_c= \ generated/matmul_i4.c \ generated/matmul_i8.c \ + generated/matmul_i16.c \ generated/matmul_r4.c \ generated/matmul_r8.c \ + generated/matmul_r10.c \ + generated/matmul_r16.c \ generated/matmul_c4.c \ ! generated/matmul_c8.c \ ! generated/matmul_c10.c \ ! generated/matmul_c16.c i_matmull_c= \ generated/matmul_l4.c \ ! generated/matmul_l8.c \ ! generated/matmul_l16.c i_transpose_c= \ generated/transpose_i4.c \ generated/transpose_i8.c \ + generated/transpose_i16.c \ generated/transpose_c4.c \ ! generated/transpose_c8.c \ ! generated/transpose_c10.c \ ! generated/transpose_c16.c i_shape_c= \ generated/shape_i4.c \ ! generated/shape_i8.c \ ! generated/shape_i16.c i_reshape_c= \ generated/reshape_i4.c \ generated/reshape_i8.c \ + generated/reshape_i16.c \ generated/reshape_c4.c \ ! generated/reshape_c8.c \ ! generated/reshape_c10.c \ ! generated/reshape_c16.c i_eoshift1_c= \ generated/eoshift1_4.c \ ! generated/eoshift1_8.c \ ! generated/eoshift1_16.c i_eoshift3_c= \ generated/eoshift3_4.c \ ! generated/eoshift3_8.c \ ! generated/eoshift3_16.c i_cshift1_c= \ generated/cshift1_4.c \ ! generated/cshift1_8.c \ ! generated/cshift1_16.c in_pack_c = \ generated/in_pack_i4.c \ generated/in_pack_i8.c \ + generated/in_pack_i16.c \ generated/in_pack_c4.c \ ! generated/in_pack_c8.c \ ! generated/in_pack_c10.c \ ! generated/in_pack_c16.c in_unpack_c = \ generated/in_unpack_i4.c \ generated/in_unpack_i8.c \ + generated/in_unpack_i16.c \ generated/in_unpack_c4.c \ ! generated/in_unpack_c8.c \ ! generated/in_unpack_c10.c \ ! generated/in_unpack_c16.c i_exponent_c = \ generated/exponent_r4.c \ ! generated/exponent_r8.c \ ! generated/exponent_r10.c \ ! generated/exponent_r16.c i_fraction_c = \ generated/fraction_r4.c \ ! generated/fraction_r8.c \ ! generated/fraction_r10.c \ ! generated/fraction_r16.c i_nearest_c = \ generated/nearest_r4.c \ ! generated/nearest_r8.c \ ! generated/nearest_r10.c \ ! generated/nearest_r16.c i_set_exponent_c = \ generated/set_exponent_r4.c \ ! generated/set_exponent_r8.c \ ! generated/set_exponent_r10.c \ ! generated/set_exponent_r16.c i_pow_c = \ generated/pow_i4_i4.c \ generated/pow_i8_i4.c \ + generated/pow_i16_i4.c \ generated/pow_r4_i4.c \ generated/pow_r8_i4.c \ + generated/pow_r10_i4.c \ + generated/pow_r16_i4.c \ generated/pow_c4_i4.c \ generated/pow_c8_i4.c \ + generated/pow_c10_i4.c \ + generated/pow_c16_i4.c \ generated/pow_i4_i8.c \ generated/pow_i8_i8.c \ + generated/pow_i16_i8.c \ generated/pow_r4_i8.c \ generated/pow_r8_i8.c \ + generated/pow_r10_i8.c \ + generated/pow_r16_i8.c \ generated/pow_c4_i8.c \ ! generated/pow_c8_i8.c \ ! generated/pow_c10_i8.c \ ! generated/pow_c16_i8.c \ ! generated/pow_i4_i16.c \ ! generated/pow_i8_i16.c \ ! generated/pow_i16_i16.c \ ! generated/pow_r4_i16.c \ ! generated/pow_r8_i16.c \ ! generated/pow_r10_i16.c \ ! generated/pow_r16_i16.c \ ! generated/pow_c4_i16.c \ ! generated/pow_c8_i16.c \ ! generated/pow_c10_i16.c \ ! generated/pow_c16_i16.c m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \ m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \ *************** gfor_built_src= $(i_all_c) $(i_any_c) $( *** 298,398 **** $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ $(i_pow_c) \ ! selected_int_kind.inc selected_real_kind.inc ! ! # We only use these if libm doesn't contain complex math functions. ! ! gfor_math_trig_c= \ ! generated/trig_c4.c \ ! generated/trig_c8.c ! gfor_math_exp_c= \ ! generated/exp_c4.c \ ! generated/exp_c8.c ! gfor_math_hyp_c= \ ! generated/hyp_c4.c \ ! generated/hyp_c8.c ! ! gfor_math_trig_obj= \ ! trig_c4.lo \ ! trig_c8.lo ! gfor_math_exp_obj= \ ! exp_c4.lo \ ! exp_c8.lo ! gfor_math_hyp_obj= \ ! hyp_c4.lo \ ! hyp_c8.lo # Machine generated specifics gfor_built_specific_src= \ ! generated/_abs_c4.f90 \ ! generated/_abs_c8.f90 \ ! generated/_abs_i4.f90 \ ! generated/_abs_i8.f90 \ ! generated/_abs_r4.f90 \ ! generated/_abs_r8.f90 \ ! generated/_exp_r4.f90 \ ! generated/_exp_r8.f90 \ ! generated/_exp_c4.f90 \ ! generated/_exp_c8.f90 \ ! generated/_log_r4.f90 \ ! generated/_log_r8.f90 \ ! generated/_log_c4.f90 \ ! generated/_log_c8.f90 \ ! generated/_log10_r4.f90 \ ! generated/_log10_r8.f90 \ ! generated/_sqrt_r4.f90 \ ! generated/_sqrt_r8.f90 \ ! generated/_sqrt_c4.f90 \ ! generated/_sqrt_c8.f90 \ ! generated/_asin_r4.f90 \ ! generated/_asin_r8.f90 \ ! generated/_acos_r4.f90 \ ! generated/_acos_r8.f90 \ ! generated/_atan_r4.f90 \ ! generated/_atan_r8.f90 \ ! generated/_sin_r4.f90 \ ! generated/_sin_r8.f90 \ ! generated/_sin_c4.f90 \ ! generated/_sin_c8.f90 \ ! generated/_cos_r4.f90 \ ! generated/_cos_r8.f90 \ ! generated/_cos_c4.f90 \ ! generated/_cos_c8.f90 \ ! generated/_tan_r4.f90 \ ! generated/_tan_r8.f90 \ ! generated/_sinh_r4.f90 \ ! generated/_sinh_r8.f90 \ ! generated/_cosh_r4.f90 \ ! generated/_cosh_r8.f90 \ ! generated/_tanh_r4.f90 \ ! generated/_tanh_r8.f90 \ ! generated/_conjg_c4.f90 \ ! generated/_conjg_c8.f90 \ ! generated/_aint_r4.f90 \ ! generated/_aint_r8.f90 \ ! generated/_anint_r4.f90 \ ! generated/_anint_r8.f90 gfor_built_specific2_src= \ ! generated/_sign_i4.f90 \ ! generated/_sign_i8.f90 \ ! generated/_sign_r4.f90 \ ! generated/_sign_r8.f90 \ ! generated/_dim_i4.f90 \ ! generated/_dim_i8.f90 \ ! generated/_dim_r4.f90 \ ! generated/_dim_r8.f90 \ ! generated/_atan2_r4.f90 \ ! generated/_atan2_r8.f90 \ ! generated/_mod_i4.f90 \ ! generated/_mod_i8.f90 \ ! generated/_mod_r4.f90 \ ! generated/_mod_r8.f90 ! #specific intrinsics requiring manal code ! #gfor_specific_c= \ ! intrinsics/_aimag.c \ ! intrinsics/_cabs.c \ ! foo gfor_specific_src= \ $(gfor_built_specific_src) \ --- 439,573 ---- $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ $(i_pow_c) \ ! selected_int_kind.inc selected_real_kind.inc kinds.h \ ! kinds.inc c99_protos.inc fpu-target.h # Machine generated specifics gfor_built_specific_src= \ ! generated/_abs_c4.F90 \ ! generated/_abs_c8.F90 \ ! generated/_abs_c10.F90 \ ! generated/_abs_c16.F90 \ ! generated/_abs_i4.F90 \ ! generated/_abs_i8.F90 \ ! generated/_abs_i16.F90 \ ! generated/_abs_r4.F90 \ ! generated/_abs_r8.F90 \ ! generated/_abs_r10.F90 \ ! generated/_abs_r16.F90 \ ! generated/_exp_r4.F90 \ ! generated/_exp_r8.F90 \ ! generated/_exp_r10.F90 \ ! generated/_exp_r16.F90 \ ! generated/_exp_c4.F90 \ ! generated/_exp_c8.F90 \ ! generated/_exp_c10.F90 \ ! generated/_exp_c16.F90 \ ! generated/_log_r4.F90 \ ! generated/_log_r8.F90 \ ! generated/_log_r10.F90 \ ! generated/_log_r16.F90 \ ! generated/_log_c4.F90 \ ! generated/_log_c8.F90 \ ! generated/_log_c10.F90 \ ! generated/_log_c16.F90 \ ! generated/_log10_r4.F90 \ ! generated/_log10_r8.F90 \ ! generated/_log10_r10.F90 \ ! generated/_log10_r16.F90 \ ! generated/_sqrt_r4.F90 \ ! generated/_sqrt_r8.F90 \ ! generated/_sqrt_r10.F90 \ ! generated/_sqrt_r16.F90 \ ! generated/_sqrt_c4.F90 \ ! generated/_sqrt_c8.F90 \ ! generated/_sqrt_c10.F90 \ ! generated/_sqrt_c16.F90 \ ! generated/_asin_r4.F90 \ ! generated/_asin_r8.F90 \ ! generated/_asin_r10.F90 \ ! generated/_asin_r16.F90 \ ! generated/_acos_r4.F90 \ ! generated/_acos_r8.F90 \ ! generated/_acos_r10.F90 \ ! generated/_acos_r16.F90 \ ! generated/_atan_r4.F90 \ ! generated/_atan_r8.F90 \ ! generated/_atan_r10.F90 \ ! generated/_atan_r16.F90 \ ! generated/_sin_r4.F90 \ ! generated/_sin_r8.F90 \ ! generated/_sin_r10.F90 \ ! generated/_sin_r16.F90 \ ! generated/_sin_c4.F90 \ ! generated/_sin_c8.F90 \ ! generated/_sin_c10.F90 \ ! generated/_sin_c16.F90 \ ! generated/_cos_r4.F90 \ ! generated/_cos_r8.F90 \ ! generated/_cos_r10.F90 \ ! generated/_cos_r16.F90 \ ! generated/_cos_c4.F90 \ ! generated/_cos_c8.F90 \ ! generated/_cos_c10.F90 \ ! generated/_cos_c16.F90 \ ! generated/_tan_r4.F90 \ ! generated/_tan_r8.F90 \ ! generated/_tan_r10.F90 \ ! generated/_tan_r16.F90 \ ! generated/_sinh_r4.F90 \ ! generated/_sinh_r8.F90 \ ! generated/_sinh_r10.F90 \ ! generated/_sinh_r16.F90 \ ! generated/_cosh_r4.F90 \ ! generated/_cosh_r8.F90 \ ! generated/_cosh_r10.F90 \ ! generated/_cosh_r16.F90 \ ! generated/_tanh_r4.F90 \ ! generated/_tanh_r8.F90 \ ! generated/_tanh_r10.F90 \ ! generated/_tanh_r16.F90 \ ! generated/_conjg_c4.F90 \ ! generated/_conjg_c8.F90 \ ! generated/_conjg_c10.F90 \ ! generated/_conjg_c16.F90 \ ! generated/_aint_r4.F90 \ ! generated/_aint_r8.F90 \ ! generated/_aint_r10.F90 \ ! generated/_aint_r16.F90 \ ! generated/_anint_r4.F90 \ ! generated/_anint_r8.F90 \ ! generated/_anint_r10.F90 \ ! generated/_anint_r16.F90 gfor_built_specific2_src= \ ! generated/_sign_i4.F90 \ ! generated/_sign_i8.F90 \ ! generated/_sign_i16.F90 \ ! generated/_sign_r4.F90 \ ! generated/_sign_r8.F90 \ ! generated/_sign_r10.F90 \ ! generated/_sign_r16.F90 \ ! generated/_dim_i4.F90 \ ! generated/_dim_i8.F90 \ ! generated/_dim_i16.F90 \ ! generated/_dim_r4.F90 \ ! generated/_dim_r8.F90 \ ! generated/_dim_r10.F90 \ ! generated/_dim_r16.F90 \ ! generated/_atan2_r4.F90 \ ! generated/_atan2_r8.F90 \ ! generated/_atan2_r10.F90 \ ! generated/_atan2_r16.F90 \ ! generated/_mod_i4.F90 \ ! generated/_mod_i8.F90 \ ! generated/_mod_i16.F90 \ ! generated/_mod_r4.F90 \ ! generated/_mod_r8.F90 ! # There are commented out due to a bug in the way the front-end ! # handles MOD ! #generated/_mod_r10.F90 ! #generated/_mod_r16.F90 gfor_specific_src= \ $(gfor_built_specific_src) \ *************** $(gfor_built_specific2_src) \ *** 400,428 **** intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 ! gfor_cmath_src= $(gfor_math_trig_c) $(gfor_math_exp_c) $(gfor_math_hyp_c) ! gfor_cmath_obj= $(gfor_math_trig_obj) $(gfor_math_exp_obj) \ ! $(gfor_math_hyp_obj) ! BUILT_SOURCES=$(gfor_built_src) $(gfor_cmath_src) $(gfor_built_specific_src) \ $(gfor_built_specific2_src) libgfortran_la_SOURCES = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ $(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src) - EXTRA_libgfortran_la_SOURCES = $(gfor_cmath_src) - - libgfortran_la_LIBADD = @MATH_OBJ@ - libgfortran_la_DEPENDENCIES = @MATH_OBJ@ - I_M4_DEPS=m4/iparm.m4 I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4 I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4 selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh ! $(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh ! $(SHELL) $(srcdir)/mk-srk-inc.sh '$(FCCOMPILE)' > $@ ## A 'normal' build shouldn't need to regenerate these ## so we only include them in maintainer mode --- 575,609 ---- intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 ! # Turn on vectorization for matmul. ! $(patsubst %.c,%.lo,$(notdir $(i_matmul_c))): AM_CFLAGS += -ftree-vectorize ! BUILT_SOURCES=$(gfor_built_src) $(gfor_built_specific_src) \ $(gfor_built_specific2_src) libgfortran_la_SOURCES = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ $(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src) I_M4_DEPS=m4/iparm.m4 I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4 I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4 + kinds.h: $(srcdir)/mk-kinds-h.sh + $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@ + + kinds.inc: kinds.h + grep '^#' < kinds.h > $@ + + c99_protos.inc: $(srcdir)/c99_protos.h + grep '^#' < $(srcdir)/c99_protos.h > $@ + selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh ! $(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@ || rm $@ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh ! $(SHELL) $(srcdir)/mk-srk-inc.sh '$(FCCOMPILE)' > $@ || rm $@ ! ! fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER) ! cp $(srcdir)/$(FPU_HOST_HEADER) $@ ## A 'normal' build shouldn't need to regenerate these ## so we only include them in maintainer mode *************** $(i_set_exponent_c): m4/set_exponent.m4 *** 515,529 **** $(i_pow_c): m4/pow.m4 $(I_M4_DEPS) m4 -Dfile=$@ -I$(srcdir)/m4 pow.m4 > $(srcdir)/$@ - $(gfor_math_trig_c): m4/ctrig.m4 m4/mtype.m4 - m4 -Dfile=$@ -I$(srcdir)/m4 ctrig.m4 > $(srcdir)/$@ - - $(gfor_math_exp_c): m4/cexp.m4 m4/mtype.m4 - m4 -Dfile=$@ -I$(srcdir)/m4 cexp.m4 > $(srcdir)/$@ - - $(gfor_math_hyp_c): m4/chyp.m4 m4/mtype.m4 - m4 -Dfile=$@ -I$(srcdir)/m4 chyp.m4 > $(srcdir)/$@ - $(gfor_built_specific_src): m4/specific.m4 m4/head.m4 m4 -Dfile=$@ -I$(srcdir)/m4 specific.m4 > $(srcdir)/$@ --- 696,701 ---- diff -Nrcpad gcc-4.0.2/libgfortran/Makefile.in gcc-4.1.0/libgfortran/Makefile.in *** gcc-4.0.2/libgfortran/Makefile.in Wed Sep 28 06:16:38 2005 --- gcc-4.1.0/libgfortran/Makefile.in Tue Feb 28 08:39:11 2006 *************** *** 1,8 **** ! # Makefile.in generated by automake 1.9.4 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, ! # 2003, 2004 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. --- 1,8 ---- ! # Makefile.in generated by automake 1.9.6 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, ! # 2003, 2004, 2005 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. *************** *** 14,21 **** @SET_MAKE@ - SOURCES = $(libgfortran_la_SOURCES) $(EXTRA_libgfortran_la_SOURCES) $(libgfortranbegin_la_SOURCES) - srcdir = @srcdir@ top_srcdir = @top_srcdir@ VPATH = @srcdir@ --- 14,19 ---- *************** DIST_COMMON = $(am__configure_deps) $(sr *** 47,56 **** $(top_srcdir)/configure ChangeLog subdir = . ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 ! am__aclocal_m4_deps = $(top_srcdir)/../config/gcc-version.m4 \ $(top_srcdir)/../config/no-executables.m4 \ ! $(top_srcdir)/acinclude.m4 $(top_srcdir)/../libtool.m4 \ ! $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ --- 45,54 ---- $(top_srcdir)/configure ChangeLog subdir = . ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 ! am__aclocal_m4_deps = $(top_srcdir)/../config/lead-dot.m4 \ ! $(top_srcdir)/acinclude.m4 $(top_srcdir)/../config/acx.m4 \ $(top_srcdir)/../config/no-executables.m4 \ ! $(top_srcdir)/../libtool.m4 $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ *************** am__strip_dir = `echo $$p | sed -e 's|^. *** 67,122 **** am__installdirs = "$(DESTDIR)$(toolexeclibdir)" toolexeclibLTLIBRARIES_INSTALL = $(INSTALL) LTLIBRARIES = $(toolexeclib_LTLIBRARIES) ! am__objects_1 = compile_options.lo environ.lo error.lo main.lo \ memory.lo pause.lo stop.lo string.lo select.lo ! am__objects_2 = all_l4.lo all_l8.lo ! am__objects_3 = any_l4.lo any_l8.lo ! am__objects_4 = count_4_l4.lo count_8_l4.lo count_4_l8.lo \ ! count_8_l8.lo ! am__objects_5 = maxloc0_4_i4.lo maxloc0_8_i4.lo maxloc0_4_i8.lo \ ! maxloc0_8_i8.lo maxloc0_4_r4.lo maxloc0_8_r4.lo \ ! maxloc0_4_r8.lo maxloc0_8_r8.lo ! am__objects_6 = maxloc1_4_i4.lo maxloc1_8_i4.lo maxloc1_4_i8.lo \ ! maxloc1_8_i8.lo maxloc1_4_r4.lo maxloc1_8_r4.lo \ ! maxloc1_4_r8.lo maxloc1_8_r8.lo ! am__objects_7 = maxval_i4.lo maxval_i8.lo maxval_r4.lo maxval_r8.lo ! am__objects_8 = minloc0_4_i4.lo minloc0_8_i4.lo minloc0_4_i8.lo \ ! minloc0_8_i8.lo minloc0_4_r4.lo minloc0_8_r4.lo \ ! minloc0_4_r8.lo minloc0_8_r8.lo ! am__objects_9 = minloc1_4_i4.lo minloc1_8_i4.lo minloc1_4_i8.lo \ ! minloc1_8_i8.lo minloc1_4_r4.lo minloc1_8_r4.lo \ ! minloc1_4_r8.lo minloc1_8_r8.lo ! am__objects_10 = minval_i4.lo minval_i8.lo minval_r4.lo minval_r8.lo ! am__objects_11 = product_i4.lo product_i8.lo product_r4.lo \ ! product_r8.lo product_c4.lo product_c8.lo ! am__objects_12 = sum_i4.lo sum_i8.lo sum_r4.lo sum_r8.lo sum_c4.lo \ ! sum_c8.lo ! am__objects_13 = dotprod_i4.lo dotprod_i8.lo dotprod_r4.lo \ ! dotprod_r8.lo ! am__objects_14 = dotprod_l4.lo dotprod_l8.lo ! am__objects_15 = dotprod_c4.lo dotprod_c8.lo ! am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_r4.lo matmul_r8.lo \ ! matmul_c4.lo matmul_c8.lo ! am__objects_17 = matmul_l4.lo matmul_l8.lo ! am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_c4.lo \ ! transpose_c8.lo ! am__objects_19 = shape_i4.lo shape_i8.lo ! am__objects_20 = eoshift1_4.lo eoshift1_8.lo ! am__objects_21 = eoshift3_4.lo eoshift3_8.lo ! am__objects_22 = cshift1_4.lo cshift1_8.lo ! am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_c4.lo \ ! reshape_c8.lo ! am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_c4.lo \ ! in_pack_c8.lo ! am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_c4.lo \ ! in_unpack_c8.lo ! am__objects_26 = exponent_r4.lo exponent_r8.lo ! am__objects_27 = fraction_r4.lo fraction_r8.lo ! am__objects_28 = nearest_r4.lo nearest_r8.lo ! am__objects_29 = set_exponent_r4.lo set_exponent_r8.lo ! am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_r4_i4.lo pow_r8_i4.lo \ ! pow_c4_i4.lo pow_c8_i4.lo pow_i4_i8.lo pow_i8_i8.lo \ ! pow_r4_i8.lo pow_r8_i8.lo pow_c4_i8.lo pow_c8_i8.lo am__objects_31 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \ $(am__objects_5) $(am__objects_6) $(am__objects_7) \ $(am__objects_8) $(am__objects_9) $(am__objects_10) \ --- 65,156 ---- am__installdirs = "$(DESTDIR)$(toolexeclibdir)" toolexeclibLTLIBRARIES_INSTALL = $(INSTALL) LTLIBRARIES = $(toolexeclib_LTLIBRARIES) ! libgfortran_la_LIBADD = ! am__objects_1 = compile_options.lo environ.lo error.lo fpu.lo main.lo \ memory.lo pause.lo stop.lo string.lo select.lo ! am__objects_2 = all_l4.lo all_l8.lo all_l16.lo ! am__objects_3 = any_l4.lo any_l8.lo any_l16.lo ! am__objects_4 = count_4_l4.lo count_8_l4.lo count_16_l4.lo \ ! count_4_l8.lo count_8_l8.lo count_16_l8.lo count_4_l16.lo \ ! count_8_l16.lo count_16_l16.lo ! am__objects_5 = maxloc0_4_i4.lo maxloc0_8_i4.lo maxloc0_16_i4.lo \ ! maxloc0_4_i8.lo maxloc0_8_i8.lo maxloc0_16_i8.lo \ ! maxloc0_4_i16.lo maxloc0_8_i16.lo maxloc0_16_i16.lo \ ! maxloc0_4_r4.lo maxloc0_8_r4.lo maxloc0_16_r4.lo \ ! maxloc0_4_r8.lo maxloc0_8_r8.lo maxloc0_16_r8.lo \ ! maxloc0_4_r10.lo maxloc0_8_r10.lo maxloc0_16_r10.lo \ ! maxloc0_4_r16.lo maxloc0_8_r16.lo maxloc0_16_r16.lo ! am__objects_6 = maxloc1_4_i4.lo maxloc1_8_i4.lo maxloc1_16_i4.lo \ ! maxloc1_4_i8.lo maxloc1_8_i8.lo maxloc1_16_i8.lo \ ! maxloc1_4_i16.lo maxloc1_8_i16.lo maxloc1_16_i16.lo \ ! maxloc1_4_r4.lo maxloc1_8_r4.lo maxloc1_16_r4.lo \ ! maxloc1_4_r8.lo maxloc1_8_r8.lo maxloc1_16_r8.lo \ ! maxloc1_4_r10.lo maxloc1_8_r10.lo maxloc1_16_r10.lo \ ! maxloc1_4_r16.lo maxloc1_8_r16.lo maxloc1_16_r16.lo ! am__objects_7 = maxval_i4.lo maxval_i8.lo maxval_i16.lo maxval_r4.lo \ ! maxval_r8.lo maxval_r10.lo maxval_r16.lo ! am__objects_8 = minloc0_4_i4.lo minloc0_8_i4.lo minloc0_16_i4.lo \ ! minloc0_4_i8.lo minloc0_8_i8.lo minloc0_16_i8.lo \ ! minloc0_4_i16.lo minloc0_8_i16.lo minloc0_16_i16.lo \ ! minloc0_4_r4.lo minloc0_8_r4.lo minloc0_16_r4.lo \ ! minloc0_4_r8.lo minloc0_8_r8.lo minloc0_16_r8.lo \ ! minloc0_4_r10.lo minloc0_8_r10.lo minloc0_16_r10.lo \ ! minloc0_4_r16.lo minloc0_8_r16.lo minloc0_16_r16.lo ! am__objects_9 = minloc1_4_i4.lo minloc1_8_i4.lo minloc1_16_i4.lo \ ! minloc1_4_i8.lo minloc1_8_i8.lo minloc1_16_i8.lo \ ! minloc1_4_i16.lo minloc1_8_i16.lo minloc1_16_i16.lo \ ! minloc1_4_r4.lo minloc1_8_r4.lo minloc1_16_r4.lo \ ! minloc1_4_r8.lo minloc1_8_r8.lo minloc1_16_r8.lo \ ! minloc1_4_r10.lo minloc1_8_r10.lo minloc1_16_r10.lo \ ! minloc1_4_r16.lo minloc1_8_r16.lo minloc1_16_r16.lo ! am__objects_10 = minval_i4.lo minval_i8.lo minval_i16.lo minval_r4.lo \ ! minval_r8.lo minval_r10.lo minval_r16.lo ! am__objects_11 = product_i4.lo product_i8.lo product_i16.lo \ ! product_r4.lo product_r8.lo product_r10.lo product_r16.lo \ ! product_c4.lo product_c8.lo product_c10.lo product_c16.lo ! am__objects_12 = sum_i4.lo sum_i8.lo sum_i16.lo sum_r4.lo sum_r8.lo \ ! sum_r10.lo sum_r16.lo sum_c4.lo sum_c8.lo sum_c10.lo \ ! sum_c16.lo ! am__objects_13 = dotprod_i4.lo dotprod_i8.lo dotprod_i16.lo \ ! dotprod_r4.lo dotprod_r8.lo dotprod_r10.lo dotprod_r16.lo ! am__objects_14 = dotprod_l4.lo dotprod_l8.lo dotprod_l16.lo ! am__objects_15 = dotprod_c4.lo dotprod_c8.lo dotprod_c10.lo \ ! dotprod_c16.lo ! am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_i16.lo matmul_r4.lo \ ! matmul_r8.lo matmul_r10.lo matmul_r16.lo matmul_c4.lo \ ! matmul_c8.lo matmul_c10.lo matmul_c16.lo ! am__objects_17 = matmul_l4.lo matmul_l8.lo matmul_l16.lo ! am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \ ! transpose_c4.lo transpose_c8.lo transpose_c10.lo \ ! transpose_c16.lo ! am__objects_19 = shape_i4.lo shape_i8.lo shape_i16.lo ! am__objects_20 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo ! am__objects_21 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo ! am__objects_22 = cshift1_4.lo cshift1_8.lo cshift1_16.lo ! am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \ ! reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo ! am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_i16.lo \ ! in_pack_c4.lo in_pack_c8.lo in_pack_c10.lo in_pack_c16.lo ! am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_i16.lo \ ! in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \ ! in_unpack_c16.lo ! am__objects_26 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \ ! exponent_r16.lo ! am__objects_27 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \ ! fraction_r16.lo ! am__objects_28 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \ ! nearest_r16.lo ! am__objects_29 = set_exponent_r4.lo set_exponent_r8.lo \ ! set_exponent_r10.lo set_exponent_r16.lo ! am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_r4_i4.lo \ ! pow_r8_i4.lo pow_r10_i4.lo pow_r16_i4.lo pow_c4_i4.lo \ ! pow_c8_i4.lo pow_c10_i4.lo pow_c16_i4.lo pow_i4_i8.lo \ ! pow_i8_i8.lo pow_i16_i8.lo pow_r4_i8.lo pow_r8_i8.lo \ ! pow_r10_i8.lo pow_r16_i8.lo pow_c4_i8.lo pow_c8_i8.lo \ ! pow_c10_i8.lo pow_c16_i8.lo pow_i4_i16.lo pow_i8_i16.lo \ ! pow_i16_i16.lo pow_r4_i16.lo pow_r8_i16.lo pow_r10_i16.lo \ ! pow_r16_i16.lo pow_c4_i16.lo pow_c8_i16.lo pow_c10_i16.lo \ ! pow_c16_i16.lo am__objects_31 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \ $(am__objects_5) $(am__objects_6) $(am__objects_7) \ $(am__objects_8) $(am__objects_9) $(am__objects_10) \ *************** am__objects_31 = $(am__objects_2) $(am__ *** 127,141 **** $(am__objects_23) $(am__objects_24) $(am__objects_25) \ $(am__objects_26) $(am__objects_27) $(am__objects_28) \ $(am__objects_29) $(am__objects_30) ! am__objects_32 = backspace.lo close.lo endfile.lo format.lo inquire.lo \ ! list_read.lo lock.lo open.lo read.lo rewind.lo transfer.lo \ ! unit.lo unix.lo write.lo am__objects_33 = associated.lo abort.lo args.lo bessel.lo \ ! c99_functions.lo chdir.lo cpu_time.lo cshift0.lo \ date_and_time.lo env.lo erf.lo eoshift0.lo eoshift2.lo \ ! etime.lo exit.lo flush.lo fnum.lo gerror.lo getcwd.lo \ ! getlog.lo getXid.lo hostnm.lo kill.lo ierrno.lo ishftc.lo \ ! link.lo mvbits.lo pack_generic.lo perror.lo size.lo sleep.lo \ spread_generic.lo string_intrinsics.lo system.lo rand.lo \ random.lo rename.lo reshape_generic.lo reshape_packed.lo \ selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \ --- 161,176 ---- $(am__objects_23) $(am__objects_24) $(am__objects_25) \ $(am__objects_26) $(am__objects_27) $(am__objects_28) \ $(am__objects_29) $(am__objects_30) ! am__objects_32 = close.lo file_pos.lo format.lo inquire.lo \ ! list_read.lo lock.lo open.lo read.lo size_from_kind.lo \ ! transfer.lo unit.lo unix.lo write.lo am__objects_33 = associated.lo abort.lo args.lo bessel.lo \ ! c99_functions.lo chdir.lo cpu_time.lo cshift0.lo ctime.lo \ date_and_time.lo env.lo erf.lo eoshift0.lo eoshift2.lo \ ! etime.lo exit.lo fget.lo flush.lo fnum.lo ftell.lo gerror.lo \ ! getcwd.lo getlog.lo getXid.lo hyper.lo hostnm.lo kill.lo \ ! ierrno.lo ishftc.lo link.lo malloc.lo mvbits.lo \ ! pack_generic.lo perror.lo signal.lo size.lo sleep.lo \ spread_generic.lo string_intrinsics.lo system.lo rand.lo \ random.lo rename.lo reshape_generic.lo reshape_packed.lo \ selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \ *************** am__objects_33 = associated.lo abort.lo *** 143,161 **** unlink.lo unpack_generic.lo in_pack_generic.lo \ in_unpack_generic.lo normalize.lo am__objects_34 = ! am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \ ! _abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \ ! _exp_c8.lo _log_r4.lo _log_r8.lo _log_c4.lo _log_c8.lo \ ! _log10_r4.lo _log10_r8.lo _sqrt_r4.lo _sqrt_r8.lo _sqrt_c4.lo \ ! _sqrt_c8.lo _asin_r4.lo _asin_r8.lo _acos_r4.lo _acos_r8.lo \ ! _atan_r4.lo _atan_r8.lo _sin_r4.lo _sin_r8.lo _sin_c4.lo \ ! _sin_c8.lo _cos_r4.lo _cos_r8.lo _cos_c4.lo _cos_c8.lo \ ! _tan_r4.lo _tan_r8.lo _sinh_r4.lo _sinh_r8.lo _cosh_r4.lo \ ! _cosh_r8.lo _tanh_r4.lo _tanh_r8.lo _conjg_c4.lo _conjg_c8.lo \ ! _aint_r4.lo _aint_r8.lo _anint_r4.lo _anint_r8.lo ! am__objects_36 = _sign_i4.lo _sign_i8.lo _sign_r4.lo _sign_r8.lo \ ! _dim_i4.lo _dim_i8.lo _dim_r4.lo _dim_r8.lo _atan2_r4.lo \ ! _atan2_r8.lo _mod_i4.lo _mod_i8.lo _mod_r4.lo _mod_r8.lo am__objects_37 = $(am__objects_35) $(am__objects_36) dprod_r8.lo \ f2c_specifics.lo am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_31) \ --- 178,208 ---- unlink.lo unpack_generic.lo in_pack_generic.lo \ in_unpack_generic.lo normalize.lo am__objects_34 = ! am__objects_35 = _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 \ ! _abs_r10.lo _abs_r16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \ ! _exp_r16.lo _exp_c4.lo _exp_c8.lo _exp_c10.lo _exp_c16.lo \ ! _log_r4.lo _log_r8.lo _log_r10.lo _log_r16.lo _log_c4.lo \ ! _log_c8.lo _log_c10.lo _log_c16.lo _log10_r4.lo _log10_r8.lo \ ! _log10_r10.lo _log10_r16.lo _sqrt_r4.lo _sqrt_r8.lo \ ! _sqrt_r10.lo _sqrt_r16.lo _sqrt_c4.lo _sqrt_c8.lo _sqrt_c10.lo \ ! _sqrt_c16.lo _asin_r4.lo _asin_r8.lo _asin_r10.lo _asin_r16.lo \ ! _acos_r4.lo _acos_r8.lo _acos_r10.lo _acos_r16.lo _atan_r4.lo \ ! _atan_r8.lo _atan_r10.lo _atan_r16.lo _sin_r4.lo _sin_r8.lo \ ! _sin_r10.lo _sin_r16.lo _sin_c4.lo _sin_c8.lo _sin_c10.lo \ ! _sin_c16.lo _cos_r4.lo _cos_r8.lo _cos_r10.lo _cos_r16.lo \ ! _cos_c4.lo _cos_c8.lo _cos_c10.lo _cos_c16.lo _tan_r4.lo \ ! _tan_r8.lo _tan_r10.lo _tan_r16.lo _sinh_r4.lo _sinh_r8.lo \ ! _sinh_r10.lo _sinh_r16.lo _cosh_r4.lo _cosh_r8.lo _cosh_r10.lo \ ! _cosh_r16.lo _tanh_r4.lo _tanh_r8.lo _tanh_r10.lo _tanh_r16.lo \ ! _conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \ ! _aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \ ! _anint_r8.lo _anint_r10.lo _anint_r16.lo ! am__objects_36 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \ ! _sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \ ! _dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \ ! _atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \ ! _mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo am__objects_37 = $(am__objects_35) $(am__objects_36) dprod_r8.lo \ f2c_specifics.lo am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_31) \ *************** LTPPFCCOMPILE = $(LIBTOOL) --mode=compil *** 174,180 **** $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ $(AM_FCFLAGS) $(FCFLAGS) FCLD = $(FC) ! FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FFLAGS) $(FCFLAGS) \ $(AM_LDFLAGS) $(LDFLAGS) -o $@ COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) --- 221,227 ---- $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ $(AM_FCFLAGS) $(FCFLAGS) FCLD = $(FC) ! FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(AM_LDFLAGS) $(LDFLAGS) -o $@ COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) *************** LINK = $(LIBTOOL) --mode=link $(CCLD) $( *** 186,195 **** $(AM_LDFLAGS) $(LDFLAGS) -o $@ FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) LTFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) ! SOURCES = $(libgfortran_la_SOURCES) $(EXTRA_libgfortran_la_SOURCES) \ ! $(libgfortranbegin_la_SOURCES) DIST_SOURCES = $(libgfortran_la_SOURCES) \ ! $(EXTRA_libgfortran_la_SOURCES) $(libgfortranbegin_la_SOURCES) MULTISRCTOP = MULTIBUILDTOP = MULTIDIRS = --- 233,241 ---- $(AM_LDFLAGS) $(LDFLAGS) -o $@ FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) LTFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) ! SOURCES = $(libgfortran_la_SOURCES) $(libgfortranbegin_la_SOURCES) DIST_SOURCES = $(libgfortran_la_SOURCES) \ ! $(libgfortranbegin_la_SOURCES) MULTISRCTOP = MULTIBUILDTOP = MULTIDIRS = *************** EGREP = @EGREP@ *** 231,236 **** --- 277,283 ---- EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ + FPU_HOST_HEADER = @FPU_HOST_HEADER@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ *************** MAINT = @MAINT@ *** 245,251 **** MAINTAINER_MODE_FALSE = @MAINTAINER_MODE_FALSE@ MAINTAINER_MODE_TRUE = @MAINTAINER_MODE_TRUE@ MAKEINFO = @MAKEINFO@ - MATH_OBJ = @MATH_OBJ@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ --- 292,297 ---- *************** build = @build@ *** 273,291 **** build_alias = @build_alias@ build_cpu = @build_cpu@ build_os = @build_os@ build_vendor = @build_vendor@ datadir = @datadir@ enable_shared = @enable_shared@ enable_static = @enable_static@ exec_prefix = @exec_prefix@ extra_ldflags_libgfortran = @extra_ldflags_libgfortran@ - gcc_version = @gcc_version@ - gcc_version_full = @gcc_version_full@ - gcc_version_trigger = @gcc_version_trigger@ host = @host@ host_alias = @host_alias@ host_cpu = @host_cpu@ host_os = @host_os@ host_vendor = @host_vendor@ includedir = @includedir@ infodir = @infodir@ --- 319,336 ---- build_alias = @build_alias@ build_cpu = @build_cpu@ build_os = @build_os@ + build_subdir = @build_subdir@ build_vendor = @build_vendor@ datadir = @datadir@ enable_shared = @enable_shared@ enable_static = @enable_static@ exec_prefix = @exec_prefix@ extra_ldflags_libgfortran = @extra_ldflags_libgfortran@ host = @host@ host_alias = @host_alias@ host_cpu = @host_cpu@ host_os = @host_os@ + host_subdir = @host_subdir@ host_vendor = @host_vendor@ includedir = @includedir@ infodir = @infodir@ *************** target = @target@ *** 306,332 **** target_alias = @target_alias@ target_cpu = @target_cpu@ target_os = @target_os@ target_vendor = @target_vendor@ toolexecdir = @toolexecdir@ toolexeclibdir = @toolexeclibdir@ ACLOCAL_AMFLAGS = -I ../config toolexeclib_LTLIBRARIES = libgfortran.la libgfortranbegin.la libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` -lm $(extra_ldflags_libgfortran) libgfortranbegin_la_SOURCES = fmain.c libgfortranbegin_la_LDFLAGS = -static ! AM_CPPFLAGS = -iquote$(srcdir)/io ! libgfortranincludedir = $(includedir)/gforio gfor_io_src = \ - io/backspace.c \ io/close.c \ ! io/endfile.c \ io/format.c \ io/inquire.c \ io/list_read.c \ io/lock.c \ io/open.c \ io/read.c \ ! io/rewind.c \ io/transfer.c \ io/unit.c \ io/unix.c \ --- 351,380 ---- target_alias = @target_alias@ target_cpu = @target_cpu@ target_os = @target_os@ + target_subdir = @target_subdir@ target_vendor = @target_vendor@ toolexecdir = @toolexecdir@ toolexeclibdir = @toolexeclibdir@ ACLOCAL_AMFLAGS = -I ../config + gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER) toolexeclib_LTLIBRARIES = libgfortran.la libgfortranbegin.la libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` -lm $(extra_ldflags_libgfortran) libgfortranbegin_la_SOURCES = fmain.c libgfortranbegin_la_LDFLAGS = -static ! AM_CPPFLAGS = -iquote$(srcdir)/io -I$(srcdir)/$(MULTISRCTOP)../gcc \ ! -I$(srcdir)/$(MULTISRCTOP)../gcc/config \ ! -I$(MULTIBUILDTOP)../../$(host_subdir)/gcc -D_GNU_SOURCE ! gfor_io_src = \ io/close.c \ ! io/file_pos.c \ io/format.c \ io/inquire.c \ io/list_read.c \ io/lock.c \ io/open.c \ io/read.c \ ! io/size_from_kind.c \ io/transfer.c \ io/unit.c \ io/unix.c \ *************** intrinsics/c99_functions.c \ *** 344,349 **** --- 392,398 ---- intrinsics/chdir.c \ intrinsics/cpu_time.c \ intrinsics/cshift0.c \ + intrinsics/ctime.c \ intrinsics/date_and_time.c \ intrinsics/env.c \ intrinsics/erf.c \ *************** intrinsics/eoshift0.c \ *** 351,370 **** --- 400,424 ---- intrinsics/eoshift2.c \ intrinsics/etime.c \ intrinsics/exit.c \ + intrinsics/fget.c \ intrinsics/flush.c \ intrinsics/fnum.c \ + intrinsics/ftell.c \ intrinsics/gerror.c \ intrinsics/getcwd.c \ intrinsics/getlog.c \ intrinsics/getXid.c \ + intrinsics/hyper.c \ intrinsics/hostnm.c \ intrinsics/kill.c \ intrinsics/ierrno.c \ intrinsics/ishftc.c \ intrinsics/link.c \ + intrinsics/malloc.c \ intrinsics/mvbits.c \ intrinsics/pack_generic.c \ intrinsics/perror.c \ + intrinsics/signal.c \ intrinsics/size.c \ intrinsics/sleep.c \ intrinsics/spread_generic.c \ *************** gfor_src = \ *** 394,399 **** --- 448,454 ---- runtime/compile_options.c \ runtime/environ.c \ runtime/error.c \ + runtime/fpu.c \ runtime/main.c \ runtime/memory.c \ runtime/pause.c \ *************** libgfortran.h *** 405,585 **** i_all_c = \ generated/all_l4.c \ ! generated/all_l8.c i_any_c = \ generated/any_l4.c \ ! generated/any_l8.c i_count_c = \ generated/count_4_l4.c \ generated/count_8_l4.c \ generated/count_4_l8.c \ ! generated/count_8_l8.c i_maxloc0_c = \ generated/maxloc0_4_i4.c \ generated/maxloc0_8_i4.c \ generated/maxloc0_4_i8.c \ generated/maxloc0_8_i8.c \ generated/maxloc0_4_r4.c \ generated/maxloc0_8_r4.c \ generated/maxloc0_4_r8.c \ ! generated/maxloc0_8_r8.c i_maxloc1_c = \ generated/maxloc1_4_i4.c \ generated/maxloc1_8_i4.c \ generated/maxloc1_4_i8.c \ generated/maxloc1_8_i8.c \ generated/maxloc1_4_r4.c \ generated/maxloc1_8_r4.c \ generated/maxloc1_4_r8.c \ ! generated/maxloc1_8_r8.c i_maxval_c = \ generated/maxval_i4.c \ generated/maxval_i8.c \ generated/maxval_r4.c \ ! generated/maxval_r8.c i_minloc0_c = \ generated/minloc0_4_i4.c \ generated/minloc0_8_i4.c \ generated/minloc0_4_i8.c \ generated/minloc0_8_i8.c \ generated/minloc0_4_r4.c \ generated/minloc0_8_r4.c \ generated/minloc0_4_r8.c \ ! generated/minloc0_8_r8.c i_minloc1_c = \ generated/minloc1_4_i4.c \ generated/minloc1_8_i4.c \ generated/minloc1_4_i8.c \ generated/minloc1_8_i8.c \ generated/minloc1_4_r4.c \ generated/minloc1_8_r4.c \ generated/minloc1_4_r8.c \ ! generated/minloc1_8_r8.c i_minval_c = \ generated/minval_i4.c \ generated/minval_i8.c \ generated/minval_r4.c \ ! generated/minval_r8.c i_sum_c = \ generated/sum_i4.c \ generated/sum_i8.c \ generated/sum_r4.c \ generated/sum_r8.c \ generated/sum_c4.c \ ! generated/sum_c8.c i_product_c = \ generated/product_i4.c \ generated/product_i8.c \ generated/product_r4.c \ generated/product_r8.c \ generated/product_c4.c \ ! generated/product_c8.c i_dotprod_c = \ generated/dotprod_i4.c \ generated/dotprod_i8.c \ generated/dotprod_r4.c \ ! generated/dotprod_r8.c i_dotprodl_c = \ generated/dotprod_l4.c \ ! generated/dotprod_l8.c i_dotprodc_c = \ generated/dotprod_c4.c \ ! generated/dotprod_c8.c i_matmul_c = \ generated/matmul_i4.c \ generated/matmul_i8.c \ generated/matmul_r4.c \ generated/matmul_r8.c \ generated/matmul_c4.c \ ! generated/matmul_c8.c i_matmull_c = \ generated/matmul_l4.c \ ! generated/matmul_l8.c i_transpose_c = \ generated/transpose_i4.c \ generated/transpose_i8.c \ generated/transpose_c4.c \ ! generated/transpose_c8.c i_shape_c = \ generated/shape_i4.c \ ! generated/shape_i8.c i_reshape_c = \ generated/reshape_i4.c \ generated/reshape_i8.c \ generated/reshape_c4.c \ ! generated/reshape_c8.c i_eoshift1_c = \ generated/eoshift1_4.c \ ! generated/eoshift1_8.c i_eoshift3_c = \ generated/eoshift3_4.c \ ! generated/eoshift3_8.c i_cshift1_c = \ generated/cshift1_4.c \ ! generated/cshift1_8.c in_pack_c = \ generated/in_pack_i4.c \ generated/in_pack_i8.c \ generated/in_pack_c4.c \ ! generated/in_pack_c8.c in_unpack_c = \ generated/in_unpack_i4.c \ generated/in_unpack_i8.c \ generated/in_unpack_c4.c \ ! generated/in_unpack_c8.c i_exponent_c = \ generated/exponent_r4.c \ ! generated/exponent_r8.c i_fraction_c = \ generated/fraction_r4.c \ ! generated/fraction_r8.c i_nearest_c = \ generated/nearest_r4.c \ ! generated/nearest_r8.c i_set_exponent_c = \ generated/set_exponent_r4.c \ ! generated/set_exponent_r8.c i_pow_c = \ generated/pow_i4_i4.c \ generated/pow_i8_i4.c \ generated/pow_r4_i4.c \ generated/pow_r8_i4.c \ generated/pow_c4_i4.c \ generated/pow_c8_i4.c \ generated/pow_i4_i8.c \ generated/pow_i8_i8.c \ generated/pow_r4_i8.c \ generated/pow_r8_i8.c \ generated/pow_c4_i8.c \ ! generated/pow_c8_i8.c m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \ m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \ --- 460,772 ---- i_all_c = \ generated/all_l4.c \ ! generated/all_l8.c \ ! generated/all_l16.c i_any_c = \ generated/any_l4.c \ ! generated/any_l8.c \ ! generated/any_l16.c i_count_c = \ generated/count_4_l4.c \ generated/count_8_l4.c \ + generated/count_16_l4.c \ generated/count_4_l8.c \ ! generated/count_8_l8.c \ ! generated/count_16_l8.c \ ! generated/count_4_l16.c \ ! generated/count_8_l16.c \ ! generated/count_16_l16.c i_maxloc0_c = \ generated/maxloc0_4_i4.c \ generated/maxloc0_8_i4.c \ + generated/maxloc0_16_i4.c \ generated/maxloc0_4_i8.c \ generated/maxloc0_8_i8.c \ + generated/maxloc0_16_i8.c \ + generated/maxloc0_4_i16.c \ + generated/maxloc0_8_i16.c \ + generated/maxloc0_16_i16.c \ generated/maxloc0_4_r4.c \ generated/maxloc0_8_r4.c \ + generated/maxloc0_16_r4.c \ generated/maxloc0_4_r8.c \ ! generated/maxloc0_8_r8.c \ ! generated/maxloc0_16_r8.c \ ! generated/maxloc0_4_r10.c \ ! generated/maxloc0_8_r10.c \ ! generated/maxloc0_16_r10.c \ ! generated/maxloc0_4_r16.c \ ! generated/maxloc0_8_r16.c \ ! generated/maxloc0_16_r16.c i_maxloc1_c = \ generated/maxloc1_4_i4.c \ generated/maxloc1_8_i4.c \ + generated/maxloc1_16_i4.c \ generated/maxloc1_4_i8.c \ generated/maxloc1_8_i8.c \ + generated/maxloc1_16_i8.c \ + generated/maxloc1_4_i16.c \ + generated/maxloc1_8_i16.c \ + generated/maxloc1_16_i16.c \ generated/maxloc1_4_r4.c \ generated/maxloc1_8_r4.c \ + generated/maxloc1_16_r4.c \ generated/maxloc1_4_r8.c \ ! generated/maxloc1_8_r8.c \ ! generated/maxloc1_16_r8.c \ ! generated/maxloc1_4_r10.c \ ! generated/maxloc1_8_r10.c \ ! generated/maxloc1_16_r10.c \ ! generated/maxloc1_4_r16.c \ ! generated/maxloc1_8_r16.c \ ! generated/maxloc1_16_r16.c i_maxval_c = \ generated/maxval_i4.c \ generated/maxval_i8.c \ + generated/maxval_i16.c \ generated/maxval_r4.c \ ! generated/maxval_r8.c \ ! generated/maxval_r10.c \ ! generated/maxval_r16.c i_minloc0_c = \ generated/minloc0_4_i4.c \ generated/minloc0_8_i4.c \ + generated/minloc0_16_i4.c \ generated/minloc0_4_i8.c \ generated/minloc0_8_i8.c \ + generated/minloc0_16_i8.c \ + generated/minloc0_4_i16.c \ + generated/minloc0_8_i16.c \ + generated/minloc0_16_i16.c \ generated/minloc0_4_r4.c \ generated/minloc0_8_r4.c \ + generated/minloc0_16_r4.c \ generated/minloc0_4_r8.c \ ! generated/minloc0_8_r8.c \ ! generated/minloc0_16_r8.c \ ! generated/minloc0_4_r10.c \ ! generated/minloc0_8_r10.c \ ! generated/minloc0_16_r10.c \ ! generated/minloc0_4_r16.c \ ! generated/minloc0_8_r16.c \ ! generated/minloc0_16_r16.c i_minloc1_c = \ generated/minloc1_4_i4.c \ generated/minloc1_8_i4.c \ + generated/minloc1_16_i4.c \ generated/minloc1_4_i8.c \ generated/minloc1_8_i8.c \ + generated/minloc1_16_i8.c \ + generated/minloc1_4_i16.c \ + generated/minloc1_8_i16.c \ + generated/minloc1_16_i16.c \ generated/minloc1_4_r4.c \ generated/minloc1_8_r4.c \ + generated/minloc1_16_r4.c \ generated/minloc1_4_r8.c \ ! generated/minloc1_8_r8.c \ ! generated/minloc1_16_r8.c \ ! generated/minloc1_4_r10.c \ ! generated/minloc1_8_r10.c \ ! generated/minloc1_16_r10.c \ ! generated/minloc1_4_r16.c \ ! generated/minloc1_8_r16.c \ ! generated/minloc1_16_r16.c i_minval_c = \ generated/minval_i4.c \ generated/minval_i8.c \ + generated/minval_i16.c \ generated/minval_r4.c \ ! generated/minval_r8.c \ ! generated/minval_r10.c \ ! generated/minval_r16.c i_sum_c = \ generated/sum_i4.c \ generated/sum_i8.c \ + generated/sum_i16.c \ generated/sum_r4.c \ generated/sum_r8.c \ + generated/sum_r10.c \ + generated/sum_r16.c \ generated/sum_c4.c \ ! generated/sum_c8.c \ ! generated/sum_c10.c \ ! generated/sum_c16.c i_product_c = \ generated/product_i4.c \ generated/product_i8.c \ + generated/product_i16.c \ generated/product_r4.c \ generated/product_r8.c \ + generated/product_r10.c \ + generated/product_r16.c \ generated/product_c4.c \ ! generated/product_c8.c \ ! generated/product_c10.c \ ! generated/product_c16.c i_dotprod_c = \ generated/dotprod_i4.c \ generated/dotprod_i8.c \ + generated/dotprod_i16.c \ generated/dotprod_r4.c \ ! generated/dotprod_r8.c \ ! generated/dotprod_r10.c \ ! generated/dotprod_r16.c i_dotprodl_c = \ generated/dotprod_l4.c \ ! generated/dotprod_l8.c \ ! generated/dotprod_l16.c i_dotprodc_c = \ generated/dotprod_c4.c \ ! generated/dotprod_c8.c \ ! generated/dotprod_c10.c \ ! generated/dotprod_c16.c i_matmul_c = \ generated/matmul_i4.c \ generated/matmul_i8.c \ + generated/matmul_i16.c \ generated/matmul_r4.c \ generated/matmul_r8.c \ + generated/matmul_r10.c \ + generated/matmul_r16.c \ generated/matmul_c4.c \ ! generated/matmul_c8.c \ ! generated/matmul_c10.c \ ! generated/matmul_c16.c i_matmull_c = \ generated/matmul_l4.c \ ! generated/matmul_l8.c \ ! generated/matmul_l16.c i_transpose_c = \ generated/transpose_i4.c \ generated/transpose_i8.c \ + generated/transpose_i16.c \ generated/transpose_c4.c \ ! generated/transpose_c8.c \ ! generated/transpose_c10.c \ ! generated/transpose_c16.c i_shape_c = \ generated/shape_i4.c \ ! generated/shape_i8.c \ ! generated/shape_i16.c i_reshape_c = \ generated/reshape_i4.c \ generated/reshape_i8.c \ + generated/reshape_i16.c \ generated/reshape_c4.c \ ! generated/reshape_c8.c \ ! generated/reshape_c10.c \ ! generated/reshape_c16.c i_eoshift1_c = \ generated/eoshift1_4.c \ ! generated/eoshift1_8.c \ ! generated/eoshift1_16.c i_eoshift3_c = \ generated/eoshift3_4.c \ ! generated/eoshift3_8.c \ ! generated/eoshift3_16.c i_cshift1_c = \ generated/cshift1_4.c \ ! generated/cshift1_8.c \ ! generated/cshift1_16.c in_pack_c = \ generated/in_pack_i4.c \ generated/in_pack_i8.c \ + generated/in_pack_i16.c \ generated/in_pack_c4.c \ ! generated/in_pack_c8.c \ ! generated/in_pack_c10.c \ ! generated/in_pack_c16.c in_unpack_c = \ generated/in_unpack_i4.c \ generated/in_unpack_i8.c \ + generated/in_unpack_i16.c \ generated/in_unpack_c4.c \ ! generated/in_unpack_c8.c \ ! generated/in_unpack_c10.c \ ! generated/in_unpack_c16.c i_exponent_c = \ generated/exponent_r4.c \ ! generated/exponent_r8.c \ ! generated/exponent_r10.c \ ! generated/exponent_r16.c i_fraction_c = \ generated/fraction_r4.c \ ! generated/fraction_r8.c \ ! generated/fraction_r10.c \ ! generated/fraction_r16.c i_nearest_c = \ generated/nearest_r4.c \ ! generated/nearest_r8.c \ ! generated/nearest_r10.c \ ! generated/nearest_r16.c i_set_exponent_c = \ generated/set_exponent_r4.c \ ! generated/set_exponent_r8.c \ ! generated/set_exponent_r10.c \ ! generated/set_exponent_r16.c i_pow_c = \ generated/pow_i4_i4.c \ generated/pow_i8_i4.c \ + generated/pow_i16_i4.c \ generated/pow_r4_i4.c \ generated/pow_r8_i4.c \ + generated/pow_r10_i4.c \ + generated/pow_r16_i4.c \ generated/pow_c4_i4.c \ generated/pow_c8_i4.c \ + generated/pow_c10_i4.c \ + generated/pow_c16_i4.c \ generated/pow_i4_i8.c \ generated/pow_i8_i8.c \ + generated/pow_i16_i8.c \ generated/pow_r4_i8.c \ generated/pow_r8_i8.c \ + generated/pow_r10_i8.c \ + generated/pow_r16_i8.c \ generated/pow_c4_i8.c \ ! generated/pow_c8_i8.c \ ! generated/pow_c10_i8.c \ ! generated/pow_c16_i8.c \ ! generated/pow_i4_i16.c \ ! generated/pow_i8_i16.c \ ! generated/pow_i16_i16.c \ ! generated/pow_r4_i16.c \ ! generated/pow_r8_i16.c \ ! generated/pow_r10_i16.c \ ! generated/pow_r16_i16.c \ ! generated/pow_c4_i16.c \ ! generated/pow_c8_i16.c \ ! generated/pow_c10_i16.c \ ! generated/pow_c16_i16.c m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \ m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \ *************** gfor_built_src = $(i_all_c) $(i_any_c) $ *** 597,722 **** $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ $(i_pow_c) \ ! selected_int_kind.inc selected_real_kind.inc ! ! ! # We only use these if libm doesn't contain complex math functions. ! gfor_math_trig_c = \ ! generated/trig_c4.c \ ! generated/trig_c8.c ! ! gfor_math_exp_c = \ ! generated/exp_c4.c \ ! generated/exp_c8.c ! ! gfor_math_hyp_c = \ ! generated/hyp_c4.c \ ! generated/hyp_c8.c ! ! gfor_math_trig_obj = \ ! trig_c4.lo \ ! trig_c8.lo ! ! gfor_math_exp_obj = \ ! exp_c4.lo \ ! exp_c8.lo ! ! gfor_math_hyp_obj = \ ! hyp_c4.lo \ ! hyp_c8.lo # Machine generated specifics gfor_built_specific_src = \ ! generated/_abs_c4.f90 \ ! generated/_abs_c8.f90 \ ! generated/_abs_i4.f90 \ ! generated/_abs_i8.f90 \ ! generated/_abs_r4.f90 \ ! generated/_abs_r8.f90 \ ! generated/_exp_r4.f90 \ ! generated/_exp_r8.f90 \ ! generated/_exp_c4.f90 \ ! generated/_exp_c8.f90 \ ! generated/_log_r4.f90 \ ! generated/_log_r8.f90 \ ! generated/_log_c4.f90 \ ! generated/_log_c8.f90 \ ! generated/_log10_r4.f90 \ ! generated/_log10_r8.f90 \ ! generated/_sqrt_r4.f90 \ ! generated/_sqrt_r8.f90 \ ! generated/_sqrt_c4.f90 \ ! generated/_sqrt_c8.f90 \ ! generated/_asin_r4.f90 \ ! generated/_asin_r8.f90 \ ! generated/_acos_r4.f90 \ ! generated/_acos_r8.f90 \ ! generated/_atan_r4.f90 \ ! generated/_atan_r8.f90 \ ! generated/_sin_r4.f90 \ ! generated/_sin_r8.f90 \ ! generated/_sin_c4.f90 \ ! generated/_sin_c8.f90 \ ! generated/_cos_r4.f90 \ ! generated/_cos_r8.f90 \ ! generated/_cos_c4.f90 \ ! generated/_cos_c8.f90 \ ! generated/_tan_r4.f90 \ ! generated/_tan_r8.f90 \ ! generated/_sinh_r4.f90 \ ! generated/_sinh_r8.f90 \ ! generated/_cosh_r4.f90 \ ! generated/_cosh_r8.f90 \ ! generated/_tanh_r4.f90 \ ! generated/_tanh_r8.f90 \ ! generated/_conjg_c4.f90 \ ! generated/_conjg_c8.f90 \ ! generated/_aint_r4.f90 \ ! generated/_aint_r8.f90 \ ! generated/_anint_r4.f90 \ ! generated/_anint_r8.f90 gfor_built_specific2_src = \ ! generated/_sign_i4.f90 \ ! generated/_sign_i8.f90 \ ! generated/_sign_r4.f90 \ ! generated/_sign_r8.f90 \ ! generated/_dim_i4.f90 \ ! generated/_dim_i8.f90 \ ! generated/_dim_r4.f90 \ ! generated/_dim_r8.f90 \ ! generated/_atan2_r4.f90 \ ! generated/_atan2_r8.f90 \ ! generated/_mod_i4.f90 \ ! generated/_mod_i8.f90 \ ! generated/_mod_r4.f90 \ ! generated/_mod_r8.f90 ! #specific intrinsics requiring manal code ! #gfor_specific_c= \ ! #intrinsics/_aimag.c \ ! #intrinsics/_cabs.c \ ! #foo gfor_specific_src = \ $(gfor_built_specific_src) \ $(gfor_built_specific2_src) \ intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 ! gfor_cmath_src = $(gfor_math_trig_c) $(gfor_math_exp_c) $(gfor_math_hyp_c) ! gfor_cmath_obj = $(gfor_math_trig_obj) $(gfor_math_exp_obj) \ ! $(gfor_math_hyp_obj) ! ! BUILT_SOURCES = $(gfor_built_src) $(gfor_cmath_src) $(gfor_built_specific_src) \ $(gfor_built_specific2_src) libgfortran_la_SOURCES = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ $(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src) - EXTRA_libgfortran_la_SOURCES = $(gfor_cmath_src) - libgfortran_la_LIBADD = @MATH_OBJ@ - libgfortran_la_DEPENDENCIES = @MATH_OBJ@ I_M4_DEPS = m4/iparm.m4 I_M4_DEPS0 = $(I_M4_DEPS) m4/iforeach.m4 I_M4_DEPS1 = $(I_M4_DEPS) m4/ifunction.m4 --- 784,932 ---- $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ $(i_pow_c) \ ! selected_int_kind.inc selected_real_kind.inc kinds.h \ ! kinds.inc c99_protos.inc fpu-target.h # Machine generated specifics gfor_built_specific_src = \ ! generated/_abs_c4.F90 \ ! generated/_abs_c8.F90 \ ! generated/_abs_c10.F90 \ ! generated/_abs_c16.F90 \ ! generated/_abs_i4.F90 \ ! generated/_abs_i8.F90 \ ! generated/_abs_i16.F90 \ ! generated/_abs_r4.F90 \ ! generated/_abs_r8.F90 \ ! generated/_abs_r10.F90 \ ! generated/_abs_r16.F90 \ ! generated/_exp_r4.F90 \ ! generated/_exp_r8.F90 \ ! generated/_exp_r10.F90 \ ! generated/_exp_r16.F90 \ ! generated/_exp_c4.F90 \ ! generated/_exp_c8.F90 \ ! generated/_exp_c10.F90 \ ! generated/_exp_c16.F90 \ ! generated/_log_r4.F90 \ ! generated/_log_r8.F90 \ ! generated/_log_r10.F90 \ ! generated/_log_r16.F90 \ ! generated/_log_c4.F90 \ ! generated/_log_c8.F90 \ ! generated/_log_c10.F90 \ ! generated/_log_c16.F90 \ ! generated/_log10_r4.F90 \ ! generated/_log10_r8.F90 \ ! generated/_log10_r10.F90 \ ! generated/_log10_r16.F90 \ ! generated/_sqrt_r4.F90 \ ! generated/_sqrt_r8.F90 \ ! generated/_sqrt_r10.F90 \ ! generated/_sqrt_r16.F90 \ ! generated/_sqrt_c4.F90 \ ! generated/_sqrt_c8.F90 \ ! generated/_sqrt_c10.F90 \ ! generated/_sqrt_c16.F90 \ ! generated/_asin_r4.F90 \ ! generated/_asin_r8.F90 \ ! generated/_asin_r10.F90 \ ! generated/_asin_r16.F90 \ ! generated/_acos_r4.F90 \ ! generated/_acos_r8.F90 \ ! generated/_acos_r10.F90 \ ! generated/_acos_r16.F90 \ ! generated/_atan_r4.F90 \ ! generated/_atan_r8.F90 \ ! generated/_atan_r10.F90 \ ! generated/_atan_r16.F90 \ ! generated/_sin_r4.F90 \ ! generated/_sin_r8.F90 \ ! generated/_sin_r10.F90 \ ! generated/_sin_r16.F90 \ ! generated/_sin_c4.F90 \ ! generated/_sin_c8.F90 \ ! generated/_sin_c10.F90 \ ! generated/_sin_c16.F90 \ ! generated/_cos_r4.F90 \ ! generated/_cos_r8.F90 \ ! generated/_cos_r10.F90 \ ! generated/_cos_r16.F90 \ ! generated/_cos_c4.F90 \ ! generated/_cos_c8.F90 \ ! generated/_cos_c10.F90 \ ! generated/_cos_c16.F90 \ ! generated/_tan_r4.F90 \ ! generated/_tan_r8.F90 \ ! generated/_tan_r10.F90 \ ! generated/_tan_r16.F90 \ ! generated/_sinh_r4.F90 \ ! generated/_sinh_r8.F90 \ ! generated/_sinh_r10.F90 \ ! generated/_sinh_r16.F90 \ ! generated/_cosh_r4.F90 \ ! generated/_cosh_r8.F90 \ ! generated/_cosh_r10.F90 \ ! generated/_cosh_r16.F90 \ ! generated/_tanh_r4.F90 \ ! generated/_tanh_r8.F90 \ ! generated/_tanh_r10.F90 \ ! generated/_tanh_r16.F90 \ ! generated/_conjg_c4.F90 \ ! generated/_conjg_c8.F90 \ ! generated/_conjg_c10.F90 \ ! generated/_conjg_c16.F90 \ ! generated/_aint_r4.F90 \ ! generated/_aint_r8.F90 \ ! generated/_aint_r10.F90 \ ! generated/_aint_r16.F90 \ ! generated/_anint_r4.F90 \ ! generated/_anint_r8.F90 \ ! generated/_anint_r10.F90 \ ! generated/_anint_r16.F90 gfor_built_specific2_src = \ ! generated/_sign_i4.F90 \ ! generated/_sign_i8.F90 \ ! generated/_sign_i16.F90 \ ! generated/_sign_r4.F90 \ ! generated/_sign_r8.F90 \ ! generated/_sign_r10.F90 \ ! generated/_sign_r16.F90 \ ! generated/_dim_i4.F90 \ ! generated/_dim_i8.F90 \ ! generated/_dim_i16.F90 \ ! generated/_dim_r4.F90 \ ! generated/_dim_r8.F90 \ ! generated/_dim_r10.F90 \ ! generated/_dim_r16.F90 \ ! generated/_atan2_r4.F90 \ ! generated/_atan2_r8.F90 \ ! generated/_atan2_r10.F90 \ ! generated/_atan2_r16.F90 \ ! generated/_mod_i4.F90 \ ! generated/_mod_i8.F90 \ ! generated/_mod_i16.F90 \ ! generated/_mod_r4.F90 \ ! generated/_mod_r8.F90 ! # There are commented out due to a bug in the way the front-end ! # handles MOD ! #generated/_mod_r10.F90 ! #generated/_mod_r16.F90 gfor_specific_src = \ $(gfor_built_specific_src) \ $(gfor_built_specific2_src) \ intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 ! BUILT_SOURCES = $(gfor_built_src) $(gfor_built_specific_src) \ $(gfor_built_specific2_src) libgfortran_la_SOURCES = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ $(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src) I_M4_DEPS = m4/iparm.m4 I_M4_DEPS0 = $(I_M4_DEPS) m4/iforeach.m4 I_M4_DEPS1 = $(I_M4_DEPS) m4/ifunction.m4 *************** distclean-compile: *** 823,828 **** --- 1033,1392 ---- .F90.lo: $(LTPPFCCOMPILE) -c -o $@ $< + _abs_c4.lo: generated/_abs_c4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c4.lo `test -f 'generated/_abs_c4.F90' || echo '$(srcdir)/'`generated/_abs_c4.F90 + + _abs_c8.lo: generated/_abs_c8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c8.lo `test -f 'generated/_abs_c8.F90' || echo '$(srcdir)/'`generated/_abs_c8.F90 + + _abs_c10.lo: generated/_abs_c10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c10.lo `test -f 'generated/_abs_c10.F90' || echo '$(srcdir)/'`generated/_abs_c10.F90 + + _abs_c16.lo: generated/_abs_c16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c16.lo `test -f 'generated/_abs_c16.F90' || echo '$(srcdir)/'`generated/_abs_c16.F90 + + _abs_i4.lo: generated/_abs_i4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i4.lo `test -f 'generated/_abs_i4.F90' || echo '$(srcdir)/'`generated/_abs_i4.F90 + + _abs_i8.lo: generated/_abs_i8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i8.lo `test -f 'generated/_abs_i8.F90' || echo '$(srcdir)/'`generated/_abs_i8.F90 + + _abs_i16.lo: generated/_abs_i16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i16.lo `test -f 'generated/_abs_i16.F90' || echo '$(srcdir)/'`generated/_abs_i16.F90 + + _abs_r4.lo: generated/_abs_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r4.lo `test -f 'generated/_abs_r4.F90' || echo '$(srcdir)/'`generated/_abs_r4.F90 + + _abs_r8.lo: generated/_abs_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r8.lo `test -f 'generated/_abs_r8.F90' || echo '$(srcdir)/'`generated/_abs_r8.F90 + + _abs_r10.lo: generated/_abs_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r10.lo `test -f 'generated/_abs_r10.F90' || echo '$(srcdir)/'`generated/_abs_r10.F90 + + _abs_r16.lo: generated/_abs_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r16.lo `test -f 'generated/_abs_r16.F90' || echo '$(srcdir)/'`generated/_abs_r16.F90 + + _exp_r4.lo: generated/_exp_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r4.lo `test -f 'generated/_exp_r4.F90' || echo '$(srcdir)/'`generated/_exp_r4.F90 + + _exp_r8.lo: generated/_exp_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r8.lo `test -f 'generated/_exp_r8.F90' || echo '$(srcdir)/'`generated/_exp_r8.F90 + + _exp_r10.lo: generated/_exp_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r10.lo `test -f 'generated/_exp_r10.F90' || echo '$(srcdir)/'`generated/_exp_r10.F90 + + _exp_r16.lo: generated/_exp_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r16.lo `test -f 'generated/_exp_r16.F90' || echo '$(srcdir)/'`generated/_exp_r16.F90 + + _exp_c4.lo: generated/_exp_c4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c4.lo `test -f 'generated/_exp_c4.F90' || echo '$(srcdir)/'`generated/_exp_c4.F90 + + _exp_c8.lo: generated/_exp_c8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c8.lo `test -f 'generated/_exp_c8.F90' || echo '$(srcdir)/'`generated/_exp_c8.F90 + + _exp_c10.lo: generated/_exp_c10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c10.lo `test -f 'generated/_exp_c10.F90' || echo '$(srcdir)/'`generated/_exp_c10.F90 + + _exp_c16.lo: generated/_exp_c16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c16.lo `test -f 'generated/_exp_c16.F90' || echo '$(srcdir)/'`generated/_exp_c16.F90 + + _log_r4.lo: generated/_log_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r4.lo `test -f 'generated/_log_r4.F90' || echo '$(srcdir)/'`generated/_log_r4.F90 + + _log_r8.lo: generated/_log_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r8.lo `test -f 'generated/_log_r8.F90' || echo '$(srcdir)/'`generated/_log_r8.F90 + + _log_r10.lo: generated/_log_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r10.lo `test -f 'generated/_log_r10.F90' || echo '$(srcdir)/'`generated/_log_r10.F90 + + _log_r16.lo: generated/_log_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r16.lo `test -f 'generated/_log_r16.F90' || echo '$(srcdir)/'`generated/_log_r16.F90 + + _log_c4.lo: generated/_log_c4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c4.lo `test -f 'generated/_log_c4.F90' || echo '$(srcdir)/'`generated/_log_c4.F90 + + _log_c8.lo: generated/_log_c8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c8.lo `test -f 'generated/_log_c8.F90' || echo '$(srcdir)/'`generated/_log_c8.F90 + + _log_c10.lo: generated/_log_c10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c10.lo `test -f 'generated/_log_c10.F90' || echo '$(srcdir)/'`generated/_log_c10.F90 + + _log_c16.lo: generated/_log_c16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c16.lo `test -f 'generated/_log_c16.F90' || echo '$(srcdir)/'`generated/_log_c16.F90 + + _log10_r4.lo: generated/_log10_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r4.lo `test -f 'generated/_log10_r4.F90' || echo '$(srcdir)/'`generated/_log10_r4.F90 + + _log10_r8.lo: generated/_log10_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r8.lo `test -f 'generated/_log10_r8.F90' || echo '$(srcdir)/'`generated/_log10_r8.F90 + + _log10_r10.lo: generated/_log10_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r10.lo `test -f 'generated/_log10_r10.F90' || echo '$(srcdir)/'`generated/_log10_r10.F90 + + _log10_r16.lo: generated/_log10_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r16.lo `test -f 'generated/_log10_r16.F90' || echo '$(srcdir)/'`generated/_log10_r16.F90 + + _sqrt_r4.lo: generated/_sqrt_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r4.lo `test -f 'generated/_sqrt_r4.F90' || echo '$(srcdir)/'`generated/_sqrt_r4.F90 + + _sqrt_r8.lo: generated/_sqrt_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r8.lo `test -f 'generated/_sqrt_r8.F90' || echo '$(srcdir)/'`generated/_sqrt_r8.F90 + + _sqrt_r10.lo: generated/_sqrt_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r10.lo `test -f 'generated/_sqrt_r10.F90' || echo '$(srcdir)/'`generated/_sqrt_r10.F90 + + _sqrt_r16.lo: generated/_sqrt_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r16.lo `test -f 'generated/_sqrt_r16.F90' || echo '$(srcdir)/'`generated/_sqrt_r16.F90 + + _sqrt_c4.lo: generated/_sqrt_c4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c4.lo `test -f 'generated/_sqrt_c4.F90' || echo '$(srcdir)/'`generated/_sqrt_c4.F90 + + _sqrt_c8.lo: generated/_sqrt_c8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c8.lo `test -f 'generated/_sqrt_c8.F90' || echo '$(srcdir)/'`generated/_sqrt_c8.F90 + + _sqrt_c10.lo: generated/_sqrt_c10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c10.lo `test -f 'generated/_sqrt_c10.F90' || echo '$(srcdir)/'`generated/_sqrt_c10.F90 + + _sqrt_c16.lo: generated/_sqrt_c16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c16.lo `test -f 'generated/_sqrt_c16.F90' || echo '$(srcdir)/'`generated/_sqrt_c16.F90 + + _asin_r4.lo: generated/_asin_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r4.lo `test -f 'generated/_asin_r4.F90' || echo '$(srcdir)/'`generated/_asin_r4.F90 + + _asin_r8.lo: generated/_asin_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r8.lo `test -f 'generated/_asin_r8.F90' || echo '$(srcdir)/'`generated/_asin_r8.F90 + + _asin_r10.lo: generated/_asin_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r10.lo `test -f 'generated/_asin_r10.F90' || echo '$(srcdir)/'`generated/_asin_r10.F90 + + _asin_r16.lo: generated/_asin_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r16.lo `test -f 'generated/_asin_r16.F90' || echo '$(srcdir)/'`generated/_asin_r16.F90 + + _acos_r4.lo: generated/_acos_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r4.lo `test -f 'generated/_acos_r4.F90' || echo '$(srcdir)/'`generated/_acos_r4.F90 + + _acos_r8.lo: generated/_acos_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r8.lo `test -f 'generated/_acos_r8.F90' || echo '$(srcdir)/'`generated/_acos_r8.F90 + + _acos_r10.lo: generated/_acos_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r10.lo `test -f 'generated/_acos_r10.F90' || echo '$(srcdir)/'`generated/_acos_r10.F90 + + _acos_r16.lo: generated/_acos_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r16.lo `test -f 'generated/_acos_r16.F90' || echo '$(srcdir)/'`generated/_acos_r16.F90 + + _atan_r4.lo: generated/_atan_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r4.lo `test -f 'generated/_atan_r4.F90' || echo '$(srcdir)/'`generated/_atan_r4.F90 + + _atan_r8.lo: generated/_atan_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r8.lo `test -f 'generated/_atan_r8.F90' || echo '$(srcdir)/'`generated/_atan_r8.F90 + + _atan_r10.lo: generated/_atan_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r10.lo `test -f 'generated/_atan_r10.F90' || echo '$(srcdir)/'`generated/_atan_r10.F90 + + _atan_r16.lo: generated/_atan_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r16.lo `test -f 'generated/_atan_r16.F90' || echo '$(srcdir)/'`generated/_atan_r16.F90 + + _sin_r4.lo: generated/_sin_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r4.lo `test -f 'generated/_sin_r4.F90' || echo '$(srcdir)/'`generated/_sin_r4.F90 + + _sin_r8.lo: generated/_sin_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r8.lo `test -f 'generated/_sin_r8.F90' || echo '$(srcdir)/'`generated/_sin_r8.F90 + + _sin_r10.lo: generated/_sin_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r10.lo `test -f 'generated/_sin_r10.F90' || echo '$(srcdir)/'`generated/_sin_r10.F90 + + _sin_r16.lo: generated/_sin_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r16.lo `test -f 'generated/_sin_r16.F90' || echo '$(srcdir)/'`generated/_sin_r16.F90 + + _sin_c4.lo: generated/_sin_c4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c4.lo `test -f 'generated/_sin_c4.F90' || echo '$(srcdir)/'`generated/_sin_c4.F90 + + _sin_c8.lo: generated/_sin_c8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c8.lo `test -f 'generated/_sin_c8.F90' || echo '$(srcdir)/'`generated/_sin_c8.F90 + + _sin_c10.lo: generated/_sin_c10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c10.lo `test -f 'generated/_sin_c10.F90' || echo '$(srcdir)/'`generated/_sin_c10.F90 + + _sin_c16.lo: generated/_sin_c16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c16.lo `test -f 'generated/_sin_c16.F90' || echo '$(srcdir)/'`generated/_sin_c16.F90 + + _cos_r4.lo: generated/_cos_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r4.lo `test -f 'generated/_cos_r4.F90' || echo '$(srcdir)/'`generated/_cos_r4.F90 + + _cos_r8.lo: generated/_cos_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r8.lo `test -f 'generated/_cos_r8.F90' || echo '$(srcdir)/'`generated/_cos_r8.F90 + + _cos_r10.lo: generated/_cos_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r10.lo `test -f 'generated/_cos_r10.F90' || echo '$(srcdir)/'`generated/_cos_r10.F90 + + _cos_r16.lo: generated/_cos_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r16.lo `test -f 'generated/_cos_r16.F90' || echo '$(srcdir)/'`generated/_cos_r16.F90 + + _cos_c4.lo: generated/_cos_c4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c4.lo `test -f 'generated/_cos_c4.F90' || echo '$(srcdir)/'`generated/_cos_c4.F90 + + _cos_c8.lo: generated/_cos_c8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c8.lo `test -f 'generated/_cos_c8.F90' || echo '$(srcdir)/'`generated/_cos_c8.F90 + + _cos_c10.lo: generated/_cos_c10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c10.lo `test -f 'generated/_cos_c10.F90' || echo '$(srcdir)/'`generated/_cos_c10.F90 + + _cos_c16.lo: generated/_cos_c16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c16.lo `test -f 'generated/_cos_c16.F90' || echo '$(srcdir)/'`generated/_cos_c16.F90 + + _tan_r4.lo: generated/_tan_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r4.lo `test -f 'generated/_tan_r4.F90' || echo '$(srcdir)/'`generated/_tan_r4.F90 + + _tan_r8.lo: generated/_tan_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r8.lo `test -f 'generated/_tan_r8.F90' || echo '$(srcdir)/'`generated/_tan_r8.F90 + + _tan_r10.lo: generated/_tan_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r10.lo `test -f 'generated/_tan_r10.F90' || echo '$(srcdir)/'`generated/_tan_r10.F90 + + _tan_r16.lo: generated/_tan_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r16.lo `test -f 'generated/_tan_r16.F90' || echo '$(srcdir)/'`generated/_tan_r16.F90 + + _sinh_r4.lo: generated/_sinh_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r4.lo `test -f 'generated/_sinh_r4.F90' || echo '$(srcdir)/'`generated/_sinh_r4.F90 + + _sinh_r8.lo: generated/_sinh_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r8.lo `test -f 'generated/_sinh_r8.F90' || echo '$(srcdir)/'`generated/_sinh_r8.F90 + + _sinh_r10.lo: generated/_sinh_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r10.lo `test -f 'generated/_sinh_r10.F90' || echo '$(srcdir)/'`generated/_sinh_r10.F90 + + _sinh_r16.lo: generated/_sinh_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r16.lo `test -f 'generated/_sinh_r16.F90' || echo '$(srcdir)/'`generated/_sinh_r16.F90 + + _cosh_r4.lo: generated/_cosh_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r4.lo `test -f 'generated/_cosh_r4.F90' || echo '$(srcdir)/'`generated/_cosh_r4.F90 + + _cosh_r8.lo: generated/_cosh_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r8.lo `test -f 'generated/_cosh_r8.F90' || echo '$(srcdir)/'`generated/_cosh_r8.F90 + + _cosh_r10.lo: generated/_cosh_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r10.lo `test -f 'generated/_cosh_r10.F90' || echo '$(srcdir)/'`generated/_cosh_r10.F90 + + _cosh_r16.lo: generated/_cosh_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r16.lo `test -f 'generated/_cosh_r16.F90' || echo '$(srcdir)/'`generated/_cosh_r16.F90 + + _tanh_r4.lo: generated/_tanh_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r4.lo `test -f 'generated/_tanh_r4.F90' || echo '$(srcdir)/'`generated/_tanh_r4.F90 + + _tanh_r8.lo: generated/_tanh_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r8.lo `test -f 'generated/_tanh_r8.F90' || echo '$(srcdir)/'`generated/_tanh_r8.F90 + + _tanh_r10.lo: generated/_tanh_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r10.lo `test -f 'generated/_tanh_r10.F90' || echo '$(srcdir)/'`generated/_tanh_r10.F90 + + _tanh_r16.lo: generated/_tanh_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r16.lo `test -f 'generated/_tanh_r16.F90' || echo '$(srcdir)/'`generated/_tanh_r16.F90 + + _conjg_c4.lo: generated/_conjg_c4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c4.lo `test -f 'generated/_conjg_c4.F90' || echo '$(srcdir)/'`generated/_conjg_c4.F90 + + _conjg_c8.lo: generated/_conjg_c8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c8.lo `test -f 'generated/_conjg_c8.F90' || echo '$(srcdir)/'`generated/_conjg_c8.F90 + + _conjg_c10.lo: generated/_conjg_c10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c10.lo `test -f 'generated/_conjg_c10.F90' || echo '$(srcdir)/'`generated/_conjg_c10.F90 + + _conjg_c16.lo: generated/_conjg_c16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c16.lo `test -f 'generated/_conjg_c16.F90' || echo '$(srcdir)/'`generated/_conjg_c16.F90 + + _aint_r4.lo: generated/_aint_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r4.lo `test -f 'generated/_aint_r4.F90' || echo '$(srcdir)/'`generated/_aint_r4.F90 + + _aint_r8.lo: generated/_aint_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r8.lo `test -f 'generated/_aint_r8.F90' || echo '$(srcdir)/'`generated/_aint_r8.F90 + + _aint_r10.lo: generated/_aint_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r10.lo `test -f 'generated/_aint_r10.F90' || echo '$(srcdir)/'`generated/_aint_r10.F90 + + _aint_r16.lo: generated/_aint_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r16.lo `test -f 'generated/_aint_r16.F90' || echo '$(srcdir)/'`generated/_aint_r16.F90 + + _anint_r4.lo: generated/_anint_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r4.lo `test -f 'generated/_anint_r4.F90' || echo '$(srcdir)/'`generated/_anint_r4.F90 + + _anint_r8.lo: generated/_anint_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r8.lo `test -f 'generated/_anint_r8.F90' || echo '$(srcdir)/'`generated/_anint_r8.F90 + + _anint_r10.lo: generated/_anint_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r10.lo `test -f 'generated/_anint_r10.F90' || echo '$(srcdir)/'`generated/_anint_r10.F90 + + _anint_r16.lo: generated/_anint_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r16.lo `test -f 'generated/_anint_r16.F90' || echo '$(srcdir)/'`generated/_anint_r16.F90 + + _sign_i4.lo: generated/_sign_i4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i4.lo `test -f 'generated/_sign_i4.F90' || echo '$(srcdir)/'`generated/_sign_i4.F90 + + _sign_i8.lo: generated/_sign_i8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i8.lo `test -f 'generated/_sign_i8.F90' || echo '$(srcdir)/'`generated/_sign_i8.F90 + + _sign_i16.lo: generated/_sign_i16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i16.lo `test -f 'generated/_sign_i16.F90' || echo '$(srcdir)/'`generated/_sign_i16.F90 + + _sign_r4.lo: generated/_sign_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r4.lo `test -f 'generated/_sign_r4.F90' || echo '$(srcdir)/'`generated/_sign_r4.F90 + + _sign_r8.lo: generated/_sign_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r8.lo `test -f 'generated/_sign_r8.F90' || echo '$(srcdir)/'`generated/_sign_r8.F90 + + _sign_r10.lo: generated/_sign_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r10.lo `test -f 'generated/_sign_r10.F90' || echo '$(srcdir)/'`generated/_sign_r10.F90 + + _sign_r16.lo: generated/_sign_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r16.lo `test -f 'generated/_sign_r16.F90' || echo '$(srcdir)/'`generated/_sign_r16.F90 + + _dim_i4.lo: generated/_dim_i4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i4.lo `test -f 'generated/_dim_i4.F90' || echo '$(srcdir)/'`generated/_dim_i4.F90 + + _dim_i8.lo: generated/_dim_i8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i8.lo `test -f 'generated/_dim_i8.F90' || echo '$(srcdir)/'`generated/_dim_i8.F90 + + _dim_i16.lo: generated/_dim_i16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i16.lo `test -f 'generated/_dim_i16.F90' || echo '$(srcdir)/'`generated/_dim_i16.F90 + + _dim_r4.lo: generated/_dim_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r4.lo `test -f 'generated/_dim_r4.F90' || echo '$(srcdir)/'`generated/_dim_r4.F90 + + _dim_r8.lo: generated/_dim_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r8.lo `test -f 'generated/_dim_r8.F90' || echo '$(srcdir)/'`generated/_dim_r8.F90 + + _dim_r10.lo: generated/_dim_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r10.lo `test -f 'generated/_dim_r10.F90' || echo '$(srcdir)/'`generated/_dim_r10.F90 + + _dim_r16.lo: generated/_dim_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r16.lo `test -f 'generated/_dim_r16.F90' || echo '$(srcdir)/'`generated/_dim_r16.F90 + + _atan2_r4.lo: generated/_atan2_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r4.lo `test -f 'generated/_atan2_r4.F90' || echo '$(srcdir)/'`generated/_atan2_r4.F90 + + _atan2_r8.lo: generated/_atan2_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r8.lo `test -f 'generated/_atan2_r8.F90' || echo '$(srcdir)/'`generated/_atan2_r8.F90 + + _atan2_r10.lo: generated/_atan2_r10.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r10.lo `test -f 'generated/_atan2_r10.F90' || echo '$(srcdir)/'`generated/_atan2_r10.F90 + + _atan2_r16.lo: generated/_atan2_r16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r16.lo `test -f 'generated/_atan2_r16.F90' || echo '$(srcdir)/'`generated/_atan2_r16.F90 + + _mod_i4.lo: generated/_mod_i4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i4.lo `test -f 'generated/_mod_i4.F90' || echo '$(srcdir)/'`generated/_mod_i4.F90 + + _mod_i8.lo: generated/_mod_i8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i8.lo `test -f 'generated/_mod_i8.F90' || echo '$(srcdir)/'`generated/_mod_i8.F90 + + _mod_i16.lo: generated/_mod_i16.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i16.lo `test -f 'generated/_mod_i16.F90' || echo '$(srcdir)/'`generated/_mod_i16.F90 + + _mod_r4.lo: generated/_mod_r4.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r4.lo `test -f 'generated/_mod_r4.F90' || echo '$(srcdir)/'`generated/_mod_r4.F90 + + _mod_r8.lo: generated/_mod_r8.F90 + $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r8.lo `test -f 'generated/_mod_r8.F90' || echo '$(srcdir)/'`generated/_mod_r8.F90 + f2c_specifics.lo: intrinsics/f2c_specifics.F90 $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o f2c_specifics.lo `test -f 'intrinsics/f2c_specifics.F90' || echo '$(srcdir)/'`intrinsics/f2c_specifics.F90 *************** environ.lo: runtime/environ.c *** 844,849 **** --- 1408,1416 ---- error.lo: runtime/error.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o error.lo `test -f 'runtime/error.c' || echo '$(srcdir)/'`runtime/error.c + fpu.lo: runtime/fpu.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fpu.lo `test -f 'runtime/fpu.c' || echo '$(srcdir)/'`runtime/fpu.c + main.lo: runtime/main.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o main.lo `test -f 'runtime/main.c' || echo '$(srcdir)/'`runtime/main.c *************** all_l4.lo: generated/all_l4.c *** 868,1235 **** all_l8.lo: generated/all_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l8.lo `test -f 'generated/all_l8.c' || echo '$(srcdir)/'`generated/all_l8.c any_l4.lo: generated/any_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l4.lo `test -f 'generated/any_l4.c' || echo '$(srcdir)/'`generated/any_l4.c any_l8.lo: generated/any_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l8.lo `test -f 'generated/any_l8.c' || echo '$(srcdir)/'`generated/any_l8.c count_4_l4.lo: generated/count_4_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l4.lo `test -f 'generated/count_4_l4.c' || echo '$(srcdir)/'`generated/count_4_l4.c count_8_l4.lo: generated/count_8_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l4.lo `test -f 'generated/count_8_l4.c' || echo '$(srcdir)/'`generated/count_8_l4.c count_4_l8.lo: generated/count_4_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l8.lo `test -f 'generated/count_4_l8.c' || echo '$(srcdir)/'`generated/count_4_l8.c count_8_l8.lo: generated/count_8_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l8.lo `test -f 'generated/count_8_l8.c' || echo '$(srcdir)/'`generated/count_8_l8.c maxloc0_4_i4.lo: generated/maxloc0_4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i4.lo `test -f 'generated/maxloc0_4_i4.c' || echo '$(srcdir)/'`generated/maxloc0_4_i4.c maxloc0_8_i4.lo: generated/maxloc0_8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i4.lo `test -f 'generated/maxloc0_8_i4.c' || echo '$(srcdir)/'`generated/maxloc0_8_i4.c maxloc0_4_i8.lo: generated/maxloc0_4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i8.lo `test -f 'generated/maxloc0_4_i8.c' || echo '$(srcdir)/'`generated/maxloc0_4_i8.c maxloc0_8_i8.lo: generated/maxloc0_8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i8.lo `test -f 'generated/maxloc0_8_i8.c' || echo '$(srcdir)/'`generated/maxloc0_8_i8.c maxloc0_4_r4.lo: generated/maxloc0_4_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r4.lo `test -f 'generated/maxloc0_4_r4.c' || echo '$(srcdir)/'`generated/maxloc0_4_r4.c maxloc0_8_r4.lo: generated/maxloc0_8_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r4.lo `test -f 'generated/maxloc0_8_r4.c' || echo '$(srcdir)/'`generated/maxloc0_8_r4.c maxloc0_4_r8.lo: generated/maxloc0_4_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r8.lo `test -f 'generated/maxloc0_4_r8.c' || echo '$(srcdir)/'`generated/maxloc0_4_r8.c maxloc0_8_r8.lo: generated/maxloc0_8_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r8.lo `test -f 'generated/maxloc0_8_r8.c' || echo '$(srcdir)/'`generated/maxloc0_8_r8.c maxloc1_4_i4.lo: generated/maxloc1_4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i4.lo `test -f 'generated/maxloc1_4_i4.c' || echo '$(srcdir)/'`generated/maxloc1_4_i4.c maxloc1_8_i4.lo: generated/maxloc1_8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i4.lo `test -f 'generated/maxloc1_8_i4.c' || echo '$(srcdir)/'`generated/maxloc1_8_i4.c maxloc1_4_i8.lo: generated/maxloc1_4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i8.lo `test -f 'generated/maxloc1_4_i8.c' || echo '$(srcdir)/'`generated/maxloc1_4_i8.c maxloc1_8_i8.lo: generated/maxloc1_8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i8.lo `test -f 'generated/maxloc1_8_i8.c' || echo '$(srcdir)/'`generated/maxloc1_8_i8.c maxloc1_4_r4.lo: generated/maxloc1_4_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r4.lo `test -f 'generated/maxloc1_4_r4.c' || echo '$(srcdir)/'`generated/maxloc1_4_r4.c maxloc1_8_r4.lo: generated/maxloc1_8_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r4.lo `test -f 'generated/maxloc1_8_r4.c' || echo '$(srcdir)/'`generated/maxloc1_8_r4.c maxloc1_4_r8.lo: generated/maxloc1_4_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r8.lo `test -f 'generated/maxloc1_4_r8.c' || echo '$(srcdir)/'`generated/maxloc1_4_r8.c maxloc1_8_r8.lo: generated/maxloc1_8_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r8.lo `test -f 'generated/maxloc1_8_r8.c' || echo '$(srcdir)/'`generated/maxloc1_8_r8.c maxval_i4.lo: generated/maxval_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i4.lo `test -f 'generated/maxval_i4.c' || echo '$(srcdir)/'`generated/maxval_i4.c maxval_i8.lo: generated/maxval_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i8.lo `test -f 'generated/maxval_i8.c' || echo '$(srcdir)/'`generated/maxval_i8.c maxval_r4.lo: generated/maxval_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r4.lo `test -f 'generated/maxval_r4.c' || echo '$(srcdir)/'`generated/maxval_r4.c maxval_r8.lo: generated/maxval_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r8.lo `test -f 'generated/maxval_r8.c' || echo '$(srcdir)/'`generated/maxval_r8.c minloc0_4_i4.lo: generated/minloc0_4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i4.lo `test -f 'generated/minloc0_4_i4.c' || echo '$(srcdir)/'`generated/minloc0_4_i4.c minloc0_8_i4.lo: generated/minloc0_8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i4.lo `test -f 'generated/minloc0_8_i4.c' || echo '$(srcdir)/'`generated/minloc0_8_i4.c minloc0_4_i8.lo: generated/minloc0_4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i8.lo `test -f 'generated/minloc0_4_i8.c' || echo '$(srcdir)/'`generated/minloc0_4_i8.c minloc0_8_i8.lo: generated/minloc0_8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i8.lo `test -f 'generated/minloc0_8_i8.c' || echo '$(srcdir)/'`generated/minloc0_8_i8.c minloc0_4_r4.lo: generated/minloc0_4_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r4.lo `test -f 'generated/minloc0_4_r4.c' || echo '$(srcdir)/'`generated/minloc0_4_r4.c minloc0_8_r4.lo: generated/minloc0_8_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r4.lo `test -f 'generated/minloc0_8_r4.c' || echo '$(srcdir)/'`generated/minloc0_8_r4.c minloc0_4_r8.lo: generated/minloc0_4_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r8.lo `test -f 'generated/minloc0_4_r8.c' || echo '$(srcdir)/'`generated/minloc0_4_r8.c minloc0_8_r8.lo: generated/minloc0_8_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r8.lo `test -f 'generated/minloc0_8_r8.c' || echo '$(srcdir)/'`generated/minloc0_8_r8.c minloc1_4_i4.lo: generated/minloc1_4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i4.lo `test -f 'generated/minloc1_4_i4.c' || echo '$(srcdir)/'`generated/minloc1_4_i4.c minloc1_8_i4.lo: generated/minloc1_8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i4.lo `test -f 'generated/minloc1_8_i4.c' || echo '$(srcdir)/'`generated/minloc1_8_i4.c minloc1_4_i8.lo: generated/minloc1_4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i8.lo `test -f 'generated/minloc1_4_i8.c' || echo '$(srcdir)/'`generated/minloc1_4_i8.c minloc1_8_i8.lo: generated/minloc1_8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i8.lo `test -f 'generated/minloc1_8_i8.c' || echo '$(srcdir)/'`generated/minloc1_8_i8.c minloc1_4_r4.lo: generated/minloc1_4_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r4.lo `test -f 'generated/minloc1_4_r4.c' || echo '$(srcdir)/'`generated/minloc1_4_r4.c minloc1_8_r4.lo: generated/minloc1_8_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r4.lo `test -f 'generated/minloc1_8_r4.c' || echo '$(srcdir)/'`generated/minloc1_8_r4.c minloc1_4_r8.lo: generated/minloc1_4_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r8.lo `test -f 'generated/minloc1_4_r8.c' || echo '$(srcdir)/'`generated/minloc1_4_r8.c minloc1_8_r8.lo: generated/minloc1_8_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r8.lo `test -f 'generated/minloc1_8_r8.c' || echo '$(srcdir)/'`generated/minloc1_8_r8.c minval_i4.lo: generated/minval_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i4.lo `test -f 'generated/minval_i4.c' || echo '$(srcdir)/'`generated/minval_i4.c minval_i8.lo: generated/minval_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i8.lo `test -f 'generated/minval_i8.c' || echo '$(srcdir)/'`generated/minval_i8.c minval_r4.lo: generated/minval_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r4.lo `test -f 'generated/minval_r4.c' || echo '$(srcdir)/'`generated/minval_r4.c minval_r8.lo: generated/minval_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r8.lo `test -f 'generated/minval_r8.c' || echo '$(srcdir)/'`generated/minval_r8.c product_i4.lo: generated/product_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i4.lo `test -f 'generated/product_i4.c' || echo '$(srcdir)/'`generated/product_i4.c product_i8.lo: generated/product_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i8.lo `test -f 'generated/product_i8.c' || echo '$(srcdir)/'`generated/product_i8.c product_r4.lo: generated/product_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r4.lo `test -f 'generated/product_r4.c' || echo '$(srcdir)/'`generated/product_r4.c product_r8.lo: generated/product_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r8.lo `test -f 'generated/product_r8.c' || echo '$(srcdir)/'`generated/product_r8.c product_c4.lo: generated/product_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c4.lo `test -f 'generated/product_c4.c' || echo '$(srcdir)/'`generated/product_c4.c product_c8.lo: generated/product_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c8.lo `test -f 'generated/product_c8.c' || echo '$(srcdir)/'`generated/product_c8.c sum_i4.lo: generated/sum_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i4.lo `test -f 'generated/sum_i4.c' || echo '$(srcdir)/'`generated/sum_i4.c sum_i8.lo: generated/sum_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i8.lo `test -f 'generated/sum_i8.c' || echo '$(srcdir)/'`generated/sum_i8.c sum_r4.lo: generated/sum_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r4.lo `test -f 'generated/sum_r4.c' || echo '$(srcdir)/'`generated/sum_r4.c sum_r8.lo: generated/sum_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r8.lo `test -f 'generated/sum_r8.c' || echo '$(srcdir)/'`generated/sum_r8.c sum_c4.lo: generated/sum_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c4.lo `test -f 'generated/sum_c4.c' || echo '$(srcdir)/'`generated/sum_c4.c sum_c8.lo: generated/sum_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c8.lo `test -f 'generated/sum_c8.c' || echo '$(srcdir)/'`generated/sum_c8.c dotprod_i4.lo: generated/dotprod_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i4.lo `test -f 'generated/dotprod_i4.c' || echo '$(srcdir)/'`generated/dotprod_i4.c dotprod_i8.lo: generated/dotprod_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i8.lo `test -f 'generated/dotprod_i8.c' || echo '$(srcdir)/'`generated/dotprod_i8.c dotprod_r4.lo: generated/dotprod_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r4.lo `test -f 'generated/dotprod_r4.c' || echo '$(srcdir)/'`generated/dotprod_r4.c dotprod_r8.lo: generated/dotprod_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r8.lo `test -f 'generated/dotprod_r8.c' || echo '$(srcdir)/'`generated/dotprod_r8.c dotprod_l4.lo: generated/dotprod_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l4.lo `test -f 'generated/dotprod_l4.c' || echo '$(srcdir)/'`generated/dotprod_l4.c dotprod_l8.lo: generated/dotprod_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l8.lo `test -f 'generated/dotprod_l8.c' || echo '$(srcdir)/'`generated/dotprod_l8.c dotprod_c4.lo: generated/dotprod_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c4.lo `test -f 'generated/dotprod_c4.c' || echo '$(srcdir)/'`generated/dotprod_c4.c dotprod_c8.lo: generated/dotprod_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c8.lo `test -f 'generated/dotprod_c8.c' || echo '$(srcdir)/'`generated/dotprod_c8.c matmul_i4.lo: generated/matmul_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i4.lo `test -f 'generated/matmul_i4.c' || echo '$(srcdir)/'`generated/matmul_i4.c matmul_i8.lo: generated/matmul_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i8.lo `test -f 'generated/matmul_i8.c' || echo '$(srcdir)/'`generated/matmul_i8.c matmul_r4.lo: generated/matmul_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r4.lo `test -f 'generated/matmul_r4.c' || echo '$(srcdir)/'`generated/matmul_r4.c matmul_r8.lo: generated/matmul_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r8.lo `test -f 'generated/matmul_r8.c' || echo '$(srcdir)/'`generated/matmul_r8.c matmul_c4.lo: generated/matmul_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c4.lo `test -f 'generated/matmul_c4.c' || echo '$(srcdir)/'`generated/matmul_c4.c matmul_c8.lo: generated/matmul_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c8.lo `test -f 'generated/matmul_c8.c' || echo '$(srcdir)/'`generated/matmul_c8.c matmul_l4.lo: generated/matmul_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l4.lo `test -f 'generated/matmul_l4.c' || echo '$(srcdir)/'`generated/matmul_l4.c matmul_l8.lo: generated/matmul_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l8.lo `test -f 'generated/matmul_l8.c' || echo '$(srcdir)/'`generated/matmul_l8.c transpose_i4.lo: generated/transpose_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i4.lo `test -f 'generated/transpose_i4.c' || echo '$(srcdir)/'`generated/transpose_i4.c transpose_i8.lo: generated/transpose_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i8.lo `test -f 'generated/transpose_i8.c' || echo '$(srcdir)/'`generated/transpose_i8.c transpose_c4.lo: generated/transpose_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c4.lo `test -f 'generated/transpose_c4.c' || echo '$(srcdir)/'`generated/transpose_c4.c transpose_c8.lo: generated/transpose_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c8.lo `test -f 'generated/transpose_c8.c' || echo '$(srcdir)/'`generated/transpose_c8.c shape_i4.lo: generated/shape_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i4.lo `test -f 'generated/shape_i4.c' || echo '$(srcdir)/'`generated/shape_i4.c shape_i8.lo: generated/shape_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i8.lo `test -f 'generated/shape_i8.c' || echo '$(srcdir)/'`generated/shape_i8.c eoshift1_4.lo: generated/eoshift1_4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_4.lo `test -f 'generated/eoshift1_4.c' || echo '$(srcdir)/'`generated/eoshift1_4.c eoshift1_8.lo: generated/eoshift1_8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_8.lo `test -f 'generated/eoshift1_8.c' || echo '$(srcdir)/'`generated/eoshift1_8.c eoshift3_4.lo: generated/eoshift3_4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_4.lo `test -f 'generated/eoshift3_4.c' || echo '$(srcdir)/'`generated/eoshift3_4.c eoshift3_8.lo: generated/eoshift3_8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_8.lo `test -f 'generated/eoshift3_8.c' || echo '$(srcdir)/'`generated/eoshift3_8.c cshift1_4.lo: generated/cshift1_4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_4.lo `test -f 'generated/cshift1_4.c' || echo '$(srcdir)/'`generated/cshift1_4.c cshift1_8.lo: generated/cshift1_8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_8.lo `test -f 'generated/cshift1_8.c' || echo '$(srcdir)/'`generated/cshift1_8.c reshape_i4.lo: generated/reshape_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i4.lo `test -f 'generated/reshape_i4.c' || echo '$(srcdir)/'`generated/reshape_i4.c reshape_i8.lo: generated/reshape_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i8.lo `test -f 'generated/reshape_i8.c' || echo '$(srcdir)/'`generated/reshape_i8.c reshape_c4.lo: generated/reshape_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c4.lo `test -f 'generated/reshape_c4.c' || echo '$(srcdir)/'`generated/reshape_c4.c reshape_c8.lo: generated/reshape_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c8.lo `test -f 'generated/reshape_c8.c' || echo '$(srcdir)/'`generated/reshape_c8.c in_pack_i4.lo: generated/in_pack_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i4.lo `test -f 'generated/in_pack_i4.c' || echo '$(srcdir)/'`generated/in_pack_i4.c in_pack_i8.lo: generated/in_pack_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i8.lo `test -f 'generated/in_pack_i8.c' || echo '$(srcdir)/'`generated/in_pack_i8.c in_pack_c4.lo: generated/in_pack_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c4.lo `test -f 'generated/in_pack_c4.c' || echo '$(srcdir)/'`generated/in_pack_c4.c in_pack_c8.lo: generated/in_pack_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c8.lo `test -f 'generated/in_pack_c8.c' || echo '$(srcdir)/'`generated/in_pack_c8.c in_unpack_i4.lo: generated/in_unpack_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i4.lo `test -f 'generated/in_unpack_i4.c' || echo '$(srcdir)/'`generated/in_unpack_i4.c in_unpack_i8.lo: generated/in_unpack_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i8.lo `test -f 'generated/in_unpack_i8.c' || echo '$(srcdir)/'`generated/in_unpack_i8.c in_unpack_c4.lo: generated/in_unpack_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c4.lo `test -f 'generated/in_unpack_c4.c' || echo '$(srcdir)/'`generated/in_unpack_c4.c in_unpack_c8.lo: generated/in_unpack_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c8.lo `test -f 'generated/in_unpack_c8.c' || echo '$(srcdir)/'`generated/in_unpack_c8.c exponent_r4.lo: generated/exponent_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r4.lo `test -f 'generated/exponent_r4.c' || echo '$(srcdir)/'`generated/exponent_r4.c exponent_r8.lo: generated/exponent_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r8.lo `test -f 'generated/exponent_r8.c' || echo '$(srcdir)/'`generated/exponent_r8.c fraction_r4.lo: generated/fraction_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r4.lo `test -f 'generated/fraction_r4.c' || echo '$(srcdir)/'`generated/fraction_r4.c fraction_r8.lo: generated/fraction_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r8.lo `test -f 'generated/fraction_r8.c' || echo '$(srcdir)/'`generated/fraction_r8.c nearest_r4.lo: generated/nearest_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r4.lo `test -f 'generated/nearest_r4.c' || echo '$(srcdir)/'`generated/nearest_r4.c nearest_r8.lo: generated/nearest_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r8.lo `test -f 'generated/nearest_r8.c' || echo '$(srcdir)/'`generated/nearest_r8.c set_exponent_r4.lo: generated/set_exponent_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r4.lo `test -f 'generated/set_exponent_r4.c' || echo '$(srcdir)/'`generated/set_exponent_r4.c set_exponent_r8.lo: generated/set_exponent_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r8.lo `test -f 'generated/set_exponent_r8.c' || echo '$(srcdir)/'`generated/set_exponent_r8.c pow_i4_i4.lo: generated/pow_i4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i4.lo `test -f 'generated/pow_i4_i4.c' || echo '$(srcdir)/'`generated/pow_i4_i4.c pow_i8_i4.lo: generated/pow_i8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i4.lo `test -f 'generated/pow_i8_i4.c' || echo '$(srcdir)/'`generated/pow_i8_i4.c pow_r4_i4.lo: generated/pow_r4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i4.lo `test -f 'generated/pow_r4_i4.c' || echo '$(srcdir)/'`generated/pow_r4_i4.c pow_r8_i4.lo: generated/pow_r8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i4.lo `test -f 'generated/pow_r8_i4.c' || echo '$(srcdir)/'`generated/pow_r8_i4.c pow_c4_i4.lo: generated/pow_c4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i4.lo `test -f 'generated/pow_c4_i4.c' || echo '$(srcdir)/'`generated/pow_c4_i4.c pow_c8_i4.lo: generated/pow_c8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i4.lo `test -f 'generated/pow_c8_i4.c' || echo '$(srcdir)/'`generated/pow_c8_i4.c pow_i4_i8.lo: generated/pow_i4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i8.lo `test -f 'generated/pow_i4_i8.c' || echo '$(srcdir)/'`generated/pow_i4_i8.c pow_i8_i8.lo: generated/pow_i8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i8.lo `test -f 'generated/pow_i8_i8.c' || echo '$(srcdir)/'`generated/pow_i8_i8.c pow_r4_i8.lo: generated/pow_r4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i8.lo `test -f 'generated/pow_r4_i8.c' || echo '$(srcdir)/'`generated/pow_r4_i8.c pow_r8_i8.lo: generated/pow_r8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i8.lo `test -f 'generated/pow_r8_i8.c' || echo '$(srcdir)/'`generated/pow_r8_i8.c pow_c4_i8.lo: generated/pow_c4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i8.lo `test -f 'generated/pow_c4_i8.c' || echo '$(srcdir)/'`generated/pow_c4_i8.c pow_c8_i8.lo: generated/pow_c8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i8.lo `test -f 'generated/pow_c8_i8.c' || echo '$(srcdir)/'`generated/pow_c8_i8.c ! backspace.lo: io/backspace.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o backspace.lo `test -f 'io/backspace.c' || echo '$(srcdir)/'`io/backspace.c close.lo: io/close.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c ! endfile.lo: io/endfile.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o endfile.lo `test -f 'io/endfile.c' || echo '$(srcdir)/'`io/endfile.c format.lo: io/format.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o format.lo `test -f 'io/format.c' || echo '$(srcdir)/'`io/format.c --- 1435,2195 ---- all_l8.lo: generated/all_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l8.lo `test -f 'generated/all_l8.c' || echo '$(srcdir)/'`generated/all_l8.c + all_l16.lo: generated/all_l16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l16.lo `test -f 'generated/all_l16.c' || echo '$(srcdir)/'`generated/all_l16.c + any_l4.lo: generated/any_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l4.lo `test -f 'generated/any_l4.c' || echo '$(srcdir)/'`generated/any_l4.c any_l8.lo: generated/any_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l8.lo `test -f 'generated/any_l8.c' || echo '$(srcdir)/'`generated/any_l8.c + any_l16.lo: generated/any_l16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l16.lo `test -f 'generated/any_l16.c' || echo '$(srcdir)/'`generated/any_l16.c + count_4_l4.lo: generated/count_4_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l4.lo `test -f 'generated/count_4_l4.c' || echo '$(srcdir)/'`generated/count_4_l4.c count_8_l4.lo: generated/count_8_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l4.lo `test -f 'generated/count_8_l4.c' || echo '$(srcdir)/'`generated/count_8_l4.c + count_16_l4.lo: generated/count_16_l4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l4.lo `test -f 'generated/count_16_l4.c' || echo '$(srcdir)/'`generated/count_16_l4.c + count_4_l8.lo: generated/count_4_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l8.lo `test -f 'generated/count_4_l8.c' || echo '$(srcdir)/'`generated/count_4_l8.c count_8_l8.lo: generated/count_8_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l8.lo `test -f 'generated/count_8_l8.c' || echo '$(srcdir)/'`generated/count_8_l8.c + count_16_l8.lo: generated/count_16_l8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l8.lo `test -f 'generated/count_16_l8.c' || echo '$(srcdir)/'`generated/count_16_l8.c + + count_4_l16.lo: generated/count_4_l16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l16.lo `test -f 'generated/count_4_l16.c' || echo '$(srcdir)/'`generated/count_4_l16.c + + count_8_l16.lo: generated/count_8_l16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l16.lo `test -f 'generated/count_8_l16.c' || echo '$(srcdir)/'`generated/count_8_l16.c + + count_16_l16.lo: generated/count_16_l16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l16.lo `test -f 'generated/count_16_l16.c' || echo '$(srcdir)/'`generated/count_16_l16.c + maxloc0_4_i4.lo: generated/maxloc0_4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i4.lo `test -f 'generated/maxloc0_4_i4.c' || echo '$(srcdir)/'`generated/maxloc0_4_i4.c maxloc0_8_i4.lo: generated/maxloc0_8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i4.lo `test -f 'generated/maxloc0_8_i4.c' || echo '$(srcdir)/'`generated/maxloc0_8_i4.c + maxloc0_16_i4.lo: generated/maxloc0_16_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i4.lo `test -f 'generated/maxloc0_16_i4.c' || echo '$(srcdir)/'`generated/maxloc0_16_i4.c + maxloc0_4_i8.lo: generated/maxloc0_4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i8.lo `test -f 'generated/maxloc0_4_i8.c' || echo '$(srcdir)/'`generated/maxloc0_4_i8.c maxloc0_8_i8.lo: generated/maxloc0_8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i8.lo `test -f 'generated/maxloc0_8_i8.c' || echo '$(srcdir)/'`generated/maxloc0_8_i8.c + maxloc0_16_i8.lo: generated/maxloc0_16_i8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i8.lo `test -f 'generated/maxloc0_16_i8.c' || echo '$(srcdir)/'`generated/maxloc0_16_i8.c + + maxloc0_4_i16.lo: generated/maxloc0_4_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i16.lo `test -f 'generated/maxloc0_4_i16.c' || echo '$(srcdir)/'`generated/maxloc0_4_i16.c + + maxloc0_8_i16.lo: generated/maxloc0_8_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i16.lo `test -f 'generated/maxloc0_8_i16.c' || echo '$(srcdir)/'`generated/maxloc0_8_i16.c + + maxloc0_16_i16.lo: generated/maxloc0_16_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i16.lo `test -f 'generated/maxloc0_16_i16.c' || echo '$(srcdir)/'`generated/maxloc0_16_i16.c + maxloc0_4_r4.lo: generated/maxloc0_4_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r4.lo `test -f 'generated/maxloc0_4_r4.c' || echo '$(srcdir)/'`generated/maxloc0_4_r4.c maxloc0_8_r4.lo: generated/maxloc0_8_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r4.lo `test -f 'generated/maxloc0_8_r4.c' || echo '$(srcdir)/'`generated/maxloc0_8_r4.c + maxloc0_16_r4.lo: generated/maxloc0_16_r4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r4.lo `test -f 'generated/maxloc0_16_r4.c' || echo '$(srcdir)/'`generated/maxloc0_16_r4.c + maxloc0_4_r8.lo: generated/maxloc0_4_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r8.lo `test -f 'generated/maxloc0_4_r8.c' || echo '$(srcdir)/'`generated/maxloc0_4_r8.c maxloc0_8_r8.lo: generated/maxloc0_8_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r8.lo `test -f 'generated/maxloc0_8_r8.c' || echo '$(srcdir)/'`generated/maxloc0_8_r8.c + maxloc0_16_r8.lo: generated/maxloc0_16_r8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r8.lo `test -f 'generated/maxloc0_16_r8.c' || echo '$(srcdir)/'`generated/maxloc0_16_r8.c + + maxloc0_4_r10.lo: generated/maxloc0_4_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r10.lo `test -f 'generated/maxloc0_4_r10.c' || echo '$(srcdir)/'`generated/maxloc0_4_r10.c + + maxloc0_8_r10.lo: generated/maxloc0_8_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r10.lo `test -f 'generated/maxloc0_8_r10.c' || echo '$(srcdir)/'`generated/maxloc0_8_r10.c + + maxloc0_16_r10.lo: generated/maxloc0_16_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r10.lo `test -f 'generated/maxloc0_16_r10.c' || echo '$(srcdir)/'`generated/maxloc0_16_r10.c + + maxloc0_4_r16.lo: generated/maxloc0_4_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r16.lo `test -f 'generated/maxloc0_4_r16.c' || echo '$(srcdir)/'`generated/maxloc0_4_r16.c + + maxloc0_8_r16.lo: generated/maxloc0_8_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r16.lo `test -f 'generated/maxloc0_8_r16.c' || echo '$(srcdir)/'`generated/maxloc0_8_r16.c + + maxloc0_16_r16.lo: generated/maxloc0_16_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r16.lo `test -f 'generated/maxloc0_16_r16.c' || echo '$(srcdir)/'`generated/maxloc0_16_r16.c + maxloc1_4_i4.lo: generated/maxloc1_4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i4.lo `test -f 'generated/maxloc1_4_i4.c' || echo '$(srcdir)/'`generated/maxloc1_4_i4.c maxloc1_8_i4.lo: generated/maxloc1_8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i4.lo `test -f 'generated/maxloc1_8_i4.c' || echo '$(srcdir)/'`generated/maxloc1_8_i4.c + maxloc1_16_i4.lo: generated/maxloc1_16_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i4.lo `test -f 'generated/maxloc1_16_i4.c' || echo '$(srcdir)/'`generated/maxloc1_16_i4.c + maxloc1_4_i8.lo: generated/maxloc1_4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i8.lo `test -f 'generated/maxloc1_4_i8.c' || echo '$(srcdir)/'`generated/maxloc1_4_i8.c maxloc1_8_i8.lo: generated/maxloc1_8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i8.lo `test -f 'generated/maxloc1_8_i8.c' || echo '$(srcdir)/'`generated/maxloc1_8_i8.c + maxloc1_16_i8.lo: generated/maxloc1_16_i8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i8.lo `test -f 'generated/maxloc1_16_i8.c' || echo '$(srcdir)/'`generated/maxloc1_16_i8.c + + maxloc1_4_i16.lo: generated/maxloc1_4_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i16.lo `test -f 'generated/maxloc1_4_i16.c' || echo '$(srcdir)/'`generated/maxloc1_4_i16.c + + maxloc1_8_i16.lo: generated/maxloc1_8_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i16.lo `test -f 'generated/maxloc1_8_i16.c' || echo '$(srcdir)/'`generated/maxloc1_8_i16.c + + maxloc1_16_i16.lo: generated/maxloc1_16_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i16.lo `test -f 'generated/maxloc1_16_i16.c' || echo '$(srcdir)/'`generated/maxloc1_16_i16.c + maxloc1_4_r4.lo: generated/maxloc1_4_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r4.lo `test -f 'generated/maxloc1_4_r4.c' || echo '$(srcdir)/'`generated/maxloc1_4_r4.c maxloc1_8_r4.lo: generated/maxloc1_8_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r4.lo `test -f 'generated/maxloc1_8_r4.c' || echo '$(srcdir)/'`generated/maxloc1_8_r4.c + maxloc1_16_r4.lo: generated/maxloc1_16_r4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r4.lo `test -f 'generated/maxloc1_16_r4.c' || echo '$(srcdir)/'`generated/maxloc1_16_r4.c + maxloc1_4_r8.lo: generated/maxloc1_4_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r8.lo `test -f 'generated/maxloc1_4_r8.c' || echo '$(srcdir)/'`generated/maxloc1_4_r8.c maxloc1_8_r8.lo: generated/maxloc1_8_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r8.lo `test -f 'generated/maxloc1_8_r8.c' || echo '$(srcdir)/'`generated/maxloc1_8_r8.c + maxloc1_16_r8.lo: generated/maxloc1_16_r8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r8.lo `test -f 'generated/maxloc1_16_r8.c' || echo '$(srcdir)/'`generated/maxloc1_16_r8.c + + maxloc1_4_r10.lo: generated/maxloc1_4_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r10.lo `test -f 'generated/maxloc1_4_r10.c' || echo '$(srcdir)/'`generated/maxloc1_4_r10.c + + maxloc1_8_r10.lo: generated/maxloc1_8_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r10.lo `test -f 'generated/maxloc1_8_r10.c' || echo '$(srcdir)/'`generated/maxloc1_8_r10.c + + maxloc1_16_r10.lo: generated/maxloc1_16_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r10.lo `test -f 'generated/maxloc1_16_r10.c' || echo '$(srcdir)/'`generated/maxloc1_16_r10.c + + maxloc1_4_r16.lo: generated/maxloc1_4_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r16.lo `test -f 'generated/maxloc1_4_r16.c' || echo '$(srcdir)/'`generated/maxloc1_4_r16.c + + maxloc1_8_r16.lo: generated/maxloc1_8_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r16.lo `test -f 'generated/maxloc1_8_r16.c' || echo '$(srcdir)/'`generated/maxloc1_8_r16.c + + maxloc1_16_r16.lo: generated/maxloc1_16_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r16.lo `test -f 'generated/maxloc1_16_r16.c' || echo '$(srcdir)/'`generated/maxloc1_16_r16.c + maxval_i4.lo: generated/maxval_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i4.lo `test -f 'generated/maxval_i4.c' || echo '$(srcdir)/'`generated/maxval_i4.c maxval_i8.lo: generated/maxval_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i8.lo `test -f 'generated/maxval_i8.c' || echo '$(srcdir)/'`generated/maxval_i8.c + maxval_i16.lo: generated/maxval_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i16.lo `test -f 'generated/maxval_i16.c' || echo '$(srcdir)/'`generated/maxval_i16.c + maxval_r4.lo: generated/maxval_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r4.lo `test -f 'generated/maxval_r4.c' || echo '$(srcdir)/'`generated/maxval_r4.c maxval_r8.lo: generated/maxval_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r8.lo `test -f 'generated/maxval_r8.c' || echo '$(srcdir)/'`generated/maxval_r8.c + maxval_r10.lo: generated/maxval_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r10.lo `test -f 'generated/maxval_r10.c' || echo '$(srcdir)/'`generated/maxval_r10.c + + maxval_r16.lo: generated/maxval_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r16.lo `test -f 'generated/maxval_r16.c' || echo '$(srcdir)/'`generated/maxval_r16.c + minloc0_4_i4.lo: generated/minloc0_4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i4.lo `test -f 'generated/minloc0_4_i4.c' || echo '$(srcdir)/'`generated/minloc0_4_i4.c minloc0_8_i4.lo: generated/minloc0_8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i4.lo `test -f 'generated/minloc0_8_i4.c' || echo '$(srcdir)/'`generated/minloc0_8_i4.c + minloc0_16_i4.lo: generated/minloc0_16_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i4.lo `test -f 'generated/minloc0_16_i4.c' || echo '$(srcdir)/'`generated/minloc0_16_i4.c + minloc0_4_i8.lo: generated/minloc0_4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i8.lo `test -f 'generated/minloc0_4_i8.c' || echo '$(srcdir)/'`generated/minloc0_4_i8.c minloc0_8_i8.lo: generated/minloc0_8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i8.lo `test -f 'generated/minloc0_8_i8.c' || echo '$(srcdir)/'`generated/minloc0_8_i8.c + minloc0_16_i8.lo: generated/minloc0_16_i8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i8.lo `test -f 'generated/minloc0_16_i8.c' || echo '$(srcdir)/'`generated/minloc0_16_i8.c + + minloc0_4_i16.lo: generated/minloc0_4_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i16.lo `test -f 'generated/minloc0_4_i16.c' || echo '$(srcdir)/'`generated/minloc0_4_i16.c + + minloc0_8_i16.lo: generated/minloc0_8_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i16.lo `test -f 'generated/minloc0_8_i16.c' || echo '$(srcdir)/'`generated/minloc0_8_i16.c + + minloc0_16_i16.lo: generated/minloc0_16_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i16.lo `test -f 'generated/minloc0_16_i16.c' || echo '$(srcdir)/'`generated/minloc0_16_i16.c + minloc0_4_r4.lo: generated/minloc0_4_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r4.lo `test -f 'generated/minloc0_4_r4.c' || echo '$(srcdir)/'`generated/minloc0_4_r4.c minloc0_8_r4.lo: generated/minloc0_8_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r4.lo `test -f 'generated/minloc0_8_r4.c' || echo '$(srcdir)/'`generated/minloc0_8_r4.c + minloc0_16_r4.lo: generated/minloc0_16_r4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r4.lo `test -f 'generated/minloc0_16_r4.c' || echo '$(srcdir)/'`generated/minloc0_16_r4.c + minloc0_4_r8.lo: generated/minloc0_4_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r8.lo `test -f 'generated/minloc0_4_r8.c' || echo '$(srcdir)/'`generated/minloc0_4_r8.c minloc0_8_r8.lo: generated/minloc0_8_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r8.lo `test -f 'generated/minloc0_8_r8.c' || echo '$(srcdir)/'`generated/minloc0_8_r8.c + minloc0_16_r8.lo: generated/minloc0_16_r8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r8.lo `test -f 'generated/minloc0_16_r8.c' || echo '$(srcdir)/'`generated/minloc0_16_r8.c + + minloc0_4_r10.lo: generated/minloc0_4_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r10.lo `test -f 'generated/minloc0_4_r10.c' || echo '$(srcdir)/'`generated/minloc0_4_r10.c + + minloc0_8_r10.lo: generated/minloc0_8_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r10.lo `test -f 'generated/minloc0_8_r10.c' || echo '$(srcdir)/'`generated/minloc0_8_r10.c + + minloc0_16_r10.lo: generated/minloc0_16_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r10.lo `test -f 'generated/minloc0_16_r10.c' || echo '$(srcdir)/'`generated/minloc0_16_r10.c + + minloc0_4_r16.lo: generated/minloc0_4_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r16.lo `test -f 'generated/minloc0_4_r16.c' || echo '$(srcdir)/'`generated/minloc0_4_r16.c + + minloc0_8_r16.lo: generated/minloc0_8_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r16.lo `test -f 'generated/minloc0_8_r16.c' || echo '$(srcdir)/'`generated/minloc0_8_r16.c + + minloc0_16_r16.lo: generated/minloc0_16_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r16.lo `test -f 'generated/minloc0_16_r16.c' || echo '$(srcdir)/'`generated/minloc0_16_r16.c + minloc1_4_i4.lo: generated/minloc1_4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i4.lo `test -f 'generated/minloc1_4_i4.c' || echo '$(srcdir)/'`generated/minloc1_4_i4.c minloc1_8_i4.lo: generated/minloc1_8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i4.lo `test -f 'generated/minloc1_8_i4.c' || echo '$(srcdir)/'`generated/minloc1_8_i4.c + minloc1_16_i4.lo: generated/minloc1_16_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i4.lo `test -f 'generated/minloc1_16_i4.c' || echo '$(srcdir)/'`generated/minloc1_16_i4.c + minloc1_4_i8.lo: generated/minloc1_4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i8.lo `test -f 'generated/minloc1_4_i8.c' || echo '$(srcdir)/'`generated/minloc1_4_i8.c minloc1_8_i8.lo: generated/minloc1_8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i8.lo `test -f 'generated/minloc1_8_i8.c' || echo '$(srcdir)/'`generated/minloc1_8_i8.c + minloc1_16_i8.lo: generated/minloc1_16_i8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i8.lo `test -f 'generated/minloc1_16_i8.c' || echo '$(srcdir)/'`generated/minloc1_16_i8.c + + minloc1_4_i16.lo: generated/minloc1_4_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i16.lo `test -f 'generated/minloc1_4_i16.c' || echo '$(srcdir)/'`generated/minloc1_4_i16.c + + minloc1_8_i16.lo: generated/minloc1_8_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i16.lo `test -f 'generated/minloc1_8_i16.c' || echo '$(srcdir)/'`generated/minloc1_8_i16.c + + minloc1_16_i16.lo: generated/minloc1_16_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i16.lo `test -f 'generated/minloc1_16_i16.c' || echo '$(srcdir)/'`generated/minloc1_16_i16.c + minloc1_4_r4.lo: generated/minloc1_4_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r4.lo `test -f 'generated/minloc1_4_r4.c' || echo '$(srcdir)/'`generated/minloc1_4_r4.c minloc1_8_r4.lo: generated/minloc1_8_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r4.lo `test -f 'generated/minloc1_8_r4.c' || echo '$(srcdir)/'`generated/minloc1_8_r4.c + minloc1_16_r4.lo: generated/minloc1_16_r4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r4.lo `test -f 'generated/minloc1_16_r4.c' || echo '$(srcdir)/'`generated/minloc1_16_r4.c + minloc1_4_r8.lo: generated/minloc1_4_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r8.lo `test -f 'generated/minloc1_4_r8.c' || echo '$(srcdir)/'`generated/minloc1_4_r8.c minloc1_8_r8.lo: generated/minloc1_8_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r8.lo `test -f 'generated/minloc1_8_r8.c' || echo '$(srcdir)/'`generated/minloc1_8_r8.c + minloc1_16_r8.lo: generated/minloc1_16_r8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r8.lo `test -f 'generated/minloc1_16_r8.c' || echo '$(srcdir)/'`generated/minloc1_16_r8.c + + minloc1_4_r10.lo: generated/minloc1_4_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r10.lo `test -f 'generated/minloc1_4_r10.c' || echo '$(srcdir)/'`generated/minloc1_4_r10.c + + minloc1_8_r10.lo: generated/minloc1_8_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r10.lo `test -f 'generated/minloc1_8_r10.c' || echo '$(srcdir)/'`generated/minloc1_8_r10.c + + minloc1_16_r10.lo: generated/minloc1_16_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r10.lo `test -f 'generated/minloc1_16_r10.c' || echo '$(srcdir)/'`generated/minloc1_16_r10.c + + minloc1_4_r16.lo: generated/minloc1_4_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r16.lo `test -f 'generated/minloc1_4_r16.c' || echo '$(srcdir)/'`generated/minloc1_4_r16.c + + minloc1_8_r16.lo: generated/minloc1_8_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r16.lo `test -f 'generated/minloc1_8_r16.c' || echo '$(srcdir)/'`generated/minloc1_8_r16.c + + minloc1_16_r16.lo: generated/minloc1_16_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r16.lo `test -f 'generated/minloc1_16_r16.c' || echo '$(srcdir)/'`generated/minloc1_16_r16.c + minval_i4.lo: generated/minval_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i4.lo `test -f 'generated/minval_i4.c' || echo '$(srcdir)/'`generated/minval_i4.c minval_i8.lo: generated/minval_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i8.lo `test -f 'generated/minval_i8.c' || echo '$(srcdir)/'`generated/minval_i8.c + minval_i16.lo: generated/minval_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i16.lo `test -f 'generated/minval_i16.c' || echo '$(srcdir)/'`generated/minval_i16.c + minval_r4.lo: generated/minval_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r4.lo `test -f 'generated/minval_r4.c' || echo '$(srcdir)/'`generated/minval_r4.c minval_r8.lo: generated/minval_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r8.lo `test -f 'generated/minval_r8.c' || echo '$(srcdir)/'`generated/minval_r8.c + minval_r10.lo: generated/minval_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r10.lo `test -f 'generated/minval_r10.c' || echo '$(srcdir)/'`generated/minval_r10.c + + minval_r16.lo: generated/minval_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r16.lo `test -f 'generated/minval_r16.c' || echo '$(srcdir)/'`generated/minval_r16.c + product_i4.lo: generated/product_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i4.lo `test -f 'generated/product_i4.c' || echo '$(srcdir)/'`generated/product_i4.c product_i8.lo: generated/product_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i8.lo `test -f 'generated/product_i8.c' || echo '$(srcdir)/'`generated/product_i8.c + product_i16.lo: generated/product_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i16.lo `test -f 'generated/product_i16.c' || echo '$(srcdir)/'`generated/product_i16.c + product_r4.lo: generated/product_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r4.lo `test -f 'generated/product_r4.c' || echo '$(srcdir)/'`generated/product_r4.c product_r8.lo: generated/product_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r8.lo `test -f 'generated/product_r8.c' || echo '$(srcdir)/'`generated/product_r8.c + product_r10.lo: generated/product_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r10.lo `test -f 'generated/product_r10.c' || echo '$(srcdir)/'`generated/product_r10.c + + product_r16.lo: generated/product_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r16.lo `test -f 'generated/product_r16.c' || echo '$(srcdir)/'`generated/product_r16.c + product_c4.lo: generated/product_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c4.lo `test -f 'generated/product_c4.c' || echo '$(srcdir)/'`generated/product_c4.c product_c8.lo: generated/product_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c8.lo `test -f 'generated/product_c8.c' || echo '$(srcdir)/'`generated/product_c8.c + product_c10.lo: generated/product_c10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c10.lo `test -f 'generated/product_c10.c' || echo '$(srcdir)/'`generated/product_c10.c + + product_c16.lo: generated/product_c16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c16.lo `test -f 'generated/product_c16.c' || echo '$(srcdir)/'`generated/product_c16.c + sum_i4.lo: generated/sum_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i4.lo `test -f 'generated/sum_i4.c' || echo '$(srcdir)/'`generated/sum_i4.c sum_i8.lo: generated/sum_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i8.lo `test -f 'generated/sum_i8.c' || echo '$(srcdir)/'`generated/sum_i8.c + sum_i16.lo: generated/sum_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i16.lo `test -f 'generated/sum_i16.c' || echo '$(srcdir)/'`generated/sum_i16.c + sum_r4.lo: generated/sum_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r4.lo `test -f 'generated/sum_r4.c' || echo '$(srcdir)/'`generated/sum_r4.c sum_r8.lo: generated/sum_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r8.lo `test -f 'generated/sum_r8.c' || echo '$(srcdir)/'`generated/sum_r8.c + sum_r10.lo: generated/sum_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r10.lo `test -f 'generated/sum_r10.c' || echo '$(srcdir)/'`generated/sum_r10.c + + sum_r16.lo: generated/sum_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r16.lo `test -f 'generated/sum_r16.c' || echo '$(srcdir)/'`generated/sum_r16.c + sum_c4.lo: generated/sum_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c4.lo `test -f 'generated/sum_c4.c' || echo '$(srcdir)/'`generated/sum_c4.c sum_c8.lo: generated/sum_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c8.lo `test -f 'generated/sum_c8.c' || echo '$(srcdir)/'`generated/sum_c8.c + sum_c10.lo: generated/sum_c10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c10.lo `test -f 'generated/sum_c10.c' || echo '$(srcdir)/'`generated/sum_c10.c + + sum_c16.lo: generated/sum_c16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c16.lo `test -f 'generated/sum_c16.c' || echo '$(srcdir)/'`generated/sum_c16.c + dotprod_i4.lo: generated/dotprod_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i4.lo `test -f 'generated/dotprod_i4.c' || echo '$(srcdir)/'`generated/dotprod_i4.c dotprod_i8.lo: generated/dotprod_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i8.lo `test -f 'generated/dotprod_i8.c' || echo '$(srcdir)/'`generated/dotprod_i8.c + dotprod_i16.lo: generated/dotprod_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i16.lo `test -f 'generated/dotprod_i16.c' || echo '$(srcdir)/'`generated/dotprod_i16.c + dotprod_r4.lo: generated/dotprod_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r4.lo `test -f 'generated/dotprod_r4.c' || echo '$(srcdir)/'`generated/dotprod_r4.c dotprod_r8.lo: generated/dotprod_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r8.lo `test -f 'generated/dotprod_r8.c' || echo '$(srcdir)/'`generated/dotprod_r8.c + dotprod_r10.lo: generated/dotprod_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r10.lo `test -f 'generated/dotprod_r10.c' || echo '$(srcdir)/'`generated/dotprod_r10.c + + dotprod_r16.lo: generated/dotprod_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r16.lo `test -f 'generated/dotprod_r16.c' || echo '$(srcdir)/'`generated/dotprod_r16.c + dotprod_l4.lo: generated/dotprod_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l4.lo `test -f 'generated/dotprod_l4.c' || echo '$(srcdir)/'`generated/dotprod_l4.c dotprod_l8.lo: generated/dotprod_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l8.lo `test -f 'generated/dotprod_l8.c' || echo '$(srcdir)/'`generated/dotprod_l8.c + dotprod_l16.lo: generated/dotprod_l16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l16.lo `test -f 'generated/dotprod_l16.c' || echo '$(srcdir)/'`generated/dotprod_l16.c + dotprod_c4.lo: generated/dotprod_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c4.lo `test -f 'generated/dotprod_c4.c' || echo '$(srcdir)/'`generated/dotprod_c4.c dotprod_c8.lo: generated/dotprod_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c8.lo `test -f 'generated/dotprod_c8.c' || echo '$(srcdir)/'`generated/dotprod_c8.c + dotprod_c10.lo: generated/dotprod_c10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c10.lo `test -f 'generated/dotprod_c10.c' || echo '$(srcdir)/'`generated/dotprod_c10.c + + dotprod_c16.lo: generated/dotprod_c16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c16.lo `test -f 'generated/dotprod_c16.c' || echo '$(srcdir)/'`generated/dotprod_c16.c + matmul_i4.lo: generated/matmul_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i4.lo `test -f 'generated/matmul_i4.c' || echo '$(srcdir)/'`generated/matmul_i4.c matmul_i8.lo: generated/matmul_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i8.lo `test -f 'generated/matmul_i8.c' || echo '$(srcdir)/'`generated/matmul_i8.c + matmul_i16.lo: generated/matmul_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i16.lo `test -f 'generated/matmul_i16.c' || echo '$(srcdir)/'`generated/matmul_i16.c + matmul_r4.lo: generated/matmul_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r4.lo `test -f 'generated/matmul_r4.c' || echo '$(srcdir)/'`generated/matmul_r4.c matmul_r8.lo: generated/matmul_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r8.lo `test -f 'generated/matmul_r8.c' || echo '$(srcdir)/'`generated/matmul_r8.c + matmul_r10.lo: generated/matmul_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r10.lo `test -f 'generated/matmul_r10.c' || echo '$(srcdir)/'`generated/matmul_r10.c + + matmul_r16.lo: generated/matmul_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r16.lo `test -f 'generated/matmul_r16.c' || echo '$(srcdir)/'`generated/matmul_r16.c + matmul_c4.lo: generated/matmul_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c4.lo `test -f 'generated/matmul_c4.c' || echo '$(srcdir)/'`generated/matmul_c4.c matmul_c8.lo: generated/matmul_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c8.lo `test -f 'generated/matmul_c8.c' || echo '$(srcdir)/'`generated/matmul_c8.c + matmul_c10.lo: generated/matmul_c10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c10.lo `test -f 'generated/matmul_c10.c' || echo '$(srcdir)/'`generated/matmul_c10.c + + matmul_c16.lo: generated/matmul_c16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c16.lo `test -f 'generated/matmul_c16.c' || echo '$(srcdir)/'`generated/matmul_c16.c + matmul_l4.lo: generated/matmul_l4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l4.lo `test -f 'generated/matmul_l4.c' || echo '$(srcdir)/'`generated/matmul_l4.c matmul_l8.lo: generated/matmul_l8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l8.lo `test -f 'generated/matmul_l8.c' || echo '$(srcdir)/'`generated/matmul_l8.c + matmul_l16.lo: generated/matmul_l16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l16.lo `test -f 'generated/matmul_l16.c' || echo '$(srcdir)/'`generated/matmul_l16.c + transpose_i4.lo: generated/transpose_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i4.lo `test -f 'generated/transpose_i4.c' || echo '$(srcdir)/'`generated/transpose_i4.c transpose_i8.lo: generated/transpose_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i8.lo `test -f 'generated/transpose_i8.c' || echo '$(srcdir)/'`generated/transpose_i8.c + transpose_i16.lo: generated/transpose_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i16.lo `test -f 'generated/transpose_i16.c' || echo '$(srcdir)/'`generated/transpose_i16.c + transpose_c4.lo: generated/transpose_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c4.lo `test -f 'generated/transpose_c4.c' || echo '$(srcdir)/'`generated/transpose_c4.c transpose_c8.lo: generated/transpose_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c8.lo `test -f 'generated/transpose_c8.c' || echo '$(srcdir)/'`generated/transpose_c8.c + transpose_c10.lo: generated/transpose_c10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c10.lo `test -f 'generated/transpose_c10.c' || echo '$(srcdir)/'`generated/transpose_c10.c + + transpose_c16.lo: generated/transpose_c16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c16.lo `test -f 'generated/transpose_c16.c' || echo '$(srcdir)/'`generated/transpose_c16.c + shape_i4.lo: generated/shape_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i4.lo `test -f 'generated/shape_i4.c' || echo '$(srcdir)/'`generated/shape_i4.c shape_i8.lo: generated/shape_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i8.lo `test -f 'generated/shape_i8.c' || echo '$(srcdir)/'`generated/shape_i8.c + shape_i16.lo: generated/shape_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i16.lo `test -f 'generated/shape_i16.c' || echo '$(srcdir)/'`generated/shape_i16.c + eoshift1_4.lo: generated/eoshift1_4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_4.lo `test -f 'generated/eoshift1_4.c' || echo '$(srcdir)/'`generated/eoshift1_4.c eoshift1_8.lo: generated/eoshift1_8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_8.lo `test -f 'generated/eoshift1_8.c' || echo '$(srcdir)/'`generated/eoshift1_8.c + eoshift1_16.lo: generated/eoshift1_16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_16.lo `test -f 'generated/eoshift1_16.c' || echo '$(srcdir)/'`generated/eoshift1_16.c + eoshift3_4.lo: generated/eoshift3_4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_4.lo `test -f 'generated/eoshift3_4.c' || echo '$(srcdir)/'`generated/eoshift3_4.c eoshift3_8.lo: generated/eoshift3_8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_8.lo `test -f 'generated/eoshift3_8.c' || echo '$(srcdir)/'`generated/eoshift3_8.c + eoshift3_16.lo: generated/eoshift3_16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_16.lo `test -f 'generated/eoshift3_16.c' || echo '$(srcdir)/'`generated/eoshift3_16.c + cshift1_4.lo: generated/cshift1_4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_4.lo `test -f 'generated/cshift1_4.c' || echo '$(srcdir)/'`generated/cshift1_4.c cshift1_8.lo: generated/cshift1_8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_8.lo `test -f 'generated/cshift1_8.c' || echo '$(srcdir)/'`generated/cshift1_8.c + cshift1_16.lo: generated/cshift1_16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_16.lo `test -f 'generated/cshift1_16.c' || echo '$(srcdir)/'`generated/cshift1_16.c + reshape_i4.lo: generated/reshape_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i4.lo `test -f 'generated/reshape_i4.c' || echo '$(srcdir)/'`generated/reshape_i4.c reshape_i8.lo: generated/reshape_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i8.lo `test -f 'generated/reshape_i8.c' || echo '$(srcdir)/'`generated/reshape_i8.c + reshape_i16.lo: generated/reshape_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i16.lo `test -f 'generated/reshape_i16.c' || echo '$(srcdir)/'`generated/reshape_i16.c + reshape_c4.lo: generated/reshape_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c4.lo `test -f 'generated/reshape_c4.c' || echo '$(srcdir)/'`generated/reshape_c4.c reshape_c8.lo: generated/reshape_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c8.lo `test -f 'generated/reshape_c8.c' || echo '$(srcdir)/'`generated/reshape_c8.c + reshape_c10.lo: generated/reshape_c10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c10.lo `test -f 'generated/reshape_c10.c' || echo '$(srcdir)/'`generated/reshape_c10.c + + reshape_c16.lo: generated/reshape_c16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c16.lo `test -f 'generated/reshape_c16.c' || echo '$(srcdir)/'`generated/reshape_c16.c + in_pack_i4.lo: generated/in_pack_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i4.lo `test -f 'generated/in_pack_i4.c' || echo '$(srcdir)/'`generated/in_pack_i4.c in_pack_i8.lo: generated/in_pack_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i8.lo `test -f 'generated/in_pack_i8.c' || echo '$(srcdir)/'`generated/in_pack_i8.c + in_pack_i16.lo: generated/in_pack_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i16.lo `test -f 'generated/in_pack_i16.c' || echo '$(srcdir)/'`generated/in_pack_i16.c + in_pack_c4.lo: generated/in_pack_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c4.lo `test -f 'generated/in_pack_c4.c' || echo '$(srcdir)/'`generated/in_pack_c4.c in_pack_c8.lo: generated/in_pack_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c8.lo `test -f 'generated/in_pack_c8.c' || echo '$(srcdir)/'`generated/in_pack_c8.c + in_pack_c10.lo: generated/in_pack_c10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c10.lo `test -f 'generated/in_pack_c10.c' || echo '$(srcdir)/'`generated/in_pack_c10.c + + in_pack_c16.lo: generated/in_pack_c16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c16.lo `test -f 'generated/in_pack_c16.c' || echo '$(srcdir)/'`generated/in_pack_c16.c + in_unpack_i4.lo: generated/in_unpack_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i4.lo `test -f 'generated/in_unpack_i4.c' || echo '$(srcdir)/'`generated/in_unpack_i4.c in_unpack_i8.lo: generated/in_unpack_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i8.lo `test -f 'generated/in_unpack_i8.c' || echo '$(srcdir)/'`generated/in_unpack_i8.c + in_unpack_i16.lo: generated/in_unpack_i16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i16.lo `test -f 'generated/in_unpack_i16.c' || echo '$(srcdir)/'`generated/in_unpack_i16.c + in_unpack_c4.lo: generated/in_unpack_c4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c4.lo `test -f 'generated/in_unpack_c4.c' || echo '$(srcdir)/'`generated/in_unpack_c4.c in_unpack_c8.lo: generated/in_unpack_c8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c8.lo `test -f 'generated/in_unpack_c8.c' || echo '$(srcdir)/'`generated/in_unpack_c8.c + in_unpack_c10.lo: generated/in_unpack_c10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c10.lo `test -f 'generated/in_unpack_c10.c' || echo '$(srcdir)/'`generated/in_unpack_c10.c + + in_unpack_c16.lo: generated/in_unpack_c16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c16.lo `test -f 'generated/in_unpack_c16.c' || echo '$(srcdir)/'`generated/in_unpack_c16.c + exponent_r4.lo: generated/exponent_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r4.lo `test -f 'generated/exponent_r4.c' || echo '$(srcdir)/'`generated/exponent_r4.c exponent_r8.lo: generated/exponent_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r8.lo `test -f 'generated/exponent_r8.c' || echo '$(srcdir)/'`generated/exponent_r8.c + exponent_r10.lo: generated/exponent_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r10.lo `test -f 'generated/exponent_r10.c' || echo '$(srcdir)/'`generated/exponent_r10.c + + exponent_r16.lo: generated/exponent_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r16.lo `test -f 'generated/exponent_r16.c' || echo '$(srcdir)/'`generated/exponent_r16.c + fraction_r4.lo: generated/fraction_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r4.lo `test -f 'generated/fraction_r4.c' || echo '$(srcdir)/'`generated/fraction_r4.c fraction_r8.lo: generated/fraction_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r8.lo `test -f 'generated/fraction_r8.c' || echo '$(srcdir)/'`generated/fraction_r8.c + fraction_r10.lo: generated/fraction_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r10.lo `test -f 'generated/fraction_r10.c' || echo '$(srcdir)/'`generated/fraction_r10.c + + fraction_r16.lo: generated/fraction_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r16.lo `test -f 'generated/fraction_r16.c' || echo '$(srcdir)/'`generated/fraction_r16.c + nearest_r4.lo: generated/nearest_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r4.lo `test -f 'generated/nearest_r4.c' || echo '$(srcdir)/'`generated/nearest_r4.c nearest_r8.lo: generated/nearest_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r8.lo `test -f 'generated/nearest_r8.c' || echo '$(srcdir)/'`generated/nearest_r8.c + nearest_r10.lo: generated/nearest_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r10.lo `test -f 'generated/nearest_r10.c' || echo '$(srcdir)/'`generated/nearest_r10.c + + nearest_r16.lo: generated/nearest_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r16.lo `test -f 'generated/nearest_r16.c' || echo '$(srcdir)/'`generated/nearest_r16.c + set_exponent_r4.lo: generated/set_exponent_r4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r4.lo `test -f 'generated/set_exponent_r4.c' || echo '$(srcdir)/'`generated/set_exponent_r4.c set_exponent_r8.lo: generated/set_exponent_r8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r8.lo `test -f 'generated/set_exponent_r8.c' || echo '$(srcdir)/'`generated/set_exponent_r8.c + set_exponent_r10.lo: generated/set_exponent_r10.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r10.lo `test -f 'generated/set_exponent_r10.c' || echo '$(srcdir)/'`generated/set_exponent_r10.c + + set_exponent_r16.lo: generated/set_exponent_r16.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r16.lo `test -f 'generated/set_exponent_r16.c' || echo '$(srcdir)/'`generated/set_exponent_r16.c + pow_i4_i4.lo: generated/pow_i4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i4.lo `test -f 'generated/pow_i4_i4.c' || echo '$(srcdir)/'`generated/pow_i4_i4.c pow_i8_i4.lo: generated/pow_i8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i4.lo `test -f 'generated/pow_i8_i4.c' || echo '$(srcdir)/'`generated/pow_i8_i4.c + pow_i16_i4.lo: generated/pow_i16_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i4.lo `test -f 'generated/pow_i16_i4.c' || echo '$(srcdir)/'`generated/pow_i16_i4.c + pow_r4_i4.lo: generated/pow_r4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i4.lo `test -f 'generated/pow_r4_i4.c' || echo '$(srcdir)/'`generated/pow_r4_i4.c pow_r8_i4.lo: generated/pow_r8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i4.lo `test -f 'generated/pow_r8_i4.c' || echo '$(srcdir)/'`generated/pow_r8_i4.c + pow_r10_i4.lo: generated/pow_r10_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i4.lo `test -f 'generated/pow_r10_i4.c' || echo '$(srcdir)/'`generated/pow_r10_i4.c + + pow_r16_i4.lo: generated/pow_r16_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i4.lo `test -f 'generated/pow_r16_i4.c' || echo '$(srcdir)/'`generated/pow_r16_i4.c + pow_c4_i4.lo: generated/pow_c4_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i4.lo `test -f 'generated/pow_c4_i4.c' || echo '$(srcdir)/'`generated/pow_c4_i4.c pow_c8_i4.lo: generated/pow_c8_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i4.lo `test -f 'generated/pow_c8_i4.c' || echo '$(srcdir)/'`generated/pow_c8_i4.c + pow_c10_i4.lo: generated/pow_c10_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i4.lo `test -f 'generated/pow_c10_i4.c' || echo '$(srcdir)/'`generated/pow_c10_i4.c + + pow_c16_i4.lo: generated/pow_c16_i4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i4.lo `test -f 'generated/pow_c16_i4.c' || echo '$(srcdir)/'`generated/pow_c16_i4.c + pow_i4_i8.lo: generated/pow_i4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i8.lo `test -f 'generated/pow_i4_i8.c' || echo '$(srcdir)/'`generated/pow_i4_i8.c pow_i8_i8.lo: generated/pow_i8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i8.lo `test -f 'generated/pow_i8_i8.c' || echo '$(srcdir)/'`generated/pow_i8_i8.c + pow_i16_i8.lo: generated/pow_i16_i8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i8.lo `test -f 'generated/pow_i16_i8.c' || echo '$(srcdir)/'`generated/pow_i16_i8.c + pow_r4_i8.lo: generated/pow_r4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i8.lo `test -f 'generated/pow_r4_i8.c' || echo '$(srcdir)/'`generated/pow_r4_i8.c pow_r8_i8.lo: generated/pow_r8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i8.lo `test -f 'generated/pow_r8_i8.c' || echo '$(srcdir)/'`generated/pow_r8_i8.c + pow_r10_i8.lo: generated/pow_r10_i8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i8.lo `test -f 'generated/pow_r10_i8.c' || echo '$(srcdir)/'`generated/pow_r10_i8.c + + pow_r16_i8.lo: generated/pow_r16_i8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i8.lo `test -f 'generated/pow_r16_i8.c' || echo '$(srcdir)/'`generated/pow_r16_i8.c + pow_c4_i8.lo: generated/pow_c4_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i8.lo `test -f 'generated/pow_c4_i8.c' || echo '$(srcdir)/'`generated/pow_c4_i8.c pow_c8_i8.lo: generated/pow_c8_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i8.lo `test -f 'generated/pow_c8_i8.c' || echo '$(srcdir)/'`generated/pow_c8_i8.c ! pow_c10_i8.lo: generated/pow_c10_i8.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i8.lo `test -f 'generated/pow_c10_i8.c' || echo '$(srcdir)/'`generated/pow_c10_i8.c ! ! pow_c16_i8.lo: generated/pow_c16_i8.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i8.lo `test -f 'generated/pow_c16_i8.c' || echo '$(srcdir)/'`generated/pow_c16_i8.c ! ! pow_i4_i16.lo: generated/pow_i4_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i16.lo `test -f 'generated/pow_i4_i16.c' || echo '$(srcdir)/'`generated/pow_i4_i16.c ! ! pow_i8_i16.lo: generated/pow_i8_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i16.lo `test -f 'generated/pow_i8_i16.c' || echo '$(srcdir)/'`generated/pow_i8_i16.c ! ! pow_i16_i16.lo: generated/pow_i16_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i16.lo `test -f 'generated/pow_i16_i16.c' || echo '$(srcdir)/'`generated/pow_i16_i16.c ! ! pow_r4_i16.lo: generated/pow_r4_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i16.lo `test -f 'generated/pow_r4_i16.c' || echo '$(srcdir)/'`generated/pow_r4_i16.c ! ! pow_r8_i16.lo: generated/pow_r8_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i16.lo `test -f 'generated/pow_r8_i16.c' || echo '$(srcdir)/'`generated/pow_r8_i16.c ! ! pow_r10_i16.lo: generated/pow_r10_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i16.lo `test -f 'generated/pow_r10_i16.c' || echo '$(srcdir)/'`generated/pow_r10_i16.c ! ! pow_r16_i16.lo: generated/pow_r16_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i16.lo `test -f 'generated/pow_r16_i16.c' || echo '$(srcdir)/'`generated/pow_r16_i16.c ! ! pow_c4_i16.lo: generated/pow_c4_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i16.lo `test -f 'generated/pow_c4_i16.c' || echo '$(srcdir)/'`generated/pow_c4_i16.c ! ! pow_c8_i16.lo: generated/pow_c8_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i16.lo `test -f 'generated/pow_c8_i16.c' || echo '$(srcdir)/'`generated/pow_c8_i16.c ! ! pow_c10_i16.lo: generated/pow_c10_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i16.lo `test -f 'generated/pow_c10_i16.c' || echo '$(srcdir)/'`generated/pow_c10_i16.c ! ! pow_c16_i16.lo: generated/pow_c16_i16.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i16.lo `test -f 'generated/pow_c16_i16.c' || echo '$(srcdir)/'`generated/pow_c16_i16.c close.lo: io/close.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c ! file_pos.lo: io/file_pos.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o file_pos.lo `test -f 'io/file_pos.c' || echo '$(srcdir)/'`io/file_pos.c format.lo: io/format.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o format.lo `test -f 'io/format.c' || echo '$(srcdir)/'`io/format.c *************** open.lo: io/open.c *** 1249,1256 **** read.lo: io/read.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o read.lo `test -f 'io/read.c' || echo '$(srcdir)/'`io/read.c ! rewind.lo: io/rewind.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rewind.lo `test -f 'io/rewind.c' || echo '$(srcdir)/'`io/rewind.c transfer.lo: io/transfer.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transfer.lo `test -f 'io/transfer.c' || echo '$(srcdir)/'`io/transfer.c --- 2209,2216 ---- read.lo: io/read.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o read.lo `test -f 'io/read.c' || echo '$(srcdir)/'`io/read.c ! size_from_kind.lo: io/size_from_kind.c ! $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o size_from_kind.lo `test -f 'io/size_from_kind.c' || echo '$(srcdir)/'`io/size_from_kind.c transfer.lo: io/transfer.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transfer.lo `test -f 'io/transfer.c' || echo '$(srcdir)/'`io/transfer.c *************** cpu_time.lo: intrinsics/cpu_time.c *** 1288,1293 **** --- 2248,2256 ---- cshift0.lo: intrinsics/cshift0.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0.lo `test -f 'intrinsics/cshift0.c' || echo '$(srcdir)/'`intrinsics/cshift0.c + ctime.lo: intrinsics/ctime.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ctime.lo `test -f 'intrinsics/ctime.c' || echo '$(srcdir)/'`intrinsics/ctime.c + date_and_time.lo: intrinsics/date_and_time.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o date_and_time.lo `test -f 'intrinsics/date_and_time.c' || echo '$(srcdir)/'`intrinsics/date_and_time.c *************** etime.lo: intrinsics/etime.c *** 1309,1320 **** --- 2272,2289 ---- exit.lo: intrinsics/exit.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exit.lo `test -f 'intrinsics/exit.c' || echo '$(srcdir)/'`intrinsics/exit.c + fget.lo: intrinsics/fget.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fget.lo `test -f 'intrinsics/fget.c' || echo '$(srcdir)/'`intrinsics/fget.c + flush.lo: intrinsics/flush.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o flush.lo `test -f 'intrinsics/flush.c' || echo '$(srcdir)/'`intrinsics/flush.c fnum.lo: intrinsics/fnum.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fnum.lo `test -f 'intrinsics/fnum.c' || echo '$(srcdir)/'`intrinsics/fnum.c + ftell.lo: intrinsics/ftell.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ftell.lo `test -f 'intrinsics/ftell.c' || echo '$(srcdir)/'`intrinsics/ftell.c + gerror.lo: intrinsics/gerror.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o gerror.lo `test -f 'intrinsics/gerror.c' || echo '$(srcdir)/'`intrinsics/gerror.c *************** getlog.lo: intrinsics/getlog.c *** 1327,1332 **** --- 2296,2304 ---- getXid.lo: intrinsics/getXid.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o getXid.lo `test -f 'intrinsics/getXid.c' || echo '$(srcdir)/'`intrinsics/getXid.c + hyper.lo: intrinsics/hyper.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o hyper.lo `test -f 'intrinsics/hyper.c' || echo '$(srcdir)/'`intrinsics/hyper.c + hostnm.lo: intrinsics/hostnm.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o hostnm.lo `test -f 'intrinsics/hostnm.c' || echo '$(srcdir)/'`intrinsics/hostnm.c *************** ishftc.lo: intrinsics/ishftc.c *** 1342,1347 **** --- 2314,2322 ---- link.lo: intrinsics/link.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o link.lo `test -f 'intrinsics/link.c' || echo '$(srcdir)/'`intrinsics/link.c + malloc.lo: intrinsics/malloc.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o malloc.lo `test -f 'intrinsics/malloc.c' || echo '$(srcdir)/'`intrinsics/malloc.c + mvbits.lo: intrinsics/mvbits.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mvbits.lo `test -f 'intrinsics/mvbits.c' || echo '$(srcdir)/'`intrinsics/mvbits.c *************** pack_generic.lo: intrinsics/pack_generic *** 1351,1356 **** --- 2326,2334 ---- perror.lo: intrinsics/perror.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o perror.lo `test -f 'intrinsics/perror.c' || echo '$(srcdir)/'`intrinsics/perror.c + signal.lo: intrinsics/signal.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o signal.lo `test -f 'intrinsics/signal.c' || echo '$(srcdir)/'`intrinsics/signal.c + size.lo: intrinsics/size.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o size.lo `test -f 'intrinsics/size.c' || echo '$(srcdir)/'`intrinsics/size.c *************** in_unpack_generic.lo: runtime/in_unpack_ *** 1417,1440 **** normalize.lo: runtime/normalize.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o normalize.lo `test -f 'runtime/normalize.c' || echo '$(srcdir)/'`runtime/normalize.c - trig_c4.lo: generated/trig_c4.c - $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o trig_c4.lo `test -f 'generated/trig_c4.c' || echo '$(srcdir)/'`generated/trig_c4.c - - trig_c8.lo: generated/trig_c8.c - $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o trig_c8.lo `test -f 'generated/trig_c8.c' || echo '$(srcdir)/'`generated/trig_c8.c - - exp_c4.lo: generated/exp_c4.c - $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exp_c4.lo `test -f 'generated/exp_c4.c' || echo '$(srcdir)/'`generated/exp_c4.c - - exp_c8.lo: generated/exp_c8.c - $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exp_c8.lo `test -f 'generated/exp_c8.c' || echo '$(srcdir)/'`generated/exp_c8.c - - hyp_c4.lo: generated/hyp_c4.c - $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o hyp_c4.lo `test -f 'generated/hyp_c4.c' || echo '$(srcdir)/'`generated/hyp_c4.c - - hyp_c8.lo: generated/hyp_c8.c - $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o hyp_c8.lo `test -f 'generated/hyp_c8.c' || echo '$(srcdir)/'`generated/hyp_c8.c - .f90.o: $(FCCOMPILE) -c -o $@ $< --- 2395,2400 ---- *************** selected_int_kind.lo: intrinsics/selecte *** 1450,1641 **** selected_real_kind.lo: intrinsics/selected_real_kind.f90 $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o selected_real_kind.lo `test -f 'intrinsics/selected_real_kind.f90' || echo '$(srcdir)/'`intrinsics/selected_real_kind.f90 - _abs_c4.lo: generated/_abs_c4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c4.lo `test -f 'generated/_abs_c4.f90' || echo '$(srcdir)/'`generated/_abs_c4.f90 - - _abs_c8.lo: generated/_abs_c8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c8.lo `test -f 'generated/_abs_c8.f90' || echo '$(srcdir)/'`generated/_abs_c8.f90 - - _abs_i4.lo: generated/_abs_i4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i4.lo `test -f 'generated/_abs_i4.f90' || echo '$(srcdir)/'`generated/_abs_i4.f90 - - _abs_i8.lo: generated/_abs_i8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i8.lo `test -f 'generated/_abs_i8.f90' || echo '$(srcdir)/'`generated/_abs_i8.f90 - - _abs_r4.lo: generated/_abs_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r4.lo `test -f 'generated/_abs_r4.f90' || echo '$(srcdir)/'`generated/_abs_r4.f90 - - _abs_r8.lo: generated/_abs_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r8.lo `test -f 'generated/_abs_r8.f90' || echo '$(srcdir)/'`generated/_abs_r8.f90 - - _exp_r4.lo: generated/_exp_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r4.lo `test -f 'generated/_exp_r4.f90' || echo '$(srcdir)/'`generated/_exp_r4.f90 - - _exp_r8.lo: generated/_exp_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r8.lo `test -f 'generated/_exp_r8.f90' || echo '$(srcdir)/'`generated/_exp_r8.f90 - - _exp_c4.lo: generated/_exp_c4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c4.lo `test -f 'generated/_exp_c4.f90' || echo '$(srcdir)/'`generated/_exp_c4.f90 - - _exp_c8.lo: generated/_exp_c8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c8.lo `test -f 'generated/_exp_c8.f90' || echo '$(srcdir)/'`generated/_exp_c8.f90 - - _log_r4.lo: generated/_log_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r4.lo `test -f 'generated/_log_r4.f90' || echo '$(srcdir)/'`generated/_log_r4.f90 - - _log_r8.lo: generated/_log_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r8.lo `test -f 'generated/_log_r8.f90' || echo '$(srcdir)/'`generated/_log_r8.f90 - - _log_c4.lo: generated/_log_c4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c4.lo `test -f 'generated/_log_c4.f90' || echo '$(srcdir)/'`generated/_log_c4.f90 - - _log_c8.lo: generated/_log_c8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c8.lo `test -f 'generated/_log_c8.f90' || echo '$(srcdir)/'`generated/_log_c8.f90 - - _log10_r4.lo: generated/_log10_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r4.lo `test -f 'generated/_log10_r4.f90' || echo '$(srcdir)/'`generated/_log10_r4.f90 - - _log10_r8.lo: generated/_log10_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r8.lo `test -f 'generated/_log10_r8.f90' || echo '$(srcdir)/'`generated/_log10_r8.f90 - - _sqrt_r4.lo: generated/_sqrt_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r4.lo `test -f 'generated/_sqrt_r4.f90' || echo '$(srcdir)/'`generated/_sqrt_r4.f90 - - _sqrt_r8.lo: generated/_sqrt_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r8.lo `test -f 'generated/_sqrt_r8.f90' || echo '$(srcdir)/'`generated/_sqrt_r8.f90 - - _sqrt_c4.lo: generated/_sqrt_c4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c4.lo `test -f 'generated/_sqrt_c4.f90' || echo '$(srcdir)/'`generated/_sqrt_c4.f90 - - _sqrt_c8.lo: generated/_sqrt_c8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c8.lo `test -f 'generated/_sqrt_c8.f90' || echo '$(srcdir)/'`generated/_sqrt_c8.f90 - - _asin_r4.lo: generated/_asin_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r4.lo `test -f 'generated/_asin_r4.f90' || echo '$(srcdir)/'`generated/_asin_r4.f90 - - _asin_r8.lo: generated/_asin_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r8.lo `test -f 'generated/_asin_r8.f90' || echo '$(srcdir)/'`generated/_asin_r8.f90 - - _acos_r4.lo: generated/_acos_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r4.lo `test -f 'generated/_acos_r4.f90' || echo '$(srcdir)/'`generated/_acos_r4.f90 - - _acos_r8.lo: generated/_acos_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r8.lo `test -f 'generated/_acos_r8.f90' || echo '$(srcdir)/'`generated/_acos_r8.f90 - - _atan_r4.lo: generated/_atan_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r4.lo `test -f 'generated/_atan_r4.f90' || echo '$(srcdir)/'`generated/_atan_r4.f90 - - _atan_r8.lo: generated/_atan_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r8.lo `test -f 'generated/_atan_r8.f90' || echo '$(srcdir)/'`generated/_atan_r8.f90 - - _sin_r4.lo: generated/_sin_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r4.lo `test -f 'generated/_sin_r4.f90' || echo '$(srcdir)/'`generated/_sin_r4.f90 - - _sin_r8.lo: generated/_sin_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r8.lo `test -f 'generated/_sin_r8.f90' || echo '$(srcdir)/'`generated/_sin_r8.f90 - - _sin_c4.lo: generated/_sin_c4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c4.lo `test -f 'generated/_sin_c4.f90' || echo '$(srcdir)/'`generated/_sin_c4.f90 - - _sin_c8.lo: generated/_sin_c8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c8.lo `test -f 'generated/_sin_c8.f90' || echo '$(srcdir)/'`generated/_sin_c8.f90 - - _cos_r4.lo: generated/_cos_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r4.lo `test -f 'generated/_cos_r4.f90' || echo '$(srcdir)/'`generated/_cos_r4.f90 - - _cos_r8.lo: generated/_cos_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r8.lo `test -f 'generated/_cos_r8.f90' || echo '$(srcdir)/'`generated/_cos_r8.f90 - - _cos_c4.lo: generated/_cos_c4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c4.lo `test -f 'generated/_cos_c4.f90' || echo '$(srcdir)/'`generated/_cos_c4.f90 - - _cos_c8.lo: generated/_cos_c8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c8.lo `test -f 'generated/_cos_c8.f90' || echo '$(srcdir)/'`generated/_cos_c8.f90 - - _tan_r4.lo: generated/_tan_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r4.lo `test -f 'generated/_tan_r4.f90' || echo '$(srcdir)/'`generated/_tan_r4.f90 - - _tan_r8.lo: generated/_tan_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r8.lo `test -f 'generated/_tan_r8.f90' || echo '$(srcdir)/'`generated/_tan_r8.f90 - - _sinh_r4.lo: generated/_sinh_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r4.lo `test -f 'generated/_sinh_r4.f90' || echo '$(srcdir)/'`generated/_sinh_r4.f90 - - _sinh_r8.lo: generated/_sinh_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r8.lo `test -f 'generated/_sinh_r8.f90' || echo '$(srcdir)/'`generated/_sinh_r8.f90 - - _cosh_r4.lo: generated/_cosh_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r4.lo `test -f 'generated/_cosh_r4.f90' || echo '$(srcdir)/'`generated/_cosh_r4.f90 - - _cosh_r8.lo: generated/_cosh_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r8.lo `test -f 'generated/_cosh_r8.f90' || echo '$(srcdir)/'`generated/_cosh_r8.f90 - - _tanh_r4.lo: generated/_tanh_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r4.lo `test -f 'generated/_tanh_r4.f90' || echo '$(srcdir)/'`generated/_tanh_r4.f90 - - _tanh_r8.lo: generated/_tanh_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r8.lo `test -f 'generated/_tanh_r8.f90' || echo '$(srcdir)/'`generated/_tanh_r8.f90 - - _conjg_c4.lo: generated/_conjg_c4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c4.lo `test -f 'generated/_conjg_c4.f90' || echo '$(srcdir)/'`generated/_conjg_c4.f90 - - _conjg_c8.lo: generated/_conjg_c8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c8.lo `test -f 'generated/_conjg_c8.f90' || echo '$(srcdir)/'`generated/_conjg_c8.f90 - - _aint_r4.lo: generated/_aint_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r4.lo `test -f 'generated/_aint_r4.f90' || echo '$(srcdir)/'`generated/_aint_r4.f90 - - _aint_r8.lo: generated/_aint_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r8.lo `test -f 'generated/_aint_r8.f90' || echo '$(srcdir)/'`generated/_aint_r8.f90 - - _anint_r4.lo: generated/_anint_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r4.lo `test -f 'generated/_anint_r4.f90' || echo '$(srcdir)/'`generated/_anint_r4.f90 - - _anint_r8.lo: generated/_anint_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r8.lo `test -f 'generated/_anint_r8.f90' || echo '$(srcdir)/'`generated/_anint_r8.f90 - - _sign_i4.lo: generated/_sign_i4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i4.lo `test -f 'generated/_sign_i4.f90' || echo '$(srcdir)/'`generated/_sign_i4.f90 - - _sign_i8.lo: generated/_sign_i8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i8.lo `test -f 'generated/_sign_i8.f90' || echo '$(srcdir)/'`generated/_sign_i8.f90 - - _sign_r4.lo: generated/_sign_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r4.lo `test -f 'generated/_sign_r4.f90' || echo '$(srcdir)/'`generated/_sign_r4.f90 - - _sign_r8.lo: generated/_sign_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r8.lo `test -f 'generated/_sign_r8.f90' || echo '$(srcdir)/'`generated/_sign_r8.f90 - - _dim_i4.lo: generated/_dim_i4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i4.lo `test -f 'generated/_dim_i4.f90' || echo '$(srcdir)/'`generated/_dim_i4.f90 - - _dim_i8.lo: generated/_dim_i8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i8.lo `test -f 'generated/_dim_i8.f90' || echo '$(srcdir)/'`generated/_dim_i8.f90 - - _dim_r4.lo: generated/_dim_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r4.lo `test -f 'generated/_dim_r4.f90' || echo '$(srcdir)/'`generated/_dim_r4.f90 - - _dim_r8.lo: generated/_dim_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r8.lo `test -f 'generated/_dim_r8.f90' || echo '$(srcdir)/'`generated/_dim_r8.f90 - - _atan2_r4.lo: generated/_atan2_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r4.lo `test -f 'generated/_atan2_r4.f90' || echo '$(srcdir)/'`generated/_atan2_r4.f90 - - _atan2_r8.lo: generated/_atan2_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r8.lo `test -f 'generated/_atan2_r8.f90' || echo '$(srcdir)/'`generated/_atan2_r8.f90 - - _mod_i4.lo: generated/_mod_i4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i4.lo `test -f 'generated/_mod_i4.f90' || echo '$(srcdir)/'`generated/_mod_i4.f90 - - _mod_i8.lo: generated/_mod_i8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i8.lo `test -f 'generated/_mod_i8.f90' || echo '$(srcdir)/'`generated/_mod_i8.f90 - - _mod_r4.lo: generated/_mod_r4.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r4.lo `test -f 'generated/_mod_r4.f90' || echo '$(srcdir)/'`generated/_mod_r4.f90 - - _mod_r8.lo: generated/_mod_r8.f90 - $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r8.lo `test -f 'generated/_mod_r8.f90' || echo '$(srcdir)/'`generated/_mod_r8.f90 - dprod_r8.lo: intrinsics/dprod_r8.f90 $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o dprod_r8.lo `test -f 'intrinsics/dprod_r8.f90' || echo '$(srcdir)/'`intrinsics/dprod_r8.f90 --- 2410,2415 ---- *************** uninstall-am: uninstall-info-am uninstal *** 1945,1955 **** uninstall-toolexeclibLTLIBRARIES selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh ! $(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh ! $(SHELL) $(srcdir)/mk-srk-inc.sh '$(FCCOMPILE)' > $@ @MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS1) @MAINTAINER_MODE_TRUE@ m4 -Dfile=$@ -I$(srcdir)/m4 all.m4 > $(srcdir)/$@ --- 2719,2744 ---- uninstall-toolexeclibLTLIBRARIES + # Turn on vectorization for matmul. + $(patsubst %.c,%.lo,$(notdir $(i_matmul_c))): AM_CFLAGS += -ftree-vectorize + + kinds.h: $(srcdir)/mk-kinds-h.sh + $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@ + + kinds.inc: kinds.h + grep '^#' < kinds.h > $@ + + c99_protos.inc: $(srcdir)/c99_protos.h + grep '^#' < $(srcdir)/c99_protos.h > $@ + selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh ! $(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@ || rm $@ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh ! $(SHELL) $(srcdir)/mk-srk-inc.sh '$(FCCOMPILE)' > $@ || rm $@ ! ! fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER) ! cp $(srcdir)/$(FPU_HOST_HEADER) $@ @MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS1) @MAINTAINER_MODE_TRUE@ m4 -Dfile=$@ -I$(srcdir)/m4 all.m4 > $(srcdir)/$@ *************** selected_real_kind.inc: $(srcdir)/mk-srk *** 2038,2052 **** @MAINTAINER_MODE_TRUE@$(i_pow_c): m4/pow.m4 $(I_M4_DEPS) @MAINTAINER_MODE_TRUE@ m4 -Dfile=$@ -I$(srcdir)/m4 pow.m4 > $(srcdir)/$@ - @MAINTAINER_MODE_TRUE@$(gfor_math_trig_c): m4/ctrig.m4 m4/mtype.m4 - @MAINTAINER_MODE_TRUE@ m4 -Dfile=$@ -I$(srcdir)/m4 ctrig.m4 > $(srcdir)/$@ - - @MAINTAINER_MODE_TRUE@$(gfor_math_exp_c): m4/cexp.m4 m4/mtype.m4 - @MAINTAINER_MODE_TRUE@ m4 -Dfile=$@ -I$(srcdir)/m4 cexp.m4 > $(srcdir)/$@ - - @MAINTAINER_MODE_TRUE@$(gfor_math_hyp_c): m4/chyp.m4 m4/mtype.m4 - @MAINTAINER_MODE_TRUE@ m4 -Dfile=$@ -I$(srcdir)/m4 chyp.m4 > $(srcdir)/$@ - @MAINTAINER_MODE_TRUE@$(gfor_built_specific_src): m4/specific.m4 m4/head.m4 @MAINTAINER_MODE_TRUE@ m4 -Dfile=$@ -I$(srcdir)/m4 specific.m4 > $(srcdir)/$@ --- 2827,2832 ---- diff -Nrcpad gcc-4.0.2/libgfortran/acinclude.m4 gcc-4.1.0/libgfortran/acinclude.m4 *** gcc-4.0.2/libgfortran/acinclude.m4 Wed Sep 7 21:31:55 2005 --- gcc-4.1.0/libgfortran/acinclude.m4 Tue Dec 13 08:18:54 2005 *************** *** 1,3 **** --- 1,6 ---- + m4_include(../config/acx.m4) + m4_include(../config/no-executables.m4) + dnl Check: dnl * If we have gettimeofday; dnl * If we have struct timezone for use in calling it; *************** extern void bar(void) __attribute__((ali *** 149,154 **** --- 152,201 ---- [Define to 1 if the target supports __attribute__((alias(...))).]) fi]) + dnl Check whether the target supports __sync_fetch_and_add. + AC_DEFUN([LIBGFOR_CHECK_SYNC_FETCH_AND_ADD], [ + AC_CACHE_CHECK([whether the target supports __sync_fetch_and_add], + have_sync_fetch_and_add, [ + AC_TRY_LINK([int foovar = 0;], [ + if (foovar <= 0) return __sync_fetch_and_add (&foovar, 1); + if (foovar > 10) return __sync_add_and_fetch (&foovar, -1);], + have_sync_fetch_and_add=yes, have_sync_fetch_and_add=no)]) + if test $have_sync_fetch_and_add = yes; then + AC_DEFINE(HAVE_SYNC_FETCH_AND_ADD, 1, + [Define to 1 if the target supports __sync_fetch_and_add]) + fi]) + + dnl Check if threads are supported. + AC_DEFUN([LIBGFOR_CHECK_GTHR_DEFAULT], [ + AC_CACHE_CHECK([configured target thread model], + target_thread_file, [ + target_thread_file=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'`]) + + if test $target_thread_file != single; then + AC_DEFINE(HAVE_GTHR_DEFAULT, 1, + [Define if the compiler has a thread header that is non single.]) + fi]) + + dnl Check for pragma weak. + AC_DEFUN([LIBGFOR_GTHREAD_WEAK], [ + AC_CACHE_CHECK([whether pragma weak works], + have_pragma_weak, [ + gfor_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Wunknown-pragmas" + AC_TRY_COMPILE([void foo (void); + #pragma weak foo], [if (foo) foo ();], + have_pragma_weak=yes, have_pragma_weak=no)]) + if test $have_pragma_weak = yes; then + AC_DEFINE(SUPPORTS_WEAK, 1, + [Define to 1 if the target supports #pragma weak]) + fi + case "$host" in + *-*-darwin* | *-*-hpux* | *-*-cygwin*) + AC_DEFINE(GTHREAD_USE_WEAK, 0, + [Define to 0 if the target shouldn't use #pragma weak]) + ;; + esac]) + dnl Check whether target can unlink a file still open. AC_DEFUN([LIBGFOR_CHECK_UNLINK_OPEN_FILE], [ AC_CACHE_CHECK([whether the target can unlink an open file], *************** esac])]) *** 230,232 **** --- 277,450 ---- if test x"$have_crlf" = xyes; then AC_DEFINE(HAVE_CRLF, 1, [Define if CRLF is line terminator.]) fi]) + + dnl Check whether isfinite is broken. + dnl The most common problem is that it does not work on long doubles. + AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_ISFINITE], [ + AC_CACHE_CHECK([whether isfinite is broken], + have_broken_isfinite, [ + libgfor_check_for_broken_isfinite_save_LIBS=$LIBS + LIBS="$LIBS -lm" + AC_TRY_RUN([ + #ifdef HAVE_MATH_H + #include + #endif + #include + int main () + { + #ifdef isfinite + #ifdef LDBL_MAX + if (!isfinite(LDBL_MAX)) return 1; + #endif + #ifdef DBL_MAX + if (!isfinite(DBL_MAX)) return 1; + #endif + #endif + return 0; + }], have_broken_isfinite=no, have_broken_isfinite=yes, [ + case "${target}" in + hppa*-*-hpux*) have_broken_isfinite=yes ;; + *) have_broken_isfinite=no ;; + esac])] + LIBS=$libgfor_check_for_broken_isfinite_save_LIBS) + if test x"$have_broken_isfinite" = xyes; then + AC_DEFINE(HAVE_BROKEN_ISFINITE, 1, [Define if isfinite is broken.]) + fi]) + + dnl Check whether isnan is broken. + dnl The most common problem is that it does not work on long doubles. + AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_ISNAN], [ + AC_CACHE_CHECK([whether isnan is broken], + have_broken_isnan, [ + libgfor_check_for_broken_isnan_save_LIBS=$LIBS + LIBS="$LIBS -lm" + AC_TRY_RUN([ + #ifdef HAVE_MATH_H + #include + #endif + #include + int main () + { + #ifdef isnan + #ifdef LDBL_MAX + { + long double x; + x = __builtin_nanl (""); + if (!isnan(x)) return 1; + if (isnan(LDBL_MAX)) return 1; + #ifdef NAN + x = (long double) NAN; + if (!isnan(x)) return 1; + #endif + } + #endif + #ifdef DBL_MAX + { + double y; + y = __builtin_nan (""); + if (!isnan(y)) return 1; + if (isnan(DBL_MAX)) return 1; + #ifdef NAN + y = (double) NAN; + if (!isnan(y)) return 1; + #endif + } + #endif + #endif + return 0; + }], have_broken_isnan=no, have_broken_isnan=yes, [ + case "${target}" in + hppa*-*-hpux*) have_broken_isnan=yes ;; + *) have_broken_isnan=no ;; + esac])] + LIBS=$libgfor_check_for_broken_isnan_save_LIBS) + if test x"$have_broken_isnan" = xyes; then + AC_DEFINE(HAVE_BROKEN_ISNAN, 1, [Define if isnan is broken.]) + fi]) + + dnl Check whether fpclassify is broken. + dnl The most common problem is that it does not work on long doubles. + AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY], [ + AC_CACHE_CHECK([whether fpclassify is broken], + have_broken_fpclassify, [ + libgfor_check_for_broken_fpclassify_save_LIBS=$LIBS + LIBS="$LIBS -lm" + AC_TRY_RUN([ + #ifdef HAVE_MATH_H + #include + #endif + #include + int main () + { + #ifdef fpclassify + #ifdef LDBL_MAX + if (fpclassify(LDBL_MAX) == FP_NAN + || fpclassify(LDBL_MAX) == FP_INFINITE) return 1; + #endif + #ifdef DBL_MAX + if (fpclassify(DBL_MAX) == FP_NAN + || fpclassify(DBL_MAX) == FP_INFINITE) return 1; + #endif + #endif + return 0; + }], have_broken_fpclassify=no, have_broken_fpclassify=yes, [ + case "${target}" in + hppa*-*-hpux*) have_broken_fpclassify=yes ;; + *) have_broken_fpclassify=no ;; + esac])] + LIBS=$libgfor_check_for_broken_fpclassify_save_LIBS) + if test x"$have_broken_fpclassify" = xyes; then + AC_DEFINE(HAVE_BROKEN_FPCLASSIFY, 1, [Define if fpclassify is broken.]) + fi]) + + dnl Check whether the st_ino and st_dev stat fields taken together uniquely + dnl identify the file within the system. This is should be true for POSIX + dnl systems; it is known to be false on mingw32. + AC_DEFUN([LIBGFOR_CHECK_WORKING_STAT], [ + AC_CACHE_CHECK([whether the target stat is reliable], + have_working_stat, [ + AC_TRY_RUN([ + #include + #include + #include + #include + + int main () + { + FILE *f, *g; + struct stat st1, st2; + + f = fopen ("foo", "w"); + g = fopen ("bar", "w"); + if (stat ("foo", &st1) != 0 || stat ("bar", &st2)) + return 1; + if (st1.st_dev == st2.st_dev && st1.st_ino == st2.st_ino) + return 1; + fclose(f); + fclose(g); + return 0; + }], have_working_stat=yes, have_working_stat=no, [ + case "${target}" in + *mingw*) have_working_stat=no ;; + *) have_working_stat=yes;; + esac])]) + if test x"$have_working_stat" = xyes; then + AC_DEFINE(HAVE_WORKING_STAT, 1, [Define if target has a reliable stat.]) + fi]) + + dnl Checks for fpsetmask function. + AC_DEFUN([LIBGFOR_CHECK_FPSETMASK], [ + AC_CACHE_CHECK([whether fpsetmask is present], have_fpsetmask, [ + AC_TRY_LINK([ + #if HAVE_FLOATINGPOINT_H + # include + #endif /* HAVE_FLOATINGPOINT_H */ + #if HAVE_IEEEFP_H + # include + #endif /* HAVE_IEEEFP_H */],[fpsetmask(0);], + eval "have_fpsetmask=yes", eval "have_fpsetmask=no") + ]) + if test x"$have_fpsetmask" = xyes; then + AC_DEFINE(HAVE_FPSETMASK, 1, [Define if you have fpsetmask.]) + fi + ]) diff -Nrcpad gcc-4.0.2/libgfortran/aclocal.m4 gcc-4.1.0/libgfortran/aclocal.m4 *** gcc-4.0.2/libgfortran/aclocal.m4 Wed Sep 28 06:16:38 2005 --- gcc-4.1.0/libgfortran/aclocal.m4 Tue Feb 28 08:39:11 2006 *************** *** 1,7 **** ! # generated automatically by aclocal 1.9.4 -*- Autoconf -*- ! # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ! # Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. --- 1,7 ---- ! # generated automatically by aclocal 1.9.6 -*- Autoconf -*- ! # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, ! # 2005 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. *************** *** 11,33 **** # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. ! # -*- Autoconf -*- ! # Copyright (C) 2002, 2003 Free Software Foundation, Inc. ! # Generated from amversion.in; do not edit by hand. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # AM_AUTOMAKE_VERSION(VERSION) # ---------------------------- --- 11,21 ---- # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. ! # Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc. ! # ! # This file is free software; the Free Software Foundation ! # gives unlimited permission to copy and/or distribute it, ! # with or without modifications, as long as this notice is preserved. # AM_AUTOMAKE_VERSION(VERSION) # ---------------------------- *************** AC_DEFUN([AM_AUTOMAKE_VERSION], [am__api *** 40,65 **** # Call AM_AUTOMAKE_VERSION so it can be traced. # This function is AC_REQUIREd by AC_INIT_AUTOMAKE. AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION], ! [AM_AUTOMAKE_VERSION([1.9.4])]) ! ! # AM_AUX_DIR_EXPAND ! ! # Copyright (C) 2001, 2003 Free Software Foundation, Inc. ! ! # This program 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. ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. # For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets # $ac_aux_dir to `$srcdir/foo'. In other projects, it is set to --- 28,42 ---- # Call AM_AUTOMAKE_VERSION so it can be traced. # This function is AC_REQUIREd by AC_INIT_AUTOMAKE. AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION], ! [AM_AUTOMAKE_VERSION([1.9.6])]) ! # AM_AUX_DIR_EXPAND -*- Autoconf -*- ! # Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. ! # ! # This file is free software; the Free Software Foundation ! # gives unlimited permission to copy and/or distribute it, ! # with or without modifications, as long as this notice is preserved. # For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets # $ac_aux_dir to `$srcdir/foo'. In other projects, it is set to *************** AC_PREREQ([2.50])dnl *** 106,131 **** am_aux_dir=`cd $ac_aux_dir && pwd` ]) ! # AM_CONDITIONAL -*- Autoconf -*- ! ! # Copyright (C) 1997, 2000, 2001, 2003, 2004 Free Software Foundation, Inc. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! # serial 6 # AM_CONDITIONAL(NAME, SHELL-CONDITION) # ------------------------------------- --- 83,98 ---- am_aux_dir=`cd $ac_aux_dir && pwd` ]) ! # AM_CONDITIONAL -*- Autoconf -*- ! # Copyright (C) 1997, 2000, 2001, 2003, 2004, 2005 ! # Free Software Foundation, Inc. ! # ! # This file is free software; the Free Software Foundation ! # gives unlimited permission to copy and/or distribute it, ! # with or without modifications, as long as this notice is preserved. ! # serial 7 # AM_CONDITIONAL(NAME, SHELL-CONDITION) # ------------------------------------- *************** AC_CONFIG_COMMANDS_PRE( *** 149,178 **** Usually this means the macro was only invoked conditionally.]]) fi])]) ! # Do all the work for Automake. -*- Autoconf -*- ! ! # This macro actually does too much some checks are only needed if ! # your package does certain things. But this isn't really a big deal. ! # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 # Free Software Foundation, Inc. ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! # serial 11 # AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE]) # AM_INIT_AUTOMAKE([OPTIONS]) --- 116,134 ---- Usually this means the macro was only invoked conditionally.]]) fi])]) ! # Do all the work for Automake. -*- Autoconf -*- ! # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 # Free Software Foundation, Inc. + # + # This file is free software; the Free Software Foundation + # gives unlimited permission to copy and/or distribute it, + # with or without modifications, as long as this notice is preserved. ! # serial 12 ! # This macro actually does too much. Some checks are only needed if ! # your package does certain things. But this isn't really a big deal. # AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE]) # AM_INIT_AUTOMAKE([OPTIONS]) *************** for _am_header in $config_headers :; do *** 274,360 **** done echo "timestamp for $1" >`AS_DIRNAME([$1])`/stamp-h[]$_am_stamp_count]) # AM_PROG_INSTALL_SH # ------------------ # Define $install_sh. - - # Copyright (C) 2001, 2003 Free Software Foundation, Inc. - - # This program 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. - - # This program 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 this program; if not, write to the Free Software - # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA - # 02111-1307, USA. - AC_DEFUN([AM_PROG_INSTALL_SH], [AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl install_sh=${install_sh-"$am_aux_dir/install-sh"} AC_SUBST(install_sh)]) ! # -*- Autoconf -*- ! # Copyright (C) 2003 Free Software Foundation, Inc. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! ! # serial 1 ! ! # Check whether the underlying file-system supports filenames ! # with a leading dot. For instance MS-DOS doesn't. ! AC_DEFUN([AM_SET_LEADING_DOT], ! [rm -rf .tst 2>/dev/null ! mkdir .tst 2>/dev/null ! if test -d .tst; then ! am__leading_dot=. ! else ! am__leading_dot=_ ! fi ! rmdir .tst 2>/dev/null ! AC_SUBST([am__leading_dot])]) ! ! # Add --enable-maintainer-mode option to configure. # From Jim Meyering ! # Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004 # Free Software Foundation, Inc. ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! ! # serial 3 AC_DEFUN([AM_MAINTAINER_MODE], [AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles]) --- 230,260 ---- done echo "timestamp for $1" >`AS_DIRNAME([$1])`/stamp-h[]$_am_stamp_count]) + # Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. + # + # This file is free software; the Free Software Foundation + # gives unlimited permission to copy and/or distribute it, + # with or without modifications, as long as this notice is preserved. + # AM_PROG_INSTALL_SH # ------------------ # Define $install_sh. AC_DEFUN([AM_PROG_INSTALL_SH], [AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl install_sh=${install_sh-"$am_aux_dir/install-sh"} AC_SUBST(install_sh)]) ! # Add --enable-maintainer-mode option to configure. -*- Autoconf -*- # From Jim Meyering ! # Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005 # Free Software Foundation, Inc. + # + # This file is free software; the Free Software Foundation + # gives unlimited permission to copy and/or distribute it, + # with or without modifications, as long as this notice is preserved. ! # serial 4 AC_DEFUN([AM_MAINTAINER_MODE], [AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles]) *************** AC_DEFUN([AM_MAINTAINER_MODE], *** 373,399 **** AU_DEFUN([jm_MAINTAINER_MODE], [AM_MAINTAINER_MODE]) ! # -*- Autoconf -*- ! ! ! # Copyright (C) 1997, 1999, 2000, 2001, 2003 Free Software Foundation, Inc. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! # serial 3 # AM_MISSING_PROG(NAME, PROGRAM) # ------------------------------ --- 273,288 ---- AU_DEFUN([jm_MAINTAINER_MODE], [AM_MAINTAINER_MODE]) ! # Fake the existence of programs that GNU maintainers use. -*- Autoconf -*- ! # Copyright (C) 1997, 1999, 2000, 2001, 2003, 2005 ! # Free Software Foundation, Inc. ! # ! # This file is free software; the Free Software Foundation ! # gives unlimited permission to copy and/or distribute it, ! # with or without modifications, as long as this notice is preserved. ! # serial 4 # AM_MISSING_PROG(NAME, PROGRAM) # ------------------------------ *************** else *** 419,445 **** fi ]) # AM_PROG_MKDIR_P # --------------- # Check whether `mkdir -p' is supported, fallback to mkinstalldirs otherwise. ! ! # Copyright (C) 2003, 2004 Free Software Foundation, Inc. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! # Automake 1.8 used `mkdir -m 0755 -p --' to ensure that directories # created by `make install' are always world readable, even if the # installer happens to have an overly restrictive umask (e.g. 077). --- 308,323 ---- fi ]) + # Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc. + # + # This file is free software; the Free Software Foundation + # gives unlimited permission to copy and/or distribute it, + # with or without modifications, as long as this notice is preserved. + # AM_PROG_MKDIR_P # --------------- # Check whether `mkdir -p' is supported, fallback to mkinstalldirs otherwise. ! # # Automake 1.8 used `mkdir -m 0755 -p --' to ensure that directories # created by `make install' are always world readable, even if the # installer happens to have an overly restrictive umask (e.g. 077). *************** else *** 493,517 **** fi AC_SUBST([mkdir_p])]) ! # Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004 # Free Software Foundation, Inc. ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! ! # serial 4 # AM_ENABLE_MULTILIB([MAKEFILE], [REL-TO-TOP-SRCDIR]) # --------------------------------------------------- --- 371,384 ---- fi AC_SUBST([mkdir_p])]) ! # Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004, 2005 # Free Software Foundation, Inc. + # + # This file is free software; the Free Software Foundation + # gives unlimited permission to copy and/or distribute it, + # with or without modifications, as long as this notice is preserved. ! # serial 5 # AM_ENABLE_MULTILIB([MAKEFILE], [REL-TO-TOP-SRCDIR]) # --------------------------------------------------- *************** multi_basedir="$multi_basedir" *** 562,587 **** CONFIG_SHELL=${CONFIG_SHELL-/bin/sh} CC="$CC"])])dnl ! # Helper functions for option handling. -*- Autoconf -*- ! ! # Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! # serial 2 # _AM_MANGLE_OPTION(NAME) # ----------------------- --- 429,443 ---- CONFIG_SHELL=${CONFIG_SHELL-/bin/sh} CC="$CC"])])dnl ! # Helper functions for option handling. -*- Autoconf -*- ! # Copyright (C) 2001, 2002, 2003, 2005 Free Software Foundation, Inc. ! # ! # This file is free software; the Free Software Foundation ! # gives unlimited permission to copy and/or distribute it, ! # with or without modifications, as long as this notice is preserved. ! # serial 3 # _AM_MANGLE_OPTION(NAME) # ----------------------- *************** AC_DEFUN([_AM_SET_OPTIONS], *** 606,633 **** AC_DEFUN([_AM_IF_OPTION], [m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])]) ! # ! # Check to make sure that the build environment is sane. ! # ! ! # Copyright (C) 1996, 1997, 2000, 2001, 2003 Free Software Foundation, Inc. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! # serial 3 # AM_SANITY_CHECK # --------------- --- 462,477 ---- AC_DEFUN([_AM_IF_OPTION], [m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])]) ! # Check to make sure that the build environment is sane. -*- Autoconf -*- ! # Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005 ! # Free Software Foundation, Inc. ! # ! # This file is free software; the Free Software Foundation ! # gives unlimited permission to copy and/or distribute it, ! # with or without modifications, as long as this notice is preserved. ! # serial 4 # AM_SANITY_CHECK # --------------- *************** Check your system clock]) *** 670,694 **** fi AC_MSG_RESULT(yes)]) ! # AM_PROG_INSTALL_STRIP ! ! # Copyright (C) 2001, 2003 Free Software Foundation, Inc. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. # One issue with vendor `install' (even GNU) is that you can't # specify the program used to strip binaries. This is especially # annoying in cross-compiling environments, where the build's strip --- 514,527 ---- fi AC_MSG_RESULT(yes)]) ! # Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. ! # ! # This file is free software; the Free Software Foundation ! # gives unlimited permission to copy and/or distribute it, ! # with or without modifications, as long as this notice is preserved. + # AM_PROG_INSTALL_STRIP + # --------------------- # One issue with vendor `install' (even GNU) is that you can't # specify the program used to strip binaries. This is especially # annoying in cross-compiling environments, where the build's strip *************** AC_SUBST([INSTALL_STRIP_PROGRAM])]) *** 711,735 **** # Check how to create a tarball. -*- Autoconf -*- ! # Copyright (C) 2004 Free Software Foundation, Inc. ! ! # This program 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. ! ! # This program 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 this program; if not, write to the Free Software ! # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ! # 02111-1307, USA. ! ! # serial 1 # _AM_PROG_TAR(FORMAT) # -------------------- --- 544,556 ---- # Check how to create a tarball. -*- Autoconf -*- ! # Copyright (C) 2004, 2005 Free Software Foundation, Inc. ! # ! # This file is free software; the Free Software Foundation ! # gives unlimited permission to copy and/or distribute it, ! # with or without modifications, as long as this notice is preserved. + # serial 2 # _AM_PROG_TAR(FORMAT) # -------------------- *************** AC_SUBST([am__tar]) *** 817,822 **** AC_SUBST([am__untar]) ]) # _AM_PROG_TAR ! m4_include([../config/gcc-version.m4]) ! m4_include([../config/no-executables.m4]) m4_include([acinclude.m4]) --- 638,643 ---- AC_SUBST([am__untar]) ]) # _AM_PROG_TAR ! m4_include([../config/lead-dot.m4]) ! m4_include([../config/stdint.m4]) m4_include([acinclude.m4]) diff -Nrcpad gcc-4.0.2/libgfortran/c99_protos.h gcc-4.1.0/libgfortran/c99_protos.h *** gcc-4.0.2/libgfortran/c99_protos.h Wed Jun 15 18:53:23 2005 --- gcc-4.1.0/libgfortran/c99_protos.h Wed Oct 19 09:45:27 2005 *************** GNU Lesser General Public License for mo *** 15,22 **** You should have received a copy of the GNU Lesser General Public License along with libgfortran; see the file COPYING.LIB. If not, ! write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* As a special exception, if you link this library with other files, some of which are compiled with GCC, to produce an executable, --- 15,22 ---- You should have received a copy of the GNU Lesser General Public License along with libgfortran; see the file COPYING.LIB. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* As a special exception, if you link this library with other files, some of which are compiled with GCC, to produce an executable, *************** Boston, MA 02111-1307, USA. */ *** 27,145 **** #ifndef C99_PROTOS_H ! #define C99_PROTOS_H #ifndef HAVE_ACOSF extern float acosf(float); #endif #ifndef HAVE_ASINF extern float asinf(float); #endif #ifndef HAVE_ATAN2F extern float atan2f(float, float); #endif #ifndef HAVE_ATANF extern float atanf(float); #endif #ifndef HAVE_CEILF extern float ceilf(float); #endif #ifndef HAVE_COPYSIGNF extern float copysignf(float, float); #endif #ifndef HAVE_COSF extern float cosf(float); #endif #ifndef HAVE_COSHF extern float coshf(float); #endif #ifndef HAVE_EXPF extern float expf(float); #endif #ifndef HAVE_FABSF extern float fabsf(float); #endif #ifndef HAVE_FLOORF extern float floorf(float); #endif #ifndef HAVE_FREXPF extern float frexpf(float, int *); #endif #ifndef HAVE_HYPOTF extern float hypotf(float, float); #endif #ifndef HAVE_LOGF extern float logf(float); #endif #ifndef HAVE_LOG10F extern float log10f(float); #endif #ifndef HAVE_SCALBN extern double scalbn(double, int); #endif #ifndef HAVE_SCALBNF extern float scalbnf(float, int); #endif #ifndef HAVE_SINF extern float sinf(float); #endif #ifndef HAVE_SINHF extern float sinhf(float); #endif #ifndef HAVE_SQRTF extern float sqrtf(float); #endif #ifndef HAVE_TANF extern float tanf(float); #endif #ifndef HAVE_TANHF extern float tanhf(float); #endif #ifndef HAVE_TRUNC ! extern double trunc(double x); #endif #ifndef HAVE_TRUNCF ! extern float truncf(float x); #endif #ifndef HAVE_NEXTAFTERF extern float nextafterf(float, float); #endif #ifndef HAVE_POWF extern float powf(float, float); #endif #ifndef HAVE_ROUND extern double round(double); #endif #ifndef HAVE_ROUNDF extern float roundf(float); #endif #endif /* C99_PROTOS_H */ --- 27,407 ---- #ifndef C99_PROTOS_H ! #define C99_PROTOS_H 1 + /* float variants of libm functions */ #ifndef HAVE_ACOSF + #define HAVE_ACOSF 1 extern float acosf(float); #endif + #ifndef HAVE_ACOSHF + #define HAVE_ACOSHF 1 + extern float acoshf(float); + #endif + #ifndef HAVE_ASINF + #define HAVE_ASINF 1 extern float asinf(float); #endif + #ifndef HAVE_ASINHF + #define HAVE_ASINHF 1 + extern float asinhf(float); + #endif + #ifndef HAVE_ATAN2F + #define HAVE_ATAN2F 1 extern float atan2f(float, float); #endif #ifndef HAVE_ATANF + #define HAVE_ATANF 1 extern float atanf(float); #endif + #ifndef HAVE_ATANHF + #define HAVE_ATANHF 1 + extern float atanhf(float); + #endif + #ifndef HAVE_CEILF + #define HAVE_CEILF 1 extern float ceilf(float); #endif #ifndef HAVE_COPYSIGNF + #define HAVE_COPYSIGNF 1 extern float copysignf(float, float); #endif #ifndef HAVE_COSF + #define HAVE_COSF 1 extern float cosf(float); #endif #ifndef HAVE_COSHF + #define HAVE_COSHF 1 extern float coshf(float); #endif #ifndef HAVE_EXPF + #define HAVE_EXPF 1 extern float expf(float); #endif #ifndef HAVE_FABSF + #define HAVE_FABSF 1 extern float fabsf(float); #endif #ifndef HAVE_FLOORF + #define HAVE_FLOORF 1 extern float floorf(float); #endif #ifndef HAVE_FREXPF + #define HAVE_FREXPF 1 extern float frexpf(float, int *); #endif #ifndef HAVE_HYPOTF + #define HAVE_HYPOTF 1 extern float hypotf(float, float); #endif #ifndef HAVE_LOGF + #define HAVE_LOGF 1 extern float logf(float); #endif #ifndef HAVE_LOG10F + #define HAVE_LOG10F 1 extern float log10f(float); #endif #ifndef HAVE_SCALBN + #define HAVE_SCALBN 1 extern double scalbn(double, int); #endif #ifndef HAVE_SCALBNF + #define HAVE_SCALBNF 1 extern float scalbnf(float, int); #endif #ifndef HAVE_SINF + #define HAVE_SINF 1 extern float sinf(float); #endif #ifndef HAVE_SINHF + #define HAVE_SINHF 1 extern float sinhf(float); #endif #ifndef HAVE_SQRTF + #define HAVE_SQRTF 1 extern float sqrtf(float); #endif #ifndef HAVE_TANF + #define HAVE_TANF 1 extern float tanf(float); #endif #ifndef HAVE_TANHF + #define HAVE_TANHF 1 extern float tanhf(float); #endif #ifndef HAVE_TRUNC ! #define HAVE_TRUNC 1 ! extern double trunc(double); #endif #ifndef HAVE_TRUNCF ! #define HAVE_TRUNCF 1 ! extern float truncf(float); #endif #ifndef HAVE_NEXTAFTERF + #define HAVE_NEXTAFTERF 1 extern float nextafterf(float, float); #endif #ifndef HAVE_POWF + #define HAVE_POWF 1 extern float powf(float, float); #endif #ifndef HAVE_ROUND + #define HAVE_ROUND 1 extern double round(double); #endif #ifndef HAVE_ROUNDF + #define HAVE_ROUNDF 1 extern float roundf(float); #endif + + /* log10l is needed on all platforms for decimal I/O */ + #ifndef HAVE_LOG10L + #define HAVE_LOG10L 1 + extern long double log10l(long double); + #endif + + + /* complex math functions */ + + #if !defined(HAVE_CABSF) + #define HAVE_CABSF 1 + extern float cabsf (float complex); + #endif + + #if !defined(HAVE_CABS) + #define HAVE_CABS 1 + extern double cabs (double complex); + #endif + + #if !defined(HAVE_CABSL) && defined(HAVE_HYPOTL) + #define HAVE_CABSL 1 + extern long double cabsl (long double complex); + #endif + + + #if !defined(HAVE_CARGF) + #define HAVE_CARGF 1 + extern float cargf (float complex); + #endif + + #if !defined(HAVE_CARG) + #define HAVE_CARG 1 + extern double carg (double complex); + #endif + + #if !defined(HAVE_CARGL) && defined(HAVE_ATAN2L) + #define HAVE_CARGL 1 + extern long double cargl (long double complex); + #endif + + + #if !defined(HAVE_CEXPF) + #define HAVE_CEXPF 1 + extern float complex cexpf (float complex); + #endif + + #if !defined(HAVE_CEXP) + #define HAVE_CEXP 1 + extern double complex cexp (double complex); + #endif + + #if !defined(HAVE_CEXPL) && defined(HAVE_COSL) && defined(HAVE_SINL) && defined(EXPL) + #define HAVE_CEXPL 1 + extern long double complex cexpl (long double complex); + #endif + + + #if !defined(HAVE_CLOGF) + #define HAVE_CLOGF 1 + extern float complex clogf (float complex); + #endif + + #if !defined(HAVE_CLOG) + #define HAVE_CLOG 1 + extern double complex clog (double complex); + #endif + + #if !defined(HAVE_CLOGL) && defined(HAVE_LOGL) && defined(HAVE_CABSL) && defined(HAVE_CARGL) + #define HAVE_CLOGL 1 + extern long double complex clogl (long double complex); + #endif + + + #if !defined(HAVE_CLOG10F) + #define HAVE_CLOG10F 1 + extern float complex clog10f (float complex); + #endif + + #if !defined(HAVE_CLOG10) + #define HAVE_CLOG10 1 + extern double complex clog10 (double complex); + #endif + + #if !defined(HAVE_CLOG10L) && defined(HAVE_LOG10L) && defined(HAVE_CABSL) && defined(HAVE_CARGL) + #define HAVE_CLOG10L 1 + extern long double complex clog10l (long double complex); + #endif + + + #if !defined(HAVE_CPOWF) + #define HAVE_CPOWF 1 + extern float complex cpowf (float complex, float complex); + #endif + + #if !defined(HAVE_CPOW) + #define HAVE_CPOW 1 + extern double complex cpow (double complex, double complex); + #endif + + #if !defined(HAVE_CPOWL) && defined(HAVE_CEXPL) && defined(HAVE_CLOGL) + #define HAVE_CPOWL 1 + extern long double complex cpowl (long double complex, long double complex); + #endif + + + #if !defined(HAVE_CSQRTF) + #define HAVE_CSQRTF 1 + extern float complex csqrtf (float complex); + #endif + + #if !defined(HAVE_CSQRT) + #define HAVE_CSQRT 1 + extern double complex csqrt (double complex); + #endif + + #if !defined(HAVE_CSQRTL) && defined(HAVE_COPYSIGNL) && defined(HAVE_SQRTL) && defined(HAVE_FABSL) && defined(HAVE_HYPOTL) + #define HAVE_CSQRTL 1 + extern long double complex csqrtl (long double complex); + #endif + + + #if !defined(HAVE_CSINHF) + #define HAVE_CSINHF 1 + extern float complex csinhf (float complex); + #endif + + #if !defined(HAVE_CSINH) + #define HAVE_CSINH 1 + extern double complex csinh (double complex); + #endif + + #if !defined(HAVE_CSINHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) + #define HAVE_CSINHL 1 + extern long double complex csinhl (long double complex); + #endif + + + #if !defined(HAVE_CCOSHF) + #define HAVE_CCOSHF 1 + extern float complex ccoshf (float complex); + #endif + + #if !defined(HAVE_CCOSH) + #define HAVE_CCOSH 1 + extern double complex ccosh (double complex); + #endif + + #if !defined(HAVE_CCOSHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) + #define HAVE_CCOSHL 1 + extern long double complex ccoshl (long double complex); + #endif + + + #if !defined(HAVE_CTANHF) + #define HAVE_CTANHF 1 + extern float complex ctanhf (float complex); + #endif + + #if !defined(HAVE_CTANH) + #define HAVE_CTANH 1 + extern double complex ctanh (double complex); + #endif + + #if !defined(HAVE_CTANHL) && defined(HAVE_TANL) && defined(HAVE_TANHL) + #define HAVE_CTANHL 1 + extern long double complex ctanhl (long double complex); + #endif + + + #if !defined(HAVE_CSINF) + #define HAVE_CSINF 1 + extern float complex csinf (float complex); + #endif + + #if !defined(HAVE_CSIN) + #define HAVE_CSIN 1 + extern double complex csin (double complex); + #endif + + #if !defined(HAVE_CSINL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) + #define HAVE_CSINL 1 + extern long double complex csinl (long double complex); + #endif + + + #if !defined(HAVE_CCOSF) + #define HAVE_CCOSF 1 + extern float complex ccosf (float complex); + #endif + + #if !defined(HAVE_CCOS) + #define HAVE_CCOS 1 + extern double complex ccos (double complex); + #endif + + #if !defined(HAVE_CCOSL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) + #define HAVE_CCOSL 1 + extern long double complex ccosl (long double complex); + #endif + + + #if !defined(HAVE_CTANF) + #define HAVE_CTANF 1 + extern float complex ctanf (float complex); + #endif + + #if !defined(HAVE_CTAN) + #define HAVE_CTAN 1 + extern double complex ctan (double complex); + #endif + + #if !defined(HAVE_CTANL) && defined(HAVE_TANL) && defined(HAVE_TANHL) + #define HAVE_CTANL 1 + extern long double complex ctanl (long double complex); + #endif + + #endif /* C99_PROTOS_H */ diff -Nrcpad gcc-4.0.2/libgfortran/config/fpu-387.h gcc-4.1.0/libgfortran/config/fpu-387.h *** gcc-4.0.2/libgfortran/config/fpu-387.h Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/config/fpu-387.h Fri Oct 14 11:06:11 2005 *************** *** 0 **** --- 1,104 ---- + /* FPU-related code for x86 and x86_64 processors. + Copyright 2005 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + + 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. */ + + #define SSE (1 << 25) + + static int + has_sse (void) + { + #ifdef __x86_64__ + return 1; + #else + unsigned int eax, ebx, ecx, edx; + + /* See if we can use cpuid. */ + asm volatile ("pushfl; pushfl; popl %0; movl %0,%1; xorl %2,%0;" + "pushl %0; popfl; pushfl; popl %0; popfl" + : "=&r" (eax), "=&r" (ebx) + : "i" (0x00200000)); + + if (((eax ^ ebx) & 0x00200000) == 0) + return 0; + + /* Check the highest input value for eax. */ + asm volatile ("xchgl %%ebx, %1; cpuid; xchgl %%ebx, %1" + : "=a" (eax), "=r" (ebx), "=c" (ecx), "=d" (edx) + : "0" (0)); + + if (eax == 0) + return 0; + + asm volatile ("xchgl %%ebx, %1; cpuid; xchgl %%ebx, %1" + : "=a" (eax), "=r" (ebx), "=c" (ecx), "=d" (edx) + : "0" (1)); + + if (edx & SSE) + return 1; + + return 0; + #endif + } + + void set_fpu (void) + { + unsigned short cw; + unsigned int cw_sse; + + /* i387 -- see linux header file for details. */ + #define _FPU_MASK_IM 0x01 + #define _FPU_MASK_DM 0x02 + #define _FPU_MASK_ZM 0x04 + #define _FPU_MASK_OM 0x08 + #define _FPU_MASK_UM 0x10 + #define _FPU_MASK_PM 0x20 + asm volatile ("fnstcw %0" : "=m" (cw)); + cw |= _FPU_MASK_IM | _FPU_MASK_DM | _FPU_MASK_ZM | _FPU_MASK_OM | _FPU_MASK_UM | _FPU_MASK_PM; + if (options.fpe & GFC_FPE_INVALID) cw &= ~_FPU_MASK_IM; + if (options.fpe & GFC_FPE_DENORMAL) cw &= ~_FPU_MASK_DM; + if (options.fpe & GFC_FPE_ZERO) cw &= ~_FPU_MASK_ZM; + if (options.fpe & GFC_FPE_OVERFLOW) cw &= ~_FPU_MASK_OM; + if (options.fpe & GFC_FPE_UNDERFLOW) cw &= ~_FPU_MASK_UM; + if (options.fpe & GFC_FPE_PRECISION) cw &= ~_FPU_MASK_PM; + asm volatile ("fldcw %0" : : "m" (cw)); + + if (has_sse()) + { + /* SSE */ + asm volatile ("stmxcsr %0" : "=m" (cw_sse)); + cw_sse &= 0xFFFF0000; + if (options.fpe & GFC_FPE_INVALID) cw_sse |= 1 << 7; + if (options.fpe & GFC_FPE_DENORMAL) cw_sse |= 1 << 8; + if (options.fpe & GFC_FPE_ZERO) cw_sse |= 1 << 9; + if (options.fpe & GFC_FPE_OVERFLOW) cw_sse |= 1 << 10; + if (options.fpe & GFC_FPE_UNDERFLOW) cw_sse |= 1 << 11; + if (options.fpe & GFC_FPE_PRECISION) cw_sse |= 1 << 12; + asm volatile ("ldmxcsr %0" : : "m" (cw_sse)); + } + } diff -Nrcpad gcc-4.0.2/libgfortran/config/fpu-aix.h gcc-4.1.0/libgfortran/config/fpu-aix.h *** gcc-4.0.2/libgfortran/config/fpu-aix.h Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/config/fpu-aix.h Fri Oct 28 20:13:20 2005 *************** *** 0 **** --- 1,92 ---- + /* AIX FPU-related code. + Copyright 2005 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + + 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. */ + + + /* FPU-related code for AIX. */ + #ifdef HAVE_FPTRAP_H + #include + #endif + + #ifdef HAVE_FLOAT_H + #include + #endif + + void + set_fpu (void) + { + fptrap_t mode = 0; + + if (options.fpe & GFC_FPE_INVALID) + #ifdef TRP_INVALID + mode |= TRP_INVALID; + #else + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_DENORMAL) + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); + + if (options.fpe & GFC_FPE_ZERO) + #ifdef TRP_DIV_BY_ZERO + mode |= TRP_DIV_BY_ZERO; + #else + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_OVERFLOW) + #ifdef TRP_OVERFLOW + mode |= TRP_OVERFLOW; + #else + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_UNDERFLOW) + #ifdef TRP_UNDERFLOW + mode |= TRP_UNDERFLOW; + #else + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_PRECISION) + #ifdef TRP_UNDERFLOW + mode |= TRP_UNDERFLOW; + #else + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); + #endif + + fp_trap(FP_TRAP_SYNC); + fp_enable(mode); + } diff -Nrcpad gcc-4.0.2/libgfortran/config/fpu-generic.h gcc-4.1.0/libgfortran/config/fpu-generic.h *** gcc-4.0.2/libgfortran/config/fpu-generic.h Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/config/fpu-generic.h Wed Oct 12 20:21:31 2005 *************** *** 0 **** --- 1,57 ---- + /* Fallback FPU-related code (for systems not otherwise supported). + Copyright 2005 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + + 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. */ + + + /* Fallback FPU-related code for systems not otherwise supported. This + is mainly telling the user that we will not be able to do what he + requested. */ + + void + set_fpu (void) + { + if (options.fpe & GFC_FPE_INVALID) + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_DENORMAL) + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_ZERO) + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_OVERFLOW) + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_UNDERFLOW) + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_PRECISION) + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); + } diff -Nrcpad gcc-4.0.2/libgfortran/config/fpu-glibc.h gcc-4.1.0/libgfortran/config/fpu-glibc.h *** gcc-4.0.2/libgfortran/config/fpu-glibc.h Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/config/fpu-glibc.h Fri Nov 18 00:09:09 2005 *************** *** 0 **** --- 1,93 ---- + /* FPU-related code for systems with GNU libc. + Copyright 2005 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + + 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. */ + + + /* FPU-related code for systems with the GNU libc, providing the + feenableexcept function in fenv.h to set individual exceptions + (there's nothing to do that in C99). */ + + #ifdef HAVE_FENV_H + #include + #endif + + void set_fpu (void) + { + if (FE_ALL_EXCEPT != 0) + fedisableexcept (FE_ALL_EXCEPT); + + if (options.fpe & GFC_FPE_INVALID) + #ifdef FE_INVALID + feenableexcept (FE_INVALID); + #else + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); + #endif + + /* glibc does never have a FE_DENORMAL. */ + if (options.fpe & GFC_FPE_DENORMAL) + #ifdef FE_DENORMAL + feenableexcept (FE_DENORMAL); + #else + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_ZERO) + #ifdef FE_DIVBYZERO + feenableexcept (FE_DIVBYZERO); + #else + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_OVERFLOW) + #ifdef FE_OVERFLOW + feenableexcept (FE_OVERFLOW); + #else + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_UNDERFLOW) + #ifdef FE_UNDERFLOW + feenableexcept (FE_UNDERFLOW); + #else + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_PRECISION) + #ifdef FE_INEXACT + feenableexcept (FE_INEXACT); + #else + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); + #endif + } diff -Nrcpad gcc-4.0.2/libgfortran/config/fpu-sysv.h gcc-4.1.0/libgfortran/config/fpu-sysv.h *** gcc-4.0.2/libgfortran/config/fpu-sysv.h Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/config/fpu-sysv.h Fri Oct 28 20:13:20 2005 *************** *** 0 **** --- 1,91 ---- + /* SysV FPU-related code (for systems not otherwise supported). + Copyright 2005 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + + 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. */ + + + /* FPU-related code for SysV platforms with fpsetmask(). */ + #ifdef HAVE_IEEEFP_H + #include + #endif + + void + set_fpu (void) + { + int cw = 0; + + if (options.fpe & GFC_FPE_INVALID) + #ifdef FP_X_INV + cw |= FP_X_INV; + #else + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_DENORMAL) + #ifdef FP_X_DNML + cw |= FP_X_DNML; + #else + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_ZERO) + #ifdef FP_X_DZ + cw |= FP_X_DZ; + #else + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_OVERFLOW) + #ifdef FP_X_OFL + cw |= FP_X_OFL; + #else + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_UNDERFLOW) + #ifdef FP_X_UFL + cw |= FP_X_UFL; + #else + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); + #endif + + if (options.fpe & GFC_FPE_PRECISION) + #ifdef FP_X_IMP + cw |= FP_X_IMP; + #else + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); + #endif + + fpsetmask(cw); + } diff -Nrcpad gcc-4.0.2/libgfortran/config.h.in gcc-4.1.0/libgfortran/config.h.in *** gcc-4.0.2/libgfortran/config.h.in Wed Sep 7 21:31:55 2005 --- gcc-4.1.0/libgfortran/config.h.in Wed Jan 11 18:55:18 2006 *************** *** 3,20 **** --- 3,77 ---- /* Does gettimeofday take a single argument */ #undef GETTIMEOFDAY_ONE_ARGUMENT + /* Define to 0 if the target shouldn't use #pragma weak */ + #undef GTHREAD_USE_WEAK + + /* libm includes acos */ + #undef HAVE_ACOS + /* libm includes acosf */ #undef HAVE_ACOSF + /* libm includes acosh */ + #undef HAVE_ACOSH + + /* libm includes acoshf */ + #undef HAVE_ACOSHF + + /* libm includes acoshl */ + #undef HAVE_ACOSHL + + /* libm includes acosl */ + #undef HAVE_ACOSL + + /* Define to 1 if you have the `alarm' function. */ + #undef HAVE_ALARM + + /* libm includes asin */ + #undef HAVE_ASIN + /* libm includes asinf */ #undef HAVE_ASINF + /* libm includes asinh */ + #undef HAVE_ASINH + + /* libm includes asinhf */ + #undef HAVE_ASINHF + + /* libm includes asinhl */ + #undef HAVE_ASINHL + + /* libm includes asinl */ + #undef HAVE_ASINL + + /* libm includes atan */ + #undef HAVE_ATAN + + /* libm includes atan2 */ + #undef HAVE_ATAN2 + /* libm includes atan2f */ #undef HAVE_ATAN2F + /* libm includes atan2l */ + #undef HAVE_ATAN2L + /* libm includes atanf */ #undef HAVE_ATANF + /* libm includes atanh */ + #undef HAVE_ATANH + + /* libm includes atanhf */ + #undef HAVE_ATANHF + + /* libm includes atanhl */ + #undef HAVE_ATANHL + + /* libm includes atanl */ + #undef HAVE_ATANL + /* Define to 1 if the target supports __attribute__((alias(...))). */ #undef HAVE_ATTRIBUTE_ALIAS *************** *** 24,53 **** --- 81,263 ---- /* Define to 1 if the target supports __attribute__((visibility(...))). */ #undef HAVE_ATTRIBUTE_VISIBILITY + /* Define if fpclassify is broken. */ + #undef HAVE_BROKEN_FPCLASSIFY + + /* Define if isfinite is broken. */ + #undef HAVE_BROKEN_ISFINITE + + /* Define if isnan is broken. */ + #undef HAVE_BROKEN_ISNAN + + /* libm includes cabs */ + #undef HAVE_CABS + + /* libm includes cabsf */ + #undef HAVE_CABSF + + /* libm includes cabsl */ + #undef HAVE_CABSL + + /* libm includes carg */ + #undef HAVE_CARG + + /* libm includes cargf */ + #undef HAVE_CARGF + + /* libm includes cargl */ + #undef HAVE_CARGL + + /* libm includes ccos */ + #undef HAVE_CCOS + + /* libm includes ccosf */ + #undef HAVE_CCOSF + + /* libm includes ccosh */ + #undef HAVE_CCOSH + + /* libm includes ccoshf */ + #undef HAVE_CCOSHF + + /* libm includes ccoshl */ + #undef HAVE_CCOSHL + + /* libm includes ccosl */ + #undef HAVE_CCOSL + + /* libm includes ceil */ + #undef HAVE_CEIL + /* libm includes ceilf */ #undef HAVE_CEILF + /* libm includes ceill */ + #undef HAVE_CEILL + + /* libm includes cexp */ + #undef HAVE_CEXP + + /* libm includes cexpf */ + #undef HAVE_CEXPF + + /* libm includes cexpl */ + #undef HAVE_CEXPL + /* Define to 1 if you have the `chdir' function. */ #undef HAVE_CHDIR /* Define to 1 if you have the `chsize' function. */ #undef HAVE_CHSIZE + /* libm includes clog */ + #undef HAVE_CLOG + + /* libm includes clog10 */ + #undef HAVE_CLOG10 + + /* libm includes clog10f */ + #undef HAVE_CLOG10F + + /* libm includes clog10l */ + #undef HAVE_CLOG10L + + /* libm includes clogf */ + #undef HAVE_CLOGF + + /* libm includes clogl */ + #undef HAVE_CLOGL + /* complex.h exists */ #undef HAVE_COMPLEX_H + /* libm includes copysign */ + #undef HAVE_COPYSIGN + /* libm includes copysignf */ #undef HAVE_COPYSIGNF + /* libm includes copysignl */ + #undef HAVE_COPYSIGNL + + /* libm includes cos */ + #undef HAVE_COS + /* libm includes cosf */ #undef HAVE_COSF + /* libm includes cosh */ + #undef HAVE_COSH + /* libm includes coshf */ #undef HAVE_COSHF + /* libm includes coshl */ + #undef HAVE_COSHL + + /* libm includes cosl */ + #undef HAVE_COSL + + /* libm includes cpow */ + #undef HAVE_CPOW + + /* libm includes cpowf */ + #undef HAVE_CPOWF + + /* libm includes cpowl */ + #undef HAVE_CPOWL + /* Define if CRLF is line terminator. */ #undef HAVE_CRLF + /* libm includes csin */ + #undef HAVE_CSIN + + /* libm includes csinf */ + #undef HAVE_CSINF + + /* libm includes csinh */ + #undef HAVE_CSINH + + /* libm includes csinhf */ + #undef HAVE_CSINHF + + /* libm includes csinhl */ + #undef HAVE_CSINHL + + /* libm includes csinl */ + #undef HAVE_CSINL + + /* libm includes csqrt */ + #undef HAVE_CSQRT + + /* libm includes csqrtf */ + #undef HAVE_CSQRTF + + /* libm includes csqrtl */ + #undef HAVE_CSQRTL + + /* libm includes ctan */ + #undef HAVE_CTAN + + /* libm includes ctanf */ + #undef HAVE_CTANF + + /* libm includes ctanh */ + #undef HAVE_CTANH + + /* libm includes ctanhf */ + #undef HAVE_CTANHF + + /* libm includes ctanhl */ + #undef HAVE_CTANHL + + /* libm includes ctanl */ + #undef HAVE_CTANL + + /* Define to 1 if you have the `ctime' function. */ + #undef HAVE_CTIME + /* libm includes erf */ #undef HAVE_ERF *************** *** 57,80 **** --- 267,344 ---- /* libm includes erfcf */ #undef HAVE_ERFCF + /* libm includes erfcl */ + #undef HAVE_ERFCL + /* libm includes erff */ #undef HAVE_ERFF + /* libm includes erfl */ + #undef HAVE_ERFL + + /* libm includes exp */ + #undef HAVE_EXP + /* libm includes expf */ #undef HAVE_EXPF + /* libm includes expl */ + #undef HAVE_EXPL + + /* libm includes fabs */ + #undef HAVE_FABS + /* libm includes fabsf */ #undef HAVE_FABSF + /* libm includes fabsl */ + #undef HAVE_FABSL + + /* libm includes feenableexcept */ + #undef HAVE_FEENABLEEXCEPT + + /* Define to 1 if you have the header file. */ + #undef HAVE_FENV_H + /* libm includes finite */ #undef HAVE_FINITE + /* Define to 1 if you have the header file. */ + #undef HAVE_FLOATINGPOINT_H + + /* Define to 1 if you have the header file. */ + #undef HAVE_FLOAT_H + + /* libm includes floor */ + #undef HAVE_FLOOR + /* libm includes floorf */ #undef HAVE_FLOORF + /* libm includes floorl */ + #undef HAVE_FLOORL + + /* Define if you have fpsetmask. */ + #undef HAVE_FPSETMASK + + /* Define to 1 if you have the header file. */ + #undef HAVE_FPTRAP_H + + /* fp_enable is present */ + #undef HAVE_FP_ENABLE + + /* fp_trap is present */ + #undef HAVE_FP_TRAP + + /* libm includes frexp */ + #undef HAVE_FREXP + /* libm includes frexpf */ #undef HAVE_FREXPF + /* libm includes frexpl */ + #undef HAVE_FREXPL + /* Define to 1 if you have the `ftruncate' function. */ #undef HAVE_FTRUNCATE *************** *** 102,110 **** --- 366,383 ---- /* libc includes getuid */ #undef HAVE_GETUID + /* Define if the compiler has a thread header that is non single. */ + #undef HAVE_GTHR_DEFAULT + + /* libm includes hypot */ + #undef HAVE_HYPOT + /* libm includes hypotf */ #undef HAVE_HYPOTF + /* libm includes hypotl */ + #undef HAVE_HYPOTL + /* Define to 1 if you have the header file. */ #undef HAVE_IEEEFP_H *************** *** 117,146 **** --- 390,440 ---- /* libm includes j0f */ #undef HAVE_J0F + /* libm includes j0l */ + #undef HAVE_J0L + /* libm includes j1 */ #undef HAVE_J1 /* libm includes j1f */ #undef HAVE_J1F + /* libm includes j1l */ + #undef HAVE_J1L + /* libm includes jn */ #undef HAVE_JN /* libm includes jnf */ #undef HAVE_JNF + /* libm includes jnl */ + #undef HAVE_JNL + /* Define to 1 if you have the `kill' function. */ #undef HAVE_KILL /* Define to 1 if you have the `link' function. */ #undef HAVE_LINK + /* libm includes log */ + #undef HAVE_LOG + + /* libm includes log10 */ + #undef HAVE_LOG10 + /* libm includes log10f */ #undef HAVE_LOG10F + /* libm includes log10l */ + #undef HAVE_LOG10L + /* libm includes logf */ #undef HAVE_LOGF + /* libm includes logl */ + #undef HAVE_LOGL + /* Define to 1 if you have the header file. */ #undef HAVE_MATH_H *************** *** 159,200 **** --- 453,530 ---- /* libm includes nextafterf */ #undef HAVE_NEXTAFTERF + /* libm includes nextafterl */ + #undef HAVE_NEXTAFTERL + /* Define to 1 if you have the `perror' function. */ #undef HAVE_PERROR + /* libm includes pow */ + #undef HAVE_POW + /* libm includes powf */ #undef HAVE_POWF + /* libm includes powl */ + #undef HAVE_POWL + /* libm includes round */ #undef HAVE_ROUND /* libm includes roundf */ #undef HAVE_ROUNDF + /* libm includes roundl */ + #undef HAVE_ROUNDL + /* libm includes scalbn */ #undef HAVE_SCALBN /* libm includes scalbnf */ #undef HAVE_SCALBNF + /* libm includes scalbnl */ + #undef HAVE_SCALBNL + + /* Define to 1 if you have the `signal' function. */ + #undef HAVE_SIGNAL + /* Define to 1 if you have the header file. */ #undef HAVE_SIGNAL_H + /* libm includes sin */ + #undef HAVE_SIN + /* libm includes sinf */ #undef HAVE_SINF + /* libm includes sinh */ + #undef HAVE_SINH + /* libm includes sinhf */ #undef HAVE_SINHF + /* libm includes sinhl */ + #undef HAVE_SINHL + + /* libm includes sinl */ + #undef HAVE_SINL + /* Define to 1 if you have the `sleep' function. */ #undef HAVE_SLEEP /* Define to 1 if you have the `snprintf' function. */ #undef HAVE_SNPRINTF + /* libm includes sqrt */ + #undef HAVE_SQRT + /* libm includes sqrtf */ #undef HAVE_SQRTF + /* libm includes sqrtl */ + #undef HAVE_SQRTL + /* Define to 1 if you have the header file. */ #undef HAVE_STDDEF_H *************** *** 219,224 **** --- 549,557 ---- /* Define to 1 if you have the `strtof' function. */ #undef HAVE_STRTOF + /* Define to 1 if you have the `strtold' function. */ + #undef HAVE_STRTOLD + /* Define to 1 if `st_blksize' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE *************** *** 231,238 **** /* Define to 1 if you have the `symlink' function. */ #undef HAVE_SYMLINK ! /* Define to 1 if you have the header file. */ ! #undef HAVE_SYS_MMAN_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_PARAMS_H --- 564,571 ---- /* Define to 1 if you have the `symlink' function. */ #undef HAVE_SYMLINK ! /* Define to 1 if the target supports __sync_fetch_and_add */ ! #undef HAVE_SYNC_FETCH_AND_ADD /* Define to 1 if you have the header file. */ #undef HAVE_SYS_PARAMS_H *************** *** 252,263 **** --- 585,608 ---- /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H + /* libm includes tan */ + #undef HAVE_TAN + /* libm includes tanf */ #undef HAVE_TANF + /* libm includes tanh */ + #undef HAVE_TANH + /* libm includes tanhf */ #undef HAVE_TANHF + /* libm includes tanhl */ + #undef HAVE_TANHL + + /* libm includes tanl */ + #undef HAVE_TANL + /* Define to 1 if you have the `time' function. */ #undef HAVE_TIME *************** *** 276,281 **** --- 621,629 ---- /* libm includes truncf */ #undef HAVE_TRUNCF + /* libm includes truncl */ + #undef HAVE_TRUNCL + /* Define to 1 if you have the `ttyname' function. */ #undef HAVE_TTYNAME *************** *** 285,308 **** --- 633,668 ---- /* Define if target can unlink open files. */ #undef HAVE_UNLINK_OPEN_FILE + /* Define if target has a reliable stat. */ + #undef HAVE_WORKING_STAT + /* libm includes y0 */ #undef HAVE_Y0 /* libm includes y0f */ #undef HAVE_Y0F + /* libm includes y0l */ + #undef HAVE_Y0L + /* libm includes y1 */ #undef HAVE_Y1 /* libm includes y1f */ #undef HAVE_Y1F + /* libm includes y1l */ + #undef HAVE_Y1L + /* libm includes yn */ #undef HAVE_YN /* libm includes ynf */ #undef HAVE_YNF + /* libm includes ynl */ + #undef HAVE_YNL + /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT *************** *** 321,326 **** --- 681,689 ---- /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS + /* Define to 1 if the target supports #pragma weak */ + #undef SUPPORTS_WEAK + /* Define to 1 if the target is ILP32. */ #undef TARGET_ILP32 diff -Nrcpad gcc-4.0.2/libgfortran/configure gcc-4.1.0/libgfortran/configure *** gcc-4.0.2/libgfortran/configure Wed Sep 28 06:16:38 2005 --- gcc-4.1.0/libgfortran/configure Tue Feb 28 08:39:11 2006 *************** ac_includes_default="\ *** 308,314 **** # include #endif" ! ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT multi_basedir gcc_version_trigger gcc_version_full gcc_version toolexecdir toolexeclibdir CC ac_ct_CC EXEEXT OBJEXT AM_FCFLAGS AM_CFLAGS AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB LN_S LIBTOOL enable_shared enable_static FC FCFLAGS LDFLAGS ac_ct_FC extra_ldflags_libgfortran CPP CPPFLAGS EGREP MATH_OBJ LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. --- 308,314 ---- # include #endif" ! ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os build_subdir host_subdir target_subdir host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT multi_basedir toolexecdir toolexeclibdir CC ac_ct_CC EXEEXT OBJEXT AM_FCFLAGS AM_CFLAGS AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB LN_S LIBTOOL enable_shared enable_static FC FCFLAGS LDFLAGS ac_ct_FC extra_ldflags_libgfortran CPP CPPFLAGS EGREP FPU_HOST_HEADER LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. *************** Optional Features: *** 860,866 **** --enable-fast-install=PKGS optimize for fast installation default=yes --disable-libtool-lock avoid locking (might break parallel builds) --disable-largefile omit support for large files - --enable-cmath Include complex math functions Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --- 860,865 ---- *************** esac *** 970,976 **** else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi ! cd "$ac_popdir" done fi --- 969,975 ---- else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi ! cd $ac_popdir done fi *************** ac_compiler_gnu=$ac_cv_c_compiler_gnu *** 1329,1373 **** ac_config_headers="$ac_config_headers config.h" - - # ------- - # Options - # ------- - - echo "$as_me:$LINENO: checking for --enable-version-specific-runtime-libs" >&5 - echo $ECHO_N "checking for --enable-version-specific-runtime-libs... $ECHO_C" >&6 - # Check whether --enable-version-specific-runtime-libs or --disable-version-specific-runtime-libs was given. - if test "${enable_version_specific_runtime_libs+set}" = set; then - enableval="$enable_version_specific_runtime_libs" - case "$enableval" in - yes) version_specific_libs=yes ;; - no) version_specific_libs=no ;; - *) { { echo "$as_me:$LINENO: error: Unknown argument to enable/disable version-specific libs" >&5 - echo "$as_me: error: Unknown argument to enable/disable version-specific libs" >&2;} - { (exit 1); exit 1; }; };; - esac - else - version_specific_libs=no - fi; - echo "$as_me:$LINENO: result: $version_specific_libs" >&5 - echo "${ECHO_T}$version_specific_libs" >&6 - - - # Gets build, host, target, *_vendor, *_cpu, *_os, etc. - # - # You will slowly go insane if you do not grok the following fact: when - # building this library, the top-level /target/ becomes the library's /host/. - # - # configure then causes --target to default to --host, exactly like any - # other package using autoconf. Therefore, 'target' and 'host' will - # always be the same. This makes sense both for native and cross compilers - # just think about it for a little while. :-) - # - # Also, if this library is being configured as part of a cross compiler, the - # top-level configure script will pass the "real" host as $with_cross_host. - # - # Do not delete or change the following two lines. For why, see - # http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html ac_aux_dir= for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do if test -f $ac_dir/install-sh; then --- 1328,1333 ---- *************** build_vendor=`echo $ac_cv_build | sed 's *** 1425,1430 **** --- 1385,1456 ---- build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` + case ${build_alias} in + "") build_noncanonical=${build} ;; + *) build_noncanonical=${build_alias} ;; + esac + + case ${host_alias} in + "") host_noncanonical=${build_noncanonical} ;; + *) host_noncanonical=${host_alias} ;; + esac + + case ${target_alias} in + "") target_noncanonical=${host_noncanonical} ;; + *) target_noncanonical=${target_alias} ;; + esac + + # Prefix 'build-' so this never conflicts with target_subdir. + build_subdir="build-${build_noncanonical}" + # --srcdir=. covers the toplevel, while "test -d" covers the subdirectories + if ( test $srcdir = . && test -d gcc ) \ + || test -d $srcdir/../host-${host_noncanonical}; then + host_subdir="host-${host_noncanonical}" + else + host_subdir=. + fi + # No prefix. + target_subdir=${target_noncanonical} + + + # ------- + # Options + # ------- + + echo "$as_me:$LINENO: checking for --enable-version-specific-runtime-libs" >&5 + echo $ECHO_N "checking for --enable-version-specific-runtime-libs... $ECHO_C" >&6 + # Check whether --enable-version-specific-runtime-libs or --disable-version-specific-runtime-libs was given. + if test "${enable_version_specific_runtime_libs+set}" = set; then + enableval="$enable_version_specific_runtime_libs" + case "$enableval" in + yes) version_specific_libs=yes ;; + no) version_specific_libs=no ;; + *) { { echo "$as_me:$LINENO: error: Unknown argument to enable/disable version-specific libs" >&5 + echo "$as_me: error: Unknown argument to enable/disable version-specific libs" >&2;} + { (exit 1); exit 1; }; };; + esac + else + version_specific_libs=no + fi; + echo "$as_me:$LINENO: result: $version_specific_libs" >&5 + echo "${ECHO_T}$version_specific_libs" >&6 + + + # Gets build, host, target, *_vendor, *_cpu, *_os, etc. + # + # You will slowly go insane if you do not grok the following fact: when + # building this library, the top-level /target/ becomes the library's /host/. + # + # configure then causes --target to default to --host, exactly like any + # other package using autoconf. Therefore, 'target' and 'host' will + # always be the same. This makes sense both for native and cross compilers + # just think about it for a little while. :-) + # + # Also, if this library is being configured as part of a cross compiler, the + # top-level configure script will pass the "real" host as $with_cross_host. + # + # Do not delete or change the following two lines. For why, see + # http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html echo "$as_me:$LINENO: checking host system type" >&5 echo $ECHO_N "checking host system type... $ECHO_C" >&6 if test "${ac_cv_host+set}" = set; then *************** else *** 1962,1984 **** LIBGFOR_IS_NATIVE=true fi - - if test "${with_gcc_version_trigger+set}" = set; then - gcc_version_trigger=$with_gcc_version_trigger - else - gcc_version_trigger=$srcdir/../gcc/version.c - fi - if test -f "${gcc_version_trigger}"; then - gcc_version_full=`grep version_string "${gcc_version_trigger}" | sed -e 's/.*"\([^"]*\)".*/\1/'` - else - gcc_version_full=`$CC -v 2>&1 | sed -n 's/^gcc version //p'` - fi - gcc_version=`echo ${gcc_version_full} | sed -e 's/\([^ ]*\) .*/\1/'` - - - - - # Calculate toolexeclibdir # Also toolexecdir, though it's only used in toolexeclibdir case ${version_specific_libs} in --- 1988,1993 ---- *************** case ${version_specific_libs} in *** 1987,1993 **** # and header files if --enable-version-specific-runtime-libs option # is selected. toolexecdir='$(libdir)/gcc/$(target_alias)' ! toolexeclibdir='$(toolexecdir)/'${gcc_version}'$(MULTISUBDIR)' ;; no) if test -n "$with_cross_host" && --- 1996,2002 ---- # and header files if --enable-version-specific-runtime-libs option # is selected. toolexecdir='$(libdir)/gcc/$(target_alias)' ! toolexeclibdir='$(toolexecdir)/$(gcc_version)$(MULTISUBDIR)' ;; no) if test -n "$with_cross_host" && *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 2619,2625 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 2628,2635 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 2677,2683 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 2687,2694 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 2793,2799 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 2804,2811 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 2847,2853 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 2859,2866 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 2892,2898 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 2905,2912 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 2936,2942 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 2950,2957 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** ac_compiler_gnu=$ac_cv_c_compiler_gnu *** 2977,2988 **** ! # Add -Wall if we are using GCC. if test "x$GCC" = "xyes"; then ! AM_FCFLAGS="-Wall" ## We like to use C99 routines when available. This makes sure that ## __STDC_VERSION__ is set such that libc includes make them available. ! AM_CFLAGS="-std=gnu99 -Wall" fi --- 2992,3006 ---- ! # Add -Wall -fno-repack-arrays -fno-underscoring if we are using GCC. if test "x$GCC" = "xyes"; then ! AM_FCFLAGS="-I . -Wall -fno-repack-arrays -fno-underscoring" ## We like to use C99 routines when available. This makes sure that ## __STDC_VERSION__ is set such that libc includes make them available. ! AM_CFLAGS="-std=gnu99 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings" ! ## Compile the following tests with the same system header contents ! ## that we'll encounter when compiling our own source files. ! CFLAGS="-std=gnu99 $CFLAGS" fi *************** deplibs_check_method=$lt_cv_deplibs_chec *** 3740,3745 **** --- 3758,3824 ---- # Autoconf 2.13's AC_OBJEXT and AC_EXEEXT macros only works for C compilers! + # find the maximum length of command line arguments + echo "$as_me:$LINENO: checking the maximum length of command line arguments" >&5 + echo $ECHO_N "checking the maximum length of command line arguments... $ECHO_C" >&6 + if test "${lt_cv_sys_max_cmd_len+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + i=0 + teststring="ABCD" + + case $build_os in + msdosdjgpp*) + # On DJGPP, this test can blow up pretty badly due to problems in libc + # (any single argument exceeding 2000 bytes causes a buffer overrun + # during glob expansion). Even if it were fixed, the result of this + # check would be larger than it should be. + lt_cv_sys_max_cmd_len=12288; # 12K is about right + ;; + + cygwin* | mingw*) + # On Win9x/ME, this test blows up -- it succeeds, but takes + # about 5 minutes as the teststring grows exponentially. + # Worse, since 9x/ME are not pre-emptively multitasking, + # you end up with a "frozen" computer, even though with patience + # the test eventually succeeds (with a max line length of 256k). + # Instead, let's just punt: use the minimum linelength reported by + # all of the supported platforms: 8192 (on NT/2K/XP). + lt_cv_sys_max_cmd_len=8192; + ;; + + amigaos*) + # On AmigaOS with pdksh, this test takes hours, literally. + # So we just punt and use a minimum line length of 8192. + lt_cv_sys_max_cmd_len=8192; + ;; + + netbsd* | freebsd* | openbsd* | darwin* | dragonfly*) + # This has been around since 386BSD, at least. Likely further. + if test -x /sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax` + elif test -x /usr/sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax` + else + lt_cv_sys_max_cmd_len=65536 # usable default for *BSD + fi + # And add a safety zone + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + ;; + esac + + fi + + if test -n "$lt_cv_sys_max_cmd_len" ; then + echo "$as_me:$LINENO: result: $lt_cv_sys_max_cmd_len" >&5 + echo "${ECHO_T}$lt_cv_sys_max_cmd_len" >&6 + else + echo "$as_me:$LINENO: result: none" >&5 + echo "${ECHO_T}none" >&6 + fi + + # Only perform the check for file, if the check method requires it case $deplibs_check_method in file_magic*) *************** test x"$pic_mode" = xno && libtool_flags *** 4073,4079 **** case $host in *-*-irix6*) # Find out which ABI we are using. ! echo '#line 4076 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? --- 4152,4158 ---- case $host in *-*-irix6*) # Find out which ABI we are using. ! echo '#line 4155 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 4220,4226 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 4299,4306 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** exec 5>>./config.log *** 4368,4374 **** #AC_MSG_NOTICE([====== Finished libtool configuration]) ; sleep 10 # We need gfortran to compile parts of the library - # We can't use AC_PROG_FC because it expects a fully working gfortran. #AC_PROG_FC(gfortran) FC="$GFORTRAN" ac_ext=${FC_SRCEXT-f} --- 4448,4453 ---- *************** fi *** 4463,4469 **** # Provide some information about the compiler. ! echo "$as_me:4466:" \ "checking for Fortran compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 --- 4542,4548 ---- # Provide some information about the compiler. ! echo "$as_me:4545:" \ "checking for Fortran compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 4509,4515 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_fc_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 4588,4595 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_fc_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 4558,4564 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_fc_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 4638,4645 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_fc_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** ac_compile='$CC -c $CFLAGS $CPPFLAGS con *** 4604,4610 **** ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu - FCFLAGS="$FCFLAGS -Wall -fno-repack-arrays -fno-underscoring" # extra LD Flags which are required for targets case "${host}" in --- 4685,4690 ---- *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 4665,4671 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 4745,4752 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 4694,4700 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 4775,4782 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 4764,4770 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 4846,4853 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 4816,4822 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 4899,4906 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 4887,4893 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 4971,4978 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 4939,4945 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 5024,5031 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if test x$gcc_no_link = xyes; then *** 4978,4984 **** ac_cv_func_mmap_fixed_mapped=no fi fi ! if test "x${ac_cv_func_mmap_fixed_mapped+set}" != xset; then ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' --- 5064,5070 ---- ac_cv_func_mmap_fixed_mapped=no fi fi ! if test "x${ac_cv_func_mmap_fixed_mapped}" != xno; then ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 5262,5268 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 5348,5355 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 5432,5438 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 5519,5526 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 5500,5506 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 5588,5595 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 5689,5695 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 5778,5785 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 5929,5935 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 6019,6026 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 5997,6003 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 6088,6095 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6169,6175 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 6261,6268 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6322,6328 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 6415,6422 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** done *** 6441,6447 **** ! for ac_header in sys/mman.h sys/types.h sys/stat.h ieeefp.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then --- 6535,6541 ---- ! for ac_header in sys/types.h sys/stat.h floatingpoint.h ieeefp.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6474,6480 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 6568,6727 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest.$ac_objext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_header_compiler=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_header_compiler=no ! fi ! rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ! echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 ! echo "${ECHO_T}$ac_header_compiler" >&6 ! ! # Is the header present? ! echo "$as_me:$LINENO: checking $ac_header presence" >&5 ! echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! #include <$ac_header> ! _ACEOF ! if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 ! (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } >/dev/null; then ! if test -s conftest.err; then ! ac_cpp_err=$ac_c_preproc_warn_flag ! ac_cpp_err=$ac_cpp_err$ac_c_werror_flag ! else ! ac_cpp_err= ! fi ! else ! ac_cpp_err=yes ! fi ! if test -z "$ac_cpp_err"; then ! ac_header_preproc=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_header_preproc=no ! fi ! rm -f conftest.err conftest.$ac_ext ! echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 ! echo "${ECHO_T}$ac_header_preproc" >&6 ! ! # So? What about this header? ! case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in ! yes:no: ) ! { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 ! echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} ! { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 ! echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ! ac_header_preproc=yes ! ;; ! no:yes:* ) ! { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 ! echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} ! { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 ! echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} ! { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 ! echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} ! { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 ! echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} ! { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 ! echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} ! { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 ! echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ! ( ! cat <<\_ASBOX ! ## ------------------------------------------------------ ## ! ## Report this to the GNU Fortran Runtime Library lists. ## ! ## ------------------------------------------------------ ## ! _ASBOX ! ) | ! sed "s/^/$as_me: WARNING: /" >&2 ! ;; ! esac ! echo "$as_me:$LINENO: checking for $ac_header" >&5 ! echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 ! if eval "test \"\${$as_ac_Header+set}\" = set"; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! eval "$as_ac_Header=\$ac_header_preproc" ! fi ! echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 ! echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 ! ! fi ! if test `eval echo '${'$as_ac_Header'}'` = yes; then ! cat >>confdefs.h <<_ACEOF ! #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 ! _ACEOF ! ! fi ! ! done ! ! ! ! ! for ac_header in fenv.h fptrap.h float.h ! do ! as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` ! if eval "test \"\${$as_ac_Header+set}\" = set"; then ! echo "$as_me:$LINENO: checking for $ac_header" >&5 ! echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 ! if eval "test \"\${$as_ac_Header+set}\" = set"; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! fi ! echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 ! echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 ! else ! # Is the header compilable? ! echo "$as_me:$LINENO: checking $ac_header usability" >&5 ! echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! $ac_includes_default ! #include <$ac_header> ! _ACEOF ! rm -f conftest.$ac_objext ! if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 ! (eval $ac_compile) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6619,6625 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 6866,6873 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** fi *** 6735,6740 **** --- 6983,9785 ---- + + inttype_headers=`echo inttypes.h sys/inttypes.h | sed -e 's/,/ /g'` + + acx_cv_header_stdint=stddef.h + acx_cv_header_stdint_kind="(already complete)" + for i in stdint.h $inttype_headers; do + unset ac_cv_type_uintptr_t + unset ac_cv_type_uintmax_t + unset ac_cv_type_int_least32_t + unset ac_cv_type_int_fast32_t + unset ac_cv_type_uint64_t + echo $ECHO_N "looking for a compliant stdint.h in $i, $ECHO_C" >&6 + echo "$as_me:$LINENO: checking for uintmax_t" >&5 + echo $ECHO_N "checking for uintmax_t... $ECHO_C" >&6 + if test "${ac_cv_type_uintmax_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((uintmax_t *) 0) + return 0; + if (sizeof (uintmax_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_uintmax_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_uintmax_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_uintmax_t" >&5 + echo "${ECHO_T}$ac_cv_type_uintmax_t" >&6 + if test $ac_cv_type_uintmax_t = yes; then + acx_cv_header_stdint=$i + else + continue + fi + + echo "$as_me:$LINENO: checking for uintptr_t" >&5 + echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 + if test "${ac_cv_type_uintptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((uintptr_t *) 0) + return 0; + if (sizeof (uintptr_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_uintptr_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_uintptr_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 + echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 + if test $ac_cv_type_uintptr_t = yes; then + : + else + acx_cv_header_stdint_kind="(mostly complete)" + fi + + echo "$as_me:$LINENO: checking for int_least32_t" >&5 + echo $ECHO_N "checking for int_least32_t... $ECHO_C" >&6 + if test "${ac_cv_type_int_least32_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((int_least32_t *) 0) + return 0; + if (sizeof (int_least32_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_int_least32_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_int_least32_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_int_least32_t" >&5 + echo "${ECHO_T}$ac_cv_type_int_least32_t" >&6 + if test $ac_cv_type_int_least32_t = yes; then + : + else + acx_cv_header_stdint_kind="(mostly complete)" + fi + + echo "$as_me:$LINENO: checking for int_fast32_t" >&5 + echo $ECHO_N "checking for int_fast32_t... $ECHO_C" >&6 + if test "${ac_cv_type_int_fast32_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((int_fast32_t *) 0) + return 0; + if (sizeof (int_fast32_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_int_fast32_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_int_fast32_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_int_fast32_t" >&5 + echo "${ECHO_T}$ac_cv_type_int_fast32_t" >&6 + if test $ac_cv_type_int_fast32_t = yes; then + : + else + acx_cv_header_stdint_kind="(mostly complete)" + fi + + echo "$as_me:$LINENO: checking for uint64_t" >&5 + echo $ECHO_N "checking for uint64_t... $ECHO_C" >&6 + if test "${ac_cv_type_uint64_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((uint64_t *) 0) + return 0; + if (sizeof (uint64_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_uint64_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_uint64_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_uint64_t" >&5 + echo "${ECHO_T}$ac_cv_type_uint64_t" >&6 + if test $ac_cv_type_uint64_t = yes; then + : + else + acx_cv_header_stdint_kind="(lacks uint64_t)" + fi + + break + done + if test "$acx_cv_header_stdint" = stddef.h; then + acx_cv_header_stdint_kind="(lacks uintptr_t)" + for i in stdint.h $inttype_headers; do + unset ac_cv_type_uint32_t + unset ac_cv_type_uint64_t + echo $ECHO_N "looking for an incomplete stdint.h in $i, $ECHO_C" >&6 + echo "$as_me:$LINENO: checking for uint32_t" >&5 + echo $ECHO_N "checking for uint32_t... $ECHO_C" >&6 + if test "${ac_cv_type_uint32_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((uint32_t *) 0) + return 0; + if (sizeof (uint32_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_uint32_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_uint32_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_uint32_t" >&5 + echo "${ECHO_T}$ac_cv_type_uint32_t" >&6 + if test $ac_cv_type_uint32_t = yes; then + acx_cv_header_stdint=$i + else + continue + fi + + echo "$as_me:$LINENO: checking for uint64_t" >&5 + echo $ECHO_N "checking for uint64_t... $ECHO_C" >&6 + if test "${ac_cv_type_uint64_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((uint64_t *) 0) + return 0; + if (sizeof (uint64_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_uint64_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_uint64_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_uint64_t" >&5 + echo "${ECHO_T}$ac_cv_type_uint64_t" >&6 + if test $ac_cv_type_uint64_t = yes; then + : + else + acx_cv_header_stdint_kind="(lacks uintptr_t and uint64_t)" + fi + + break + done + fi + if test "$acx_cv_header_stdint" = stddef.h; then + acx_cv_header_stdint_kind="(u_intXX_t style)" + for i in sys/types.h $inttype_headers; do + unset ac_cv_type_u_int32_t + unset ac_cv_type_u_int64_t + echo $ECHO_N "looking for u_intXX_t types in $i, $ECHO_C" >&6 + echo "$as_me:$LINENO: checking for u_int32_t" >&5 + echo $ECHO_N "checking for u_int32_t... $ECHO_C" >&6 + if test "${ac_cv_type_u_int32_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((u_int32_t *) 0) + return 0; + if (sizeof (u_int32_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_u_int32_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_u_int32_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_u_int32_t" >&5 + echo "${ECHO_T}$ac_cv_type_u_int32_t" >&6 + if test $ac_cv_type_u_int32_t = yes; then + acx_cv_header_stdint=$i + else + continue + fi + + echo "$as_me:$LINENO: checking for u_int64_t" >&5 + echo $ECHO_N "checking for u_int64_t... $ECHO_C" >&6 + if test "${ac_cv_type_u_int64_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + #include + #include <$i> + + int + main () + { + if ((u_int64_t *) 0) + return 0; + if (sizeof (u_int64_t)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_u_int64_t=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_u_int64_t=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_u_int64_t" >&5 + echo "${ECHO_T}$ac_cv_type_u_int64_t" >&6 + if test $ac_cv_type_u_int64_t = yes; then + : + else + acx_cv_header_stdint_kind="(u_intXX_t style, lacks u_int64_t)" + fi + + break + done + fi + if test "$acx_cv_header_stdint" = stddef.h; then + acx_cv_header_stdint_kind="(using manual detection)" + fi + + test -z "$ac_cv_type_uintptr_t" && ac_cv_type_uintptr_t=no + test -z "$ac_cv_type_uint64_t" && ac_cv_type_uint64_t=no + test -z "$ac_cv_type_u_int64_t" && ac_cv_type_u_int64_t=no + test -z "$ac_cv_type_int_least32_t" && ac_cv_type_int_least32_t=no + test -z "$ac_cv_type_int_fast32_t" && ac_cv_type_int_fast32_t=no + + # ----------------- Summarize what we found so far + + echo "$as_me:$LINENO: checking what to include in gstdint.h" >&5 + echo $ECHO_N "checking what to include in gstdint.h... $ECHO_C" >&6 + + case `$as_basename gstdint.h || + $as_expr X/gstdint.h : '.*/\([^/][^/]*\)/*$' \| \ + Xgstdint.h : 'X\(//\)$' \| \ + Xgstdint.h : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || + echo X/gstdint.h | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` in + stdint.h) { echo "$as_me:$LINENO: WARNING: are you sure you want it there?" >&5 + echo "$as_me: WARNING: are you sure you want it there?" >&2;} ;; + inttypes.h) { echo "$as_me:$LINENO: WARNING: are you sure you want it there?" >&5 + echo "$as_me: WARNING: are you sure you want it there?" >&2;} ;; + *) ;; + esac + + echo "$as_me:$LINENO: result: $acx_cv_header_stdint $acx_cv_header_stdint_kind" >&5 + echo "${ECHO_T}$acx_cv_header_stdint $acx_cv_header_stdint_kind" >&6 + + # ----------------- done included file, check C basic types -------- + + # Lacking an uintptr_t? Test size of void * + case "$acx_cv_header_stdint:$ac_cv_type_uintptr_t" in + stddef.h:* | *:no) echo "$as_me:$LINENO: checking for void *" >&5 + echo $ECHO_N "checking for void *... $ECHO_C" >&6 + if test "${ac_cv_type_void_p+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + if ((void * *) 0) + return 0; + if (sizeof (void *)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_void_p=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_void_p=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_void_p" >&5 + echo "${ECHO_T}$ac_cv_type_void_p" >&6 + + echo "$as_me:$LINENO: checking size of void *" >&5 + echo $ECHO_N "checking size of void *... $ECHO_C" >&6 + if test "${ac_cv_sizeof_void_p+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test "$ac_cv_type_void_p" = yes; then + # The cast to unsigned long works around a bug in the HP C Compiler + # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects + # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. + # This bug is HP SR number 8606223364. + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (void *))) >= 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=0 ac_mid=0 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (void *))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr $ac_mid + 1` + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (void *))) < 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=-1 ac_mid=-1 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (void *))) >= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_hi=`expr '(' $ac_mid ')' - 1` + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo= ac_hi= + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + # Binary search between lo and hi bounds. + while test "x$ac_lo" != "x$ac_hi"; do + ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (void *))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr '(' $ac_mid ')' + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + case $ac_lo in + ?*) ac_cv_sizeof_void_p=$ac_lo;; + '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (void *), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (void *), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } ;; + esac + else + if test "$cross_compiling" = yes; then + { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot run test program while cross compiling + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + long longval () { return (long) (sizeof (void *)); } + unsigned long ulongval () { return (long) (sizeof (void *)); } + #include + #include + int + main () + { + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + exit (1); + if (((long) (sizeof (void *))) < 0) + { + long i = longval (); + if (i != ((long) (sizeof (void *)))) + exit (1); + fprintf (f, "%ld\n", i); + } + else + { + unsigned long i = ulongval (); + if (i != ((long) (sizeof (void *)))) + exit (1); + fprintf (f, "%lu\n", i); + } + exit (ferror (f) || fclose (f) != 0); + + ; + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_sizeof_void_p=`cat conftest.val` + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: cannot compute sizeof (void *), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (void *), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + fi + rm -f conftest.val + else + ac_cv_sizeof_void_p=0 + fi + fi + echo "$as_me:$LINENO: result: $ac_cv_sizeof_void_p" >&5 + echo "${ECHO_T}$ac_cv_sizeof_void_p" >&6 + cat >>confdefs.h <<_ACEOF + #define SIZEOF_VOID_P $ac_cv_sizeof_void_p + _ACEOF + + ;; + esac + + # Lacking an uint64_t? Test size of long + case "$acx_cv_header_stdint:$ac_cv_type_uint64_t:$ac_cv_type_u_int64_t" in + stddef.h:*:* | *:no:no) echo "$as_me:$LINENO: checking for long" >&5 + echo $ECHO_N "checking for long... $ECHO_C" >&6 + if test "${ac_cv_type_long+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + if ((long *) 0) + return 0; + if (sizeof (long)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_long=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_long=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_long" >&5 + echo "${ECHO_T}$ac_cv_type_long" >&6 + + echo "$as_me:$LINENO: checking size of long" >&5 + echo $ECHO_N "checking size of long... $ECHO_C" >&6 + if test "${ac_cv_sizeof_long+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test "$ac_cv_type_long" = yes; then + # The cast to unsigned long works around a bug in the HP C Compiler + # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects + # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. + # This bug is HP SR number 8606223364. + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (long))) >= 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=0 ac_mid=0 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (long))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr $ac_mid + 1` + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (long))) < 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=-1 ac_mid=-1 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (long))) >= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_hi=`expr '(' $ac_mid ')' - 1` + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo= ac_hi= + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + # Binary search between lo and hi bounds. + while test "x$ac_lo" != "x$ac_hi"; do + ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (long))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr '(' $ac_mid ')' + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + case $ac_lo in + ?*) ac_cv_sizeof_long=$ac_lo;; + '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (long), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (long), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } ;; + esac + else + if test "$cross_compiling" = yes; then + { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot run test program while cross compiling + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + long longval () { return (long) (sizeof (long)); } + unsigned long ulongval () { return (long) (sizeof (long)); } + #include + #include + int + main () + { + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + exit (1); + if (((long) (sizeof (long))) < 0) + { + long i = longval (); + if (i != ((long) (sizeof (long)))) + exit (1); + fprintf (f, "%ld\n", i); + } + else + { + unsigned long i = ulongval (); + if (i != ((long) (sizeof (long)))) + exit (1); + fprintf (f, "%lu\n", i); + } + exit (ferror (f) || fclose (f) != 0); + + ; + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_sizeof_long=`cat conftest.val` + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: cannot compute sizeof (long), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (long), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + fi + rm -f conftest.val + else + ac_cv_sizeof_long=0 + fi + fi + echo "$as_me:$LINENO: result: $ac_cv_sizeof_long" >&5 + echo "${ECHO_T}$ac_cv_sizeof_long" >&6 + cat >>confdefs.h <<_ACEOF + #define SIZEOF_LONG $ac_cv_sizeof_long + _ACEOF + + ;; + esac + + if test $acx_cv_header_stdint = stddef.h; then + # Lacking a good header? Test size of everything and deduce all types. + echo "$as_me:$LINENO: checking for int" >&5 + echo $ECHO_N "checking for int... $ECHO_C" >&6 + if test "${ac_cv_type_int+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + if ((int *) 0) + return 0; + if (sizeof (int)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_int=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_int=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_int" >&5 + echo "${ECHO_T}$ac_cv_type_int" >&6 + + echo "$as_me:$LINENO: checking size of int" >&5 + echo $ECHO_N "checking size of int... $ECHO_C" >&6 + if test "${ac_cv_sizeof_int+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test "$ac_cv_type_int" = yes; then + # The cast to unsigned long works around a bug in the HP C Compiler + # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects + # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. + # This bug is HP SR number 8606223364. + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (int))) >= 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=0 ac_mid=0 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (int))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr $ac_mid + 1` + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (int))) < 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=-1 ac_mid=-1 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (int))) >= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_hi=`expr '(' $ac_mid ')' - 1` + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo= ac_hi= + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + # Binary search between lo and hi bounds. + while test "x$ac_lo" != "x$ac_hi"; do + ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (int))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr '(' $ac_mid ')' + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + case $ac_lo in + ?*) ac_cv_sizeof_int=$ac_lo;; + '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (int), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } ;; + esac + else + if test "$cross_compiling" = yes; then + { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot run test program while cross compiling + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + long longval () { return (long) (sizeof (int)); } + unsigned long ulongval () { return (long) (sizeof (int)); } + #include + #include + int + main () + { + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + exit (1); + if (((long) (sizeof (int))) < 0) + { + long i = longval (); + if (i != ((long) (sizeof (int)))) + exit (1); + fprintf (f, "%ld\n", i); + } + else + { + unsigned long i = ulongval (); + if (i != ((long) (sizeof (int)))) + exit (1); + fprintf (f, "%lu\n", i); + } + exit (ferror (f) || fclose (f) != 0); + + ; + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_sizeof_int=`cat conftest.val` + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (int), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + fi + rm -f conftest.val + else + ac_cv_sizeof_int=0 + fi + fi + echo "$as_me:$LINENO: result: $ac_cv_sizeof_int" >&5 + echo "${ECHO_T}$ac_cv_sizeof_int" >&6 + cat >>confdefs.h <<_ACEOF + #define SIZEOF_INT $ac_cv_sizeof_int + _ACEOF + + + echo "$as_me:$LINENO: checking for short" >&5 + echo $ECHO_N "checking for short... $ECHO_C" >&6 + if test "${ac_cv_type_short+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + if ((short *) 0) + return 0; + if (sizeof (short)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_short=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_short=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_short" >&5 + echo "${ECHO_T}$ac_cv_type_short" >&6 + + echo "$as_me:$LINENO: checking size of short" >&5 + echo $ECHO_N "checking size of short... $ECHO_C" >&6 + if test "${ac_cv_sizeof_short+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test "$ac_cv_type_short" = yes; then + # The cast to unsigned long works around a bug in the HP C Compiler + # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects + # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. + # This bug is HP SR number 8606223364. + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (short))) >= 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=0 ac_mid=0 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (short))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr $ac_mid + 1` + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (short))) < 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=-1 ac_mid=-1 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (short))) >= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_hi=`expr '(' $ac_mid ')' - 1` + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo= ac_hi= + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + # Binary search between lo and hi bounds. + while test "x$ac_lo" != "x$ac_hi"; do + ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (short))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr '(' $ac_mid ')' + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + case $ac_lo in + ?*) ac_cv_sizeof_short=$ac_lo;; + '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (short), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (short), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } ;; + esac + else + if test "$cross_compiling" = yes; then + { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot run test program while cross compiling + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + long longval () { return (long) (sizeof (short)); } + unsigned long ulongval () { return (long) (sizeof (short)); } + #include + #include + int + main () + { + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + exit (1); + if (((long) (sizeof (short))) < 0) + { + long i = longval (); + if (i != ((long) (sizeof (short)))) + exit (1); + fprintf (f, "%ld\n", i); + } + else + { + unsigned long i = ulongval (); + if (i != ((long) (sizeof (short)))) + exit (1); + fprintf (f, "%lu\n", i); + } + exit (ferror (f) || fclose (f) != 0); + + ; + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_sizeof_short=`cat conftest.val` + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: cannot compute sizeof (short), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (short), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + fi + rm -f conftest.val + else + ac_cv_sizeof_short=0 + fi + fi + echo "$as_me:$LINENO: result: $ac_cv_sizeof_short" >&5 + echo "${ECHO_T}$ac_cv_sizeof_short" >&6 + cat >>confdefs.h <<_ACEOF + #define SIZEOF_SHORT $ac_cv_sizeof_short + _ACEOF + + + echo "$as_me:$LINENO: checking for char" >&5 + echo $ECHO_N "checking for char... $ECHO_C" >&6 + if test "${ac_cv_type_char+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + if ((char *) 0) + return 0; + if (sizeof (char)) + return 0; + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_char=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_type_char=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $ac_cv_type_char" >&5 + echo "${ECHO_T}$ac_cv_type_char" >&6 + + echo "$as_me:$LINENO: checking size of char" >&5 + echo $ECHO_N "checking size of char... $ECHO_C" >&6 + if test "${ac_cv_sizeof_char+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + if test "$ac_cv_type_char" = yes; then + # The cast to unsigned long works around a bug in the HP C Compiler + # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects + # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. + # This bug is HP SR number 8606223364. + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (char))) >= 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=0 ac_mid=0 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (char))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr $ac_mid + 1` + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (char))) < 0)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=-1 ac_mid=-1 + while :; do + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (char))) >= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=$ac_mid; break + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_hi=`expr '(' $ac_mid ')' - 1` + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo= ac_hi= + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + # Binary search between lo and hi bounds. + while test "x$ac_lo" != "x$ac_hi"; do + ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + int + main () + { + static int test_array [1 - 2 * !(((long) (sizeof (char))) <= $ac_mid)]; + test_array [0] = 0 + + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_lo=`expr '(' $ac_mid ')' + 1` + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + done + case $ac_lo in + ?*) ac_cv_sizeof_char=$ac_lo;; + '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (char), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (char), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } ;; + esac + else + if test "$cross_compiling" = yes; then + { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot run test program while cross compiling + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + $ac_includes_default + long longval () { return (long) (sizeof (char)); } + unsigned long ulongval () { return (long) (sizeof (char)); } + #include + #include + int + main () + { + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + exit (1); + if (((long) (sizeof (char))) < 0) + { + long i = longval (); + if (i != ((long) (sizeof (char)))) + exit (1); + fprintf (f, "%ld\n", i); + } + else + { + unsigned long i = ulongval (); + if (i != ((long) (sizeof (char)))) + exit (1); + fprintf (f, "%lu\n", i); + } + exit (ferror (f) || fclose (f) != 0); + + ; + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_sizeof_char=`cat conftest.val` + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + { { echo "$as_me:$LINENO: error: cannot compute sizeof (char), 77 + See \`config.log' for more details." >&5 + echo "$as_me: error: cannot compute sizeof (char), 77 + See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + fi + rm -f conftest.val + else + ac_cv_sizeof_char=0 + fi + fi + echo "$as_me:$LINENO: result: $ac_cv_sizeof_char" >&5 + echo "${ECHO_T}$ac_cv_sizeof_char" >&6 + cat >>confdefs.h <<_ACEOF + #define SIZEOF_CHAR $ac_cv_sizeof_char + _ACEOF + + + + echo "$as_me:$LINENO: checking for type equivalent to int8_t" >&5 + echo $ECHO_N "checking for type equivalent to int8_t... $ECHO_C" >&6 + case "$ac_cv_sizeof_char" in + 1) acx_cv_type_int8_t=char ;; + *) { { echo "$as_me:$LINENO: error: no 8-bit type" >&5 + echo "$as_me: error: no 8-bit type" >&2;} + { (exit please report a bug); exit please report a bug; }; } + esac + echo "$as_me:$LINENO: result: $acx_cv_type_int8_t" >&5 + echo "${ECHO_T}$acx_cv_type_int8_t" >&6 + + echo "$as_me:$LINENO: checking for type equivalent to int16_t" >&5 + echo $ECHO_N "checking for type equivalent to int16_t... $ECHO_C" >&6 + case "$ac_cv_sizeof_int:$ac_cv_sizeof_short" in + 2:*) acx_cv_type_int16_t=int ;; + *:2) acx_cv_type_int16_t=short ;; + *) { { echo "$as_me:$LINENO: error: no 16-bit type" >&5 + echo "$as_me: error: no 16-bit type" >&2;} + { (exit please report a bug); exit please report a bug; }; } + esac + echo "$as_me:$LINENO: result: $acx_cv_type_int16_t" >&5 + echo "${ECHO_T}$acx_cv_type_int16_t" >&6 + + echo "$as_me:$LINENO: checking for type equivalent to int32_t" >&5 + echo $ECHO_N "checking for type equivalent to int32_t... $ECHO_C" >&6 + case "$ac_cv_sizeof_int:$ac_cv_sizeof_long" in + 4:*) acx_cv_type_int32_t=int ;; + *:4) acx_cv_type_int32_t=long ;; + *) { { echo "$as_me:$LINENO: error: no 32-bit type" >&5 + echo "$as_me: error: no 32-bit type" >&2;} + { (exit please report a bug); exit please report a bug; }; } + esac + echo "$as_me:$LINENO: result: $acx_cv_type_int32_t" >&5 + echo "${ECHO_T}$acx_cv_type_int32_t" >&6 + fi + + # These tests are here to make the output prettier + + if test "$ac_cv_type_uint64_t" != yes && test "$ac_cv_type_u_int64_t" != yes; then + case "$ac_cv_sizeof_long" in + 8) acx_cv_type_int64_t=long ;; + esac + echo "$as_me:$LINENO: checking for type equivalent to int64_t" >&5 + echo $ECHO_N "checking for type equivalent to int64_t... $ECHO_C" >&6 + echo "$as_me:$LINENO: result: ${acx_cv_type_int64_t-'using preprocessor symbols'}" >&5 + echo "${ECHO_T}${acx_cv_type_int64_t-'using preprocessor symbols'}" >&6 + fi + + # Now we can use the above types + + if test "$ac_cv_type_uintptr_t" != yes; then + echo "$as_me:$LINENO: checking for type equivalent to intptr_t" >&5 + echo $ECHO_N "checking for type equivalent to intptr_t... $ECHO_C" >&6 + case $ac_cv_sizeof_void_p in + 2) acx_cv_type_intptr_t=int16_t ;; + 4) acx_cv_type_intptr_t=int32_t ;; + 8) acx_cv_type_intptr_t=int64_t ;; + *) { { echo "$as_me:$LINENO: error: no equivalent for intptr_t" >&5 + echo "$as_me: error: no equivalent for intptr_t" >&2;} + { (exit please report a bug); exit please report a bug; }; } + esac + echo "$as_me:$LINENO: result: $acx_cv_type_intptr_t" >&5 + echo "${ECHO_T}$acx_cv_type_intptr_t" >&6 + fi + + # ----------------- done all checks, emit header ------------- + ac_config_commands="$ac_config_commands gstdint.h" + + + + echo "$as_me:$LINENO: checking for struct stat.st_blksize" >&5 echo $ECHO_N "checking for struct stat.st_blksize... $ECHO_C" >&6 if test "${ac_cv_member_struct_stat_st_blksize+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6766,6772 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 9811,9818 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6809,6815 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 9855,9862 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6874,6880 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 9921,9928 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6917,6923 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 9965,9972 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 6982,6988 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10031,10038 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 7025,7031 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10075,10082 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 7060,7141 **** fi - # Check for complex math functions - echo "$as_me:$LINENO: checking for csin in -lm" >&5 - echo $ECHO_N "checking for csin in -lm... $ECHO_C" >&6 - if test "${ac_cv_lib_m_csin+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 - else - ac_check_lib_save_LIBS=$LIBS - LIBS="-lm $LIBS" - if test x$gcc_no_link = xyes; then - { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 - echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} - { (exit 1); exit 1; }; } - fi - cat >conftest.$ac_ext <<_ACEOF - /* confdefs.h. */ - _ACEOF - cat confdefs.h >>conftest.$ac_ext - cat >>conftest.$ac_ext <<_ACEOF - /* end confdefs.h. */ - - /* Override any gcc2 internal prototype to avoid an error. */ - #ifdef __cplusplus - extern "C" - #endif - /* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ - char csin (); - int - main () - { - csin (); - ; - return 0; - } - _ACEOF - rm -f conftest.$ac_objext conftest$ac_exeext - if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - ac_cv_lib_m_csin=yes - else - echo "$as_me: failed program was:" >&5 - sed 's/^/| /' conftest.$ac_ext >&5 - - ac_cv_lib_m_csin=no - fi - rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - LIBS=$ac_check_lib_save_LIBS - fi - echo "$as_me:$LINENO: result: $ac_cv_lib_m_csin" >&5 - echo "${ECHO_T}$ac_cv_lib_m_csin" >&6 - if test $ac_cv_lib_m_csin = yes; then - need_math="no" - else - need_math="yes" - fi - - # Check for library functions. --- 10111,10116 ---- *************** fi *** 7144,7150 **** ! for ac_func in getrusage times mkstemp strtof snprintf ftruncate chsize do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 --- 10119,10126 ---- ! ! for ac_func in getrusage times mkstemp strtof strtold snprintf ftruncate chsize do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7217,7223 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10193,10200 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7330,7336 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10307,10314 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** done *** 7365,7371 **** ! for ac_func in sleep time ttyname do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 --- 10343,10352 ---- ! ! ! ! for ac_func in sleep time ttyname signal alarm ctime do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7438,7444 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10419,10426 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7515,7521 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10497,10504 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7591,7597 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10574,10581 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7667,7673 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10651,10658 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7746,7752 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 10731,10738 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 7779,7784 **** --- 10765,11155 ---- fi + echo "$as_me:$LINENO: checking for acos in -lm" >&5 + echo $ECHO_N "checking for acos in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_acos+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char acos (); + int + main () + { + acos (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_acos=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_acos=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_acos" >&5 + echo "${ECHO_T}$ac_cv_lib_m_acos" >&6 + if test $ac_cv_lib_m_acos = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ACOS 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for acosl in -lm" >&5 + echo $ECHO_N "checking for acosl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_acosl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char acosl (); + int + main () + { + acosl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_acosl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_acosl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_acosl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_acosl" >&6 + if test $ac_cv_lib_m_acosl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ACOSL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for acoshf in -lm" >&5 + echo $ECHO_N "checking for acoshf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_acoshf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char acoshf (); + int + main () + { + acoshf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_acoshf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_acoshf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_acoshf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_acoshf" >&6 + if test $ac_cv_lib_m_acoshf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ACOSHF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for acosh in -lm" >&5 + echo $ECHO_N "checking for acosh in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_acosh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char acosh (); + int + main () + { + acosh (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_acosh=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_acosh=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_acosh" >&5 + echo "${ECHO_T}$ac_cv_lib_m_acosh" >&6 + if test $ac_cv_lib_m_acosh = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ACOSH 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for acoshl in -lm" >&5 + echo $ECHO_N "checking for acoshl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_acoshl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char acoshl (); + int + main () + { + acoshl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_acoshl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_acoshl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_acoshl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_acoshl" >&6 + if test $ac_cv_lib_m_acoshl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ACOSHL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for asinf in -lm" >&5 echo $ECHO_N "checking for asinf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_asinf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7822,7828 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 11193,11200 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 7855,7860 **** --- 11227,11617 ---- fi + echo "$as_me:$LINENO: checking for asin in -lm" >&5 + echo $ECHO_N "checking for asin in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_asin+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char asin (); + int + main () + { + asin (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_asin=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_asin=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_asin" >&5 + echo "${ECHO_T}$ac_cv_lib_m_asin" >&6 + if test $ac_cv_lib_m_asin = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ASIN 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for asinl in -lm" >&5 + echo $ECHO_N "checking for asinl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_asinl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char asinl (); + int + main () + { + asinl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_asinl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_asinl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_asinl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_asinl" >&6 + if test $ac_cv_lib_m_asinl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ASINL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for asinhf in -lm" >&5 + echo $ECHO_N "checking for asinhf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_asinhf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char asinhf (); + int + main () + { + asinhf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_asinhf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_asinhf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_asinhf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_asinhf" >&6 + if test $ac_cv_lib_m_asinhf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ASINHF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for asinh in -lm" >&5 + echo $ECHO_N "checking for asinh in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_asinh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char asinh (); + int + main () + { + asinh (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_asinh=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_asinh=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_asinh" >&5 + echo "${ECHO_T}$ac_cv_lib_m_asinh" >&6 + if test $ac_cv_lib_m_asinh = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ASINH 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for asinhl in -lm" >&5 + echo $ECHO_N "checking for asinhl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_asinhl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char asinhl (); + int + main () + { + asinhl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_asinhl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_asinhl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_asinhl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_asinhl" >&6 + if test $ac_cv_lib_m_asinhl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ASINHL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for atan2f in -lm" >&5 echo $ECHO_N "checking for atan2f in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_atan2f+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7898,7904 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 11655,11662 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 7931,7936 **** --- 11689,11848 ---- fi + echo "$as_me:$LINENO: checking for atan2 in -lm" >&5 + echo $ECHO_N "checking for atan2 in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_atan2+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char atan2 (); + int + main () + { + atan2 (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_atan2=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_atan2=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_atan2" >&5 + echo "${ECHO_T}$ac_cv_lib_m_atan2" >&6 + if test $ac_cv_lib_m_atan2 = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ATAN2 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for atan2l in -lm" >&5 + echo $ECHO_N "checking for atan2l in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_atan2l+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char atan2l (); + int + main () + { + atan2l (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_atan2l=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_atan2l=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_atan2l" >&5 + echo "${ECHO_T}$ac_cv_lib_m_atan2l" >&6 + if test $ac_cv_lib_m_atan2l = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ATAN2L 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for atanf in -lm" >&5 echo $ECHO_N "checking for atanf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_atanf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 7974,7980 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 11886,11893 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8007,8012 **** --- 11920,12541 ---- fi + echo "$as_me:$LINENO: checking for atan in -lm" >&5 + echo $ECHO_N "checking for atan in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_atan+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char atan (); + int + main () + { + atan (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_atan=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_atan=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_atan" >&5 + echo "${ECHO_T}$ac_cv_lib_m_atan" >&6 + if test $ac_cv_lib_m_atan = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ATAN 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for atanl in -lm" >&5 + echo $ECHO_N "checking for atanl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_atanl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char atanl (); + int + main () + { + atanl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_atanl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_atanl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_atanl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_atanl" >&6 + if test $ac_cv_lib_m_atanl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ATANL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for atanhf in -lm" >&5 + echo $ECHO_N "checking for atanhf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_atanhf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char atanhf (); + int + main () + { + atanhf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_atanhf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_atanhf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_atanhf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_atanhf" >&6 + if test $ac_cv_lib_m_atanhf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ATANHF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for atanh in -lm" >&5 + echo $ECHO_N "checking for atanh in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_atanh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char atanh (); + int + main () + { + atanh (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_atanh=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_atanh=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_atanh" >&5 + echo "${ECHO_T}$ac_cv_lib_m_atanh" >&6 + if test $ac_cv_lib_m_atanh = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ATANH 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for atanhl in -lm" >&5 + echo $ECHO_N "checking for atanhl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_atanhl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char atanhl (); + int + main () + { + atanhl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_atanhl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_atanhl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_atanhl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_atanhl" >&6 + if test $ac_cv_lib_m_atanhl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ATANHL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cargf in -lm" >&5 + echo $ECHO_N "checking for cargf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cargf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cargf (); + int + main () + { + cargf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cargf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cargf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cargf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cargf" >&6 + if test $ac_cv_lib_m_cargf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CARGF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for carg in -lm" >&5 + echo $ECHO_N "checking for carg in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_carg+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char carg (); + int + main () + { + carg (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_carg=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_carg=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_carg" >&5 + echo "${ECHO_T}$ac_cv_lib_m_carg" >&6 + if test $ac_cv_lib_m_carg = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CARG 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cargl in -lm" >&5 + echo $ECHO_N "checking for cargl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cargl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cargl (); + int + main () + { + cargl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cargl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cargl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cargl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cargl" >&6 + if test $ac_cv_lib_m_cargl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CARGL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for ceilf in -lm" >&5 echo $ECHO_N "checking for ceilf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_ceilf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8050,8056 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 12579,12586 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8083,8088 **** --- 12613,12772 ---- fi + echo "$as_me:$LINENO: checking for ceil in -lm" >&5 + echo $ECHO_N "checking for ceil in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ceil+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ceil (); + int + main () + { + ceil (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ceil=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ceil=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ceil" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ceil" >&6 + if test $ac_cv_lib_m_ceil = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CEIL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ceill in -lm" >&5 + echo $ECHO_N "checking for ceill in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ceill+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ceill (); + int + main () + { + ceill (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ceill=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ceill=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ceill" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ceill" >&6 + if test $ac_cv_lib_m_ceill = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CEILL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for copysignf in -lm" >&5 echo $ECHO_N "checking for copysignf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_copysignf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8126,8132 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 12810,12817 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8159,8164 **** --- 12844,13003 ---- fi + echo "$as_me:$LINENO: checking for copysign in -lm" >&5 + echo $ECHO_N "checking for copysign in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_copysign+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char copysign (); + int + main () + { + copysign (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_copysign=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_copysign=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_copysign" >&5 + echo "${ECHO_T}$ac_cv_lib_m_copysign" >&6 + if test $ac_cv_lib_m_copysign = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_COPYSIGN 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for copysignl in -lm" >&5 + echo $ECHO_N "checking for copysignl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_copysignl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char copysignl (); + int + main () + { + copysignl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_copysignl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_copysignl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_copysignl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_copysignl" >&6 + if test $ac_cv_lib_m_copysignl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_COPYSIGNL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for cosf in -lm" >&5 echo $ECHO_N "checking for cosf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_cosf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8202,8208 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 13041,13048 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8235,8240 **** --- 13075,13465 ---- fi + echo "$as_me:$LINENO: checking for cos in -lm" >&5 + echo $ECHO_N "checking for cos in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cos+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cos (); + int + main () + { + cos (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cos=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cos=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cos" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cos" >&6 + if test $ac_cv_lib_m_cos = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_COS 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cosl in -lm" >&5 + echo $ECHO_N "checking for cosl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cosl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cosl (); + int + main () + { + cosl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cosl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cosl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cosl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cosl" >&6 + if test $ac_cv_lib_m_cosl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_COSL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ccosf in -lm" >&5 + echo $ECHO_N "checking for ccosf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ccosf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ccosf (); + int + main () + { + ccosf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ccosf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ccosf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ccosf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ccosf" >&6 + if test $ac_cv_lib_m_ccosf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CCOSF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ccos in -lm" >&5 + echo $ECHO_N "checking for ccos in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ccos+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ccos (); + int + main () + { + ccos (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ccos=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ccos=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ccos" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ccos" >&6 + if test $ac_cv_lib_m_ccos = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CCOS 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ccosl in -lm" >&5 + echo $ECHO_N "checking for ccosl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ccosl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ccosl (); + int + main () + { + ccosl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ccosl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ccosl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ccosl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ccosl" >&6 + if test $ac_cv_lib_m_ccosl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CCOSL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for coshf in -lm" >&5 echo $ECHO_N "checking for coshf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_coshf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8278,8284 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 13503,13510 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8311,8316 **** --- 13537,13927 ---- fi + echo "$as_me:$LINENO: checking for cosh in -lm" >&5 + echo $ECHO_N "checking for cosh in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cosh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cosh (); + int + main () + { + cosh (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cosh=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cosh=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cosh" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cosh" >&6 + if test $ac_cv_lib_m_cosh = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_COSH 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for coshl in -lm" >&5 + echo $ECHO_N "checking for coshl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_coshl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char coshl (); + int + main () + { + coshl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_coshl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_coshl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_coshl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_coshl" >&6 + if test $ac_cv_lib_m_coshl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_COSHL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ccoshf in -lm" >&5 + echo $ECHO_N "checking for ccoshf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ccoshf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ccoshf (); + int + main () + { + ccoshf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ccoshf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ccoshf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ccoshf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ccoshf" >&6 + if test $ac_cv_lib_m_ccoshf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CCOSHF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ccosh in -lm" >&5 + echo $ECHO_N "checking for ccosh in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ccosh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ccosh (); + int + main () + { + ccosh (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ccosh=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ccosh=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ccosh" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ccosh" >&6 + if test $ac_cv_lib_m_ccosh = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CCOSH 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ccoshl in -lm" >&5 + echo $ECHO_N "checking for ccoshl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ccoshl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ccoshl (); + int + main () + { + ccoshl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ccoshl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ccoshl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ccoshl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ccoshl" >&6 + if test $ac_cv_lib_m_ccoshl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CCOSHL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for expf in -lm" >&5 echo $ECHO_N "checking for expf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_expf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8354,8360 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 13965,13972 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8387,8392 **** --- 13999,14389 ---- fi + echo "$as_me:$LINENO: checking for exp in -lm" >&5 + echo $ECHO_N "checking for exp in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_exp+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char exp (); + int + main () + { + exp (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_exp=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_exp=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_exp" >&5 + echo "${ECHO_T}$ac_cv_lib_m_exp" >&6 + if test $ac_cv_lib_m_exp = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_EXP 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for expl in -lm" >&5 + echo $ECHO_N "checking for expl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_expl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char expl (); + int + main () + { + expl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_expl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_expl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_expl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_expl" >&6 + if test $ac_cv_lib_m_expl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_EXPL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cexpf in -lm" >&5 + echo $ECHO_N "checking for cexpf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cexpf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cexpf (); + int + main () + { + cexpf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cexpf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cexpf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cexpf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cexpf" >&6 + if test $ac_cv_lib_m_cexpf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CEXPF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cexp in -lm" >&5 + echo $ECHO_N "checking for cexp in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cexp+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cexp (); + int + main () + { + cexp (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cexp=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cexp=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cexp" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cexp" >&6 + if test $ac_cv_lib_m_cexp = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CEXP 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cexpl in -lm" >&5 + echo $ECHO_N "checking for cexpl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cexpl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cexpl (); + int + main () + { + cexpl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cexpl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cexpl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cexpl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cexpl" >&6 + if test $ac_cv_lib_m_cexpl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CEXPL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for fabsf in -lm" >&5 echo $ECHO_N "checking for fabsf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_fabsf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8430,8436 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 14427,14434 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8463,8468 **** --- 14461,14851 ---- fi + echo "$as_me:$LINENO: checking for fabs in -lm" >&5 + echo $ECHO_N "checking for fabs in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_fabs+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char fabs (); + int + main () + { + fabs (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_fabs=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_fabs=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_fabs" >&5 + echo "${ECHO_T}$ac_cv_lib_m_fabs" >&6 + if test $ac_cv_lib_m_fabs = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_FABS 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for fabsl in -lm" >&5 + echo $ECHO_N "checking for fabsl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_fabsl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char fabsl (); + int + main () + { + fabsl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_fabsl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_fabsl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_fabsl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_fabsl" >&6 + if test $ac_cv_lib_m_fabsl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_FABSL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cabsf in -lm" >&5 + echo $ECHO_N "checking for cabsf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cabsf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cabsf (); + int + main () + { + cabsf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cabsf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cabsf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cabsf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cabsf" >&6 + if test $ac_cv_lib_m_cabsf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CABSF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cabs in -lm" >&5 + echo $ECHO_N "checking for cabs in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cabs+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cabs (); + int + main () + { + cabs (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cabs=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cabs=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cabs" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cabs" >&6 + if test $ac_cv_lib_m_cabs = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CABS 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for cabsl in -lm" >&5 + echo $ECHO_N "checking for cabsl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_cabsl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char cabsl (); + int + main () + { + cabsl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_cabsl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_cabsl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_cabsl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_cabsl" >&6 + if test $ac_cv_lib_m_cabsl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CABSL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for floorf in -lm" >&5 echo $ECHO_N "checking for floorf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_floorf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8506,8512 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 14889,14896 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8539,8544 **** --- 14923,15082 ---- fi + echo "$as_me:$LINENO: checking for floor in -lm" >&5 + echo $ECHO_N "checking for floor in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_floor+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char floor (); + int + main () + { + floor (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_floor=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_floor=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_floor" >&5 + echo "${ECHO_T}$ac_cv_lib_m_floor" >&6 + if test $ac_cv_lib_m_floor = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_FLOOR 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for floorl in -lm" >&5 + echo $ECHO_N "checking for floorl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_floorl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char floorl (); + int + main () + { + floorl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_floorl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_floorl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_floorl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_floorl" >&6 + if test $ac_cv_lib_m_floorl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_FLOORL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for frexpf in -lm" >&5 echo $ECHO_N "checking for frexpf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_frexpf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8582,8588 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 15120,15127 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8615,8620 **** --- 15154,15313 ---- fi + echo "$as_me:$LINENO: checking for frexp in -lm" >&5 + echo $ECHO_N "checking for frexp in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_frexp+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char frexp (); + int + main () + { + frexp (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_frexp=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_frexp=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_frexp" >&5 + echo "${ECHO_T}$ac_cv_lib_m_frexp" >&6 + if test $ac_cv_lib_m_frexp = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_FREXP 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for frexpl in -lm" >&5 + echo $ECHO_N "checking for frexpl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_frexpl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char frexpl (); + int + main () + { + frexpl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_frexpl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_frexpl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_frexpl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_frexpl" >&6 + if test $ac_cv_lib_m_frexpl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_FREXPL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for hypotf in -lm" >&5 echo $ECHO_N "checking for hypotf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_hypotf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8658,8664 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 15351,15358 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8691,8696 **** --- 15385,15544 ---- fi + echo "$as_me:$LINENO: checking for hypot in -lm" >&5 + echo $ECHO_N "checking for hypot in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_hypot+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char hypot (); + int + main () + { + hypot (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_hypot=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_hypot=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_hypot" >&5 + echo "${ECHO_T}$ac_cv_lib_m_hypot" >&6 + if test $ac_cv_lib_m_hypot = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_HYPOT 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for hypotl in -lm" >&5 + echo $ECHO_N "checking for hypotl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_hypotl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char hypotl (); + int + main () + { + hypotl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_hypotl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_hypotl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_hypotl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_hypotl" >&6 + if test $ac_cv_lib_m_hypotl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_HYPOTL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for logf in -lm" >&5 echo $ECHO_N "checking for logf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_logf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8734,8740 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 15582,15589 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8767,8772 **** --- 15616,16006 ---- fi + echo "$as_me:$LINENO: checking for log in -lm" >&5 + echo $ECHO_N "checking for log in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_log+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char log (); + int + main () + { + log (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_log=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_log=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_log" >&5 + echo "${ECHO_T}$ac_cv_lib_m_log" >&6 + if test $ac_cv_lib_m_log = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_LOG 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for logl in -lm" >&5 + echo $ECHO_N "checking for logl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_logl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char logl (); + int + main () + { + logl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_logl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_logl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_logl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_logl" >&6 + if test $ac_cv_lib_m_logl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_LOGL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for clogf in -lm" >&5 + echo $ECHO_N "checking for clogf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_clogf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char clogf (); + int + main () + { + clogf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_clogf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_clogf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_clogf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_clogf" >&6 + if test $ac_cv_lib_m_clogf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CLOGF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for clog in -lm" >&5 + echo $ECHO_N "checking for clog in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_clog+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char clog (); + int + main () + { + clog (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_clog=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_clog=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_clog" >&5 + echo "${ECHO_T}$ac_cv_lib_m_clog" >&6 + if test $ac_cv_lib_m_clog = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CLOG 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for clogl in -lm" >&5 + echo $ECHO_N "checking for clogl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_clogl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char clogl (); + int + main () + { + clogl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_clogl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_clogl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_clogl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_clogl" >&6 + if test $ac_cv_lib_m_clogl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CLOGL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for log10f in -lm" >&5 echo $ECHO_N "checking for log10f in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_log10f+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8810,8816 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 16044,16051 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8843,8851 **** fi ! echo "$as_me:$LINENO: checking for nextafter in -lm" >&5 ! echo $ECHO_N "checking for nextafter in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_nextafter+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 16078,16086 ---- fi ! echo "$as_me:$LINENO: checking for log10 in -lm" >&5 ! echo $ECHO_N "checking for log10 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_log10+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 8868,8878 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char nextafter (); int main () { ! nextafter (); ; return 0; } --- 16103,16113 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char log10 (); int main () { ! log10 (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8886,8892 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 16121,16128 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8898,8920 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_nextafter=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_nextafter=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_nextafter" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_nextafter" >&6 ! if test $ac_cv_lib_m_nextafter = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_NEXTAFTER 1 _ACEOF fi --- 16134,16464 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_log10=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_log10=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_log10" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_log10" >&6 ! if test $ac_cv_lib_m_log10 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_LOG10 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for log10l in -lm" >&5 ! echo $ECHO_N "checking for log10l in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_log10l+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char log10l (); ! int ! main () ! { ! log10l (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_log10l=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_log10l=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_log10l" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_log10l" >&6 ! if test $ac_cv_lib_m_log10l = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_LOG10L 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for clog10f in -lm" >&5 ! echo $ECHO_N "checking for clog10f in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_clog10f+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char clog10f (); ! int ! main () ! { ! clog10f (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_clog10f=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_clog10f=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_clog10f" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_clog10f" >&6 ! if test $ac_cv_lib_m_clog10f = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CLOG10F 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for clog10 in -lm" >&5 ! echo $ECHO_N "checking for clog10 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_clog10+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char clog10 (); ! int ! main () ! { ! clog10 (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_clog10=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_clog10=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_clog10" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_clog10" >&6 ! if test $ac_cv_lib_m_clog10 = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CLOG10 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for clog10l in -lm" >&5 ! echo $ECHO_N "checking for clog10l in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_clog10l+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char clog10l (); ! int ! main () ! { ! clog10l (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_clog10l=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_clog10l=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_clog10l" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_clog10l" >&6 ! if test $ac_cv_lib_m_clog10l = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CLOG10L 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 8962,8968 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 16506,16513 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 8995,9000 **** --- 16540,16699 ---- fi + echo "$as_me:$LINENO: checking for nextafter in -lm" >&5 + echo $ECHO_N "checking for nextafter in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_nextafter+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char nextafter (); + int + main () + { + nextafter (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_nextafter=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_nextafter=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_nextafter" >&5 + echo "${ECHO_T}$ac_cv_lib_m_nextafter" >&6 + if test $ac_cv_lib_m_nextafter = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_NEXTAFTER 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for nextafterl in -lm" >&5 + echo $ECHO_N "checking for nextafterl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_nextafterl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char nextafterl (); + int + main () + { + nextafterl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_nextafterl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_nextafterl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_nextafterl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_nextafterl" >&6 + if test $ac_cv_lib_m_nextafterl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_NEXTAFTERL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for powf in -lm" >&5 echo $ECHO_N "checking for powf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_powf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9038,9044 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 16737,16744 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9071,9079 **** fi ! echo "$as_me:$LINENO: checking for round in -lm" >&5 ! echo $ECHO_N "checking for round in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_round+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 16771,16779 ---- fi ! echo "$as_me:$LINENO: checking for pow in -lm" >&5 ! echo $ECHO_N "checking for pow in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_pow+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 9096,9106 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char round (); int main () { ! round (); ; return 0; } --- 16796,16806 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char pow (); int main () { ! pow (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9114,9120 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 16814,16821 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9126,9148 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_round=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_round=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_round" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_round" >&6 ! if test $ac_cv_lib_m_round = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_ROUND 1 _ACEOF fi --- 16827,17157 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_pow=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_pow=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_pow" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_pow" >&6 ! if test $ac_cv_lib_m_pow = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_POW 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for powl in -lm" >&5 ! echo $ECHO_N "checking for powl in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_powl+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char powl (); ! int ! main () ! { ! powl (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_powl=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_powl=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_powl" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_powl" >&6 ! if test $ac_cv_lib_m_powl = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_POWL 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for cpowf in -lm" >&5 ! echo $ECHO_N "checking for cpowf in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_cpowf+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char cpowf (); ! int ! main () ! { ! cpowf (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_cpowf=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_cpowf=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_cpowf" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_cpowf" >&6 ! if test $ac_cv_lib_m_cpowf = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CPOWF 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for cpow in -lm" >&5 ! echo $ECHO_N "checking for cpow in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_cpow+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char cpow (); ! int ! main () ! { ! cpow (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_cpow=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_cpow=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_cpow" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_cpow" >&6 ! if test $ac_cv_lib_m_cpow = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CPOW 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for cpowl in -lm" >&5 ! echo $ECHO_N "checking for cpowl in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_cpowl+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char cpowl (); ! int ! main () ! { ! cpowl (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_cpowl=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_cpowl=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_cpowl" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_cpowl" >&6 ! if test $ac_cv_lib_m_cpowl = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CPOWL 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9190,9196 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 17199,17206 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9223,9228 **** --- 17233,17392 ---- fi + echo "$as_me:$LINENO: checking for round in -lm" >&5 + echo $ECHO_N "checking for round in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_round+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char round (); + int + main () + { + round (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_round=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_round=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_round" >&5 + echo "${ECHO_T}$ac_cv_lib_m_round" >&6 + if test $ac_cv_lib_m_round = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ROUND 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for roundl in -lm" >&5 + echo $ECHO_N "checking for roundl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_roundl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char roundl (); + int + main () + { + roundl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_roundl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_roundl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_roundl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_roundl" >&6 + if test $ac_cv_lib_m_roundl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ROUNDL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for scalbnf in -lm" >&5 echo $ECHO_N "checking for scalbnf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_scalbnf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9266,9272 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 17430,17437 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9342,9348 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 17507,17514 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9375,9380 **** --- 17541,17623 ---- fi + echo "$as_me:$LINENO: checking for scalbnl in -lm" >&5 + echo $ECHO_N "checking for scalbnl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_scalbnl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char scalbnl (); + int + main () + { + scalbnl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_scalbnl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_scalbnl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_scalbnl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_scalbnl" >&6 + if test $ac_cv_lib_m_scalbnl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_SCALBNL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for sinf in -lm" >&5 echo $ECHO_N "checking for sinf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_sinf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9418,9424 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 17661,17668 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9451,9456 **** --- 17695,18085 ---- fi + echo "$as_me:$LINENO: checking for sin in -lm" >&5 + echo $ECHO_N "checking for sin in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_sin+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char sin (); + int + main () + { + sin (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_sin=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_sin=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_sin" >&5 + echo "${ECHO_T}$ac_cv_lib_m_sin" >&6 + if test $ac_cv_lib_m_sin = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_SIN 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for sinl in -lm" >&5 + echo $ECHO_N "checking for sinl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_sinl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char sinl (); + int + main () + { + sinl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_sinl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_sinl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_sinl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_sinl" >&6 + if test $ac_cv_lib_m_sinl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_SINL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csinf in -lm" >&5 + echo $ECHO_N "checking for csinf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csinf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csinf (); + int + main () + { + csinf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csinf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csinf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csinf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csinf" >&6 + if test $ac_cv_lib_m_csinf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSINF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csin in -lm" >&5 + echo $ECHO_N "checking for csin in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csin+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csin (); + int + main () + { + csin (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csin=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csin=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csin" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csin" >&6 + if test $ac_cv_lib_m_csin = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSIN 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csinl in -lm" >&5 + echo $ECHO_N "checking for csinl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csinl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csinl (); + int + main () + { + csinl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csinl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csinl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csinl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csinl" >&6 + if test $ac_cv_lib_m_csinl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSINL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for sinhf in -lm" >&5 echo $ECHO_N "checking for sinhf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_sinhf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9494,9500 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 18123,18130 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9527,9532 **** --- 18157,18547 ---- fi + echo "$as_me:$LINENO: checking for sinh in -lm" >&5 + echo $ECHO_N "checking for sinh in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_sinh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char sinh (); + int + main () + { + sinh (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_sinh=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_sinh=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_sinh" >&5 + echo "${ECHO_T}$ac_cv_lib_m_sinh" >&6 + if test $ac_cv_lib_m_sinh = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_SINH 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for sinhl in -lm" >&5 + echo $ECHO_N "checking for sinhl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_sinhl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char sinhl (); + int + main () + { + sinhl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_sinhl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_sinhl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_sinhl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_sinhl" >&6 + if test $ac_cv_lib_m_sinhl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_SINHL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csinhf in -lm" >&5 + echo $ECHO_N "checking for csinhf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csinhf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csinhf (); + int + main () + { + csinhf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csinhf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csinhf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csinhf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csinhf" >&6 + if test $ac_cv_lib_m_csinhf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSINHF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csinh in -lm" >&5 + echo $ECHO_N "checking for csinh in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csinh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csinh (); + int + main () + { + csinh (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csinh=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csinh=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csinh" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csinh" >&6 + if test $ac_cv_lib_m_csinh = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSINH 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csinhl in -lm" >&5 + echo $ECHO_N "checking for csinhl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csinhl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csinhl (); + int + main () + { + csinhl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csinhl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csinhl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csinhl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csinhl" >&6 + if test $ac_cv_lib_m_csinhl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSINHL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for sqrtf in -lm" >&5 echo $ECHO_N "checking for sqrtf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_sqrtf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9570,9576 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 18585,18592 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9603,9608 **** --- 18619,19009 ---- fi + echo "$as_me:$LINENO: checking for sqrt in -lm" >&5 + echo $ECHO_N "checking for sqrt in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_sqrt+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char sqrt (); + int + main () + { + sqrt (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_sqrt=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_sqrt=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_sqrt" >&5 + echo "${ECHO_T}$ac_cv_lib_m_sqrt" >&6 + if test $ac_cv_lib_m_sqrt = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_SQRT 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for sqrtl in -lm" >&5 + echo $ECHO_N "checking for sqrtl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_sqrtl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char sqrtl (); + int + main () + { + sqrtl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_sqrtl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_sqrtl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_sqrtl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_sqrtl" >&6 + if test $ac_cv_lib_m_sqrtl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_SQRTL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csqrtf in -lm" >&5 + echo $ECHO_N "checking for csqrtf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csqrtf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csqrtf (); + int + main () + { + csqrtf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csqrtf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csqrtf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csqrtf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csqrtf" >&6 + if test $ac_cv_lib_m_csqrtf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSQRTF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csqrt in -lm" >&5 + echo $ECHO_N "checking for csqrt in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csqrt+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csqrt (); + int + main () + { + csqrt (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csqrt=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csqrt=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csqrt" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csqrt" >&6 + if test $ac_cv_lib_m_csqrt = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSQRT 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for csqrtl in -lm" >&5 + echo $ECHO_N "checking for csqrtl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_csqrtl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char csqrtl (); + int + main () + { + csqrtl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_csqrtl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_csqrtl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_csqrtl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_csqrtl" >&6 + if test $ac_cv_lib_m_csqrtl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CSQRTL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for tanf in -lm" >&5 echo $ECHO_N "checking for tanf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_tanf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9646,9652 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 19047,19054 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9679,9684 **** --- 19081,19471 ---- fi + echo "$as_me:$LINENO: checking for tan in -lm" >&5 + echo $ECHO_N "checking for tan in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_tan+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char tan (); + int + main () + { + tan (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_tan=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_tan=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_tan" >&5 + echo "${ECHO_T}$ac_cv_lib_m_tan" >&6 + if test $ac_cv_lib_m_tan = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_TAN 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for tanl in -lm" >&5 + echo $ECHO_N "checking for tanl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_tanl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char tanl (); + int + main () + { + tanl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_tanl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_tanl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_tanl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_tanl" >&6 + if test $ac_cv_lib_m_tanl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_TANL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ctanf in -lm" >&5 + echo $ECHO_N "checking for ctanf in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ctanf+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ctanf (); + int + main () + { + ctanf (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ctanf=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ctanf=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ctanf" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ctanf" >&6 + if test $ac_cv_lib_m_ctanf = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CTANF 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ctan in -lm" >&5 + echo $ECHO_N "checking for ctan in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ctan+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ctan (); + int + main () + { + ctan (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ctan=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ctan=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ctan" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ctan" >&6 + if test $ac_cv_lib_m_ctan = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CTAN 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ctanl in -lm" >&5 + echo $ECHO_N "checking for ctanl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ctanl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ctanl (); + int + main () + { + ctanl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ctanl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ctanl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ctanl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ctanl" >&6 + if test $ac_cv_lib_m_ctanl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CTANL 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for tanhf in -lm" >&5 echo $ECHO_N "checking for tanhf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_tanhf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9722,9728 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 19509,19516 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9755,9763 **** fi ! echo "$as_me:$LINENO: checking for trunc in -lm" >&5 ! echo $ECHO_N "checking for trunc in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_trunc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 19543,19551 ---- fi ! echo "$as_me:$LINENO: checking for tanh in -lm" >&5 ! echo $ECHO_N "checking for tanh in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_tanh+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 9780,9790 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char trunc (); int main () { ! trunc (); ; return 0; } --- 19568,19578 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char tanh (); int main () { ! tanh (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9798,9804 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 19586,19593 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9810,9832 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_trunc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_trunc=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_trunc" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_trunc" >&6 ! if test $ac_cv_lib_m_trunc = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_TRUNC 1 _ACEOF fi --- 19599,19929 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_tanh=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_tanh=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_tanh" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_tanh" >&6 ! if test $ac_cv_lib_m_tanh = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_TANH 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for tanhl in -lm" >&5 ! echo $ECHO_N "checking for tanhl in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_tanhl+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char tanhl (); ! int ! main () ! { ! tanhl (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_tanhl=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_tanhl=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_tanhl" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_tanhl" >&6 ! if test $ac_cv_lib_m_tanhl = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_TANHL 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for ctanhf in -lm" >&5 ! echo $ECHO_N "checking for ctanhf in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_ctanhf+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char ctanhf (); ! int ! main () ! { ! ctanhf (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_ctanhf=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_ctanhf=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_ctanhf" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_ctanhf" >&6 ! if test $ac_cv_lib_m_ctanhf = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CTANHF 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for ctanh in -lm" >&5 ! echo $ECHO_N "checking for ctanh in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_ctanh+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char ctanh (); ! int ! main () ! { ! ctanh (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_ctanh=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_ctanh=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_ctanh" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_ctanh" >&6 ! if test $ac_cv_lib_m_ctanh = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CTANH 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for ctanhl in -lm" >&5 ! echo $ECHO_N "checking for ctanhl in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_ctanhl+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char ctanhl (); ! int ! main () ! { ! ctanhl (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_ctanhl=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_ctanhl=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_ctanhl" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_ctanhl" >&6 ! if test $ac_cv_lib_m_ctanhl = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_CTANHL 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9874,9880 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 19971,19978 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9907,9912 **** --- 20005,20241 ---- fi + echo "$as_me:$LINENO: checking for trunc in -lm" >&5 + echo $ECHO_N "checking for trunc in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_trunc+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char trunc (); + int + main () + { + trunc (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_trunc=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_trunc=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_trunc" >&5 + echo "${ECHO_T}$ac_cv_lib_m_trunc" >&6 + if test $ac_cv_lib_m_trunc = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_TRUNC 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for truncl in -lm" >&5 + echo $ECHO_N "checking for truncl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_truncl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char truncl (); + int + main () + { + truncl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_truncl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_truncl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_truncl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_truncl" >&6 + if test $ac_cv_lib_m_truncl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_TRUNCL 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for erff in -lm" >&5 + echo $ECHO_N "checking for erff in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_erff+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char erff (); + int + main () + { + erff (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_erff=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_erff=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_erff" >&5 + echo "${ECHO_T}$ac_cv_lib_m_erff" >&6 + if test $ac_cv_lib_m_erff = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_ERFF 1 + _ACEOF + + fi + echo "$as_me:$LINENO: checking for erf in -lm" >&5 echo $ECHO_N "checking for erf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_erf+set}" = set; then *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 9950,9956 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20279,20286 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 9983,9991 **** fi ! echo "$as_me:$LINENO: checking for erfc in -lm" >&5 ! echo $ECHO_N "checking for erfc in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_erfc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 20313,20321 ---- fi ! echo "$as_me:$LINENO: checking for erfl in -lm" >&5 ! echo $ECHO_N "checking for erfl in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_erfl+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 10008,10018 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char erfc (); int main () { ! erfc (); ; return 0; } --- 20338,20348 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char erfl (); int main () { ! erfl (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10026,10032 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20356,20363 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10038,10060 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_erfc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_erfc=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_erfc" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_erfc" >&6 ! if test $ac_cv_lib_m_erfc = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_ERFC 1 _ACEOF fi --- 20369,20391 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_erfl=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_erfl=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_erfl" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_erfl" >&6 ! if test $ac_cv_lib_m_erfl = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_ERFL 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10102,10108 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20433,20440 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 10135,10143 **** fi ! echo "$as_me:$LINENO: checking for erff in -lm" >&5 ! echo $ECHO_N "checking for erff in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_erff+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 20467,20475 ---- fi ! echo "$as_me:$LINENO: checking for erfc in -lm" >&5 ! echo $ECHO_N "checking for erfc in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_erfc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 10160,10170 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char erff (); int main () { ! erff (); ; return 0; } --- 20492,20502 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char erfc (); int main () { ! erfc (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10178,10184 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20510,20517 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10190,10219 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_erff=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_erff=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_erff" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_erff" >&6 ! if test $ac_cv_lib_m_erff = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_ERFF 1 _ACEOF fi ! echo "$as_me:$LINENO: checking for j0 in -lm" >&5 ! echo $ECHO_N "checking for j0 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_j0+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 20523,20552 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_erfc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_erfc=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_erfc" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_erfc" >&6 ! if test $ac_cv_lib_m_erfc = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_ERFC 1 _ACEOF fi ! echo "$as_me:$LINENO: checking for erfcl in -lm" >&5 ! echo $ECHO_N "checking for erfcl in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_erfcl+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 10236,10246 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char j0 (); int main () { ! j0 (); ; return 0; } --- 20569,20579 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char erfcl (); int main () { ! erfcl (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10254,10260 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20587,20594 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10266,10288 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_j0=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_j0=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_j0" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_j0" >&6 ! if test $ac_cv_lib_m_j0 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_J0 1 _ACEOF fi --- 20600,20622 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_erfcl=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_erfcl=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_erfcl" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_erfcl" >&6 ! if test $ac_cv_lib_m_erfcl = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_ERFCL 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10330,10336 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20664,20671 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 10363,10371 **** fi ! echo "$as_me:$LINENO: checking for j1 in -lm" >&5 ! echo $ECHO_N "checking for j1 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_j1+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 20698,20706 ---- fi ! echo "$as_me:$LINENO: checking for j0 in -lm" >&5 ! echo $ECHO_N "checking for j0 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_j0+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 10388,10398 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char j1 (); int main () { ! j1 (); ; return 0; } --- 20723,20733 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char j0 (); int main () { ! j0 (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10406,10412 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20741,20748 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10418,10440 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_j1=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_j1=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_j1" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_j1" >&6 ! if test $ac_cv_lib_m_j1 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_J1 1 _ACEOF fi --- 20754,20853 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_j0=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_j0=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_j0" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_j0" >&6 ! if test $ac_cv_lib_m_j0 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_J0 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for j0l in -lm" >&5 ! echo $ECHO_N "checking for j0l in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_j0l+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char j0l (); ! int ! main () ! { ! j0l (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_j0l=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_j0l=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_j0l" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_j0l" >&6 ! if test $ac_cv_lib_m_j0l = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_J0L 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10482,10488 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20895,20902 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 10515,10523 **** fi ! echo "$as_me:$LINENO: checking for jn in -lm" >&5 ! echo $ECHO_N "checking for jn in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_jn+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 20929,20937 ---- fi ! echo "$as_me:$LINENO: checking for j1 in -lm" >&5 ! echo $ECHO_N "checking for j1 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_j1+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 10540,10550 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char jn (); int main () { ! jn (); ; return 0; } --- 20954,20964 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char j1 (); int main () { ! j1 (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10558,10564 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 20972,20979 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10570,10592 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_jn=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_jn=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_jn" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_jn" >&6 ! if test $ac_cv_lib_m_jn = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_JN 1 _ACEOF fi --- 20985,21084 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_j1=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_j1=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_j1" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_j1" >&6 ! if test $ac_cv_lib_m_j1 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_J1 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for j1l in -lm" >&5 ! echo $ECHO_N "checking for j1l in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_j1l+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char j1l (); ! int ! main () ! { ! j1l (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_j1l=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_j1l=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_j1l" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_j1l" >&6 ! if test $ac_cv_lib_m_j1l = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_J1L 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10634,10640 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 21126,21133 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 10667,10675 **** fi ! echo "$as_me:$LINENO: checking for y0 in -lm" >&5 ! echo $ECHO_N "checking for y0 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_y0+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 21160,21168 ---- fi ! echo "$as_me:$LINENO: checking for jn in -lm" >&5 ! echo $ECHO_N "checking for jn in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_jn+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 10692,10702 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char y0 (); int main () { ! y0 (); ; return 0; } --- 21185,21195 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char jn (); int main () { ! jn (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10710,10716 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 21203,21210 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10722,10744 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_y0=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_y0=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_y0" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_y0" >&6 ! if test $ac_cv_lib_m_y0 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_Y0 1 _ACEOF fi --- 21216,21315 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_jn=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_jn=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_jn" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_jn" >&6 ! if test $ac_cv_lib_m_jn = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_JN 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for jnl in -lm" >&5 ! echo $ECHO_N "checking for jnl in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_jnl+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char jnl (); ! int ! main () ! { ! jnl (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_jnl=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_jnl=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_jnl" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_jnl" >&6 ! if test $ac_cv_lib_m_jnl = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_JNL 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10786,10792 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 21357,21364 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 10819,10827 **** fi ! echo "$as_me:$LINENO: checking for y1 in -lm" >&5 ! echo $ECHO_N "checking for y1 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_y1+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 21391,21399 ---- fi ! echo "$as_me:$LINENO: checking for y0 in -lm" >&5 ! echo $ECHO_N "checking for y0 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_y0+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 10844,10854 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char y1 (); int main () { ! y1 (); ; return 0; } --- 21416,21426 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char y0 (); int main () { ! y0 (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10862,10868 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 21434,21441 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10874,10896 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_y1=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_y1=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_y1" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_y1" >&6 ! if test $ac_cv_lib_m_y1 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_Y1 1 _ACEOF fi --- 21447,21546 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_y0=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_y0=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_y0" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_y0" >&6 ! if test $ac_cv_lib_m_y0 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_Y0 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for y0l in -lm" >&5 ! echo $ECHO_N "checking for y0l in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_y0l+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char y0l (); ! int ! main () ! { ! y0l (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_y0l=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_y0l=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_y0l" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_y0l" >&6 ! if test $ac_cv_lib_m_y0l = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_Y0L 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 10938,10944 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 21588,21595 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 10971,10979 **** fi ! echo "$as_me:$LINENO: checking for yn in -lm" >&5 ! echo $ECHO_N "checking for yn in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_yn+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS --- 21622,21630 ---- fi ! echo "$as_me:$LINENO: checking for y1 in -lm" >&5 ! echo $ECHO_N "checking for y1 in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_y1+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS *************** extern "C" *** 10996,11006 **** #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char yn (); int main () { ! yn (); ; return 0; } --- 21647,21657 ---- #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ ! char y1 (); int main () { ! y1 (); ; return 0; } *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 11014,11020 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 21665,21672 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 11026,11048 **** ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_yn=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_yn=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_yn" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_yn" >&6 ! if test $ac_cv_lib_m_yn = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_YN 1 _ACEOF fi --- 21678,21777 ---- ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ! ac_cv_lib_m_y1=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ! ac_cv_lib_m_y1=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_y1" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_y1" >&6 ! if test $ac_cv_lib_m_y1 = yes; then cat >>confdefs.h <<\_ACEOF ! #define HAVE_Y1 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for y1l in -lm" >&5 ! echo $ECHO_N "checking for y1l in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_y1l+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char y1l (); ! int ! main () ! { ! y1l (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_y1l=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_y1l=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_y1l" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_y1l" >&6 ! if test $ac_cv_lib_m_y1l = yes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_Y1L 1 _ACEOF fi *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 11090,11096 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 21819,21826 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 11123,11128 **** --- 21853,22412 ---- fi + echo "$as_me:$LINENO: checking for yn in -lm" >&5 + echo $ECHO_N "checking for yn in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_yn+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char yn (); + int + main () + { + yn (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_yn=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_yn=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_yn" >&5 + echo "${ECHO_T}$ac_cv_lib_m_yn" >&6 + if test $ac_cv_lib_m_yn = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_YN 1 + _ACEOF + + fi + + echo "$as_me:$LINENO: checking for ynl in -lm" >&5 + echo $ECHO_N "checking for ynl in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m_ynl+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char ynl (); + int + main () + { + ynl (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m_ynl=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m_ynl=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m_ynl" >&5 + echo "${ECHO_T}$ac_cv_lib_m_ynl" >&6 + if test $ac_cv_lib_m_ynl = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_YNL 1 + _ACEOF + + fi + + + # On AIX, clog is present in libm as __clog + echo "$as_me:$LINENO: checking for __clog in -lm" >&5 + echo $ECHO_N "checking for __clog in -lm... $ECHO_C" >&6 + if test "${ac_cv_lib_m___clog+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + /* Override any gcc2 internal prototype to avoid an error. */ + #ifdef __cplusplus + extern "C" + #endif + /* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ + char __clog (); + int + main () + { + __clog (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_m___clog=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_m___clog=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_m___clog" >&5 + echo "${ECHO_T}$ac_cv_lib_m___clog" >&6 + if test $ac_cv_lib_m___clog = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_CLOG 1 + _ACEOF + + fi + + + # Check for a isfinite macro that works on long doubles. + + echo "$as_me:$LINENO: checking whether isfinite is broken" >&5 + echo $ECHO_N "checking whether isfinite is broken... $ECHO_C" >&6 + if test "${have_broken_isfinite+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + + libgfor_check_for_broken_isfinite_save_LIBS=$LIBS + LIBS="$LIBS -lm" + if test "$cross_compiling" = yes; then + + case "${target}" in + hppa*-*-hpux*) have_broken_isfinite=yes ;; + *) have_broken_isfinite=no ;; + esac + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + #ifdef HAVE_MATH_H + #include + #endif + #include + int main () + { + #ifdef isfinite + #ifdef LDBL_MAX + if (!isfinite(LDBL_MAX)) return 1; + #endif + #ifdef DBL_MAX + if (!isfinite(DBL_MAX)) return 1; + #endif + #endif + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + have_broken_isfinite=no + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + have_broken_isfinite=yes + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + LIBS=$libgfor_check_for_broken_isfinite_save_LIBS + fi + echo "$as_me:$LINENO: result: $have_broken_isfinite" >&5 + echo "${ECHO_T}$have_broken_isfinite" >&6 + if test x"$have_broken_isfinite" = xyes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_BROKEN_ISFINITE 1 + _ACEOF + + fi + + # Check for a isnan macro that works on long doubles. + + echo "$as_me:$LINENO: checking whether isnan is broken" >&5 + echo $ECHO_N "checking whether isnan is broken... $ECHO_C" >&6 + if test "${have_broken_isnan+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + + libgfor_check_for_broken_isnan_save_LIBS=$LIBS + LIBS="$LIBS -lm" + if test "$cross_compiling" = yes; then + + case "${target}" in + hppa*-*-hpux*) have_broken_isnan=yes ;; + *) have_broken_isnan=no ;; + esac + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + #ifdef HAVE_MATH_H + #include + #endif + #include + int main () + { + #ifdef isnan + #ifdef LDBL_MAX + { + long double x; + x = __builtin_nanl (""); + if (!isnan(x)) return 1; + if (isnan(LDBL_MAX)) return 1; + #ifdef NAN + x = (long double) NAN; + if (!isnan(x)) return 1; + #endif + } + #endif + #ifdef DBL_MAX + { + double y; + y = __builtin_nan (""); + if (!isnan(y)) return 1; + if (isnan(DBL_MAX)) return 1; + #ifdef NAN + y = (double) NAN; + if (!isnan(y)) return 1; + #endif + } + #endif + #endif + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + have_broken_isnan=no + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + have_broken_isnan=yes + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + LIBS=$libgfor_check_for_broken_isnan_save_LIBS + fi + echo "$as_me:$LINENO: result: $have_broken_isnan" >&5 + echo "${ECHO_T}$have_broken_isnan" >&6 + if test x"$have_broken_isnan" = xyes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_BROKEN_ISNAN 1 + _ACEOF + + fi + + # Check for a fpclassify macro that works on long doubles. + + echo "$as_me:$LINENO: checking whether fpclassify is broken" >&5 + echo $ECHO_N "checking whether fpclassify is broken... $ECHO_C" >&6 + if test "${have_broken_fpclassify+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + + libgfor_check_for_broken_fpclassify_save_LIBS=$LIBS + LIBS="$LIBS -lm" + if test "$cross_compiling" = yes; then + + case "${target}" in + hppa*-*-hpux*) have_broken_fpclassify=yes ;; + *) have_broken_fpclassify=no ;; + esac + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + #ifdef HAVE_MATH_H + #include + #endif + #include + int main () + { + #ifdef fpclassify + #ifdef LDBL_MAX + if (fpclassify(LDBL_MAX) == FP_NAN + || fpclassify(LDBL_MAX) == FP_INFINITE) return 1; + #endif + #ifdef DBL_MAX + if (fpclassify(DBL_MAX) == FP_NAN + || fpclassify(DBL_MAX) == FP_INFINITE) return 1; + #endif + #endif + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + have_broken_fpclassify=no + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + have_broken_fpclassify=yes + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + LIBS=$libgfor_check_for_broken_fpclassify_save_LIBS + fi + echo "$as_me:$LINENO: result: $have_broken_fpclassify" >&5 + echo "${ECHO_T}$have_broken_fpclassify" >&6 + if test x"$have_broken_fpclassify" = xyes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_BROKEN_FPCLASSIFY 1 + _ACEOF + + fi + + # Check whether the system has a working stat() + + echo "$as_me:$LINENO: checking whether the target stat is reliable" >&5 + echo $ECHO_N "checking whether the target stat is reliable... $ECHO_C" >&6 + if test "${have_working_stat+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + + if test "$cross_compiling" = yes; then + + case "${target}" in + *mingw*) have_working_stat=no ;; + *) have_working_stat=yes;; + esac + else + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + + #include + #include + #include + #include + + int main () + { + FILE *f, *g; + struct stat st1, st2; + + f = fopen ("foo", "w"); + g = fopen ("bar", "w"); + if (stat ("foo", &st1) != 0 || stat ("bar", &st2)) + return 1; + if (st1.st_dev == st2.st_dev && st1.st_ino == st2.st_ino) + return 1; + fclose(f); + fclose(g); + return 0; + } + _ACEOF + rm -f conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + have_working_stat=yes + else + echo "$as_me: program exited with status $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ( exit $ac_status ) + have_working_stat=no + fi + rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + fi + fi + echo "$as_me:$LINENO: result: $have_working_stat" >&5 + echo "${ECHO_T}$have_working_stat" >&6 + if test x"$have_working_stat" = xyes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_WORKING_STAT 1 + _ACEOF + + fi # Fallback in case isfinite is not available. echo "$as_me:$LINENO: checking for finite in -lm" >&5 *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 11168,11174 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 22452,22459 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 11202,11220 **** fi ! # Let the user override this ! # Check whether --enable-cmath or --disable-cmath was given. ! if test "${enable_cmath+set}" = set; then ! enableval="$enable_cmath" ! need_math=$enableval ! fi; ! if test "$need_math" = "yes"; then ! { echo "$as_me:$LINENO: Including complex math functions in libgfor" >&5 ! echo "$as_me: Including complex math functions in libgfor" >&6;}; ! extra_math_obj='$(gfor_cmath_obj)' fi ! MATH_OBJ="$extra_math_obj" # The standard autoconf HAVE_STRUCT_TIMEZONE doesn't actually check --- 22487,22864 ---- fi ! # Check for GNU libc feenableexcept ! echo "$as_me:$LINENO: checking for feenableexcept in -lm" >&5 ! echo $ECHO_N "checking for feenableexcept in -lm... $ECHO_C" >&6 ! if test "${ac_cv_lib_m_feenableexcept+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ac_check_lib_save_LIBS=$LIBS ! LIBS="-lm $LIBS" ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char feenableexcept (); ! int ! main () ! { ! feenableexcept (); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_lib_m_feenableexcept=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_lib_m_feenableexcept=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! LIBS=$ac_check_lib_save_LIBS ! fi ! echo "$as_me:$LINENO: result: $ac_cv_lib_m_feenableexcept" >&5 ! echo "${ECHO_T}$ac_cv_lib_m_feenableexcept" >&6 ! if test $ac_cv_lib_m_feenableexcept = yes; then ! have_feenableexcept=yes ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_FEENABLEEXCEPT 1 ! _ACEOF ! ! fi ! ! ! # Check for SysV fpsetmask ! ! echo "$as_me:$LINENO: checking whether fpsetmask is present" >&5 ! echo $ECHO_N "checking whether fpsetmask is present... $ECHO_C" >&6 ! if test "${have_fpsetmask+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! ! #if HAVE_FLOATINGPOINT_H ! # include ! #endif /* HAVE_FLOATINGPOINT_H */ ! #if HAVE_IEEEFP_H ! # include ! #endif /* HAVE_IEEEFP_H */ ! int ! main () ! { ! fpsetmask(0); ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! eval "have_fpsetmask=yes" ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! eval "have_fpsetmask=no" ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! ! fi ! echo "$as_me:$LINENO: result: $have_fpsetmask" >&5 ! echo "${ECHO_T}$have_fpsetmask" >&6 ! if test x"$have_fpsetmask" = xyes; then ! ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_FPSETMASK 1 ! _ACEOF ! ! fi ! ! ! # Check for AIX fp_trap and fp_enable ! echo "$as_me:$LINENO: checking for fp_trap" >&5 ! echo $ECHO_N "checking for fp_trap... $ECHO_C" >&6 ! if test "${ac_cv_func_fp_trap+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! /* Define fp_trap to an innocuous variant, in case declares fp_trap. ! For example, HP-UX 11i declares gettimeofday. */ ! #define fp_trap innocuous_fp_trap ! ! /* System header to define __stub macros and hopefully few prototypes, ! which can conflict with char fp_trap (); below. ! Prefer to if __STDC__ is defined, since ! exists even on freestanding compilers. */ ! ! #ifdef __STDC__ ! # include ! #else ! # include ! #endif ! ! #undef fp_trap ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! { ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char fp_trap (); ! /* The GNU C library defines this for functions which it implements ! to always fail with ENOSYS. Some functions are actually named ! something starting with __ and the normal name is an alias. */ ! #if defined (__stub_fp_trap) || defined (__stub___fp_trap) ! choke me ! #else ! char (*f) () = fp_trap; ! #endif ! #ifdef __cplusplus ! } ! #endif ! ! int ! main () ! { ! return f != fp_trap; ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_func_fp_trap=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_func_fp_trap=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! fi ! echo "$as_me:$LINENO: result: $ac_cv_func_fp_trap" >&5 ! echo "${ECHO_T}$ac_cv_func_fp_trap" >&6 ! if test $ac_cv_func_fp_trap = yes; then ! have_fp_trap=yes ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_FP_TRAP 1 ! _ACEOF ! ! fi ! ! echo "$as_me:$LINENO: checking for fp_enable" >&5 ! echo $ECHO_N "checking for fp_enable... $ECHO_C" >&6 ! if test "${ac_cv_func_fp_enable+set}" = set; then ! echo $ECHO_N "(cached) $ECHO_C" >&6 ! else ! if test x$gcc_no_link = xyes; then ! { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 ! echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} ! { (exit 1); exit 1; }; } ! fi ! cat >conftest.$ac_ext <<_ACEOF ! /* confdefs.h. */ ! _ACEOF ! cat confdefs.h >>conftest.$ac_ext ! cat >>conftest.$ac_ext <<_ACEOF ! /* end confdefs.h. */ ! /* Define fp_enable to an innocuous variant, in case declares fp_enable. ! For example, HP-UX 11i declares gettimeofday. */ ! #define fp_enable innocuous_fp_enable ! ! /* System header to define __stub macros and hopefully few prototypes, ! which can conflict with char fp_enable (); below. ! Prefer to if __STDC__ is defined, since ! exists even on freestanding compilers. */ ! ! #ifdef __STDC__ ! # include ! #else ! # include ! #endif ! ! #undef fp_enable ! ! /* Override any gcc2 internal prototype to avoid an error. */ ! #ifdef __cplusplus ! extern "C" ! { ! #endif ! /* We use char because int might match the return type of a gcc2 ! builtin and then its argument prototype would still apply. */ ! char fp_enable (); ! /* The GNU C library defines this for functions which it implements ! to always fail with ENOSYS. Some functions are actually named ! something starting with __ and the normal name is an alias. */ ! #if defined (__stub_fp_enable) || defined (__stub___fp_enable) ! choke me ! #else ! char (*f) () = fp_enable; ! #endif ! #ifdef __cplusplus ! } ! #endif ! ! int ! main () ! { ! return f != fp_enable; ! ; ! return 0; ! } ! _ACEOF ! rm -f conftest.$ac_objext conftest$ac_exeext ! if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ! (eval $ac_link) 2>conftest.er1 ! ac_status=$? ! grep -v '^ *+' conftest.er1 >conftest.err ! rm -f conftest.er1 ! cat conftest.err >&5 ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; } && ! { ac_try='test -s conftest$ac_exeext' ! { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 ! (eval $ac_try) 2>&5 ! ac_status=$? ! echo "$as_me:$LINENO: \$? = $ac_status" >&5 ! (exit $ac_status); }; }; then ! ac_cv_func_fp_enable=yes ! else ! echo "$as_me: failed program was:" >&5 ! sed 's/^/| /' conftest.$ac_ext >&5 ! ! ac_cv_func_fp_enable=no ! fi ! rm -f conftest.err conftest.$ac_objext \ ! conftest$ac_exeext conftest.$ac_ext ! fi ! echo "$as_me:$LINENO: result: $ac_cv_func_fp_enable" >&5 ! echo "${ECHO_T}$ac_cv_func_fp_enable" >&6 ! if test $ac_cv_func_fp_enable = yes; then ! have_fp_enable=yes ! cat >>confdefs.h <<\_ACEOF ! #define HAVE_FP_ENABLE 1 ! _ACEOF ! ! fi ! ! ! # Runs configure.host to set up necessary host-dependent shell variables. ! # We then display a message about it, and propagate them through the ! # build chain. ! . ${srcdir}/configure.host ! { echo "$as_me:$LINENO: FPU dependent file will be ${fpu_host}.h" >&5 ! echo "$as_me: FPU dependent file will be ${fpu_host}.h" >&6;} ! FPU_HOST_HEADER=config/${fpu_host}.h # The standard autoconf HAVE_STRUCT_TIMEZONE doesn't actually check *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 11253,11259 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 22897,22904 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 11359,11365 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 23004,23011 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 11421,11427 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 23067,23074 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 11559,11565 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 23206,23213 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 11637,11643 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 23285,23292 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 11705,11711 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 23354,23361 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_c *** 11769,11775 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 23419,23426 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** if { (eval echo "$as_me:$LINENO: \"$ac_l *** 11841,11847 **** cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? --- 23492,23499 ---- cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && ! { ac_try='test -z "$ac_c_werror_flag" ! || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? *************** _ACEOF *** 11873,11878 **** --- 23525,23699 ---- fi + # Check out sync builtins support. + + echo "$as_me:$LINENO: checking whether the target supports __sync_fetch_and_add" >&5 + echo $ECHO_N "checking whether the target supports __sync_fetch_and_add... $ECHO_C" >&6 + if test "${have_sync_fetch_and_add+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 + echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } + fi + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + int foovar = 0; + int + main () + { + + if (foovar <= 0) return __sync_fetch_and_add (&foovar, 1); + if (foovar > 10) return __sync_add_and_fetch (&foovar, -1); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + have_sync_fetch_and_add=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + have_sync_fetch_and_add=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $have_sync_fetch_and_add" >&5 + echo "${ECHO_T}$have_sync_fetch_and_add" >&6 + if test $have_sync_fetch_and_add = yes; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_SYNC_FETCH_AND_ADD 1 + _ACEOF + + fi + + # Check out thread support. + + echo "$as_me:$LINENO: checking configured target thread model" >&5 + echo $ECHO_N "checking configured target thread model... $ECHO_C" >&6 + if test "${target_thread_file+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + + target_thread_file=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'` + fi + echo "$as_me:$LINENO: result: $target_thread_file" >&5 + echo "${ECHO_T}$target_thread_file" >&6 + + if test $target_thread_file != single; then + + cat >>confdefs.h <<\_ACEOF + #define HAVE_GTHR_DEFAULT 1 + _ACEOF + + fi + + # Check out #pragma weak. + + echo "$as_me:$LINENO: checking whether pragma weak works" >&5 + echo $ECHO_N "checking whether pragma weak works... $ECHO_C" >&6 + if test "${have_pragma_weak+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + + gfor_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Wunknown-pragmas" + cat >conftest.$ac_ext <<_ACEOF + /* confdefs.h. */ + _ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF + /* end confdefs.h. */ + void foo (void); + #pragma weak foo + int + main () + { + if (foo) foo (); + ; + return 0; + } + _ACEOF + rm -f conftest.$ac_objext + if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + have_pragma_weak=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + have_pragma_weak=no + fi + rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi + echo "$as_me:$LINENO: result: $have_pragma_weak" >&5 + echo "${ECHO_T}$have_pragma_weak" >&6 + if test $have_pragma_weak = yes; then + + cat >>confdefs.h <<\_ACEOF + #define SUPPORTS_WEAK 1 + _ACEOF + + fi + case "$host" in + *-*-darwin* | *-*-hpux* | *-*-cygwin*) + + cat >>confdefs.h <<\_ACEOF + #define GTHREAD_USE_WEAK 0 + _ACEOF + + ;; + esac + # Various other checks on target echo "$as_me:$LINENO: checking whether the target can unlink an open file" >&5 *************** multi_basedir="$multi_basedir" *** 12648,12653 **** --- 24469,24492 ---- CONFIG_SHELL=${CONFIG_SHELL-/bin/sh} CC="$CC" + GCC="$GCC" + CC="$CC" + acx_cv_header_stdint="$acx_cv_header_stdint" + acx_cv_type_int8_t="$acx_cv_type_int8_t" + acx_cv_type_int16_t="$acx_cv_type_int16_t" + acx_cv_type_int32_t="$acx_cv_type_int32_t" + acx_cv_type_int64_t="$acx_cv_type_int64_t" + acx_cv_type_intptr_t="$acx_cv_type_intptr_t" + ac_cv_type_uintmax_t="$ac_cv_type_uintmax_t" + ac_cv_type_uintptr_t="$ac_cv_type_uintptr_t" + ac_cv_type_uint64_t="$ac_cv_type_uint64_t" + ac_cv_type_u_int64_t="$ac_cv_type_u_int64_t" + ac_cv_type_u_int32_t="$ac_cv_type_u_int32_t" + ac_cv_type_int_least32_t="$ac_cv_type_int_least32_t" + ac_cv_type_int_fast32_t="$ac_cv_type_int_fast32_t" + ac_cv_sizeof_void_p="$ac_cv_sizeof_void_p" + + _ACEOF *************** do *** 12659,12664 **** --- 24498,24504 ---- # Handling of arguments. "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "default-1" ) CONFIG_COMMANDS="$CONFIG_COMMANDS default-1" ;; + "gstdint.h" ) CONFIG_COMMANDS="$CONFIG_COMMANDS gstdint.h" ;; "config.h" ) CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} *************** s,@build@,$build,;t t *** 12749,12754 **** --- 24589,24597 ---- s,@build_cpu@,$build_cpu,;t t s,@build_vendor@,$build_vendor,;t t s,@build_os@,$build_os,;t t + s,@build_subdir@,$build_subdir,;t t + s,@host_subdir@,$host_subdir,;t t + s,@target_subdir@,$target_subdir,;t t s,@host@,$host,;t t s,@host_cpu@,$host_cpu,;t t s,@host_vendor@,$host_vendor,;t t *************** s,@MAINTAINER_MODE_TRUE@,$MAINTAINER_MOD *** 12783,12791 **** s,@MAINTAINER_MODE_FALSE@,$MAINTAINER_MODE_FALSE,;t t s,@MAINT@,$MAINT,;t t s,@multi_basedir@,$multi_basedir,;t t - s,@gcc_version_trigger@,$gcc_version_trigger,;t t - s,@gcc_version_full@,$gcc_version_full,;t t - s,@gcc_version@,$gcc_version,;t t s,@toolexecdir@,$toolexecdir,;t t s,@toolexeclibdir@,$toolexeclibdir,;t t s,@CC@,$CC,;t t --- 24626,24631 ---- *************** s,@extra_ldflags_libgfortran@,$extra_ldf *** 12812,12818 **** s,@CPP@,$CPP,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@EGREP@,$EGREP,;t t ! s,@MATH_OBJ@,$MATH_OBJ,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF --- 24652,24658 ---- s,@CPP@,$CPP,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@EGREP@,$EGREP,;t t ! s,@FPU_HOST_HEADER@,$FPU_HOST_HEADER,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF *************** esac *** 12981,12986 **** --- 24821,24831 ---- *) ac_INSTALL=$ac_top_builddir$INSTALL ;; esac + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 + echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ *************** echo "$as_me: error: cannot find input f *** 13019,13030 **** fi;; esac done` || { (exit 1); exit 1; } - - if test x"$ac_file" != x-; then - { echo "$as_me:$LINENO: creating $ac_file" >&5 - echo "$as_me: creating $ac_file" >&6;} - rm -f "$ac_file" - fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub --- 24864,24869 ---- *************** case " $CONFIG_FILES " in *** 13421,13426 **** --- 25260,25554 ---- ac_file=Makefile . ${multi_basedir}/config-ml.in ;; esac ;; + gstdint.h ) + if test "$GCC" = yes; then + echo "/* generated for " `$CC --version | sed 1q` "*/" > tmp-stdint.h + else + echo "/* generated for $CC */" > tmp-stdint.h + fi + + sed 's/^ *//' >> tmp-stdint.h < + EOF + + if test "$acx_cv_header_stdint" != stdint.h; then + echo "#include " >> tmp-stdint.h + fi + if test "$acx_cv_header_stdint" != stddef.h; then + echo "#include <$acx_cv_header_stdint>" >> tmp-stdint.h + fi + + sed 's/^ *//' >> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <= 199901L + #ifndef _INT64_T + #define _INT64_T + typedef long long int64_t; + #endif + #ifndef _UINT64_T + #define _UINT64_T + typedef unsigned long long uint64_t; + #endif + + #elif defined __GNUC__ && defined (__STDC__) && __STDC__-0 + /* NextStep 2.0 cc is really gcc 1.93 but it defines __GNUC__ = 2 and + does not implement __extension__. But that compiler doesn't define + __GNUC_MINOR__. */ + # if __GNUC__ < 2 || (__NeXT__ && !__GNUC_MINOR__) + # define __extension__ + # endif + + # ifndef _INT64_T + # define _INT64_T + __extension__ typedef long long int64_t; + # endif + # ifndef _UINT64_T + # define _UINT64_T + __extension__ typedef unsigned long long uint64_t; + # endif + + #elif !defined __STRICT_ANSI__ + # if defined _MSC_VER || defined __WATCOMC__ || defined __BORLANDC__ + + # ifndef _INT64_T + # define _INT64_T + typedef __int64 int64_t; + # endif + # ifndef _UINT64_T + # define _UINT64_T + typedef unsigned __int64 uint64_t; + # endif + # endif /* compiler */ + + #endif /* ANSI version */ + EOF + fi + + # ------------- done int64_t types, emit intptr types ------------ + if test "$ac_cv_type_uintptr_t" != yes; then + sed 's/^ *//' >> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h < + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_10) + #ifdef HAVE_CABSL + + elemental function specific__abs_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: specific__abs_c10 + + specific__abs_c10 = abs (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_c16.F90 gcc-4.1.0/libgfortran/generated/_abs_c16.F90 *** gcc-4.0.2/libgfortran/generated/_abs_c16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_c16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_16) + #ifdef HAVE_CABSL + + elemental function specific__abs_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: specific__abs_c16 + + specific__abs_c16 = abs (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_c4.F90 gcc-4.1.0/libgfortran/generated/_abs_c4.F90 *** gcc-4.0.2/libgfortran/generated/_abs_c4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_c4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_4) + #ifdef HAVE_CABSF + + elemental function specific__abs_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__abs_c4 + + specific__abs_c4 = abs (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_c4.f90 gcc-4.1.0/libgfortran/generated/_abs_c4.f90 *** gcc-4.0.2/libgfortran/generated/_abs_c4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_abs_c4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__abs_c4 (parm) - complex (kind=4), intent (in) :: parm - complex (kind=4) :: specific__abs_c4 - - specific__abs_c4 = abs (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_c8.F90 gcc-4.1.0/libgfortran/generated/_abs_c8.F90 *** gcc-4.0.2/libgfortran/generated/_abs_c8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_c8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_8) + #ifdef HAVE_CABS + + elemental function specific__abs_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__abs_c8 + + specific__abs_c8 = abs (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_c8.f90 gcc-4.1.0/libgfortran/generated/_abs_c8.f90 *** gcc-4.0.2/libgfortran/generated/_abs_c8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_abs_c8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__abs_c8 (parm) - complex (kind=8), intent (in) :: parm - complex (kind=8) :: specific__abs_c8 - - specific__abs_c8 = abs (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_i16.F90 gcc-4.1.0/libgfortran/generated/_abs_i16.F90 *** gcc-4.0.2/libgfortran/generated/_abs_i16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_i16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_16) + + + elemental function specific__abs_i16 (parm) + integer (kind=16), intent (in) :: parm + integer (kind=16) :: specific__abs_i16 + + specific__abs_i16 = abs (parm) + end function + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_i4.F90 gcc-4.1.0/libgfortran/generated/_abs_i4.F90 *** gcc-4.0.2/libgfortran/generated/_abs_i4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_i4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_4) + + + elemental function specific__abs_i4 (parm) + integer (kind=4), intent (in) :: parm + integer (kind=4) :: specific__abs_i4 + + specific__abs_i4 = abs (parm) + end function + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_i4.f90 gcc-4.1.0/libgfortran/generated/_abs_i4.f90 *** gcc-4.0.2/libgfortran/generated/_abs_i4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_abs_i4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__abs_i4 (parm) - integer (kind=4), intent (in) :: parm - integer (kind=4) :: specific__abs_i4 - - specific__abs_i4 = abs (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_i8.F90 gcc-4.1.0/libgfortran/generated/_abs_i8.F90 *** gcc-4.0.2/libgfortran/generated/_abs_i8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_i8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_8) + + + elemental function specific__abs_i8 (parm) + integer (kind=8), intent (in) :: parm + integer (kind=8) :: specific__abs_i8 + + specific__abs_i8 = abs (parm) + end function + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_i8.f90 gcc-4.1.0/libgfortran/generated/_abs_i8.f90 *** gcc-4.0.2/libgfortran/generated/_abs_i8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_abs_i8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__abs_i8 (parm) - integer (kind=8), intent (in) :: parm - integer (kind=8) :: specific__abs_i8 - - specific__abs_i8 = abs (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_r10.F90 gcc-4.1.0/libgfortran/generated/_abs_r10.F90 *** gcc-4.0.2/libgfortran/generated/_abs_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_FABSL + + elemental function specific__abs_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__abs_r10 + + specific__abs_r10 = abs (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_r16.F90 gcc-4.1.0/libgfortran/generated/_abs_r16.F90 *** gcc-4.0.2/libgfortran/generated/_abs_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_FABSL + + elemental function specific__abs_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__abs_r16 + + specific__abs_r16 = abs (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_r4.F90 gcc-4.1.0/libgfortran/generated/_abs_r4.F90 *** gcc-4.0.2/libgfortran/generated/_abs_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_FABSF + + elemental function specific__abs_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__abs_r4 + + specific__abs_r4 = abs (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_r4.f90 gcc-4.1.0/libgfortran/generated/_abs_r4.f90 *** gcc-4.0.2/libgfortran/generated/_abs_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_abs_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__abs_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__abs_r4 - - specific__abs_r4 = abs (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_r8.F90 gcc-4.1.0/libgfortran/generated/_abs_r8.F90 *** gcc-4.0.2/libgfortran/generated/_abs_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_abs_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_FABS + + elemental function specific__abs_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__abs_r8 + + specific__abs_r8 = abs (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_abs_r8.f90 gcc-4.1.0/libgfortran/generated/_abs_r8.f90 *** gcc-4.0.2/libgfortran/generated/_abs_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_abs_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__abs_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__abs_r8 - - specific__abs_r8 = abs (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_acos_r10.F90 gcc-4.1.0/libgfortran/generated/_acos_r10.F90 *** gcc-4.0.2/libgfortran/generated/_acos_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_acos_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_ACOSL + + elemental function specific__acos_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__acos_r10 + + specific__acos_r10 = acos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_acos_r16.F90 gcc-4.1.0/libgfortran/generated/_acos_r16.F90 *** gcc-4.0.2/libgfortran/generated/_acos_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_acos_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_ACOSL + + elemental function specific__acos_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__acos_r16 + + specific__acos_r16 = acos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_acos_r4.F90 gcc-4.1.0/libgfortran/generated/_acos_r4.F90 *** gcc-4.0.2/libgfortran/generated/_acos_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_acos_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_ACOSF + + elemental function specific__acos_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__acos_r4 + + specific__acos_r4 = acos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_acos_r4.f90 gcc-4.1.0/libgfortran/generated/_acos_r4.f90 *** gcc-4.0.2/libgfortran/generated/_acos_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_acos_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__acos_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__acos_r4 - - specific__acos_r4 = acos (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_acos_r8.F90 gcc-4.1.0/libgfortran/generated/_acos_r8.F90 *** gcc-4.0.2/libgfortran/generated/_acos_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_acos_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_ACOS + + elemental function specific__acos_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__acos_r8 + + specific__acos_r8 = acos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_acos_r8.f90 gcc-4.1.0/libgfortran/generated/_acos_r8.f90 *** gcc-4.0.2/libgfortran/generated/_acos_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_acos_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__acos_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__acos_r8 - - specific__acos_r8 = acos (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_aint_r10.F90 gcc-4.1.0/libgfortran/generated/_aint_r10.F90 *** gcc-4.0.2/libgfortran/generated/_aint_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_aint_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_TRUNCL + + elemental function specific__aint_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__aint_r10 + + specific__aint_r10 = aint (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_aint_r16.F90 gcc-4.1.0/libgfortran/generated/_aint_r16.F90 *** gcc-4.0.2/libgfortran/generated/_aint_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_aint_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_TRUNCL + + elemental function specific__aint_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__aint_r16 + + specific__aint_r16 = aint (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_aint_r4.F90 gcc-4.1.0/libgfortran/generated/_aint_r4.F90 *** gcc-4.0.2/libgfortran/generated/_aint_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_aint_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_TRUNCF + + elemental function specific__aint_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__aint_r4 + + specific__aint_r4 = aint (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_aint_r4.f90 gcc-4.1.0/libgfortran/generated/_aint_r4.f90 *** gcc-4.0.2/libgfortran/generated/_aint_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_aint_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__aint_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__aint_r4 - - specific__aint_r4 = aint (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_aint_r8.F90 gcc-4.1.0/libgfortran/generated/_aint_r8.F90 *** gcc-4.0.2/libgfortran/generated/_aint_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_aint_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_TRUNC + + elemental function specific__aint_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__aint_r8 + + specific__aint_r8 = aint (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_aint_r8.f90 gcc-4.1.0/libgfortran/generated/_aint_r8.f90 *** gcc-4.0.2/libgfortran/generated/_aint_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_aint_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__aint_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__aint_r8 - - specific__aint_r8 = aint (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_anint_r10.F90 gcc-4.1.0/libgfortran/generated/_anint_r10.F90 *** gcc-4.0.2/libgfortran/generated/_anint_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_anint_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_ROUNDL + + elemental function specific__anint_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__anint_r10 + + specific__anint_r10 = anint (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_anint_r16.F90 gcc-4.1.0/libgfortran/generated/_anint_r16.F90 *** gcc-4.0.2/libgfortran/generated/_anint_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_anint_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_ROUNDL + + elemental function specific__anint_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__anint_r16 + + specific__anint_r16 = anint (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_anint_r4.F90 gcc-4.1.0/libgfortran/generated/_anint_r4.F90 *** gcc-4.0.2/libgfortran/generated/_anint_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_anint_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_ROUNDF + + elemental function specific__anint_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__anint_r4 + + specific__anint_r4 = anint (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_anint_r4.f90 gcc-4.1.0/libgfortran/generated/_anint_r4.f90 *** gcc-4.0.2/libgfortran/generated/_anint_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_anint_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__anint_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__anint_r4 - - specific__anint_r4 = anint (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_anint_r8.F90 gcc-4.1.0/libgfortran/generated/_anint_r8.F90 *** gcc-4.0.2/libgfortran/generated/_anint_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_anint_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_ROUND + + elemental function specific__anint_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__anint_r8 + + specific__anint_r8 = anint (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_anint_r8.f90 gcc-4.1.0/libgfortran/generated/_anint_r8.f90 *** gcc-4.0.2/libgfortran/generated/_anint_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_anint_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__anint_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__anint_r8 - - specific__anint_r8 = anint (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_asin_r10.F90 gcc-4.1.0/libgfortran/generated/_asin_r10.F90 *** gcc-4.0.2/libgfortran/generated/_asin_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_asin_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_ASINL + + elemental function specific__asin_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__asin_r10 + + specific__asin_r10 = asin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_asin_r16.F90 gcc-4.1.0/libgfortran/generated/_asin_r16.F90 *** gcc-4.0.2/libgfortran/generated/_asin_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_asin_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_ASINL + + elemental function specific__asin_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__asin_r16 + + specific__asin_r16 = asin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_asin_r4.F90 gcc-4.1.0/libgfortran/generated/_asin_r4.F90 *** gcc-4.0.2/libgfortran/generated/_asin_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_asin_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_ASINF + + elemental function specific__asin_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__asin_r4 + + specific__asin_r4 = asin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_asin_r4.f90 gcc-4.1.0/libgfortran/generated/_asin_r4.f90 *** gcc-4.0.2/libgfortran/generated/_asin_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_asin_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__asin_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__asin_r4 - - specific__asin_r4 = asin (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_asin_r8.F90 gcc-4.1.0/libgfortran/generated/_asin_r8.F90 *** gcc-4.0.2/libgfortran/generated/_asin_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_asin_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_ASIN + + elemental function specific__asin_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__asin_r8 + + specific__asin_r8 = asin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_asin_r8.f90 gcc-4.1.0/libgfortran/generated/_asin_r8.f90 *** gcc-4.0.2/libgfortran/generated/_asin_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_asin_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__asin_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__asin_r8 - - specific__asin_r8 = asin (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan2_r10.F90 gcc-4.1.0/libgfortran/generated/_atan2_r10.F90 *** gcc-4.0.2/libgfortran/generated/_atan2_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_atan2_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + + #ifdef HAVE_ATAN2L + + elemental function specific__atan2_r10 (p1, p2) + real (kind=10), intent (in) :: p1, p2 + real (kind=10) :: specific__atan2_r10 + + specific__atan2_r10 = atan2 (p1, p2) + end function + + #endif + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan2_r16.F90 gcc-4.1.0/libgfortran/generated/_atan2_r16.F90 *** gcc-4.0.2/libgfortran/generated/_atan2_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_atan2_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + + #ifdef HAVE_ATAN2L + + elemental function specific__atan2_r16 (p1, p2) + real (kind=16), intent (in) :: p1, p2 + real (kind=16) :: specific__atan2_r16 + + specific__atan2_r16 = atan2 (p1, p2) + end function + + #endif + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan2_r4.F90 gcc-4.1.0/libgfortran/generated/_atan2_r4.F90 *** gcc-4.0.2/libgfortran/generated/_atan2_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_atan2_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + + #ifdef HAVE_ATAN2F + + elemental function specific__atan2_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: specific__atan2_r4 + + specific__atan2_r4 = atan2 (p1, p2) + end function + + #endif + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan2_r4.f90 gcc-4.1.0/libgfortran/generated/_atan2_r4.f90 *** gcc-4.0.2/libgfortran/generated/_atan2_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_atan2_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__atan2_r4 (p1, p2) - real (kind=4), intent (in) :: p1, p2 - real (kind=4) :: specific__atan2_r4 - - specific__atan2_r4 = atan2 (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan2_r8.F90 gcc-4.1.0/libgfortran/generated/_atan2_r8.F90 *** gcc-4.0.2/libgfortran/generated/_atan2_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_atan2_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + + #ifdef HAVE_ATAN2 + + elemental function specific__atan2_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: specific__atan2_r8 + + specific__atan2_r8 = atan2 (p1, p2) + end function + + #endif + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan2_r8.f90 gcc-4.1.0/libgfortran/generated/_atan2_r8.f90 *** gcc-4.0.2/libgfortran/generated/_atan2_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_atan2_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__atan2_r8 (p1, p2) - real (kind=8), intent (in) :: p1, p2 - real (kind=8) :: specific__atan2_r8 - - specific__atan2_r8 = atan2 (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan_r10.F90 gcc-4.1.0/libgfortran/generated/_atan_r10.F90 *** gcc-4.0.2/libgfortran/generated/_atan_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_atan_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_ATANL + + elemental function specific__atan_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__atan_r10 + + specific__atan_r10 = atan (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan_r16.F90 gcc-4.1.0/libgfortran/generated/_atan_r16.F90 *** gcc-4.0.2/libgfortran/generated/_atan_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_atan_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_ATANL + + elemental function specific__atan_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__atan_r16 + + specific__atan_r16 = atan (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan_r4.F90 gcc-4.1.0/libgfortran/generated/_atan_r4.F90 *** gcc-4.0.2/libgfortran/generated/_atan_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_atan_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_ATANF + + elemental function specific__atan_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__atan_r4 + + specific__atan_r4 = atan (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan_r4.f90 gcc-4.1.0/libgfortran/generated/_atan_r4.f90 *** gcc-4.0.2/libgfortran/generated/_atan_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_atan_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__atan_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__atan_r4 - - specific__atan_r4 = atan (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan_r8.F90 gcc-4.1.0/libgfortran/generated/_atan_r8.F90 *** gcc-4.0.2/libgfortran/generated/_atan_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_atan_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_ATAN + + elemental function specific__atan_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__atan_r8 + + specific__atan_r8 = atan (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_atan_r8.f90 gcc-4.1.0/libgfortran/generated/_atan_r8.f90 *** gcc-4.0.2/libgfortran/generated/_atan_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_atan_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__atan_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__atan_r8 - - specific__atan_r8 = atan (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_conjg_c10.F90 gcc-4.1.0/libgfortran/generated/_conjg_c10.F90 *** gcc-4.0.2/libgfortran/generated/_conjg_c10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_conjg_c10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_10) + + + elemental function specific__conjg_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: specific__conjg_c10 + + specific__conjg_c10 = conjg (parm) + end function + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_conjg_c16.F90 gcc-4.1.0/libgfortran/generated/_conjg_c16.F90 *** gcc-4.0.2/libgfortran/generated/_conjg_c16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_conjg_c16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_16) + + + elemental function specific__conjg_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: specific__conjg_c16 + + specific__conjg_c16 = conjg (parm) + end function + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_conjg_c4.F90 gcc-4.1.0/libgfortran/generated/_conjg_c4.F90 *** gcc-4.0.2/libgfortran/generated/_conjg_c4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_conjg_c4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_4) + + + elemental function specific__conjg_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__conjg_c4 + + specific__conjg_c4 = conjg (parm) + end function + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_conjg_c4.f90 gcc-4.1.0/libgfortran/generated/_conjg_c4.f90 *** gcc-4.0.2/libgfortran/generated/_conjg_c4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_conjg_c4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__conjg_c4 (parm) - complex (kind=4), intent (in) :: parm - complex (kind=4) :: specific__conjg_c4 - - specific__conjg_c4 = conjg (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_conjg_c8.F90 gcc-4.1.0/libgfortran/generated/_conjg_c8.F90 *** gcc-4.0.2/libgfortran/generated/_conjg_c8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_conjg_c8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_8) + + + elemental function specific__conjg_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__conjg_c8 + + specific__conjg_c8 = conjg (parm) + end function + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_conjg_c8.f90 gcc-4.1.0/libgfortran/generated/_conjg_c8.f90 *** gcc-4.0.2/libgfortran/generated/_conjg_c8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_conjg_c8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__conjg_c8 (parm) - complex (kind=8), intent (in) :: parm - complex (kind=8) :: specific__conjg_c8 - - specific__conjg_c8 = conjg (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_c10.F90 gcc-4.1.0/libgfortran/generated/_cos_c10.F90 *** gcc-4.0.2/libgfortran/generated/_cos_c10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cos_c10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_10) + #ifdef HAVE_CCOSL + + elemental function specific__cos_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: specific__cos_c10 + + specific__cos_c10 = cos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_c16.F90 gcc-4.1.0/libgfortran/generated/_cos_c16.F90 *** gcc-4.0.2/libgfortran/generated/_cos_c16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cos_c16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_16) + #ifdef HAVE_CCOSL + + elemental function specific__cos_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: specific__cos_c16 + + specific__cos_c16 = cos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_c4.F90 gcc-4.1.0/libgfortran/generated/_cos_c4.F90 *** gcc-4.0.2/libgfortran/generated/_cos_c4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cos_c4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_4) + #ifdef HAVE_CCOSF + + elemental function specific__cos_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__cos_c4 + + specific__cos_c4 = cos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_c4.f90 gcc-4.1.0/libgfortran/generated/_cos_c4.f90 *** gcc-4.0.2/libgfortran/generated/_cos_c4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_cos_c4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__cos_c4 (parm) - complex (kind=4), intent (in) :: parm - complex (kind=4) :: specific__cos_c4 - - specific__cos_c4 = cos (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_c8.F90 gcc-4.1.0/libgfortran/generated/_cos_c8.F90 *** gcc-4.0.2/libgfortran/generated/_cos_c8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cos_c8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_8) + #ifdef HAVE_CCOS + + elemental function specific__cos_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__cos_c8 + + specific__cos_c8 = cos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_c8.f90 gcc-4.1.0/libgfortran/generated/_cos_c8.f90 *** gcc-4.0.2/libgfortran/generated/_cos_c8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_cos_c8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__cos_c8 (parm) - complex (kind=8), intent (in) :: parm - complex (kind=8) :: specific__cos_c8 - - specific__cos_c8 = cos (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_r10.F90 gcc-4.1.0/libgfortran/generated/_cos_r10.F90 *** gcc-4.0.2/libgfortran/generated/_cos_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cos_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_COSL + + elemental function specific__cos_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__cos_r10 + + specific__cos_r10 = cos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_r16.F90 gcc-4.1.0/libgfortran/generated/_cos_r16.F90 *** gcc-4.0.2/libgfortran/generated/_cos_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cos_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_COSL + + elemental function specific__cos_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__cos_r16 + + specific__cos_r16 = cos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_r4.F90 gcc-4.1.0/libgfortran/generated/_cos_r4.F90 *** gcc-4.0.2/libgfortran/generated/_cos_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cos_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_COSF + + elemental function specific__cos_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__cos_r4 + + specific__cos_r4 = cos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_r4.f90 gcc-4.1.0/libgfortran/generated/_cos_r4.f90 *** gcc-4.0.2/libgfortran/generated/_cos_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_cos_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__cos_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__cos_r4 - - specific__cos_r4 = cos (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_r8.F90 gcc-4.1.0/libgfortran/generated/_cos_r8.F90 *** gcc-4.0.2/libgfortran/generated/_cos_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cos_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_COS + + elemental function specific__cos_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__cos_r8 + + specific__cos_r8 = cos (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cos_r8.f90 gcc-4.1.0/libgfortran/generated/_cos_r8.f90 *** gcc-4.0.2/libgfortran/generated/_cos_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_cos_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__cos_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__cos_r8 - - specific__cos_r8 = cos (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cosh_r10.F90 gcc-4.1.0/libgfortran/generated/_cosh_r10.F90 *** gcc-4.0.2/libgfortran/generated/_cosh_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cosh_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_COSHL + + elemental function specific__cosh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__cosh_r10 + + specific__cosh_r10 = cosh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cosh_r16.F90 gcc-4.1.0/libgfortran/generated/_cosh_r16.F90 *** gcc-4.0.2/libgfortran/generated/_cosh_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cosh_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_COSHL + + elemental function specific__cosh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__cosh_r16 + + specific__cosh_r16 = cosh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cosh_r4.F90 gcc-4.1.0/libgfortran/generated/_cosh_r4.F90 *** gcc-4.0.2/libgfortran/generated/_cosh_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cosh_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_COSHF + + elemental function specific__cosh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__cosh_r4 + + specific__cosh_r4 = cosh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cosh_r4.f90 gcc-4.1.0/libgfortran/generated/_cosh_r4.f90 *** gcc-4.0.2/libgfortran/generated/_cosh_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_cosh_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__cosh_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__cosh_r4 - - specific__cosh_r4 = cosh (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cosh_r8.F90 gcc-4.1.0/libgfortran/generated/_cosh_r8.F90 *** gcc-4.0.2/libgfortran/generated/_cosh_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_cosh_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_COSH + + elemental function specific__cosh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__cosh_r8 + + specific__cosh_r8 = cosh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_cosh_r8.f90 gcc-4.1.0/libgfortran/generated/_cosh_r8.f90 *** gcc-4.0.2/libgfortran/generated/_cosh_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_cosh_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__cosh_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__cosh_r8 - - specific__cosh_r8 = cosh (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_i16.F90 gcc-4.1.0/libgfortran/generated/_dim_i16.F90 *** gcc-4.0.2/libgfortran/generated/_dim_i16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_dim_i16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_16) + + + + elemental function specific__dim_i16 (p1, p2) + integer (kind=16), intent (in) :: p1, p2 + integer (kind=16) :: specific__dim_i16 + + specific__dim_i16 = dim (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_i4.F90 gcc-4.1.0/libgfortran/generated/_dim_i4.F90 *** gcc-4.0.2/libgfortran/generated/_dim_i4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_dim_i4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_4) + + + + elemental function specific__dim_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: specific__dim_i4 + + specific__dim_i4 = dim (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_i4.f90 gcc-4.1.0/libgfortran/generated/_dim_i4.f90 *** gcc-4.0.2/libgfortran/generated/_dim_i4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_dim_i4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__dim_i4 (p1, p2) - integer (kind=4), intent (in) :: p1, p2 - integer (kind=4) :: specific__dim_i4 - - specific__dim_i4 = dim (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_i8.F90 gcc-4.1.0/libgfortran/generated/_dim_i8.F90 *** gcc-4.0.2/libgfortran/generated/_dim_i8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_dim_i8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_8) + + + + elemental function specific__dim_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: specific__dim_i8 + + specific__dim_i8 = dim (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_i8.f90 gcc-4.1.0/libgfortran/generated/_dim_i8.f90 *** gcc-4.0.2/libgfortran/generated/_dim_i8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_dim_i8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__dim_i8 (p1, p2) - integer (kind=8), intent (in) :: p1, p2 - integer (kind=8) :: specific__dim_i8 - - specific__dim_i8 = dim (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_r10.F90 gcc-4.1.0/libgfortran/generated/_dim_r10.F90 *** gcc-4.0.2/libgfortran/generated/_dim_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_dim_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + + + + elemental function specific__dim_r10 (p1, p2) + real (kind=10), intent (in) :: p1, p2 + real (kind=10) :: specific__dim_r10 + + specific__dim_r10 = dim (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_r16.F90 gcc-4.1.0/libgfortran/generated/_dim_r16.F90 *** gcc-4.0.2/libgfortran/generated/_dim_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_dim_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + + + + elemental function specific__dim_r16 (p1, p2) + real (kind=16), intent (in) :: p1, p2 + real (kind=16) :: specific__dim_r16 + + specific__dim_r16 = dim (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_r4.F90 gcc-4.1.0/libgfortran/generated/_dim_r4.F90 *** gcc-4.0.2/libgfortran/generated/_dim_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_dim_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + + + + elemental function specific__dim_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: specific__dim_r4 + + specific__dim_r4 = dim (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_r4.f90 gcc-4.1.0/libgfortran/generated/_dim_r4.f90 *** gcc-4.0.2/libgfortran/generated/_dim_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_dim_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__dim_r4 (p1, p2) - real (kind=4), intent (in) :: p1, p2 - real (kind=4) :: specific__dim_r4 - - specific__dim_r4 = dim (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_r8.F90 gcc-4.1.0/libgfortran/generated/_dim_r8.F90 *** gcc-4.0.2/libgfortran/generated/_dim_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_dim_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + + + + elemental function specific__dim_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: specific__dim_r8 + + specific__dim_r8 = dim (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_dim_r8.f90 gcc-4.1.0/libgfortran/generated/_dim_r8.f90 *** gcc-4.0.2/libgfortran/generated/_dim_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_dim_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__dim_r8 (p1, p2) - real (kind=8), intent (in) :: p1, p2 - real (kind=8) :: specific__dim_r8 - - specific__dim_r8 = dim (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_c10.F90 gcc-4.1.0/libgfortran/generated/_exp_c10.F90 *** gcc-4.0.2/libgfortran/generated/_exp_c10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_exp_c10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_10) + #ifdef HAVE_CEXPL + + elemental function specific__exp_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: specific__exp_c10 + + specific__exp_c10 = exp (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_c16.F90 gcc-4.1.0/libgfortran/generated/_exp_c16.F90 *** gcc-4.0.2/libgfortran/generated/_exp_c16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_exp_c16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_16) + #ifdef HAVE_CEXPL + + elemental function specific__exp_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: specific__exp_c16 + + specific__exp_c16 = exp (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_c4.F90 gcc-4.1.0/libgfortran/generated/_exp_c4.F90 *** gcc-4.0.2/libgfortran/generated/_exp_c4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_exp_c4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_4) + #ifdef HAVE_CEXPF + + elemental function specific__exp_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__exp_c4 + + specific__exp_c4 = exp (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_c4.f90 gcc-4.1.0/libgfortran/generated/_exp_c4.f90 *** gcc-4.0.2/libgfortran/generated/_exp_c4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_exp_c4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__exp_c4 (parm) - complex (kind=4), intent (in) :: parm - complex (kind=4) :: specific__exp_c4 - - specific__exp_c4 = exp (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_c8.F90 gcc-4.1.0/libgfortran/generated/_exp_c8.F90 *** gcc-4.0.2/libgfortran/generated/_exp_c8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_exp_c8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_8) + #ifdef HAVE_CEXP + + elemental function specific__exp_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__exp_c8 + + specific__exp_c8 = exp (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_c8.f90 gcc-4.1.0/libgfortran/generated/_exp_c8.f90 *** gcc-4.0.2/libgfortran/generated/_exp_c8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_exp_c8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__exp_c8 (parm) - complex (kind=8), intent (in) :: parm - complex (kind=8) :: specific__exp_c8 - - specific__exp_c8 = exp (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_r10.F90 gcc-4.1.0/libgfortran/generated/_exp_r10.F90 *** gcc-4.0.2/libgfortran/generated/_exp_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_exp_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_EXPL + + elemental function specific__exp_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__exp_r10 + + specific__exp_r10 = exp (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_r16.F90 gcc-4.1.0/libgfortran/generated/_exp_r16.F90 *** gcc-4.0.2/libgfortran/generated/_exp_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_exp_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_EXPL + + elemental function specific__exp_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__exp_r16 + + specific__exp_r16 = exp (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_r4.F90 gcc-4.1.0/libgfortran/generated/_exp_r4.F90 *** gcc-4.0.2/libgfortran/generated/_exp_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_exp_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_EXPF + + elemental function specific__exp_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__exp_r4 + + specific__exp_r4 = exp (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_r4.f90 gcc-4.1.0/libgfortran/generated/_exp_r4.f90 *** gcc-4.0.2/libgfortran/generated/_exp_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_exp_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__exp_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__exp_r4 - - specific__exp_r4 = exp (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_r8.F90 gcc-4.1.0/libgfortran/generated/_exp_r8.F90 *** gcc-4.0.2/libgfortran/generated/_exp_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_exp_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_EXP + + elemental function specific__exp_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__exp_r8 + + specific__exp_r8 = exp (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_exp_r8.f90 gcc-4.1.0/libgfortran/generated/_exp_r8.f90 *** gcc-4.0.2/libgfortran/generated/_exp_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_exp_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__exp_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__exp_r8 - - specific__exp_r8 = exp (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log10_r10.F90 gcc-4.1.0/libgfortran/generated/_log10_r10.F90 *** gcc-4.0.2/libgfortran/generated/_log10_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log10_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_LOG10L + + elemental function specific__log10_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__log10_r10 + + specific__log10_r10 = log10 (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log10_r16.F90 gcc-4.1.0/libgfortran/generated/_log10_r16.F90 *** gcc-4.0.2/libgfortran/generated/_log10_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log10_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_LOG10L + + elemental function specific__log10_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__log10_r16 + + specific__log10_r16 = log10 (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log10_r4.F90 gcc-4.1.0/libgfortran/generated/_log10_r4.F90 *** gcc-4.0.2/libgfortran/generated/_log10_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log10_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_LOG10F + + elemental function specific__log10_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__log10_r4 + + specific__log10_r4 = log10 (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log10_r4.f90 gcc-4.1.0/libgfortran/generated/_log10_r4.f90 *** gcc-4.0.2/libgfortran/generated/_log10_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_log10_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__log10_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__log10_r4 - - specific__log10_r4 = log10 (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log10_r8.F90 gcc-4.1.0/libgfortran/generated/_log10_r8.F90 *** gcc-4.0.2/libgfortran/generated/_log10_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log10_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_LOG10 + + elemental function specific__log10_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__log10_r8 + + specific__log10_r8 = log10 (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log10_r8.f90 gcc-4.1.0/libgfortran/generated/_log10_r8.f90 *** gcc-4.0.2/libgfortran/generated/_log10_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_log10_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__log10_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__log10_r8 - - specific__log10_r8 = log10 (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_c10.F90 gcc-4.1.0/libgfortran/generated/_log_c10.F90 *** gcc-4.0.2/libgfortran/generated/_log_c10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log_c10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_10) + #ifdef HAVE_CLOGL + + elemental function specific__log_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: specific__log_c10 + + specific__log_c10 = log (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_c16.F90 gcc-4.1.0/libgfortran/generated/_log_c16.F90 *** gcc-4.0.2/libgfortran/generated/_log_c16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log_c16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_16) + #ifdef HAVE_CLOGL + + elemental function specific__log_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: specific__log_c16 + + specific__log_c16 = log (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_c4.F90 gcc-4.1.0/libgfortran/generated/_log_c4.F90 *** gcc-4.0.2/libgfortran/generated/_log_c4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log_c4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_4) + #ifdef HAVE_CLOGF + + elemental function specific__log_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__log_c4 + + specific__log_c4 = log (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_c4.f90 gcc-4.1.0/libgfortran/generated/_log_c4.f90 *** gcc-4.0.2/libgfortran/generated/_log_c4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_log_c4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__log_c4 (parm) - complex (kind=4), intent (in) :: parm - complex (kind=4) :: specific__log_c4 - - specific__log_c4 = log (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_c8.F90 gcc-4.1.0/libgfortran/generated/_log_c8.F90 *** gcc-4.0.2/libgfortran/generated/_log_c8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log_c8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_8) + #ifdef HAVE_CLOG + + elemental function specific__log_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__log_c8 + + specific__log_c8 = log (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_c8.f90 gcc-4.1.0/libgfortran/generated/_log_c8.f90 *** gcc-4.0.2/libgfortran/generated/_log_c8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_log_c8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__log_c8 (parm) - complex (kind=8), intent (in) :: parm - complex (kind=8) :: specific__log_c8 - - specific__log_c8 = log (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_r10.F90 gcc-4.1.0/libgfortran/generated/_log_r10.F90 *** gcc-4.0.2/libgfortran/generated/_log_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_LOGL + + elemental function specific__log_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__log_r10 + + specific__log_r10 = log (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_r16.F90 gcc-4.1.0/libgfortran/generated/_log_r16.F90 *** gcc-4.0.2/libgfortran/generated/_log_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_LOGL + + elemental function specific__log_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__log_r16 + + specific__log_r16 = log (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_r4.F90 gcc-4.1.0/libgfortran/generated/_log_r4.F90 *** gcc-4.0.2/libgfortran/generated/_log_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_LOGF + + elemental function specific__log_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__log_r4 + + specific__log_r4 = log (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_r4.f90 gcc-4.1.0/libgfortran/generated/_log_r4.f90 *** gcc-4.0.2/libgfortran/generated/_log_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_log_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__log_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__log_r4 - - specific__log_r4 = log (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_r8.F90 gcc-4.1.0/libgfortran/generated/_log_r8.F90 *** gcc-4.0.2/libgfortran/generated/_log_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_log_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_LOG + + elemental function specific__log_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__log_r8 + + specific__log_r8 = log (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_log_r8.f90 gcc-4.1.0/libgfortran/generated/_log_r8.f90 *** gcc-4.0.2/libgfortran/generated/_log_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_log_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__log_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__log_r8 - - specific__log_r8 = log (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_i16.F90 gcc-4.1.0/libgfortran/generated/_mod_i16.F90 *** gcc-4.0.2/libgfortran/generated/_mod_i16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_mod_i16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_16) + + + + elemental function specific__mod_i16 (p1, p2) + integer (kind=16), intent (in) :: p1, p2 + integer (kind=16) :: specific__mod_i16 + + specific__mod_i16 = mod (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_i4.F90 gcc-4.1.0/libgfortran/generated/_mod_i4.F90 *** gcc-4.0.2/libgfortran/generated/_mod_i4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_mod_i4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_4) + + + + elemental function specific__mod_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: specific__mod_i4 + + specific__mod_i4 = mod (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_i4.f90 gcc-4.1.0/libgfortran/generated/_mod_i4.f90 *** gcc-4.0.2/libgfortran/generated/_mod_i4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_mod_i4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__mod_i4 (p1, p2) - integer (kind=4), intent (in) :: p1, p2 - integer (kind=4) :: specific__mod_i4 - - specific__mod_i4 = mod (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_i8.F90 gcc-4.1.0/libgfortran/generated/_mod_i8.F90 *** gcc-4.0.2/libgfortran/generated/_mod_i8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_mod_i8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_8) + + + + elemental function specific__mod_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: specific__mod_i8 + + specific__mod_i8 = mod (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_i8.f90 gcc-4.1.0/libgfortran/generated/_mod_i8.f90 *** gcc-4.0.2/libgfortran/generated/_mod_i8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_mod_i8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__mod_i8 (p1, p2) - integer (kind=8), intent (in) :: p1, p2 - integer (kind=8) :: specific__mod_i8 - - specific__mod_i8 = mod (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_r4.F90 gcc-4.1.0/libgfortran/generated/_mod_r4.F90 *** gcc-4.0.2/libgfortran/generated/_mod_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_mod_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + + + + elemental function specific__mod_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: specific__mod_r4 + + specific__mod_r4 = mod (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_r4.f90 gcc-4.1.0/libgfortran/generated/_mod_r4.f90 *** gcc-4.0.2/libgfortran/generated/_mod_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_mod_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__mod_r4 (p1, p2) - real (kind=4), intent (in) :: p1, p2 - real (kind=4) :: specific__mod_r4 - - specific__mod_r4 = mod (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_r8.F90 gcc-4.1.0/libgfortran/generated/_mod_r8.F90 *** gcc-4.0.2/libgfortran/generated/_mod_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_mod_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + + + + elemental function specific__mod_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: specific__mod_r8 + + specific__mod_r8 = mod (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_mod_r8.f90 gcc-4.1.0/libgfortran/generated/_mod_r8.f90 *** gcc-4.0.2/libgfortran/generated/_mod_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_mod_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__mod_r8 (p1, p2) - real (kind=8), intent (in) :: p1, p2 - real (kind=8) :: specific__mod_r8 - - specific__mod_r8 = mod (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_i16.F90 gcc-4.1.0/libgfortran/generated/_sign_i16.F90 *** gcc-4.0.2/libgfortran/generated/_sign_i16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sign_i16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_16) + + + + elemental function specific__sign_i16 (p1, p2) + integer (kind=16), intent (in) :: p1, p2 + integer (kind=16) :: specific__sign_i16 + + specific__sign_i16 = sign (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_i4.F90 gcc-4.1.0/libgfortran/generated/_sign_i4.F90 *** gcc-4.0.2/libgfortran/generated/_sign_i4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sign_i4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_4) + + + + elemental function specific__sign_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: specific__sign_i4 + + specific__sign_i4 = sign (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_i4.f90 gcc-4.1.0/libgfortran/generated/_sign_i4.f90 *** gcc-4.0.2/libgfortran/generated/_sign_i4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sign_i4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sign_i4 (p1, p2) - integer (kind=4), intent (in) :: p1, p2 - integer (kind=4) :: specific__sign_i4 - - specific__sign_i4 = sign (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_i8.F90 gcc-4.1.0/libgfortran/generated/_sign_i8.F90 *** gcc-4.0.2/libgfortran/generated/_sign_i8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sign_i8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_INTEGER_8) + + + + elemental function specific__sign_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: specific__sign_i8 + + specific__sign_i8 = sign (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_i8.f90 gcc-4.1.0/libgfortran/generated/_sign_i8.f90 *** gcc-4.0.2/libgfortran/generated/_sign_i8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sign_i8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sign_i8 (p1, p2) - integer (kind=8), intent (in) :: p1, p2 - integer (kind=8) :: specific__sign_i8 - - specific__sign_i8 = sign (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_r10.F90 gcc-4.1.0/libgfortran/generated/_sign_r10.F90 *** gcc-4.0.2/libgfortran/generated/_sign_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sign_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + + + + elemental function specific__sign_r10 (p1, p2) + real (kind=10), intent (in) :: p1, p2 + real (kind=10) :: specific__sign_r10 + + specific__sign_r10 = sign (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_r16.F90 gcc-4.1.0/libgfortran/generated/_sign_r16.F90 *** gcc-4.0.2/libgfortran/generated/_sign_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sign_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + + + + elemental function specific__sign_r16 (p1, p2) + real (kind=16), intent (in) :: p1, p2 + real (kind=16) :: specific__sign_r16 + + specific__sign_r16 = sign (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_r4.F90 gcc-4.1.0/libgfortran/generated/_sign_r4.F90 *** gcc-4.0.2/libgfortran/generated/_sign_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sign_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + + + + elemental function specific__sign_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: specific__sign_r4 + + specific__sign_r4 = sign (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_r4.f90 gcc-4.1.0/libgfortran/generated/_sign_r4.f90 *** gcc-4.0.2/libgfortran/generated/_sign_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sign_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sign_r4 (p1, p2) - real (kind=4), intent (in) :: p1, p2 - real (kind=4) :: specific__sign_r4 - - specific__sign_r4 = sign (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_r8.F90 gcc-4.1.0/libgfortran/generated/_sign_r8.F90 *** gcc-4.0.2/libgfortran/generated/_sign_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sign_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + + + + elemental function specific__sign_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: specific__sign_r8 + + specific__sign_r8 = sign (p1, p2) + end function + + + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sign_r8.f90 gcc-4.1.0/libgfortran/generated/_sign_r8.f90 *** gcc-4.0.2/libgfortran/generated/_sign_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sign_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sign_r8 (p1, p2) - real (kind=8), intent (in) :: p1, p2 - real (kind=8) :: specific__sign_r8 - - specific__sign_r8 = sign (p1, p2) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_c10.F90 gcc-4.1.0/libgfortran/generated/_sin_c10.F90 *** gcc-4.0.2/libgfortran/generated/_sin_c10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sin_c10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_10) + #ifdef HAVE_CSINL + + elemental function specific__sin_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: specific__sin_c10 + + specific__sin_c10 = sin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_c16.F90 gcc-4.1.0/libgfortran/generated/_sin_c16.F90 *** gcc-4.0.2/libgfortran/generated/_sin_c16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sin_c16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_16) + #ifdef HAVE_CSINL + + elemental function specific__sin_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: specific__sin_c16 + + specific__sin_c16 = sin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_c4.F90 gcc-4.1.0/libgfortran/generated/_sin_c4.F90 *** gcc-4.0.2/libgfortran/generated/_sin_c4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sin_c4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_4) + #ifdef HAVE_CSINF + + elemental function specific__sin_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__sin_c4 + + specific__sin_c4 = sin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_c4.f90 gcc-4.1.0/libgfortran/generated/_sin_c4.f90 *** gcc-4.0.2/libgfortran/generated/_sin_c4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sin_c4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sin_c4 (parm) - complex (kind=4), intent (in) :: parm - complex (kind=4) :: specific__sin_c4 - - specific__sin_c4 = sin (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_c8.F90 gcc-4.1.0/libgfortran/generated/_sin_c8.F90 *** gcc-4.0.2/libgfortran/generated/_sin_c8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sin_c8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_8) + #ifdef HAVE_CSIN + + elemental function specific__sin_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__sin_c8 + + specific__sin_c8 = sin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_c8.f90 gcc-4.1.0/libgfortran/generated/_sin_c8.f90 *** gcc-4.0.2/libgfortran/generated/_sin_c8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sin_c8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sin_c8 (parm) - complex (kind=8), intent (in) :: parm - complex (kind=8) :: specific__sin_c8 - - specific__sin_c8 = sin (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_r10.F90 gcc-4.1.0/libgfortran/generated/_sin_r10.F90 *** gcc-4.0.2/libgfortran/generated/_sin_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sin_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_SINL + + elemental function specific__sin_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__sin_r10 + + specific__sin_r10 = sin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_r16.F90 gcc-4.1.0/libgfortran/generated/_sin_r16.F90 *** gcc-4.0.2/libgfortran/generated/_sin_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sin_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_SINL + + elemental function specific__sin_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__sin_r16 + + specific__sin_r16 = sin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_r4.F90 gcc-4.1.0/libgfortran/generated/_sin_r4.F90 *** gcc-4.0.2/libgfortran/generated/_sin_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sin_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_SINF + + elemental function specific__sin_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__sin_r4 + + specific__sin_r4 = sin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_r4.f90 gcc-4.1.0/libgfortran/generated/_sin_r4.f90 *** gcc-4.0.2/libgfortran/generated/_sin_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sin_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sin_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__sin_r4 - - specific__sin_r4 = sin (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_r8.F90 gcc-4.1.0/libgfortran/generated/_sin_r8.F90 *** gcc-4.0.2/libgfortran/generated/_sin_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sin_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_SIN + + elemental function specific__sin_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__sin_r8 + + specific__sin_r8 = sin (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sin_r8.f90 gcc-4.1.0/libgfortran/generated/_sin_r8.f90 *** gcc-4.0.2/libgfortran/generated/_sin_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sin_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sin_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__sin_r8 - - specific__sin_r8 = sin (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sinh_r10.F90 gcc-4.1.0/libgfortran/generated/_sinh_r10.F90 *** gcc-4.0.2/libgfortran/generated/_sinh_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sinh_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_SINHL + + elemental function specific__sinh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__sinh_r10 + + specific__sinh_r10 = sinh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sinh_r16.F90 gcc-4.1.0/libgfortran/generated/_sinh_r16.F90 *** gcc-4.0.2/libgfortran/generated/_sinh_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sinh_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_SINHL + + elemental function specific__sinh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__sinh_r16 + + specific__sinh_r16 = sinh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sinh_r4.F90 gcc-4.1.0/libgfortran/generated/_sinh_r4.F90 *** gcc-4.0.2/libgfortran/generated/_sinh_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sinh_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_SINHF + + elemental function specific__sinh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__sinh_r4 + + specific__sinh_r4 = sinh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sinh_r4.f90 gcc-4.1.0/libgfortran/generated/_sinh_r4.f90 *** gcc-4.0.2/libgfortran/generated/_sinh_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sinh_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sinh_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__sinh_r4 - - specific__sinh_r4 = sinh (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sinh_r8.F90 gcc-4.1.0/libgfortran/generated/_sinh_r8.F90 *** gcc-4.0.2/libgfortran/generated/_sinh_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sinh_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_SINH + + elemental function specific__sinh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__sinh_r8 + + specific__sinh_r8 = sinh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sinh_r8.f90 gcc-4.1.0/libgfortran/generated/_sinh_r8.f90 *** gcc-4.0.2/libgfortran/generated/_sinh_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sinh_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sinh_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__sinh_r8 - - specific__sinh_r8 = sinh (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_c10.F90 gcc-4.1.0/libgfortran/generated/_sqrt_c10.F90 *** gcc-4.0.2/libgfortran/generated/_sqrt_c10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sqrt_c10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_10) + #ifdef HAVE_CSQRTL + + elemental function specific__sqrt_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: specific__sqrt_c10 + + specific__sqrt_c10 = sqrt (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_c16.F90 gcc-4.1.0/libgfortran/generated/_sqrt_c16.F90 *** gcc-4.0.2/libgfortran/generated/_sqrt_c16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sqrt_c16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_16) + #ifdef HAVE_CSQRTL + + elemental function specific__sqrt_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: specific__sqrt_c16 + + specific__sqrt_c16 = sqrt (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_c4.F90 gcc-4.1.0/libgfortran/generated/_sqrt_c4.F90 *** gcc-4.0.2/libgfortran/generated/_sqrt_c4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sqrt_c4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_4) + #ifdef HAVE_CSQRTF + + elemental function specific__sqrt_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__sqrt_c4 + + specific__sqrt_c4 = sqrt (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_c4.f90 gcc-4.1.0/libgfortran/generated/_sqrt_c4.f90 *** gcc-4.0.2/libgfortran/generated/_sqrt_c4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sqrt_c4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sqrt_c4 (parm) - complex (kind=4), intent (in) :: parm - complex (kind=4) :: specific__sqrt_c4 - - specific__sqrt_c4 = sqrt (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_c8.F90 gcc-4.1.0/libgfortran/generated/_sqrt_c8.F90 *** gcc-4.0.2/libgfortran/generated/_sqrt_c8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sqrt_c8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_COMPLEX_8) + #ifdef HAVE_CSQRT + + elemental function specific__sqrt_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__sqrt_c8 + + specific__sqrt_c8 = sqrt (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_c8.f90 gcc-4.1.0/libgfortran/generated/_sqrt_c8.f90 *** gcc-4.0.2/libgfortran/generated/_sqrt_c8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sqrt_c8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sqrt_c8 (parm) - complex (kind=8), intent (in) :: parm - complex (kind=8) :: specific__sqrt_c8 - - specific__sqrt_c8 = sqrt (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_r10.F90 gcc-4.1.0/libgfortran/generated/_sqrt_r10.F90 *** gcc-4.0.2/libgfortran/generated/_sqrt_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sqrt_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_SQRTL + + elemental function specific__sqrt_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__sqrt_r10 + + specific__sqrt_r10 = sqrt (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_r16.F90 gcc-4.1.0/libgfortran/generated/_sqrt_r16.F90 *** gcc-4.0.2/libgfortran/generated/_sqrt_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sqrt_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_SQRTL + + elemental function specific__sqrt_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__sqrt_r16 + + specific__sqrt_r16 = sqrt (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_r4.F90 gcc-4.1.0/libgfortran/generated/_sqrt_r4.F90 *** gcc-4.0.2/libgfortran/generated/_sqrt_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sqrt_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_SQRTF + + elemental function specific__sqrt_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__sqrt_r4 + + specific__sqrt_r4 = sqrt (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_r4.f90 gcc-4.1.0/libgfortran/generated/_sqrt_r4.f90 *** gcc-4.0.2/libgfortran/generated/_sqrt_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sqrt_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sqrt_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__sqrt_r4 - - specific__sqrt_r4 = sqrt (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_r8.F90 gcc-4.1.0/libgfortran/generated/_sqrt_r8.F90 *** gcc-4.0.2/libgfortran/generated/_sqrt_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_sqrt_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_SQRT + + elemental function specific__sqrt_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__sqrt_r8 + + specific__sqrt_r8 = sqrt (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_sqrt_r8.f90 gcc-4.1.0/libgfortran/generated/_sqrt_r8.f90 *** gcc-4.0.2/libgfortran/generated/_sqrt_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_sqrt_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__sqrt_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__sqrt_r8 - - specific__sqrt_r8 = sqrt (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tan_r10.F90 gcc-4.1.0/libgfortran/generated/_tan_r10.F90 *** gcc-4.0.2/libgfortran/generated/_tan_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_tan_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_TANL + + elemental function specific__tan_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__tan_r10 + + specific__tan_r10 = tan (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tan_r16.F90 gcc-4.1.0/libgfortran/generated/_tan_r16.F90 *** gcc-4.0.2/libgfortran/generated/_tan_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_tan_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_TANL + + elemental function specific__tan_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__tan_r16 + + specific__tan_r16 = tan (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tan_r4.F90 gcc-4.1.0/libgfortran/generated/_tan_r4.F90 *** gcc-4.0.2/libgfortran/generated/_tan_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_tan_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_TANF + + elemental function specific__tan_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__tan_r4 + + specific__tan_r4 = tan (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tan_r4.f90 gcc-4.1.0/libgfortran/generated/_tan_r4.f90 *** gcc-4.0.2/libgfortran/generated/_tan_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_tan_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__tan_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__tan_r4 - - specific__tan_r4 = tan (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tan_r8.F90 gcc-4.1.0/libgfortran/generated/_tan_r8.F90 *** gcc-4.0.2/libgfortran/generated/_tan_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_tan_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_TAN + + elemental function specific__tan_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__tan_r8 + + specific__tan_r8 = tan (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tan_r8.f90 gcc-4.1.0/libgfortran/generated/_tan_r8.f90 *** gcc-4.0.2/libgfortran/generated/_tan_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_tan_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__tan_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__tan_r8 - - specific__tan_r8 = tan (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tanh_r10.F90 gcc-4.1.0/libgfortran/generated/_tanh_r10.F90 *** gcc-4.0.2/libgfortran/generated/_tanh_r10.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_tanh_r10.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_10) + #ifdef HAVE_TANHL + + elemental function specific__tanh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: specific__tanh_r10 + + specific__tanh_r10 = tanh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tanh_r16.F90 gcc-4.1.0/libgfortran/generated/_tanh_r16.F90 *** gcc-4.0.2/libgfortran/generated/_tanh_r16.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_tanh_r16.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_16) + #ifdef HAVE_TANHL + + elemental function specific__tanh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: specific__tanh_r16 + + specific__tanh_r16 = tanh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tanh_r4.F90 gcc-4.1.0/libgfortran/generated/_tanh_r4.F90 *** gcc-4.0.2/libgfortran/generated/_tanh_r4.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_tanh_r4.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_4) + #ifdef HAVE_TANHF + + elemental function specific__tanh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__tanh_r4 + + specific__tanh_r4 = tanh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tanh_r4.f90 gcc-4.1.0/libgfortran/generated/_tanh_r4.f90 *** gcc-4.0.2/libgfortran/generated/_tanh_r4.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_tanh_r4.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__tanh_r4 (parm) - real (kind=4), intent (in) :: parm - real (kind=4) :: specific__tanh_r4 - - specific__tanh_r4 = tanh (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tanh_r8.F90 gcc-4.1.0/libgfortran/generated/_tanh_r8.F90 *** gcc-4.0.2/libgfortran/generated/_tanh_r8.F90 Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/_tanh_r8.F90 Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,51 ---- + ! Copyright 2002 Free Software Foundation, Inc. + ! Contributed by Paul Brook + ! + !This file is part of the GNU Fortran 95 runtime library (libgfortran). + ! + !GNU 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.) + ! + !GNU 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. + ! + !This file is machine generated. + + + + + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + #if defined (HAVE_GFC_REAL_8) + #ifdef HAVE_TANH + + elemental function specific__tanh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__tanh_r8 + + specific__tanh_r8 = tanh (parm) + end function + + #endif + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/_tanh_r8.f90 gcc-4.1.0/libgfortran/generated/_tanh_r8.f90 *** gcc-4.0.2/libgfortran/generated/_tanh_r8.f90 Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/_tanh_r8.f90 Thu Jan 1 00:00:00 1970 *************** *** 1,38 **** - ! Copyright 2002 Free Software Foundation, Inc. - ! Contributed by Paul Brook - ! - !This file is part of the GNU Fortran 95 runtime library (libgfortran). - ! - !GNU 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.) - ! - !GNU 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., 59 Temple Place - Suite 330, - !Boston, MA 02111-1307, USA. - ! - !This file is machine generated. - - - elemental function specific__tanh_r8 (parm) - real (kind=8), intent (in) :: parm - real (kind=8) :: specific__tanh_r8 - - specific__tanh_r8 = tanh (parm) - end function --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/all_l16.c gcc-4.1.0/libgfortran/generated/all_l16.c *** gcc-4.0.2/libgfortran/generated/all_l16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/all_l16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,177 ---- + /* Implementation of the ALL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16) + + + extern void all_l16 (gfc_array_l16 *, gfc_array_l16 *, index_type *); + export_proto(all_l16); + + void + all_l16 (gfc_array_l16 *retarray, gfc_array_l16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_LOGICAL_16 *base; + GFC_LOGICAL_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_LOGICAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_16 *src; + GFC_LOGICAL_16 result; + src = base; + { + + /* Return true only if all the elements are set. */ + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (! *src) + { + result = 0; + break; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/all_l4.c gcc-4.1.0/libgfortran/generated/all_l4.c *** gcc-4.0.2/libgfortran/generated/all_l4.c Mon May 23 20:03:51 2005 --- gcc-4.1.0/libgfortran/generated/all_l4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4) + + extern void all_l4 (gfc_array_l4 *, gfc_array_l4 *, index_type *); export_proto(all_l4); *************** all_l4 (gfc_array_l4 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_LOGICAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_LOGICAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** all_l4 (gfc_array_l4 *retarray, gfc_arra *** 171,173 **** --- 174,177 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/all_l8.c gcc-4.1.0/libgfortran/generated/all_l8.c *** gcc-4.0.2/libgfortran/generated/all_l8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/all_l8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8) + + extern void all_l8 (gfc_array_l8 *, gfc_array_l8 *, index_type *); export_proto(all_l8); *************** all_l8 (gfc_array_l8 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_LOGICAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_LOGICAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** all_l8 (gfc_array_l8 *retarray, gfc_arra *** 171,173 **** --- 174,177 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/any_l16.c gcc-4.1.0/libgfortran/generated/any_l16.c *** gcc-4.0.2/libgfortran/generated/any_l16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/any_l16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,177 ---- + /* Implementation of the ANY intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16) + + + extern void any_l16 (gfc_array_l16 *, gfc_array_l16 *, index_type *); + export_proto(any_l16); + + void + any_l16 (gfc_array_l16 *retarray, gfc_array_l16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_LOGICAL_16 *base; + GFC_LOGICAL_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_LOGICAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_16 *src; + GFC_LOGICAL_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + /* Return true if any of the elements are set. */ + if (*src) + { + result = 1; + break; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/any_l4.c gcc-4.1.0/libgfortran/generated/any_l4.c *** gcc-4.0.2/libgfortran/generated/any_l4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/any_l4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4) + + extern void any_l4 (gfc_array_l4 *, gfc_array_l4 *, index_type *); export_proto(any_l4); *************** any_l4 (gfc_array_l4 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_LOGICAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_LOGICAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** any_l4 (gfc_array_l4 *retarray, gfc_arra *** 171,173 **** --- 174,177 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/any_l8.c gcc-4.1.0/libgfortran/generated/any_l8.c *** gcc-4.0.2/libgfortran/generated/any_l8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/any_l8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8) + + extern void any_l8 (gfc_array_l8 *, gfc_array_l8 *, index_type *); export_proto(any_l8); *************** any_l8 (gfc_array_l8 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_LOGICAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_LOGICAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** any_l8 (gfc_array_l8 *retarray, gfc_arra *** 171,173 **** --- 174,177 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_16_l16.c gcc-4.1.0/libgfortran/generated/count_16_l16.c *** gcc-4.0.2/libgfortran/generated/count_16_l16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/count_16_l16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,173 ---- + /* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void count_16_l16 (gfc_array_i16 *, gfc_array_l16 *, index_type *); + export_proto(count_16_l16); + + void + count_16_l16 (gfc_array_i16 *retarray, gfc_array_l16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_LOGICAL_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_16_l4.c gcc-4.1.0/libgfortran/generated/count_16_l4.c *** gcc-4.0.2/libgfortran/generated/count_16_l4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/count_16_l4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,173 ---- + /* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void count_16_l4 (gfc_array_i16 *, gfc_array_l4 *, index_type *); + export_proto(count_16_l4); + + void + count_16_l4 (gfc_array_i16 *retarray, gfc_array_l4 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_LOGICAL_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_4 *src; + GFC_INTEGER_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_16_l8.c gcc-4.1.0/libgfortran/generated/count_16_l8.c *** gcc-4.0.2/libgfortran/generated/count_16_l8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/count_16_l8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,173 ---- + /* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void count_16_l8 (gfc_array_i16 *, gfc_array_l8 *, index_type *); + export_proto(count_16_l8); + + void + count_16_l8 (gfc_array_i16 *retarray, gfc_array_l8 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_LOGICAL_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_8 *src; + GFC_INTEGER_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_4_l16.c gcc-4.1.0/libgfortran/generated/count_4_l16.c *** gcc-4.0.2/libgfortran/generated/count_4_l16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/count_4_l16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,173 ---- + /* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void count_4_l16 (gfc_array_i4 *, gfc_array_l16 *, index_type *); + export_proto(count_4_l16); + + void + count_4_l16 (gfc_array_i4 *retarray, gfc_array_l16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_LOGICAL_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_16 *src; + GFC_INTEGER_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_4_l4.c gcc-4.1.0/libgfortran/generated/count_4_l4.c *** gcc-4.0.2/libgfortran/generated/count_4_l4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/count_4_l4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_4) + + extern void count_4_l4 (gfc_array_i4 *, gfc_array_l4 *, index_type *); export_proto(count_4_l4); *************** count_4_l4 (gfc_array_i4 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** count_4_l4 (gfc_array_i4 *retarray, gfc_ *** 167,169 **** --- 170,173 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_4_l8.c gcc-4.1.0/libgfortran/generated/count_4_l8.c *** gcc-4.0.2/libgfortran/generated/count_4_l8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/count_4_l8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_4) + + extern void count_4_l8 (gfc_array_i4 *, gfc_array_l8 *, index_type *); export_proto(count_4_l8); *************** count_4_l8 (gfc_array_i4 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** count_4_l8 (gfc_array_i4 *retarray, gfc_ *** 167,169 **** --- 170,173 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_8_l16.c gcc-4.1.0/libgfortran/generated/count_8_l16.c *** gcc-4.0.2/libgfortran/generated/count_8_l16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/count_8_l16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,173 ---- + /* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void count_8_l16 (gfc_array_i8 *, gfc_array_l16 *, index_type *); + export_proto(count_8_l16); + + void + count_8_l16 (gfc_array_i8 *retarray, gfc_array_l16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_LOGICAL_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_16 *src; + GFC_INTEGER_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_8_l4.c gcc-4.1.0/libgfortran/generated/count_8_l4.c *** gcc-4.0.2/libgfortran/generated/count_8_l4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/count_8_l4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_8) + + extern void count_8_l4 (gfc_array_i8 *, gfc_array_l4 *, index_type *); export_proto(count_8_l4); *************** count_8_l4 (gfc_array_i8 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** count_8_l4 (gfc_array_i8 *retarray, gfc_ *** 167,169 **** --- 170,173 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/count_8_l8.c gcc-4.1.0/libgfortran/generated/count_8_l8.c *** gcc-4.0.2/libgfortran/generated/count_8_l8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/count_8_l8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_8) + + extern void count_8_l8 (gfc_array_i8 *, gfc_array_l8 *, index_type *); export_proto(count_8_l8); *************** count_8_l8 (gfc_array_i8 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** count_8_l8 (gfc_array_i8 *retarray, gfc_ *** 167,169 **** --- 170,173 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/cshift1_16.c gcc-4.1.0/libgfortran/generated/cshift1_16.c *** gcc-4.0.2/libgfortran/generated/cshift1_16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/cshift1_16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,225 ---- + /* Implementation of the CSHIFT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Feng Wang + + 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.) + + Ligbfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + static void + cshift1 (gfc_array_char * ret, const gfc_array_char * array, + const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich, index_type size) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the array. */ + index_type hstride[GFC_MAX_DIMENSIONS]; + index_type hstride0; + const GFC_INTEGER_16 *hptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + int which; + GFC_INTEGER_16 sh; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) + runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); + + if (ret->data == NULL) + { + int i; + + ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + ret->dim[i].lbound = 0; + ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound; + + if (i == 0) + ret->dim[i].stride = 1; + else + ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + } + } + + extent[0] = 1; + count[0] = 0; + n = 0; + + /* Initialized for avoiding compiler warnings. */ + roffset = size; + soffset = size; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + + while (rptr) + { + /* Do the for this dimension. */ + sh = *hptr; + sh = (div (sh, len)).rem; + if (sh < 0) + sh += len; + + src = &sptr[sh * soffset]; + dest = rptr; + + for (n = 0; n < len; n++) + { + memcpy (dest, src, size); + dest += roffset; + if (n == len - sh - 1) + src = sptr; + else + src += soffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + } + } + } + } + + void cshift1_16 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i16 *, const GFC_INTEGER_16 *); + export_proto(cshift1_16); + + void + cshift1_16 (gfc_array_char * ret, + const gfc_array_char * array, + const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich) + { + cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); + } + + void cshift1_16_char (gfc_array_char * ret, GFC_INTEGER_4, + const gfc_array_char * array, + const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich, + GFC_INTEGER_4); + export_proto(cshift1_16_char); + + void + cshift1_16_char (gfc_array_char * ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * array, + const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich, + GFC_INTEGER_4 array_length) + { + cshift1 (ret, array, h, pwhich, array_length); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/cshift1_4.c gcc-4.1.0/libgfortran/generated/cshift1_4.c *** gcc-4.0.2/libgfortran/generated/cshift1_4.c Thu Jul 14 21:17:21 2005 --- gcc-4.1.0/libgfortran/generated/cshift1_4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,48 **** #include #include "libgfortran.h" ! void cshift1_4 (gfc_array_char * ret, ! const gfc_array_char * array, ! const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich); ! export_proto(cshift1_4); ! void ! cshift1_4 (gfc_array_char * ret, ! const gfc_array_char * array, ! const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,44 ---- #include #include "libgfortran.h" ! #if defined (HAVE_GFC_INTEGER_4) ! static void ! cshift1 (gfc_array_char * ret, const gfc_array_char * array, ! const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich, index_type size) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** cshift1_4 (gfc_array_char * ret, *** 64,70 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; --- 60,65 ---- *************** cshift1_4 (gfc_array_char * ret, *** 78,91 **** if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); - size = GFC_DESCRIPTOR_SIZE (ret); - if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 73,84 ---- if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** cshift1_4 (gfc_array_char * ret, *** 101,107 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; /* Initialized for avoiding compiler warnings. */ --- 94,99 ---- *************** cshift1_4 (gfc_array_char * ret, *** 201,203 **** --- 193,225 ---- } } } + + void cshift1_4 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i4 *, const GFC_INTEGER_4 *); + export_proto(cshift1_4); + + void + cshift1_4 (gfc_array_char * ret, + const gfc_array_char * array, + const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich) + { + cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); + } + + void cshift1_4_char (gfc_array_char * ret, GFC_INTEGER_4, + const gfc_array_char * array, + const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich, + GFC_INTEGER_4); + export_proto(cshift1_4_char); + + void + cshift1_4_char (gfc_array_char * ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * array, + const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich, + GFC_INTEGER_4 array_length) + { + cshift1 (ret, array, h, pwhich, array_length); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/cshift1_8.c gcc-4.1.0/libgfortran/generated/cshift1_8.c *** gcc-4.0.2/libgfortran/generated/cshift1_8.c Thu Jul 14 21:17:21 2005 --- gcc-4.1.0/libgfortran/generated/cshift1_8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,48 **** #include #include "libgfortran.h" ! void cshift1_8 (gfc_array_char * ret, ! const gfc_array_char * array, ! const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich); ! export_proto(cshift1_8); ! void ! cshift1_8 (gfc_array_char * ret, ! const gfc_array_char * array, ! const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,44 ---- #include #include "libgfortran.h" ! #if defined (HAVE_GFC_INTEGER_8) ! static void ! cshift1 (gfc_array_char * ret, const gfc_array_char * array, ! const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich, index_type size) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** cshift1_8 (gfc_array_char * ret, *** 64,70 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; --- 60,65 ---- *************** cshift1_8 (gfc_array_char * ret, *** 78,91 **** if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); - size = GFC_DESCRIPTOR_SIZE (ret); - if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 73,84 ---- if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** cshift1_8 (gfc_array_char * ret, *** 101,107 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; /* Initialized for avoiding compiler warnings. */ --- 94,99 ---- *************** cshift1_8 (gfc_array_char * ret, *** 201,203 **** --- 193,225 ---- } } } + + void cshift1_8 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i8 *, const GFC_INTEGER_8 *); + export_proto(cshift1_8); + + void + cshift1_8 (gfc_array_char * ret, + const gfc_array_char * array, + const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich) + { + cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); + } + + void cshift1_8_char (gfc_array_char * ret, GFC_INTEGER_4, + const gfc_array_char * array, + const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich, + GFC_INTEGER_4); + export_proto(cshift1_8_char); + + void + cshift1_8_char (gfc_array_char * ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * array, + const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich, + GFC_INTEGER_4 array_length) + { + cshift1 (ret, array, h, pwhich, array_length); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_c10.c gcc-4.1.0/libgfortran/generated/dotprod_c10.c *** gcc-4.0.2/libgfortran/generated/dotprod_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/dotprod_c10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,82 ---- + /* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + and Feng Wang + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_10) + + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + + extern GFC_COMPLEX_10 dot_product_c10 (gfc_array_c10 * a, gfc_array_c10 * b); + export_proto(dot_product_c10); + + /* Both parameters will already have been converted to the result type. */ + GFC_COMPLEX_10 + dot_product_c10 (gfc_array_c10 * a, gfc_array_c10 * b) + { + GFC_COMPLEX_10 *pa; + GFC_COMPLEX_10 *pb; + GFC_COMPLEX_10 res; + GFC_COMPLEX_10 conjga; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa)); + res += conjga * *pb; + pa += astride; + pb += bstride; + } + + return res; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_c16.c gcc-4.1.0/libgfortran/generated/dotprod_c16.c *** gcc-4.0.2/libgfortran/generated/dotprod_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/dotprod_c16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,82 ---- + /* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + and Feng Wang + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_16) + + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + + extern GFC_COMPLEX_16 dot_product_c16 (gfc_array_c16 * a, gfc_array_c16 * b); + export_proto(dot_product_c16); + + /* Both parameters will already have been converted to the result type. */ + GFC_COMPLEX_16 + dot_product_c16 (gfc_array_c16 * a, gfc_array_c16 * b) + { + GFC_COMPLEX_16 *pa; + GFC_COMPLEX_16 *pb; + GFC_COMPLEX_16 res; + GFC_COMPLEX_16 conjga; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa)); + res += conjga * *pb; + pa += astride; + pb += bstride; + } + + return res; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_c4.c gcc-4.1.0/libgfortran/generated/dotprod_c4.c *** gcc-4.0.2/libgfortran/generated/dotprod_c4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/dotprod_c4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 26,39 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_COMPLEX_4 dot_product_c4 (gfc_array_c4 * a, gfc_array_c4 * b); --- 26,41 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_4) + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_COMPLEX_4 dot_product_c4 (gfc_array_c4 * a, gfc_array_c4 * b); *************** dot_product_c4 (gfc_array_c4 * a, gfc_ar *** 76,78 **** --- 78,82 ---- return res; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_c8.c gcc-4.1.0/libgfortran/generated/dotprod_c8.c *** gcc-4.0.2/libgfortran/generated/dotprod_c8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/dotprod_c8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 26,39 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_COMPLEX_8 dot_product_c8 (gfc_array_c8 * a, gfc_array_c8 * b); --- 26,41 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_8) + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_COMPLEX_8 dot_product_c8 (gfc_array_c8 * a, gfc_array_c8 * b); *************** dot_product_c8 (gfc_array_c8 * a, gfc_ar *** 76,78 **** --- 78,82 ---- return res; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_i16.c gcc-4.1.0/libgfortran/generated/dotprod_i16.c *** gcc-4.0.2/libgfortran/generated/dotprod_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/dotprod_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,79 ---- + /* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + + extern GFC_INTEGER_16 dot_product_i16 (gfc_array_i16 * a, gfc_array_i16 * b); + export_proto(dot_product_i16); + + /* Both parameters will already have been converted to the result type. */ + GFC_INTEGER_16 + dot_product_i16 (gfc_array_i16 * a, gfc_array_i16 * b) + { + GFC_INTEGER_16 *pa; + GFC_INTEGER_16 *pb; + GFC_INTEGER_16 res; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + return res; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_i4.c gcc-4.1.0/libgfortran/generated/dotprod_i4.c *** gcc-4.0.2/libgfortran/generated/dotprod_i4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/dotprod_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_INTEGER_4 dot_product_i4 (gfc_array_i4 * a, gfc_array_i4 * b); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_INTEGER_4 dot_product_i4 (gfc_array_i4 * a, gfc_array_i4 * b); *************** dot_product_i4 (gfc_array_i4 * a, gfc_ar *** 73,75 **** --- 75,79 ---- return res; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_i8.c gcc-4.1.0/libgfortran/generated/dotprod_i8.c *** gcc-4.0.2/libgfortran/generated/dotprod_i8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/dotprod_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_INTEGER_8 dot_product_i8 (gfc_array_i8 * a, gfc_array_i8 * b); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_INTEGER_8 dot_product_i8 (gfc_array_i8 * a, gfc_array_i8 * b); *************** dot_product_i8 (gfc_array_i8 * a, gfc_ar *** 73,75 **** --- 75,79 ---- return res; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_l16.c gcc-4.1.0/libgfortran/generated/dotprod_l16.c *** gcc-4.0.2/libgfortran/generated/dotprod_l16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/dotprod_l16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,89 ---- + /* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_LOGICAL_16) + + extern GFC_LOGICAL_16 dot_product_l16 (gfc_array_l4 *, gfc_array_l4 *); + export_proto(dot_product_l16); + + GFC_LOGICAL_16 + dot_product_l16 (gfc_array_l4 * a, gfc_array_l4 * b) + { + GFC_LOGICAL_4 *pa; + GFC_LOGICAL_4 *pb; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + + pa = a->data; + if (GFC_DESCRIPTOR_SIZE (a) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (a) == 8); + pa = GFOR_POINTER_L8_TO_L4 (pa); + astride <<= 1; + } + pb = b->data; + if (GFC_DESCRIPTOR_SIZE (b) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (b) == 8); + pb = GFOR_POINTER_L8_TO_L4 (pb); + bstride <<= 1; + } + + while (count--) + { + if (*pa && *pb) + return 1; + + pa += astride; + pb += bstride; + } + + return 0; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_l4.c gcc-4.1.0/libgfortran/generated/dotprod_l4.c *** gcc-4.0.2/libgfortran/generated/dotprod_l4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/dotprod_l4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" extern GFC_LOGICAL_4 dot_product_l4 (gfc_array_l4 *, gfc_array_l4 *); export_proto(dot_product_l4); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_4) + extern GFC_LOGICAL_4 dot_product_l4 (gfc_array_l4 *, gfc_array_l4 *); export_proto(dot_product_l4); *************** dot_product_l4 (gfc_array_l4 * a, gfc_ar *** 83,85 **** --- 85,89 ---- return 0; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_l8.c gcc-4.1.0/libgfortran/generated/dotprod_l8.c *** gcc-4.0.2/libgfortran/generated/dotprod_l8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/dotprod_l8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" extern GFC_LOGICAL_8 dot_product_l8 (gfc_array_l4 *, gfc_array_l4 *); export_proto(dot_product_l8); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_8) + extern GFC_LOGICAL_8 dot_product_l8 (gfc_array_l4 *, gfc_array_l4 *); export_proto(dot_product_l8); *************** dot_product_l8 (gfc_array_l4 * a, gfc_ar *** 83,85 **** --- 85,89 ---- return 0; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_r10.c gcc-4.1.0/libgfortran/generated/dotprod_r10.c *** gcc-4.0.2/libgfortran/generated/dotprod_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/dotprod_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,79 ---- + /* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_REAL_10) + + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + + extern GFC_REAL_10 dot_product_r10 (gfc_array_r10 * a, gfc_array_r10 * b); + export_proto(dot_product_r10); + + /* Both parameters will already have been converted to the result type. */ + GFC_REAL_10 + dot_product_r10 (gfc_array_r10 * a, gfc_array_r10 * b) + { + GFC_REAL_10 *pa; + GFC_REAL_10 *pb; + GFC_REAL_10 res; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + return res; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_r16.c gcc-4.1.0/libgfortran/generated/dotprod_r16.c *** gcc-4.0.2/libgfortran/generated/dotprod_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/dotprod_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,79 ---- + /* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_REAL_16) + + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + + extern GFC_REAL_16 dot_product_r16 (gfc_array_r16 * a, gfc_array_r16 * b); + export_proto(dot_product_r16); + + /* Both parameters will already have been converted to the result type. */ + GFC_REAL_16 + dot_product_r16 (gfc_array_r16 * a, gfc_array_r16 * b) + { + GFC_REAL_16 *pa; + GFC_REAL_16 *pb; + GFC_REAL_16 res; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + return res; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_r4.c gcc-4.1.0/libgfortran/generated/dotprod_r4.c *** gcc-4.0.2/libgfortran/generated/dotprod_r4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/dotprod_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_REAL_4 dot_product_r4 (gfc_array_r4 * a, gfc_array_r4 * b); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_REAL_4 dot_product_r4 (gfc_array_r4 * a, gfc_array_r4 * b); *************** dot_product_r4 (gfc_array_r4 * a, gfc_ar *** 73,75 **** --- 75,79 ---- return res; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/dotprod_r8.c gcc-4.1.0/libgfortran/generated/dotprod_r8.c *** gcc-4.0.2/libgfortran/generated/dotprod_r8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/dotprod_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_REAL_8 dot_product_r8 (gfc_array_r8 * a, gfc_array_r8 * b); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern GFC_REAL_8 dot_product_r8 (gfc_array_r8 * a, gfc_array_r8 * b); *************** dot_product_r8 (gfc_array_r8 * a, gfc_ar *** 73,75 **** --- 75,79 ---- return res; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/eoshift1_16.c gcc-4.1.0/libgfortran/generated/eoshift1_16.c *** gcc-4.0.2/libgfortran/generated/eoshift1_16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/eoshift1_16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,251 ---- + /* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + static void + eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i16 *h, + const char *pbound, const GFC_INTEGER_16 *pwhich, index_type size, + char filler) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the shift array. */ + index_type hstride[GFC_MAX_DIMENSIONS]; + index_type hstride0; + const GFC_INTEGER_16 *hptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + int which; + GFC_INTEGER_16 sh; + GFC_INTEGER_16 delta; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + extent[0] = 1; + count[0] = 0; + + if (ret->data == NULL) + { + int i; + + ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + ret->dim[i].lbound = 0; + ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound; + + if (i == 0) + ret->dim[i].stride = 1; + else + ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + } + } + + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + + while (rptr) + { + /* Do the shift for this dimension. */ + sh = *hptr; + if (( sh >= 0 ? sh : -sh ) > len) + { + delta = len; + sh = len; + } + else + delta = (sh >= 0) ? sh: -sh; + + if (sh > 0) + { + src = &sptr[delta * soffset]; + dest = rptr; + } + else + { + src = sptr; + dest = &rptr[delta * roffset]; + } + for (n = 0; n < len - delta; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + if (sh < 0) + dest = rptr; + n = delta; + + if (pbound) + while (n--) + { + memcpy (dest, pbound, size); + dest += roffset; + } + else + while (n--) + { + memset (dest, filler, size); + dest += roffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + } + } + } + } + + void eoshift1_16 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i16 *, const char *, const GFC_INTEGER_16 *); + export_proto(eoshift1_16); + + void + eoshift1_16 (gfc_array_char *ret, const gfc_array_char *array, + const gfc_array_i16 *h, const char *pbound, + const GFC_INTEGER_16 *pwhich) + { + eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + } + + void eoshift1_16_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_i16 *, + const char *, const GFC_INTEGER_16 *, + GFC_INTEGER_4, GFC_INTEGER_4); + export_proto(eoshift1_16_char); + + void + eoshift1_16_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_i16 *h, + const char *pbound, const GFC_INTEGER_16 *pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length + __attribute__((unused))) + { + eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/eoshift1_4.c gcc-4.1.0/libgfortran/generated/eoshift1_4.c *** gcc-4.0.2/libgfortran/generated/eoshift1_4.c Thu Jul 14 21:17:21 2005 --- gcc-4.1.0/libgfortran/generated/eoshift1_4.c Mon Oct 3 07:22:20 2005 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,53 **** #include #include "libgfortran.h" ! static const char zeros[16] = ! {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; ! ! extern void eoshift1_4 (gfc_array_char *, ! const gfc_array_char *, ! const gfc_array_i4 *, const char *, ! const GFC_INTEGER_4 *); ! export_proto(eoshift1_4); ! void ! eoshift1_4 (gfc_array_char *ret, ! const gfc_array_char *array, ! const gfc_array_i4 *h, const char *pbound, ! const GFC_INTEGER_4 *pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,45 ---- #include #include "libgfortran.h" ! #if defined (HAVE_GFC_INTEGER_4) ! static void ! eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i4 *h, ! const char *pbound, const GFC_INTEGER_4 *pwhich, index_type size, ! char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** eoshift1_4 (gfc_array_char *ret, *** 69,101 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; GFC_INTEGER_4 sh; GFC_INTEGER_4 delta; if (pwhich) which = *pwhich - 1; else which = 0; - if (!pbound) - pbound = zeros; - - size = GFC_DESCRIPTOR_SIZE (ret); - extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 61,92 ---- index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; index_type len; index_type n; int which; GFC_INTEGER_4 sh; GFC_INTEGER_4 delta; + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + if (pwhich) which = *pwhich - 1; else which = 0; extent[0] = 1; count[0] = 0; if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** eoshift1_4 (gfc_array_char *ret, *** 129,135 **** rstride[n] = ret->dim[dim].stride * size; sstride[n] = array->dim[dim].stride * size; ! hstride[n] = h->dim[n].stride * size; n++; } } --- 120,126 ---- rstride[n] = ret->dim[dim].stride * size; sstride[n] = array->dim[dim].stride * size; ! hstride[n] = h->dim[n].stride; n++; } } *************** eoshift1_4 (gfc_array_char *ret, *** 180,190 **** dest = rptr; n = delta; ! while (n--) ! { ! memcpy (dest, pbound, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; --- 171,188 ---- dest = rptr; n = delta; ! if (pbound) ! while (n--) ! { ! memcpy (dest, pbound, size); ! dest += roffset; ! } ! else ! while (n--) ! { ! memset (dest, filler, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; *************** eoshift1_4 (gfc_array_char *ret, *** 219,221 **** --- 217,251 ---- } } } + + void eoshift1_4 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i4 *, const char *, const GFC_INTEGER_4 *); + export_proto(eoshift1_4); + + void + eoshift1_4 (gfc_array_char *ret, const gfc_array_char *array, + const gfc_array_i4 *h, const char *pbound, + const GFC_INTEGER_4 *pwhich) + { + eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + } + + void eoshift1_4_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_i4 *, + const char *, const GFC_INTEGER_4 *, + GFC_INTEGER_4, GFC_INTEGER_4); + export_proto(eoshift1_4_char); + + void + eoshift1_4_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_i4 *h, + const char *pbound, const GFC_INTEGER_4 *pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length + __attribute__((unused))) + { + eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/eoshift1_8.c gcc-4.1.0/libgfortran/generated/eoshift1_8.c *** gcc-4.0.2/libgfortran/generated/eoshift1_8.c Thu Jul 14 21:17:21 2005 --- gcc-4.1.0/libgfortran/generated/eoshift1_8.c Mon Oct 3 07:22:20 2005 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,53 **** #include #include "libgfortran.h" ! static const char zeros[16] = ! {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; ! ! extern void eoshift1_8 (gfc_array_char *, ! const gfc_array_char *, ! const gfc_array_i8 *, const char *, ! const GFC_INTEGER_8 *); ! export_proto(eoshift1_8); ! void ! eoshift1_8 (gfc_array_char *ret, ! const gfc_array_char *array, ! const gfc_array_i8 *h, const char *pbound, ! const GFC_INTEGER_8 *pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,45 ---- #include #include "libgfortran.h" ! #if defined (HAVE_GFC_INTEGER_8) ! static void ! eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i8 *h, ! const char *pbound, const GFC_INTEGER_8 *pwhich, index_type size, ! char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** eoshift1_8 (gfc_array_char *ret, *** 69,101 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; GFC_INTEGER_8 sh; GFC_INTEGER_8 delta; if (pwhich) which = *pwhich - 1; else which = 0; - if (!pbound) - pbound = zeros; - - size = GFC_DESCRIPTOR_SIZE (ret); - extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 61,92 ---- index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; index_type len; index_type n; int which; GFC_INTEGER_8 sh; GFC_INTEGER_8 delta; + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + if (pwhich) which = *pwhich - 1; else which = 0; extent[0] = 1; count[0] = 0; if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** eoshift1_8 (gfc_array_char *ret, *** 129,135 **** rstride[n] = ret->dim[dim].stride * size; sstride[n] = array->dim[dim].stride * size; ! hstride[n] = h->dim[n].stride * size; n++; } } --- 120,126 ---- rstride[n] = ret->dim[dim].stride * size; sstride[n] = array->dim[dim].stride * size; ! hstride[n] = h->dim[n].stride; n++; } } *************** eoshift1_8 (gfc_array_char *ret, *** 180,190 **** dest = rptr; n = delta; ! while (n--) ! { ! memcpy (dest, pbound, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; --- 171,188 ---- dest = rptr; n = delta; ! if (pbound) ! while (n--) ! { ! memcpy (dest, pbound, size); ! dest += roffset; ! } ! else ! while (n--) ! { ! memset (dest, filler, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; *************** eoshift1_8 (gfc_array_char *ret, *** 219,221 **** --- 217,251 ---- } } } + + void eoshift1_8 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i8 *, const char *, const GFC_INTEGER_8 *); + export_proto(eoshift1_8); + + void + eoshift1_8 (gfc_array_char *ret, const gfc_array_char *array, + const gfc_array_i8 *h, const char *pbound, + const GFC_INTEGER_8 *pwhich) + { + eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + } + + void eoshift1_8_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_i8 *, + const char *, const GFC_INTEGER_8 *, + GFC_INTEGER_4, GFC_INTEGER_4); + export_proto(eoshift1_8_char); + + void + eoshift1_8_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_i8 *h, + const char *pbound, const GFC_INTEGER_8 *pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length + __attribute__((unused))) + { + eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/eoshift3_16.c gcc-4.1.0/libgfortran/generated/eoshift3_16.c *** gcc-4.0.2/libgfortran/generated/eoshift3_16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/eoshift3_16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,273 ---- + /* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + static void + eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i16 *h, + const gfc_array_char *bound, const GFC_INTEGER_16 *pwhich, + index_type size, char filler) + { + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the shift array. */ + index_type hstride[GFC_MAX_DIMENSIONS]; + index_type hstride0; + const GFC_INTEGER_16 *hptr; + /* b.* indicates the bound array. */ + index_type bstride[GFC_MAX_DIMENSIONS]; + index_type bstride0; + const char *bptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + int which; + GFC_INTEGER_16 sh; + GFC_INTEGER_16 delta; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (ret->data == NULL) + { + int i; + + ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + ret->dim[i].lbound = 0; + ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound; + + if (i == 0) + ret->dim[i].stride = 1; + else + ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + } + } + + + extent[0] = 1; + count[0] = 0; + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + if (bound) + bstride[n] = bound->dim[n].stride * size; + else + bstride[n] = 0; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + if (bound && bstride[0] == 0) + bstride[0] = size; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + bstride0 = bstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + if (bound) + bptr = bound->data; + else + bptr = NULL; + + while (rptr) + { + /* Do the shift for this dimension. */ + sh = *hptr; + if (( sh >= 0 ? sh : -sh ) > len) + { + delta = len; + sh = len; + } + else + delta = (sh >= 0) ? sh: -sh; + + if (sh > 0) + { + src = &sptr[delta * soffset]; + dest = rptr; + } + else + { + src = sptr; + dest = &rptr[delta * roffset]; + } + for (n = 0; n < len - delta; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + if (sh < 0) + dest = rptr; + n = delta; + + if (bptr) + while (n--) + { + memcpy (dest, bptr, size); + dest += roffset; + } + else + while (n--) + { + memset (dest, filler, size); + dest += roffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + bptr += bstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + bptr -= bstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + bptr += bstride[n]; + } + } + } + } + + extern void eoshift3_16 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i16 *, const gfc_array_char *, + const GFC_INTEGER_16 *); + export_proto(eoshift3_16); + + void + eoshift3_16 (gfc_array_char *ret, const gfc_array_char *array, + const gfc_array_i16 *h, const gfc_array_char *bound, + const GFC_INTEGER_16 *pwhich) + { + eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + } + + extern void eoshift3_16_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, + const gfc_array_i16 *, + const gfc_array_char *, + const GFC_INTEGER_16 *, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(eoshift3_16_char); + + void + eoshift3_16_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_i16 *h, + const gfc_array_char *bound, + const GFC_INTEGER_16 *pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length + __attribute__((unused))) + { + eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/eoshift3_4.c gcc-4.1.0/libgfortran/generated/eoshift3_4.c *** gcc-4.0.2/libgfortran/generated/eoshift3_4.c Thu Jul 14 21:17:21 2005 --- gcc-4.1.0/libgfortran/generated/eoshift3_4.c Mon Oct 3 07:22:20 2005 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,51 **** #include #include "libgfortran.h" ! static const char zeros[16] = ! {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; ! ! extern void eoshift3_4 (gfc_array_char *, gfc_array_char *, ! gfc_array_i4 *, const gfc_array_char *, ! GFC_INTEGER_4 *); ! export_proto(eoshift3_4); ! void ! eoshift3_4 (gfc_array_char *ret, gfc_array_char *array, ! gfc_array_i4 *h, const gfc_array_char *bound, ! GFC_INTEGER_4 *pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,45 ---- #include #include "libgfortran.h" ! #if defined (HAVE_GFC_INTEGER_4) ! static void ! eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i4 *h, ! const gfc_array_char *bound, const GFC_INTEGER_4 *pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** eoshift3_4 (gfc_array_char *ret, gfc_arr *** 71,95 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; GFC_INTEGER_4 sh; GFC_INTEGER_4 delta; if (pwhich) which = *pwhich - 1; else which = 0; - size = GFC_DESCRIPTOR_SIZE (ret); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 65,93 ---- index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; index_type len; index_type n; int which; GFC_INTEGER_4 sh; GFC_INTEGER_4 delta; + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + if (pwhich) which = *pwhich - 1; else which = 0; if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** eoshift3_4 (gfc_array_char *ret, gfc_arr *** 106,112 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { --- 104,109 ---- *************** eoshift3_4 (gfc_array_char *ret, gfc_arr *** 155,161 **** if (bound) bptr = bound->data; else ! bptr = zeros; while (rptr) { --- 152,158 ---- if (bound) bptr = bound->data; else ! bptr = NULL; while (rptr) { *************** eoshift3_4 (gfc_array_char *ret, gfc_arr *** 189,199 **** dest = rptr; n = delta; ! while (n--) ! { ! memcpy (dest, bptr, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; --- 186,203 ---- dest = rptr; n = delta; ! if (bptr) ! while (n--) ! { ! memcpy (dest, bptr, size); ! dest += roffset; ! } ! else ! while (n--) ! { ! memset (dest, filler, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; *************** eoshift3_4 (gfc_array_char *ret, gfc_arr *** 231,233 **** --- 235,273 ---- } } } + + extern void eoshift3_4 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i4 *, const gfc_array_char *, + const GFC_INTEGER_4 *); + export_proto(eoshift3_4); + + void + eoshift3_4 (gfc_array_char *ret, const gfc_array_char *array, + const gfc_array_i4 *h, const gfc_array_char *bound, + const GFC_INTEGER_4 *pwhich) + { + eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + } + + extern void eoshift3_4_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, + const gfc_array_i4 *, + const gfc_array_char *, + const GFC_INTEGER_4 *, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(eoshift3_4_char); + + void + eoshift3_4_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_i4 *h, + const gfc_array_char *bound, + const GFC_INTEGER_4 *pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length + __attribute__((unused))) + { + eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/eoshift3_8.c gcc-4.1.0/libgfortran/generated/eoshift3_8.c *** gcc-4.0.2/libgfortran/generated/eoshift3_8.c Thu Jul 14 21:17:21 2005 --- gcc-4.1.0/libgfortran/generated/eoshift3_8.c Mon Oct 3 07:22:20 2005 *************** *** 1,5 **** /* Implementation of the EOSHIFT intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,51 **** #include #include "libgfortran.h" ! static const char zeros[16] = ! {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; ! ! extern void eoshift3_8 (gfc_array_char *, gfc_array_char *, ! gfc_array_i8 *, const gfc_array_char *, ! GFC_INTEGER_8 *); ! export_proto(eoshift3_8); ! void ! eoshift3_8 (gfc_array_char *ret, gfc_array_char *array, ! gfc_array_i8 *h, const gfc_array_char *bound, ! GFC_INTEGER_8 *pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,45 ---- #include #include "libgfortran.h" ! #if defined (HAVE_GFC_INTEGER_8) ! static void ! eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i8 *h, ! const gfc_array_char *bound, const GFC_INTEGER_8 *pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** eoshift3_8 (gfc_array_char *ret, gfc_arr *** 71,95 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; GFC_INTEGER_8 sh; GFC_INTEGER_8 delta; if (pwhich) which = *pwhich - 1; else which = 0; - size = GFC_DESCRIPTOR_SIZE (ret); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 65,93 ---- index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; index_type len; index_type n; int which; GFC_INTEGER_8 sh; GFC_INTEGER_8 delta; + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + if (pwhich) which = *pwhich - 1; else which = 0; if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** eoshift3_8 (gfc_array_char *ret, gfc_arr *** 106,112 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { --- 104,109 ---- *************** eoshift3_8 (gfc_array_char *ret, gfc_arr *** 155,161 **** if (bound) bptr = bound->data; else ! bptr = zeros; while (rptr) { --- 152,158 ---- if (bound) bptr = bound->data; else ! bptr = NULL; while (rptr) { *************** eoshift3_8 (gfc_array_char *ret, gfc_arr *** 189,199 **** dest = rptr; n = delta; ! while (n--) ! { ! memcpy (dest, bptr, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; --- 186,203 ---- dest = rptr; n = delta; ! if (bptr) ! while (n--) ! { ! memcpy (dest, bptr, size); ! dest += roffset; ! } ! else ! while (n--) ! { ! memset (dest, filler, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; *************** eoshift3_8 (gfc_array_char *ret, gfc_arr *** 231,233 **** --- 235,273 ---- } } } + + extern void eoshift3_8 (gfc_array_char *, const gfc_array_char *, + const gfc_array_i8 *, const gfc_array_char *, + const GFC_INTEGER_8 *); + export_proto(eoshift3_8); + + void + eoshift3_8 (gfc_array_char *ret, const gfc_array_char *array, + const gfc_array_i8 *h, const gfc_array_char *bound, + const GFC_INTEGER_8 *pwhich) + { + eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + } + + extern void eoshift3_8_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, + const gfc_array_i8 *, + const gfc_array_char *, + const GFC_INTEGER_8 *, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(eoshift3_8_char); + + void + eoshift3_8_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_i8 *h, + const gfc_array_char *bound, + const GFC_INTEGER_8 *pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length + __attribute__((unused))) + { + eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/exp_c4.c gcc-4.1.0/libgfortran/generated/exp_c4.c *** gcc-4.0.2/libgfortran/generated/exp_c4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/exp_c4.c Thu Jan 1 00:00:00 1970 *************** *** 1,145 **** - /* Complex exponential functions - Copyright 2002, 2004 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h" - - - /* z = a + ib */ - /* Absolute value. */ - GFC_REAL_4 - cabsf (GFC_COMPLEX_4 z) - { - return hypotf (REALPART (z), IMAGPART (z)); - } - - /* Complex argument. The angle made with the +ve real axis. - Range -pi-pi. */ - GFC_REAL_4 - cargf (GFC_COMPLEX_4 z) - { - GFC_REAL_4 arg; - - return atan2f (IMAGPART (z), REALPART (z)); - } - - /* exp(z) = exp(a)*(cos(b) + isin(b)) */ - GFC_COMPLEX_4 - cexpf (GFC_COMPLEX_4 z) - { - GFC_REAL_4 a; - GFC_REAL_4 b; - GFC_COMPLEX_4 v; - - a = REALPART (z); - b = IMAGPART (z); - COMPLEX_ASSIGN (v, cosf (b), sinf (b)); - return expf (a) * v; - } - - /* log(z) = log (cabs(z)) + i*carg(z) */ - GFC_COMPLEX_4 - clogf (GFC_COMPLEX_4 z) - { - GFC_COMPLEX_4 v; - - COMPLEX_ASSIGN (v, logf (cabsf (z)), cargf (z)); - return v; - } - - /* log10(z) = log10 (cabs(z)) + i*carg(z) */ - GFC_COMPLEX_4 - clog10f (GFC_COMPLEX_4 z) - { - GFC_COMPLEX_4 v; - - COMPLEX_ASSIGN (v, log10f (cabsf (z)), cargf (z)); - return v; - } - - /* pow(base, power) = cexp (power * clog (base)) */ - GFC_COMPLEX_4 - cpowf (GFC_COMPLEX_4 base, GFC_COMPLEX_4 power) - { - return cexpf (power * clogf (base)); - } - - /* sqrt(z). Algorithm pulled from glibc. */ - GFC_COMPLEX_4 - csqrtf (GFC_COMPLEX_4 z) - { - GFC_REAL_4 re; - GFC_REAL_4 im; - GFC_COMPLEX_4 v; - - re = REALPART (z); - im = IMAGPART (z); - if (im == 0.0) - { - if (re < 0.0) - { - COMPLEX_ASSIGN (v, 0.0, copysignf (sqrtf (-re), im)); - } - else - { - COMPLEX_ASSIGN (v, fabsf (sqrt (re)), - copysignf (0.0, im)); - } - } - else if (re == 0.0) - { - GFC_REAL_4 r; - - r = sqrtf (0.5 * fabs (im)); - - COMPLEX_ASSIGN (v, copysignf (r, im), r); - } - else - { - GFC_REAL_4 d, r, s; - - d = hypotf (re, im); - /* Use the identity 2 Re res Im res = Im x - to avoid cancellation error in d +/- Re x. */ - if (re > 0) - { - r = sqrtf (0.5 * d + 0.5 * re); - s = (0.5 * im) / r; - } - else - { - s = sqrtf (0.5 * d - 0.5 * re); - r = fabsf ((0.5 * im) / s); - } - - COMPLEX_ASSIGN (v, r, copysignf (s, im)); - } - return v; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/exp_c8.c gcc-4.1.0/libgfortran/generated/exp_c8.c *** gcc-4.0.2/libgfortran/generated/exp_c8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/exp_c8.c Thu Jan 1 00:00:00 1970 *************** *** 1,145 **** - /* Complex exponential functions - Copyright 2002, 2004 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h" - - - /* z = a + ib */ - /* Absolute value. */ - GFC_REAL_8 - cabs (GFC_COMPLEX_8 z) - { - return hypot (REALPART (z), IMAGPART (z)); - } - - /* Complex argument. The angle made with the +ve real axis. - Range -pi-pi. */ - GFC_REAL_8 - carg (GFC_COMPLEX_8 z) - { - GFC_REAL_8 arg; - - return atan2 (IMAGPART (z), REALPART (z)); - } - - /* exp(z) = exp(a)*(cos(b) + isin(b)) */ - GFC_COMPLEX_8 - cexp (GFC_COMPLEX_8 z) - { - GFC_REAL_8 a; - GFC_REAL_8 b; - GFC_COMPLEX_8 v; - - a = REALPART (z); - b = IMAGPART (z); - COMPLEX_ASSIGN (v, cos (b), sin (b)); - return exp (a) * v; - } - - /* log(z) = log (cabs(z)) + i*carg(z) */ - GFC_COMPLEX_8 - clog (GFC_COMPLEX_8 z) - { - GFC_COMPLEX_8 v; - - COMPLEX_ASSIGN (v, log (cabs (z)), carg (z)); - return v; - } - - /* log10(z) = log10 (cabs(z)) + i*carg(z) */ - GFC_COMPLEX_8 - clog10 (GFC_COMPLEX_8 z) - { - GFC_COMPLEX_8 v; - - COMPLEX_ASSIGN (v, log10 (cabs (z)), carg (z)); - return v; - } - - /* pow(base, power) = cexp (power * clog (base)) */ - GFC_COMPLEX_8 - cpow (GFC_COMPLEX_8 base, GFC_COMPLEX_8 power) - { - return cexp (power * clog (base)); - } - - /* sqrt(z). Algorithm pulled from glibc. */ - GFC_COMPLEX_8 - csqrt (GFC_COMPLEX_8 z) - { - GFC_REAL_8 re; - GFC_REAL_8 im; - GFC_COMPLEX_8 v; - - re = REALPART (z); - im = IMAGPART (z); - if (im == 0.0) - { - if (re < 0.0) - { - COMPLEX_ASSIGN (v, 0.0, copysign (sqrt (-re), im)); - } - else - { - COMPLEX_ASSIGN (v, fabs (sqrt (re)), - copysign (0.0, im)); - } - } - else if (re == 0.0) - { - GFC_REAL_8 r; - - r = sqrt (0.5 * fabs (im)); - - COMPLEX_ASSIGN (v, copysign (r, im), r); - } - else - { - GFC_REAL_8 d, r, s; - - d = hypot (re, im); - /* Use the identity 2 Re res Im res = Im x - to avoid cancellation error in d +/- Re x. */ - if (re > 0) - { - r = sqrt (0.5 * d + 0.5 * re); - s = (0.5 * im) / r; - } - else - { - s = sqrt (0.5 * d - 0.5 * re); - r = fabs ((0.5 * im) / s); - } - - COMPLEX_ASSIGN (v, r, copysign (s, im)); - } - return v; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/exponent_r10.c gcc-4.1.0/libgfortran/generated/exponent_r10.c *** gcc-4.0.2/libgfortran/generated/exponent_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/exponent_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,49 ---- + /* Implementation of the EXPONENT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_FREXPL) + + extern GFC_INTEGER_4 exponent_r10 (GFC_REAL_10 s); + export_proto(exponent_r10); + + GFC_INTEGER_4 + exponent_r10 (GFC_REAL_10 s) + { + int ret; + frexpl (s, &ret); + return ret; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/exponent_r16.c gcc-4.1.0/libgfortran/generated/exponent_r16.c *** gcc-4.0.2/libgfortran/generated/exponent_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/exponent_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,49 ---- + /* Implementation of the EXPONENT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_FREXPL) + + extern GFC_INTEGER_4 exponent_r16 (GFC_REAL_16 s); + export_proto(exponent_r16); + + GFC_INTEGER_4 + exponent_r16 (GFC_REAL_16 s) + { + int ret; + frexpl (s, &ret); + return ret; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/exponent_r4.c gcc-4.1.0/libgfortran/generated/exponent_r4.c *** gcc-4.0.2/libgfortran/generated/exponent_r4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/exponent_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,36 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" extern GFC_INTEGER_4 exponent_r4 (GFC_REAL_4 s); export_proto(exponent_r4); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF) + extern GFC_INTEGER_4 exponent_r4 (GFC_REAL_4 s); export_proto(exponent_r4); *************** exponent_r4 (GFC_REAL_4 s) *** 41,43 **** --- 45,49 ---- frexpf (s, &ret); return ret; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/exponent_r8.c gcc-4.1.0/libgfortran/generated/exponent_r8.c *** gcc-4.0.2/libgfortran/generated/exponent_r8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/exponent_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,36 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" extern GFC_INTEGER_4 exponent_r8 (GFC_REAL_8 s); export_proto(exponent_r8); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP) + extern GFC_INTEGER_4 exponent_r8 (GFC_REAL_8 s); export_proto(exponent_r8); *************** exponent_r8 (GFC_REAL_8 s) *** 41,43 **** --- 45,49 ---- frexp (s, &ret); return ret; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/fraction_r10.c gcc-4.1.0/libgfortran/generated/fraction_r10.c *** gcc-4.0.2/libgfortran/generated/fraction_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/fraction_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,48 ---- + /* Implementation of the FRACTION intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_FREXPL) + + extern GFC_REAL_10 fraction_r10 (GFC_REAL_10 s); + export_proto(fraction_r10); + + GFC_REAL_10 + fraction_r10 (GFC_REAL_10 s) + { + int dummy_exp; + return frexpl (s, &dummy_exp); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/fraction_r16.c gcc-4.1.0/libgfortran/generated/fraction_r16.c *** gcc-4.0.2/libgfortran/generated/fraction_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/fraction_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,48 ---- + /* Implementation of the FRACTION intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_FREXPL) + + extern GFC_REAL_16 fraction_r16 (GFC_REAL_16 s); + export_proto(fraction_r16); + + GFC_REAL_16 + fraction_r16 (GFC_REAL_16 s) + { + int dummy_exp; + return frexpl (s, &dummy_exp); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/fraction_r4.c gcc-4.1.0/libgfortran/generated/fraction_r4.c *** gcc-4.0.2/libgfortran/generated/fraction_r4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/fraction_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,36 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" extern GFC_REAL_4 fraction_r4 (GFC_REAL_4 s); export_proto(fraction_r4); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF) + extern GFC_REAL_4 fraction_r4 (GFC_REAL_4 s); export_proto(fraction_r4); *************** fraction_r4 (GFC_REAL_4 s) *** 40,42 **** --- 44,48 ---- int dummy_exp; return frexpf (s, &dummy_exp); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/fraction_r8.c gcc-4.1.0/libgfortran/generated/fraction_r8.c *** gcc-4.0.2/libgfortran/generated/fraction_r8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/fraction_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,36 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" extern GFC_REAL_8 fraction_r8 (GFC_REAL_8 s); export_proto(fraction_r8); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP) + extern GFC_REAL_8 fraction_r8 (GFC_REAL_8 s); export_proto(fraction_r8); *************** fraction_r8 (GFC_REAL_8 s) *** 40,42 **** --- 44,48 ---- int dummy_exp; return frexp (s, &dummy_exp); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/hyp_c4.c gcc-4.1.0/libgfortran/generated/hyp_c4.c *** gcc-4.0.2/libgfortran/generated/hyp_c4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/hyp_c4.c Thu Jan 1 00:00:00 1970 *************** *** 1,80 **** - /* Complex hyperbolic functions - Copyright 2002 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h" - - - /* Complex number z = a + ib. */ - - /* sinh(z) = sinh(a)cos(b) + icosh(a)sin(b) */ - GFC_COMPLEX_4 - csinhf (GFC_COMPLEX_4 a) - { - GFC_REAL_4 r; - GFC_REAL_4 i; - GFC_COMPLEX_4 v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, sinhf (r) * cosf (i), coshf (r) * sinf (i)); - return v; - } - - /* cosh(z) = cosh(a)cos(b) - isinh(a)sin(b) */ - GFC_COMPLEX_4 - ccoshf (GFC_COMPLEX_4 a) - { - GFC_REAL_4 r; - GFC_REAL_4 i; - GFC_COMPLEX_4 v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, coshf (r) * cosf (i), - (sinhf (r) * sinf (i))); - return v; - } - - /* tanh(z) = (tanh(a) + itan(b)) / (1 - itanh(a)tan(b)) */ - GFC_COMPLEX_4 - ctanhf (GFC_COMPLEX_4 a) - { - GFC_REAL_4 rt; - GFC_REAL_4 it; - GFC_COMPLEX_4 n; - GFC_COMPLEX_4 d; - - rt = tanhf (REALPART (a)); - it = tanf (IMAGPART (a)); - COMPLEX_ASSIGN (n, rt, it); - COMPLEX_ASSIGN (d, 1, - (rt * it)); - - return n / d; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/hyp_c8.c gcc-4.1.0/libgfortran/generated/hyp_c8.c *** gcc-4.0.2/libgfortran/generated/hyp_c8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/hyp_c8.c Thu Jan 1 00:00:00 1970 *************** *** 1,80 **** - /* Complex hyperbolic functions - Copyright 2002 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h" - - - /* Complex number z = a + ib. */ - - /* sinh(z) = sinh(a)cos(b) + icosh(a)sin(b) */ - GFC_COMPLEX_8 - csinh (GFC_COMPLEX_8 a) - { - GFC_REAL_8 r; - GFC_REAL_8 i; - GFC_COMPLEX_8 v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, sinh (r) * cos (i), cosh (r) * sin (i)); - return v; - } - - /* cosh(z) = cosh(a)cos(b) - isinh(a)sin(b) */ - GFC_COMPLEX_8 - ccosh (GFC_COMPLEX_8 a) - { - GFC_REAL_8 r; - GFC_REAL_8 i; - GFC_COMPLEX_8 v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, cosh (r) * cos (i), - (sinh (r) * sin (i))); - return v; - } - - /* tanh(z) = (tanh(a) + itan(b)) / (1 - itanh(a)tan(b)) */ - GFC_COMPLEX_8 - ctanh (GFC_COMPLEX_8 a) - { - GFC_REAL_8 rt; - GFC_REAL_8 it; - GFC_COMPLEX_8 n; - GFC_COMPLEX_8 d; - - rt = tanh (REALPART (a)); - it = tan (IMAGPART (a)); - COMPLEX_ASSIGN (n, rt, it); - COMPLEX_ASSIGN (d, 1, - (rt * it)); - - return n / d; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_pack_c10.c gcc-4.1.0/libgfortran/generated/in_pack_c10.c *** gcc-4.0.2/libgfortran/generated/in_pack_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/in_pack_c10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,126 ---- + /* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_10) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_COMPLEX_10 * + internal_pack_c10 (gfc_array_c10 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_COMPLEX_10 *src; + GFC_COMPLEX_10 *dest; + GFC_COMPLEX_10 *destptr; + int n; + int packed; + + if (source->dim[0].stride == 0) + { + source->dim[0].stride = 1; + return source->data; + } + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_COMPLEX_10 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_10)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_pack_c16.c gcc-4.1.0/libgfortran/generated/in_pack_c16.c *** gcc-4.0.2/libgfortran/generated/in_pack_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/in_pack_c16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,126 ---- + /* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_16) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_COMPLEX_16 * + internal_pack_c16 (gfc_array_c16 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_COMPLEX_16 *src; + GFC_COMPLEX_16 *dest; + GFC_COMPLEX_16 *destptr; + int n; + int packed; + + if (source->dim[0].stride == 0) + { + source->dim[0].stride = 1; + return source->data; + } + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_COMPLEX_16 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_16)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_pack_c4.c gcc-4.1.0/libgfortran/generated/in_pack_c4.c *** gcc-4.0.2/libgfortran/generated/in_pack_c4.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/generated/in_pack_c4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" /* Allocates a block of memory with internal_malloc if the array needs repacking. */ --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_4) + /* Allocates a block of memory with internal_malloc if the array needs repacking. */ *************** internal_pack_c4 (gfc_array_c4 * source) *** 121,123 **** --- 123,126 ---- return destptr; } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_pack_c8.c gcc-4.1.0/libgfortran/generated/in_pack_c8.c *** gcc-4.0.2/libgfortran/generated/in_pack_c8.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/generated/in_pack_c8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" /* Allocates a block of memory with internal_malloc if the array needs repacking. */ --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_8) + /* Allocates a block of memory with internal_malloc if the array needs repacking. */ *************** internal_pack_c8 (gfc_array_c8 * source) *** 121,123 **** --- 123,126 ---- return destptr; } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_pack_i16.c gcc-4.1.0/libgfortran/generated/in_pack_i16.c *** gcc-4.0.2/libgfortran/generated/in_pack_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/in_pack_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,126 ---- + /* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + /* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + + GFC_INTEGER_16 * + internal_pack_16 (gfc_array_i16 * source) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_INTEGER_16 *src; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *destptr; + int n; + int packed; + + if (source->dim[0].stride == 0) + { + source->dim[0].stride = 1; + return source->data; + } + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_INTEGER_16 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_16)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_pack_i4.c gcc-4.1.0/libgfortran/generated/in_pack_i4.c *** gcc-4.0.2/libgfortran/generated/in_pack_i4.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/generated/in_pack_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" /* Allocates a block of memory with internal_malloc if the array needs repacking. */ --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) + /* Allocates a block of memory with internal_malloc if the array needs repacking. */ *************** internal_pack_4 (gfc_array_i4 * source) *** 121,123 **** --- 123,126 ---- return destptr; } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_pack_i8.c gcc-4.1.0/libgfortran/generated/in_pack_i8.c *** gcc-4.0.2/libgfortran/generated/in_pack_i8.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/generated/in_pack_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" /* Allocates a block of memory with internal_malloc if the array needs repacking. */ --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) + /* Allocates a block of memory with internal_malloc if the array needs repacking. */ *************** internal_pack_8 (gfc_array_i8 * source) *** 121,123 **** --- 123,126 ---- return destptr; } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_unpack_c10.c gcc-4.1.0/libgfortran/generated/in_unpack_c10.c *** gcc-4.0.2/libgfortran/generated/in_unpack_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/in_unpack_c10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,114 ---- + /* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_10) + + void + internal_unpack_c10 (gfc_array_c10 * d, const GFC_COMPLEX_10 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_COMPLEX_10 *dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + if (d->dim[0].stride == 0) + d->dim[0].stride = 1; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + abort (); + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_10)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_unpack_c16.c gcc-4.1.0/libgfortran/generated/in_unpack_c16.c *** gcc-4.0.2/libgfortran/generated/in_unpack_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/in_unpack_c16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,114 ---- + /* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_16) + + void + internal_unpack_c16 (gfc_array_c16 * d, const GFC_COMPLEX_16 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_COMPLEX_16 *dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + if (d->dim[0].stride == 0) + d->dim[0].stride = 1; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + abort (); + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_16)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_unpack_c4.c gcc-4.1.0/libgfortran/generated/in_unpack_c4.c *** gcc-4.0.2/libgfortran/generated/in_unpack_c4.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/generated/in_unpack_c4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_4) + void internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src) { *************** internal_unpack_c4 (gfc_array_c4 * d, co *** 109,111 **** --- 111,114 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_unpack_c8.c gcc-4.1.0/libgfortran/generated/in_unpack_c8.c *** gcc-4.0.2/libgfortran/generated/in_unpack_c8.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/generated/in_unpack_c8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_8) + void internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src) { *************** internal_unpack_c8 (gfc_array_c8 * d, co *** 109,111 **** --- 111,114 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_unpack_i16.c gcc-4.1.0/libgfortran/generated/in_unpack_i16.c *** gcc-4.0.2/libgfortran/generated/in_unpack_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/in_unpack_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,114 ---- + /* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + void + internal_unpack_16 (gfc_array_i16 * d, const GFC_INTEGER_16 * src) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_INTEGER_16 *dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + if (d->dim[0].stride == 0) + d->dim[0].stride = 1; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + abort (); + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_INTEGER_16)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_unpack_i4.c gcc-4.1.0/libgfortran/generated/in_unpack_i4.c *** gcc-4.0.2/libgfortran/generated/in_unpack_i4.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/generated/in_unpack_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) + void internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src) { *************** internal_unpack_4 (gfc_array_i4 * d, con *** 109,111 **** --- 111,114 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/in_unpack_i8.c gcc-4.1.0/libgfortran/generated/in_unpack_i8.c *** gcc-4.0.2/libgfortran/generated/in_unpack_i8.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/generated/in_unpack_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) + void internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src) { *************** internal_unpack_8 (gfc_array_i8 * d, con *** 109,111 **** --- 111,114 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_c10.c gcc-4.1.0/libgfortran/generated/matmul_c10.c *** gcc-4.0.2/libgfortran/generated/matmul_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/matmul_c10.c Mon Nov 14 19:48:31 2005 *************** *** 0 **** --- 1,221 ---- + /* Implementation of the MATMUL intrinsic + Copyright 2002, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_10) + + /* This is a C version of the following fortran pseudo-code. The key + point is the loop order -- we access all arrays column-first, which + improves the performance enough to boost galgel spec score by 50%. + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + C = 0 + DO J=1,N + DO K=1,COUNT + DO I=1,M + C(I,J) = C(I,J)+A(I,K)*B(K,J) + */ + + extern void matmul_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict a, gfc_array_c10 * const restrict b); + export_proto(matmul_c10); + + void + matmul_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict a, gfc_array_c10 * const restrict b) + { + const GFC_COMPLEX_10 * restrict abase; + const GFC_COMPLEX_10 * restrict bbase; + GFC_COMPLEX_10 * restrict dest; + + index_type rxstride, rystride, axstride, aystride, bxstride, bystride; + index_type x, y, n, count, xcount, ycount; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + + /* C[xcount,ycount] = A[xcount, count] * B[count,ycount] + + Either A or B (but not both) can be rank 1: + + o One-dimensional argument A is implicitly treated as a row matrix + dimensioned [1,count], so xcount=1. + + o One-dimensional argument B is implicitly treated as a column matrix + dimensioned [count, 1], so ycount=1. + */ + + if (retarray->data == NULL) + { + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[0].stride = 1; + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + } + else + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + + retarray->dim[1].lbound = 0; + retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[1].stride = retarray->dim[0].ubound+1; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + /* One-dimensional result may be addressed in the code below + either as a row or a column matrix. We want both cases to + work. */ + rxstride = rystride = retarray->dim[0].stride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = a->dim[0].stride; + aystride = 1; + + xcount = 1; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + else + { + axstride = a->dim[0].stride; + aystride = a->dim[1].stride; + + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = b->dim[0].stride; + + /* bystride should never be used for 1-dimensional b. + in case it is we want it to cause a segfault, rather than + an incorrect result. */ + bystride = 0xDEADBEEF; + ycount = 1; + } + else + { + bxstride = b->dim[0].stride; + bystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_COMPLEX_10 * restrict bbase_y; + GFC_COMPLEX_10 * restrict dest_y; + const GFC_COMPLEX_10 * restrict abase_n; + GFC_COMPLEX_10 bbase_yn; + + if (rystride == ycount) + memset (dest, 0, (sizeof (GFC_COMPLEX_10) * size0((array_t *) retarray))); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_COMPLEX_10)0; + } + + for (y = 0; y < ycount; y++) + { + bbase_y = bbase + y*bystride; + dest_y = dest + y*rystride; + for (n = 0; n < count; n++) + { + abase_n = abase + n*aystride; + bbase_yn = bbase_y[n]; + for (x = 0; x < xcount; x++) + { + dest_y[x] += abase_n[x] * bbase_yn; + } + } + } + } + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_COMPLEX_10)0; + + for (y = 0; y < ycount; y++) + for (n = 0; n < count; n++) + for (x = 0; x < xcount; x++) + /* dest[x,y] += a[x,n] * b[n,y] */ + dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_c16.c gcc-4.1.0/libgfortran/generated/matmul_c16.c *** gcc-4.0.2/libgfortran/generated/matmul_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/matmul_c16.c Mon Nov 14 19:48:31 2005 *************** *** 0 **** --- 1,221 ---- + /* Implementation of the MATMUL intrinsic + Copyright 2002, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_16) + + /* This is a C version of the following fortran pseudo-code. The key + point is the loop order -- we access all arrays column-first, which + improves the performance enough to boost galgel spec score by 50%. + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + C = 0 + DO J=1,N + DO K=1,COUNT + DO I=1,M + C(I,J) = C(I,J)+A(I,K)*B(K,J) + */ + + extern void matmul_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict a, gfc_array_c16 * const restrict b); + export_proto(matmul_c16); + + void + matmul_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict a, gfc_array_c16 * const restrict b) + { + const GFC_COMPLEX_16 * restrict abase; + const GFC_COMPLEX_16 * restrict bbase; + GFC_COMPLEX_16 * restrict dest; + + index_type rxstride, rystride, axstride, aystride, bxstride, bystride; + index_type x, y, n, count, xcount, ycount; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + + /* C[xcount,ycount] = A[xcount, count] * B[count,ycount] + + Either A or B (but not both) can be rank 1: + + o One-dimensional argument A is implicitly treated as a row matrix + dimensioned [1,count], so xcount=1. + + o One-dimensional argument B is implicitly treated as a column matrix + dimensioned [count, 1], so ycount=1. + */ + + if (retarray->data == NULL) + { + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[0].stride = 1; + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + } + else + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + + retarray->dim[1].lbound = 0; + retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[1].stride = retarray->dim[0].ubound+1; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + /* One-dimensional result may be addressed in the code below + either as a row or a column matrix. We want both cases to + work. */ + rxstride = rystride = retarray->dim[0].stride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = a->dim[0].stride; + aystride = 1; + + xcount = 1; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + else + { + axstride = a->dim[0].stride; + aystride = a->dim[1].stride; + + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = b->dim[0].stride; + + /* bystride should never be used for 1-dimensional b. + in case it is we want it to cause a segfault, rather than + an incorrect result. */ + bystride = 0xDEADBEEF; + ycount = 1; + } + else + { + bxstride = b->dim[0].stride; + bystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_COMPLEX_16 * restrict bbase_y; + GFC_COMPLEX_16 * restrict dest_y; + const GFC_COMPLEX_16 * restrict abase_n; + GFC_COMPLEX_16 bbase_yn; + + if (rystride == ycount) + memset (dest, 0, (sizeof (GFC_COMPLEX_16) * size0((array_t *) retarray))); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_COMPLEX_16)0; + } + + for (y = 0; y < ycount; y++) + { + bbase_y = bbase + y*bystride; + dest_y = dest + y*rystride; + for (n = 0; n < count; n++) + { + abase_n = abase + n*aystride; + bbase_yn = bbase_y[n]; + for (x = 0; x < xcount; x++) + { + dest_y[x] += abase_n[x] * bbase_yn; + } + } + } + } + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_COMPLEX_16)0; + + for (y = 0; y < ycount; y++) + for (n = 0; n < count; n++) + for (x = 0; x < xcount; x++) + /* dest[x,y] += a[x,n] * b[n,y] */ + dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_c4.c gcc-4.1.0/libgfortran/generated/matmul_c4.c *** gcc-4.0.2/libgfortran/generated/matmul_c4.c Fri Jul 15 20:47:33 2005 --- gcc-4.1.0/libgfortran/generated/matmul_c4.c Mon Nov 14 19:48:31 2005 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_4) + /* This is a C version of the following fortran pseudo-code. The key point is the loop order -- we access all arrays column-first, which improves the performance enough to boost galgel spec score by 50%. *************** Boston, MA 02111-1307, USA. */ *** 46,60 **** C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b); export_proto(matmul_c4); void ! matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b) { ! GFC_COMPLEX_4 *abase; ! GFC_COMPLEX_4 *bbase; ! GFC_COMPLEX_4 *dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; --- 48,64 ---- C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_c4 (gfc_array_c4 * const restrict retarray, ! gfc_array_c4 * const restrict a, gfc_array_c4 * const restrict b); export_proto(matmul_c4); void ! matmul_c4 (gfc_array_c4 * const restrict retarray, ! gfc_array_c4 * const restrict a, gfc_array_c4 * const restrict b) { ! const GFC_COMPLEX_4 * restrict abase; ! const GFC_COMPLEX_4 * restrict bbase; ! GFC_COMPLEX_4 * restrict dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; *************** matmul_c4 (gfc_array_c4 * retarray, gfc_ *** 92,114 **** retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 (retarray)); ! retarray->base = 0; } - abase = a->data; - bbase = b->data; - dest = retarray->data; - if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) --- 96,116 ---- retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) *************** matmul_c4 (gfc_array_c4 * retarray, gfc_ *** 157,163 **** /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else --- 159,165 ---- /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else *************** matmul_c4 (gfc_array_c4 * retarray, gfc_ *** 173,181 **** if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! GFC_COMPLEX_4 *bbase_y; ! GFC_COMPLEX_4 *dest_y; ! GFC_COMPLEX_4 *abase_n; GFC_COMPLEX_4 bbase_yn; if (rystride == ycount) --- 175,183 ---- if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! const GFC_COMPLEX_4 * restrict bbase_y; ! GFC_COMPLEX_4 * restrict dest_y; ! const GFC_COMPLEX_4 * restrict abase_n; GFC_COMPLEX_4 bbase_yn; if (rystride == ycount) *************** matmul_c4 (gfc_array_c4 * retarray, gfc_ *** 215,217 **** --- 217,221 ---- dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_c8.c gcc-4.1.0/libgfortran/generated/matmul_c8.c *** gcc-4.0.2/libgfortran/generated/matmul_c8.c Fri Jul 15 20:47:34 2005 --- gcc-4.1.0/libgfortran/generated/matmul_c8.c Mon Nov 14 19:48:31 2005 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_8) + /* This is a C version of the following fortran pseudo-code. The key point is the loop order -- we access all arrays column-first, which improves the performance enough to boost galgel spec score by 50%. *************** Boston, MA 02111-1307, USA. */ *** 46,60 **** C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b); export_proto(matmul_c8); void ! matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b) { ! GFC_COMPLEX_8 *abase; ! GFC_COMPLEX_8 *bbase; ! GFC_COMPLEX_8 *dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; --- 48,64 ---- C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_c8 (gfc_array_c8 * const restrict retarray, ! gfc_array_c8 * const restrict a, gfc_array_c8 * const restrict b); export_proto(matmul_c8); void ! matmul_c8 (gfc_array_c8 * const restrict retarray, ! gfc_array_c8 * const restrict a, gfc_array_c8 * const restrict b) { ! const GFC_COMPLEX_8 * restrict abase; ! const GFC_COMPLEX_8 * restrict bbase; ! GFC_COMPLEX_8 * restrict dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; *************** matmul_c8 (gfc_array_c8 * retarray, gfc_ *** 92,114 **** retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 (retarray)); ! retarray->base = 0; } - abase = a->data; - bbase = b->data; - dest = retarray->data; - if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) --- 96,116 ---- retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) *************** matmul_c8 (gfc_array_c8 * retarray, gfc_ *** 157,163 **** /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else --- 159,165 ---- /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else *************** matmul_c8 (gfc_array_c8 * retarray, gfc_ *** 173,181 **** if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! GFC_COMPLEX_8 *bbase_y; ! GFC_COMPLEX_8 *dest_y; ! GFC_COMPLEX_8 *abase_n; GFC_COMPLEX_8 bbase_yn; if (rystride == ycount) --- 175,183 ---- if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! const GFC_COMPLEX_8 * restrict bbase_y; ! GFC_COMPLEX_8 * restrict dest_y; ! const GFC_COMPLEX_8 * restrict abase_n; GFC_COMPLEX_8 bbase_yn; if (rystride == ycount) *************** matmul_c8 (gfc_array_c8 * retarray, gfc_ *** 215,217 **** --- 217,221 ---- dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_i16.c gcc-4.1.0/libgfortran/generated/matmul_i16.c *** gcc-4.0.2/libgfortran/generated/matmul_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/matmul_i16.c Mon Nov 14 19:48:31 2005 *************** *** 0 **** --- 1,221 ---- + /* Implementation of the MATMUL intrinsic + Copyright 2002, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + /* This is a C version of the following fortran pseudo-code. The key + point is the loop order -- we access all arrays column-first, which + improves the performance enough to boost galgel spec score by 50%. + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + C = 0 + DO J=1,N + DO K=1,COUNT + DO I=1,M + C(I,J) = C(I,J)+A(I,K)*B(K,J) + */ + + extern void matmul_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict a, gfc_array_i16 * const restrict b); + export_proto(matmul_i16); + + void + matmul_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict a, gfc_array_i16 * const restrict b) + { + const GFC_INTEGER_16 * restrict abase; + const GFC_INTEGER_16 * restrict bbase; + GFC_INTEGER_16 * restrict dest; + + index_type rxstride, rystride, axstride, aystride, bxstride, bystride; + index_type x, y, n, count, xcount, ycount; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + + /* C[xcount,ycount] = A[xcount, count] * B[count,ycount] + + Either A or B (but not both) can be rank 1: + + o One-dimensional argument A is implicitly treated as a row matrix + dimensioned [1,count], so xcount=1. + + o One-dimensional argument B is implicitly treated as a column matrix + dimensioned [count, 1], so ycount=1. + */ + + if (retarray->data == NULL) + { + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[0].stride = 1; + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + } + else + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + + retarray->dim[1].lbound = 0; + retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[1].stride = retarray->dim[0].ubound+1; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + /* One-dimensional result may be addressed in the code below + either as a row or a column matrix. We want both cases to + work. */ + rxstride = rystride = retarray->dim[0].stride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = a->dim[0].stride; + aystride = 1; + + xcount = 1; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + else + { + axstride = a->dim[0].stride; + aystride = a->dim[1].stride; + + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = b->dim[0].stride; + + /* bystride should never be used for 1-dimensional b. + in case it is we want it to cause a segfault, rather than + an incorrect result. */ + bystride = 0xDEADBEEF; + ycount = 1; + } + else + { + bxstride = b->dim[0].stride; + bystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_INTEGER_16 * restrict bbase_y; + GFC_INTEGER_16 * restrict dest_y; + const GFC_INTEGER_16 * restrict abase_n; + GFC_INTEGER_16 bbase_yn; + + if (rystride == ycount) + memset (dest, 0, (sizeof (GFC_INTEGER_16) * size0((array_t *) retarray))); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_INTEGER_16)0; + } + + for (y = 0; y < ycount; y++) + { + bbase_y = bbase + y*bystride; + dest_y = dest + y*rystride; + for (n = 0; n < count; n++) + { + abase_n = abase + n*aystride; + bbase_yn = bbase_y[n]; + for (x = 0; x < xcount; x++) + { + dest_y[x] += abase_n[x] * bbase_yn; + } + } + } + } + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_INTEGER_16)0; + + for (y = 0; y < ycount; y++) + for (n = 0; n < count; n++) + for (x = 0; x < xcount; x++) + /* dest[x,y] += a[x,n] * b[n,y] */ + dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_i4.c gcc-4.1.0/libgfortran/generated/matmul_i4.c *** gcc-4.0.2/libgfortran/generated/matmul_i4.c Fri Jul 15 20:47:34 2005 --- gcc-4.1.0/libgfortran/generated/matmul_i4.c Mon Nov 14 19:48:31 2005 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) + /* This is a C version of the following fortran pseudo-code. The key point is the loop order -- we access all arrays column-first, which improves the performance enough to boost galgel spec score by 50%. *************** Boston, MA 02111-1307, USA. */ *** 46,60 **** C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b); export_proto(matmul_i4); void ! matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b) { ! GFC_INTEGER_4 *abase; ! GFC_INTEGER_4 *bbase; ! GFC_INTEGER_4 *dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; --- 48,64 ---- C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_i4 (gfc_array_i4 * const restrict retarray, ! gfc_array_i4 * const restrict a, gfc_array_i4 * const restrict b); export_proto(matmul_i4); void ! matmul_i4 (gfc_array_i4 * const restrict retarray, ! gfc_array_i4 * const restrict a, gfc_array_i4 * const restrict b) { ! const GFC_INTEGER_4 * restrict abase; ! const GFC_INTEGER_4 * restrict bbase; ! GFC_INTEGER_4 * restrict dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; *************** matmul_i4 (gfc_array_i4 * retarray, gfc_ *** 92,114 **** retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 (retarray)); ! retarray->base = 0; } - abase = a->data; - bbase = b->data; - dest = retarray->data; - if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) --- 96,116 ---- retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) *************** matmul_i4 (gfc_array_i4 * retarray, gfc_ *** 157,163 **** /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else --- 159,165 ---- /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else *************** matmul_i4 (gfc_array_i4 * retarray, gfc_ *** 173,181 **** if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! GFC_INTEGER_4 *bbase_y; ! GFC_INTEGER_4 *dest_y; ! GFC_INTEGER_4 *abase_n; GFC_INTEGER_4 bbase_yn; if (rystride == ycount) --- 175,183 ---- if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! const GFC_INTEGER_4 * restrict bbase_y; ! GFC_INTEGER_4 * restrict dest_y; ! const GFC_INTEGER_4 * restrict abase_n; GFC_INTEGER_4 bbase_yn; if (rystride == ycount) *************** matmul_i4 (gfc_array_i4 * retarray, gfc_ *** 215,217 **** --- 217,221 ---- dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_i8.c gcc-4.1.0/libgfortran/generated/matmul_i8.c *** gcc-4.0.2/libgfortran/generated/matmul_i8.c Fri Jul 15 20:47:34 2005 --- gcc-4.1.0/libgfortran/generated/matmul_i8.c Mon Nov 14 19:48:31 2005 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) + /* This is a C version of the following fortran pseudo-code. The key point is the loop order -- we access all arrays column-first, which improves the performance enough to boost galgel spec score by 50%. *************** Boston, MA 02111-1307, USA. */ *** 46,60 **** C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b); export_proto(matmul_i8); void ! matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b) { ! GFC_INTEGER_8 *abase; ! GFC_INTEGER_8 *bbase; ! GFC_INTEGER_8 *dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; --- 48,64 ---- C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_i8 (gfc_array_i8 * const restrict retarray, ! gfc_array_i8 * const restrict a, gfc_array_i8 * const restrict b); export_proto(matmul_i8); void ! matmul_i8 (gfc_array_i8 * const restrict retarray, ! gfc_array_i8 * const restrict a, gfc_array_i8 * const restrict b) { ! const GFC_INTEGER_8 * restrict abase; ! const GFC_INTEGER_8 * restrict bbase; ! GFC_INTEGER_8 * restrict dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; *************** matmul_i8 (gfc_array_i8 * retarray, gfc_ *** 92,114 **** retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 (retarray)); ! retarray->base = 0; } - abase = a->data; - bbase = b->data; - dest = retarray->data; - if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) --- 96,116 ---- retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) *************** matmul_i8 (gfc_array_i8 * retarray, gfc_ *** 157,163 **** /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else --- 159,165 ---- /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else *************** matmul_i8 (gfc_array_i8 * retarray, gfc_ *** 173,181 **** if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! GFC_INTEGER_8 *bbase_y; ! GFC_INTEGER_8 *dest_y; ! GFC_INTEGER_8 *abase_n; GFC_INTEGER_8 bbase_yn; if (rystride == ycount) --- 175,183 ---- if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! const GFC_INTEGER_8 * restrict bbase_y; ! GFC_INTEGER_8 * restrict dest_y; ! const GFC_INTEGER_8 * restrict abase_n; GFC_INTEGER_8 bbase_yn; if (rystride == ycount) *************** matmul_i8 (gfc_array_i8 * retarray, gfc_ *** 215,217 **** --- 217,221 ---- dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_l16.c gcc-4.1.0/libgfortran/generated/matmul_l16.c *** gcc-4.0.2/libgfortran/generated/matmul_l16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/matmul_l16.c Mon Nov 14 19:48:31 2005 *************** *** 0 **** --- 1,198 ---- + /* Implementation of the MATMUL intrinsic + Copyright 2002, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_LOGICAL_16) + + /* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ + + extern void matmul_l16 (gfc_array_l16 * const restrict, + gfc_array_l4 * const restrict, gfc_array_l4 * const restrict); + export_proto(matmul_l16); + + void + matmul_l16 (gfc_array_l16 * const restrict retarray, + gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b) + { + const GFC_INTEGER_4 * restrict abase; + const GFC_INTEGER_4 * restrict bbase; + GFC_LOGICAL_16 * restrict dest; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + const GFC_INTEGER_4 * restrict pa; + const GFC_INTEGER_4 * restrict pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + + if (retarray->data == NULL) + { + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[0].stride = 1; + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + } + else + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + + retarray->dim[1].lbound = 0; + retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[1].stride = retarray->dim[0].ubound+1; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_LOGICAL_16) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + + abase = a->data; + if (GFC_DESCRIPTOR_SIZE (a) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (a) == 8); + abase = GFOR_POINTER_L8_TO_L4 (abase); + } + bbase = b->data; + if (GFC_DESCRIPTOR_SIZE (b) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (b) == 8); + bbase = GFOR_POINTER_L8_TO_L4 (bbase); + } + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + *dest = 0; + + for (n = 0; n < count; n++) + { + if (*pa && *pb) + { + *dest = 1; + break; + } + pa += astride; + pb += bstride; + } + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_l4.c gcc-4.1.0/libgfortran/generated/matmul_l4.c *** gcc-4.0.2/libgfortran/generated/matmul_l4.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/matmul_l4.c Mon Nov 14 19:48:31 2005 *************** GNU General Public License for more deta *** 25,50 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" /* Dimensions: retarray(x,y) a(x, count) b(count,y). Either a or b can be rank 1. In this case x or y is 1. */ ! extern void matmul_l4 (gfc_array_l4 *, gfc_array_l4 *, gfc_array_l4 *); export_proto(matmul_l4); void ! matmul_l4 (gfc_array_l4 * retarray, gfc_array_l4 * a, gfc_array_l4 * b) { ! GFC_INTEGER_4 *abase; ! GFC_INTEGER_4 *bbase; ! GFC_LOGICAL_4 *dest; index_type rxstride; index_type rystride; index_type xcount; --- 25,54 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_4) + /* Dimensions: retarray(x,y) a(x, count) b(count,y). Either a or b can be rank 1. In this case x or y is 1. */ ! extern void matmul_l4 (gfc_array_l4 * const restrict, ! gfc_array_l4 * const restrict, gfc_array_l4 * const restrict); export_proto(matmul_l4); void ! matmul_l4 (gfc_array_l4 * const restrict retarray, ! gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b) { ! const GFC_INTEGER_4 * restrict abase; ! const GFC_INTEGER_4 * restrict bbase; ! GFC_LOGICAL_4 * restrict dest; index_type rxstride; index_type rystride; index_type xcount; *************** matmul_l4 (gfc_array_l4 * retarray, gfc_ *** 54,61 **** index_type x; index_type y; ! GFC_INTEGER_4 *pa; ! GFC_INTEGER_4 *pb; index_type astride; index_type bstride; index_type count; --- 58,65 ---- index_type x; index_type y; ! const GFC_INTEGER_4 * restrict pa; ! const GFC_INTEGER_4 * restrict pb; index_type astride; index_type bstride; index_type count; *************** matmul_l4 (gfc_array_l4 * retarray, gfc_ *** 91,97 **** retarray->data = internal_malloc_size (sizeof (GFC_LOGICAL_4) * size0 ((array_t *) retarray)); ! retarray->base = 0; } abase = a->data; --- 95,101 ---- retarray->data = internal_malloc_size (sizeof (GFC_LOGICAL_4) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } abase = a->data; *************** matmul_l4 (gfc_array_l4 * retarray, gfc_ *** 190,192 **** --- 194,198 ---- dest += rystride - (rxstride * xcount); } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_l8.c gcc-4.1.0/libgfortran/generated/matmul_l8.c *** gcc-4.0.2/libgfortran/generated/matmul_l8.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/matmul_l8.c Mon Nov 14 19:48:31 2005 *************** GNU General Public License for more deta *** 25,50 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" /* Dimensions: retarray(x,y) a(x, count) b(count,y). Either a or b can be rank 1. In this case x or y is 1. */ ! extern void matmul_l8 (gfc_array_l8 *, gfc_array_l4 *, gfc_array_l4 *); export_proto(matmul_l8); void ! matmul_l8 (gfc_array_l8 * retarray, gfc_array_l4 * a, gfc_array_l4 * b) { ! GFC_INTEGER_4 *abase; ! GFC_INTEGER_4 *bbase; ! GFC_LOGICAL_8 *dest; index_type rxstride; index_type rystride; index_type xcount; --- 25,54 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_LOGICAL_8) + /* Dimensions: retarray(x,y) a(x, count) b(count,y). Either a or b can be rank 1. In this case x or y is 1. */ ! extern void matmul_l8 (gfc_array_l8 * const restrict, ! gfc_array_l4 * const restrict, gfc_array_l4 * const restrict); export_proto(matmul_l8); void ! matmul_l8 (gfc_array_l8 * const restrict retarray, ! gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b) { ! const GFC_INTEGER_4 * restrict abase; ! const GFC_INTEGER_4 * restrict bbase; ! GFC_LOGICAL_8 * restrict dest; index_type rxstride; index_type rystride; index_type xcount; *************** matmul_l8 (gfc_array_l8 * retarray, gfc_ *** 54,61 **** index_type x; index_type y; ! GFC_INTEGER_4 *pa; ! GFC_INTEGER_4 *pb; index_type astride; index_type bstride; index_type count; --- 58,65 ---- index_type x; index_type y; ! const GFC_INTEGER_4 * restrict pa; ! const GFC_INTEGER_4 * restrict pb; index_type astride; index_type bstride; index_type count; *************** matmul_l8 (gfc_array_l8 * retarray, gfc_ *** 91,97 **** retarray->data = internal_malloc_size (sizeof (GFC_LOGICAL_8) * size0 ((array_t *) retarray)); ! retarray->base = 0; } abase = a->data; --- 95,101 ---- retarray->data = internal_malloc_size (sizeof (GFC_LOGICAL_8) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } abase = a->data; *************** matmul_l8 (gfc_array_l8 * retarray, gfc_ *** 190,192 **** --- 194,198 ---- dest += rystride - (rxstride * xcount); } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_r10.c gcc-4.1.0/libgfortran/generated/matmul_r10.c *** gcc-4.0.2/libgfortran/generated/matmul_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/matmul_r10.c Mon Nov 14 19:48:31 2005 *************** *** 0 **** --- 1,221 ---- + /* Implementation of the MATMUL intrinsic + Copyright 2002, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_REAL_10) + + /* This is a C version of the following fortran pseudo-code. The key + point is the loop order -- we access all arrays column-first, which + improves the performance enough to boost galgel spec score by 50%. + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + C = 0 + DO J=1,N + DO K=1,COUNT + DO I=1,M + C(I,J) = C(I,J)+A(I,K)*B(K,J) + */ + + extern void matmul_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict a, gfc_array_r10 * const restrict b); + export_proto(matmul_r10); + + void + matmul_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict a, gfc_array_r10 * const restrict b) + { + const GFC_REAL_10 * restrict abase; + const GFC_REAL_10 * restrict bbase; + GFC_REAL_10 * restrict dest; + + index_type rxstride, rystride, axstride, aystride, bxstride, bystride; + index_type x, y, n, count, xcount, ycount; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + + /* C[xcount,ycount] = A[xcount, count] * B[count,ycount] + + Either A or B (but not both) can be rank 1: + + o One-dimensional argument A is implicitly treated as a row matrix + dimensioned [1,count], so xcount=1. + + o One-dimensional argument B is implicitly treated as a column matrix + dimensioned [count, 1], so ycount=1. + */ + + if (retarray->data == NULL) + { + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[0].stride = 1; + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + } + else + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + + retarray->dim[1].lbound = 0; + retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[1].stride = retarray->dim[0].ubound+1; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + /* One-dimensional result may be addressed in the code below + either as a row or a column matrix. We want both cases to + work. */ + rxstride = rystride = retarray->dim[0].stride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = a->dim[0].stride; + aystride = 1; + + xcount = 1; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + else + { + axstride = a->dim[0].stride; + aystride = a->dim[1].stride; + + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = b->dim[0].stride; + + /* bystride should never be used for 1-dimensional b. + in case it is we want it to cause a segfault, rather than + an incorrect result. */ + bystride = 0xDEADBEEF; + ycount = 1; + } + else + { + bxstride = b->dim[0].stride; + bystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_REAL_10 * restrict bbase_y; + GFC_REAL_10 * restrict dest_y; + const GFC_REAL_10 * restrict abase_n; + GFC_REAL_10 bbase_yn; + + if (rystride == ycount) + memset (dest, 0, (sizeof (GFC_REAL_10) * size0((array_t *) retarray))); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_REAL_10)0; + } + + for (y = 0; y < ycount; y++) + { + bbase_y = bbase + y*bystride; + dest_y = dest + y*rystride; + for (n = 0; n < count; n++) + { + abase_n = abase + n*aystride; + bbase_yn = bbase_y[n]; + for (x = 0; x < xcount; x++) + { + dest_y[x] += abase_n[x] * bbase_yn; + } + } + } + } + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_REAL_10)0; + + for (y = 0; y < ycount; y++) + for (n = 0; n < count; n++) + for (x = 0; x < xcount; x++) + /* dest[x,y] += a[x,n] * b[n,y] */ + dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_r16.c gcc-4.1.0/libgfortran/generated/matmul_r16.c *** gcc-4.0.2/libgfortran/generated/matmul_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/matmul_r16.c Mon Nov 14 19:48:31 2005 *************** *** 0 **** --- 1,221 ---- + /* Implementation of the MATMUL intrinsic + Copyright 2002, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_REAL_16) + + /* This is a C version of the following fortran pseudo-code. The key + point is the loop order -- we access all arrays column-first, which + improves the performance enough to boost galgel spec score by 50%. + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + C = 0 + DO J=1,N + DO K=1,COUNT + DO I=1,M + C(I,J) = C(I,J)+A(I,K)*B(K,J) + */ + + extern void matmul_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict a, gfc_array_r16 * const restrict b); + export_proto(matmul_r16); + + void + matmul_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict a, gfc_array_r16 * const restrict b) + { + const GFC_REAL_16 * restrict abase; + const GFC_REAL_16 * restrict bbase; + GFC_REAL_16 * restrict dest; + + index_type rxstride, rystride, axstride, aystride, bxstride, bystride; + index_type x, y, n, count, xcount, ycount; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + + /* C[xcount,ycount] = A[xcount, count] * B[count,ycount] + + Either A or B (but not both) can be rank 1: + + o One-dimensional argument A is implicitly treated as a row matrix + dimensioned [1,count], so xcount=1. + + o One-dimensional argument B is implicitly treated as a column matrix + dimensioned [count, 1], so ycount=1. + */ + + if (retarray->data == NULL) + { + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[0].stride = 1; + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + } + else + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; + retarray->dim[0].stride = 1; + + retarray->dim[1].lbound = 0; + retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; + retarray->dim[1].stride = retarray->dim[0].ubound+1; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + /* One-dimensional result may be addressed in the code below + either as a row or a column matrix. We want both cases to + work. */ + rxstride = rystride = retarray->dim[0].stride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = a->dim[0].stride; + aystride = 1; + + xcount = 1; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + else + { + axstride = a->dim[0].stride; + aystride = a->dim[1].stride; + + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = b->dim[0].stride; + + /* bystride should never be used for 1-dimensional b. + in case it is we want it to cause a segfault, rather than + an incorrect result. */ + bystride = 0xDEADBEEF; + ycount = 1; + } + else + { + bxstride = b->dim[0].stride; + bystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_REAL_16 * restrict bbase_y; + GFC_REAL_16 * restrict dest_y; + const GFC_REAL_16 * restrict abase_n; + GFC_REAL_16 bbase_yn; + + if (rystride == ycount) + memset (dest, 0, (sizeof (GFC_REAL_16) * size0((array_t *) retarray))); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_REAL_16)0; + } + + for (y = 0; y < ycount; y++) + { + bbase_y = bbase + y*bystride; + dest_y = dest + y*rystride; + for (n = 0; n < count; n++) + { + abase_n = abase + n*aystride; + bbase_yn = bbase_y[n]; + for (x = 0; x < xcount; x++) + { + dest_y[x] += abase_n[x] * bbase_yn; + } + } + } + } + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_REAL_16)0; + + for (y = 0; y < ycount; y++) + for (n = 0; n < count; n++) + for (x = 0; x < xcount; x++) + /* dest[x,y] += a[x,n] * b[n,y] */ + dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_r4.c gcc-4.1.0/libgfortran/generated/matmul_r4.c *** gcc-4.0.2/libgfortran/generated/matmul_r4.c Fri Jul 15 20:47:34 2005 --- gcc-4.1.0/libgfortran/generated/matmul_r4.c Mon Nov 14 19:48:31 2005 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) + /* This is a C version of the following fortran pseudo-code. The key point is the loop order -- we access all arrays column-first, which improves the performance enough to boost galgel spec score by 50%. *************** Boston, MA 02111-1307, USA. */ *** 46,60 **** C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b); export_proto(matmul_r4); void ! matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b) { ! GFC_REAL_4 *abase; ! GFC_REAL_4 *bbase; ! GFC_REAL_4 *dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; --- 48,64 ---- C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_r4 (gfc_array_r4 * const restrict retarray, ! gfc_array_r4 * const restrict a, gfc_array_r4 * const restrict b); export_proto(matmul_r4); void ! matmul_r4 (gfc_array_r4 * const restrict retarray, ! gfc_array_r4 * const restrict a, gfc_array_r4 * const restrict b) { ! const GFC_REAL_4 * restrict abase; ! const GFC_REAL_4 * restrict bbase; ! GFC_REAL_4 * restrict dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; *************** matmul_r4 (gfc_array_r4 * retarray, gfc_ *** 92,114 **** retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_REAL_4) * size0 (retarray)); ! retarray->base = 0; } - abase = a->data; - bbase = b->data; - dest = retarray->data; - if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) --- 96,116 ---- retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) *************** matmul_r4 (gfc_array_r4 * retarray, gfc_ *** 157,163 **** /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else --- 159,165 ---- /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else *************** matmul_r4 (gfc_array_r4 * retarray, gfc_ *** 173,181 **** if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! GFC_REAL_4 *bbase_y; ! GFC_REAL_4 *dest_y; ! GFC_REAL_4 *abase_n; GFC_REAL_4 bbase_yn; if (rystride == ycount) --- 175,183 ---- if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! const GFC_REAL_4 * restrict bbase_y; ! GFC_REAL_4 * restrict dest_y; ! const GFC_REAL_4 * restrict abase_n; GFC_REAL_4 bbase_yn; if (rystride == ycount) *************** matmul_r4 (gfc_array_r4 * retarray, gfc_ *** 215,217 **** --- 217,221 ---- dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/matmul_r8.c gcc-4.1.0/libgfortran/generated/matmul_r8.c *** gcc-4.0.2/libgfortran/generated/matmul_r8.c Fri Jul 15 20:47:34 2005 --- gcc-4.1.0/libgfortran/generated/matmul_r8.c Mon Nov 14 19:48:31 2005 *************** *** 1,5 **** /* Implementation of the MATMUL intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) + /* This is a C version of the following fortran pseudo-code. The key point is the loop order -- we access all arrays column-first, which improves the performance enough to boost galgel spec score by 50%. *************** Boston, MA 02111-1307, USA. */ *** 46,60 **** C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b); export_proto(matmul_r8); void ! matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b) { ! GFC_REAL_8 *abase; ! GFC_REAL_8 *bbase; ! GFC_REAL_8 *dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; --- 48,64 ---- C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_r8 (gfc_array_r8 * const restrict retarray, ! gfc_array_r8 * const restrict a, gfc_array_r8 * const restrict b); export_proto(matmul_r8); void ! matmul_r8 (gfc_array_r8 * const restrict retarray, ! gfc_array_r8 * const restrict a, gfc_array_r8 * const restrict b) { ! const GFC_REAL_8 * restrict abase; ! const GFC_REAL_8 * restrict bbase; ! GFC_REAL_8 * restrict dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; *************** matmul_r8 (gfc_array_r8 * retarray, gfc_ *** 92,114 **** retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_REAL_8) * size0 (retarray)); ! retarray->base = 0; } - abase = a->data; - bbase = b->data; - dest = retarray->data; - if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) --- 96,116 ---- retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) *************** matmul_r8 (gfc_array_r8 * retarray, gfc_ *** 157,163 **** /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else --- 159,165 ---- /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else *************** matmul_r8 (gfc_array_r8 * retarray, gfc_ *** 173,181 **** if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! GFC_REAL_8 *bbase_y; ! GFC_REAL_8 *dest_y; ! GFC_REAL_8 *abase_n; GFC_REAL_8 bbase_yn; if (rystride == ycount) --- 175,183 ---- if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! const GFC_REAL_8 * restrict bbase_y; ! GFC_REAL_8 * restrict dest_y; ! const GFC_REAL_8 * restrict abase_n; GFC_REAL_8 bbase_yn; if (rystride == ycount) *************** matmul_r8 (gfc_array_r8 * retarray, gfc_ *** 215,217 **** --- 217,221 ---- dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_16_i16.c gcc-4.1.0/libgfortran/generated/maxloc0_16_i16.c *** gcc-4.0.2/libgfortran/generated/maxloc0_16_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_16_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array); + export_proto(maxloc0_16_i16); + + void + maxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 maxval; + + maxval = -GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_16_i16 (gfc_array_i16 *, gfc_array_i16 *, gfc_array_l4 *); + export_proto(mmaxloc0_16_i16); + + void + mmaxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 maxval; + + maxval = -GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_16_i4.c gcc-4.1.0/libgfortran/generated/maxloc0_16_i4.c *** gcc-4.0.2/libgfortran/generated/maxloc0_16_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_16_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array); + export_proto(maxloc0_16_i4); + + void + maxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 maxval; + + maxval = -GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_16_i4 (gfc_array_i16 *, gfc_array_i4 *, gfc_array_l4 *); + export_proto(mmaxloc0_16_i4); + + void + mmaxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 maxval; + + maxval = -GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_16_i8.c gcc-4.1.0/libgfortran/generated/maxloc0_16_i8.c *** gcc-4.0.2/libgfortran/generated/maxloc0_16_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_16_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array); + export_proto(maxloc0_16_i8); + + void + maxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 maxval; + + maxval = -GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_16_i8 (gfc_array_i16 *, gfc_array_i8 *, gfc_array_l4 *); + export_proto(mmaxloc0_16_i8); + + void + mmaxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 maxval; + + maxval = -GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_16_r10.c gcc-4.1.0/libgfortran/generated/maxloc0_16_r10.c *** gcc-4.0.2/libgfortran/generated/maxloc0_16_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_16_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array); + export_proto(maxloc0_16_r10); + + void + maxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_10 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 maxval; + + maxval = -GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_16_r10 (gfc_array_i16 *, gfc_array_r10 *, gfc_array_l4 *); + export_proto(mmaxloc0_16_r10); + + void + mmaxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 maxval; + + maxval = -GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_16_r16.c gcc-4.1.0/libgfortran/generated/maxloc0_16_r16.c *** gcc-4.0.2/libgfortran/generated/maxloc0_16_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_16_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array); + export_proto(maxloc0_16_r16); + + void + maxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 maxval; + + maxval = -GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_16_r16 (gfc_array_i16 *, gfc_array_r16 *, gfc_array_l4 *); + export_proto(mmaxloc0_16_r16); + + void + mmaxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 maxval; + + maxval = -GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_16_r4.c gcc-4.1.0/libgfortran/generated/maxloc0_16_r4.c *** gcc-4.0.2/libgfortran/generated/maxloc0_16_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_16_r4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array); + export_proto(maxloc0_16_r4); + + void + maxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 maxval; + + maxval = -GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_16_r4 (gfc_array_i16 *, gfc_array_r4 *, gfc_array_l4 *); + export_proto(mmaxloc0_16_r4); + + void + mmaxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 maxval; + + maxval = -GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_16_r8.c gcc-4.1.0/libgfortran/generated/maxloc0_16_r8.c *** gcc-4.0.2/libgfortran/generated/maxloc0_16_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_16_r8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array); + export_proto(maxloc0_16_r8); + + void + maxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 maxval; + + maxval = -GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_16_r8 (gfc_array_i16 *, gfc_array_r8 *, gfc_array_l4 *); + export_proto(mmaxloc0_16_r8); + + void + mmaxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 maxval; + + maxval = -GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_4_i16.c gcc-4.1.0/libgfortran/generated/maxloc0_4_i16.c *** gcc-4.0.2/libgfortran/generated/maxloc0_4_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_4_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void maxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array); + export_proto(maxloc0_4_i16); + + void + maxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 maxval; + + maxval = -GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_4_i16 (gfc_array_i4 *, gfc_array_i16 *, gfc_array_l4 *); + export_proto(mmaxloc0_4_i16); + + void + mmaxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 maxval; + + maxval = -GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_4_i4.c gcc-4.1.0/libgfortran/generated/maxloc0_4_i4.c *** gcc-4.0.2/libgfortran/generated/maxloc0_4_i4.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/maxloc0_4_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + extern void maxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array); export_proto(maxloc0_4_i4); *************** maxloc0_4_i4 (gfc_array_i4 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mmaxloc0_4_i4 (gfc_array_i4 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mmaxloc0_4_i4 (gfc_array_i4 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_4_i8.c gcc-4.1.0/libgfortran/generated/maxloc0_4_i8.c *** gcc-4.0.2/libgfortran/generated/maxloc0_4_i8.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/maxloc0_4_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + extern void maxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array); export_proto(maxloc0_4_i8); *************** maxloc0_4_i8 (gfc_array_i4 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mmaxloc0_4_i8 (gfc_array_i4 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mmaxloc0_4_i8 (gfc_array_i4 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_4_r10.c gcc-4.1.0/libgfortran/generated/maxloc0_4_r10.c *** gcc-4.0.2/libgfortran/generated/maxloc0_4_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_4_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + + extern void maxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array); + export_proto(maxloc0_4_r10); + + void + maxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_10 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 maxval; + + maxval = -GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_4_r10 (gfc_array_i4 *, gfc_array_r10 *, gfc_array_l4 *); + export_proto(mmaxloc0_4_r10); + + void + mmaxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 maxval; + + maxval = -GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_4_r16.c gcc-4.1.0/libgfortran/generated/maxloc0_4_r16.c *** gcc-4.0.2/libgfortran/generated/maxloc0_4_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_4_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void maxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array); + export_proto(maxloc0_4_r16); + + void + maxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 maxval; + + maxval = -GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_4_r16 (gfc_array_i4 *, gfc_array_r16 *, gfc_array_l4 *); + export_proto(mmaxloc0_4_r16); + + void + mmaxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 maxval; + + maxval = -GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_4_r4.c gcc-4.1.0/libgfortran/generated/maxloc0_4_r4.c *** gcc-4.0.2/libgfortran/generated/maxloc0_4_r4.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/maxloc0_4_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + extern void maxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array); export_proto(maxloc0_4_r4); *************** maxloc0_4_r4 (gfc_array_i4 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mmaxloc0_4_r4 (gfc_array_i4 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mmaxloc0_4_r4 (gfc_array_i4 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_4_r8.c gcc-4.1.0/libgfortran/generated/maxloc0_4_r8.c *** gcc-4.0.2/libgfortran/generated/maxloc0_4_r8.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/maxloc0_4_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + extern void maxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array); export_proto(maxloc0_4_r8); *************** maxloc0_4_r8 (gfc_array_i4 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mmaxloc0_4_r8 (gfc_array_i4 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mmaxloc0_4_r8 (gfc_array_i4 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_8_i16.c gcc-4.1.0/libgfortran/generated/maxloc0_8_i16.c *** gcc-4.0.2/libgfortran/generated/maxloc0_8_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_8_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void maxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array); + export_proto(maxloc0_8_i16); + + void + maxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 maxval; + + maxval = -GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_8_i16 (gfc_array_i8 *, gfc_array_i16 *, gfc_array_l4 *); + export_proto(mmaxloc0_8_i16); + + void + mmaxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 maxval; + + maxval = -GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_8_i4.c gcc-4.1.0/libgfortran/generated/maxloc0_8_i4.c *** gcc-4.0.2/libgfortran/generated/maxloc0_8_i4.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/maxloc0_8_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + extern void maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array); export_proto(maxloc0_8_i4); *************** maxloc0_8_i4 (gfc_array_i8 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mmaxloc0_8_i4 (gfc_array_i8 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mmaxloc0_8_i4 (gfc_array_i8 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_8_i8.c gcc-4.1.0/libgfortran/generated/maxloc0_8_i8.c *** gcc-4.0.2/libgfortran/generated/maxloc0_8_i8.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/maxloc0_8_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + extern void maxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array); export_proto(maxloc0_8_i8); *************** maxloc0_8_i8 (gfc_array_i8 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mmaxloc0_8_i8 (gfc_array_i8 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mmaxloc0_8_i8 (gfc_array_i8 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_8_r10.c gcc-4.1.0/libgfortran/generated/maxloc0_8_r10.c *** gcc-4.0.2/libgfortran/generated/maxloc0_8_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_8_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + + extern void maxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array); + export_proto(maxloc0_8_r10); + + void + maxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_10 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 maxval; + + maxval = -GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_8_r10 (gfc_array_i8 *, gfc_array_r10 *, gfc_array_l4 *); + export_proto(mmaxloc0_8_r10); + + void + mmaxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 maxval; + + maxval = -GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_8_r16.c gcc-4.1.0/libgfortran/generated/maxloc0_8_r16.c *** gcc-4.0.2/libgfortran/generated/maxloc0_8_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc0_8_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void maxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array); + export_proto(maxloc0_8_r16); + + void + maxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 maxval; + + maxval = -GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mmaxloc0_8_r16 (gfc_array_i8 *, gfc_array_r16 *, gfc_array_l4 *); + export_proto(mmaxloc0_8_r16); + + void + mmaxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 maxval; + + maxval = -GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_8_r4.c gcc-4.1.0/libgfortran/generated/maxloc0_8_r4.c *** gcc-4.0.2/libgfortran/generated/maxloc0_8_r4.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/maxloc0_8_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + extern void maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array); export_proto(maxloc0_8_r4); *************** maxloc0_8_r4 (gfc_array_i8 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mmaxloc0_8_r4 (gfc_array_i8 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mmaxloc0_8_r4 (gfc_array_i8 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc0_8_r8.c gcc-4.1.0/libgfortran/generated/maxloc0_8_r8.c *** gcc-4.0.2/libgfortran/generated/maxloc0_8_r8.c Fri May 20 22:36:37 2005 --- gcc-4.1.0/libgfortran/generated/maxloc0_8_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + extern void maxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array); export_proto(maxloc0_8_r8); *************** maxloc0_8_r8 (gfc_array_i8 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mmaxloc0_8_r8 (gfc_array_i8 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mmaxloc0_8_r8 (gfc_array_i8 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_16_i16.c gcc-4.1.0/libgfortran/generated/maxloc1_16_i16.c *** gcc-4.0.2/libgfortran/generated/maxloc1_16_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_16_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *); + export_proto(maxloc1_16_i16); + + void + maxloc1_16_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_16 maxval; + maxval = -GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_16_i16); + + void + mmaxloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 maxval; + maxval = -GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_16_i4.c gcc-4.1.0/libgfortran/generated/maxloc1_16_i4.c *** gcc-4.0.2/libgfortran/generated/maxloc1_16_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_16_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *); + export_proto(maxloc1_16_i4); + + void + maxloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_4 maxval; + maxval = -GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_16_i4); + + void + mmaxloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 maxval; + maxval = -GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_16_i8.c gcc-4.1.0/libgfortran/generated/maxloc1_16_i8.c *** gcc-4.0.2/libgfortran/generated/maxloc1_16_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_16_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *); + export_proto(maxloc1_16_i8); + + void + maxloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_8 maxval; + maxval = -GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_16_i8); + + void + mmaxloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 maxval; + maxval = -GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_16_r10.c gcc-4.1.0/libgfortran/generated/maxloc1_16_r10.c *** gcc-4.0.2/libgfortran/generated/maxloc1_16_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_16_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *); + export_proto(maxloc1_16_r10); + + void + maxloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_10 maxval; + maxval = -GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_16_r10); + + void + mmaxloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 maxval; + maxval = -GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_16_r16.c gcc-4.1.0/libgfortran/generated/maxloc1_16_r16.c *** gcc-4.0.2/libgfortran/generated/maxloc1_16_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_16_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *); + export_proto(maxloc1_16_r16); + + void + maxloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_16 maxval; + maxval = -GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_16_r16); + + void + mmaxloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 maxval; + maxval = -GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_16_r4.c gcc-4.1.0/libgfortran/generated/maxloc1_16_r4.c *** gcc-4.0.2/libgfortran/generated/maxloc1_16_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_16_r4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *); + export_proto(maxloc1_16_r4); + + void + maxloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_4 maxval; + maxval = -GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_16_r4); + + void + mmaxloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 maxval; + maxval = -GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_16_r8.c gcc-4.1.0/libgfortran/generated/maxloc1_16_r8.c *** gcc-4.0.2/libgfortran/generated/maxloc1_16_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_16_r8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *); + export_proto(maxloc1_16_r8); + + void + maxloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_8 maxval; + maxval = -GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_16_r8); + + void + mmaxloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 maxval; + maxval = -GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_4_i16.c gcc-4.1.0/libgfortran/generated/maxloc1_4_i16.c *** gcc-4.0.2/libgfortran/generated/maxloc1_4_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_4_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void maxloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *); + export_proto(maxloc1_4_i16); + + void + maxloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_16 maxval; + maxval = -GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_4_i16); + + void + mmaxloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 maxval; + maxval = -GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_4_i4.c gcc-4.1.0/libgfortran/generated/maxloc1_4_i4.c *** gcc-4.0.2/libgfortran/generated/maxloc1_4_i4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxloc1_4_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + extern void maxloc1_4_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *); export_proto(maxloc1_4_i4); *************** maxloc1_4_i4 (gfc_array_i4 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_4_i4 (gfc_array_i4 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_4_i4 (gfc_array_i4 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_4_i8.c gcc-4.1.0/libgfortran/generated/maxloc1_4_i8.c *** gcc-4.0.2/libgfortran/generated/maxloc1_4_i8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxloc1_4_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + + extern void maxloc1_4_i8 (gfc_array_i4 *, gfc_array_i8 *, index_type *); export_proto(maxloc1_4_i8); *************** maxloc1_4_i8 (gfc_array_i4 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_4_i8 (gfc_array_i4 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_4_i8 (gfc_array_i4 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_4_r10.c gcc-4.1.0/libgfortran/generated/maxloc1_4_r10.c *** gcc-4.0.2/libgfortran/generated/maxloc1_4_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_4_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + + extern void maxloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *); + export_proto(maxloc1_4_r10); + + void + maxloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_10 maxval; + maxval = -GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_4_r10); + + void + mmaxloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 maxval; + maxval = -GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_4_r16.c gcc-4.1.0/libgfortran/generated/maxloc1_4_r16.c *** gcc-4.0.2/libgfortran/generated/maxloc1_4_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_4_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void maxloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *); + export_proto(maxloc1_4_r16); + + void + maxloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_16 maxval; + maxval = -GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_4_r16); + + void + mmaxloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 maxval; + maxval = -GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_4_r4.c gcc-4.1.0/libgfortran/generated/maxloc1_4_r4.c *** gcc-4.0.2/libgfortran/generated/maxloc1_4_r4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxloc1_4_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + + extern void maxloc1_4_r4 (gfc_array_i4 *, gfc_array_r4 *, index_type *); export_proto(maxloc1_4_r4); *************** maxloc1_4_r4 (gfc_array_i4 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_4_r4 (gfc_array_i4 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_4_r4 (gfc_array_i4 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_4_r8.c gcc-4.1.0/libgfortran/generated/maxloc1_4_r8.c *** gcc-4.0.2/libgfortran/generated/maxloc1_4_r8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxloc1_4_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + + extern void maxloc1_4_r8 (gfc_array_i4 *, gfc_array_r8 *, index_type *); export_proto(maxloc1_4_r8); *************** maxloc1_4_r8 (gfc_array_i4 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_4_r8 (gfc_array_i4 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_4_r8 (gfc_array_i4 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_8_i16.c gcc-4.1.0/libgfortran/generated/maxloc1_8_i16.c *** gcc-4.0.2/libgfortran/generated/maxloc1_8_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_8_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void maxloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *); + export_proto(maxloc1_8_i16); + + void + maxloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_16 maxval; + maxval = -GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_8_i16); + + void + mmaxloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 maxval; + maxval = -GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_8_i4.c gcc-4.1.0/libgfortran/generated/maxloc1_8_i4.c *** gcc-4.0.2/libgfortran/generated/maxloc1_8_i4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxloc1_8_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + + extern void maxloc1_8_i4 (gfc_array_i8 *, gfc_array_i4 *, index_type *); export_proto(maxloc1_8_i4); *************** maxloc1_8_i4 (gfc_array_i8 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_8_i4 (gfc_array_i8 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_8_i4 (gfc_array_i8 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_8_i8.c gcc-4.1.0/libgfortran/generated/maxloc1_8_i8.c *** gcc-4.0.2/libgfortran/generated/maxloc1_8_i8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxloc1_8_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + extern void maxloc1_8_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *); export_proto(maxloc1_8_i8); *************** maxloc1_8_i8 (gfc_array_i8 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_8_i8 (gfc_array_i8 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_8_i8 (gfc_array_i8 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_8_r10.c gcc-4.1.0/libgfortran/generated/maxloc1_8_r10.c *** gcc-4.0.2/libgfortran/generated/maxloc1_8_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_8_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + + extern void maxloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *); + export_proto(maxloc1_8_r10); + + void + maxloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_10 maxval; + maxval = -GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_8_r10); + + void + mmaxloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 maxval; + maxval = -GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_8_r16.c gcc-4.1.0/libgfortran/generated/maxloc1_8_r16.c *** gcc-4.0.2/libgfortran/generated/maxloc1_8_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxloc1_8_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void maxloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *); + export_proto(maxloc1_8_r16); + + void + maxloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_16 maxval; + maxval = -GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxloc1_8_r16); + + void + mmaxloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 maxval; + maxval = -GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_8_r4.c gcc-4.1.0/libgfortran/generated/maxloc1_8_r4.c *** gcc-4.0.2/libgfortran/generated/maxloc1_8_r4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxloc1_8_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + + extern void maxloc1_8_r4 (gfc_array_i8 *, gfc_array_r4 *, index_type *); export_proto(maxloc1_8_r4); *************** maxloc1_8_r4 (gfc_array_i8 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_8_r4 (gfc_array_i8 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_8_r4 (gfc_array_i8 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxloc1_8_r8.c gcc-4.1.0/libgfortran/generated/maxloc1_8_r8.c *** gcc-4.0.2/libgfortran/generated/maxloc1_8_r8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxloc1_8_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + + extern void maxloc1_8_r8 (gfc_array_i8 *, gfc_array_r8 *, index_type *); export_proto(maxloc1_8_r8); *************** maxloc1_8_r8 (gfc_array_i8 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_8_r8 (gfc_array_i8 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxloc1_8_r8 (gfc_array_i8 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxval_i16.c gcc-4.1.0/libgfortran/generated/maxval_i16.c *** gcc-4.0.2/libgfortran/generated/maxval_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxval_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,336 ---- + /* Implementation of the MAXVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void maxval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *); + export_proto(maxval_i16); + + void + maxval_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + result = -GFC_INTEGER_16_HUGE; + if (len <= 0) + *dest = -GFC_INTEGER_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxval_i16); + + void + mmaxval_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = -GFC_INTEGER_16_HUGE; + if (len <= 0) + *dest = -GFC_INTEGER_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxval_i4.c gcc-4.1.0/libgfortran/generated/maxval_i4.c *** gcc-4.0.2/libgfortran/generated/maxval_i4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxval_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + extern void maxval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *); export_proto(maxval_i4); *************** maxval_i4 (gfc_array_i4 *retarray, gfc_a *** 93,99 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 96,102 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxval_i4 (gfc_array_i4 * retarray, gfc *** 239,245 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 242,248 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxval_i4 (gfc_array_i4 * retarray, gfc *** 330,332 **** --- 333,336 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxval_i8.c gcc-4.1.0/libgfortran/generated/maxval_i8.c *** gcc-4.0.2/libgfortran/generated/maxval_i8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxval_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + extern void maxval_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *); export_proto(maxval_i8); *************** maxval_i8 (gfc_array_i8 *retarray, gfc_a *** 93,99 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 96,102 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxval_i8 (gfc_array_i8 * retarray, gfc *** 239,245 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 242,248 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxval_i8 (gfc_array_i8 * retarray, gfc *** 330,332 **** --- 333,336 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxval_r10.c gcc-4.1.0/libgfortran/generated/maxval_r10.c *** gcc-4.0.2/libgfortran/generated/maxval_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxval_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,336 ---- + /* Implementation of the MAXVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) + + + extern void maxval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *); + export_proto(maxval_r10); + + void + maxval_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_REAL_10 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_REAL_10 result; + src = base; + { + + result = -GFC_REAL_10_HUGE; + if (len <= 0) + *dest = -GFC_REAL_10_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxval_r10); + + void + mmaxval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_10 result; + src = base; + msrc = mbase; + { + + result = -GFC_REAL_10_HUGE; + if (len <= 0) + *dest = -GFC_REAL_10_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxval_r16.c gcc-4.1.0/libgfortran/generated/maxval_r16.c *** gcc-4.0.2/libgfortran/generated/maxval_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/maxval_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,336 ---- + /* Implementation of the MAXVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) + + + extern void maxval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *); + export_proto(maxval_r16); + + void + maxval_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_REAL_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_REAL_16 result; + src = base; + { + + result = -GFC_REAL_16_HUGE; + if (len <= 0) + *dest = -GFC_REAL_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mmaxval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mmaxval_r16); + + void + mmaxval_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_16 result; + src = base; + msrc = mbase; + { + + result = -GFC_REAL_16_HUGE; + if (len <= 0) + *dest = -GFC_REAL_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxval_r4.c gcc-4.1.0/libgfortran/generated/maxval_r4.c *** gcc-4.0.2/libgfortran/generated/maxval_r4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxval_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) + + extern void maxval_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *); export_proto(maxval_r4); *************** maxval_r4 (gfc_array_r4 *retarray, gfc_a *** 93,99 **** = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 96,102 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxval_r4 (gfc_array_r4 * retarray, gfc *** 239,245 **** = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 242,248 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxval_r4 (gfc_array_r4 * retarray, gfc *** 330,332 **** --- 333,336 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/maxval_r8.c gcc-4.1.0/libgfortran/generated/maxval_r8.c *** gcc-4.0.2/libgfortran/generated/maxval_r8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/maxval_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) + + extern void maxval_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *); export_proto(maxval_r8); *************** maxval_r8 (gfc_array_r8 *retarray, gfc_a *** 93,99 **** = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 96,102 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxval_r8 (gfc_array_r8 * retarray, gfc *** 239,245 **** = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 242,248 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mmaxval_r8 (gfc_array_r8 * retarray, gfc *** 330,332 **** --- 333,336 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_16_i16.c gcc-4.1.0/libgfortran/generated/minloc0_16_i16.c *** gcc-4.0.2/libgfortran/generated/minloc0_16_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_16_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array); + export_proto(minloc0_16_i16); + + void + minloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 minval; + + minval = GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_16_i16 (gfc_array_i16 *, gfc_array_i16 *, gfc_array_l4 *); + export_proto(mminloc0_16_i16); + + void + mminloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 minval; + + minval = GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_16_i4.c gcc-4.1.0/libgfortran/generated/minloc0_16_i4.c *** gcc-4.0.2/libgfortran/generated/minloc0_16_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_16_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array); + export_proto(minloc0_16_i4); + + void + minloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 minval; + + minval = GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_16_i4 (gfc_array_i16 *, gfc_array_i4 *, gfc_array_l4 *); + export_proto(mminloc0_16_i4); + + void + mminloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 minval; + + minval = GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_16_i8.c gcc-4.1.0/libgfortran/generated/minloc0_16_i8.c *** gcc-4.0.2/libgfortran/generated/minloc0_16_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_16_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array); + export_proto(minloc0_16_i8); + + void + minloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 minval; + + minval = GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_16_i8 (gfc_array_i16 *, gfc_array_i8 *, gfc_array_l4 *); + export_proto(mminloc0_16_i8); + + void + mminloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 minval; + + minval = GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_16_r10.c gcc-4.1.0/libgfortran/generated/minloc0_16_r10.c *** gcc-4.0.2/libgfortran/generated/minloc0_16_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_16_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array); + export_proto(minloc0_16_r10); + + void + minloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_10 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 minval; + + minval = GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_16_r10 (gfc_array_i16 *, gfc_array_r10 *, gfc_array_l4 *); + export_proto(mminloc0_16_r10); + + void + mminloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 minval; + + minval = GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_16_r16.c gcc-4.1.0/libgfortran/generated/minloc0_16_r16.c *** gcc-4.0.2/libgfortran/generated/minloc0_16_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_16_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array); + export_proto(minloc0_16_r16); + + void + minloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 minval; + + minval = GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_16_r16 (gfc_array_i16 *, gfc_array_r16 *, gfc_array_l4 *); + export_proto(mminloc0_16_r16); + + void + mminloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 minval; + + minval = GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_16_r4.c gcc-4.1.0/libgfortran/generated/minloc0_16_r4.c *** gcc-4.0.2/libgfortran/generated/minloc0_16_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_16_r4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array); + export_proto(minloc0_16_r4); + + void + minloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 minval; + + minval = GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_16_r4 (gfc_array_i16 *, gfc_array_r4 *, gfc_array_l4 *); + export_proto(mminloc0_16_r4); + + void + mminloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 minval; + + minval = GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_16_r8.c gcc-4.1.0/libgfortran/generated/minloc0_16_r8.c *** gcc-4.0.2/libgfortran/generated/minloc0_16_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_16_r8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array); + export_proto(minloc0_16_r8); + + void + minloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 minval; + + minval = GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_16_r8 (gfc_array_i16 *, gfc_array_r8 *, gfc_array_l4 *); + export_proto(mminloc0_16_r8); + + void + mminloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 minval; + + minval = GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_4_i16.c gcc-4.1.0/libgfortran/generated/minloc0_4_i16.c *** gcc-4.0.2/libgfortran/generated/minloc0_4_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_4_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void minloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array); + export_proto(minloc0_4_i16); + + void + minloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 minval; + + minval = GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_4_i16 (gfc_array_i4 *, gfc_array_i16 *, gfc_array_l4 *); + export_proto(mminloc0_4_i16); + + void + mminloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 minval; + + minval = GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_4_i4.c gcc-4.1.0/libgfortran/generated/minloc0_4_i4.c *** gcc-4.0.2/libgfortran/generated/minloc0_4_i4.c Fri May 20 22:36:38 2005 --- gcc-4.1.0/libgfortran/generated/minloc0_4_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + extern void minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array); export_proto(minloc0_4_i4); *************** minloc0_4_i4 (gfc_array_i4 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mminloc0_4_i4 (gfc_array_i4 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mminloc0_4_i4 (gfc_array_i4 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_4_i8.c gcc-4.1.0/libgfortran/generated/minloc0_4_i8.c *** gcc-4.0.2/libgfortran/generated/minloc0_4_i8.c Fri May 20 22:36:38 2005 --- gcc-4.1.0/libgfortran/generated/minloc0_4_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + extern void minloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array); export_proto(minloc0_4_i8); *************** minloc0_4_i8 (gfc_array_i4 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mminloc0_4_i8 (gfc_array_i4 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mminloc0_4_i8 (gfc_array_i4 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_4_r10.c gcc-4.1.0/libgfortran/generated/minloc0_4_r10.c *** gcc-4.0.2/libgfortran/generated/minloc0_4_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_4_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + + extern void minloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array); + export_proto(minloc0_4_r10); + + void + minloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_10 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 minval; + + minval = GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_4_r10 (gfc_array_i4 *, gfc_array_r10 *, gfc_array_l4 *); + export_proto(mminloc0_4_r10); + + void + mminloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 minval; + + minval = GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_4_r16.c gcc-4.1.0/libgfortran/generated/minloc0_4_r16.c *** gcc-4.0.2/libgfortran/generated/minloc0_4_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_4_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void minloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array); + export_proto(minloc0_4_r16); + + void + minloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 minval; + + minval = GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_4_r16 (gfc_array_i4 *, gfc_array_r16 *, gfc_array_l4 *); + export_proto(mminloc0_4_r16); + + void + mminloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 minval; + + minval = GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_4_r4.c gcc-4.1.0/libgfortran/generated/minloc0_4_r4.c *** gcc-4.0.2/libgfortran/generated/minloc0_4_r4.c Fri May 20 22:36:38 2005 --- gcc-4.1.0/libgfortran/generated/minloc0_4_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + extern void minloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array); export_proto(minloc0_4_r4); *************** minloc0_4_r4 (gfc_array_i4 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mminloc0_4_r4 (gfc_array_i4 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mminloc0_4_r4 (gfc_array_i4 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_4_r8.c gcc-4.1.0/libgfortran/generated/minloc0_4_r8.c *** gcc-4.0.2/libgfortran/generated/minloc0_4_r8.c Fri May 20 22:36:38 2005 --- gcc-4.1.0/libgfortran/generated/minloc0_4_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + extern void minloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array); export_proto(minloc0_4_r8); *************** minloc0_4_r8 (gfc_array_i4 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mminloc0_4_r8 (gfc_array_i4 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } else *************** mminloc0_4_r8 (gfc_array_i4 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_8_i16.c gcc-4.1.0/libgfortran/generated/minloc0_8_i16.c *** gcc-4.0.2/libgfortran/generated/minloc0_8_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_8_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void minloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array); + export_proto(minloc0_8_i16); + + void + minloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 minval; + + minval = GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_8_i16 (gfc_array_i8 *, gfc_array_i16 *, gfc_array_l4 *); + export_proto(mminloc0_8_i16); + + void + mminloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_16 minval; + + minval = GFC_INTEGER_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_8_i4.c gcc-4.1.0/libgfortran/generated/minloc0_8_i4.c *** gcc-4.0.2/libgfortran/generated/minloc0_8_i4.c Fri May 20 22:36:38 2005 --- gcc-4.1.0/libgfortran/generated/minloc0_8_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + extern void minloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array); export_proto(minloc0_8_i4); *************** minloc0_8_i4 (gfc_array_i8 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mminloc0_8_i4 (gfc_array_i8 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mminloc0_8_i4 (gfc_array_i8 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_8_i8.c gcc-4.1.0/libgfortran/generated/minloc0_8_i8.c *** gcc-4.0.2/libgfortran/generated/minloc0_8_i8.c Fri May 20 22:36:38 2005 --- gcc-4.1.0/libgfortran/generated/minloc0_8_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + extern void minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array); export_proto(minloc0_8_i8); *************** minloc0_8_i8 (gfc_array_i8 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mminloc0_8_i8 (gfc_array_i8 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mminloc0_8_i8 (gfc_array_i8 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_8_r10.c gcc-4.1.0/libgfortran/generated/minloc0_8_r10.c *** gcc-4.0.2/libgfortran/generated/minloc0_8_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_8_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + + extern void minloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array); + export_proto(minloc0_8_r10); + + void + minloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_10 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 minval; + + minval = GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_8_r10 (gfc_array_i8 *, gfc_array_r10 *, gfc_array_l4 *); + export_proto(mminloc0_8_r10); + + void + mminloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_10 minval; + + minval = GFC_REAL_10_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_8_r16.c gcc-4.1.0/libgfortran/generated/minloc0_8_r16.c *** gcc-4.0.2/libgfortran/generated/minloc0_8_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc0_8_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,292 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void minloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array); + export_proto(minloc0_8_r16); + + void + minloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 minval; + + minval = GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } + } + + + extern void mminloc0_8_r16 (gfc_array_i8 *, gfc_array_r16 *, gfc_array_l4 *); + export_proto(mminloc0_8_r16); + + void + mminloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array, + gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_16 minval; + + minval = GFC_REAL_16_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_8_r4.c gcc-4.1.0/libgfortran/generated/minloc0_8_r4.c *** gcc-4.0.2/libgfortran/generated/minloc0_8_r4.c Fri May 20 22:36:38 2005 --- gcc-4.1.0/libgfortran/generated/minloc0_8_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + extern void minloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array); export_proto(minloc0_8_r4); *************** minloc0_8_r4 (gfc_array_i8 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mminloc0_8_r4 (gfc_array_i8 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mminloc0_8_r4 (gfc_array_i8 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc0_8_r8.c gcc-4.1.0/libgfortran/generated/minloc0_8_r8.c *** gcc-4.0.2/libgfortran/generated/minloc0_8_r8.c Fri May 20 22:36:38 2005 --- gcc-4.1.0/libgfortran/generated/minloc0_8_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + extern void minloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array); export_proto(minloc0_8_r8); *************** minloc0_8_r8 (gfc_array_i8 * retarray, g *** 62,68 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 64,70 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mminloc0_8_r8 (gfc_array_i8 * retarray, *** 180,186 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else --- 182,188 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } else *************** mminloc0_8_r8 (gfc_array_i8 * retarray, *** 286,288 **** --- 288,292 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_16_i16.c gcc-4.1.0/libgfortran/generated/minloc1_16_i16.c *** gcc-4.0.2/libgfortran/generated/minloc1_16_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_16_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *); + export_proto(minloc1_16_i16); + + void + minloc1_16_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_16 minval; + minval = GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_16_i16); + + void + mminloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 minval; + minval = GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_16_i4.c gcc-4.1.0/libgfortran/generated/minloc1_16_i4.c *** gcc-4.0.2/libgfortran/generated/minloc1_16_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_16_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *); + export_proto(minloc1_16_i4); + + void + minloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_4 minval; + minval = GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_16_i4); + + void + mminloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 minval; + minval = GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_16_i8.c gcc-4.1.0/libgfortran/generated/minloc1_16_i8.c *** gcc-4.0.2/libgfortran/generated/minloc1_16_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_16_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *); + export_proto(minloc1_16_i8); + + void + minloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_8 minval; + minval = GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_16_i8); + + void + mminloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 minval; + minval = GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_16_r10.c gcc-4.1.0/libgfortran/generated/minloc1_16_r10.c *** gcc-4.0.2/libgfortran/generated/minloc1_16_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_16_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *); + export_proto(minloc1_16_r10); + + void + minloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_10 minval; + minval = GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_16_r10); + + void + mminloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 minval; + minval = GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_16_r16.c gcc-4.1.0/libgfortran/generated/minloc1_16_r16.c *** gcc-4.0.2/libgfortran/generated/minloc1_16_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_16_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *); + export_proto(minloc1_16_r16); + + void + minloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_16 minval; + minval = GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_16_r16); + + void + mminloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 minval; + minval = GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_16_r4.c gcc-4.1.0/libgfortran/generated/minloc1_16_r4.c *** gcc-4.0.2/libgfortran/generated/minloc1_16_r4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_16_r4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *); + export_proto(minloc1_16_r4); + + void + minloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_4 minval; + minval = GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_16_r4); + + void + mminloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 minval; + minval = GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_16_r8.c gcc-4.1.0/libgfortran/generated/minloc1_16_r8.c *** gcc-4.0.2/libgfortran/generated/minloc1_16_r8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_16_r8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + + extern void minloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *); + export_proto(minloc1_16_r8); + + void + minloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_8 minval; + minval = GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_16_r8); + + void + mminloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 minval; + minval = GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_4_i16.c gcc-4.1.0/libgfortran/generated/minloc1_4_i16.c *** gcc-4.0.2/libgfortran/generated/minloc1_4_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_4_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void minloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *); + export_proto(minloc1_4_i16); + + void + minloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_16 minval; + minval = GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_4_i16); + + void + mminloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 minval; + minval = GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_4_i4.c gcc-4.1.0/libgfortran/generated/minloc1_4_i4.c *** gcc-4.0.2/libgfortran/generated/minloc1_4_i4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minloc1_4_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + extern void minloc1_4_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *); export_proto(minloc1_4_i4); *************** minloc1_4_i4 (gfc_array_i4 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_4_i4 (gfc_array_i4 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_4_i4 (gfc_array_i4 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_4_i8.c gcc-4.1.0/libgfortran/generated/minloc1_4_i8.c *** gcc-4.0.2/libgfortran/generated/minloc1_4_i8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minloc1_4_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + + extern void minloc1_4_i8 (gfc_array_i4 *, gfc_array_i8 *, index_type *); export_proto(minloc1_4_i8); *************** minloc1_4_i8 (gfc_array_i4 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_4_i8 (gfc_array_i4 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_4_i8 (gfc_array_i4 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_4_r10.c gcc-4.1.0/libgfortran/generated/minloc1_4_r10.c *** gcc-4.0.2/libgfortran/generated/minloc1_4_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_4_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + + extern void minloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *); + export_proto(minloc1_4_r10); + + void + minloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_10 minval; + minval = GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_4_r10); + + void + mminloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 minval; + minval = GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_4_r16.c gcc-4.1.0/libgfortran/generated/minloc1_4_r16.c *** gcc-4.0.2/libgfortran/generated/minloc1_4_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_4_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + + extern void minloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *); + export_proto(minloc1_4_r16); + + void + minloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_16 minval; + minval = GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_4_r16); + + void + mminloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 minval; + minval = GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_4_r4.c gcc-4.1.0/libgfortran/generated/minloc1_4_r4.c *** gcc-4.0.2/libgfortran/generated/minloc1_4_r4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minloc1_4_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + + extern void minloc1_4_r4 (gfc_array_i4 *, gfc_array_r4 *, index_type *); export_proto(minloc1_4_r4); *************** minloc1_4_r4 (gfc_array_i4 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_4_r4 (gfc_array_i4 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_4_r4 (gfc_array_i4 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_4_r8.c gcc-4.1.0/libgfortran/generated/minloc1_4_r8.c *** gcc-4.0.2/libgfortran/generated/minloc1_4_r8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minloc1_4_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + + extern void minloc1_4_r8 (gfc_array_i4 *, gfc_array_r8 *, index_type *); export_proto(minloc1_4_r8); *************** minloc1_4_r8 (gfc_array_i4 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_4_r8 (gfc_array_i4 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_4_r8 (gfc_array_i4 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_8_i16.c gcc-4.1.0/libgfortran/generated/minloc1_8_i16.c *** gcc-4.0.2/libgfortran/generated/minloc1_8_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_8_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void minloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *); + export_proto(minloc1_8_i16); + + void + minloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_16 minval; + minval = GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_8_i16); + + void + mminloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 minval; + minval = GFC_INTEGER_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_8_i4.c gcc-4.1.0/libgfortran/generated/minloc1_8_i4.c *** gcc-4.0.2/libgfortran/generated/minloc1_8_i4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minloc1_8_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + + extern void minloc1_8_i4 (gfc_array_i8 *, gfc_array_i4 *, index_type *); export_proto(minloc1_8_i4); *************** minloc1_8_i4 (gfc_array_i8 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_8_i4 (gfc_array_i8 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_8_i4 (gfc_array_i8 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_8_i8.c gcc-4.1.0/libgfortran/generated/minloc1_8_i8.c *** gcc-4.0.2/libgfortran/generated/minloc1_8_i8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minloc1_8_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + extern void minloc1_8_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *); export_proto(minloc1_8_i8); *************** minloc1_8_i8 (gfc_array_i8 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_8_i8 (gfc_array_i8 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_8_i8 (gfc_array_i8 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_8_r10.c gcc-4.1.0/libgfortran/generated/minloc1_8_r10.c *** gcc-4.0.2/libgfortran/generated/minloc1_8_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_8_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + + extern void minloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *); + export_proto(minloc1_8_r10); + + void + minloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_10 minval; + minval = GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_8_r10); + + void + mminloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 minval; + minval = GFC_REAL_10_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_8_r16.c gcc-4.1.0/libgfortran/generated/minloc1_8_r16.c *** gcc-4.0.2/libgfortran/generated/minloc1_8_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minloc1_8_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,347 ---- + /* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + + extern void minloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *); + export_proto(minloc1_8_r16); + + void + minloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_16 minval; + minval = GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mminloc1_8_r16); + + void + mminloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 minval; + minval = GFC_REAL_16_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_8_r4.c gcc-4.1.0/libgfortran/generated/minloc1_8_r4.c *** gcc-4.0.2/libgfortran/generated/minloc1_8_r4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minloc1_8_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + + extern void minloc1_8_r4 (gfc_array_i8 *, gfc_array_r4 *, index_type *); export_proto(minloc1_8_r4); *************** minloc1_8_r4 (gfc_array_i8 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_8_r4 (gfc_array_i8 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_8_r4 (gfc_array_i8 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minloc1_8_r8.c gcc-4.1.0/libgfortran/generated/minloc1_8_r8.c *** gcc-4.0.2/libgfortran/generated/minloc1_8_r8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minloc1_8_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + + extern void minloc1_8_r8 (gfc_array_i8 *, gfc_array_r8 *, index_type *); export_proto(minloc1_8_r8); *************** minloc1_8_r8 (gfc_array_i8 *retarray, gf *** 94,100 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 97,103 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_8_r8 (gfc_array_i8 * retarray, *** 245,251 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 248,254 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminloc1_8_r8 (gfc_array_i8 * retarray, *** 341,343 **** --- 344,347 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minval_i16.c gcc-4.1.0/libgfortran/generated/minval_i16.c *** gcc-4.0.2/libgfortran/generated/minval_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minval_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,336 ---- + /* Implementation of the MINVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void minval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *); + export_proto(minval_i16); + + void + minval_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + result = GFC_INTEGER_16_HUGE; + if (len <= 0) + *dest = GFC_INTEGER_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mminval_i16); + + void + mminval_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = GFC_INTEGER_16_HUGE; + if (len <= 0) + *dest = GFC_INTEGER_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minval_i4.c gcc-4.1.0/libgfortran/generated/minval_i4.c *** gcc-4.0.2/libgfortran/generated/minval_i4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minval_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + extern void minval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *); export_proto(minval_i4); *************** minval_i4 (gfc_array_i4 *retarray, gfc_a *** 93,99 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 96,102 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminval_i4 (gfc_array_i4 * retarray, gfc *** 239,245 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 242,248 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminval_i4 (gfc_array_i4 * retarray, gfc *** 330,332 **** --- 333,336 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minval_i8.c gcc-4.1.0/libgfortran/generated/minval_i8.c *** gcc-4.0.2/libgfortran/generated/minval_i8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minval_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + extern void minval_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *); export_proto(minval_i8); *************** minval_i8 (gfc_array_i8 *retarray, gfc_a *** 93,99 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 96,102 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminval_i8 (gfc_array_i8 * retarray, gfc *** 239,245 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 242,248 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminval_i8 (gfc_array_i8 * retarray, gfc *** 330,332 **** --- 333,336 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minval_r10.c gcc-4.1.0/libgfortran/generated/minval_r10.c *** gcc-4.0.2/libgfortran/generated/minval_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minval_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,336 ---- + /* Implementation of the MINVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) + + + extern void minval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *); + export_proto(minval_r10); + + void + minval_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_REAL_10 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_REAL_10 result; + src = base; + { + + result = GFC_REAL_10_HUGE; + if (len <= 0) + *dest = GFC_REAL_10_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mminval_r10); + + void + mminval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_10 result; + src = base; + msrc = mbase; + { + + result = GFC_REAL_10_HUGE; + if (len <= 0) + *dest = GFC_REAL_10_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minval_r16.c gcc-4.1.0/libgfortran/generated/minval_r16.c *** gcc-4.0.2/libgfortran/generated/minval_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/minval_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,336 ---- + /* Implementation of the MINVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) + + + extern void minval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *); + export_proto(minval_r16); + + void + minval_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_REAL_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_REAL_16 result; + src = base; + { + + result = GFC_REAL_16_HUGE; + if (len <= 0) + *dest = GFC_REAL_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mminval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mminval_r16); + + void + mminval_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_16 result; + src = base; + msrc = mbase; + { + + result = GFC_REAL_16_HUGE; + if (len <= 0) + *dest = GFC_REAL_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minval_r4.c gcc-4.1.0/libgfortran/generated/minval_r4.c *** gcc-4.0.2/libgfortran/generated/minval_r4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minval_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) + + extern void minval_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *); export_proto(minval_r4); *************** minval_r4 (gfc_array_r4 *retarray, gfc_a *** 93,99 **** = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 96,102 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminval_r4 (gfc_array_r4 * retarray, gfc *** 239,245 **** = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 242,248 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminval_r4 (gfc_array_r4 * retarray, gfc *** 330,332 **** --- 333,336 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/minval_r8.c gcc-4.1.0/libgfortran/generated/minval_r8.c *** gcc-4.0.2/libgfortran/generated/minval_r8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/minval_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) + + extern void minval_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *); export_proto(minval_r8); *************** minval_r8 (gfc_array_r8 *retarray, gfc_a *** 93,99 **** = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 96,102 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminval_r8 (gfc_array_r8 * retarray, gfc *** 239,245 **** = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 242,248 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mminval_r8 (gfc_array_r8 * retarray, gfc *** 330,332 **** --- 333,336 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/nearest_r10.c gcc-4.1.0/libgfortran/generated/nearest_r10.c *** gcc-4.0.2/libgfortran/generated/nearest_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/nearest_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,56 ---- + /* Implementation of the NEAREST intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_COPYSIGNL) && defined (HAVE_NEXTAFTERL) + + extern GFC_REAL_10 nearest_r10 (GFC_REAL_10 s, GFC_REAL_10 dir); + export_proto(nearest_r10); + + GFC_REAL_10 + nearest_r10 (GFC_REAL_10 s, GFC_REAL_10 dir) + { + dir = copysignl (__builtin_infl (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile GFC_REAL_10 r = nextafterl (s, dir); + return r; + } + else + return nextafterl (s, dir); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/nearest_r16.c gcc-4.1.0/libgfortran/generated/nearest_r16.c *** gcc-4.0.2/libgfortran/generated/nearest_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/nearest_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,56 ---- + /* Implementation of the NEAREST intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_COPYSIGNL) && defined (HAVE_NEXTAFTERL) + + extern GFC_REAL_16 nearest_r16 (GFC_REAL_16 s, GFC_REAL_16 dir); + export_proto(nearest_r16); + + GFC_REAL_16 + nearest_r16 (GFC_REAL_16 s, GFC_REAL_16 dir) + { + dir = copysignl (__builtin_infl (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile GFC_REAL_16 r = nextafterl (s, dir); + return r; + } + else + return nextafterl (s, dir); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/nearest_r4.c gcc-4.1.0/libgfortran/generated/nearest_r4.c *** gcc-4.0.2/libgfortran/generated/nearest_r4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/nearest_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include #include "libgfortran.h" extern GFC_REAL_4 nearest_r4 (GFC_REAL_4 s, GFC_REAL_4 dir); export_proto(nearest_r4); --- 25,41 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_COPYSIGNF) && defined (HAVE_NEXTAFTERF) + extern GFC_REAL_4 nearest_r4 (GFC_REAL_4 s, GFC_REAL_4 dir); export_proto(nearest_r4); *************** nearest_r4 (GFC_REAL_4 s, GFC_REAL_4 dir *** 48,50 **** --- 52,56 ---- else return nextafterf (s, dir); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/nearest_r8.c gcc-4.1.0/libgfortran/generated/nearest_r8.c *** gcc-4.0.2/libgfortran/generated/nearest_r8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/nearest_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include #include "libgfortran.h" extern GFC_REAL_8 nearest_r8 (GFC_REAL_8 s, GFC_REAL_8 dir); export_proto(nearest_r8); --- 25,41 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_COPYSIGN) && defined (HAVE_NEXTAFTER) + extern GFC_REAL_8 nearest_r8 (GFC_REAL_8 s, GFC_REAL_8 dir); export_proto(nearest_r8); *************** nearest_r8 (GFC_REAL_8 s, GFC_REAL_8 dir *** 48,50 **** --- 52,56 ---- else return nextafter (s, dir); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c10_i16.c gcc-4.1.0/libgfortran/generated/pow_c10_i16.c *** gcc-4.0.2/libgfortran/generated/pow_c10_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_c10_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_16) + + GFC_COMPLEX_10 pow_c10_i16 (GFC_COMPLEX_10 a, GFC_INTEGER_16 b); + export_proto(pow_c10_i16); + + GFC_COMPLEX_10 + pow_c10_i16 (GFC_COMPLEX_10 a, GFC_INTEGER_16 b) + { + GFC_COMPLEX_10 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c10_i4.c gcc-4.1.0/libgfortran/generated/pow_c10_i4.c *** gcc-4.0.2/libgfortran/generated/pow_c10_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_c10_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_4) + + GFC_COMPLEX_10 pow_c10_i4 (GFC_COMPLEX_10 a, GFC_INTEGER_4 b); + export_proto(pow_c10_i4); + + GFC_COMPLEX_10 + pow_c10_i4 (GFC_COMPLEX_10 a, GFC_INTEGER_4 b) + { + GFC_COMPLEX_10 pow, x; + GFC_INTEGER_4 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c10_i8.c gcc-4.1.0/libgfortran/generated/pow_c10_i8.c *** gcc-4.0.2/libgfortran/generated/pow_c10_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_c10_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_8) + + GFC_COMPLEX_10 pow_c10_i8 (GFC_COMPLEX_10 a, GFC_INTEGER_8 b); + export_proto(pow_c10_i8); + + GFC_COMPLEX_10 + pow_c10_i8 (GFC_COMPLEX_10 a, GFC_INTEGER_8 b) + { + GFC_COMPLEX_10 pow, x; + GFC_INTEGER_8 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c16_i16.c gcc-4.1.0/libgfortran/generated/pow_c16_i16.c *** gcc-4.0.2/libgfortran/generated/pow_c16_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_c16_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_16) + + GFC_COMPLEX_16 pow_c16_i16 (GFC_COMPLEX_16 a, GFC_INTEGER_16 b); + export_proto(pow_c16_i16); + + GFC_COMPLEX_16 + pow_c16_i16 (GFC_COMPLEX_16 a, GFC_INTEGER_16 b) + { + GFC_COMPLEX_16 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c16_i4.c gcc-4.1.0/libgfortran/generated/pow_c16_i4.c *** gcc-4.0.2/libgfortran/generated/pow_c16_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_c16_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_4) + + GFC_COMPLEX_16 pow_c16_i4 (GFC_COMPLEX_16 a, GFC_INTEGER_4 b); + export_proto(pow_c16_i4); + + GFC_COMPLEX_16 + pow_c16_i4 (GFC_COMPLEX_16 a, GFC_INTEGER_4 b) + { + GFC_COMPLEX_16 pow, x; + GFC_INTEGER_4 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c16_i8.c gcc-4.1.0/libgfortran/generated/pow_c16_i8.c *** gcc-4.0.2/libgfortran/generated/pow_c16_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_c16_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_8) + + GFC_COMPLEX_16 pow_c16_i8 (GFC_COMPLEX_16 a, GFC_INTEGER_8 b); + export_proto(pow_c16_i8); + + GFC_COMPLEX_16 + pow_c16_i8 (GFC_COMPLEX_16 a, GFC_INTEGER_8 b) + { + GFC_COMPLEX_16 pow, x; + GFC_INTEGER_8 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c4_i16.c gcc-4.1.0/libgfortran/generated/pow_c4_i16.c *** gcc-4.0.2/libgfortran/generated/pow_c4_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_c4_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_16) + + GFC_COMPLEX_4 pow_c4_i16 (GFC_COMPLEX_4 a, GFC_INTEGER_16 b); + export_proto(pow_c4_i16); + + GFC_COMPLEX_4 + pow_c4_i16 (GFC_COMPLEX_4 a, GFC_INTEGER_16 b) + { + GFC_COMPLEX_4 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c4_i4.c gcc-4.1.0/libgfortran/generated/pow_c4_i4.c *** gcc-4.0.2/libgfortran/generated/pow_c4_i4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_c4_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_4) + GFC_COMPLEX_4 pow_c4_i4 (GFC_COMPLEX_4 a, GFC_INTEGER_4 b); export_proto(pow_c4_i4); *************** pow_c4_i4 (GFC_COMPLEX_4 a, GFC_INTEGER_ *** 70,72 **** --- 72,76 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c4_i8.c gcc-4.1.0/libgfortran/generated/pow_c4_i8.c *** gcc-4.0.2/libgfortran/generated/pow_c4_i8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_c4_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_8) + GFC_COMPLEX_4 pow_c4_i8 (GFC_COMPLEX_4 a, GFC_INTEGER_8 b); export_proto(pow_c4_i8); *************** pow_c4_i8 (GFC_COMPLEX_4 a, GFC_INTEGER_ *** 70,72 **** --- 72,76 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c8_i16.c gcc-4.1.0/libgfortran/generated/pow_c8_i16.c *** gcc-4.0.2/libgfortran/generated/pow_c8_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_c8_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_16) + + GFC_COMPLEX_8 pow_c8_i16 (GFC_COMPLEX_8 a, GFC_INTEGER_16 b); + export_proto(pow_c8_i16); + + GFC_COMPLEX_8 + pow_c8_i16 (GFC_COMPLEX_8 a, GFC_INTEGER_16 b) + { + GFC_COMPLEX_8 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c8_i4.c gcc-4.1.0/libgfortran/generated/pow_c8_i4.c *** gcc-4.0.2/libgfortran/generated/pow_c8_i4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_c8_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_4) + GFC_COMPLEX_8 pow_c8_i4 (GFC_COMPLEX_8 a, GFC_INTEGER_4 b); export_proto(pow_c8_i4); *************** pow_c8_i4 (GFC_COMPLEX_8 a, GFC_INTEGER_ *** 70,72 **** --- 72,76 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_c8_i8.c gcc-4.1.0/libgfortran/generated/pow_c8_i8.c *** gcc-4.0.2/libgfortran/generated/pow_c8_i8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_c8_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_8) + GFC_COMPLEX_8 pow_c8_i8 (GFC_COMPLEX_8 a, GFC_INTEGER_8 b); export_proto(pow_c8_i8); *************** pow_c8_i8 (GFC_COMPLEX_8 a, GFC_INTEGER_ *** 70,72 **** --- 72,76 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i16_i16.c gcc-4.1.0/libgfortran/generated/pow_i16_i16.c *** gcc-4.0.2/libgfortran/generated/pow_i16_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_i16_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,78 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + GFC_INTEGER_16 pow_i16_i16 (GFC_INTEGER_16 a, GFC_INTEGER_16 b); + export_proto(pow_i16_i16); + + GFC_INTEGER_16 + pow_i16_i16 (GFC_INTEGER_16 a, GFC_INTEGER_16 b) + { + GFC_INTEGER_16 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + if (x == 1) + return 1; + if (x == -1) + return (n & 1) ? -1 : 1; + return (x == 0) ? 1 / x : 0; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i16_i4.c gcc-4.1.0/libgfortran/generated/pow_i16_i4.c *** gcc-4.0.2/libgfortran/generated/pow_i16_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_i16_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,78 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + GFC_INTEGER_16 pow_i16_i4 (GFC_INTEGER_16 a, GFC_INTEGER_4 b); + export_proto(pow_i16_i4); + + GFC_INTEGER_16 + pow_i16_i4 (GFC_INTEGER_16 a, GFC_INTEGER_4 b) + { + GFC_INTEGER_16 pow, x; + GFC_INTEGER_4 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + if (x == 1) + return 1; + if (x == -1) + return (n & 1) ? -1 : 1; + return (x == 0) ? 1 / x : 0; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i16_i8.c gcc-4.1.0/libgfortran/generated/pow_i16_i8.c *** gcc-4.0.2/libgfortran/generated/pow_i16_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_i16_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,78 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + GFC_INTEGER_16 pow_i16_i8 (GFC_INTEGER_16 a, GFC_INTEGER_8 b); + export_proto(pow_i16_i8); + + GFC_INTEGER_16 + pow_i16_i8 (GFC_INTEGER_16 a, GFC_INTEGER_8 b) + { + GFC_INTEGER_16 pow, x; + GFC_INTEGER_8 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + if (x == 1) + return 1; + if (x == -1) + return (n & 1) ? -1 : 1; + return (x == 0) ? 1 / x : 0; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i4_i16.c gcc-4.1.0/libgfortran/generated/pow_i4_i16.c *** gcc-4.0.2/libgfortran/generated/pow_i4_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_i4_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,78 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + GFC_INTEGER_4 pow_i4_i16 (GFC_INTEGER_4 a, GFC_INTEGER_16 b); + export_proto(pow_i4_i16); + + GFC_INTEGER_4 + pow_i4_i16 (GFC_INTEGER_4 a, GFC_INTEGER_16 b) + { + GFC_INTEGER_4 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + if (x == 1) + return 1; + if (x == -1) + return (n & 1) ? -1 : 1; + return (x == 0) ? 1 / x : 0; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i4_i4.c gcc-4.1.0/libgfortran/generated/pow_i4_i4.c *** gcc-4.0.2/libgfortran/generated/pow_i4_i4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_i4_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + GFC_INTEGER_4 pow_i4_i4 (GFC_INTEGER_4 a, GFC_INTEGER_4 b); export_proto(pow_i4_i4); *************** pow_i4_i4 (GFC_INTEGER_4 a, GFC_INTEGER_ *** 72,74 **** --- 74,78 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i4_i8.c gcc-4.1.0/libgfortran/generated/pow_i4_i8.c *** gcc-4.0.2/libgfortran/generated/pow_i4_i8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_i4_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + GFC_INTEGER_4 pow_i4_i8 (GFC_INTEGER_4 a, GFC_INTEGER_8 b); export_proto(pow_i4_i8); *************** pow_i4_i8 (GFC_INTEGER_4 a, GFC_INTEGER_ *** 72,74 **** --- 74,78 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i8_i16.c gcc-4.1.0/libgfortran/generated/pow_i8_i16.c *** gcc-4.0.2/libgfortran/generated/pow_i8_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_i8_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,78 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + GFC_INTEGER_8 pow_i8_i16 (GFC_INTEGER_8 a, GFC_INTEGER_16 b); + export_proto(pow_i8_i16); + + GFC_INTEGER_8 + pow_i8_i16 (GFC_INTEGER_8 a, GFC_INTEGER_16 b) + { + GFC_INTEGER_8 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + if (x == 1) + return 1; + if (x == -1) + return (n & 1) ? -1 : 1; + return (x == 0) ? 1 / x : 0; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i8_i4.c gcc-4.1.0/libgfortran/generated/pow_i8_i4.c *** gcc-4.0.2/libgfortran/generated/pow_i8_i4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_i8_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + GFC_INTEGER_8 pow_i8_i4 (GFC_INTEGER_8 a, GFC_INTEGER_4 b); export_proto(pow_i8_i4); *************** pow_i8_i4 (GFC_INTEGER_8 a, GFC_INTEGER_ *** 72,74 **** --- 74,78 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_i8_i8.c gcc-4.1.0/libgfortran/generated/pow_i8_i8.c *** gcc-4.0.2/libgfortran/generated/pow_i8_i8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_i8_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + GFC_INTEGER_8 pow_i8_i8 (GFC_INTEGER_8 a, GFC_INTEGER_8 b); export_proto(pow_i8_i8); *************** pow_i8_i8 (GFC_INTEGER_8 a, GFC_INTEGER_ *** 72,74 **** --- 74,78 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r10_i16.c gcc-4.1.0/libgfortran/generated/pow_r10_i16.c *** gcc-4.0.2/libgfortran/generated/pow_r10_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_r10_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + GFC_REAL_10 pow_r10_i16 (GFC_REAL_10 a, GFC_INTEGER_16 b); + export_proto(pow_r10_i16); + + GFC_REAL_10 + pow_r10_i16 (GFC_REAL_10 a, GFC_INTEGER_16 b) + { + GFC_REAL_10 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r10_i4.c gcc-4.1.0/libgfortran/generated/pow_r10_i4.c *** gcc-4.0.2/libgfortran/generated/pow_r10_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_r10_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + GFC_REAL_10 pow_r10_i4 (GFC_REAL_10 a, GFC_INTEGER_4 b); + export_proto(pow_r10_i4); + + GFC_REAL_10 + pow_r10_i4 (GFC_REAL_10 a, GFC_INTEGER_4 b) + { + GFC_REAL_10 pow, x; + GFC_INTEGER_4 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r10_i8.c gcc-4.1.0/libgfortran/generated/pow_r10_i8.c *** gcc-4.0.2/libgfortran/generated/pow_r10_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_r10_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + GFC_REAL_10 pow_r10_i8 (GFC_REAL_10 a, GFC_INTEGER_8 b); + export_proto(pow_r10_i8); + + GFC_REAL_10 + pow_r10_i8 (GFC_REAL_10 a, GFC_INTEGER_8 b) + { + GFC_REAL_10 pow, x; + GFC_INTEGER_8 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r16_i16.c gcc-4.1.0/libgfortran/generated/pow_r16_i16.c *** gcc-4.0.2/libgfortran/generated/pow_r16_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_r16_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + GFC_REAL_16 pow_r16_i16 (GFC_REAL_16 a, GFC_INTEGER_16 b); + export_proto(pow_r16_i16); + + GFC_REAL_16 + pow_r16_i16 (GFC_REAL_16 a, GFC_INTEGER_16 b) + { + GFC_REAL_16 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r16_i4.c gcc-4.1.0/libgfortran/generated/pow_r16_i4.c *** gcc-4.0.2/libgfortran/generated/pow_r16_i4.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_r16_i4.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + GFC_REAL_16 pow_r16_i4 (GFC_REAL_16 a, GFC_INTEGER_4 b); + export_proto(pow_r16_i4); + + GFC_REAL_16 + pow_r16_i4 (GFC_REAL_16 a, GFC_INTEGER_4 b) + { + GFC_REAL_16 pow, x; + GFC_INTEGER_4 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r16_i8.c gcc-4.1.0/libgfortran/generated/pow_r16_i8.c *** gcc-4.0.2/libgfortran/generated/pow_r16_i8.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_r16_i8.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + GFC_REAL_16 pow_r16_i8 (GFC_REAL_16 a, GFC_INTEGER_8 b); + export_proto(pow_r16_i8); + + GFC_REAL_16 + pow_r16_i8 (GFC_REAL_16 a, GFC_INTEGER_8 b) + { + GFC_REAL_16 pow, x; + GFC_INTEGER_8 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r4_i16.c gcc-4.1.0/libgfortran/generated/pow_r4_i16.c *** gcc-4.0.2/libgfortran/generated/pow_r4_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_r4_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + GFC_REAL_4 pow_r4_i16 (GFC_REAL_4 a, GFC_INTEGER_16 b); + export_proto(pow_r4_i16); + + GFC_REAL_4 + pow_r4_i16 (GFC_REAL_4 a, GFC_INTEGER_16 b) + { + GFC_REAL_4 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r4_i4.c gcc-4.1.0/libgfortran/generated/pow_r4_i4.c *** gcc-4.0.2/libgfortran/generated/pow_r4_i4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_r4_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + GFC_REAL_4 pow_r4_i4 (GFC_REAL_4 a, GFC_INTEGER_4 b); export_proto(pow_r4_i4); *************** pow_r4_i4 (GFC_REAL_4 a, GFC_INTEGER_4 b *** 70,72 **** --- 72,76 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r4_i8.c gcc-4.1.0/libgfortran/generated/pow_r4_i8.c *** gcc-4.0.2/libgfortran/generated/pow_r4_i8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_r4_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + GFC_REAL_4 pow_r4_i8 (GFC_REAL_4 a, GFC_INTEGER_8 b); export_proto(pow_r4_i8); *************** pow_r4_i8 (GFC_REAL_4 a, GFC_INTEGER_8 b *** 70,72 **** --- 72,76 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r8_i16.c gcc-4.1.0/libgfortran/generated/pow_r8_i16.c *** gcc-4.0.2/libgfortran/generated/pow_r8_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/pow_r8_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,76 ---- + /* Support routines for the intrinsic power (**) operator. + Copyright 2004 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + /* Use Binary Method to calculate the powi. This is not an optimal but + a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of + Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art + of Computer Programming", 3rd Edition, 1998. */ + + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + GFC_REAL_8 pow_r8_i16 (GFC_REAL_8 a, GFC_INTEGER_16 b); + export_proto(pow_r8_i16); + + GFC_REAL_8 + pow_r8_i16 (GFC_REAL_8 a, GFC_INTEGER_16 b) + { + GFC_REAL_8 pow, x; + GFC_INTEGER_16 n, u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + n = -n; + x = pow / x; + } + u = n; + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r8_i4.c gcc-4.1.0/libgfortran/generated/pow_r8_i4.c *** gcc-4.0.2/libgfortran/generated/pow_r8_i4.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_r8_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + GFC_REAL_8 pow_r8_i4 (GFC_REAL_8 a, GFC_INTEGER_4 b); export_proto(pow_r8_i4); *************** pow_r8_i4 (GFC_REAL_8 a, GFC_INTEGER_4 b *** 70,72 **** --- 72,76 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/pow_r8_i8.c gcc-4.1.0/libgfortran/generated/pow_r8_i8.c *** gcc-4.0.2/libgfortran/generated/pow_r8_i8.c Wed Jan 12 21:27:32 2005 --- gcc-4.1.0/libgfortran/generated/pow_r8_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,43 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + GFC_REAL_8 pow_r8_i8 (GFC_REAL_8 a, GFC_INTEGER_8 b); export_proto(pow_r8_i8); *************** pow_r8_i8 (GFC_REAL_8 a, GFC_INTEGER_8 b *** 70,72 **** --- 72,76 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_c10.c gcc-4.1.0/libgfortran/generated/product_c10.c *** gcc-4.0.2/libgfortran/generated/product_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/product_c10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_COMPLEX_10) + + + extern void product_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *); + export_proto(product_c10); + + void + product_c10 (gfc_array_c10 *retarray, gfc_array_c10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_10 *base; + GFC_COMPLEX_10 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_COMPLEX_10 *src; + GFC_COMPLEX_10 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mproduct_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *, + gfc_array_l4 *); + export_proto(mproduct_c10); + + void + mproduct_c10 (gfc_array_c10 * retarray, gfc_array_c10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_10 *dest; + GFC_COMPLEX_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_COMPLEX_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_COMPLEX_10 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_c16.c gcc-4.1.0/libgfortran/generated/product_c16.c *** gcc-4.0.2/libgfortran/generated/product_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/product_c16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16) + + + extern void product_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *); + export_proto(product_c16); + + void + product_c16 (gfc_array_c16 *retarray, gfc_array_c16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_16 *base; + GFC_COMPLEX_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_COMPLEX_16 *src; + GFC_COMPLEX_16 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mproduct_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *, + gfc_array_l4 *); + export_proto(mproduct_c16); + + void + mproduct_c16 (gfc_array_c16 * retarray, gfc_array_c16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_16 *dest; + GFC_COMPLEX_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_COMPLEX_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_COMPLEX_16 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_c4.c gcc-4.1.0/libgfortran/generated/product_c4.c *** gcc-4.0.2/libgfortran/generated/product_c4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/product_c4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_COMPLEX_4) + + extern void product_c4 (gfc_array_c4 *, gfc_array_c4 *, index_type *); export_proto(product_c4); *************** product_c4 (gfc_array_c4 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_c4 (gfc_array_c4 * retarray, gf *** 237,243 **** = internal_malloc_size (sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_c4 (gfc_array_c4 * retarray, gf *** 328,330 **** --- 331,334 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_c8.c gcc-4.1.0/libgfortran/generated/product_c8.c *** gcc-4.0.2/libgfortran/generated/product_c8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/product_c8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_COMPLEX_8) + + extern void product_c8 (gfc_array_c8 *, gfc_array_c8 *, index_type *); export_proto(product_c8); *************** product_c8 (gfc_array_c8 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_c8 (gfc_array_c8 * retarray, gf *** 237,243 **** = internal_malloc_size (sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_c8 (gfc_array_c8 * retarray, gf *** 328,330 **** --- 331,334 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_i16.c gcc-4.1.0/libgfortran/generated/product_i16.c *** gcc-4.0.2/libgfortran/generated/product_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/product_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void product_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *); + export_proto(product_i16); + + void + product_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mproduct_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(mproduct_i16); + + void + mproduct_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_i4.c gcc-4.1.0/libgfortran/generated/product_i4.c *** gcc-4.0.2/libgfortran/generated/product_i4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/product_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + extern void product_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *); export_proto(product_i4); *************** product_i4 (gfc_array_i4 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_i4 (gfc_array_i4 * retarray, gf *** 237,243 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_i4 (gfc_array_i4 * retarray, gf *** 328,330 **** --- 331,334 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_i8.c gcc-4.1.0/libgfortran/generated/product_i8.c *** gcc-4.0.2/libgfortran/generated/product_i8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/product_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + extern void product_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *); export_proto(product_i8); *************** product_i8 (gfc_array_i8 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_i8 (gfc_array_i8 * retarray, gf *** 237,243 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_i8 (gfc_array_i8 * retarray, gf *** 328,330 **** --- 331,334 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_r10.c gcc-4.1.0/libgfortran/generated/product_r10.c *** gcc-4.0.2/libgfortran/generated/product_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/product_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) + + + extern void product_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *); + export_proto(product_r10); + + void + product_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_REAL_10 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_REAL_10 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mproduct_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(mproduct_r10); + + void + mproduct_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_10 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_r16.c gcc-4.1.0/libgfortran/generated/product_r16.c *** gcc-4.0.2/libgfortran/generated/product_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/product_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) + + + extern void product_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *); + export_proto(product_r16); + + void + product_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_REAL_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_REAL_16 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void mproduct_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(mproduct_r16); + + void + mproduct_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_16 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_r4.c gcc-4.1.0/libgfortran/generated/product_r4.c *** gcc-4.0.2/libgfortran/generated/product_r4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/product_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) + + extern void product_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *); export_proto(product_r4); *************** product_r4 (gfc_array_r4 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_r4 (gfc_array_r4 * retarray, gf *** 237,243 **** = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_r4 (gfc_array_r4 * retarray, gf *** 328,330 **** --- 331,334 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/product_r8.c gcc-4.1.0/libgfortran/generated/product_r8.c *** gcc-4.0.2/libgfortran/generated/product_r8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/product_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) + + extern void product_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *); export_proto(product_r8); *************** product_r8 (gfc_array_r8 *retarray, gfc_ *** 92,98 **** = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_r8 (gfc_array_r8 * retarray, gf *** 237,243 **** = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** mproduct_r8 (gfc_array_r8 * retarray, gf *** 328,330 **** --- 331,334 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/reshape_c10.c gcc-4.1.0/libgfortran/generated/reshape_c10.c *** gcc-4.0.2/libgfortran/generated/reshape_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/reshape_c10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,262 ---- + /* Implementation of the RESHAPE + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_10) + + typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + /* The shape parameter is ignored. We can currently deduce the shape from the + return array. */ + + extern void reshape_c10 (gfc_array_c10 *, gfc_array_c10 *, shape_type *, + gfc_array_c10 *, shape_type *); + export_proto(reshape_c10); + + void + reshape_c10 (gfc_array_c10 * ret, gfc_array_c10 * source, shape_type * shape, + gfc_array_c10 * pad, shape_type * order) + { + /* r.* indicates the return array. */ + index_type rcount[GFC_MAX_DIMENSIONS]; + index_type rextent[GFC_MAX_DIMENSIONS]; + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdim; + index_type rsize; + index_type rs; + index_type rex; + GFC_COMPLEX_10 *rptr; + /* s.* indicates the source array. */ + index_type scount[GFC_MAX_DIMENSIONS]; + index_type sextent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type sdim; + index_type ssize; + const GFC_COMPLEX_10 *sptr; + /* p.* indicates the pad array. */ + index_type pcount[GFC_MAX_DIMENSIONS]; + index_type pextent[GFC_MAX_DIMENSIONS]; + index_type pstride[GFC_MAX_DIMENSIONS]; + index_type pdim; + index_type psize; + const GFC_COMPLEX_10 *pptr; + + const GFC_COMPLEX_10 *src; + int n; + int dim; + + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + if (shape->dim[0].stride == 0) + shape->dim[0].stride = 1; + if (pad && pad->dim[0].stride == 0) + pad->dim[0].stride = 1; + if (order && order->dim[0].stride == 0) + order->dim[0].stride = 1; + + if (ret->data == NULL) + { + rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rs = 1; + for (n=0; n < rdim; n++) + { + ret->dim[n].lbound = 0; + rex = shape->data[n * shape->dim[0].stride]; + ret->dim[n].ubound = rex - 1; + ret->dim[n].stride = rs; + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_10)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + else + { + rdim = GFC_DESCRIPTOR_RANK (ret); + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * order->dim[0].stride] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = ret->dim[dim].stride; + rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + + if (rextent[n] != shape->data[dim * shape->dim[0].stride]) + runtime_error ("shape and target do not conform"); + + if (rsize == rstride[n]) + rsize *= rextent[n]; + else + rsize = 0; + if (rextent[n] <= 0) + return; + } + + sdim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = source->dim[n].stride; + sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (sextent[n] <= 0) + abort (); + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + abort (); + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pptr = NULL; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_COMPLEX_10); + ssize *= sizeof (GFC_COMPLEX_10); + psize *= sizeof (GFC_COMPLEX_10); + reshape_packed ((char *)ret->data, rsize, (char *)source->data, + ssize, pad ? (char *)pad->data : NULL, psize); + return; + } + rptr = ret->data; + src = sptr = source->data; + rstride0 = rstride[0]; + sstride0 = sstride[0]; + + while (rptr) + { + /* Select between the source and pad arrays. */ + *rptr = *src; + /* Advance to the next element. */ + rptr += rstride0; + src += sstride0; + rcount[0]++; + scount[0]++; + /* Advance to the next destination element. */ + n = 0; + while (rcount[n] == rextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + rcount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * rextent[n]; + n++; + if (n == rdim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + rcount[n]++; + rptr += rstride[n]; + } + } + /* Advance to the next source element. */ + n = 0; + while (scount[n] == sextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + scount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= sstride[n] * sextent[n]; + n++; + if (n == sdim) + { + if (sptr && pad) + { + /* Switch to the pad array. */ + sptr = NULL; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = sstride[0]; + } + } + /* We now start again from the beginning of the pad array. */ + src = pptr; + break; + } + else + { + scount[n]++; + src += sstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/reshape_c16.c gcc-4.1.0/libgfortran/generated/reshape_c16.c *** gcc-4.0.2/libgfortran/generated/reshape_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/reshape_c16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,262 ---- + /* Implementation of the RESHAPE + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_16) + + typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + /* The shape parameter is ignored. We can currently deduce the shape from the + return array. */ + + extern void reshape_c16 (gfc_array_c16 *, gfc_array_c16 *, shape_type *, + gfc_array_c16 *, shape_type *); + export_proto(reshape_c16); + + void + reshape_c16 (gfc_array_c16 * ret, gfc_array_c16 * source, shape_type * shape, + gfc_array_c16 * pad, shape_type * order) + { + /* r.* indicates the return array. */ + index_type rcount[GFC_MAX_DIMENSIONS]; + index_type rextent[GFC_MAX_DIMENSIONS]; + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdim; + index_type rsize; + index_type rs; + index_type rex; + GFC_COMPLEX_16 *rptr; + /* s.* indicates the source array. */ + index_type scount[GFC_MAX_DIMENSIONS]; + index_type sextent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type sdim; + index_type ssize; + const GFC_COMPLEX_16 *sptr; + /* p.* indicates the pad array. */ + index_type pcount[GFC_MAX_DIMENSIONS]; + index_type pextent[GFC_MAX_DIMENSIONS]; + index_type pstride[GFC_MAX_DIMENSIONS]; + index_type pdim; + index_type psize; + const GFC_COMPLEX_16 *pptr; + + const GFC_COMPLEX_16 *src; + int n; + int dim; + + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + if (shape->dim[0].stride == 0) + shape->dim[0].stride = 1; + if (pad && pad->dim[0].stride == 0) + pad->dim[0].stride = 1; + if (order && order->dim[0].stride == 0) + order->dim[0].stride = 1; + + if (ret->data == NULL) + { + rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rs = 1; + for (n=0; n < rdim; n++) + { + ret->dim[n].lbound = 0; + rex = shape->data[n * shape->dim[0].stride]; + ret->dim[n].ubound = rex - 1; + ret->dim[n].stride = rs; + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_16)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + else + { + rdim = GFC_DESCRIPTOR_RANK (ret); + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * order->dim[0].stride] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = ret->dim[dim].stride; + rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + + if (rextent[n] != shape->data[dim * shape->dim[0].stride]) + runtime_error ("shape and target do not conform"); + + if (rsize == rstride[n]) + rsize *= rextent[n]; + else + rsize = 0; + if (rextent[n] <= 0) + return; + } + + sdim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = source->dim[n].stride; + sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (sextent[n] <= 0) + abort (); + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + abort (); + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pptr = NULL; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_COMPLEX_16); + ssize *= sizeof (GFC_COMPLEX_16); + psize *= sizeof (GFC_COMPLEX_16); + reshape_packed ((char *)ret->data, rsize, (char *)source->data, + ssize, pad ? (char *)pad->data : NULL, psize); + return; + } + rptr = ret->data; + src = sptr = source->data; + rstride0 = rstride[0]; + sstride0 = sstride[0]; + + while (rptr) + { + /* Select between the source and pad arrays. */ + *rptr = *src; + /* Advance to the next element. */ + rptr += rstride0; + src += sstride0; + rcount[0]++; + scount[0]++; + /* Advance to the next destination element. */ + n = 0; + while (rcount[n] == rextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + rcount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * rextent[n]; + n++; + if (n == rdim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + rcount[n]++; + rptr += rstride[n]; + } + } + /* Advance to the next source element. */ + n = 0; + while (scount[n] == sextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + scount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= sstride[n] * sextent[n]; + n++; + if (n == sdim) + { + if (sptr && pad) + { + /* Switch to the pad array. */ + sptr = NULL; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = sstride[0]; + } + } + /* We now start again from the beginning of the pad array. */ + src = pptr; + break; + } + else + { + scount[n]++; + src += sstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/reshape_c4.c gcc-4.1.0/libgfortran/generated/reshape_c4.c *** gcc-4.0.2/libgfortran/generated/reshape_c4.c Sun Jul 17 19:12:00 2005 --- gcc-4.1.0/libgfortran/generated/reshape_c4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_4) + typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the *************** reshape_c4 (gfc_array_c4 * ret, gfc_arra *** 97,103 **** ret->dim[n].stride = rs; rs *= rex; } ! ret->base = 0; ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } --- 99,105 ---- ret->dim[n].stride = rs; rs *= rex; } ! ret->offset = 0; ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } *************** reshape_c4 (gfc_array_c4 * ret, gfc_arra *** 256,258 **** --- 258,262 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/reshape_c8.c gcc-4.1.0/libgfortran/generated/reshape_c8.c *** gcc-4.0.2/libgfortran/generated/reshape_c8.c Sun Jul 17 19:12:00 2005 --- gcc-4.1.0/libgfortran/generated/reshape_c8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_8) + typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the *************** reshape_c8 (gfc_array_c8 * ret, gfc_arra *** 97,103 **** ret->dim[n].stride = rs; rs *= rex; } ! ret->base = 0; ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } --- 99,105 ---- ret->dim[n].stride = rs; rs *= rex; } ! ret->offset = 0; ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } *************** reshape_c8 (gfc_array_c8 * ret, gfc_arra *** 256,258 **** --- 258,262 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/reshape_i16.c gcc-4.1.0/libgfortran/generated/reshape_i16.c *** gcc-4.0.2/libgfortran/generated/reshape_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/reshape_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,262 ---- + /* Implementation of the RESHAPE + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + /* The shape parameter is ignored. We can currently deduce the shape from the + return array. */ + + extern void reshape_16 (gfc_array_i16 *, gfc_array_i16 *, shape_type *, + gfc_array_i16 *, shape_type *); + export_proto(reshape_16); + + void + reshape_16 (gfc_array_i16 * ret, gfc_array_i16 * source, shape_type * shape, + gfc_array_i16 * pad, shape_type * order) + { + /* r.* indicates the return array. */ + index_type rcount[GFC_MAX_DIMENSIONS]; + index_type rextent[GFC_MAX_DIMENSIONS]; + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdim; + index_type rsize; + index_type rs; + index_type rex; + GFC_INTEGER_16 *rptr; + /* s.* indicates the source array. */ + index_type scount[GFC_MAX_DIMENSIONS]; + index_type sextent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type sdim; + index_type ssize; + const GFC_INTEGER_16 *sptr; + /* p.* indicates the pad array. */ + index_type pcount[GFC_MAX_DIMENSIONS]; + index_type pextent[GFC_MAX_DIMENSIONS]; + index_type pstride[GFC_MAX_DIMENSIONS]; + index_type pdim; + index_type psize; + const GFC_INTEGER_16 *pptr; + + const GFC_INTEGER_16 *src; + int n; + int dim; + + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + if (shape->dim[0].stride == 0) + shape->dim[0].stride = 1; + if (pad && pad->dim[0].stride == 0) + pad->dim[0].stride = 1; + if (order && order->dim[0].stride == 0) + order->dim[0].stride = 1; + + if (ret->data == NULL) + { + rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rs = 1; + for (n=0; n < rdim; n++) + { + ret->dim[n].lbound = 0; + rex = shape->data[n * shape->dim[0].stride]; + ret->dim[n].ubound = rex - 1; + ret->dim[n].stride = rs; + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_16)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + else + { + rdim = GFC_DESCRIPTOR_RANK (ret); + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * order->dim[0].stride] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = ret->dim[dim].stride; + rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + + if (rextent[n] != shape->data[dim * shape->dim[0].stride]) + runtime_error ("shape and target do not conform"); + + if (rsize == rstride[n]) + rsize *= rextent[n]; + else + rsize = 0; + if (rextent[n] <= 0) + return; + } + + sdim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = source->dim[n].stride; + sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (sextent[n] <= 0) + abort (); + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + abort (); + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pptr = NULL; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_INTEGER_16); + ssize *= sizeof (GFC_INTEGER_16); + psize *= sizeof (GFC_INTEGER_16); + reshape_packed ((char *)ret->data, rsize, (char *)source->data, + ssize, pad ? (char *)pad->data : NULL, psize); + return; + } + rptr = ret->data; + src = sptr = source->data; + rstride0 = rstride[0]; + sstride0 = sstride[0]; + + while (rptr) + { + /* Select between the source and pad arrays. */ + *rptr = *src; + /* Advance to the next element. */ + rptr += rstride0; + src += sstride0; + rcount[0]++; + scount[0]++; + /* Advance to the next destination element. */ + n = 0; + while (rcount[n] == rextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + rcount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * rextent[n]; + n++; + if (n == rdim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + rcount[n]++; + rptr += rstride[n]; + } + } + /* Advance to the next source element. */ + n = 0; + while (scount[n] == sextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + scount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= sstride[n] * sextent[n]; + n++; + if (n == sdim) + { + if (sptr && pad) + { + /* Switch to the pad array. */ + sptr = NULL; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = sstride[0]; + } + } + /* We now start again from the beginning of the pad array. */ + src = pptr; + break; + } + else + { + scount[n]++; + src += sstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/reshape_i4.c gcc-4.1.0/libgfortran/generated/reshape_i4.c *** gcc-4.0.2/libgfortran/generated/reshape_i4.c Sun Jul 17 19:12:00 2005 --- gcc-4.1.0/libgfortran/generated/reshape_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) + typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the *************** reshape_4 (gfc_array_i4 * ret, gfc_array *** 97,103 **** ret->dim[n].stride = rs; rs *= rex; } ! ret->base = 0; ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } --- 99,105 ---- ret->dim[n].stride = rs; rs *= rex; } ! ret->offset = 0; ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } *************** reshape_4 (gfc_array_i4 * ret, gfc_array *** 256,258 **** --- 258,262 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/reshape_i8.c gcc-4.1.0/libgfortran/generated/reshape_i8.c *** gcc-4.0.2/libgfortran/generated/reshape_i8.c Sun Jul 17 19:12:00 2005 --- gcc-4.1.0/libgfortran/generated/reshape_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) + typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the *************** reshape_8 (gfc_array_i8 * ret, gfc_array *** 97,103 **** ret->dim[n].stride = rs; rs *= rex; } ! ret->base = 0; ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } --- 99,105 ---- ret->dim[n].stride = rs; rs *= rex; } ! ret->offset = 0; ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } *************** reshape_8 (gfc_array_i8 * ret, gfc_array *** 256,258 **** --- 258,262 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/set_exponent_r10.c gcc-4.1.0/libgfortran/generated/set_exponent_r10.c *** gcc-4.0.2/libgfortran/generated/set_exponent_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/set_exponent_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,48 ---- + /* Implementation of the SET_EXPONENT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_SCALBNL) && defined (HAVE_FREXPL) + + extern GFC_REAL_10 set_exponent_r10 (GFC_REAL_10 s, GFC_INTEGER_4 i); + export_proto(set_exponent_r10); + + GFC_REAL_10 + set_exponent_r10 (GFC_REAL_10 s, GFC_INTEGER_4 i) + { + int dummy_exp; + return scalbnl (frexpl (s, &dummy_exp), i); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/set_exponent_r16.c gcc-4.1.0/libgfortran/generated/set_exponent_r16.c *** gcc-4.0.2/libgfortran/generated/set_exponent_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/set_exponent_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,48 ---- + /* Implementation of the SET_EXPONENT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson . + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_SCALBNL) && defined (HAVE_FREXPL) + + extern GFC_REAL_16 set_exponent_r16 (GFC_REAL_16 s, GFC_INTEGER_4 i); + export_proto(set_exponent_r16); + + GFC_REAL_16 + set_exponent_r16 (GFC_REAL_16 s, GFC_INTEGER_4 i) + { + int dummy_exp; + return scalbnl (frexpl (s, &dummy_exp), i); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/set_exponent_r4.c gcc-4.1.0/libgfortran/generated/set_exponent_r4.c *** gcc-4.0.2/libgfortran/generated/set_exponent_r4.c Wed Jan 12 21:27:33 2005 --- gcc-4.1.0/libgfortran/generated/set_exponent_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,36 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" extern GFC_REAL_4 set_exponent_r4 (GFC_REAL_4 s, GFC_INTEGER_4 i); export_proto(set_exponent_r4); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_SCALBNF) && defined (HAVE_FREXPF) + extern GFC_REAL_4 set_exponent_r4 (GFC_REAL_4 s, GFC_INTEGER_4 i); export_proto(set_exponent_r4); *************** set_exponent_r4 (GFC_REAL_4 s, GFC_INTEG *** 40,42 **** --- 44,48 ---- int dummy_exp; return scalbnf (frexpf (s, &dummy_exp), i); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/set_exponent_r8.c gcc-4.1.0/libgfortran/generated/set_exponent_r8.c *** gcc-4.0.2/libgfortran/generated/set_exponent_r8.c Wed Jan 12 21:27:33 2005 --- gcc-4.1.0/libgfortran/generated/set_exponent_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,36 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" extern GFC_REAL_8 set_exponent_r8 (GFC_REAL_8 s, GFC_INTEGER_4 i); export_proto(set_exponent_r8); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_SCALBN) && defined (HAVE_FREXP) + extern GFC_REAL_8 set_exponent_r8 (GFC_REAL_8 s, GFC_INTEGER_4 i); export_proto(set_exponent_r8); *************** set_exponent_r8 (GFC_REAL_8 s, GFC_INTEG *** 40,42 **** --- 44,48 ---- int dummy_exp; return scalbn (frexp (s, &dummy_exp), i); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/shape_i16.c gcc-4.1.0/libgfortran/generated/shape_i16.c *** gcc-4.0.2/libgfortran/generated/shape_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/shape_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,58 ---- + /* Implementation of the SHAPE intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + extern void shape_16 (gfc_array_i16 * ret, const gfc_array_i16 * array); + export_proto(shape_16); + + void + shape_16 (gfc_array_i16 * ret, const gfc_array_i16 * array) + { + int n; + index_type stride; + + stride = ret->dim[0].stride; + if (stride == 0) + stride = 1; + + for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) + { + ret->data[n * stride] = + array->dim[n].ubound + 1 - array->dim[n].lbound; + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/shape_i4.c gcc-4.1.0/libgfortran/generated/shape_i4.c *** gcc-4.0.2/libgfortran/generated/shape_i4.c Wed Jan 12 21:27:33 2005 --- gcc-4.1.0/libgfortran/generated/shape_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" extern void shape_4 (gfc_array_i4 * ret, const gfc_array_i4 * array); export_proto(shape_4); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) + extern void shape_4 (gfc_array_i4 * ret, const gfc_array_i4 * array); export_proto(shape_4); *************** shape_4 (gfc_array_i4 * ret, const gfc_a *** 52,54 **** --- 54,58 ---- array->dim[n].ubound + 1 - array->dim[n].lbound; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/shape_i8.c gcc-4.1.0/libgfortran/generated/shape_i8.c *** gcc-4.0.2/libgfortran/generated/shape_i8.c Wed Jan 12 21:27:33 2005 --- gcc-4.1.0/libgfortran/generated/shape_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include "libgfortran.h" extern void shape_8 (gfc_array_i8 * ret, const gfc_array_i8 * array); export_proto(shape_8); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) + extern void shape_8 (gfc_array_i8 * ret, const gfc_array_i8 * array); export_proto(shape_8); *************** shape_8 (gfc_array_i8 * ret, const gfc_a *** 52,54 **** --- 54,58 ---- array->dim[n].ubound + 1 - array->dim[n].lbound; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_c10.c gcc-4.1.0/libgfortran/generated/sum_c10.c *** gcc-4.0.2/libgfortran/generated/sum_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/sum_c10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_COMPLEX_10) + + + extern void sum_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *); + export_proto(sum_c10); + + void + sum_c10 (gfc_array_c10 *retarray, gfc_array_c10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_10 *base; + GFC_COMPLEX_10 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_COMPLEX_10 *src; + GFC_COMPLEX_10 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void msum_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *, + gfc_array_l4 *); + export_proto(msum_c10); + + void + msum_c10 (gfc_array_c10 * retarray, gfc_array_c10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_10 *dest; + GFC_COMPLEX_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_COMPLEX_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_COMPLEX_10 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_c16.c gcc-4.1.0/libgfortran/generated/sum_c16.c *** gcc-4.0.2/libgfortran/generated/sum_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/sum_c16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16) + + + extern void sum_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *); + export_proto(sum_c16); + + void + sum_c16 (gfc_array_c16 *retarray, gfc_array_c16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_16 *base; + GFC_COMPLEX_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_COMPLEX_16 *src; + GFC_COMPLEX_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void msum_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *, + gfc_array_l4 *); + export_proto(msum_c16); + + void + msum_c16 (gfc_array_c16 * retarray, gfc_array_c16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_16 *dest; + GFC_COMPLEX_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_COMPLEX_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_COMPLEX_16 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_c4.c gcc-4.1.0/libgfortran/generated/sum_c4.c *** gcc-4.0.2/libgfortran/generated/sum_c4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/sum_c4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_COMPLEX_4) + + extern void sum_c4 (gfc_array_c4 *, gfc_array_c4 *, index_type *); export_proto(sum_c4); *************** sum_c4 (gfc_array_c4 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_c4 (gfc_array_c4 * retarray, gfc_ar *** 237,243 **** = internal_malloc_size (sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_c4 (gfc_array_c4 * retarray, gfc_ar *** 327,329 **** --- 330,334 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_c8.c gcc-4.1.0/libgfortran/generated/sum_c8.c *** gcc-4.0.2/libgfortran/generated/sum_c8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/sum_c8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_COMPLEX_8) + + extern void sum_c8 (gfc_array_c8 *, gfc_array_c8 *, index_type *); export_proto(sum_c8); *************** sum_c8 (gfc_array_c8 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_c8 (gfc_array_c8 * retarray, gfc_ar *** 237,243 **** = internal_malloc_size (sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_c8 (gfc_array_c8 * retarray, gfc_ar *** 327,329 **** --- 330,334 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_i16.c gcc-4.1.0/libgfortran/generated/sum_i16.c *** gcc-4.0.2/libgfortran/generated/sum_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/sum_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + + extern void sum_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *); + export_proto(sum_i16); + + void + sum_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *base; + GFC_INTEGER_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_16 *src; + GFC_INTEGER_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void msum_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *, + gfc_array_l4 *); + export_proto(msum_i16); + + void + msum_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 *dest; + GFC_INTEGER_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_i4.c gcc-4.1.0/libgfortran/generated/sum_i4.c *** gcc-4.0.2/libgfortran/generated/sum_i4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/sum_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + extern void sum_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *); export_proto(sum_i4); *************** sum_i4 (gfc_array_i4 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_i4 (gfc_array_i4 * retarray, gfc_ar *** 237,243 **** = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_i4 (gfc_array_i4 * retarray, gfc_ar *** 327,329 **** --- 330,334 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_i8.c gcc-4.1.0/libgfortran/generated/sum_i8.c *** gcc-4.0.2/libgfortran/generated/sum_i8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/sum_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + extern void sum_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *); export_proto(sum_i8); *************** sum_i8 (gfc_array_i8 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_i8 (gfc_array_i8 * retarray, gfc_ar *** 237,243 **** = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_i8 (gfc_array_i8 * retarray, gfc_ar *** 327,329 **** --- 330,334 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_r10.c gcc-4.1.0/libgfortran/generated/sum_r10.c *** gcc-4.0.2/libgfortran/generated/sum_r10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/sum_r10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) + + + extern void sum_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *); + export_proto(sum_r10); + + void + sum_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *base; + GFC_REAL_10 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_10 *src; + GFC_REAL_10 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void msum_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *, + gfc_array_l4 *); + export_proto(msum_r10); + + void + msum_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 *dest; + GFC_REAL_10 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_10 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_10 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_r16.c gcc-4.1.0/libgfortran/generated/sum_r16.c *** gcc-4.0.2/libgfortran/generated/sum_r16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/sum_r16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,334 ---- + /* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include + #include "libgfortran.h" + + + #if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) + + + extern void sum_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *); + export_proto(sum_r16); + + void + sum_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *base; + GFC_REAL_16 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_16 *src; + GFC_REAL_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } + } + + + extern void msum_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *, + gfc_array_l4 *); + export_proto(msum_r16); + + void + msum_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array, + index_type *pdim, gfc_array_l4 * mask) + { + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 *dest; + GFC_REAL_16 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + /* TODO: It should be a front end job to correctly set the strides. */ + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + + if (mask->dim[0].stride == 0) + mask->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_16 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_16 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_r4.c gcc-4.1.0/libgfortran/generated/sum_r4.c *** gcc-4.0.2/libgfortran/generated/sum_r4.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/sum_r4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) + + extern void sum_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *); export_proto(sum_r4); *************** sum_r4 (gfc_array_r4 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_r4 (gfc_array_r4 * retarray, gfc_ar *** 237,243 **** = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_r4 (gfc_array_r4 * retarray, gfc_ar *** 327,329 **** --- 330,334 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/sum_r8.c gcc-4.1.0/libgfortran/generated/sum_r8.c *** gcc-4.0.2/libgfortran/generated/sum_r8.c Mon May 23 20:03:52 2005 --- gcc-4.1.0/libgfortran/generated/sum_r8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,42 ---- #include "libgfortran.h" + #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) + + extern void sum_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *); export_proto(sum_r8); *************** sum_r8 (gfc_array_r8 *retarray, gfc_arra *** 92,98 **** = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 95,101 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_r8 (gfc_array_r8 * retarray, gfc_ar *** 237,243 **** = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 240,246 ---- = internal_malloc_size (sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** msum_r8 (gfc_array_r8 * retarray, gfc_ar *** 327,329 **** --- 330,334 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/transpose_c10.c gcc-4.1.0/libgfortran/generated/transpose_c10.c *** gcc-4.0.2/libgfortran/generated/transpose_c10.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/transpose_c10.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,102 ---- + /* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005 Free Software Foundation, Inc. + Contributed by Tobias Schlüter + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_10) + + extern void transpose_c10 (gfc_array_c10 * ret, gfc_array_c10 * source); + export_proto(transpose_c10); + + void + transpose_c10 (gfc_array_c10 * ret, gfc_array_c10 * source) + { + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_COMPLEX_10 *rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_COMPLEX_10 *sptr; + + index_type xcount, ycount; + index_type x, y; + + assert (GFC_DESCRIPTOR_RANK (source) == 2); + + if (ret->data == NULL) + { + assert (GFC_DESCRIPTOR_RANK (ret) == 2); + assert (ret->dtype == source->dtype); + + ret->dim[0].lbound = 0; + ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound; + ret->dim[0].stride = 1; + + ret->dim[1].lbound = 0; + ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; + ret->dim[1].stride = ret->dim[0].ubound+1; + + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) ret)); + ret->offset = 0; + } + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + + sxstride = source->dim[0].stride; + systride = source->dim[1].stride; + xcount = source->dim[0].ubound + 1 - source->dim[0].lbound; + ycount = source->dim[1].ubound + 1 - source->dim[1].lbound; + + rxstride = ret->dim[0].stride; + rystride = ret->dim[1].stride; + + rptr = ret->data; + sptr = source->data; + + for (y=0; y < ycount; y++) + { + for (x=0; x < xcount; x++) + { + *rptr = *sptr; + + sptr += sxstride; + rptr += rystride; + } + sptr += systride - (sxstride * xcount); + rptr += rxstride - (rystride * xcount); + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/transpose_c16.c gcc-4.1.0/libgfortran/generated/transpose_c16.c *** gcc-4.0.2/libgfortran/generated/transpose_c16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/transpose_c16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,102 ---- + /* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005 Free Software Foundation, Inc. + Contributed by Tobias Schlüter + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_COMPLEX_16) + + extern void transpose_c16 (gfc_array_c16 * ret, gfc_array_c16 * source); + export_proto(transpose_c16); + + void + transpose_c16 (gfc_array_c16 * ret, gfc_array_c16 * source) + { + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_COMPLEX_16 *rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_COMPLEX_16 *sptr; + + index_type xcount, ycount; + index_type x, y; + + assert (GFC_DESCRIPTOR_RANK (source) == 2); + + if (ret->data == NULL) + { + assert (GFC_DESCRIPTOR_RANK (ret) == 2); + assert (ret->dtype == source->dtype); + + ret->dim[0].lbound = 0; + ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound; + ret->dim[0].stride = 1; + + ret->dim[1].lbound = 0; + ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; + ret->dim[1].stride = ret->dim[0].ubound+1; + + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) ret)); + ret->offset = 0; + } + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + + sxstride = source->dim[0].stride; + systride = source->dim[1].stride; + xcount = source->dim[0].ubound + 1 - source->dim[0].lbound; + ycount = source->dim[1].ubound + 1 - source->dim[1].lbound; + + rxstride = ret->dim[0].stride; + rystride = ret->dim[1].stride; + + rptr = ret->data; + sptr = source->data; + + for (y=0; y < ycount; y++) + { + for (x=0; x < xcount; x++) + { + *rptr = *sptr; + + sptr += sxstride; + rptr += rystride; + } + sptr += systride - (sxstride * xcount); + rptr += rxstride - (rystride * xcount); + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/transpose_c4.c gcc-4.1.0/libgfortran/generated/transpose_c4.c *** gcc-4.0.2/libgfortran/generated/transpose_c4.c Sun Jan 23 17:01:00 2005 --- gcc-4.1.0/libgfortran/generated/transpose_c4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include "libgfortran.h" extern void transpose_c4 (gfc_array_c4 * ret, gfc_array_c4 * source); export_proto(transpose_c4); --- 25,39 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_4) + extern void transpose_c4 (gfc_array_c4 * ret, gfc_array_c4 * source); export_proto(transpose_c4); *************** transpose_c4 (gfc_array_c4 * ret, gfc_ar *** 63,70 **** ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 (ret)); ! ret->base = 0; } if (ret->dim[0].stride == 0) --- 65,72 ---- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) ret)); ! ret->offset = 0; } if (ret->dim[0].stride == 0) *************** transpose_c4 (gfc_array_c4 * ret, gfc_ar *** 96,98 **** --- 98,102 ---- rptr += rxstride - (rystride * xcount); } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/transpose_c8.c gcc-4.1.0/libgfortran/generated/transpose_c8.c *** gcc-4.0.2/libgfortran/generated/transpose_c8.c Sun Jan 23 17:01:00 2005 --- gcc-4.1.0/libgfortran/generated/transpose_c8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include "libgfortran.h" extern void transpose_c8 (gfc_array_c8 * ret, gfc_array_c8 * source); export_proto(transpose_c8); --- 25,39 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_COMPLEX_8) + extern void transpose_c8 (gfc_array_c8 * ret, gfc_array_c8 * source); export_proto(transpose_c8); *************** transpose_c8 (gfc_array_c8 * ret, gfc_ar *** 63,70 **** ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 (ret)); ! ret->base = 0; } if (ret->dim[0].stride == 0) --- 65,72 ---- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) ret)); ! ret->offset = 0; } if (ret->dim[0].stride == 0) *************** transpose_c8 (gfc_array_c8 * ret, gfc_ar *** 96,98 **** --- 98,102 ---- rptr += rxstride - (rystride * xcount); } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/transpose_i16.c gcc-4.1.0/libgfortran/generated/transpose_i16.c *** gcc-4.0.2/libgfortran/generated/transpose_i16.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/generated/transpose_i16.c Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,102 ---- + /* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005 Free Software Foundation, Inc. + Contributed by Tobias Schlüter + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + #if defined (HAVE_GFC_INTEGER_16) + + extern void transpose_i16 (gfc_array_i16 * ret, gfc_array_i16 * source); + export_proto(transpose_i16); + + void + transpose_i16 (gfc_array_i16 * ret, gfc_array_i16 * source) + { + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_INTEGER_16 *rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_INTEGER_16 *sptr; + + index_type xcount, ycount; + index_type x, y; + + assert (GFC_DESCRIPTOR_RANK (source) == 2); + + if (ret->data == NULL) + { + assert (GFC_DESCRIPTOR_RANK (ret) == 2); + assert (ret->dtype == source->dtype); + + ret->dim[0].lbound = 0; + ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound; + ret->dim[0].stride = 1; + + ret->dim[1].lbound = 0; + ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; + ret->dim[1].stride = ret->dim[0].ubound+1; + + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) ret)); + ret->offset = 0; + } + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + + sxstride = source->dim[0].stride; + systride = source->dim[1].stride; + xcount = source->dim[0].ubound + 1 - source->dim[0].lbound; + ycount = source->dim[1].ubound + 1 - source->dim[1].lbound; + + rxstride = ret->dim[0].stride; + rystride = ret->dim[1].stride; + + rptr = ret->data; + sptr = source->data; + + for (y=0; y < ycount; y++) + { + for (x=0; x < xcount; x++) + { + *rptr = *sptr; + + sptr += sxstride; + rptr += rystride; + } + sptr += systride - (sxstride * xcount); + rptr += rxstride - (rystride * xcount); + } + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/transpose_i4.c gcc-4.1.0/libgfortran/generated/transpose_i4.c *** gcc-4.0.2/libgfortran/generated/transpose_i4.c Sun Jan 23 17:01:00 2005 --- gcc-4.1.0/libgfortran/generated/transpose_i4.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include "libgfortran.h" extern void transpose_i4 (gfc_array_i4 * ret, gfc_array_i4 * source); export_proto(transpose_i4); --- 25,39 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_4) + extern void transpose_i4 (gfc_array_i4 * ret, gfc_array_i4 * source); export_proto(transpose_i4); *************** transpose_i4 (gfc_array_i4 * ret, gfc_ar *** 63,70 **** ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 (ret)); ! ret->base = 0; } if (ret->dim[0].stride == 0) --- 65,72 ---- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) ret)); ! ret->offset = 0; } if (ret->dim[0].stride == 0) *************** transpose_i4 (gfc_array_i4 * ret, gfc_ar *** 96,98 **** --- 98,102 ---- rptr += rxstride - (rystride * xcount); } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/transpose_i8.c gcc-4.1.0/libgfortran/generated/transpose_i8.c *** gcc-4.0.2/libgfortran/generated/transpose_i8.c Sun Jan 23 17:01:00 2005 --- gcc-4.1.0/libgfortran/generated/transpose_i8.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include "libgfortran.h" extern void transpose_i8 (gfc_array_i8 * ret, gfc_array_i8 * source); export_proto(transpose_i8); --- 25,39 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include "libgfortran.h" + #if defined (HAVE_GFC_INTEGER_8) + extern void transpose_i8 (gfc_array_i8 * ret, gfc_array_i8 * source); export_proto(transpose_i8); *************** transpose_i8 (gfc_array_i8 * ret, gfc_ar *** 63,70 **** ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 (ret)); ! ret->base = 0; } if (ret->dim[0].stride == 0) --- 65,72 ---- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) ret)); ! ret->offset = 0; } if (ret->dim[0].stride == 0) *************** transpose_i8 (gfc_array_i8 * ret, gfc_ar *** 96,98 **** --- 98,102 ---- rptr += rxstride - (rystride * xcount); } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/generated/trig_c4.c gcc-4.1.0/libgfortran/generated/trig_c4.c *** gcc-4.0.2/libgfortran/generated/trig_c4.c Wed Jan 12 21:27:33 2005 --- gcc-4.1.0/libgfortran/generated/trig_c4.c Thu Jan 1 00:00:00 1970 *************** *** 1,80 **** - /* Complex trig functions - Copyright 2002 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h" - - - /* Complex number z = a + ib. */ - - /* sin(z) = sin(a)cosh(b) + icos(a)sinh(b) */ - GFC_COMPLEX_4 - csinf (GFC_COMPLEX_4 a) - { - GFC_REAL_4 r; - GFC_REAL_4 i; - GFC_COMPLEX_4 v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, sinf (r) * coshf (i), cosf (r) * sinhf (i)); - return v; - } - - /* cos(z) = cos(a)cosh(b) - isin(a)sinh(b) */ - GFC_COMPLEX_4 - ccosf (GFC_COMPLEX_4 a) - { - GFC_REAL_4 r; - GFC_REAL_4 i; - GFC_COMPLEX_4 v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, cosf (r) * coshf (i), - (sinf (r) * sinhf (i))); - return v; - } - - /* tan(z) = (tan(a) + itanh(b)) / (1 - itan(a)tanh(b)) */ - GFC_COMPLEX_4 - ctanf (GFC_COMPLEX_4 a) - { - GFC_REAL_4 rt; - GFC_REAL_4 it; - GFC_COMPLEX_4 n; - GFC_COMPLEX_4 d; - - rt = tanf (REALPART (a)); - it = tanhf (IMAGPART (a)); - COMPLEX_ASSIGN (n, rt, it); - COMPLEX_ASSIGN (d , 1, - (rt * it)); - - return n / d; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/generated/trig_c8.c gcc-4.1.0/libgfortran/generated/trig_c8.c *** gcc-4.0.2/libgfortran/generated/trig_c8.c Wed Jan 12 21:27:33 2005 --- gcc-4.1.0/libgfortran/generated/trig_c8.c Thu Jan 1 00:00:00 1970 *************** *** 1,80 **** - /* Complex trig functions - Copyright 2002 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h" - - - /* Complex number z = a + ib. */ - - /* sin(z) = sin(a)cosh(b) + icos(a)sinh(b) */ - GFC_COMPLEX_8 - csin (GFC_COMPLEX_8 a) - { - GFC_REAL_8 r; - GFC_REAL_8 i; - GFC_COMPLEX_8 v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, sin (r) * cosh (i), cos (r) * sinh (i)); - return v; - } - - /* cos(z) = cos(a)cosh(b) - isin(a)sinh(b) */ - GFC_COMPLEX_8 - ccos (GFC_COMPLEX_8 a) - { - GFC_REAL_8 r; - GFC_REAL_8 i; - GFC_COMPLEX_8 v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, cos (r) * cosh (i), - (sin (r) * sinh (i))); - return v; - } - - /* tan(z) = (tan(a) + itanh(b)) / (1 - itan(a)tanh(b)) */ - GFC_COMPLEX_8 - ctan (GFC_COMPLEX_8 a) - { - GFC_REAL_8 rt; - GFC_REAL_8 it; - GFC_COMPLEX_8 n; - GFC_COMPLEX_8 d; - - rt = tan (REALPART (a)); - it = tanh (IMAGPART (a)); - COMPLEX_ASSIGN (n, rt, it); - COMPLEX_ASSIGN (d , 1, - (rt * it)); - - return n / d; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/abort.c gcc-4.1.0/libgfortran/intrinsics/abort.c *** gcc-4.0.2/libgfortran/intrinsics/abort.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/abort.c Fri Dec 2 00:38:36 2005 *************** *** 1,5 **** /* Implementation of the ABORT intrinsic. ! Copyright (C) 2003, 2004 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ABORT intrinsic. ! Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc. This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,31 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" --- 24,31 ---- 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 #include "libgfortran.h" *************** export_proto_np(PREFIX(abort)); *** 35,39 **** --- 35,52 ---- void PREFIX(abort) (void) { + close_units (); + abort (); + } + + /* abort() is needed for the testsuite when linking with -std=f95. */ + + extern void abort_ (void); + export_proto_np(abort_); + + void + abort_ (void) + { + close_units (); abort (); } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/args.c gcc-4.1.0/libgfortran/intrinsics/args.c *** gcc-4.0.2/libgfortran/intrinsics/args.c Sun Feb 20 15:24:02 2005 --- gcc-4.1.0/libgfortran/intrinsics/args.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 26,33 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 26,33 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/associated.c gcc-4.1.0/libgfortran/intrinsics/associated.c *** gcc-4.0.2/libgfortran/intrinsics/associated.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/associated.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "libgfortran.h" --- 25,32 ---- 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" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/bessel.c gcc-4.1.0/libgfortran/intrinsics/bessel.c *** gcc-4.0.2/libgfortran/intrinsics/bessel.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/bessel.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/c99_functions.c gcc-4.1.0/libgfortran/intrinsics/c99_functions.c *** gcc-4.0.2/libgfortran/intrinsics/c99_functions.c Wed Jun 15 18:53:26 2005 --- gcc-4.1.0/libgfortran/intrinsics/c99_functions.c Tue Feb 7 17:35:25 2006 *************** GNU General Public License for more deta *** 24,40 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include #include "libgfortran.h" #ifndef HAVE_ACOSF float acosf(float x) { --- 24,84 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include + + #define C99_PROTOS_H WE_DONT_WANT_PROTOS_NOW #include "libgfortran.h" + /* IRIX's declares a non-C99 compliant implementation of cabs, + which takes two floating point arguments instead of a single complex. + If is missing this prevents building of c99_functions.c. + To work around this we redirect cabs{,f,l} calls to __gfc_cabs{,f,l}. */ + + #if defined(__sgi__) && !defined(HAVE_COMPLEX_H) + #undef HAVE_CABS + #undef HAVE_CABSF + #undef HAVE_CABSL + #define cabs __gfc_cabs + #define cabsf __gfc_cabsf + #define cabsl __gfc_cabsl + #endif + + /* Tru64's declares a non-C99 compliant implementation of cabs, + which takes two floating point arguments instead of a single complex. + To work around this we redirect cabs{,f,l} calls to __gfc_cabs{,f,l}. */ + + #ifdef __osf__ + #undef HAVE_CABS + #undef HAVE_CABSF + #undef HAVE_CABSL + #define cabs __gfc_cabs + #define cabsf __gfc_cabsf + #define cabsl __gfc_cabsl + #endif + + /* Prototypes to silence -Wstrict-prototypes -Wmissing-prototypes. */ + + float cabsf(float complex); + double cabs(double complex); + long double cabsl(long double complex); + + float cargf(float complex); + double carg(double complex); + long double cargl(long double complex); + + float complex clog10f(float complex); + double complex clog10(double complex); + long double complex clog10l(long double complex); + #ifndef HAVE_ACOSF + #define HAVE_ACOSF 1 float acosf(float x) { *************** acosf(float x) *** 43,48 **** --- 87,93 ---- #endif #ifndef HAVE_ASINF + #define HAVE_ASINF 1 float asinf(float x) { *************** asinf(float x) *** 51,56 **** --- 96,102 ---- #endif #ifndef HAVE_ATAN2F + #define HAVE_ATAN2F 1 float atan2f(float y, float x) { *************** atan2f(float y, float x) *** 59,64 **** --- 105,111 ---- #endif #ifndef HAVE_ATANF + #define HAVE_ATANF 1 float atanf(float x) { *************** atanf(float x) *** 67,72 **** --- 114,120 ---- #endif #ifndef HAVE_CEILF + #define HAVE_CEILF 1 float ceilf(float x) { *************** ceilf(float x) *** 75,80 **** --- 123,129 ---- #endif #ifndef HAVE_COPYSIGNF + #define HAVE_COPYSIGNF 1 float copysignf(float x, float y) { *************** copysignf(float x, float y) *** 83,88 **** --- 132,138 ---- #endif #ifndef HAVE_COSF + #define HAVE_COSF 1 float cosf(float x) { *************** cosf(float x) *** 91,96 **** --- 141,147 ---- #endif #ifndef HAVE_COSHF + #define HAVE_COSHF 1 float coshf(float x) { *************** coshf(float x) *** 99,104 **** --- 150,156 ---- #endif #ifndef HAVE_EXPF + #define HAVE_EXPF 1 float expf(float x) { *************** expf(float x) *** 107,112 **** --- 159,165 ---- #endif #ifndef HAVE_FABSF + #define HAVE_FABSF 1 float fabsf(float x) { *************** fabsf(float x) *** 115,120 **** --- 168,174 ---- #endif #ifndef HAVE_FLOORF + #define HAVE_FLOORF 1 float floorf(float x) { *************** floorf(float x) *** 123,128 **** --- 177,183 ---- #endif #ifndef HAVE_FREXPF + #define HAVE_FREXPF 1 float frexpf(float x, int *exp) { *************** frexpf(float x, int *exp) *** 131,136 **** --- 186,192 ---- #endif #ifndef HAVE_HYPOTF + #define HAVE_HYPOTF 1 float hypotf(float x, float y) { *************** hypotf(float x, float y) *** 139,144 **** --- 195,201 ---- #endif #ifndef HAVE_LOGF + #define HAVE_LOGF 1 float logf(float x) { *************** logf(float x) *** 147,152 **** --- 204,210 ---- #endif #ifndef HAVE_LOG10F + #define HAVE_LOG10F 1 float log10f(float x) { *************** log10f(float x) *** 155,160 **** --- 213,219 ---- #endif #ifndef HAVE_SCALBN + #define HAVE_SCALBN 1 double scalbn(double x, int y) { *************** scalbn(double x, int y) *** 163,168 **** --- 222,228 ---- #endif #ifndef HAVE_SCALBNF + #define HAVE_SCALBNF 1 float scalbnf(float x, int y) { *************** scalbnf(float x, int y) *** 171,176 **** --- 231,237 ---- #endif #ifndef HAVE_SINF + #define HAVE_SINF 1 float sinf(float x) { *************** sinf(float x) *** 179,184 **** --- 240,246 ---- #endif #ifndef HAVE_SINHF + #define HAVE_SINHF 1 float sinhf(float x) { *************** sinhf(float x) *** 187,192 **** --- 249,255 ---- #endif #ifndef HAVE_SQRTF + #define HAVE_SQRTF 1 float sqrtf(float x) { *************** sqrtf(float x) *** 195,200 **** --- 258,264 ---- #endif #ifndef HAVE_TANF + #define HAVE_TANF 1 float tanf(float x) { *************** tanf(float x) *** 203,208 **** --- 267,273 ---- #endif #ifndef HAVE_TANHF + #define HAVE_TANHF 1 float tanhf(float x) { *************** tanhf(float x) *** 211,216 **** --- 276,282 ---- #endif #ifndef HAVE_TRUNC + #define HAVE_TRUNC 1 double trunc(double x) { *************** trunc(double x) *** 225,230 **** --- 291,297 ---- #endif #ifndef HAVE_TRUNCF + #define HAVE_TRUNCF 1 float truncf(float x) { *************** truncf(float x) *** 233,238 **** --- 300,306 ---- #endif #ifndef HAVE_NEXTAFTERF + #define HAVE_NEXTAFTERF 1 /* This is a portable implementation of nextafterf that is intended to be independent of the floating point format or its in memory representation. This implementation works correctly with denormalized values. */ *************** nextafterf(float x, float y) *** 296,301 **** --- 364,370 ---- #ifndef HAVE_POWF + #define HAVE_POWF 1 float powf(float x, float y) { *************** powf(float x, float y) *** 308,313 **** --- 377,383 ---- /* Algorithm by Steven G. Kargl. */ #ifndef HAVE_ROUND + #define HAVE_ROUND 1 /* Round to nearest integral value. If the argument is halfway between two integral values then round away from zero. */ *************** double *** 315,326 **** round(double x) { double t; ! #if defined(fpclassify) ! int i; ! i = fpclassify(x); ! if (i == FP_INFINITE || i == FP_NAN) return (x); - #endif if (x >= 0.0) { --- 385,392 ---- round(double x) { double t; ! if (!isfinite (x)) return (x); if (x >= 0.0) { *************** round(double x) *** 340,345 **** --- 406,412 ---- #endif #ifndef HAVE_ROUNDF + #define HAVE_ROUNDF 1 /* Round to nearest integral value. If the argument is halfway between two integral values then round away from zero. */ *************** float *** 347,359 **** roundf(float x) { float t; ! #if defined(fpclassify) ! int i; ! ! i = fpclassify(x); ! if (i == FP_INFINITE || i == FP_NAN) return (x); - #endif if (x >= 0.0) { --- 414,421 ---- roundf(float x) { float t; ! if (!isfinite (x)) return (x); if (x >= 0.0) { *************** roundf(float x) *** 371,373 **** --- 433,1138 ---- } } #endif + + #ifndef HAVE_LOG10L + #define HAVE_LOG10L 1 + /* log10 function for long double variables. The version provided here + reduces the argument until it fits into a double, then use log10. */ + long double + log10l(long double x) + { + #if LDBL_MAX_EXP > DBL_MAX_EXP + if (x > DBL_MAX) + { + double val; + int p2_result = 0; + if (x > 0x1p16383L) { p2_result += 16383; x /= 0x1p16383L; } + if (x > 0x1p8191L) { p2_result += 8191; x /= 0x1p8191L; } + if (x > 0x1p4095L) { p2_result += 4095; x /= 0x1p4095L; } + if (x > 0x1p2047L) { p2_result += 2047; x /= 0x1p2047L; } + if (x > 0x1p1023L) { p2_result += 1023; x /= 0x1p1023L; } + val = log10 ((double) x); + return (val + p2_result * .30102999566398119521373889472449302L); + } + #endif + #if LDBL_MIN_EXP < DBL_MIN_EXP + if (x < DBL_MIN) + { + double val; + int p2_result = 0; + if (x < 0x1p-16380L) { p2_result += 16380; x /= 0x1p-16380L; } + if (x < 0x1p-8189L) { p2_result += 8189; x /= 0x1p-8189L; } + if (x < 0x1p-4093L) { p2_result += 4093; x /= 0x1p-4093L; } + if (x < 0x1p-2045L) { p2_result += 2045; x /= 0x1p-2045L; } + if (x < 0x1p-1021L) { p2_result += 1021; x /= 0x1p-1021L; } + val = fabs(log10 ((double) x)); + return (- val - p2_result * .30102999566398119521373889472449302L); + } + #endif + return log10 (x); + } + #endif + + + #if !defined(HAVE_CABSF) + #define HAVE_CABSF 1 + float + cabsf (float complex z) + { + return hypotf (REALPART (z), IMAGPART (z)); + } + #endif + + #if !defined(HAVE_CABS) + #define HAVE_CABS 1 + double + cabs (double complex z) + { + return hypot (REALPART (z), IMAGPART (z)); + } + #endif + + #if !defined(HAVE_CABSL) && defined(HAVE_HYPOTL) + #define HAVE_CABSL 1 + long double + cabsl (long double complex z) + { + return hypotl (REALPART (z), IMAGPART (z)); + } + #endif + + + #if !defined(HAVE_CARGF) + #define HAVE_CARGF 1 + float + cargf (float complex z) + { + return atan2f (IMAGPART (z), REALPART (z)); + } + #endif + + #if !defined(HAVE_CARG) + #define HAVE_CARG 1 + double + carg (double complex z) + { + return atan2 (IMAGPART (z), REALPART (z)); + } + #endif + + #if !defined(HAVE_CARGL) && defined(HAVE_ATAN2L) + #define HAVE_CARGL 1 + long double + cargl (long double complex z) + { + return atan2l (IMAGPART (z), REALPART (z)); + } + #endif + + + /* exp(z) = exp(a)*(cos(b) + i sin(b)) */ + #if !defined(HAVE_CEXPF) + #define HAVE_CEXPF 1 + float complex + cexpf (float complex z) + { + float a, b; + float complex v; + + a = REALPART (z); + b = IMAGPART (z); + COMPLEX_ASSIGN (v, cosf (b), sinf (b)); + return expf (a) * v; + } + #endif + + #if !defined(HAVE_CEXP) + #define HAVE_CEXP 1 + double complex + cexp (double complex z) + { + double a, b; + double complex v; + + a = REALPART (z); + b = IMAGPART (z); + COMPLEX_ASSIGN (v, cos (b), sin (b)); + return exp (a) * v; + } + #endif + + #if !defined(HAVE_CEXPL) && defined(HAVE_COSL) && defined(HAVE_SINL) && defined(EXPL) + #define HAVE_CEXPL 1 + long double complex + cexpl (long double complex z) + { + long double a, b; + long double complex v; + + a = REALPART (z); + b = IMAGPART (z); + COMPLEX_ASSIGN (v, cosl (b), sinl (b)); + return expl (a) * v; + } + #endif + + + /* log(z) = log (cabs(z)) + i*carg(z) */ + #if !defined(HAVE_CLOGF) + #define HAVE_CLOGF 1 + float complex + clogf (float complex z) + { + float complex v; + + COMPLEX_ASSIGN (v, logf (cabsf (z)), cargf (z)); + return v; + } + #endif + + #if !defined(HAVE_CLOG) + #define HAVE_CLOG 1 + double complex + clog (double complex z) + { + double complex v; + + COMPLEX_ASSIGN (v, log (cabs (z)), carg (z)); + return v; + } + #endif + + #if !defined(HAVE_CLOGL) && defined(HAVE_LOGL) && defined(HAVE_CABSL) && defined(HAVE_CARGL) + #define HAVE_CLOGL 1 + long double complex + clogl (long double complex z) + { + long double complex v; + + COMPLEX_ASSIGN (v, logl (cabsl (z)), cargl (z)); + return v; + } + #endif + + + /* log10(z) = log10 (cabs(z)) + i*carg(z) */ + #if !defined(HAVE_CLOG10F) + #define HAVE_CLOG10F 1 + float complex + clog10f (float complex z) + { + float complex v; + + COMPLEX_ASSIGN (v, log10f (cabsf (z)), cargf (z)); + return v; + } + #endif + + #if !defined(HAVE_CLOG10) + #define HAVE_CLOG10 1 + double complex + clog10 (double complex z) + { + double complex v; + + COMPLEX_ASSIGN (v, log10 (cabs (z)), carg (z)); + return v; + } + #endif + + #if !defined(HAVE_CLOG10L) && defined(HAVE_LOG10L) && defined(HAVE_CABSL) && defined(HAVE_CARGL) + #define HAVE_CLOG10L 1 + long double complex + clog10l (long double complex z) + { + long double complex v; + + COMPLEX_ASSIGN (v, log10l (cabsl (z)), cargl (z)); + return v; + } + #endif + + + /* pow(base, power) = cexp (power * clog (base)) */ + #if !defined(HAVE_CPOWF) + #define HAVE_CPOWF 1 + float complex + cpowf (float complex base, float complex power) + { + return cexpf (power * clogf (base)); + } + #endif + + #if !defined(HAVE_CPOW) + #define HAVE_CPOW 1 + double complex + cpow (double complex base, double complex power) + { + return cexp (power * clog (base)); + } + #endif + + #if !defined(HAVE_CPOWL) && defined(HAVE_CEXPL) && defined(HAVE_CLOGL) + #define HAVE_CPOWL 1 + long double complex + cpowl (long double complex base, long double complex power) + { + return cexpl (power * clogl (base)); + } + #endif + + + /* sqrt(z). Algorithm pulled from glibc. */ + #if !defined(HAVE_CSQRTF) + #define HAVE_CSQRTF 1 + float complex + csqrtf (float complex z) + { + float re, im; + float complex v; + + re = REALPART (z); + im = IMAGPART (z); + if (im == 0) + { + if (re < 0) + { + COMPLEX_ASSIGN (v, 0, copysignf (sqrtf (-re), im)); + } + else + { + COMPLEX_ASSIGN (v, fabsf (sqrtf (re)), copysignf (0, im)); + } + } + else if (re == 0) + { + float r; + + r = sqrtf (0.5 * fabsf (im)); + + COMPLEX_ASSIGN (v, r, copysignf (r, im)); + } + else + { + float d, r, s; + + d = hypotf (re, im); + /* Use the identity 2 Re res Im res = Im x + to avoid cancellation error in d +/- Re x. */ + if (re > 0) + { + r = sqrtf (0.5 * d + 0.5 * re); + s = (0.5 * im) / r; + } + else + { + s = sqrtf (0.5 * d - 0.5 * re); + r = fabsf ((0.5 * im) / s); + } + + COMPLEX_ASSIGN (v, r, copysignf (s, im)); + } + return v; + } + #endif + + #if !defined(HAVE_CSQRT) + #define HAVE_CSQRT 1 + double complex + csqrt (double complex z) + { + double re, im; + double complex v; + + re = REALPART (z); + im = IMAGPART (z); + if (im == 0) + { + if (re < 0) + { + COMPLEX_ASSIGN (v, 0, copysign (sqrt (-re), im)); + } + else + { + COMPLEX_ASSIGN (v, fabs (sqrt (re)), copysign (0, im)); + } + } + else if (re == 0) + { + double r; + + r = sqrt (0.5 * fabs (im)); + + COMPLEX_ASSIGN (v, r, copysign (r, im)); + } + else + { + double d, r, s; + + d = hypot (re, im); + /* Use the identity 2 Re res Im res = Im x + to avoid cancellation error in d +/- Re x. */ + if (re > 0) + { + r = sqrt (0.5 * d + 0.5 * re); + s = (0.5 * im) / r; + } + else + { + s = sqrt (0.5 * d - 0.5 * re); + r = fabs ((0.5 * im) / s); + } + + COMPLEX_ASSIGN (v, r, copysign (s, im)); + } + return v; + } + #endif + + #if !defined(HAVE_CSQRTL) && defined(HAVE_COPYSIGNL) && defined(HAVE_SQRTL) && defined(HAVE_FABSL) && defined(HAVE_HYPOTL) + #define HAVE_CSQRTL 1 + long double complex + csqrtl (long double complex z) + { + long double re, im; + long double complex v; + + re = REALPART (z); + im = IMAGPART (z); + if (im == 0) + { + if (re < 0) + { + COMPLEX_ASSIGN (v, 0, copysignl (sqrtl (-re), im)); + } + else + { + COMPLEX_ASSIGN (v, fabsl (sqrtl (re)), copysignl (0, im)); + } + } + else if (re == 0) + { + long double r; + + r = sqrtl (0.5 * fabsl (im)); + + COMPLEX_ASSIGN (v, copysignl (r, im), r); + } + else + { + long double d, r, s; + + d = hypotl (re, im); + /* Use the identity 2 Re res Im res = Im x + to avoid cancellation error in d +/- Re x. */ + if (re > 0) + { + r = sqrtl (0.5 * d + 0.5 * re); + s = (0.5 * im) / r; + } + else + { + s = sqrtl (0.5 * d - 0.5 * re); + r = fabsl ((0.5 * im) / s); + } + + COMPLEX_ASSIGN (v, r, copysignl (s, im)); + } + return v; + } + #endif + + + /* sinh(a + i b) = sinh(a) cos(b) + i cosh(a) sin(b) */ + #if !defined(HAVE_CSINHF) + #define HAVE_CSINHF 1 + float complex + csinhf (float complex a) + { + float r, i; + float complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinhf (r) * cosf (i), coshf (r) * sinf (i)); + return v; + } + #endif + + #if !defined(HAVE_CSINH) + #define HAVE_CSINH 1 + double complex + csinh (double complex a) + { + double r, i; + double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinh (r) * cos (i), cosh (r) * sin (i)); + return v; + } + #endif + + #if !defined(HAVE_CSINHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) + #define HAVE_CSINHL 1 + long double complex + csinhl (long double complex a) + { + long double r, i; + long double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinhl (r) * cosl (i), coshl (r) * sinl (i)); + return v; + } + #endif + + + /* cosh(a + i b) = cosh(a) cos(b) - i sinh(a) sin(b) */ + #if !defined(HAVE_CCOSHF) + #define HAVE_CCOSHF 1 + float complex + ccoshf (float complex a) + { + float r, i; + float complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, coshf (r) * cosf (i), - (sinhf (r) * sinf (i))); + return v; + } + #endif + + #if !defined(HAVE_CCOSH) + #define HAVE_CCOSH 1 + double complex + ccosh (double complex a) + { + double r, i; + double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cosh (r) * cos (i), - (sinh (r) * sin (i))); + return v; + } + #endif + + #if !defined(HAVE_CCOSHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) + #define HAVE_CCOSHL 1 + long double complex + ccoshl (long double complex a) + { + long double r, i; + long double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, coshl (r) * cosl (i), - (sinhl (r) * sinl (i))); + return v; + } + #endif + + + /* tanh(a + i b) = (tanh(a) + i tan(b)) / (1 - i tanh(a) tan(b)) */ + #if !defined(HAVE_CTANHF) + #define HAVE_CTANHF 1 + float complex + ctanhf (float complex a) + { + float rt, it; + float complex n, d; + + rt = tanhf (REALPART (a)); + it = tanf (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; + } + #endif + + #if !defined(HAVE_CTANH) + #define HAVE_CTANH 1 + double complex + ctanh (double complex a) + { + double rt, it; + double complex n, d; + + rt = tanh (REALPART (a)); + it = tan (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; + } + #endif + + #if !defined(HAVE_CTANHL) && defined(HAVE_TANL) && defined(HAVE_TANHL) + #define HAVE_CTANHL 1 + long double complex + ctanhl (long double complex a) + { + long double rt, it; + long double complex n, d; + + rt = tanhl (REALPART (a)); + it = tanl (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; + } + #endif + + + /* sin(a + i b) = sin(a) cosh(b) + i cos(a) sinh(b) */ + #if !defined(HAVE_CSINF) + #define HAVE_CSINF 1 + float complex + csinf (float complex a) + { + float r, i; + float complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinf (r) * coshf (i), cosf (r) * sinhf (i)); + return v; + } + #endif + + #if !defined(HAVE_CSIN) + #define HAVE_CSIN 1 + double complex + csin (double complex a) + { + double r, i; + double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sin (r) * cosh (i), cos (r) * sinh (i)); + return v; + } + #endif + + #if !defined(HAVE_CSINL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) + #define HAVE_CSINL 1 + long double complex + csinl (long double complex a) + { + long double r, i; + long double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinl (r) * coshl (i), cosl (r) * sinhl (i)); + return v; + } + #endif + + + /* cos(a + i b) = cos(a) cosh(b) - i sin(a) sinh(b) */ + #if !defined(HAVE_CCOSF) + #define HAVE_CCOSF 1 + float complex + ccosf (float complex a) + { + float r, i; + float complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cosf (r) * coshf (i), - (sinf (r) * sinhf (i))); + return v; + } + #endif + + #if !defined(HAVE_CCOS) + #define HAVE_CCOS 1 + double complex + ccos (double complex a) + { + double r, i; + double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cos (r) * cosh (i), - (sin (r) * sinh (i))); + return v; + } + #endif + + #if !defined(HAVE_CCOSL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) + #define HAVE_CCOSL 1 + long double complex + ccosl (long double complex a) + { + long double r, i; + long double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cosl (r) * coshl (i), - (sinl (r) * sinhl (i))); + return v; + } + #endif + + + /* tan(a + i b) = (tan(a) + i tanh(b)) / (1 - i tan(a) tanh(b)) */ + #if !defined(HAVE_CTANF) + #define HAVE_CTANF 1 + float complex + ctanf (float complex a) + { + float rt, it; + float complex n, d; + + rt = tanf (REALPART (a)); + it = tanhf (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; + } + #endif + + #if !defined(HAVE_CTAN) + #define HAVE_CTAN 1 + double complex + ctan (double complex a) + { + double rt, it; + double complex n, d; + + rt = tan (REALPART (a)); + it = tanh (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; + } + #endif + + #if !defined(HAVE_CTANL) && defined(HAVE_TANL) && defined(HAVE_TANHL) + #define HAVE_CTANL 1 + long double complex + ctanl (long double complex a) + { + long double rt, it; + long double complex n, d; + + rt = tanl (REALPART (a)); + it = tanhl (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; + } + #endif + diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/chdir.c gcc-4.1.0/libgfortran/intrinsics/chdir.c *** gcc-4.0.2/libgfortran/intrinsics/chdir.c Sun May 15 08:27:26 2005 --- gcc-4.1.0/libgfortran/intrinsics/chdir.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** chdir_i4_sub (char *dir, GFC_INTEGER_4 * *** 63,73 **** /* Make a null terminated copy of the strings. */ str = gfc_alloca (dir_len + 1); memcpy (str, dir, dir_len); ! str[dir_len] = '\0'; val = chdir (str); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(chdir_i4_sub); --- 63,73 ---- /* Make a null terminated copy of the strings. */ str = gfc_alloca (dir_len + 1); memcpy (str, dir, dir_len); ! str[dir_len] = '\0'; val = chdir (str); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(chdir_i4_sub); *************** chdir_i8_sub (char *dir, GFC_INTEGER_8 * *** 88,98 **** /* Make a null terminated copy of the strings. */ str = gfc_alloca (dir_len + 1); memcpy (str, dir, dir_len); ! str[dir_len] = '\0'; val = chdir (str); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(chdir_i8_sub); --- 88,98 ---- /* Make a null terminated copy of the strings. */ str = gfc_alloca (dir_len + 1); memcpy (str, dir, dir_len); ! str[dir_len] = '\0'; val = chdir (str); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(chdir_i8_sub); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/cpu_time.c gcc-4.1.0/libgfortran/intrinsics/cpu_time.c *** gcc-4.0.2/libgfortran/intrinsics/cpu_time.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/cpu_time.c Sat Sep 24 08:39:35 2005 *************** GNU General Public License for more deta *** 24,31 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 24,31 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** static inline void __cpu_time_1 (long *, *** 88,93 **** --- 88,131 ---- /* Helper function for the actual implementation of the CPU_TIME intrnsic. Returns a CPU time in microseconds or -1 if no CPU time could be computed. */ + + #ifdef __MINGW32__ + + #define WIN32_LEAN_AND_MEAN + #include + + static void + __cpu_time_1 (long *sec, long *usec) + { + union { + FILETIME ft; + unsigned long long ulltime; + } kernel_time, user_time; + + FILETIME unused1, unused2; + unsigned long long total_time; + + /* No support for Win9x. The high order bit of the DWORD + returned by GetVersion is 0 for NT and higher. */ + if (GetVersion () >= 0x80000000) + { + *sec = -1; + *usec = 0; + return; + } + + /* The FILETIME structs filled in by GetProcessTimes represent + time in 100 nanosecond units. */ + GetProcessTimes (GetCurrentProcess (), &unused1, &unused2, + &kernel_time.ft, &user_time.ft); + + total_time = (kernel_time.ulltime + user_time.ulltime)/10; + *sec = total_time / 1000000; + *usec = total_time % 1000000; + } + + #else + static inline void __cpu_time_1 (long *sec, long *usec) { *************** __cpu_time_1 (long *sec, long *usec) *** 110,115 **** --- 148,155 ---- #endif /* HAVE_GETRUSAGE */ } + #endif + extern void cpu_time_4 (GFC_REAL_4 *); iexport_proto(cpu_time_4); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/cshift0.c gcc-4.1.0/libgfortran/intrinsics/cshift0.c *** gcc-4.0.2/libgfortran/intrinsics/cshift0.c Mon May 23 20:03:50 2005 --- gcc-4.1.0/libgfortran/intrinsics/cshift0.c Tue Sep 13 07:15:01 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** DEF_COPY_LOOP(cdouble, _Complex double) *** 78,84 **** static void cshift0 (gfc_array_char * ret, const gfc_array_char * array, ! ssize_t shift, int which) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 78,84 ---- static void cshift0 (gfc_array_char * ret, const gfc_array_char * array, ! ssize_t shift, int which, index_type size) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** cshift0 (gfc_array_char * ret, const gfc *** 95,101 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int whichloop; --- 95,100 ---- *************** cshift0 (gfc_array_char * ret, const gfc *** 107,113 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; /* The values assigned here must match the cases in the inner loop. */ --- 106,111 ---- *************** cshift0 (gfc_array_char * ret, const gfc *** 148,154 **** int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 146,152 ---- int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** cshift0 (gfc_array_char * ret, const gfc *** 298,348 **** } } ! extern void cshift0_1 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_1 *, const GFC_INTEGER_1 *); ! export_proto(cshift0_1); ! ! void ! cshift0_1 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_1 *pshift, const GFC_INTEGER_1 *pdim) ! { ! cshift0 (ret, array, *pshift, pdim ? *pdim : 1); ! } ! ! ! extern void cshift0_2 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_2 *, const GFC_INTEGER_2 *); ! export_proto(cshift0_2); ! ! void ! cshift0_2 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_2 *pshift, const GFC_INTEGER_2 *pdim) ! { ! cshift0 (ret, array, *pshift, pdim ? *pdim : 1); ! } ! ! ! extern void cshift0_4 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_4 *, const GFC_INTEGER_4 *); ! export_proto(cshift0_4); ! ! void ! cshift0_4 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_4 *pshift, const GFC_INTEGER_4 *pdim) ! { ! cshift0 (ret, array, *pshift, pdim ? *pdim : 1); ! } ! ! ! extern void cshift0_8 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_8 *, const GFC_INTEGER_8 *); ! export_proto(cshift0_8); ! ! void ! cshift0_8 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_8 *pshift, const GFC_INTEGER_8 *pdim) ! { ! cshift0 (ret, array, *pshift, pdim ? *pdim : 1); ! } ! --- 296,332 ---- } } + #define DEFINE_CSHIFT(N) \ + extern void cshift0_##N (gfc_array_char *, const gfc_array_char *, \ + const GFC_INTEGER_##N *, const GFC_INTEGER_##N *); \ + export_proto(cshift0_##N); \ + \ + void \ + cshift0_##N (gfc_array_char *ret, const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, const GFC_INTEGER_##N *pdim) \ + { \ + cshift0 (ret, array, *pshift, pdim ? *pdim : 1, \ + GFC_DESCRIPTOR_SIZE (array)); \ + } \ + \ + extern void cshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + const GFC_INTEGER_##N *, GFC_INTEGER_4); \ + export_proto(cshift0_##N##_char); \ + \ + void \ + cshift0_##N##_char (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length) \ + { \ + cshift0 (ret, array, *pshift, pdim ? *pdim : 1, array_length); \ + } ! DEFINE_CSHIFT (1); ! DEFINE_CSHIFT (2); ! DEFINE_CSHIFT (4); ! DEFINE_CSHIFT (8); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/ctime.c gcc-4.1.0/libgfortran/intrinsics/ctime.c *** gcc-4.0.2/libgfortran/intrinsics/ctime.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/intrinsics/ctime.c Sun Nov 6 10:17:04 2005 *************** *** 0 **** --- 1,160 ---- + /* Implementation of the CTIME and FDATE g77 intrinsics. + Copyright (C) 2005 Free Software Foundation, Inc. + Contributed by Fran§ois-Xavier Coudert + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + #ifdef TIME_WITH_SYS_TIME + # include + # include + #else + # if HAVE_SYS_TIME_H + # include + # else + # ifdef HAVE_TIME_H + # include + # endif + # endif + #endif + + #include + + + extern void fdate (char **, gfc_charlen_type *); + export_proto(fdate); + + void + fdate (char ** date, gfc_charlen_type * date_len) + { + #if defined(HAVE_TIME) && defined(HAVE_CTIME) + int i; + time_t now = time(NULL); + *date = ctime (&now); + if (*date != NULL) + { + *date = strdup (*date); + *date_len = strlen (*date); + + i = 0; + while ((*date)[i]) + { + if ((*date)[i] == '\n') + (*date)[i] = ' '; + i++; + } + return; + } + #endif + + *date = NULL; + *date_len = 0; + } + + + extern void fdate_sub (char *, gfc_charlen_type); + export_proto(fdate_sub); + + void + fdate_sub (char * date, gfc_charlen_type date_len) + { + #if defined(HAVE_TIME) && defined(HAVE_CTIME) + int i; + char *d; + time_t now = time(NULL); + #endif + + memset (date, ' ', date_len); + #if defined(HAVE_TIME) && defined(HAVE_CTIME) + d = ctime (&now); + if (d != NULL) + { + i = 0; + while (*d && *d != '\n' && i < date_len) + date[i++] = *(d++); + } + #endif + } + + + + extern void PREFIX(ctime) (char **, gfc_charlen_type *, GFC_INTEGER_8); + export_proto_np(PREFIX(ctime)); + + void + PREFIX(ctime) (char ** date, gfc_charlen_type * date_len, GFC_INTEGER_8 t) + { + #if defined(HAVE_CTIME) + time_t now = t; + int i; + *date = ctime (&now); + if (*date != NULL) + { + *date = strdup (*date); + *date_len = strlen (*date); + + i = 0; + while ((*date)[i]) + { + if ((*date)[i] == '\n') + (*date)[i] = ' '; + i++; + } + return; + } + #endif + + *date = NULL; + *date_len = 0; + } + + + extern void ctime_sub (GFC_INTEGER_8 *, char *, gfc_charlen_type); + export_proto(ctime_sub); + + void + ctime_sub (GFC_INTEGER_8 * t, char * date, gfc_charlen_type date_len) + { + #if defined(HAVE_CTIME) + int i; + char *d; + time_t now = *t; + #endif + + memset (date, ' ', date_len); + #if defined(HAVE_CTIME) + d = ctime (&now); + if (d != NULL) + { + i = 0; + while (*d && *d != '\n' && i < date_len) + date[i++] = *(d++); + } + #endif + } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/date_and_time.c gcc-4.1.0/libgfortran/intrinsics/date_and_time.c *** gcc-4.0.2/libgfortran/intrinsics/date_and_time.c Sat Feb 19 18:06:00 2005 --- gcc-4.1.0/libgfortran/intrinsics/date_and_time.c Tue Nov 1 05:53:29 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** date_and_time (char *__date, char *__tim *** 305,307 **** --- 305,361 ---- fstrcpy (__date, DATE_LEN, date, DATE_LEN); } } + + + /* SECNDS (X) - Non-standard + + Description: Returns the system time of day, or elapsed time, as a GFC_REAL_4 + in seconds. + + Class: Non-elemental subroutine. + + Arguments: + + X must be REAL(4) and the result is of the same type. The accuracy is system + dependent. + + Usage: + + T = SECNDS (X) + + yields the time in elapsed seconds since X. If X is 0.0, T is the time in + seconds since midnight. Note that a time that spans midnight but is less than + 24hours will be calculated correctly. */ + + extern GFC_REAL_4 secnds (GFC_REAL_4 *); + export_proto(secnds); + + GFC_REAL_4 + secnds (GFC_REAL_4 *x) + { + GFC_INTEGER_4 values[VALUES_SIZE]; + GFC_REAL_4 temp1, temp2; + + /* Make the INTEGER*4 array for passing to date_and_time. */ + gfc_array_i4 *avalues = internal_malloc_size (sizeof (gfc_array_i4)); + avalues->data = &values[0]; + GFC_DESCRIPTOR_DTYPE (avalues) = ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) + & GFC_DTYPE_TYPE_MASK) + + (4 << GFC_DTYPE_SIZE_SHIFT); + + avalues->dim[0].ubound = 7; + avalues->dim[0].lbound = 0; + avalues->dim[0].stride = 1; + + date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0); + + free_mem (avalues); + + temp1 = 3600.0 * (GFC_REAL_4)values[4] + + 60.0 * (GFC_REAL_4)values[5] + + (GFC_REAL_4)values[6] + + 0.001 * (GFC_REAL_4)values[7]; + temp2 = fmod (*x, 86400.0); + temp2 = (temp1 - temp2 > 0.0) ? temp2 : (temp2 - 86400.0); + return temp1 - temp2; + } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/dprod_r8.f90 gcc-4.1.0/libgfortran/intrinsics/dprod_r8.f90 *** gcc-4.0.2/libgfortran/intrinsics/dprod_r8.f90 Thu May 13 06:41:02 2004 --- gcc-4.1.0/libgfortran/intrinsics/dprod_r8.f90 Wed Aug 17 02:49:08 2005 *************** *** 15,22 **** ! !You should have received a copy of the GNU Lesser General Public !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! !Boston, MA 02111-1307, USA. elemental function specific__dprod_r8 (p1, p2) --- 15,22 ---- ! !You should have received a copy of the GNU Lesser General Public !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. elemental function specific__dprod_r8 (p1, p2) diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/env.c gcc-4.1.0/libgfortran/intrinsics/env.c *** gcc-4.0.2/libgfortran/intrinsics/env.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/env.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 26,33 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 26,33 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/eoshift0.c gcc-4.1.0/libgfortran/intrinsics/eoshift0.c *** gcc-4.0.2/libgfortran/intrinsics/eoshift0.c Thu Jul 14 21:17:22 2005 --- gcc-4.1.0/libgfortran/intrinsics/eoshift0.c Tue Sep 13 07:15:01 2005 *************** *** 1,5 **** /* Generic implementation of the EOSHIFT intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,48 **** #include #include "libgfortran.h" - static const char zeros[16] = - {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; - /* TODO: make this work for large shifts when sizeof(int) < sizeof (index_type). */ static void eoshift0 (gfc_array_char * ret, const gfc_array_char * array, ! int shift, const char * pbound, int which) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,46 ---- #include #include "libgfortran.h" /* TODO: make this work for large shifts when sizeof(int) < sizeof (index_type). */ static void eoshift0 (gfc_array_char * ret, const gfc_array_char * array, ! int shift, const char * pbound, int which, index_type size, ! char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** eoshift0 (gfc_array_char * ret, const gf *** 60,80 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; ! if (!pbound) ! pbound = zeros; ! ! size = GFC_DESCRIPTOR_SIZE (ret); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 58,78 ---- index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; index_type len; index_type n; ! /* The compiler cannot figure out that these are set, initialize ! them to avoid warnings. */ ! len = 0; ! soffset = 0; ! roffset = 0; if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** eoshift0 (gfc_array_char * ret, const gf *** 92,98 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { --- 90,95 ---- *************** eoshift0 (gfc_array_char * ret, const gf *** 168,178 **** n = -shift; } ! while (n--) ! { ! memcpy (dest, pbound, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; --- 165,182 ---- n = -shift; } ! if (pbound) ! while (n--) ! { ! memcpy (dest, pbound, size); ! dest += roffset; ! } ! else ! while (n--) ! { ! memset (dest, filler, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; *************** eoshift0 (gfc_array_char * ret, const gf *** 206,263 **** } ! extern void eoshift0_1 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_1 *, const char *, ! const GFC_INTEGER_1 *); ! export_proto(eoshift0_1); ! ! void ! eoshift0_1 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_1 *pshift, const char *pbound, ! const GFC_INTEGER_1 *pdim) ! { ! eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1); ! } ! ! ! extern void eoshift0_2 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_2 *, const char *, ! const GFC_INTEGER_2 *); ! export_proto(eoshift0_2); ! ! void ! eoshift0_2 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_2 *pshift, const char *pbound, ! const GFC_INTEGER_2 *pdim) ! { ! eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1); ! } ! ! ! extern void eoshift0_4 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_4 *, const char *, ! const GFC_INTEGER_4 *); ! export_proto(eoshift0_4); ! ! void ! eoshift0_4 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_4 *pshift, const char *pbound, ! const GFC_INTEGER_4 *pdim) ! { ! eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1); ! } ! ! ! extern void eoshift0_8 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_8 *, const char *, ! const GFC_INTEGER_8 *); ! export_proto(eoshift0_8); ! ! void ! eoshift0_8 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_8 *pshift, const char *pbound, ! const GFC_INTEGER_8 *pdim) ! { ! eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1); ! } --- 210,252 ---- } ! #define DEFINE_EOSHIFT(N) \ ! extern void eoshift0_##N (gfc_array_char *, const gfc_array_char *, \ ! const GFC_INTEGER_##N *, const char *, \ ! const GFC_INTEGER_##N *); \ ! export_proto(eoshift0_##N); \ ! \ ! void \ ! eoshift0_##N (gfc_array_char *ret, const gfc_array_char *array, \ ! const GFC_INTEGER_##N *pshift, const char *pbound, \ ! const GFC_INTEGER_##N *pdim) \ ! { \ ! eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! GFC_DESCRIPTOR_SIZE (array), 0); \ ! } \ ! \ ! extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ ! const gfc_array_char *, \ ! const GFC_INTEGER_##N *, const char *, \ ! const GFC_INTEGER_##N *, GFC_INTEGER_4, \ ! GFC_INTEGER_4); \ ! export_proto(eoshift0_##N##_char); \ ! \ ! void \ ! eoshift0_##N##_char (gfc_array_char *ret, \ ! GFC_INTEGER_4 ret_length __attribute__((unused)), \ ! const gfc_array_char *array, \ ! const GFC_INTEGER_##N *pshift, \ ! const char *pbound, \ ! const GFC_INTEGER_##N *pdim, \ ! GFC_INTEGER_4 array_length, \ ! GFC_INTEGER_4 bound_length __attribute__((unused))) \ ! { \ ! eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! array_length, ' '); \ ! } + DEFINE_EOSHIFT (1); + DEFINE_EOSHIFT (2); + DEFINE_EOSHIFT (4); + DEFINE_EOSHIFT (8); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/eoshift2.c gcc-4.1.0/libgfortran/intrinsics/eoshift2.c *** gcc-4.0.2/libgfortran/intrinsics/eoshift2.c Thu Jul 14 21:17:22 2005 --- gcc-4.1.0/libgfortran/intrinsics/eoshift2.c Tue Sep 13 07:15:01 2005 *************** *** 1,5 **** /* Generic implementation of the EOSHIFT intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,48 **** #include #include "libgfortran.h" - static const char zeros[16] = - {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; - /* TODO: make this work for large shifts when sizeof(int) < sizeof (index_type). */ static void eoshift2 (gfc_array_char *ret, const gfc_array_char *array, ! int shift, const gfc_array_char *bound, int which) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,46 ---- #include #include "libgfortran.h" /* TODO: make this work for large shifts when sizeof(int) < sizeof (index_type). */ static void eoshift2 (gfc_array_char *ret, const gfc_array_char *array, ! int shift, const gfc_array_char *bound, int which, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** eoshift2 (gfc_array_char *ret, const gfc *** 64,81 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; ! size = GFC_DESCRIPTOR_SIZE (ret); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 62,82 ---- index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; index_type len; index_type n; ! /* The compiler cannot figure out that these are set, initialize ! them to avoid warnings. */ ! len = 0; ! soffset = 0; ! roffset = 0; if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** eoshift2 (gfc_array_char *ret, const gfc *** 93,99 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { --- 94,99 ---- *************** eoshift2 (gfc_array_char *ret, const gfc *** 150,156 **** if (bound) bptr = bound->data; else ! bptr = zeros; while (rptr) { --- 150,156 ---- if (bound) bptr = bound->data; else ! bptr = NULL; while (rptr) { *************** eoshift2 (gfc_array_char *ret, const gfc *** 181,191 **** n = -shift; } ! while (n--) ! { ! memcpy (dest, bptr, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; --- 181,198 ---- n = -shift; } ! if (bptr) ! while (n--) ! { ! memcpy (dest, bptr, size); ! dest += roffset; ! } ! else ! while (n--) ! { ! memset (dest, filler, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; *************** eoshift2 (gfc_array_char *ret, const gfc *** 222,279 **** } ! extern void eoshift2_1 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_1 *, const gfc_array_char *, ! const GFC_INTEGER_1 *); ! export_proto(eoshift2_1); ! ! void ! eoshift2_1 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_1 *pshift, const gfc_array_char *bound, ! const GFC_INTEGER_1 *pdim) ! { ! eoshift2 (ret, array, *pshift, bound, pdim ? *pdim : 1); ! } ! ! ! extern void eoshift2_2 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_2 *, const gfc_array_char *, ! const GFC_INTEGER_2 *); ! export_proto(eoshift2_2); ! ! void ! eoshift2_2 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_2 *pshift, const gfc_array_char *bound, ! const GFC_INTEGER_2 *pdim) ! { ! eoshift2 (ret, array, *pshift, bound, pdim ? *pdim : 1); ! } ! ! ! extern void eoshift2_4 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_4 *, const gfc_array_char *, ! const GFC_INTEGER_4 *); ! export_proto(eoshift2_4); ! ! void ! eoshift2_4 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_4 *pshift, const gfc_array_char *bound, ! const GFC_INTEGER_4 *pdim) ! { ! eoshift2 (ret, array, *pshift, bound, pdim ? *pdim : 1); ! } ! ! ! extern void eoshift2_8 (gfc_array_char *, const gfc_array_char *, ! const GFC_INTEGER_8 *, const gfc_array_char *, ! const GFC_INTEGER_8 *); ! export_proto(eoshift2_8); ! ! void ! eoshift2_8 (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_INTEGER_8 *pshift, const gfc_array_char *bound, ! const GFC_INTEGER_8 *pdim) ! { ! eoshift2 (ret, array, *pshift, bound, pdim ? *pdim : 1); ! } --- 229,272 ---- } ! #define DEFINE_EOSHIFT(N) \ ! extern void eoshift2_##N (gfc_array_char *, const gfc_array_char *, \ ! const GFC_INTEGER_##N *, const gfc_array_char *, \ ! const GFC_INTEGER_##N *); \ ! export_proto(eoshift2_##N); \ ! \ ! void \ ! eoshift2_##N (gfc_array_char *ret, const gfc_array_char *array, \ ! const GFC_INTEGER_##N *pshift, const gfc_array_char *pbound, \ ! const GFC_INTEGER_##N *pdim) \ ! { \ ! eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! GFC_DESCRIPTOR_SIZE (array), 0); \ ! } \ ! \ ! extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ ! const gfc_array_char *, \ ! const GFC_INTEGER_##N *, \ ! const gfc_array_char *, \ ! const GFC_INTEGER_##N *, \ ! GFC_INTEGER_4, GFC_INTEGER_4); \ ! export_proto(eoshift2_##N##_char); \ ! \ ! void \ ! eoshift2_##N##_char (gfc_array_char *ret, \ ! GFC_INTEGER_4 ret_length __attribute__((unused)), \ ! const gfc_array_char *array, \ ! const GFC_INTEGER_##N *pshift, \ ! const gfc_array_char *pbound, \ ! const GFC_INTEGER_##N *pdim, \ ! GFC_INTEGER_4 array_length, \ ! GFC_INTEGER_4 bound_length __attribute__((unused))) \ ! { \ ! eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ ! array_length, ' '); \ ! } + DEFINE_EOSHIFT (1); + DEFINE_EOSHIFT (2); + DEFINE_EOSHIFT (4); + DEFINE_EOSHIFT (8); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/erf.c gcc-4.1.0/libgfortran/intrinsics/erf.c *** gcc-4.0.2/libgfortran/intrinsics/erf.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/erf.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 24,31 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 24,31 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/etime.c gcc-4.1.0/libgfortran/intrinsics/etime.c *** gcc-4.0.2/libgfortran/intrinsics/etime.c Tue Jul 12 01:50:36 2005 --- gcc-4.1.0/libgfortran/intrinsics/etime.c Wed Aug 17 02:49:08 2005 *************** *** 1,5 **** /* Implementation of the ETIME intrinsic. ! Copyright (C) 2004 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the ETIME intrinsic. ! Copyright (C) 2004, 2005 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** etime (gfc_array_r4 *t) *** 94,100 **** return val; } ! /* LAPACK's test programs declares ETIME external, therefore we need this. */ extern GFC_REAL_4 etime_ (GFC_REAL_4 *t); --- 94,100 ---- return val; } ! /* LAPACK's test programs declares ETIME external, therefore we need this. */ extern GFC_REAL_4 etime_ (GFC_REAL_4 *t); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/exit.c gcc-4.1.0/libgfortran/intrinsics/exit.c *** gcc-4.0.2/libgfortran/intrinsics/exit.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/exit.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/f2c_specifics.F90 gcc-4.1.0/libgfortran/intrinsics/f2c_specifics.F90 *** gcc-4.0.2/libgfortran/intrinsics/f2c_specifics.F90 Wed Jun 1 23:02:17 2005 --- gcc-4.1.0/libgfortran/intrinsics/f2c_specifics.F90 Wed Aug 17 02:49:08 2005 *************** *** 24,31 **** ! !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., 59 Temple Place - Suite 330, ! !Boston, MA 02111-1307, USA. ! ! Specifics for the intrinsics whose calling conventions change if ! -ff2c is used. --- 24,31 ---- ! !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. ! ! Specifics for the intrinsics whose calling conventions change if ! -ff2c is used. diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/fget.c gcc-4.1.0/libgfortran/intrinsics/fget.c *** gcc-4.0.2/libgfortran/intrinsics/fget.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/intrinsics/fget.c Mon Nov 28 07:17:39 2005 *************** *** 0 **** --- 1,177 ---- + /* Implementation of the FGET, FGETC, FPUT and FPUTC intrinsics. + Copyright (C) 2005 Free Software Foundation, Inc. + Contributed by Fran§ois-Xavier Coudert + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + #include + + #include "../io/io.h" + + static const int five = 5; + static const int six = 6; + + extern int PREFIX(fgetc) (const int *, char *, gfc_charlen_type); + export_proto_np(PREFIX(fgetc)); + + int + PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len) + { + int ret; + size_t s; + gfc_unit * u = find_unit (*unit); + + if (u == NULL) + return -1; + + s = 1; + memset (c, ' ', c_len); + ret = sread (u->s, c, &s); + unlock_unit (u); + + if (ret != 0) + return ret; + + if (s != 1) + return -1; + else + return 0; + } + + + #define FGETC_SUB(kind) \ + extern void fgetc_i ## kind ## _sub \ + (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \ + export_proto(fgetc_i ## kind ## _sub); \ + void fgetc_i ## kind ## _sub \ + (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \ + { if (st != NULL) \ + *st = PREFIX(fgetc) (unit, c, c_len); \ + else \ + PREFIX(fgetc) (unit, c, c_len); } + + FGETC_SUB(1) + FGETC_SUB(2) + FGETC_SUB(4) + FGETC_SUB(8) + + + extern int PREFIX(fget) (char *, gfc_charlen_type); + export_proto_np(PREFIX(fget)); + + int + PREFIX(fget) (char * c, gfc_charlen_type c_len) + { + return PREFIX(fgetc) (&five, c, c_len); + } + + + #define FGET_SUB(kind) \ + extern void fget_i ## kind ## _sub \ + (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \ + export_proto(fget_i ## kind ## _sub); \ + void fget_i ## kind ## _sub \ + (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \ + { if (st != NULL) \ + *st = PREFIX(fgetc) (&five, c, c_len); \ + else \ + PREFIX(fgetc) (&five, c, c_len); } + + FGET_SUB(1) + FGET_SUB(2) + FGET_SUB(4) + FGET_SUB(8) + + + + extern int PREFIX(fputc) (const int *, char *, gfc_charlen_type); + export_proto_np(PREFIX(fputc)); + + int + PREFIX(fputc) (const int * unit, char * c, + gfc_charlen_type c_len __attribute__((unused))) + { + size_t s; + int ret; + gfc_unit * u = find_unit (*unit); + + if (u == NULL) + return -1; + + s = 1; + ret = swrite (u->s, c, &s); + unlock_unit (u); + return ret; + } + + + #define FPUTC_SUB(kind) \ + extern void fputc_i ## kind ## _sub \ + (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \ + export_proto(fputc_i ## kind ## _sub); \ + void fputc_i ## kind ## _sub \ + (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \ + { if (st != NULL) \ + *st = PREFIX(fputc) (unit, c, c_len); \ + else \ + PREFIX(fputc) (unit, c, c_len); } + + FPUTC_SUB(1) + FPUTC_SUB(2) + FPUTC_SUB(4) + FPUTC_SUB(8) + + + extern int PREFIX(fput) (char *, gfc_charlen_type); + export_proto_np(PREFIX(fput)); + + int + PREFIX(fput) (char * c, gfc_charlen_type c_len) + { + return PREFIX(fputc) (&six, c, c_len); + } + + + #define FPUT_SUB(kind) \ + extern void fput_i ## kind ## _sub \ + (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \ + export_proto(fput_i ## kind ## _sub); \ + void fput_i ## kind ## _sub \ + (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \ + { if (st != NULL) \ + *st = PREFIX(fputc) (&six, c, c_len); \ + else \ + PREFIX(fputc) (&six, c, c_len); } + + FPUT_SUB(1) + FPUT_SUB(2) + FPUT_SUB(4) + FPUT_SUB(8) + diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/flush.c gcc-4.1.0/libgfortran/intrinsics/flush.c *** gcc-4.0.2/libgfortran/intrinsics/flush.c Mon Aug 1 21:15:22 2005 --- gcc-4.1.0/libgfortran/intrinsics/flush.c Tue Nov 22 10:58:47 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" *************** Boston, MA 02111-1307, USA. */ *** 41,59 **** /* SUBROUTINE FLUSH(UNIT) INTEGER, INTENT(IN), OPTIONAL :: UNIT */ - static void - recursive_flush (gfc_unit *us) - { - /* There can be no open files. */ - if (us == NULL) - return; - - flush (us->s); - recursive_flush (us->left); - recursive_flush (us->right); - } - - extern void flush_i4 (GFC_INTEGER_4 *); export_proto(flush_i4); --- 41,46 ---- *************** flush_i4 (GFC_INTEGER_4 *unit) *** 64,78 **** /* flush all streams */ if (unit == NULL) ! { ! us = g.unit_root; ! recursive_flush(us); ! } else { ! us = find_unit(*unit); if (us != NULL) ! flush (us->s); } } --- 51,65 ---- /* flush all streams */ if (unit == NULL) ! flush_all_units (); else { ! us = find_unit (*unit); if (us != NULL) ! { ! flush (us->s); ! unlock_unit (us); ! } } } *************** flush_i8 (GFC_INTEGER_8 *unit) *** 87,100 **** /* flush all streams */ if (unit == NULL) ! { ! us = g.unit_root; ! recursive_flush(us); ! } else { ! us = find_unit(*unit); if (us != NULL) ! flush (us->s); } } --- 74,87 ---- /* flush all streams */ if (unit == NULL) ! flush_all_units (); else { ! us = find_unit (*unit); if (us != NULL) ! { ! flush (us->s); ! unlock_unit (us); ! } } } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/fnum.c gcc-4.1.0/libgfortran/intrinsics/fnum.c *** gcc-4.0.2/libgfortran/intrinsics/fnum.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/fnum.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/ftell.c gcc-4.1.0/libgfortran/intrinsics/ftell.c *** gcc-4.0.2/libgfortran/intrinsics/ftell.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/intrinsics/ftell.c Mon Nov 28 07:17:39 2005 *************** *** 0 **** --- 1,72 ---- + /* Implementation of the FTELL intrinsic. + Copyright (C) 2005 Free Software Foundation, Inc. + Contributed by Fran§ois-Xavier Coudert + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + #include + + #include "../io/io.h" + + extern size_t PREFIX(ftell) (int *); + export_proto_np(PREFIX(ftell)); + + size_t + PREFIX(ftell) (int * unit) + { + gfc_unit * u = find_unit (*unit); + size_t ret; + if (u == NULL) + return ((size_t) -1); + ret = (size_t) stream_offset (u->s); + unlock_unit (u); + return ret; + } + + #define FTELL_SUB(kind) \ + extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \ + export_proto(ftell_i ## kind ## _sub); \ + void \ + ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \ + { \ + gfc_unit * u = find_unit (*unit); \ + if (u == NULL) \ + *offset = -1; \ + else \ + { \ + *offset = stream_offset (u->s); \ + unlock_unit (u); \ + } \ + } + + FTELL_SUB(1) + FTELL_SUB(2) + FTELL_SUB(4) + FTELL_SUB(8) diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/gerror.c gcc-4.1.0/libgfortran/intrinsics/gerror.c *** gcc-4.0.2/libgfortran/intrinsics/gerror.c Tue Mar 22 23:15:12 2005 --- gcc-4.1.0/libgfortran/intrinsics/gerror.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/getXid.c gcc-4.1.0/libgfortran/intrinsics/getXid.c *** gcc-4.0.2/libgfortran/intrinsics/getXid.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/getXid.c Wed Oct 19 09:45:27 2005 *************** GNU General Public License for more deta *** 24,31 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" --- 24,31 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" *************** Boston, MA 02111-1307, USA. */ *** 38,43 **** --- 38,48 ---- #include "libgfortran.h" + #ifdef __MINGW32__ + #define HAVE_GETPID 1 + #include + #endif + #ifdef HAVE_GETGID extern GFC_INTEGER_4 PREFIX(getgid) (void); export_proto_np(PREFIX(getgid)); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/getcwd.c gcc-4.1.0/libgfortran/intrinsics/getcwd.c *** gcc-4.0.2/libgfortran/intrinsics/getcwd.c Tue Jul 12 01:50:36 2005 --- gcc-4.1.0/libgfortran/intrinsics/getcwd.c Wed Aug 17 02:49:08 2005 *************** *** 1,5 **** /* Implementation of the GETCWD intrinsic. ! Copyright (C) 2004 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the GETCWD intrinsic. ! Copyright (C) 2004, 2005 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** getcwd_i4_sub (char *cwd, GFC_INTEGER_4 *** 58,64 **** stat = 0; memcpy (cwd, str, strlen (str)); } ! if (status != NULL) *status = stat; } iexport(getcwd_i4_sub); --- 58,64 ---- stat = 0; memcpy (cwd, str, strlen (str)); } ! if (status != NULL) *status = stat; } iexport(getcwd_i4_sub); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/getlog.c gcc-4.1.0/libgfortran/intrinsics/getlog.c *** gcc-4.0.2/libgfortran/intrinsics/getlog.c Sun May 15 08:27:26 2005 --- gcc-4.1.0/libgfortran/intrinsics/getlog.c Sun Sep 25 21:02:17 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 39,44 **** --- 39,67 ---- #endif + /* Windows32 version */ + #if defined __MINGW32__ && !defined HAVE_GETLOGIN + #define WIN32_LEAN_AND_MEAN + #include + #include /* for UNLEN */ + + static char * + w32_getlogin (void) + { + static char name [UNLEN + 1]; + DWORD namelen = sizeof (name); + + GetUserName (name, &namelen); + return (name[0] == 0 ? NULL : name); + } + + #undef getlogin + #define getlogin w32_getlogin + #define HAVE_GETLOGIN 1 + + #endif + + /* GETLOG (LOGIN), g77 intrinsic for retrieving the login name for the process. CHARACTER(len=*), INTENT(OUT) :: LOGIN */ *************** Boston, MA 02111-1307, USA. */ *** 47,53 **** void PREFIX(getlog) (char *, gfc_charlen_type); export_proto_np(PREFIX(getlog)); ! void PREFIX(getlog) (char * login, gfc_charlen_type login_len) { int p_len; --- 70,76 ---- void PREFIX(getlog) (char *, gfc_charlen_type); export_proto_np(PREFIX(getlog)); ! void PREFIX(getlog) (char * login, gfc_charlen_type login_len) { int p_len; diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/hostnm.c gcc-4.1.0/libgfortran/intrinsics/hostnm.c *** gcc-4.0.2/libgfortran/intrinsics/hostnm.c Tue Mar 22 23:15:12 2005 --- gcc-4.1.0/libgfortran/intrinsics/hostnm.c Sun Sep 25 21:02:17 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 38,44 **** #include #endif ! #include "../io/io.h" /* SUBROUTINE HOSTNM(NAME, STATUS) CHARACTER(len=*), INTENT(OUT) :: NAME --- 38,84 ---- #include #endif ! ! /* Windows32 version */ ! #if defined __MINGW32__ && !defined HAVE_GETHOSTNAME ! #define WIN32_LEAN_AND_MEAN ! #include ! #include ! ! static int ! w32_gethostname (char *name, size_t len) ! { ! /* We could try the WinSock API gethostname, but that will ! fail if WSAStartup function has has not been called. We don't ! really need a name that will be understood by socket API, so avoid ! unnecessary dependence on WinSock libraries by using ! GetComputerName instead. */ ! ! /* On Win9x GetComputerName fails if the input size is less ! than MAX_COMPUTERNAME_LENGTH + 1. */ ! char buffer[MAX_COMPUTERNAME_LENGTH + 1]; ! DWORD size = sizeof (buffer); ! ! if (!GetComputerName (buffer, &size)) ! return -1; ! ! if ((size = strlen (buffer) + 1) > len) ! { ! errno = EINVAL; ! /* Truncate as per POSIX spec. We do not NUL-terminate. */ ! size = len; ! } ! memcpy (name, buffer, (size_t) size); ! ! return 0; ! } ! ! #undef gethostname ! #define gethostname w32_gethostname ! #define HAVE_GETHOSTNAME 1 ! ! #endif ! /* SUBROUTINE HOSTNM(NAME, STATUS) CHARACTER(len=*), INTENT(OUT) :: NAME diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/hyper.c gcc-4.1.0/libgfortran/intrinsics/hyper.c *** gcc-4.0.2/libgfortran/intrinsics/hyper.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/intrinsics/hyper.c Wed Aug 17 02:49:08 2005 *************** *** 0 **** --- 1,56 ---- + /* Wrapper for systems without the C99 acosh(), asinh(), and atanh() functions + Copyright (C) 2005 Free Software Foundation, Inc. + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include + #include "libgfortran.h" + + #if HAVE_ACOSH && !HAVE_ACOSHF + float + acoshf (float x) + { + return (float) acosh ((double) x); + } + #endif + + #if HAVE_ASINH && !HAVE_ASINHF + float + asinhf (float x) + { + return (float) asinh ((double) x); + } + #endif + + #if HAVE_ATANH && !HAVE_ATANHF + float + atanhf (float x) + { + return (float) atanh ((double) x); + } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/ierrno.c gcc-4.1.0/libgfortran/intrinsics/ierrno.c *** gcc-4.0.2/libgfortran/intrinsics/ierrno.c Tue Mar 22 23:15:12 2005 --- gcc-4.1.0/libgfortran/intrinsics/ierrno.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/ishftc.c gcc-4.1.0/libgfortran/intrinsics/ishftc.c *** gcc-4.0.2/libgfortran/intrinsics/ishftc.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/ishftc.c Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "libgfortran.h" --- 25,32 ---- 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" *************** ishftc8 (GFC_INTEGER_8 i, GFC_INTEGER_4 *** 69,71 **** --- 69,93 ---- bits = i & ~mask; return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask); } + + #ifdef HAVE_GFC_INTEGER_16 + extern GFC_INTEGER_16 ishftc16 (GFC_INTEGER_16, GFC_INTEGER_4, GFC_INTEGER_4); + export_proto(ishftc16); + + GFC_INTEGER_16 + ishftc16 (GFC_INTEGER_16 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size) + { + GFC_INTEGER_16 mask; + GFC_UINTEGER_16 bits; + + if (shift < 0) + shift = shift + size; + + if (shift == 0 || shift == size) + return i; + + mask = (~(GFC_INTEGER_16)0) << size; + bits = i & ~mask; + return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask); + } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/kill.c gcc-4.1.0/libgfortran/intrinsics/kill.c *** gcc-4.0.2/libgfortran/intrinsics/kill.c Tue Mar 22 23:15:12 2005 --- gcc-4.1.0/libgfortran/intrinsics/kill.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/link.c gcc-4.1.0/libgfortran/intrinsics/link.c *** gcc-4.0.2/libgfortran/intrinsics/link.c Sun May 15 08:27:26 2005 --- gcc-4.1.0/libgfortran/intrinsics/link.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** link_i4_sub (char *path1, char *path2, G *** 67,81 **** /* Make a null terminated copy of the strings. */ str1 = gfc_alloca (path1_len + 1); memcpy (str1, path1, path1_len); ! str1[path1_len] = '\0'; str2 = gfc_alloca (path2_len + 1); memcpy (str2, path2, path2_len); ! str2[path2_len] = '\0'; val = link (str1, str2); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(link_i4_sub); --- 67,81 ---- /* Make a null terminated copy of the strings. */ str1 = gfc_alloca (path1_len + 1); memcpy (str1, path1, path1_len); ! str1[path1_len] = '\0'; str2 = gfc_alloca (path2_len + 1); memcpy (str2, path2, path2_len); ! str2[path2_len] = '\0'; val = link (str1, str2); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(link_i4_sub); *************** link_i8_sub (char *path1, char *path2, G *** 100,114 **** /* Make a null terminated copy of the strings. */ str1 = gfc_alloca (path1_len + 1); memcpy (str1, path1, path1_len); ! str1[path1_len] = '\0'; str2 = gfc_alloca (path2_len + 1); memcpy (str2, path2, path2_len); ! str2[path2_len] = '\0'; val = link (str1, str2); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(link_i8_sub); --- 100,114 ---- /* Make a null terminated copy of the strings. */ str1 = gfc_alloca (path1_len + 1); memcpy (str1, path1, path1_len); ! str1[path1_len] = '\0'; str2 = gfc_alloca (path2_len + 1); memcpy (str2, path2, path2_len); ! str2[path2_len] = '\0'; val = link (str1, str2); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(link_i8_sub); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/malloc.c gcc-4.1.0/libgfortran/intrinsics/malloc.c *** gcc-4.0.2/libgfortran/intrinsics/malloc.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/intrinsics/malloc.c Sun Oct 30 12:17:48 2005 *************** *** 0 **** --- 1,55 ---- + /* Implementation of the MALLOC and FREE intrinsics + Copyright (C) 2005 Free Software Foundation, Inc. + Contributed by Fran§ois-Xavier Coudert + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + #ifdef HAVE_STDLIB_H + #include + #endif + + extern void PREFIX(free) (void **); + export_proto_np(PREFIX(free)); + + void + PREFIX(free) (void ** ptr) + { + free (*ptr); + } + + + extern void * PREFIX(malloc) (size_t *); + export_proto_np(PREFIX(malloc)); + + void * + PREFIX(malloc) (size_t * size) + { + return malloc (*size); + } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/mvbits.c gcc-4.1.0/libgfortran/intrinsics/mvbits.c *** gcc-4.0.2/libgfortran/intrinsics/mvbits.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/mvbits.c Wed Feb 8 13:14:43 2006 *************** *** 1,6 **** /* Implementation of the MVBITS intrinsic ! Copyright (C) 2004 Free Software Foundation, Inc. ! Contributed by Tobias Schlĵter This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,6 ---- /* Implementation of the MVBITS intrinsic ! Copyright (C) 2004, 2006 Free Software Foundation, Inc. ! Contributed by Tobias Schlüter This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* TODO: This should be replaced by a compiler builtin. */ --- 25,32 ---- 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. */ /* TODO: This should be replaced by a compiler builtin. */ *************** SUB_NAME (const TYPE *from, const GFC_IN *** 48,54 **** { TYPE oldbits, newbits, lenmask; ! lenmask = (*len == sizeof (TYPE)*8) ? ~(TYPE)0 : (1 << *len) - 1; newbits = (((UTYPE)(*from) >> *frompos) & lenmask) << *topos; oldbits = *to & (~(lenmask << *topos)); --- 48,54 ---- { TYPE oldbits, newbits, lenmask; ! lenmask = (*len == sizeof (TYPE)*8) ? ~(TYPE)0 : ((TYPE)1 << *len) - 1; newbits = (((UTYPE)(*from) >> *frompos) & lenmask) << *topos; oldbits = *to & (~(lenmask << *topos)); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/pack_generic.c gcc-4.1.0/libgfortran/intrinsics/pack_generic.c *** gcc-4.0.2/libgfortran/intrinsics/pack_generic.c Sun May 15 15:58:16 2005 --- gcc-4.1.0/libgfortran/intrinsics/pack_generic.c Tue Sep 13 07:15:01 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 74,86 **** There are two variants of the PACK intrinsic: one, where MASK is array valued, and the other one where MASK is scalar. */ ! extern void pack (gfc_array_char *, const gfc_array_char *, ! const gfc_array_l4 *, const gfc_array_char *); ! export_proto(pack); ! ! void ! pack (gfc_array_char *ret, const gfc_array_char *array, ! const gfc_array_l4 *mask, const gfc_array_char *vector) { /* r.* indicates the return array. */ index_type rstride0; --- 74,83 ---- There are two variants of the PACK intrinsic: one, where MASK is array valued, and the other one where MASK is scalar. */ ! static void ! pack_internal (gfc_array_char *ret, const gfc_array_char *array, ! const gfc_array_l4 *mask, const gfc_array_char *vector, ! index_type size) { /* r.* indicates the return array. */ index_type rstride0; *************** pack (gfc_array_char *ret, const gfc_arr *** 98,107 **** index_type extent[GFC_MAX_DIMENSIONS]; index_type n; index_type dim; - index_type size; index_type nelem; - size = GFC_DESCRIPTOR_SIZE (array); dim = GFC_DESCRIPTOR_RANK (array); for (n = 0; n < dim; n++) { --- 95,102 ---- *************** pack (gfc_array_char *ret, const gfc_arr *** 189,195 **** else { count[n]++; ! mptr += mstride[n]; } } } --- 184,190 ---- else { count[n]++; ! m += mstride[n]; } } } *************** pack (gfc_array_char *ret, const gfc_arr *** 201,207 **** ret->dim[0].stride = 1; ret->data = internal_malloc_size (size * total); ! ret->base = 0; if (total == 0) /* In this case, nothing remains to be done. */ --- 196,202 ---- ret->dim[0].stride = 1; ret->data = internal_malloc_size (size * total); ! ret->offset = 0; if (total == 0) /* In this case, nothing remains to be done. */ *************** pack (gfc_array_char *ret, const gfc_arr *** 277,289 **** } } ! extern void pack_s (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_LOGICAL_4 *, const gfc_array_char *); ! export_proto(pack_s); void ! pack_s (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_LOGICAL_4 *mask, const gfc_array_char *vector) { /* r.* indicates the return array. */ index_type rstride0; --- 272,307 ---- } } ! extern void pack (gfc_array_char *, const gfc_array_char *, ! const gfc_array_l4 *, const gfc_array_char *); ! export_proto(pack); void ! pack (gfc_array_char *ret, const gfc_array_char *array, ! const gfc_array_l4 *mask, const gfc_array_char *vector) ! { ! pack_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array)); ! } ! ! extern void pack_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, ! const gfc_array_l4 *, const gfc_array_char *, ! GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(pack_char); ! ! void ! pack_char (gfc_array_char *ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char *array, const gfc_array_l4 *mask, ! const gfc_array_char *vector, GFC_INTEGER_4 array_length, ! GFC_INTEGER_4 vector_length __attribute__((unused))) ! { ! pack_internal (ret, array, mask, vector, array_length); ! } ! ! static void ! pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, ! const GFC_LOGICAL_4 *mask, const gfc_array_char *vector, ! index_type size) { /* r.* indicates the return array. */ index_type rstride0; *************** pack_s (gfc_array_char *ret, const gfc_a *** 297,306 **** index_type extent[GFC_MAX_DIMENSIONS]; index_type n; index_type dim; - index_type size; index_type nelem; - size = GFC_DESCRIPTOR_SIZE (array); dim = GFC_DESCRIPTOR_RANK (array); for (n = 0; n < dim; n++) { --- 315,322 ---- *************** pack_s (gfc_array_char *ret, const gfc_a *** 342,348 **** ret->dim[0].ubound = -1; ret->dim[0].stride = 1; ret->data = internal_malloc_size (0); ! ret->base = 0; return; } --- 358,364 ---- ret->dim[0].ubound = -1; ret->dim[0].stride = 1; ret->data = internal_malloc_size (0); ! ret->offset = 0; return; } *************** pack_s (gfc_array_char *ret, const gfc_a *** 354,360 **** ret->dim[0].stride = 1; ret->data = internal_malloc_size (size * total); ! ret->base = 0; } rstride0 = ret->dim[0].stride * size; --- 370,376 ---- ret->dim[0].stride = 1; ret->data = internal_malloc_size (size * total); ! ret->offset = 0; } rstride0 = ret->dim[0].stride * size; *************** pack_s (gfc_array_char *ret, const gfc_a *** 426,428 **** --- 442,471 ---- } } } + + extern void pack_s (gfc_array_char *ret, const gfc_array_char *array, + const GFC_LOGICAL_4 *, const gfc_array_char *); + export_proto(pack_s); + + void + pack_s (gfc_array_char *ret, const gfc_array_char *array, + const GFC_LOGICAL_4 *mask, const gfc_array_char *vector) + { + pack_s_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array)); + } + + extern void pack_s_char (gfc_array_char *ret, GFC_INTEGER_4, + const gfc_array_char *array, const GFC_LOGICAL_4 *, + const gfc_array_char *, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(pack_s_char); + + void + pack_s_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const GFC_LOGICAL_4 *mask, + const gfc_array_char *vector, GFC_INTEGER_4 array_length, + GFC_INTEGER_4 vector_length __attribute__((unused))) + { + pack_s_internal (ret, array, mask, vector, array_length); + } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/perror.c gcc-4.1.0/libgfortran/intrinsics/perror.c *** gcc-4.0.2/libgfortran/intrinsics/perror.c Sun May 15 08:27:26 2005 --- gcc-4.1.0/libgfortran/intrinsics/perror.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** perror_sub (char *string, gfc_charlen_ty *** 59,65 **** /* Make a null terminated copy of the strings. */ str = gfc_alloca (string_len + 1); memcpy (str, string, string_len); ! str[string_len] = '\0'; perror (str); } --- 59,65 ---- /* Make a null terminated copy of the strings. */ str = gfc_alloca (string_len + 1); memcpy (str, string, string_len); ! str[string_len] = '\0'; perror (str); } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/rand.c gcc-4.1.0/libgfortran/intrinsics/rand.c *** gcc-4.0.2/libgfortran/intrinsics/rand.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/rand.c Tue Nov 22 10:58:47 2005 *************** *** 1,5 **** /* Implementation of the IRAND, RAND, and SRAND intrinsics. ! Copyright (C) 2004 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the IRAND, RAND, and SRAND intrinsics. ! Copyright (C) 2004, 2005 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* Simple multiplicative congruent algorithm. The period of this generator is approximately 2^31-1, which means that --- 25,32 ---- 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. */ /* Simple multiplicative congruent algorithm. The period of this generator is approximately 2^31-1, which means that *************** Boston, MA 02111-1307, USA. */ *** 37,48 **** --- 37,54 ---- #include "config.h" #include "libgfortran.h" + #include "../io/io.h" #define GFC_RAND_A 16807 #define GFC_RAND_M 2147483647 #define GFC_RAND_M1 (GFC_RAND_M - 1) static GFC_UINTEGER_8 rand_seed = 1; + #ifdef __GTHREAD_MUTEX_INIT + static __gthread_mutex_t rand_seed_lock = __GTHREAD_MUTEX_INIT; + #else + static __gthread_mutex_t rand_seed_lock; + #endif /* Set the seed of the irand generator. Note 0 is a bad seed. */ *************** export_proto_np(PREFIX(srand)); *** 59,65 **** --- 65,73 ---- void PREFIX(srand) (GFC_INTEGER_4 *i) { + __gthread_mutex_lock (&rand_seed_lock); srand_internal (*i); + __gthread_mutex_unlock (&rand_seed_lock); } /* Return an INTEGER in the range [1,GFC_RAND_M-1]. */ *************** irand (GFC_INTEGER_4 *i) *** 76,81 **** --- 84,91 ---- else j = 0; + __gthread_mutex_lock (&rand_seed_lock); + switch (j) { /* Return the next RN. */ *************** irand (GFC_INTEGER_4 *i) *** 95,102 **** } rand_seed = GFC_RAND_A * rand_seed % GFC_RAND_M; ! return (GFC_INTEGER_4) rand_seed; } iexport(irand); --- 105,115 ---- } rand_seed = GFC_RAND_A * rand_seed % GFC_RAND_M; + j = (GFC_INTEGER_4) rand_seed; ! __gthread_mutex_unlock (&rand_seed_lock); ! ! return j; } iexport(irand); *************** PREFIX(rand) (GFC_INTEGER_4 *i) *** 111,113 **** --- 124,134 ---- { return normalize_r4_i4 (irand (i) - 1, GFC_RAND_M1 - 1); } + + #ifndef __GTHREAD_MUTEX_INIT + static void __attribute__((constructor)) + init (void) + { + __GTHREAD_MUTEX_INIT_FUNCTION (&rand_seed_lock); + } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/random.c gcc-4.1.0/libgfortran/intrinsics/random.c *** gcc-4.0.2/libgfortran/intrinsics/random.c Mon May 23 20:03:50 2005 --- gcc-4.1.0/libgfortran/intrinsics/random.c Sun Dec 4 18:22:20 2005 *************** *** 1,5 **** /* Implementation of the RANDOM intrinsics ! Copyright 2002, 2004 Free Software Foundation, Inc. Contributed by Lars Segerlund and Steve Kargl. --- 1,5 ---- /* Implementation of the RANDOM intrinsics ! Copyright 2002, 2004, 2005 Free Software Foundation, Inc. Contributed by Lars Segerlund and Steve Kargl. *************** GNU General Public License for more deta *** 26,35 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "libgfortran.h" extern void random_r4 (GFC_REAL_4 *); iexport_proto(random_r4); --- 26,37 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ + #include "config.h" #include "libgfortran.h" + #include "../io/io.h" extern void random_r4 (GFC_REAL_4 *); iexport_proto(random_r4); *************** export_proto(arandom_r4); *** 43,405 **** extern void arandom_r8 (gfc_array_r8 *); export_proto(arandom_r8); ! #if 0 ! ! /* The Mersenne Twister code is currently commented out due to ! ! (1) Simple user specified seeds lead to really bad sequences for ! nearly 100000 random numbers. ! (2) open(), read(), and close() are not properly declared via header ! files. ! (3) The global index i is abused and causes unexpected behavior with ! GET and PUT. ! (4) See PR 15619. - The algorithm was taken from the paper : Mersenne Twister: 623-dimensionally equidistributed uniform pseudorandom generator. ! by: Makoto Matsumoto ! Takuji Nishimura ! ! Which appeared in the: ACM Transactions on Modelling and Computer Simulations: Special Issue on Uniform Random Number ! Generation. ( Early in 1998 ). */ ! ! ! #include ! #include ! #include ! #include ! #include ! ! #ifdef HAVE_UNISTD_H ! #include ! #endif ! ! /*Use the 'big' generator by default ( period -> 2**19937 ). */ ! ! #define MT19937 ! ! /* Define the necessary constants for the algorithm. */ ! ! #ifdef MT19937 ! enum constants ! { ! N = 624, M = 397, R = 19, TU = 11, TS = 7, TT = 15, TL = 17 ! }; ! #define M_A 0x9908B0DF ! #define T_B 0x9D2C5680 ! #define T_C 0xEFC60000 ! #else ! enum constants ! { ! N = 351, M = 175, R = 19, TU = 11, TS = 7, TT = 15, TL = 17 ! }; ! #define M_A 0xE4BD75F5 ! #define T_B 0x655E5280 ! #define T_C 0xFFD58000 ! #endif ! ! static int i = N; ! static unsigned int seed[N]; ! ! /* This is the routine which handles the seeding of the generator, ! and also reading and writing of the seed. */ ! ! void ! random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) ! { ! /* Initialize the seed in system dependent manner. */ ! if (get == NULL && put == NULL && size == NULL) ! { ! int fd; ! fd = open ("/dev/urandom", O_RDONLY); ! if (fd == 0) ! { ! /* We dont have urandom. */ ! GFC_UINTEGER_4 s = (GFC_UINTEGER_4) seed; ! for (i = 0; i < N; i++) ! { ! s = s * 29943829 - 1; ! seed[i] = s; ! } ! } ! else ! { ! /* Using urandom, might have a length issue. */ ! read (fd, &seed[0], sizeof (GFC_UINTEGER_4) * N); ! close (fd); ! } ! return; ! } ! ! /* Return the size of the seed */ ! if (size != NULL) ! { ! *size = N; ! return; ! } ! ! /* if we have gotten to this pount we have a get or put ! * now we check it the array fulfills the demands in the standard . ! */ ! ! /* Set the seed to PUT data */ ! if (put != NULL) ! { ! /* if the rank of the array is not 1 abort */ ! if (GFC_DESCRIPTOR_RANK (put) != 1) ! abort (); ! ! /* if the array is too small abort */ ! if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < N) ! abort (); ! ! /* If this is the case the array is a temporary */ ! if (put->dim[0].stride == 0) ! return; ! ! /* This code now should do correct strides. */ ! for (i = 0; i < N; i++) ! seed[i] = put->data[i * put->dim[0].stride]; ! } ! ! /* Return the seed to GET data */ ! if (get != NULL) ! { ! /* if the rank of the array is not 1 abort */ ! if (GFC_DESCRIPTOR_RANK (get) != 1) ! abort (); ! ! /* if the array is too small abort */ ! if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < N) ! abort (); ! ! /* If this is the case the array is a temporary */ ! if (get->dim[0].stride == 0) ! return; ! ! /* This code now should do correct strides. */ ! for (i = 0; i < N; i++) ! get->data[i * get->dim[0].stride] = seed[i]; ! } ! } ! iexport(random_seed); ! ! /* Here is the internal routine which generates the random numbers ! in 'batches' based upon the need for a new batch. ! It's an integer based routine known as 'Mersenne Twister'. ! This implementation still lacks 'tempering' and a good verification, ! but gives very good metrics. */ ! ! static void ! random_generate (void) ! { ! /* 32 bits. */ ! GFC_UINTEGER_4 y; ! ! /* Generate batch of N. */ ! int k, m; ! for (k = 0, m = M; k < N - 1; k++) ! { ! y = (seed[k] & (-1 << R)) | (seed[k + 1] & ((1u << R) - 1)); ! seed[k] = seed[m] ^ (y >> 1) ^ (-(GFC_INTEGER_4) (y & 1) & M_A); ! if (++m >= N) ! m = 0; ! } ! ! y = (seed[N - 1] & (-1 << R)) | (seed[0] & ((1u << R) - 1)); ! seed[N - 1] = seed[M - 1] ^ (y >> 1) ^ (-(GFC_INTEGER_4) (y & 1) & M_A); ! i = 0; ! } ! ! /* A routine to return a REAL(KIND=4). */ ! ! void ! random_r4 (GFC_REAL_4 * harv) ! { ! /* Regenerate if we need to. */ ! if (i >= N) ! random_generate (); ! ! /* Convert uint32 to REAL(KIND=4). */ ! *harv = (GFC_REAL_4) ((GFC_REAL_4) (GFC_UINTEGER_4) seed[i++] / ! (GFC_REAL_4) (~(GFC_UINTEGER_4) 0)); ! } ! iexport(random_r4); ! ! /* A routine to return a REAL(KIND=8). */ ! ! void ! random_r8 (GFC_REAL_8 * harv) ! { ! /* Regenerate if we need to, may waste one 32-bit value. */ ! if ((i + 1) >= N) ! random_generate (); ! ! /* Convert two uint32 to a REAL(KIND=8). */ ! *harv = ((GFC_REAL_8) ((((GFC_UINTEGER_8) seed[i+1]) << 32) + seed[i])) / ! (GFC_REAL_8) (~(GFC_UINTEGER_8) 0); ! i += 2; ! } ! iexport(random_r8); ! ! /* Code to handle arrays will follow here. */ ! ! /* REAL(KIND=4) REAL array. */ ! ! void ! arandom_r4 (gfc_array_r4 * harv) ! { ! index_type count[GFC_MAX_DIMENSIONS]; ! index_type extent[GFC_MAX_DIMENSIONS]; ! index_type stride[GFC_MAX_DIMENSIONS]; ! index_type stride0; ! index_type dim; ! GFC_REAL_4 *dest; ! int n; ! ! dest = harv->data; ! ! if (harv->dim[0].stride == 0) ! harv->dim[0].stride = 1; ! ! dim = GFC_DESCRIPTOR_RANK (harv); ! ! for (n = 0; n < dim; n++) ! { ! count[n] = 0; ! stride[n] = harv->dim[n].stride; ! extent[n] = harv->dim[n].ubound + 1 - harv->dim[n].lbound; ! if (extent[n] <= 0) ! return; ! } ! ! stride0 = stride[0]; ! ! while (dest) ! { ! /* Set the elements. */ ! ! /* regenerate if we need to */ ! if (i >= N) ! random_generate (); ! ! /* Convert uint32 to float in a hopefully g95 compiant manner */ ! *dest = (GFC_REAL_4) ((GFC_REAL_4) (GFC_UINTEGER_4) seed[i++] / ! (GFC_REAL_4) (~(GFC_UINTEGER_4) 0)); ! ! /* Advance to the next element. */ ! dest += stride0; ! count[0]++; ! /* Advance to the next source element. */ ! n = 0; ! while (count[n] == extent[n]) ! { ! /* When we get to the end of a dimension, ! reset it and increment ! the next dimension. */ ! count[n] = 0; ! /* We could precalculate these products, ! but this is a less ! frequently used path so proabably not worth it. */ ! dest -= stride[n] * extent[n]; ! n++; ! if (n == dim) ! { ! dest = NULL; ! break; ! } ! else ! { ! count[n]++; ! dest += stride[n]; ! } ! } ! } ! } ! ! /* REAL(KIND=8) array. */ ! ! void ! arandom_r8 (gfc_array_r8 * harv) ! { ! index_type count[GFC_MAX_DIMENSIONS]; ! index_type extent[GFC_MAX_DIMENSIONS]; ! index_type stride[GFC_MAX_DIMENSIONS]; ! index_type stride0; ! index_type dim; ! GFC_REAL_8 *dest; ! int n; ! ! dest = harv->data; ! ! if (harv->dim[0].stride == 0) ! harv->dim[0].stride = 1; ! ! dim = GFC_DESCRIPTOR_RANK (harv); ! ! for (n = 0; n < dim; n++) ! { ! count[n] = 0; ! stride[n] = harv->dim[n].stride; ! extent[n] = harv->dim[n].ubound + 1 - harv->dim[n].lbound; ! if (extent[n] <= 0) ! return; ! } ! ! stride0 = stride[0]; ! ! while (dest) ! { ! /* Set the elements. */ ! ! /* regenerate if we need to, may waste one 32-bit value */ ! if ((i + 1) >= N) ! random_generate (); ! ! /* Convert two uint32 to a REAL(KIND=8). */ ! *dest = ((GFC_REAL_8) ((((GFC_UINTEGER_8) seed[i+1]) << 32) + seed[i])) / ! (GFC_REAL_8) (~(GFC_UINTEGER_8) 0); ! i += 2; ! /* Advance to the next element. */ ! dest += stride0; ! count[0]++; ! /* Advance to the next source element. */ ! n = 0; ! while (count[n] == extent[n]) ! { ! /* When we get to the end of a dimension, ! reset it and increment ! the next dimension. */ ! count[n] = 0; ! /* We could precalculate these products, ! but this is a less ! frequently used path so proabably not worth it. */ ! dest -= stride[n] * extent[n]; ! n++; ! if (n == dim) ! { ! dest = NULL; ! break; ! } ! else ! { ! count[n]++; ! dest += stride[n]; ! } ! } ! } ! } ! #else - /* George Marsaglia's KISS (Keep It Simple Stupid) random number generator. ! This PRNG combines: (1) The congruential generator x(n)=69069*x(n-1)+1327217885 with a period of 2^32, --- 45,80 ---- extern void arandom_r8 (gfc_array_r8 *); export_proto(arandom_r8); ! #ifdef __GTHREAD_MUTEX_INIT ! static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT; ! #else ! static __gthread_mutex_t random_lock; ! #endif + /* libgfortran previously had a Mersenne Twister, taken from the paper: + Mersenne Twister: 623-dimensionally equidistributed uniform pseudorandom generator. ! by Makoto Matsumoto & Takuji Nishimura ! which appeared in the: ACM Transactions on Modelling and Computer Simulations: Special Issue on Uniform Random Number ! Generation. ( Early in 1998 ). ! The Mersenne Twister code was replaced due to ! (1) Simple user specified seeds lead to really bad sequences for ! nearly 100000 random numbers. ! (2) open(), read(), and close() were not properly declared via header ! files. ! (3) The global index i was abused and caused unexpected behavior with ! GET and PUT. ! (4) See PR 15619. ! libgfortran currently uses George Marsaglia's KISS (Keep It Simple Stupid) ! random number generator. This PRNG combines: (1) The congruential generator x(n)=69069*x(n-1)+1327217885 with a period of 2^32, *************** KISS algorithm. */ *** 440,446 **** #define GFC_SR(k, n) ((k)^((k)>>(n))) static const GFC_INTEGER_4 kiss_size = 4; ! #define KISS_DEFAULT_SEED {123456789, 362436069, 521288629, 916191069}; static const GFC_UINTEGER_4 kiss_default_seed[4] = KISS_DEFAULT_SEED; static GFC_UINTEGER_4 kiss_seed[4] = KISS_DEFAULT_SEED; --- 115,121 ---- #define GFC_SR(k, n) ((k)^((k)>>(n))) static const GFC_INTEGER_4 kiss_size = 4; ! #define KISS_DEFAULT_SEED {123456789, 362436069, 521288629, 916191069} static const GFC_UINTEGER_4 kiss_default_seed[4] = KISS_DEFAULT_SEED; static GFC_UINTEGER_4 kiss_seed[4] = KISS_DEFAULT_SEED; *************** random_r4 (GFC_REAL_4 *x) *** 470,480 **** --- 145,157 ---- { GFC_UINTEGER_4 kiss; + __gthread_mutex_lock (&random_lock); kiss = kiss_random_kernel (); /* Burn a random number, so the REAL*4 and REAL*8 functions produce similar sequences of random numbers. */ kiss_random_kernel (); *x = normalize_r4_i4 (kiss, ~(GFC_UINTEGER_4) 0); + __gthread_mutex_unlock (&random_lock); } iexport(random_r4); *************** random_r8 (GFC_REAL_8 *x) *** 486,494 **** --- 163,173 ---- { GFC_UINTEGER_8 kiss; + __gthread_mutex_lock (&random_lock); kiss = ((GFC_UINTEGER_8)kiss_random_kernel ()) << 32; kiss += kiss_random_kernel (); *x = normalize_r8_i8 (kiss, ~(GFC_UINTEGER_8) 0); + __gthread_mutex_unlock (&random_lock); } iexport(random_r8); *************** arandom_r4 (gfc_array_r4 *x) *** 504,509 **** --- 183,189 ---- index_type stride0; index_type dim; GFC_REAL_4 *dest; + GFC_UINTEGER_4 kiss; int n; dest = x->data; *************** arandom_r4 (gfc_array_r4 *x) *** 524,532 **** stride0 = stride[0]; while (dest) { ! random_r4 (dest); /* Advance to the next element. */ dest += stride0; --- 204,219 ---- stride0 = stride[0]; + __gthread_mutex_lock (&random_lock); + while (dest) { ! /* random_r4 (dest); */ ! kiss = kiss_random_kernel (); ! /* Burn a random number, so the REAL*4 and REAL*8 functions ! produce similar sequences of random numbers. */ ! kiss_random_kernel (); ! *dest = normalize_r4_i4 (kiss, ~(GFC_UINTEGER_4) 0); /* Advance to the next element. */ dest += stride0; *************** arandom_r4 (gfc_array_r4 *x) *** 554,559 **** --- 241,247 ---- } } } + __gthread_mutex_unlock (&random_lock); } /* This function fills a REAL(8) array with values from the uniform *************** arandom_r8 (gfc_array_r8 *x) *** 568,573 **** --- 256,262 ---- index_type stride0; index_type dim; GFC_REAL_8 *dest; + GFC_UINTEGER_8 kiss; int n; dest = x->data; *************** arandom_r8 (gfc_array_r8 *x) *** 588,596 **** stride0 = stride[0]; while (dest) { ! random_r8 (dest); /* Advance to the next element. */ dest += stride0; --- 277,290 ---- stride0 = stride[0]; + __gthread_mutex_lock (&random_lock); + while (dest) { ! /* random_r8 (dest); */ ! kiss = ((GFC_UINTEGER_8)kiss_random_kernel ()) << 32; ! kiss += kiss_random_kernel (); ! *dest = normalize_r8_i8 (kiss, ~(GFC_UINTEGER_8) 0); /* Advance to the next element. */ dest += stride0; *************** arandom_r8 (gfc_array_r8 *x) *** 618,627 **** } } } } /* random_seed is used to seed the PRNG with either a default ! set of seeds or user specified set of seeds. random_seed must be called with no argument or exactly one argument. */ void --- 312,322 ---- } } } + __gthread_mutex_unlock (&random_lock); } /* random_seed is used to seed the PRNG with either a default ! set of seeds or user specified set of seeds. random_seed must be called with no argument or exactly one argument. */ void *************** random_seed (GFC_INTEGER_4 *size, gfc_ar *** 629,634 **** --- 324,331 ---- { int i; + __gthread_mutex_lock (&random_lock); + if (size == NULL && put == NULL && get == NULL) { /* From the standard: "If no argument is present, the processor assigns *************** random_seed (GFC_INTEGER_4 *size, gfc_ar *** 678,684 **** for (i = 0; i < kiss_size; i++) get->data[i * get->dim[0].stride] = (GFC_INTEGER_4) kiss_seed[i]; } } iexport(random_seed); ! #endif /* mersenne twister */ --- 375,390 ---- for (i = 0; i < kiss_size; i++) get->data[i * get->dim[0].stride] = (GFC_INTEGER_4) kiss_seed[i]; } + + __gthread_mutex_unlock (&random_lock); } iexport(random_seed); ! ! #ifndef __GTHREAD_MUTEX_INIT ! static void __attribute__((constructor)) ! init (void) ! { ! __GTHREAD_MUTEX_INIT_FUNCTION (&random_lock); ! } ! #endif diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/rename.c gcc-4.1.0/libgfortran/intrinsics/rename.c *** gcc-4.0.2/libgfortran/intrinsics/rename.c Tue Mar 22 23:15:12 2005 --- gcc-4.1.0/libgfortran/intrinsics/rename.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" #include #include "../io/io.h" --- 25,39 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" #include + #include + #include #include "../io/io.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/reshape_generic.c gcc-4.1.0/libgfortran/intrinsics/reshape_generic.c *** gcc-4.0.2/libgfortran/intrinsics/reshape_generic.c Mon May 23 20:03:50 2005 --- gcc-4.1.0/libgfortran/intrinsics/reshape_generic.c Tue Sep 13 07:15:01 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 37,51 **** typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray; - extern void reshape (parray *, parray *, shape_type *, parray *, shape_type *); - export_proto(reshape); - /* The shape parameter is ignored. We can currently deduce the shape from the return array. */ ! void ! reshape (parray *ret, parray *source, shape_type *shape, ! parray *pad, shape_type *order) { /* r.* indicates the return array. */ index_type rcount[GFC_MAX_DIMENSIONS]; --- 37,48 ---- typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray; /* The shape parameter is ignored. We can currently deduce the shape from the return array. */ ! static void ! reshape_internal (parray *ret, parray *source, shape_type *shape, ! parray *pad, shape_type *order, index_type size) { /* r.* indicates the return array. */ index_type rcount[GFC_MAX_DIMENSIONS]; *************** reshape (parray *ret, parray *source, sh *** 76,82 **** const char *src; int n; int dim; - int size; if (source->dim[0].stride == 0) source->dim[0].stride = 1; --- 73,78 ---- *************** reshape (parray *ret, parray *source, sh *** 89,95 **** if (ret->data == NULL) { - size = GFC_DESCRIPTOR_SIZE (ret); rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; for (n=0; n < rdim; n++) --- 85,90 ---- *************** reshape (parray *ret, parray *source, sh *** 100,112 **** ret->dim[n].stride = rs; rs *= rex; } ! ret->base = 0; ret->data = internal_malloc_size ( rs * size ); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { - size = GFC_DESCRIPTOR_SIZE (ret); rdim = GFC_DESCRIPTOR_RANK (ret); if (ret->dim[0].stride == 0) ret->dim[0].stride = 1; --- 95,106 ---- ret->dim[n].stride = rs; rs *= rex; } ! ret->offset = 0; ret->data = internal_malloc_size ( rs * size ); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else { rdim = GFC_DESCRIPTOR_RANK (ret); if (ret->dim[0].stride == 0) ret->dim[0].stride = 1; *************** reshape (parray *ret, parray *source, sh *** 260,262 **** --- 254,281 ---- } } } + + extern void reshape (parray *, parray *, shape_type *, parray *, shape_type *); + export_proto(reshape); + + void + reshape (parray *ret, parray *source, shape_type *shape, parray *pad, + shape_type *order) + { + reshape_internal (ret, source, shape, pad, order, + GFC_DESCRIPTOR_SIZE (source)); + } + + extern void reshape_char (parray *, GFC_INTEGER_4, parray *, shape_type *, + parray *, shape_type *, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(reshape_char); + + void + reshape_char (parray *ret, GFC_INTEGER_4 ret_length __attribute__((unused)), + parray *source, shape_type *shape, parray *pad, + shape_type *order, GFC_INTEGER_4 source_length, + GFC_INTEGER_4 pad_length __attribute__((unused))) + { + reshape_internal (ret, source, shape, pad, order, source_length); + } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/reshape_packed.c gcc-4.1.0/libgfortran/intrinsics/reshape_packed.c *** gcc-4.0.2/libgfortran/intrinsics/reshape_packed.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/reshape_packed.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/selected_int_kind.f90 gcc-4.1.0/libgfortran/intrinsics/selected_int_kind.f90 *** gcc-4.0.2/libgfortran/intrinsics/selected_int_kind.f90 Mon Aug 30 21:34:37 2004 --- gcc-4.1.0/libgfortran/intrinsics/selected_int_kind.f90 Wed Aug 17 02:49:08 2005 *************** *** 15,22 **** ! !You should have received a copy of the GNU Lesser General Public !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! !Boston, MA 02111-1307, USA. ! function selected_int_kind (r) --- 15,22 ---- ! !You should have received a copy of the GNU Lesser General Public !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! function selected_int_kind (r) diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/selected_real_kind.f90 gcc-4.1.0/libgfortran/intrinsics/selected_real_kind.f90 *** gcc-4.0.2/libgfortran/intrinsics/selected_real_kind.f90 Mon Aug 30 21:34:37 2004 --- gcc-4.1.0/libgfortran/intrinsics/selected_real_kind.f90 Wed Aug 17 02:49:08 2005 *************** *** 15,22 **** ! !You should have received a copy of the GNU Lesser General Public !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! !Boston, MA 02111-1307, USA. ! function selected_real_kind (p, r) --- 15,22 ---- ! !You should have received a copy of the GNU Lesser General Public !License along with libgfor; see the file COPYING. If not, ! !write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! !Boston, MA 02110-1301, USA. ! function selected_real_kind (p, r) diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/signal.c gcc-4.1.0/libgfortran/intrinsics/signal.c *** gcc-4.0.2/libgfortran/intrinsics/signal.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/intrinsics/signal.c Fri Oct 28 21:16:17 2005 *************** *** 0 **** --- 1,170 ---- + /* Implementation of the SIGNAL and ALARM g77 intrinsics + Contributed by Fran§ois-Xavier Coudert + + This file is part of the GNU Fortran 95 runtime library (libgfortran). + + Libgfortran is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + In addition to the permissions in the GNU General Public License, the + Free Software Foundation gives you unlimited permission to link the + compiled version of this file into combinations with other programs, + and to distribute those combinations without any restriction coming + from the use of this file. (The General Public License restrictions + do apply in other respects; for example, they cover modification of + the file, and distribution when not linked into a combine + executable.) + + Libgfortran is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with libgfortran; see the file COPYING. If not, + write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + + #include "config.h" + #include "libgfortran.h" + + #ifdef HAVE_UNISTD_H + #include + #endif + + #ifdef HAVE_SIGNAL_H + #include + #endif + + #include + + /* SIGNAL subroutine with PROCEDURE as handler */ + extern void signal_sub (int *, void (*)(int), int *); + iexport_proto(signal_sub); + + void + signal_sub (int *number, void (*handler)(int), int *status) + { + #ifdef HAVE_SIGNAL + if (status != NULL) + *status = (int) signal (*number, handler); + else + signal (*number, handler); + #else + errno = ENOSYS; + if (status != NULL) + *status = -1; + #endif + } + iexport(signal_sub); + + + /* SIGNAL subroutine with INTEGER as handler */ + extern void signal_sub_int (int *, int *, int *); + iexport_proto(signal_sub_int); + + void + signal_sub_int (int *number, int *handler, int *status) + { + #ifdef HAVE_SIGNAL + if (status != NULL) + *status = (int) signal (*number, (void (*)(int)) *handler); + else + signal (*number, (void (*)(int)) *handler); + #else + errno = ENOSYS; + if (status != NULL) + *status = -1; + #endif + } + iexport(signal_sub_int); + + + /* SIGNAL function with PROCEDURE as handler */ + extern int signal_func (int *, void (*)(int)); + iexport_proto(signal_func); + + int + signal_func (int *number, void (*handler)(int)) + { + int status; + signal_sub (number, handler, &status); + return status; + } + iexport(signal_func); + + + /* SIGNAL function with INTEGER as handler */ + extern int signal_func_int (int *, int *); + iexport_proto(signal_func_int); + + int + signal_func_int (int *number, int *handler) + { + int status; + signal_sub_int (number, handler, &status); + return status; + } + iexport(signal_func_int); + + + + /* ALARM intrinsic with PROCEDURE as handler */ + extern void alarm_sub (int *, void (*)(int), int *); + iexport_proto(alarm_sub); + + void + alarm_sub (int *seconds, void (*handler)(int), int *status) + { + #if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) + if (status != NULL) + { + if (signal (SIGALRM, handler) == SIG_ERR) + *status = -1; + else + *status = alarm (*seconds); + } + else + { + signal (SIGALRM, handler); + alarm (*seconds); + } + #else + errno = ENOSYS; + if (status != NULL) + *status = -1; + #endif + } + iexport(alarm_sub); + + + /* ALARM intrinsic with INTEGER as handler */ + extern void alarm_sub_int (int *, int *, int *); + iexport_proto(alarm_sub_int); + + void + alarm_sub_int (int *seconds, int *handler, int *status) + { + #if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) + if (status != NULL) + { + if (signal (SIGALRM, (void (*)(int)) handler) == SIG_ERR) + *status = -1; + else + *status = alarm (*seconds); + } + else + { + signal (SIGALRM, (void (*)(int)) handler); + alarm (*seconds); + } + #else + errno = ENOSYS; + if (status != NULL) + *status = -1; + #endif + } + iexport(alarm_sub_int); + diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/size.c gcc-4.1.0/libgfortran/intrinsics/size.c *** gcc-4.0.2/libgfortran/intrinsics/size.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/size.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "libgfortran.h" --- 25,32 ---- 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" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/sleep.c gcc-4.1.0/libgfortran/intrinsics/sleep.c *** gcc-4.0.2/libgfortran/intrinsics/sleep.c Tue Mar 22 23:15:12 2005 --- gcc-4.1.0/libgfortran/intrinsics/sleep.c Wed Oct 19 09:45:27 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 39,44 **** --- 39,51 ---- #include #endif + #ifdef __MINGW32__ + # include + # undef sleep + # define sleep(x) Sleep(1000*(x)) + # define HAVE_SLEEP 1 + #endif + /* SUBROUTINE SLEEP(SECONDS) INTEGER, INTENT(IN) :: SECONDS diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/spread_generic.c gcc-4.1.0/libgfortran/intrinsics/spread_generic.c *** gcc-4.0.2/libgfortran/intrinsics/spread_generic.c Tue May 24 22:21:52 2005 --- gcc-4.1.0/libgfortran/intrinsics/spread_generic.c Sun Oct 23 06:59:17 2005 *************** *** 1,5 **** /* Generic implementation of the SPREAD intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Generic implementation of the SPREAD intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,51 **** #include #include "libgfortran.h" ! extern void spread (gfc_array_char *, const gfc_array_char *, ! const index_type *, const index_type *); ! export_proto(spread); ! ! void ! spread (gfc_array_char *ret, const gfc_array_char *source, ! const index_type *along, const index_type *pncopies) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; ! index_type rdelta; index_type rrank; index_type rs; char *rptr; --- 34,48 ---- #include #include "libgfortran.h" ! static void ! spread_internal (gfc_array_char *ret, const gfc_array_char *source, ! const index_type *along, const index_type *pncopies, ! index_type size) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride0; ! index_type rdelta = 0; index_type rrank; index_type rs; char *rptr; *************** spread (gfc_array_char *ret, const gfc_a *** 60,66 **** index_type extent[GFC_MAX_DIMENSIONS]; index_type n; index_type dim; - index_type size; index_type ncopies; srank = GFC_DESCRIPTOR_RANK(source); --- 57,62 ---- *************** spread (gfc_array_char *ret, const gfc_a *** 74,80 **** ncopies = *pncopies; - size = GFC_DESCRIPTOR_SIZE (source); if (ret->data == NULL) { /* The front end has signalled that we need to populate the --- 70,75 ---- *************** spread (gfc_array_char *ret, const gfc_a *** 105,111 **** dim++; } } ! ret->base = 0; ret->data = internal_malloc_size (rs * size); } else --- 100,106 ---- dim++; } } ! ret->offset = 0; ret->data = internal_malloc_size (rs * size); } else *************** spread (gfc_array_char *ret, const gfc_a *** 180,182 **** --- 175,279 ---- } } } + + /* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + + static void + spread_internal_scalar (gfc_array_char *ret, const char *source, + const index_type *along, const index_type *pncopies, + index_type size) + { + int n; + int ncopies = *pncopies; + char * dest; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (*along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * size); + ret->offset = 0; + ret->dim[0].stride = 1; + ret->dim[0].lbound = 0; + ret->dim[0].ubound = ncopies - 1; + } + else + { + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + + if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) + / ret->dim[0].stride) + runtime_error ("dim too large in spread()"); + } + + for (n = 0; n < ncopies; n++) + { + dest = (char*)(ret->data + n*size*ret->dim[0].stride); + memcpy (dest , source, size); + } + } + + extern void spread (gfc_array_char *, const gfc_array_char *, + const index_type *, const index_type *); + export_proto(spread); + + void + spread (gfc_array_char *ret, const gfc_array_char *source, + const index_type *along, const index_type *pncopies) + { + spread_internal (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (source)); + } + + extern void spread_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const index_type *, + const index_type *, GFC_INTEGER_4); + export_proto(spread_char); + + void + spread_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *source, const index_type *along, + const index_type *pncopies, GFC_INTEGER_4 source_length) + { + spread_internal (ret, source, along, pncopies, source_length); + } + + /* The following are the prototypes for the versions of spread with a + scalar source. */ + + extern void spread_scalar (gfc_array_char *, const char *, + const index_type *, const index_type *); + export_proto(spread_scalar); + + void + spread_scalar (gfc_array_char *ret, const char *source, + const index_type *along, const index_type *pncopies) + { + if (!ret->dtype) + runtime_error ("return array missing descriptor in spread()"); + spread_internal_scalar (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (ret)); + } + + + extern void spread_char_scalar (gfc_array_char *, GFC_INTEGER_4, + const char *, const index_type *, + const index_type *, GFC_INTEGER_4); + export_proto(spread_char_scalar); + + void + spread_char_scalar (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const char *source, const index_type *along, + const index_type *pncopies, GFC_INTEGER_4 source_length) + { + if (!ret->dtype) + runtime_error ("return array missing descriptor in spread()"); + spread_internal_scalar (ret, source, along, pncopies, source_length); + } + diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/stat.c gcc-4.1.0/libgfortran/intrinsics/stat.c *** gcc-4.0.2/libgfortran/intrinsics/stat.c Tue Jul 12 01:50:36 2005 --- gcc-4.1.0/libgfortran/intrinsics/stat.c Wed Aug 17 02:49:08 2005 *************** *** 1,5 **** /* Implementation of the STAT and FSTAT intrinsics. ! Copyright (C) 2004 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the STAT and FSTAT intrinsics. ! Copyright (C) 2004, 2005 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** stat_i4_sub (char *name, gfc_array_i4 *s *** 91,101 **** /* Make a null terminated copy of the string. */ str = gfc_alloca (name_len + 1); memcpy (str, name, name_len); ! str[name_len] = '\0'; val = stat(str, &sb); ! if (val == 0) { /* Device ID */ sarray->data[0 * sarray->dim[0].stride] = sb.st_dev; --- 91,101 ---- /* Make a null terminated copy of the string. */ str = gfc_alloca (name_len + 1); memcpy (str, name, name_len); ! str[name_len] = '\0'; val = stat(str, &sb); ! if (val == 0) { /* Device ID */ sarray->data[0 * sarray->dim[0].stride] = sb.st_dev; *************** stat_i4_sub (char *name, gfc_array_i4 *s *** 114,120 **** /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; ! /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; --- 114,120 ---- /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; ! /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; *************** stat_i4_sub (char *name, gfc_array_i4 *s *** 149,155 **** #endif } ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(stat_i4_sub); --- 149,155 ---- #endif } ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(stat_i4_sub); *************** stat_i8_sub (char *name, gfc_array_i8 *s *** 184,190 **** /* Make a null terminated copy of the string. */ str = gfc_alloca (name_len + 1); memcpy (str, name, name_len); ! str[name_len] = '\0'; val = stat(str, &sb); --- 184,190 ---- /* Make a null terminated copy of the string. */ str = gfc_alloca (name_len + 1); memcpy (str, name, name_len); ! str[name_len] = '\0'; val = stat(str, &sb); *************** stat_i8_sub (char *name, gfc_array_i8 *s *** 201,213 **** /* Number of (hard) links */ sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink; ! /* Owner's uid */ sarray->data[4 * sarray->dim[0].stride] = sb.st_uid; /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; ! /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; --- 201,213 ---- /* Number of (hard) links */ sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink; ! /* Owner's uid */ sarray->data[4 * sarray->dim[0].stride] = sb.st_uid; /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; ! /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; *************** stat_i8_sub (char *name, gfc_array_i8 *s *** 242,248 **** #endif } ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(stat_i8_sub); --- 242,248 ---- #endif } ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(stat_i8_sub); *************** stat_i8 (char *name, gfc_array_i8 *sarra *** 271,283 **** /* SUBROUTINE FSTAT(UNIT, SARRAY, STATUS) ! INTEGER, INTENT(IN) :: UNIT INTEGER, INTENT(OUT) :: SARRAY(13) ! INTEGER, INTENT(OUT), OPTIONAL :: STATUS FUNCTION FSTAT(UNIT, SARRAY) INTEGER FSTAT ! INTEGER, INTENT(IN) :: UNIT INTEGER, INTENT(OUT) :: SARRAY(13) */ extern void fstat_i4_sub (GFC_INTEGER_4 *, gfc_array_i4 *, GFC_INTEGER_4 *); --- 271,283 ---- /* SUBROUTINE FSTAT(UNIT, SARRAY, STATUS) ! INTEGER, INTENT(IN) :: UNIT INTEGER, INTENT(OUT) :: SARRAY(13) ! INTEGER, INTENT(OUT), OPTIONAL :: STATUS FUNCTION FSTAT(UNIT, SARRAY) INTEGER FSTAT ! INTEGER, INTENT(IN) :: UNIT INTEGER, INTENT(OUT) :: SARRAY(13) */ extern void fstat_i4_sub (GFC_INTEGER_4 *, gfc_array_i4 *, GFC_INTEGER_4 *); *************** fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_a *** 312,318 **** /* Inode number */ sarray->data[1 * sarray->dim[0].stride] = sb.st_ino; ! /* File mode */ sarray->data[2 * sarray->dim[0].stride] = sb.st_mode; --- 312,318 ---- /* Inode number */ sarray->data[1 * sarray->dim[0].stride] = sb.st_ino; ! /* File mode */ sarray->data[2 * sarray->dim[0].stride] = sb.st_mode; *************** fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_a *** 324,330 **** /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; ! /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; --- 324,330 ---- /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; ! /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; *************** fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_a *** 359,365 **** #endif } ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(fstat_i4_sub); --- 359,365 ---- #endif } ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(fstat_i4_sub); *************** fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_a *** 372,378 **** { int val; struct stat sb; ! /* If the rank of the array is not 1, abort. */ if (GFC_DESCRIPTOR_RANK (sarray) != 1) runtime_error ("Array rank of SARRAY is not 1."); --- 372,378 ---- { int val; struct stat sb; ! /* If the rank of the array is not 1, abort. */ if (GFC_DESCRIPTOR_RANK (sarray) != 1) runtime_error ("Array rank of SARRAY is not 1."); *************** fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_a *** 408,414 **** /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; ! /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; --- 408,414 ---- /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; ! /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; *************** fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_a *** 443,449 **** #endif } ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(fstat_i8_sub); --- 443,449 ---- #endif } ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(fstat_i8_sub); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/string_intrinsics.c gcc-4.1.0/libgfortran/intrinsics/string_intrinsics.c *** gcc-4.0.2/libgfortran/intrinsics/string_intrinsics.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/string_intrinsics.c Sat Nov 12 19:16:40 2005 *************** *** 1,5 **** /* String intrinsics helper functions. ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* String intrinsics helper functions. ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* Unlike what the name of this file suggests, we don't actually --- 25,32 ---- 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. */ /* Unlike what the name of this file suggests, we don't actually *************** copy_string (GFC_INTEGER_4 destlen, char *** 89,100 **** { /* This will truncate if too long. */ memmove (dest, src, destlen); - /*memcpy (dest, src, destlen);*/ } else { memmove (dest, src, srclen); - /*memcpy (dest, src, srclen);*/ /* Pad with spaces. */ memset (&dest[srclen], ' ', destlen - srclen); } --- 89,98 ---- *************** GFC_INTEGER_4 *** 304,338 **** string_scan (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, const char * set, GFC_LOGICAL_4 back) { ! int start; ! int last; ! int i; ! int delta; if (slen == 0 || setlen == 0) return 0; if (back) { ! last = 0; ! start = slen - 1; ! delta = -1; } else { ! last = slen - 1; ! start = 0; ! delta = 1; ! } ! ! i = 0; ! for (; start != last; start += delta) ! { ! for (i = 0; i < setlen; i++) ! { ! if (str[start] == set[i]) ! return (start + 1); ! } } return 0; --- 302,333 ---- string_scan (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, const char * set, GFC_LOGICAL_4 back) { ! int i, j; if (slen == 0 || setlen == 0) return 0; if (back) { ! for (i = slen - 1; i >= 0; i--) ! { ! for (j = 0; j < setlen; j++) ! { ! if (str[i] == set[j]) ! return (i + 1); ! } ! } } else { ! for (i = 0; i < slen; i++) ! { ! for (j = 0; j < setlen; j++) ! { ! if (str[i] == set[j]) ! return (i + 1); ! } ! } } return 0; *************** string_scan (GFC_INTEGER_4 slen, const c *** 340,347 **** /* Verify that a set of characters contains all the characters in a ! string by indentifying the position of the first character in a ! characters that dose not appear in a given set of characters. */ GFC_INTEGER_4 string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, --- 335,342 ---- /* Verify that a set of characters contains all the characters in a ! string by identifying the position of the first character in a ! characters that does not appear in a given set of characters. */ GFC_INTEGER_4 string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/symlnk.c gcc-4.1.0/libgfortran/intrinsics/symlnk.c *** gcc-4.0.2/libgfortran/intrinsics/symlnk.c Sun May 15 08:27:26 2005 --- gcc-4.1.0/libgfortran/intrinsics/symlnk.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** symlnk_i4_sub (char *path1, char *path2, *** 67,81 **** /* Make a null terminated copy of the strings. */ str1 = gfc_alloca (path1_len + 1); memcpy (str1, path1, path1_len); ! str1[path1_len] = '\0'; str2 = gfc_alloca (path2_len + 1); memcpy (str2, path2, path2_len); ! str2[path2_len] = '\0'; val = symlink (str1, str2); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(symlnk_i4_sub); --- 67,81 ---- /* Make a null terminated copy of the strings. */ str1 = gfc_alloca (path1_len + 1); memcpy (str1, path1, path1_len); ! str1[path1_len] = '\0'; str2 = gfc_alloca (path2_len + 1); memcpy (str2, path2, path2_len); ! str2[path2_len] = '\0'; val = symlink (str1, str2); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(symlnk_i4_sub); *************** symlnk_i8_sub (char *path1, char *path2, *** 100,114 **** /* Make a null terminated copy of the strings. */ str1 = gfc_alloca (path1_len + 1); memcpy (str1, path1, path1_len); ! str1[path1_len] = '\0'; str2 = gfc_alloca (path2_len + 1); memcpy (str2, path2, path2_len); ! str2[path2_len] = '\0'; val = symlink (str1, str2); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(symlnk_i8_sub); --- 100,114 ---- /* Make a null terminated copy of the strings. */ str1 = gfc_alloca (path1_len + 1); memcpy (str1, path1, path1_len); ! str1[path1_len] = '\0'; str2 = gfc_alloca (path2_len + 1); memcpy (str2, path2, path2_len); ! str2[path2_len] = '\0'; val = symlink (str1, str2); ! if (status != NULL) *status = (val == 0) ? 0 : errno; } iexport(symlnk_i8_sub); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/system.c gcc-4.1.0/libgfortran/intrinsics/system.c *** gcc-4.0.2/libgfortran/intrinsics/system.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/system.c Wed Aug 17 02:49:08 2005 *************** for more details. *** 25,32 **** 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, 59 Temple Place - Suite 330, Boston, MA ! 02111-1307, USA. */ #include "config.h" --- 25,32 ---- 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. */ #include "config.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/system_clock.c gcc-4.1.0/libgfortran/intrinsics/system_clock.c *** gcc-4.0.2/libgfortran/intrinsics/system_clock.c Sun May 15 15:58:17 2005 --- gcc-4.1.0/libgfortran/intrinsics/system_clock.c Tue Nov 22 10:58:47 2005 *************** GNU General Public License for more deta *** 24,31 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 24,31 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 44,56 **** #endif - #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) - static struct timeval tp0 = {-1, 0}; - #elif defined(HAVE_TIME_H) - static time_t t0 = (time_t) -2; - #endif - - extern void system_clock_4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *); export_proto(system_clock_4); --- 44,49 ---- *************** system_clock_4(GFC_INTEGER_4 *count, GFC *** 74,104 **** #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) struct timeval tp1; struct timezone tzp; ! double t; if (gettimeofday(&tp1, &tzp) == 0) { ! if (tp0.tv_sec < 0) ! { ! tp0 = tp1; ! cnt = 0; ! } else ! { ! /* TODO: Convert this to integer arithmetic. */ ! t = (double) (tp1.tv_sec - tp0.tv_sec); ! t += (double) (tp1.tv_usec - tp0.tv_usec) * 1.e-6; ! t *= TCK; ! ! if (t > (double) GFC_INTEGER_4_HUGE) ! { ! /* Time has wrapped. */ ! while (t > (double) GFC_INTEGER_4_HUGE) ! t -= (double) GFC_INTEGER_4_HUGE; ! tp0 = tp1; ! } ! cnt = (GFC_INTEGER_4) t; ! } rate = TCK; mx = GFC_INTEGER_4_HUGE; } --- 67,84 ---- #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) struct timeval tp1; struct timezone tzp; ! ! if (sizeof (tp1.tv_sec) < sizeof (GFC_INTEGER_4)) ! internal_error (NULL, "tv_sec too small"); if (gettimeofday(&tp1, &tzp) == 0) { ! GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) tp1.tv_sec * TCK; ! ucnt += (tp1.tv_usec + 500000 / TCK) / (1000000 / TCK); ! if (ucnt > GFC_INTEGER_4_HUGE) ! cnt = ucnt - GFC_INTEGER_4_HUGE - 1; else ! cnt = ucnt; rate = TCK; mx = GFC_INTEGER_4_HUGE; } *************** system_clock_4(GFC_INTEGER_4 *count, GFC *** 113,136 **** return; } #elif defined(HAVE_TIME_H) ! time_t t, t1; ! t1 = time(NULL); ! if (t1 == (time_t) -1) ! { ! cnt = - GFC_INTEGER_4_HUGE; ! mx = 0; ! } ! else if (t0 == (time_t) -2) ! t0 = t1; else ! { ! /* The timer counts in seconts, so for simplicity assume it never wraps. ! Even with 32-bit counters this only happens once every 68 years. */ ! cnt = t1 - t0; ! mx = GFC_INTEGER_4_HUGE; ! } #else cnt = - GFC_INTEGER_4_HUGE; mx = 0; --- 93,109 ---- return; } #elif defined(HAVE_TIME_H) ! GFC_UINTEGER_4 ucnt; ! if (sizeof (time_t) < sizeof (GFC_INTEGER_4)) ! internal_error (NULL, "time_t too small"); ! ucnt = time (NULL); ! if (ucnt > GFC_INTEGER_4_HUGE) ! cnt = ucnt - GFC_INTEGER_4_HUGE - 1; else ! cnt = ucnt; ! mx = GFC_INTEGER_4_HUGE; #else cnt = - GFC_INTEGER_4_HUGE; mx = 0; *************** system_clock_4(GFC_INTEGER_4 *count, GFC *** 148,154 **** void system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, ! GFC_INTEGER_8 *count_max) { GFC_INTEGER_8 cnt; GFC_INTEGER_8 rate; --- 121,127 ---- void system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, ! GFC_INTEGER_8 *count_max) { GFC_INTEGER_8 cnt; GFC_INTEGER_8 rate; *************** system_clock_8 (GFC_INTEGER_8 *count, GF *** 157,189 **** #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) struct timeval tp1; struct timezone tzp; ! double t; if (gettimeofday(&tp1, &tzp) == 0) { ! if (tp0.tv_sec < 0) ! { ! tp0 = tp1; ! cnt = 0; ! } else ! { ! /* TODO: Convert this to integer arithmetic. */ ! t = (double) (tp1.tv_sec - tp0.tv_sec); ! t += (double) (tp1.tv_usec - tp0.tv_usec) * 1.e-6; ! t *= TCK; ! ! if (t > (double) GFC_INTEGER_8_HUGE) ! { ! /* Time has wrapped. */ ! while (t > (double) GFC_INTEGER_8_HUGE) ! t -= (double) GFC_INTEGER_8_HUGE; ! tp0 = tp1; ! } ! cnt = (GFC_INTEGER_8) t; ! } rate = TCK; - mx = GFC_INTEGER_8_HUGE; } else { --- 130,162 ---- #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) struct timeval tp1; struct timezone tzp; ! ! if (sizeof (tp1.tv_sec) < sizeof (GFC_INTEGER_4)) ! internal_error (NULL, "tv_sec too small"); if (gettimeofday(&tp1, &tzp) == 0) { ! if (sizeof (tp1.tv_sec) < sizeof (GFC_INTEGER_8)) ! { ! GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) tp1.tv_sec * TCK; ! ucnt += (tp1.tv_usec + 500000 / TCK) / (1000000 / TCK); ! if (ucnt > GFC_INTEGER_4_HUGE) ! cnt = ucnt - GFC_INTEGER_4_HUGE - 1; ! else ! cnt = ucnt; ! mx = GFC_INTEGER_4_HUGE; ! } else ! { ! GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) tp1.tv_sec * TCK; ! ucnt += (tp1.tv_usec + 500000 / TCK) / (1000000 / TCK); ! if (ucnt > GFC_INTEGER_8_HUGE) ! cnt = ucnt - GFC_INTEGER_8_HUGE - 1; ! else ! cnt = ucnt; ! mx = GFC_INTEGER_8_HUGE; ! } rate = TCK; } else { *************** system_clock_8 (GFC_INTEGER_8 *count, GF *** 197,218 **** return; } #elif defined(HAVE_TIME_H) ! time_t t, t1; ! ! t1 = time(NULL); ! ! if (t1 == (time_t) -1) { ! cnt = - GFC_INTEGER_8_HUGE; ! mx = 0; } - else if (t0 == (time_t) -2) - t0 = t1; else { ! /* The timer counts in seconts, so for simplicity assume it never wraps. ! Even with 32-bit counters this only happens once every 68 years. */ ! cnt = t1 - t0; mx = GFC_INTEGER_8_HUGE; } #else --- 170,193 ---- return; } #elif defined(HAVE_TIME_H) ! if (sizeof (time_t) < sizeof (GFC_INTEGER_4)) ! internal_error (NULL, "time_t too small"); ! else if (sizeof (time_t) == sizeof (GFC_INTEGER_4)) { ! GFC_UINTEGER_4 ucnt = time (NULL); ! if (ucnt > GFC_INTEGER_4_HUGE) ! cnt = ucnt - GFC_INTEGER_4_HUGE - 1; ! else ! cnt = ucnt; ! mx = GFC_INTEGER_4_HUGE; } else { ! GFC_UINTEGER_8 ucnt = time (NULL); ! if (ucnt > GFC_INTEGER_8_HUGE) ! cnt = ucnt - GFC_INTEGER_8_HUGE - 1; ! else ! cnt = ucnt; mx = GFC_INTEGER_8_HUGE; } #else diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/time.c gcc-4.1.0/libgfortran/intrinsics/time.c *** gcc-4.0.2/libgfortran/intrinsics/time.c Tue Mar 22 23:15:12 2005 --- gcc-4.1.0/libgfortran/intrinsics/time.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/transpose_generic.c gcc-4.1.0/libgfortran/intrinsics/transpose_generic.c *** gcc-4.0.2/libgfortran/intrinsics/transpose_generic.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/transpose_generic.c Tue Sep 13 07:15:01 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 37,44 **** extern void transpose (gfc_array_char *, gfc_array_char *); export_proto(transpose); ! void ! transpose (gfc_array_char *ret, gfc_array_char *source) { /* r.* indicates the return array. */ index_type rxstride, rystride; --- 37,45 ---- extern void transpose (gfc_array_char *, gfc_array_char *); export_proto(transpose); ! static void ! transpose_internal (gfc_array_char *ret, gfc_array_char *source, ! index_type size) { /* r.* indicates the return array. */ index_type rxstride, rystride; *************** transpose (gfc_array_char *ret, gfc_arra *** 49,61 **** index_type xcount, ycount; index_type x, y; - index_type size; assert (GFC_DESCRIPTOR_RANK (source) == 2 && GFC_DESCRIPTOR_RANK (ret) == 2); - size = GFC_DESCRIPTOR_SIZE (source); - if (ret->data == NULL) { assert (ret->dtype == source->dtype); --- 50,59 ---- *************** transpose (gfc_array_char *ret, gfc_arra *** 69,75 **** ret->dim[1].stride = ret->dim[0].ubound+1; ret->data = internal_malloc_size (size * size0 ((array_t*)ret)); ! ret->base = 0; } sxstride = source->dim[0].stride * size; --- 67,73 ---- ret->dim[1].stride = ret->dim[0].ubound+1; ret->data = internal_malloc_size (size * size0 ((array_t*)ret)); ! ret->offset = 0; } sxstride = source->dim[0].stride * size; *************** transpose (gfc_array_char *ret, gfc_arra *** 100,102 **** --- 98,121 ---- rptr += rxstride - (rystride * xcount); } } + + extern void transpose (gfc_array_char *, gfc_array_char *); + export_proto(transpose); + + void + transpose (gfc_array_char *ret, gfc_array_char *source) + { + transpose_internal (ret, source, GFC_DESCRIPTOR_SIZE (source)); + } + + extern void transpose_char (gfc_array_char *, GFC_INTEGER_4, + gfc_array_char *, GFC_INTEGER_4); + export_proto(transpose_char); + + void + transpose_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + gfc_array_char *source, GFC_INTEGER_4 source_length) + { + transpose_internal (ret, source, source_length); + } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/tty.c gcc-4.1.0/libgfortran/intrinsics/tty.c *** gcc-4.0.2/libgfortran/intrinsics/tty.c Tue Aug 9 17:44:56 2005 --- gcc-4.1.0/libgfortran/intrinsics/tty.c Mon Nov 28 07:17:39 2005 *************** GNU General Public License for more deta *** 25,36 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" #include "../io/io.h" #include /* LOGICAL FUNCTION ISATTY(UNIT) --- 25,37 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" #include "../io/io.h" + #include /* LOGICAL FUNCTION ISATTY(UNIT) *************** GFC_LOGICAL_4 *** 43,54 **** isatty_l4 (int *unit) { gfc_unit *u; u = find_unit (*unit); if (u != NULL) ! return (GFC_LOGICAL_4) stream_isatty (u->s); ! else ! return 0; } --- 44,58 ---- isatty_l4 (int *unit) { gfc_unit *u; + GFC_LOGICAL_4 ret = 0; u = find_unit (*unit); if (u != NULL) ! { ! ret = (GFC_LOGICAL_4) stream_isatty (u->s); ! unlock_unit (u); ! } ! return ret; } *************** GFC_LOGICAL_8 *** 59,70 **** isatty_l8 (int *unit) { gfc_unit *u; u = find_unit (*unit); if (u != NULL) ! return (GFC_LOGICAL_8) stream_isatty (u->s); ! else ! return 0; } --- 63,77 ---- isatty_l8 (int *unit) { gfc_unit *u; + GFC_LOGICAL_8 ret = 0; u = find_unit (*unit); if (u != NULL) ! { ! ret = (GFC_LOGICAL_8) stream_isatty (u->s); ! unlock_unit (u); ! } ! return ret; } *************** ttynam_sub (int *unit, char * name, gfc_ *** 93,97 **** --- 100,132 ---- while (*n && i < name_len) name[i++] = *(n++); } + unlock_unit (u); } } + + + extern void ttynam (char **, gfc_charlen_type *, int); + export_proto(ttynam); + + void + ttynam (char ** name, gfc_charlen_type * name_len, int unit) + { + gfc_unit *u; + + u = find_unit (unit); + if (u != NULL) + { + *name = stream_ttyname (u->s); + if (*name != NULL) + { + *name_len = strlen (*name); + *name = strdup (*name); + unlock_unit (u); + return; + } + unlock_unit (u); + } + + *name_len = 0; + *name = NULL; + } diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/umask.c gcc-4.1.0/libgfortran/intrinsics/umask.c *** gcc-4.0.2/libgfortran/intrinsics/umask.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/intrinsics/umask.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/unlink.c gcc-4.1.0/libgfortran/intrinsics/unlink.c *** gcc-4.0.2/libgfortran/intrinsics/unlink.c Tue Jul 12 01:50:36 2005 --- gcc-4.1.0/libgfortran/intrinsics/unlink.c Wed Aug 17 02:49:08 2005 *************** *** 1,5 **** /* Implementation of the UNLINK intrinsic. ! Copyright (C) 2004 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the UNLINK intrinsic. ! Copyright (C) 2004, 2005 Free Software Foundation, Inc. Contributed by Steven G. Kargl . This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" *************** unlink_i4_sub (char *name, GFC_INTEGER_4 *** 61,71 **** /* Make a null terminated copy of the string. */ str = gfc_alloca (name_len + 1); memcpy (str, name, name_len); ! str[name_len] = '\0'; stat = unlink (str); ! if (status != NULL) *status = (stat == 0) ? stat : errno; } iexport(unlink_i4_sub); --- 61,71 ---- /* Make a null terminated copy of the string. */ str = gfc_alloca (name_len + 1); memcpy (str, name, name_len); ! str[name_len] = '\0'; stat = unlink (str); ! if (status != NULL) *status = (stat == 0) ? stat : errno; } iexport(unlink_i4_sub); diff -Nrcpad gcc-4.0.2/libgfortran/intrinsics/unpack_generic.c gcc-4.1.0/libgfortran/intrinsics/unpack_generic.c *** gcc-4.0.2/libgfortran/intrinsics/unpack_generic.c Thu May 26 06:40:38 2005 --- gcc-4.1.0/libgfortran/intrinsics/unpack_generic.c Tue Sep 13 07:15:01 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,46 **** #include #include "libgfortran.h" ! extern void unpack1 (gfc_array_char *, const gfc_array_char *, ! const gfc_array_l4 *, const gfc_array_char *); ! iexport_proto(unpack1); ! ! void ! unpack1 (gfc_array_char *ret, const gfc_array_char *vector, ! const gfc_array_l4 *mask, const gfc_array_char *field) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 34,43 ---- #include #include "libgfortran.h" ! static void ! unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, ! const gfc_array_l4 *mask, const gfc_array_char *field, ! index_type size, index_type fsize) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** unpack1 (gfc_array_char *ret, const gfc_ *** 63,74 **** index_type extent[GFC_MAX_DIMENSIONS]; index_type n; index_type dim; - index_type size; - index_type fsize; - size = GFC_DESCRIPTOR_SIZE (ret); - /* A field element size of 0 actually means this is a scalar. */ - fsize = GFC_DESCRIPTOR_SIZE (field); if (ret->data == NULL) { /* The front end has signalled that we need to populate the --- 60,66 ---- *************** unpack1 (gfc_array_char *ret, const gfc_ *** 87,93 **** mstride[n] = mask->dim[n].stride; rs *= extent[n]; } ! ret->base = 0; ret->data = internal_malloc_size (rs * size); } else --- 79,85 ---- mstride[n] = mask->dim[n].stride; rs *= extent[n]; } ! ret->offset = 0; ret->data = internal_malloc_size (rs * size); } else *************** unpack1 (gfc_array_char *ret, const gfc_ *** 177,195 **** } } } - iexport(unpack1); ! extern void unpack0 (const gfc_array_char *, const gfc_array_char *, const gfc_array_l4 *, char *); export_proto(unpack0); void ! unpack0 (const gfc_array_char *ret, const gfc_array_char *vector, const gfc_array_l4 *mask, char *field) { gfc_array_char tmp; tmp.dtype = 0; tmp.data = field; ! unpack1 (ret, vector, mask, &tmp); } --- 169,234 ---- } } } ! extern void unpack1 (gfc_array_char *, const gfc_array_char *, ! const gfc_array_l4 *, const gfc_array_char *); ! export_proto(unpack1); ! ! void ! unpack1 (gfc_array_char *ret, const gfc_array_char *vector, ! const gfc_array_l4 *mask, const gfc_array_char *field) ! { ! unpack_internal (ret, vector, mask, field, ! GFC_DESCRIPTOR_SIZE (vector), ! GFC_DESCRIPTOR_SIZE (field)); ! } ! ! extern void unpack1_char (gfc_array_char *, GFC_INTEGER_4, ! const gfc_array_char *, const gfc_array_l4 *, ! const gfc_array_char *, GFC_INTEGER_4, ! GFC_INTEGER_4); ! export_proto(unpack1_char); ! ! void ! unpack1_char (gfc_array_char *ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char *vector, const gfc_array_l4 *mask, ! const gfc_array_char *field, GFC_INTEGER_4 vector_length, ! GFC_INTEGER_4 field_length) ! { ! unpack_internal (ret, vector, mask, field, vector_length, field_length); ! } ! ! extern void unpack0 (gfc_array_char *, const gfc_array_char *, const gfc_array_l4 *, char *); export_proto(unpack0); void ! unpack0 (gfc_array_char *ret, const gfc_array_char *vector, const gfc_array_l4 *mask, char *field) { gfc_array_char tmp; tmp.dtype = 0; tmp.data = field; ! unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector), 0); ! } ! ! extern void unpack0_char (gfc_array_char *, GFC_INTEGER_4, ! const gfc_array_char *, const gfc_array_l4 *, ! char *, GFC_INTEGER_4, GFC_INTEGER_4); ! export_proto(unpack0_char); ! ! void ! unpack0_char (gfc_array_char *ret, ! GFC_INTEGER_4 ret_length __attribute__((unused)), ! const gfc_array_char *vector, const gfc_array_l4 *mask, ! char *field, GFC_INTEGER_4 vector_length, ! GFC_INTEGER_4 field_length __attribute__((unused))) ! { ! gfc_array_char tmp; ! ! tmp.dtype = 0; ! tmp.data = field; ! unpack_internal (ret, vector, mask, &tmp, vector_length, 0); } diff -Nrcpad gcc-4.0.2/libgfortran/io/backspace.c gcc-4.1.0/libgfortran/io/backspace.c *** gcc-4.0.2/libgfortran/io/backspace.c Fri Apr 8 19:09:05 2005 --- gcc-4.1.0/libgfortran/io/backspace.c Thu Jan 1 00:00:00 1970 *************** *** 1,182 **** - /* Copyright (C) 2002-2003 Free Software Foundation, Inc. - Contributed by Andy Vaught - - 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, 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - - #include "config.h" - #include - #include "libgfortran.h" - #include "io.h" - - /* backspace.c -- Implement the BACKSPACE statement */ - - /* formatted_backspace(void)-- Move the file back one line. The - * current position is after the newline that terminates the previous - * record, and we have to sift backwards to find the newline before - * that or the start of the file, whichever comes first. */ - - #define READ_CHUNK 4096 - - static void - formatted_backspace (void) - { - gfc_offset base; - char *p; - int n; - - base = file_position (current_unit->s) - 1; - - do - { - n = (base < READ_CHUNK) ? base : READ_CHUNK; - base -= n; - - p = salloc_r_at (current_unit->s, &n, base); - if (p == NULL) - goto io_error; - - /* Because we've moved backwords from the current position, it - * should not be possible to get a short read. Because it isn't - * clear what to do about such thing, we ignore the possibility. */ - - /* There is no memrchr() in the C library, so we have to do it - * ourselves. */ - - n--; - while (n >= 0) - { - if (p[n] == '\n') - { - base += n + 1; - goto done; - } - - n--; - } - - } - while (base != 0); - - /* base is the new pointer. Seek to it exactly */ - done: - if (sseek (current_unit->s, base) == FAILURE) - goto io_error; - current_unit->last_record--; - current_unit->endfile = NO_ENDFILE; - - return; - - io_error: - generate_error (ERROR_OS, NULL); - } - - - /* unformatted_backspace()-- Move the file backwards for an - * unformatted sequential file. We are guaranteed to be between - * records on entry and we have to shift to the previous record. */ - - static void - unformatted_backspace (void) - { - gfc_offset m, new; - int length; - char *p; - - length = sizeof (gfc_offset); - - p = salloc_r_at (current_unit->s, &length, - file_position (current_unit->s) - length); - if (p == NULL) - goto io_error; - - memcpy (&m, p, sizeof (gfc_offset)); - new = file_position (current_unit->s) - m - 2*length; - if (sseek (current_unit->s, new) == FAILURE) - goto io_error; - - current_unit->last_record--; - return; - - io_error: - generate_error (ERROR_OS, NULL); - } - - - extern void st_backspace (void); - export_proto(st_backspace); - - void - st_backspace (void) - { - gfc_unit *u; - - library_start (); - - u = find_unit (ioparm.unit); - if (u == NULL) - { - generate_error (ERROR_BAD_UNIT, NULL); - goto done; - } - - current_unit = u; - - /* Ignore direct access. Non-advancing I/O is only allowed for - * formatted sequential I/O and the next direct access transfer - * repositions the file anyway. */ - - if (u->flags.access == ACCESS_DIRECT) - goto done; - - /* Check for special cases involving the ENDFILE record first */ - - if (u->endfile == AFTER_ENDFILE) - u->endfile = AT_ENDFILE; - else - { - if (file_position (u->s) == 0) - goto done; /* Common special case */ - - if (u->mode == WRITING) - { - flush (u->s); - struncate (u->s); - u->mode = READING; - } - - if (u->flags.form == FORM_FORMATTED) - formatted_backspace (); - else - unformatted_backspace (); - - u->endfile = NO_ENDFILE; - u->current_record = 0; - } - - done: - library_end (); - } --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/io/close.c gcc-4.1.0/libgfortran/io/close.c *** gcc-4.0.2/libgfortran/io/close.c Fri Sep 9 21:52:12 2005 --- gcc-4.1.0/libgfortran/io/close.c Tue Nov 22 10:58:47 2005 *************** *** 1,4 **** ! /* Copyright (C) 2002-2003 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! /* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h" --- 24,31 ---- 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. */ #include "config.h" #include "libgfortran.h" *************** typedef enum *** 36,53 **** { CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED } close_status; ! static st_option status_opt[] = { {"keep", CLOSE_KEEP}, {"delete", CLOSE_DELETE}, ! {NULL} }; ! extern void st_close (void); export_proto(st_close); void ! st_close (void) { close_status status; gfc_unit *u; --- 36,53 ---- { CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED } close_status; ! static const st_option status_opt[] = { {"keep", CLOSE_KEEP}, {"delete", CLOSE_DELETE}, ! {NULL, 0} }; ! extern void st_close (st_parameter_close *); export_proto(st_close); void ! st_close (st_parameter_close *clp) { close_status status; gfc_unit *u; *************** st_close (void) *** 57,81 **** path = NULL; #endif ! library_start (); ! status = (ioparm.status == NULL) ? CLOSE_UNSPECIFIED : ! find_option (ioparm.status, ioparm.status_len, status_opt, ! "Bad STATUS parameter in CLOSE statement"); ! if (ioparm.library_return != LIBRARY_OK) { library_end (); return; } ! u = find_unit (ioparm.unit); if (u != NULL) { if (u->flags.status == STATUS_SCRATCH) { if (status == CLOSE_KEEP) ! generate_error (ERROR_BAD_OPTION, "Can't KEEP a scratch file on CLOSE"); #if !HAVE_UNLINK_OPEN_FILE path = (char *) gfc_alloca (u->file_len + 1); --- 57,81 ---- path = NULL; #endif ! library_start (&clp->common); ! status = !(clp->common.flags & IOPARM_CLOSE_HAS_STATUS) ? CLOSE_UNSPECIFIED : ! find_option (&clp->common, clp->status, clp->status_len, ! status_opt, "Bad STATUS parameter in CLOSE statement"); ! if ((clp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) { library_end (); return; } ! u = find_unit (clp->common.unit); if (u != NULL) { if (u->flags.status == STATUS_SCRATCH) { if (status == CLOSE_KEEP) ! generate_error (&clp->common, ERROR_BAD_OPTION, "Can't KEEP a scratch file on CLOSE"); #if !HAVE_UNLINK_OPEN_FILE path = (char *) gfc_alloca (u->file_len + 1); diff -Nrcpad gcc-4.0.2/libgfortran/io/endfile.c gcc-4.1.0/libgfortran/io/endfile.c *** gcc-4.0.2/libgfortran/io/endfile.c Wed Jan 12 21:27:30 2005 --- gcc-4.1.0/libgfortran/io/endfile.c Thu Jan 1 00:00:00 1970 *************** *** 1,59 **** - /* Copyright (C) 2002-2003 Free Software Foundation, Inc. - Contributed by Andy Vaught - - 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, 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - - #include "config.h" - #include "libgfortran.h" - #include "io.h" - - /* endfile.c-- Implement the ENDFILE statement */ - - extern void st_endfile (void); - export_proto(st_endfile); - - void - st_endfile (void) - { - gfc_unit *u; - - library_start (); - - u = get_unit (0); - if (u != NULL) - { - current_unit = u; /* next_record() needs this set */ - if (u->current_record) - next_record (1); - - flush(u->s); - struncate (u->s); - u->endfile = AFTER_ENDFILE; - } - - library_end (); - } --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/io/file_pos.c gcc-4.1.0/libgfortran/io/file_pos.c *** gcc-4.0.2/libgfortran/io/file_pos.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/io/file_pos.c Sun Jan 8 02:16:11 2006 *************** *** 0 **** --- 1,291 ---- + /* Copyright (C) 2002-2003, 2005 Free Software Foundation, Inc. + Contributed by Andy Vaught and Janne Blomqvist + + This file is part of the GNU Fortran 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. */ + + #include "config.h" + #include + #include "libgfortran.h" + #include "io.h" + + /* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE, + ENDFILE, and REWIND as well as the FLUSH statement. */ + + + /* formatted_backspace(fpp, u)-- Move the file back one line. The + current position is after the newline that terminates the previous + record, and we have to sift backwards to find the newline before + that or the start of the file, whichever comes first. */ + + #define READ_CHUNK 4096 + + static void + formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) + { + gfc_offset base; + char *p; + int n; + + base = file_position (u->s) - 1; + + do + { + n = (base < READ_CHUNK) ? base : READ_CHUNK; + base -= n; + + p = salloc_r_at (u->s, &n, base); + if (p == NULL) + goto io_error; + + /* We have moved backwards from the current position, it should + not be possible to get a short read. Because it is not + clear what to do about such thing, we ignore the possibility. */ + + /* There is no memrchr() in the C library, so we have to do it + ourselves. */ + + n--; + while (n >= 0) + { + if (p[n] == '\n') + { + base += n + 1; + goto done; + } + n--; + } + + } + while (base != 0); + + /* base is the new pointer. Seek to it exactly. */ + done: + if (sseek (u->s, base) == FAILURE) + goto io_error; + u->last_record--; + u->endfile = NO_ENDFILE; + + return; + + io_error: + generate_error (&fpp->common, ERROR_OS, NULL); + } + + + /* unformatted_backspace(fpp) -- Move the file backwards for an unformatted + sequential file. We are guaranteed to be between records on entry and + we have to shift to the previous record. */ + + static void + unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) + { + gfc_offset m, new; + int length; + char *p; + + length = sizeof (gfc_offset); + + p = salloc_r_at (u->s, &length, + file_position (u->s) - length); + if (p == NULL) + goto io_error; + + /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ + if (u->flags.convert == CONVERT_NATIVE) + memcpy (&m, p, sizeof (gfc_offset)); + else + reverse_memcpy (&m, p, sizeof (gfc_offset)); + + if ((new = file_position (u->s) - m - 2*length) < 0) + new = 0; + + if (sseek (u->s, new) == FAILURE) + goto io_error; + + u->last_record--; + return; + + io_error: + generate_error (&fpp->common, ERROR_OS, NULL); + } + + + extern void st_backspace (st_parameter_filepos *); + export_proto(st_backspace); + + void + st_backspace (st_parameter_filepos *fpp) + { + gfc_unit *u; + + library_start (&fpp->common); + + u = find_unit (fpp->common.unit); + if (u == NULL) + { + generate_error (&fpp->common, ERROR_BAD_UNIT, NULL); + goto done; + } + + /* Ignore direct access. Non-advancing I/O is only allowed for formatted + sequential I/O and the next direct access transfer repositions the file + anyway. */ + + if (u->flags.access == ACCESS_DIRECT) + goto done; + + /* Check for special cases involving the ENDFILE record first. */ + + if (u->endfile == AFTER_ENDFILE) + u->endfile = AT_ENDFILE; + else + { + if (file_position (u->s) == 0) + goto done; /* Common special case */ + + if (u->mode == WRITING) + { + flush (u->s); + struncate (u->s); + u->mode = READING; + } + + if (u->flags.form == FORM_FORMATTED) + formatted_backspace (fpp, u); + else + unformatted_backspace (fpp, u); + + u->endfile = NO_ENDFILE; + u->current_record = 0; + u->bytes_left = 0; + } + + done: + if (u != NULL) + unlock_unit (u); + + library_end (); + } + + + extern void st_endfile (st_parameter_filepos *); + export_proto(st_endfile); + + void + st_endfile (st_parameter_filepos *fpp) + { + gfc_unit *u; + + library_start (&fpp->common); + + u = find_unit (fpp->common.unit); + if (u != NULL) + { + if (u->current_record) + { + st_parameter_dt dtp; + dtp.common = fpp->common; + memset (&dtp.u.p, 0, sizeof (dtp.u.p)); + dtp.u.p.current_unit = u; + next_record (&dtp, 1); + } + + flush (u->s); + struncate (u->s); + u->endfile = AFTER_ENDFILE; + unlock_unit (u); + } + + library_end (); + } + + + extern void st_rewind (st_parameter_filepos *); + export_proto(st_rewind); + + void + st_rewind (st_parameter_filepos *fpp) + { + gfc_unit *u; + + library_start (&fpp->common); + + u = find_unit (fpp->common.unit); + if (u != NULL) + { + if (u->flags.access != ACCESS_SEQUENTIAL) + generate_error (&fpp->common, ERROR_BAD_OPTION, + "Cannot REWIND a file opened for DIRECT access"); + else + { + /* If we have been writing to the file, the last written record + is the last record in the file, so truncate the file now. + Reset to read mode so two consecutive rewind statements do not + delete the file contents. Flush buffer when switching mode. */ + if (u->mode == WRITING) + { + flush (u->s); + struncate (u->s); + } + u->mode = READING; + u->last_record = 0; + if (sseek (u->s, 0) == FAILURE) + generate_error (&fpp->common, ERROR_OS, NULL); + + u->endfile = NO_ENDFILE; + u->current_record = 0; + u->bytes_left = 0; + test_endfile (u); + } + /* Update position for INQUIRE. */ + u->flags.position = POSITION_REWIND; + unlock_unit (u); + } + + library_end (); + } + + + extern void st_flush (st_parameter_filepos *); + export_proto(st_flush); + + void + st_flush (st_parameter_filepos *fpp) + { + gfc_unit *u; + + library_start (&fpp->common); + + u = find_unit (fpp->common.unit); + if (u != NULL) + { + flush (u->s); + unlock_unit (u); + } + + library_end (); + } diff -Nrcpad gcc-4.0.2/libgfortran/io/format.c gcc-4.1.0/libgfortran/io/format.c *** gcc-4.0.2/libgfortran/io/format.c Thu Aug 11 13:53:22 2005 --- gcc-4.1.0/libgfortran/io/format.c Sun Dec 4 18:22:20 2005 *************** *** 1,4 **** ! /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005 ! Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* format.c-- parse a FORMAT string into a binary format suitable for --- 25,32 ---- 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. */ /* format.c-- parse a FORMAT string into a binary format suitable for *************** Boston, MA 02111-1307, USA. */ *** 37,64 **** #include "libgfortran.h" #include "io.h" ! /* Number of format nodes that we can store statically before we have ! * to resort to dynamic allocation. The root node is array[0]. */ ! ! #define FARRAY_SIZE 200 ! ! static fnode *avail, array[FARRAY_SIZE]; ! ! /* Local variables for checking format strings. The saved_token is ! * used to back up by a single format token during the parsing process. */ ! ! static char *format_string, *string; ! static const char *error; ! static format_token saved_token; ! static int value, format_string_len, reversion_ok; ! static fnode *saved_format, colon_node = { FMT_COLON }; /* Error messages */ ! static char posint_required[] = "Positive width required in format", period_required[] = "Period required in format", nonneg_required[] = "Nonnegative width required in format", unexpected_element[] = "Unexpected element in format", --- 38,71 ---- #include "libgfortran.h" #include "io.h" + #define FARRAY_SIZE 64 + typedef struct fnode_array + { + struct fnode_array *next; + fnode array[FARRAY_SIZE]; + } + fnode_array; ! typedef struct format_data ! { ! char *format_string, *string; ! const char *error; ! format_token saved_token; ! int value, format_string_len, reversion_ok; ! fnode *avail; ! const fnode *saved_format; ! fnode_array *last; ! fnode_array array; ! } ! format_data; ! static const fnode colon_node = { FMT_COLON, 0, NULL, NULL, {{ 0, 0, 0 }}, 0, ! NULL }; /* Error messages */ ! static const char posint_required[] = "Positive width required in format", period_required[] = "Period required in format", nonneg_required[] = "Nonnegative width required in format", unexpected_element[] = "Unexpected element in format", *************** static char posint_required[] = "Positiv *** 73,89 **** * spaces are significant, otherwise they are not. */ static int ! next_char (int literal) { int c; do { ! if (format_string_len == 0) return -1; ! format_string_len--; ! c = toupper (*format_string++); } while (c == ' ' && !literal); --- 80,96 ---- * spaces are significant, otherwise they are not. */ static int ! next_char (format_data *fmt, int literal) { int c; do { ! if (fmt->format_string_len == 0) return -1; ! fmt->format_string_len--; ! c = toupper (*fmt->format_string++); } while (c == ' ' && !literal); *************** next_char (int literal) *** 93,99 **** /* unget_char()-- Back up one character position. */ ! #define unget_char() { format_string--; format_string_len++; } /* get_fnode()-- Allocate a new format node, inserting it into the --- 100,107 ---- /* unget_char()-- Back up one character position. */ ! #define unget_char(fmt) \ ! { fmt->format_string--; fmt->format_string_len++; } /* get_fnode()-- Allocate a new format node, inserting it into the *************** next_char (int literal) *** 101,117 **** * static buffer. */ static fnode * ! get_fnode (fnode ** head, fnode ** tail, format_token t) { fnode *f; ! if (avail - array >= FARRAY_SIZE) ! f = get_mem (sizeof (fnode)); ! else { ! f = avail++; ! memset (f, '\0', sizeof (fnode)); } if (*head == NULL) *head = *tail = f; --- 109,127 ---- * static buffer. */ static fnode * ! get_fnode (format_data *fmt, fnode **head, fnode **tail, format_token t) { fnode *f; ! if (fmt->avail == &fmt->last->array[FARRAY_SIZE]) { ! fmt->last->next = get_mem (sizeof (fnode_array)); ! fmt->last = fmt->last->next; ! fmt->last->next = NULL; ! fmt->avail = &fmt->last->array[0]; } + f = fmt->avail++; + memset (f, '\0', sizeof (fnode)); if (*head == NULL) *head = *tail = f; *************** get_fnode (fnode ** head, fnode ** tail, *** 123,189 **** f->format = t; f->repeat = -1; ! f->source = format_string; return f; } ! /* free_fnode()-- Recursive function to free the given fnode and ! * everything it points to. We only have to actually free something ! * if it is outside of the static array. */ ! static void ! free_fnode (fnode * f) { ! fnode *next; ! for (; f; f = next) ! { ! next = f->next; ! if (f->format == FMT_LPAREN) ! free_fnode (f->u.child); ! if (f < array || f >= array + FARRAY_SIZE) ! free_mem (f); } - } - - - /* free_fnodes()-- Free the current tree of fnodes. We only have to - * traverse the tree if some nodes were allocated dynamically. */ ! void ! free_fnodes (void) ! { ! if (avail - array >= FARRAY_SIZE) ! free_fnode (&array[0]); ! ! avail = array; ! memset(array, 0, sizeof(avail[0]) * FARRAY_SIZE); } /* format_lex()-- Simple lexical analyzer for getting the next token * in a FORMAT string. We support a one-level token pushback in the ! * saved_token variable. */ static format_token ! format_lex (void) { format_token token; int negative_flag; int c; char delim; ! if (saved_token != FMT_NONE) { ! token = saved_token; ! saved_token = FMT_NONE; return token; } negative_flag = 0; ! c = next_char (0); switch (c) { --- 133,186 ---- f->format = t; f->repeat = -1; ! f->source = fmt->format_string; return f; } ! /* free_format_data()-- Free all allocated format data. */ ! void ! free_format_data (st_parameter_dt *dtp) { ! fnode_array *fa, *fa_next; ! format_data *fmt = dtp->u.p.fmt; ! if (fmt == NULL) ! return; ! for (fa = fmt->array.next; fa; fa = fa_next) ! { ! fa_next = fa->next; ! free_mem (fa); } ! free_mem (fmt); ! dtp->u.p.fmt = NULL; } /* format_lex()-- Simple lexical analyzer for getting the next token * in a FORMAT string. We support a one-level token pushback in the ! * fmt->saved_token variable. */ static format_token ! format_lex (format_data *fmt) { format_token token; int negative_flag; int c; char delim; ! if (fmt->saved_token != FMT_NONE) { ! token = fmt->saved_token; ! fmt->saved_token = FMT_NONE; return token; } negative_flag = 0; ! c = next_char (fmt, 0); switch (c) { *************** format_lex (void) *** 192,219 **** /* Fall Through */ case '+': ! c = next_char (0); if (!isdigit (c)) { token = FMT_UNKNOWN; break; } ! value = c - '0'; for (;;) { ! c = next_char (0); if (!isdigit (c)) break; ! value = 10 * value + c - '0'; } ! unget_char (); if (negative_flag) ! value = -value; token = FMT_SIGNED_INT; break; --- 189,216 ---- /* Fall Through */ case '+': ! c = next_char (fmt, 0); if (!isdigit (c)) { token = FMT_UNKNOWN; break; } ! fmt->value = c - '0'; for (;;) { ! c = next_char (fmt, 0); if (!isdigit (c)) break; ! fmt->value = 10 * fmt->value + c - '0'; } ! unget_char (fmt); if (negative_flag) ! fmt->value = -fmt->value; token = FMT_SIGNED_INT; break; *************** format_lex (void) *** 227,245 **** case '7': case '8': case '9': ! value = c - '0'; for (;;) { ! c = next_char (0); if (!isdigit (c)) break; ! value = 10 * value + c - '0'; } ! unget_char (); ! token = (value == 0) ? FMT_ZERO : FMT_POSINT; break; case '.': --- 224,242 ---- case '7': case '8': case '9': ! fmt->value = c - '0'; for (;;) { ! c = next_char (fmt, 0); if (!isdigit (c)) break; ! fmt->value = 10 * fmt->value + c - '0'; } ! unget_char (fmt); ! token = (fmt->value == 0) ? FMT_ZERO : FMT_POSINT; break; case '.': *************** format_lex (void) *** 263,269 **** break; case 'T': ! switch (next_char (0)) { case 'L': token = FMT_TL; --- 260,266 ---- break; case 'T': ! switch (next_char (fmt, 0)) { case 'L': token = FMT_TL; *************** format_lex (void) *** 273,279 **** break; default: token = FMT_T; ! unget_char (); break; } --- 270,276 ---- break; default: token = FMT_T; ! unget_char (fmt); break; } *************** format_lex (void) *** 292,298 **** break; case 'S': ! switch (next_char (0)) { case 'S': token = FMT_SS; --- 289,295 ---- break; case 'S': ! switch (next_char (fmt, 0)) { case 'S': token = FMT_SS; *************** format_lex (void) *** 302,315 **** break; default: token = FMT_S; ! unget_char (); break; } break; case 'B': ! switch (next_char (0)) { case 'N': token = FMT_BN; --- 299,312 ---- break; default: token = FMT_S; ! unget_char (fmt); break; } break; case 'B': ! switch (next_char (fmt, 0)) { case 'N': token = FMT_BN; *************** format_lex (void) *** 319,325 **** break; default: token = FMT_B; ! unget_char (); break; } --- 316,322 ---- break; default: token = FMT_B; ! unget_char (fmt); break; } *************** format_lex (void) *** 329,367 **** case '"': delim = c; ! string = format_string; ! value = 0; /* This is the length of the string */ for (;;) { ! c = next_char (1); if (c == -1) { token = FMT_BADSTRING; ! error = bad_string; break; } if (c == delim) { ! c = next_char (1); if (c == -1) { token = FMT_BADSTRING; ! error = bad_string; break; } if (c != delim) { ! unget_char (); token = FMT_STRING; break; } } ! value++; } break; --- 326,364 ---- case '"': delim = c; ! fmt->string = fmt->format_string; ! fmt->value = 0; /* This is the length of the string */ for (;;) { ! c = next_char (fmt, 1); if (c == -1) { token = FMT_BADSTRING; ! fmt->error = bad_string; break; } if (c == delim) { ! c = next_char (fmt, 1); if (c == -1) { token = FMT_BADSTRING; ! fmt->error = bad_string; break; } if (c != delim) { ! unget_char (fmt); token = FMT_STRING; break; } } ! fmt->value++; } break; *************** format_lex (void) *** 387,393 **** break; case 'E': ! switch (next_char (0)) { case 'N': token = FMT_EN; --- 384,390 ---- break; case 'E': ! switch (next_char (fmt, 0)) { case 'N': token = FMT_EN; *************** format_lex (void) *** 397,403 **** break; default: token = FMT_E; ! unget_char (); break; } --- 394,400 ---- break; default: token = FMT_E; ! unget_char (fmt); break; } *************** format_lex (void) *** 441,484 **** * parenthesis node which contains the rest of the list. */ static fnode * ! parse_format_list (void) { fnode *head, *tail; format_token t, u, t2; int repeat; head = tail = NULL; /* Get the next format item */ format_item: ! t = format_lex (); format_item_1: switch (t) { case FMT_POSINT: ! repeat = value; ! t = format_lex (); switch (t) { case FMT_LPAREN: ! get_fnode (&head, &tail, FMT_LPAREN); tail->repeat = repeat; ! tail->u.child = parse_format_list (); ! if (error != NULL) goto finished; goto between_desc; case FMT_SLASH: ! get_fnode (&head, &tail, FMT_SLASH); tail->repeat = repeat; goto optional_comma; case FMT_X: ! get_fnode (&head, &tail, FMT_X); tail->repeat = 1; ! tail->u.k = value; goto between_desc; case FMT_P: --- 438,482 ---- * parenthesis node which contains the rest of the list. */ static fnode * ! parse_format_list (st_parameter_dt *dtp) { fnode *head, *tail; format_token t, u, t2; int repeat; + format_data *fmt = dtp->u.p.fmt; head = tail = NULL; /* Get the next format item */ format_item: ! t = format_lex (fmt); format_item_1: switch (t) { case FMT_POSINT: ! repeat = fmt->value; ! t = format_lex (fmt); switch (t) { case FMT_LPAREN: ! get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = repeat; ! tail->u.child = parse_format_list (dtp); ! if (fmt->error != NULL) goto finished; goto between_desc; case FMT_SLASH: ! get_fnode (fmt, &head, &tail, FMT_SLASH); tail->repeat = repeat; goto optional_comma; case FMT_X: ! get_fnode (fmt, &head, &tail, FMT_X); tail->repeat = 1; ! tail->u.k = fmt->value; goto between_desc; case FMT_P: *************** parse_format_list (void) *** 489,517 **** } case FMT_LPAREN: ! get_fnode (&head, &tail, FMT_LPAREN); tail->repeat = 1; ! tail->u.child = parse_format_list (); ! if (error != NULL) goto finished; goto between_desc; case FMT_SIGNED_INT: /* Signed integer can only precede a P format. */ case FMT_ZERO: /* Same for zero. */ ! t = format_lex (); if (t != FMT_P) { ! error = "Expected P edit descriptor in format"; goto finished; } p_descriptor: ! get_fnode (&head, &tail, FMT_P); ! tail->u.k = value; tail->repeat = 1; ! t = format_lex (); if (t == FMT_F || t == FMT_EN || t == FMT_ES || t == FMT_D || t == FMT_G || t == FMT_E) { --- 487,515 ---- } case FMT_LPAREN: ! get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = 1; ! tail->u.child = parse_format_list (dtp); ! if (fmt->error != NULL) goto finished; goto between_desc; case FMT_SIGNED_INT: /* Signed integer can only precede a P format. */ case FMT_ZERO: /* Same for zero. */ ! t = format_lex (fmt); if (t != FMT_P) { ! fmt->error = "Expected P edit descriptor in format"; goto finished; } p_descriptor: ! get_fnode (fmt, &head, &tail, FMT_P); ! tail->u.k = fmt->value; tail->repeat = 1; ! t = format_lex (fmt); if (t == FMT_F || t == FMT_EN || t == FMT_ES || t == FMT_D || t == FMT_G || t == FMT_E) { *************** parse_format_list (void) *** 519,529 **** goto data_desc; } ! saved_token = t; goto optional_comma; case FMT_P: /* P and X require a prior number */ ! error = "P descriptor requires leading scale factor"; goto finished; case FMT_X: --- 517,527 ---- goto data_desc; } ! fmt->saved_token = t; goto optional_comma; case FMT_P: /* P and X require a prior number */ ! fmt->error = "P descriptor requires leading scale factor"; goto finished; case FMT_X: *************** parse_format_list (void) *** 533,539 **** If we would be pedantic in the library, we would have to reject an X descriptor without an integer prefix: ! error = "X descriptor requires leading space count"; goto finished; However, this is an extension supported by many Fortran compilers, --- 531,537 ---- If we would be pedantic in the library, we would have to reject an X descriptor without an integer prefix: ! fmt->error = "X descriptor requires leading space count"; goto finished; However, this is an extension supported by many Fortran compilers, *************** parse_format_list (void) *** 541,556 **** runtime library, and make the front end reject it if the compiler is in pedantic mode. The interpretation of 'X' is '1X'. */ ! get_fnode (&head, &tail, FMT_X); tail->repeat = 1; tail->u.k = 1; goto between_desc; case FMT_STRING: ! get_fnode (&head, &tail, FMT_STRING); ! tail->u.string.p = string; ! tail->u.string.length = value; tail->repeat = 1; goto optional_comma; --- 539,554 ---- runtime library, and make the front end reject it if the compiler is in pedantic mode. The interpretation of 'X' is '1X'. */ ! get_fnode (fmt, &head, &tail, FMT_X); tail->repeat = 1; tail->u.k = 1; goto between_desc; case FMT_STRING: ! get_fnode (fmt, &head, &tail, FMT_STRING); ! tail->u.string.p = fmt->string; ! tail->u.string.length = fmt->value; tail->repeat = 1; goto optional_comma; *************** parse_format_list (void) *** 559,581 **** case FMT_SP: case FMT_BN: case FMT_BZ: ! get_fnode (&head, &tail, t); tail->repeat = 1; goto between_desc; case FMT_COLON: ! get_fnode (&head, &tail, FMT_COLON); tail->repeat = 1; goto optional_comma; case FMT_SLASH: ! get_fnode (&head, &tail, FMT_SLASH); tail->repeat = 1; tail->u.r = 1; goto optional_comma; case FMT_DOLLAR: ! get_fnode (&head, &tail, FMT_DOLLAR); tail->repeat = 1; notify_std (GFC_STD_GNU, "Extension: $ descriptor"); goto between_desc; --- 557,579 ---- case FMT_SP: case FMT_BN: case FMT_BZ: ! get_fnode (fmt, &head, &tail, t); tail->repeat = 1; goto between_desc; case FMT_COLON: ! get_fnode (fmt, &head, &tail, FMT_COLON); tail->repeat = 1; goto optional_comma; case FMT_SLASH: ! get_fnode (fmt, &head, &tail, FMT_SLASH); tail->repeat = 1; tail->u.r = 1; goto optional_comma; case FMT_DOLLAR: ! get_fnode (fmt, &head, &tail, FMT_DOLLAR); tail->repeat = 1; notify_std (GFC_STD_GNU, "Extension: $ descriptor"); goto between_desc; *************** parse_format_list (void) *** 583,596 **** case FMT_T: case FMT_TL: case FMT_TR: ! t2 = format_lex (); if (t2 != FMT_POSINT) { ! error = posint_required; goto finished; } ! get_fnode (&head, &tail, t); ! tail->u.n = value; tail->repeat = 1; goto between_desc; --- 581,594 ---- case FMT_T: case FMT_TL: case FMT_TR: ! t2 = format_lex (fmt); if (t2 != FMT_POSINT) { ! fmt->error = posint_required; goto finished; } ! get_fnode (fmt, &head, &tail, t); ! tail->u.n = fmt->value; tail->repeat = 1; goto between_desc; *************** parse_format_list (void) *** 610,634 **** goto data_desc; case FMT_H: ! get_fnode (&head, &tail, FMT_STRING); ! if (format_string_len < 1) { ! error = bad_hollerith; goto finished; } ! tail->u.string.p = format_string; tail->u.string.length = 1; tail->repeat = 1; ! format_string++; ! format_string_len--; goto between_desc; case FMT_END: ! error = unexpected_end; goto finished; case FMT_BADSTRING: --- 608,632 ---- goto data_desc; case FMT_H: ! get_fnode (fmt, &head, &tail, FMT_STRING); ! if (fmt->format_string_len < 1) { ! fmt->error = bad_hollerith; goto finished; } ! tail->u.string.p = fmt->format_string; tail->u.string.length = 1; tail->repeat = 1; ! fmt->format_string++; ! fmt->format_string_len--; goto between_desc; case FMT_END: ! fmt->error = unexpected_end; goto finished; case FMT_BADSTRING: *************** parse_format_list (void) *** 638,644 **** goto finished; default: ! error = unexpected_element; goto finished; } --- 636,642 ---- goto finished; default: ! fmt->error = unexpected_element; goto finished; } *************** parse_format_list (void) *** 648,689 **** switch (t) { case FMT_P: ! t = format_lex (); if (t == FMT_POSINT) { ! error = "Repeat count cannot follow P descriptor"; goto finished; } ! saved_token = t; ! get_fnode (&head, &tail, FMT_P); goto optional_comma; case FMT_L: ! t = format_lex (); if (t != FMT_POSINT) { ! error = posint_required; goto finished; } ! get_fnode (&head, &tail, FMT_L); ! tail->u.n = value; tail->repeat = repeat; break; case FMT_A: ! t = format_lex (); if (t != FMT_POSINT) { ! saved_token = t; ! value = -1; /* Width not present */ } ! get_fnode (&head, &tail, FMT_A); tail->repeat = repeat; ! tail->u.n = value; break; case FMT_D: --- 646,687 ---- switch (t) { case FMT_P: ! t = format_lex (fmt); if (t == FMT_POSINT) { ! fmt->error = "Repeat count cannot follow P descriptor"; goto finished; } ! fmt->saved_token = t; ! get_fnode (fmt, &head, &tail, FMT_P); goto optional_comma; case FMT_L: ! t = format_lex (fmt); if (t != FMT_POSINT) { ! fmt->error = posint_required; goto finished; } ! get_fnode (fmt, &head, &tail, FMT_L); ! tail->u.n = fmt->value; tail->repeat = repeat; break; case FMT_A: ! t = format_lex (fmt); if (t != FMT_POSINT) { ! fmt->saved_token = t; ! fmt->value = -1; /* Width not present */ } ! get_fnode (fmt, &head, &tail, FMT_A); tail->repeat = repeat; ! tail->u.n = fmt->value; break; case FMT_D: *************** parse_format_list (void) *** 692,706 **** case FMT_G: case FMT_EN: case FMT_ES: ! get_fnode (&head, &tail, t); tail->repeat = repeat; ! u = format_lex (); ! if (t == FMT_F || g.mode == WRITING) { if (u != FMT_POSINT && u != FMT_ZERO) { ! error = nonneg_required; goto finished; } } --- 690,704 ---- case FMT_G: case FMT_EN: case FMT_ES: ! get_fnode (fmt, &head, &tail, t); tail->repeat = repeat; ! u = format_lex (fmt); ! if (t == FMT_F || dtp->u.p.mode == WRITING) { if (u != FMT_POSINT && u != FMT_ZERO) { ! fmt->error = nonneg_required; goto finished; } } *************** parse_format_list (void) *** 708,735 **** { if (u != FMT_POSINT) { ! error = posint_required; goto finished; } } ! tail->u.real.w = value; t2 = t; ! t = format_lex (); if (t != FMT_PERIOD) { ! error = period_required; goto finished; } ! t = format_lex (); if (t != FMT_ZERO && t != FMT_POSINT) { ! error = nonneg_required; goto finished; } ! tail->u.real.d = value; if (t == FMT_D || t == FMT_F) break; --- 706,733 ---- { if (u != FMT_POSINT) { ! fmt->error = posint_required; goto finished; } } ! tail->u.real.w = fmt->value; t2 = t; ! t = format_lex (fmt); if (t != FMT_PERIOD) { ! fmt->error = period_required; goto finished; } ! t = format_lex (fmt); if (t != FMT_ZERO && t != FMT_POSINT) { ! fmt->error = nonneg_required; goto finished; } ! tail->u.real.d = fmt->value; if (t == FMT_D || t == FMT_F) break; *************** parse_format_list (void) *** 737,774 **** tail->u.real.e = -1; /* Look for optional exponent */ ! t = format_lex (); if (t != FMT_E) ! saved_token = t; else { ! t = format_lex (); if (t != FMT_POSINT) { ! error = "Positive exponent width required in format"; goto finished; } ! tail->u.real.e = value; } break; case FMT_H: ! if (repeat > format_string_len) { ! error = bad_hollerith; goto finished; } ! get_fnode (&head, &tail, FMT_STRING); ! tail->u.string.p = format_string; tail->u.string.length = repeat; tail->repeat = 1; ! format_string += value; ! format_string_len -= repeat; break; --- 735,772 ---- tail->u.real.e = -1; /* Look for optional exponent */ ! t = format_lex (fmt); if (t != FMT_E) ! fmt->saved_token = t; else { ! t = format_lex (fmt); if (t != FMT_POSINT) { ! fmt->error = "Positive exponent width required in format"; goto finished; } ! tail->u.real.e = fmt->value; } break; case FMT_H: ! if (repeat > fmt->format_string_len) { ! fmt->error = bad_hollerith; goto finished; } ! get_fnode (fmt, &head, &tail, FMT_STRING); ! tail->u.string.p = fmt->format_string; tail->u.string.length = repeat; tail->repeat = 1; ! fmt->format_string += fmt->value; ! fmt->format_string_len -= repeat; break; *************** parse_format_list (void) *** 776,791 **** case FMT_B: case FMT_O: case FMT_Z: ! get_fnode (&head, &tail, t); tail->repeat = repeat; ! t = format_lex (); ! if (g.mode == READING) { if (t != FMT_POSINT) { ! error = posint_required; goto finished; } } --- 774,789 ---- case FMT_B: case FMT_O: case FMT_Z: ! get_fnode (fmt, &head, &tail, t); tail->repeat = repeat; ! t = format_lex (fmt); ! if (dtp->u.p.mode == READING) { if (t != FMT_POSINT) { ! fmt->error = posint_required; goto finished; } } *************** parse_format_list (void) *** 793,839 **** { if (t != FMT_ZERO && t != FMT_POSINT) { ! error = nonneg_required; goto finished; } } ! tail->u.integer.w = value; tail->u.integer.m = -1; ! t = format_lex (); if (t != FMT_PERIOD) { ! saved_token = t; } else { ! t = format_lex (); if (t != FMT_ZERO && t != FMT_POSINT) { ! error = nonneg_required; goto finished; } ! tail->u.integer.m = value; } if (tail->u.integer.w != 0 && tail->u.integer.m > tail->u.integer.w) { ! error = "Minimum digits exceeds field width"; goto finished; } break; default: ! error = unexpected_element; goto finished; } /* Between a descriptor and what comes next */ between_desc: ! t = format_lex (); switch (t) { case FMT_COMMA: --- 791,837 ---- { if (t != FMT_ZERO && t != FMT_POSINT) { ! fmt->error = nonneg_required; goto finished; } } ! tail->u.integer.w = fmt->value; tail->u.integer.m = -1; ! t = format_lex (fmt); if (t != FMT_PERIOD) { ! fmt->saved_token = t; } else { ! t = format_lex (fmt); if (t != FMT_ZERO && t != FMT_POSINT) { ! fmt->error = nonneg_required; goto finished; } ! tail->u.integer.m = fmt->value; } if (tail->u.integer.w != 0 && tail->u.integer.m > tail->u.integer.w) { ! fmt->error = "Minimum digits exceeds field width"; goto finished; } break; default: ! fmt->error = unexpected_element; goto finished; } /* Between a descriptor and what comes next */ between_desc: ! t = format_lex (fmt); switch (t) { case FMT_COMMA: *************** parse_format_list (void) *** 843,849 **** goto finished; case FMT_SLASH: ! get_fnode (&head, &tail, FMT_SLASH); tail->repeat = 1; /* Fall Through */ --- 841,847 ---- goto finished; case FMT_SLASH: ! get_fnode (fmt, &head, &tail, FMT_SLASH); tail->repeat = 1; /* Fall Through */ *************** parse_format_list (void) *** 852,858 **** goto optional_comma; case FMT_END: ! error = unexpected_end; goto finished; default: --- 850,856 ---- goto optional_comma; case FMT_END: ! fmt->error = unexpected_end; goto finished; default: *************** parse_format_list (void) *** 863,869 **** /* Optional comma is a weird between state where we've just finished reading a colon, slash or P descriptor. */ optional_comma: ! t = format_lex (); switch (t) { case FMT_COMMA: --- 861,867 ---- /* Optional comma is a weird between state where we've just finished reading a colon, slash or P descriptor. */ optional_comma: ! t = format_lex (fmt); switch (t) { case FMT_COMMA: *************** parse_format_list (void) *** 873,879 **** goto finished; default: /* Assume that we have another format item */ ! saved_token = t; break; } --- 871,877 ---- goto finished; default: /* Assume that we have another format item */ ! fmt->saved_token = t; break; } *************** parse_format_list (void) *** 889,918 **** * is assumed to happen at parse time, and the current location of the * parser is shown. * ! * After freeing any dynamically allocated fnodes, generate a message ! * showing where the problem is. We take extra care to print only the ! * relevant part of the format if it is longer than a standard 80 ! * column display. */ void ! format_error (fnode * f, const char *message) { int width, i, j, offset; char *p, buffer[300]; if (f != NULL) ! format_string = f->source; ! ! free_fnodes (); st_sprintf (buffer, "%s\n", message); ! j = format_string - ioparm.format; offset = (j > 60) ? j - 40 : 0; j -= offset; ! width = ioparm.format_len - offset; if (width > 80) width = 80; --- 887,914 ---- * is assumed to happen at parse time, and the current location of the * parser is shown. * ! * We generate a message showing where the problem is. We take extra ! * care to print only the relevant part of the format if it is longer ! * than a standard 80 column display. */ void ! format_error (st_parameter_dt *dtp, const fnode *f, const char *message) { int width, i, j, offset; char *p, buffer[300]; + format_data *fmt = dtp->u.p.fmt; if (f != NULL) ! fmt->format_string = f->source; st_sprintf (buffer, "%s\n", message); ! j = fmt->format_string - dtp->format; offset = (j > 60) ? j - 40 : 0; j -= offset; ! width = dtp->format_len - offset; if (width > 80) width = 80; *************** format_error (fnode * f, const char *mes *** 921,927 **** p = strchr (buffer, '\0'); ! memcpy (p, ioparm.format + offset, width); p += width; *p++ = '\n'; --- 917,923 ---- p = strchr (buffer, '\0'); ! memcpy (p, dtp->format + offset, width); p += width; *p++ = '\n'; *************** format_error (fnode * f, const char *mes *** 934,975 **** *p++ = '^'; *p = '\0'; ! generate_error (ERROR_FORMAT, buffer); } /* parse_format()-- Parse a format string. */ void ! parse_format (void) { ! format_string = ioparm.format; ! format_string_len = ioparm.format_len; ! saved_token = FMT_NONE; ! error = NULL; /* Initialize variables used during traversal of the tree */ ! reversion_ok = 0; ! g.reversion_flag = 0; ! saved_format = NULL; /* Allocate the first format node as the root of the tree */ ! avail = array; ! avail->format = FMT_LPAREN; ! avail->repeat = 1; ! avail++; ! if (format_lex () == FMT_LPAREN) ! array[0].u.child = parse_format_list (); else ! error = "Missing initial left parenthesis in format"; ! if (error) ! format_error (NULL, error); } --- 930,978 ---- *p++ = '^'; *p = '\0'; ! generate_error (&dtp->common, ERROR_FORMAT, buffer); } /* parse_format()-- Parse a format string. */ void ! parse_format (st_parameter_dt *dtp) { ! format_data *fmt; ! dtp->u.p.fmt = fmt = get_mem (sizeof (format_data)); ! fmt->format_string = dtp->format; ! fmt->format_string_len = dtp->format_len; ! ! fmt->string = NULL; ! fmt->saved_token = FMT_NONE; ! fmt->error = NULL; ! fmt->value = 0; /* Initialize variables used during traversal of the tree */ ! fmt->reversion_ok = 0; ! fmt->saved_format = NULL; /* Allocate the first format node as the root of the tree */ ! fmt->last = &fmt->array; ! fmt->last->next = NULL; ! fmt->avail = &fmt->array.array[0]; ! memset (fmt->avail, 0, sizeof (*fmt->avail)); ! fmt->avail->format = FMT_LPAREN; ! fmt->avail->repeat = 1; ! fmt->avail++; ! if (format_lex (fmt) == FMT_LPAREN) ! fmt->array.array[0].u.child = parse_format_list (dtp); else ! fmt->error = "Missing initial left parenthesis in format"; ! if (fmt->error) ! format_error (dtp, NULL, fmt->error); } *************** parse_format (void) *** 981,1002 **** * level. */ static void ! revert (void) { fnode *f, *r; ! g.reversion_flag = 1; r = NULL; ! for (f = array[0].u.child; f; f = f->next) if (f->format == FMT_LPAREN) r = f; /* If r is NULL because no node was found, the whole tree will be used */ ! array[0].current = r; ! array[0].count = 0; } --- 984,1006 ---- * level. */ static void ! revert (st_parameter_dt *dtp) { fnode *f, *r; + format_data *fmt = dtp->u.p.fmt; ! dtp->u.p.reversion_flag = 1; r = NULL; ! for (f = fmt->array.array[0].u.child; f; f = f->next) if (f->format == FMT_LPAREN) r = f; /* If r is NULL because no node was found, the whole tree will be used */ ! fmt->array.array[0].current = r; ! fmt->array.array[0].count = 0; } *************** revert (void) *** 1005,1014 **** * Parenthesis nodes are incremented after the list has been * exhausted, other nodes are incremented before they are returned. */ ! static fnode * next_format0 (fnode * f) { ! fnode *r; if (f == NULL) return NULL; --- 1009,1018 ---- * Parenthesis nodes are incremented after the list has been * exhausted, other nodes are incremented before they are returned. */ ! static const fnode * next_format0 (fnode * f) { ! const fnode *r; if (f == NULL) return NULL; *************** next_format0 (fnode * f) *** 1050,1090 **** * are no more data descriptors to return (which is an error * condition). */ ! fnode * ! next_format (void) { format_token t; ! fnode *f; ! if (saved_format != NULL) { /* Deal with a pushed-back format node */ ! f = saved_format; ! saved_format = NULL; goto done; } ! f = next_format0 (&array[0]); if (f == NULL) { ! if (!reversion_ok) ! { ! return NULL; ! } ! reversion_ok = 0; ! revert (); ! f = next_format0 (&array[0]); if (f == NULL) { ! format_error (NULL, reversion_error); return NULL; } /* Push the first reverted token and return a colon node in case * there are no more data items. */ ! saved_format = f; return &colon_node; } --- 1054,1093 ---- * are no more data descriptors to return (which is an error * condition). */ ! const fnode * ! next_format (st_parameter_dt *dtp) { format_token t; ! const fnode *f; ! format_data *fmt = dtp->u.p.fmt; ! if (fmt->saved_format != NULL) { /* Deal with a pushed-back format node */ ! f = fmt->saved_format; ! fmt->saved_format = NULL; goto done; } ! f = next_format0 (&fmt->array.array[0]); if (f == NULL) { ! if (!fmt->reversion_ok) ! return NULL; ! fmt->reversion_ok = 0; ! revert (dtp); ! f = next_format0 (&fmt->array.array[0]); if (f == NULL) { ! format_error (dtp, NULL, reversion_error); return NULL; } /* Push the first reverted token and return a colon node in case * there are no more data items. */ ! fmt->saved_format = f; return &colon_node; } *************** next_format (void) *** 1092,1102 **** done: t = f->format; ! if (!reversion_ok && (t == FMT_I || t == FMT_B || t == FMT_O || t == FMT_Z || t == FMT_F || t == FMT_E || t == FMT_EN || t == FMT_ES || t == FMT_G || t == FMT_L || t == FMT_A || t == FMT_D)) ! reversion_ok = 1; return f; } --- 1095,1105 ---- done: t = f->format; ! if (!fmt->reversion_ok && (t == FMT_I || t == FMT_B || t == FMT_O || t == FMT_Z || t == FMT_F || t == FMT_E || t == FMT_EN || t == FMT_ES || t == FMT_G || t == FMT_L || t == FMT_A || t == FMT_D)) ! fmt->reversion_ok = 1; return f; } *************** next_format (void) *** 1109,1291 **** * which calls the library back with the data item (or not). */ void ! unget_format (fnode * f) ! { ! saved_format = f; ! } ! ! ! ! ! #if 0 ! ! static void dump_format1 (fnode * f); ! ! /* dump_format0()-- Dump a single format node */ ! ! void ! dump_format0 (fnode * f) ! { ! char *p; ! int i; ! ! switch (f->format) ! { ! case FMT_COLON: ! st_printf (" :"); ! break; ! case FMT_SLASH: ! st_printf (" %d/", f->u.r); ! break; ! case FMT_DOLLAR: ! st_printf (" $"); ! break; ! case FMT_T: ! st_printf (" T%d", f->u.n); ! break; ! case FMT_TR: ! st_printf (" TR%d", f->u.n); ! break; ! case FMT_TL: ! st_printf (" TL%d", f->u.n); ! break; ! case FMT_X: ! st_printf (" %dX", f->u.n); ! break; ! case FMT_S: ! st_printf (" S"); ! break; ! case FMT_SS: ! st_printf (" SS"); ! break; ! case FMT_SP: ! st_printf (" SP"); ! break; ! ! case FMT_LPAREN: ! if (f->repeat == 1) ! st_printf (" ("); ! else ! st_printf (" %d(", f->repeat); ! ! dump_format1 (f->u.child); ! st_printf (" )"); ! break; ! ! case FMT_STRING: ! st_printf (" '"); ! p = f->u.string.p; ! for (i = f->u.string.length; i > 0; i--) ! st_printf ("%c", *p++); ! ! st_printf ("'"); ! break; ! ! case FMT_P: ! st_printf (" %dP", f->u.k); ! break; ! case FMT_I: ! st_printf (" %dI%d.%d", f->repeat, f->u.integer.w, f->u.integer.m); ! break; ! ! case FMT_B: ! st_printf (" %dB%d.%d", f->repeat, f->u.integer.w, f->u.integer.m); ! break; ! ! case FMT_O: ! st_printf (" %dO%d.%d", f->repeat, f->u.integer.w, f->u.integer.m); ! break; ! ! case FMT_Z: ! st_printf (" %dZ%d.%d", f->repeat, f->u.integer.w, f->u.integer.m); ! break; ! ! case FMT_BN: ! st_printf (" BN"); ! break; ! case FMT_BZ: ! st_printf (" BZ"); ! break; ! case FMT_D: ! st_printf (" %dD%d.%d", f->repeat, f->u.real.w, f->u.real.d); ! break; ! ! case FMT_EN: ! st_printf (" %dEN%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d, ! f->u.real.e); ! break; ! ! case FMT_ES: ! st_printf (" %dES%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d, ! f->u.real.e); ! break; ! ! case FMT_F: ! st_printf (" %dF%d.%d", f->repeat, f->u.real.w, f->u.real.d); ! break; ! ! case FMT_E: ! st_printf (" %dE%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d, ! f->u.real.e); ! break; ! ! case FMT_G: ! st_printf (" %dG%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d, ! f->u.real.e); ! break; ! ! case FMT_L: ! st_printf (" %dL%d", f->repeat, f->u.w); ! break; ! case FMT_A: ! st_printf (" %dA%d", f->repeat, f->u.w); ! break; ! ! default: ! st_printf (" ???"); ! break; ! } ! } ! ! ! /* dump_format1()-- Dump a string of format nodes */ ! ! static void ! dump_format1 (fnode * f) ! { ! for (; f; f = f->next) ! dump_format1 (f); ! } ! ! /* dump_format()-- Dump the whole format node tree */ ! ! void ! dump_format (void) ! { ! st_printf ("format = "); ! dump_format0 (&array[0]); ! st_printf ("\n"); ! } ! ! ! void ! next_test (void) { ! fnode *f; ! int i; ! ! for (i = 0; i < 20; i++) ! { ! f = next_format (); ! if (f == NULL) ! { ! st_printf ("No format!\n"); ! break; ! } ! ! dump_format1 (f); ! st_printf ("\n"); ! } } - #endif --- 1112,1119 ---- * which calls the library back with the data item (or not). */ void ! unget_format (st_parameter_dt *dtp, const fnode *f) { ! dtp->u.p.fmt->saved_format = f; } diff -Nrcpad gcc-4.0.2/libgfortran/io/inquire.c gcc-4.1.0/libgfortran/io/inquire.c *** gcc-4.0.2/libgfortran/io/inquire.c Wed Apr 27 18:15:39 2005 --- gcc-4.1.0/libgfortran/io/inquire.c Tue Dec 13 21:11:23 2005 *************** *** 1,4 **** ! /* Copyright (C) 2002-2003 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! /* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* Implement the non-IOLENGTH variant of the INQUIRY statement */ --- 24,31 ---- 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. */ /* Implement the non-IOLENGTH variant of the INQUIRY statement */ *************** Boston, MA 02111-1307, USA. */ *** 35,71 **** #include "io.h" ! static char undefined[] = "UNDEFINED"; /* inquire_via_unit()-- Inquiry via unit number. The unit might not exist. */ static void ! inquire_via_unit (gfc_unit * u) { const char *p; ! if (ioparm.exist != NULL) ! { ! if (ioparm.unit >= 0) ! *ioparm.exist = 1; ! else ! *ioparm.exist = 0; ! } ! if (ioparm.opened != NULL) ! *ioparm.opened = (u != NULL); ! if (ioparm.number != NULL) ! *ioparm.number = (u != NULL) ? u->unit_number : -1; ! if (ioparm.named != NULL) ! *ioparm.named = (u != NULL && u->flags.status != STATUS_SCRATCH); ! if (ioparm.name != NULL && u != NULL && u->flags.status != STATUS_SCRATCH) ! fstrcpy (ioparm.name, ioparm.name_len, u->file, u->file_len); ! if (ioparm.access != NULL) { if (u == NULL) p = undefined; --- 35,68 ---- #include "io.h" ! static const char undefined[] = "UNDEFINED"; /* inquire_via_unit()-- Inquiry via unit number. The unit might not exist. */ static void ! inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) { const char *p; + GFC_INTEGER_4 cf = iqp->common.flags; ! if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) ! *iqp->exist = iqp->common.unit >= 0; ! if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) ! *iqp->opened = (u != NULL); ! if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) ! *iqp->number = (u != NULL) ? u->unit_number : -1; ! if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) ! *iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH); ! if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0 ! && u != NULL && u->flags.status != STATUS_SCRATCH) ! fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len); ! if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) { if (u == NULL) p = undefined; *************** inquire_via_unit (gfc_unit * u) *** 79,91 **** p = "DIRECT"; break; default: ! internal_error ("inquire_via_unit(): Bad access"); } ! cf_strcpy (ioparm.access, ioparm.access_len, p); } ! if (ioparm.sequential != NULL) { if (u == NULL) p = inquire_sequential (NULL, 0); --- 76,88 ---- p = "DIRECT"; break; default: ! internal_error (&iqp->common, "inquire_via_unit(): Bad access"); } ! cf_strcpy (iqp->access, iqp->access_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) { if (u == NULL) p = inquire_sequential (NULL, 0); *************** inquire_via_unit (gfc_unit * u) *** 98,115 **** p = inquire_sequential (u->file, u->file_len); } ! cf_strcpy (ioparm.sequential, ioparm.sequential_len, p); } ! if (ioparm.direct != NULL) { p = (u == NULL) ? inquire_direct (NULL, 0) : inquire_direct (u->file, u->file_len); ! cf_strcpy (ioparm.direct, ioparm.direct_len, p); } ! if (ioparm.form != NULL) { if (u == NULL) p = undefined; --- 95,112 ---- p = inquire_sequential (u->file, u->file_len); } ! cf_strcpy (iqp->sequential, iqp->sequential_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) { p = (u == NULL) ? inquire_direct (NULL, 0) : inquire_direct (u->file, u->file_len); ! cf_strcpy (iqp->direct, iqp->direct_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) { if (u == NULL) p = undefined; *************** inquire_via_unit (gfc_unit * u) *** 123,157 **** p = "UNFORMATTED"; break; default: ! internal_error ("inquire_via_unit(): Bad form"); } ! cf_strcpy (ioparm.form, ioparm.form_len, p); } ! if (ioparm.formatted != NULL) { p = (u == NULL) ? inquire_formatted (NULL, 0) : inquire_formatted (u->file, u->file_len); ! cf_strcpy (ioparm.formatted, ioparm.formatted_len, p); } ! if (ioparm.unformatted != NULL) { p = (u == NULL) ? inquire_unformatted (NULL, 0) : inquire_unformatted (u->file, u->file_len); ! cf_strcpy (ioparm.unformatted, ioparm.unformatted_len, p); } ! if (ioparm.recl_out != NULL) ! *ioparm.recl_out = (u != NULL) ? u->recl : 0; ! if (ioparm.nextrec != NULL) ! *ioparm.nextrec = (u != NULL) ? u->last_record + 1 : 0; ! if (ioparm.blank != NULL) { if (u == NULL) p = undefined; --- 120,154 ---- p = "UNFORMATTED"; break; default: ! internal_error (&iqp->common, "inquire_via_unit(): Bad form"); } ! cf_strcpy (iqp->form, iqp->form_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) { p = (u == NULL) ? inquire_formatted (NULL, 0) : inquire_formatted (u->file, u->file_len); ! cf_strcpy (iqp->formatted, iqp->formatted_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) { p = (u == NULL) ? inquire_unformatted (NULL, 0) : inquire_unformatted (u->file, u->file_len); ! cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) ! *iqp->recl_out = (u != NULL) ? u->recl : 0; ! if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) ! *iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0; ! if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) { if (u == NULL) p = undefined; *************** inquire_via_unit (gfc_unit * u) *** 159,177 **** switch (u->flags.blank) { case BLANK_NULL: ! p = "NULL"; break; case BLANK_ZERO: p = "ZERO"; break; default: ! internal_error ("inquire_via_unit(): Bad blank"); } ! cf_strcpy (ioparm.blank, ioparm.blank_len, p); } ! if (ioparm.position != NULL) { if (u == NULL || u->flags.access == ACCESS_DIRECT) p = undefined; --- 156,174 ---- switch (u->flags.blank) { case BLANK_NULL: ! p = "NULL"; break; case BLANK_ZERO: p = "ZERO"; break; default: ! internal_error (&iqp->common, "inquire_via_unit(): Bad blank"); } ! cf_strcpy (iqp->blank, iqp->blank_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) { if (u == NULL || u->flags.access == ACCESS_DIRECT) p = undefined; *************** inquire_via_unit (gfc_unit * u) *** 194,203 **** p = "ASIS"; break; } ! cf_strcpy (ioparm.position, ioparm.position_len, p); } ! if (ioparm.action != NULL) { if (u == NULL) p = undefined; --- 191,200 ---- p = "ASIS"; break; } ! cf_strcpy (iqp->position, iqp->position_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0) { if (u == NULL) p = undefined; *************** inquire_via_unit (gfc_unit * u) *** 214,250 **** p = "READWRITE"; break; default: ! internal_error ("inquire_via_unit(): Bad action"); } ! cf_strcpy (ioparm.action, ioparm.action_len, p); } ! if (ioparm.read != NULL) { p = (u == NULL) ? inquire_read (NULL, 0) : inquire_read (u->file, u->file_len); ! cf_strcpy (ioparm.read, ioparm.read_len, p); } ! if (ioparm.write != NULL) { p = (u == NULL) ? inquire_write (NULL, 0) : inquire_write (u->file, u->file_len); ! cf_strcpy (ioparm.write, ioparm.write_len, p); } ! if (ioparm.readwrite != NULL) { p = (u == NULL) ? inquire_readwrite (NULL, 0) : inquire_readwrite (u->file, u->file_len); ! cf_strcpy (ioparm.readwrite, ioparm.readwrite_len, p); } ! if (ioparm.delim != NULL) { if (u == NULL || u->flags.form != FORM_FORMATTED) p = undefined; --- 211,247 ---- p = "READWRITE"; break; default: ! internal_error (&iqp->common, "inquire_via_unit(): Bad action"); } ! cf_strcpy (iqp->action, iqp->action_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) { p = (u == NULL) ? inquire_read (NULL, 0) : inquire_read (u->file, u->file_len); ! cf_strcpy (iqp->read, iqp->read_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) { p = (u == NULL) ? inquire_write (NULL, 0) : inquire_write (u->file, u->file_len); ! cf_strcpy (iqp->write, iqp->write_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) { p = (u == NULL) ? inquire_readwrite (NULL, 0) : inquire_readwrite (u->file, u->file_len); ! cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0) { if (u == NULL || u->flags.form != FORM_FORMATTED) p = undefined; *************** inquire_via_unit (gfc_unit * u) *** 261,273 **** p = "APOSTROPHE"; break; default: ! internal_error ("inquire_via_unit(): Bad delim"); } ! cf_strcpy (ioparm.delim, ioparm.delim_len, p); } ! if (ioparm.pad != NULL) { if (u == NULL || u->flags.form != FORM_FORMATTED) p = undefined; --- 258,270 ---- p = "APOSTROPHE"; break; default: ! internal_error (&iqp->common, "inquire_via_unit(): Bad delim"); } ! cf_strcpy (iqp->delim, iqp->delim_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) { if (u == NULL || u->flags.form != FORM_FORMATTED) p = undefined; *************** inquire_via_unit (gfc_unit * u) *** 281,290 **** p = "YES"; break; default: ! internal_error ("inquire_via_unit(): Bad pad"); } ! cf_strcpy (ioparm.pad, ioparm.pad_len, p); } } --- 278,310 ---- p = "YES"; break; default: ! internal_error (&iqp->common, "inquire_via_unit(): Bad pad"); } ! cf_strcpy (iqp->pad, iqp->pad_len, p); ! } ! ! if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0) ! { ! if (u == NULL) ! p = undefined; ! else ! switch (u->flags.convert) ! { ! /* l8_to_l4_offset is 0 for little-endian, 1 for big-endian. */ ! case CONVERT_NATIVE: ! p = l8_to_l4_offset ? "BIG_ENDIAN" : "LITTLE_ENDIAN"; ! break; ! ! case CONVERT_SWAP: ! p = l8_to_l4_offset ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; ! break; ! ! default: ! internal_error (&iqp->common, "inquire_via_unit(): Bad convert"); ! } ! ! cf_strcpy (iqp->convert, iqp->convert_len, p); } } *************** inquire_via_unit (gfc_unit * u) *** 293,412 **** * only used if the filename is *not* connected to a unit number. */ static void ! inquire_via_filename (void) { const char *p; ! if (ioparm.exist != NULL) ! *ioparm.exist = file_exists (); ! if (ioparm.opened != NULL) ! *ioparm.opened = 0; ! if (ioparm.number != NULL) ! *ioparm.number = -1; ! if (ioparm.named != NULL) ! *ioparm.named = 1; ! if (ioparm.name != NULL) ! fstrcpy (ioparm.name, ioparm.name_len, ioparm.file, ioparm.file_len); ! if (ioparm.access != NULL) ! cf_strcpy (ioparm.access, ioparm.access_len, undefined); ! if (ioparm.sequential != NULL) { ! p = inquire_sequential (ioparm.file, ioparm.file_len); ! cf_strcpy (ioparm.sequential, ioparm.sequential_len, p); } ! if (ioparm.direct != NULL) { ! p = inquire_direct (ioparm.file, ioparm.file_len); ! cf_strcpy (ioparm.direct, ioparm.direct_len, p); } ! if (ioparm.form != NULL) ! cf_strcpy (ioparm.form, ioparm.form_len, undefined); ! if (ioparm.formatted != NULL) { ! p = inquire_formatted (ioparm.file, ioparm.file_len); ! cf_strcpy (ioparm.formatted, ioparm.formatted_len, p); } ! if (ioparm.unformatted != NULL) { ! p = inquire_unformatted (ioparm.file, ioparm.file_len); ! cf_strcpy (ioparm.unformatted, ioparm.unformatted_len, p); } ! if (ioparm.recl_out != NULL) ! *ioparm.recl_out = 0; ! if (ioparm.nextrec != NULL) ! *ioparm.nextrec = 0; ! if (ioparm.blank != NULL) ! cf_strcpy (ioparm.blank, ioparm.blank_len, undefined); ! if (ioparm.position != NULL) ! cf_strcpy (ioparm.position, ioparm.position_len, undefined); ! if (ioparm.access != NULL) ! cf_strcpy (ioparm.access, ioparm.access_len, undefined); ! if (ioparm.read != NULL) { ! p = inquire_read (ioparm.file, ioparm.file_len); ! cf_strcpy (ioparm.read, ioparm.read_len, p); } ! if (ioparm.write != NULL) { ! p = inquire_write (ioparm.file, ioparm.file_len); ! cf_strcpy (ioparm.write, ioparm.write_len, p); } ! if (ioparm.readwrite != NULL) { ! p = inquire_read (ioparm.file, ioparm.file_len); ! cf_strcpy (ioparm.readwrite, ioparm.readwrite_len, p); } ! if (ioparm.delim != NULL) ! cf_strcpy (ioparm.delim, ioparm.delim_len, undefined); ! ! if (ioparm.pad != NULL) ! cf_strcpy (ioparm.pad, ioparm.pad_len, undefined); } /* Library entry point for the INQUIRE statement (non-IOLENGTH form). */ ! extern void st_inquire (void); export_proto(st_inquire); void ! st_inquire (void) { gfc_unit *u; ! library_start (); ! if (ioparm.file == NULL) ! inquire_via_unit (find_unit (ioparm.unit)); else { ! u = find_file (); if (u == NULL) ! inquire_via_filename (); else ! inquire_via_unit (u); } library_end (); } --- 313,437 ---- * only used if the filename is *not* connected to a unit number. */ static void ! inquire_via_filename (st_parameter_inquire *iqp) { const char *p; + GFC_INTEGER_4 cf = iqp->common.flags; ! if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) ! *iqp->exist = file_exists (iqp->file, iqp->file_len); ! if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) ! *iqp->opened = 0; ! if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) ! *iqp->number = -1; ! if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) ! *iqp->named = 1; ! if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0) ! fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len); ! if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) ! cf_strcpy (iqp->access, iqp->access_len, undefined); ! if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) { ! p = inquire_sequential (iqp->file, iqp->file_len); ! cf_strcpy (iqp->sequential, iqp->sequential_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) { ! p = inquire_direct (iqp->file, iqp->file_len); ! cf_strcpy (iqp->direct, iqp->direct_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) ! cf_strcpy (iqp->form, iqp->form_len, undefined); ! if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) { ! p = inquire_formatted (iqp->file, iqp->file_len); ! cf_strcpy (iqp->formatted, iqp->formatted_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) { ! p = inquire_unformatted (iqp->file, iqp->file_len); ! cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) ! *iqp->recl_out = 0; ! if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) ! *iqp->nextrec = 0; ! if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) ! cf_strcpy (iqp->blank, iqp->blank_len, undefined); ! if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) ! cf_strcpy (iqp->position, iqp->position_len, undefined); ! if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) ! cf_strcpy (iqp->access, iqp->access_len, undefined); ! if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) { ! p = inquire_read (iqp->file, iqp->file_len); ! cf_strcpy (iqp->read, iqp->read_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) { ! p = inquire_write (iqp->file, iqp->file_len); ! cf_strcpy (iqp->write, iqp->write_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) { ! p = inquire_read (iqp->file, iqp->file_len); ! cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); } ! if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0) ! cf_strcpy (iqp->delim, iqp->delim_len, undefined); + if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) + cf_strcpy (iqp->pad, iqp->pad_len, undefined); } /* Library entry point for the INQUIRE statement (non-IOLENGTH form). */ ! extern void st_inquire (st_parameter_inquire *); export_proto(st_inquire); void ! st_inquire (st_parameter_inquire *iqp) { gfc_unit *u; ! library_start (&iqp->common); ! if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0) ! { ! u = find_unit (iqp->common.unit); ! inquire_via_unit (iqp, u); ! } else { ! u = find_file (iqp->file, iqp->file_len); if (u == NULL) ! inquire_via_filename (iqp); else ! inquire_via_unit (iqp, u); } + if (u != NULL) + unlock_unit (u); library_end (); } diff -Nrcpad gcc-4.0.2/libgfortran/io/io.h gcc-4.1.0/libgfortran/io/io.h *** gcc-4.0.2/libgfortran/io/io.h Sun Sep 11 18:55:16 2005 --- gcc-4.1.0/libgfortran/io/io.h Tue Feb 14 20:21:15 2006 *************** GNU General Public License for more deta *** 15,22 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* As a special exception, if you link this library with other files, some of which are compiled with GCC, to produce an executable, --- 15,22 ---- 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. */ /* As a special exception, if you link this library with other files, some of which are compiled with GCC, to produce an executable, *************** Boston, MA 02111-1307, USA. */ *** 33,38 **** --- 33,40 ---- #include #include "libgfortran.h" + #include + #define DEFAULT_TEMPDIR "/tmp" /* Basic types used in data transfers. */ *************** typedef enum *** 48,53 **** --- 50,57 ---- { SUCCESS = 1, FAILURE } try; + struct st_parameter_dt; + typedef struct stream { char *(*alloc_w_at) (struct stream *, int *, gfc_offset); *************** typedef struct stream *** 56,61 **** --- 60,68 ---- try (*close) (struct stream *); try (*seek) (struct stream *, gfc_offset); try (*truncate) (struct stream *); + int (*read) (struct stream *, void *, size_t *); + int (*write) (struct stream *, const void *, size_t *); + try (*set) (struct stream *, int, size_t); } stream; *************** stream; *** 73,101 **** #define sseek(s, pos) ((s)->seek)(s, pos) #define struncate(s) ((s)->truncate)(s) ! /* Representation of a namelist object in libgfortran ! ! Namelist Records ! &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../ ! or ! &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END ! ! The object can be a fully qualified, compound name for an instrinsic ! type, derived types or derived type components. So, a substring ! a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist ! read. Hence full information about the structure of the object has ! to be available to list_read.c and write. ! ! These requirements are met by the following data structures. ! nml_loop_spec contains the variables for the loops over index ranges that are encountered. Since the variables can be negative, ssize_t is used. */ ! typedef struct nml_loop_spec { - /* Index counter for this dimension. */ ssize_t idx; --- 80,96 ---- #define sseek(s, pos) ((s)->seek)(s, pos) #define struncate(s) ((s)->truncate)(s) + #define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes) + #define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes) ! #define sset(s, c, n) ((s)->set)(s, c, n) ! /* The array_loop_spec contains the variables for the loops over index ranges that are encountered. Since the variables can be negative, ssize_t is used. */ ! typedef struct array_loop_spec { /* Index counter for this dimension. */ ssize_t idx; *************** typedef struct nml_loop_spec *** 108,117 **** /* Step for the index counter. */ ssize_t step; } ! nml_loop_spec; ! /* namelist_info type contains all the scalar information about the ! object and arrays of descriptor_dimension and nml_loop_spec types for arrays. */ typedef struct namelist_type --- 103,127 ---- /* Step for the index counter. */ ssize_t step; } ! array_loop_spec; ! /* Representation of a namelist object in libgfortran ! ! Namelist Records ! &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../ ! or ! &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END ! ! The object can be a fully qualified, compound name for an instrinsic ! type, derived types or derived type components. So, a substring ! a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist ! read. Hence full information about the structure of the object has ! to be available to list_read.c and write. ! ! These requirements are met by the following data structures. ! ! namelist_info type contains all the scalar information about the ! object and arrays of descriptor_dimension and array_loop_spec types for arrays. */ typedef struct namelist_type *************** typedef struct namelist_type *** 142,148 **** index_type string_length; descriptor_dimension * dim; ! nml_loop_spec * ls; struct namelist_type * next; } namelist_info; --- 152,158 ---- index_type string_length; descriptor_dimension * dim; ! array_loop_spec * ls; struct namelist_type * next; } namelist_info; *************** namelist_info; *** 150,156 **** /* Options for the OPEN statement. */ typedef enum ! { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_UNSPECIFIED } unit_access; --- 160,166 ---- /* Options for the OPEN statement. */ typedef enum ! { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_UNSPECIFIED } unit_access; *************** typedef enum *** 199,277 **** {READING, WRITING} unit_mode; ! /* Statement parameters. These are all the things that can appear in ! an I/O statement. Some are inputs and some are outputs, but none ! are both. All of these values are initially zeroed and are zeroed ! at the end of a library statement. The relevant values need to be ! set before entry to an I/O statement. This structure needs to be ! duplicated by the back end. */ ! typedef struct { GFC_INTEGER_4 unit; ! GFC_INTEGER_4 err, end, eor, list_format; /* These are flags, not values. */ ! ! /* Return values from library statements. These are returned only if ! the labels are specified in the statement itself and the condition ! occurs. In most cases, none of the labels are specified and the ! return value does not have to be checked. Must be consistent with ! the front end. */ ! enum ! { ! LIBRARY_OK = 0, ! LIBRARY_ERROR, ! LIBRARY_END, ! LIBRARY_EOR ! } ! library_return; ! GFC_INTEGER_4 *iostat, *exist, *opened, *number, *named; ! GFC_INTEGER_4 rec; ! GFC_INTEGER_4 *nextrec, *size; ! GFC_INTEGER_4 recl_in; ! GFC_INTEGER_4 *recl_out; ! GFC_INTEGER_4 *iolength; ! #define CHARACTER(name) \ ! char * name; \ ! gfc_charlen_type name ## _len ! CHARACTER (file); ! CHARACTER (status); ! CHARACTER (access); ! CHARACTER (form); ! CHARACTER (blank); ! CHARACTER (position); ! CHARACTER (action); ! CHARACTER (delim); ! CHARACTER (pad); ! CHARACTER (format); ! CHARACTER (advance); ! CHARACTER (name); ! CHARACTER (internal_unit); ! CHARACTER (sequential); ! CHARACTER (direct); ! CHARACTER (formatted); ! CHARACTER (unformatted); ! CHARACTER (read); ! CHARACTER (write); ! CHARACTER (readwrite); ! /* namelist related data */ ! CHARACTER (namelist_name); ! GFC_INTEGER_4 namelist_read_mode; ! #undef CHARACTER } ! st_parameter; ! extern st_parameter ioparm; ! iexport_data_proto(ioparm); ! extern namelist_info * ionml; ! internal_proto(ionml); typedef struct { --- 209,442 ---- {READING, WRITING} unit_mode; ! typedef enum ! { CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE } ! unit_convert; ! #define CHARACTER1(name) \ ! char * name; \ ! gfc_charlen_type name ## _len ! #define CHARACTER2(name) \ ! gfc_charlen_type name ## _len; \ ! char * name ! ! #define IOPARM_LIBRETURN_MASK (3 << 0) ! #define IOPARM_LIBRETURN_OK (0 << 0) ! #define IOPARM_LIBRETURN_ERROR (1 << 0) ! #define IOPARM_LIBRETURN_END (2 << 0) ! #define IOPARM_LIBRETURN_EOR (3 << 0) ! #define IOPARM_ERR (1 << 2) ! #define IOPARM_END (1 << 3) ! #define IOPARM_EOR (1 << 4) ! #define IOPARM_HAS_IOSTAT (1 << 5) ! #define IOPARM_HAS_IOMSG (1 << 6) ! ! #define IOPARM_COMMON_MASK ((1 << 7) - 1) ! ! typedef struct st_parameter_common { + GFC_INTEGER_4 flags; GFC_INTEGER_4 unit; ! const char *filename; ! GFC_INTEGER_4 line; ! CHARACTER2 (iomsg); ! GFC_INTEGER_4 *iostat; ! } ! st_parameter_common; ! #define IOPARM_OPEN_HAS_RECL_IN (1 << 7) ! #define IOPARM_OPEN_HAS_FILE (1 << 8) ! #define IOPARM_OPEN_HAS_STATUS (1 << 9) ! #define IOPARM_OPEN_HAS_ACCESS (1 << 10) ! #define IOPARM_OPEN_HAS_FORM (1 << 11) ! #define IOPARM_OPEN_HAS_BLANK (1 << 12) ! #define IOPARM_OPEN_HAS_POSITION (1 << 13) ! #define IOPARM_OPEN_HAS_ACTION (1 << 14) ! #define IOPARM_OPEN_HAS_DELIM (1 << 15) ! #define IOPARM_OPEN_HAS_PAD (1 << 16) ! #define IOPARM_OPEN_HAS_CONVERT (1 << 17) ! typedef struct ! { ! st_parameter_common common; ! GFC_INTEGER_4 recl_in; ! CHARACTER2 (file); ! CHARACTER1 (status); ! CHARACTER2 (access); ! CHARACTER1 (form); ! CHARACTER2 (blank); ! CHARACTER1 (position); ! CHARACTER2 (action); ! CHARACTER1 (delim); ! CHARACTER2 (pad); ! CHARACTER1 (convert); ! } ! st_parameter_open; ! #define IOPARM_CLOSE_HAS_STATUS (1 << 7) ! typedef struct ! { ! st_parameter_common common; ! CHARACTER1 (status); ! } ! st_parameter_close; ! typedef struct ! { ! st_parameter_common common; ! } ! st_parameter_filepos; ! #define IOPARM_INQUIRE_HAS_EXIST (1 << 7) ! #define IOPARM_INQUIRE_HAS_OPENED (1 << 8) ! #define IOPARM_INQUIRE_HAS_NUMBER (1 << 9) ! #define IOPARM_INQUIRE_HAS_NAMED (1 << 10) ! #define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11) ! #define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12) ! #define IOPARM_INQUIRE_HAS_FILE (1 << 13) ! #define IOPARM_INQUIRE_HAS_ACCESS (1 << 14) ! #define IOPARM_INQUIRE_HAS_FORM (1 << 15) ! #define IOPARM_INQUIRE_HAS_BLANK (1 << 16) ! #define IOPARM_INQUIRE_HAS_POSITION (1 << 17) ! #define IOPARM_INQUIRE_HAS_ACTION (1 << 18) ! #define IOPARM_INQUIRE_HAS_DELIM (1 << 19) ! #define IOPARM_INQUIRE_HAS_PAD (1 << 20) ! #define IOPARM_INQUIRE_HAS_NAME (1 << 21) ! #define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 22) ! #define IOPARM_INQUIRE_HAS_DIRECT (1 << 23) ! #define IOPARM_INQUIRE_HAS_FORMATTED (1 << 24) ! #define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 25) ! #define IOPARM_INQUIRE_HAS_READ (1 << 26) ! #define IOPARM_INQUIRE_HAS_WRITE (1 << 27) ! #define IOPARM_INQUIRE_HAS_READWRITE (1 << 28) ! #define IOPARM_INQUIRE_HAS_CONVERT (1 << 29) ! typedef struct ! { ! st_parameter_common common; ! GFC_INTEGER_4 *exist, *opened, *number, *named; ! GFC_INTEGER_4 *nextrec, *recl_out; ! CHARACTER1 (file); ! CHARACTER2 (access); ! CHARACTER1 (form); ! CHARACTER2 (blank); ! CHARACTER1 (position); ! CHARACTER2 (action); ! CHARACTER1 (delim); ! CHARACTER2 (pad); ! CHARACTER1 (name); ! CHARACTER2 (sequential); ! CHARACTER1 (direct); ! CHARACTER2 (formatted); ! CHARACTER1 (unformatted); ! CHARACTER2 (read); ! CHARACTER1 (write); ! CHARACTER2 (readwrite); ! CHARACTER1 (convert); } ! st_parameter_inquire; ! struct gfc_unit; ! struct format_data; ! #define IOPARM_DT_LIST_FORMAT (1 << 7) ! #define IOPARM_DT_NAMELIST_READ_MODE (1 << 8) ! #define IOPARM_DT_HAS_REC (1 << 9) ! #define IOPARM_DT_HAS_SIZE (1 << 10) ! #define IOPARM_DT_HAS_IOLENGTH (1 << 11) ! #define IOPARM_DT_HAS_FORMAT (1 << 12) ! #define IOPARM_DT_HAS_ADVANCE (1 << 13) ! #define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14) ! #define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15) ! /* Internal use bit. */ ! #define IOPARM_DT_IONML_SET (1 << 31) ! ! typedef struct st_parameter_dt ! { ! st_parameter_common common; ! GFC_INTEGER_4 rec; ! GFC_INTEGER_4 *size, *iolength; ! gfc_array_char *internal_unit_desc; ! CHARACTER1 (format); ! CHARACTER2 (advance); ! CHARACTER1 (internal_unit); ! CHARACTER2 (namelist_name); ! /* Private part of the structure. The compiler just needs ! to reserve enough space. */ ! union ! { ! struct ! { ! void (*transfer) (struct st_parameter_dt *, bt, void *, int, ! size_t, size_t); ! struct gfc_unit *current_unit; ! int item_count; /* Item number in a formatted data transfer. */ ! unit_mode mode; ! unit_blank blank_status; ! enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status; ! int scale_factor; ! int max_pos; /* Maximum righthand column written to. */ ! /* Number of skips + spaces to be done for T and X-editing. */ ! int skips; ! /* Number of spaces to be done for T and X-editing. */ ! int pending_spaces; ! /* Whether an EOR condition was encountered. Value is: ! 0 if no EOR was encountered ! 1 if an EOR was encountered due to a 1-byte marker (LF) ! 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ ! int sf_seen_eor; ! unit_advance advance_status; ! ! unsigned reversion_flag : 1; /* Format reversion has occurred. */ ! unsigned first_item : 1; ! unsigned seen_dollar : 1; ! unsigned eor_condition : 1; ! unsigned no_leading_blank : 1; ! unsigned char_flag : 1; ! unsigned input_complete : 1; ! unsigned at_eol : 1; ! unsigned comma_flag : 1; ! /* A namelist specific flag used in the list directed library ! to flag that calls are being made from namelist read (eg. to ! ignore comments or to treat '/' as a terminator) */ ! unsigned namelist_mode : 1; ! /* A namelist specific flag used in the list directed library ! to flag read errors and return, so that an attempt can be ! made to read a new object name. */ ! unsigned nml_read_error : 1; ! /* A sequential formatted read specific flag used to signal that a ! character string is being read so don't use commas to shorten a ! formatted field width. */ ! unsigned sf_read_comma : 1; ! /* 19 unused bits. */ ! ! char last_char; ! char nml_delim; ! ! int repeat_count; ! int saved_length; ! int saved_used; ! bt saved_type; ! char *saved_string; ! char *scratch; ! char *line_buffer; ! struct format_data *fmt; ! jmp_buf *eof_jump; ! namelist_info *ionml; ! ! /* Storage area for values except for strings. Must be large ! enough to hold a complex value (two reals) of the largest ! kind. */ ! char value[32]; ! } p; ! char pad[16 * sizeof (char *) + 34 * sizeof (int)]; ! } u; ! } ! st_parameter_dt; ! ! #undef CHARACTER1 ! #undef CHARACTER2 typedef struct { *************** typedef struct *** 284,289 **** --- 449,455 ---- unit_position position; unit_status status; unit_pad pad; + unit_convert convert; } unit_flags; *************** unit_flags; *** 298,307 **** typedef struct gfc_unit { int unit_number; - stream *s; ! ! struct gfc_unit *left, *right; /* Treap links. */ int priority; int read_bad, current_record; --- 464,473 ---- typedef struct gfc_unit { int unit_number; stream *s; ! ! /* Treap links. */ ! struct gfc_unit *left, *right; int priority; int read_bad, current_record; *************** typedef struct gfc_unit *** 309,357 **** { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } endfile; ! unit_mode mode; unit_flags flags; - gfc_offset recl, last_record, maxrec, bytes_left; /* recl -- Record length of the file. last_record -- Last record number read or written maxrec -- Maximum record number in a direct access file bytes_left -- Bytes left in current record. */ ! int file_len; ! char file[1]; /* Filename is allocated at the end of the structure. */ ! } ! gfc_unit; ! ! /* Global variables. Putting these in a structure makes it easier to ! maintain, particularly with the constraint of a prefix. */ ! ! typedef struct ! { ! int in_library; /* Nonzero if a library call is being processed. */ ! int size; /* Bytes processed by the current data-transfer statement. */ ! gfc_offset max_offset; /* Maximum file offset. */ ! int item_count; /* Item number in a formatted data transfer. */ ! int reversion_flag; /* Format reversion has occurred. */ ! int first_item; ! ! gfc_unit *unit_root; ! int seen_dollar; ! unit_mode mode; ! unit_blank blank_status; ! enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status; ! int scale_factor; ! jmp_buf eof_jump; } ! global_t; ! ! extern global_t g; ! internal_proto(g); ! ! extern gfc_unit *current_unit; ! internal_proto(current_unit); /* Format tokens. Only about half of these can be stored in the format nodes. */ --- 475,509 ---- { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } endfile; ! unit_mode mode; unit_flags flags; /* recl -- Record length of the file. last_record -- Last record number read or written maxrec -- Maximum record number in a direct access file bytes_left -- Bytes left in current record. */ + gfc_offset recl, last_record, maxrec, bytes_left; ! __gthread_mutex_t lock; ! /* Number of threads waiting to acquire this unit's lock. ! When non-zero, close_unit doesn't only removes the unit ! from the UNIT_ROOT tree, but doesn't free it and the ! last of the waiting threads will do that. ! This must be either atomically increased/decreased, or ! always guarded by UNIT_LOCK. */ ! int waiting; ! /* Flag set by close_unit if the unit as been closed. ! Must be manipulated under unit's lock. */ ! int closed; ! /* For traversing arrays */ ! array_loop_spec *ls; ! int rank; ! int file_len; ! char *file; } ! gfc_unit; /* Format tokens. Only about half of these can be stored in the format nodes. */ *************** internal_proto(move_pos_offset); *** 424,433 **** extern int compare_files (stream *, stream *); internal_proto(compare_files); ! extern stream *init_error_stream (void); ! internal_proto(init_error_stream); ! ! extern stream *open_external (unit_flags *); internal_proto(open_external); extern stream *open_internal (char *, int); --- 576,582 ---- extern int compare_files (stream *, stream *); internal_proto(compare_files); ! extern stream *open_external (st_parameter_open *, unit_flags *); internal_proto(open_external); extern stream *open_internal (char *, int); *************** internal_proto(output_stream); *** 442,453 **** extern stream *error_stream (void); internal_proto(error_stream); ! extern int compare_file_filename (stream *, const char *, int); internal_proto(compare_file_filename); ! extern gfc_unit *find_file (void); internal_proto(find_file); extern int stream_at_bof (stream *); internal_proto(stream_at_bof); --- 591,605 ---- extern stream *error_stream (void); internal_proto(error_stream); ! extern int compare_file_filename (gfc_unit *, const char *, int); internal_proto(compare_file_filename); ! extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len); internal_proto(find_file); + extern void flush_all_units (void); + internal_proto(flush_all_units); + extern int stream_at_bof (stream *); internal_proto(stream_at_bof); *************** internal_proto(stream_at_eof); *** 457,463 **** extern int delete_file (gfc_unit *); internal_proto(delete_file); ! extern int file_exists (void); internal_proto(file_exists); extern const char *inquire_sequential (const char *, int); --- 609,615 ---- extern int delete_file (gfc_unit *); internal_proto(delete_file); ! extern int file_exists (const char *file, gfc_charlen_type file_len); internal_proto(file_exists); extern const char *inquire_sequential (const char *, int); *************** internal_proto(is_seekable); *** 493,498 **** --- 645,653 ---- extern int is_preconnected (stream *); internal_proto(is_preconnected); + extern void flush_if_preconnected (stream *); + internal_proto(flush_if_preconnected); + extern void empty_internal_buffer(stream *); internal_proto(empty_internal_buffer); *************** internal_proto(stream_isatty); *** 505,510 **** --- 660,668 ---- extern char * stream_ttyname (stream *); internal_proto(stream_ttyname); + extern gfc_offset stream_offset (stream *s); + internal_proto(stream_offset); + extern int unit_to_fd (int); internal_proto(unit_to_fd); *************** internal_proto(unpack_filename); *** 513,662 **** /* unit.c */ ! extern void insert_unit (gfc_unit *); ! internal_proto(insert_unit); extern int close_unit (gfc_unit *); internal_proto(close_unit); ! extern int is_internal_unit (void); internal_proto(is_internal_unit); extern gfc_unit *find_unit (int); internal_proto(find_unit); ! extern gfc_unit *get_unit (int); internal_proto(get_unit); /* open.c */ extern void test_endfile (gfc_unit *); internal_proto(test_endfile); ! extern void new_unit (unit_flags *); internal_proto(new_unit); /* format.c */ ! extern void parse_format (void); internal_proto(parse_format); ! extern fnode *next_format (void); internal_proto(next_format); ! extern void unget_format (fnode *); internal_proto(unget_format); ! extern void format_error (fnode *, const char *); internal_proto(format_error); ! extern void free_fnodes (void); ! internal_proto(free_fnodes); /* transfer.c */ #define SCRATCH_SIZE 300 - extern char scratch[]; - internal_proto(scratch); - extern const char *type_name (bt); internal_proto(type_name); ! extern void *read_block (int *); internal_proto(read_block); ! extern void *write_block (int); internal_proto(write_block); ! extern void next_record (int); internal_proto(next_record); /* read.c */ ! extern void set_integer (void *, int64_t, int); internal_proto(set_integer); ! extern uint64_t max_value (int, int); internal_proto(max_value); ! extern int convert_real (void *, const char *, int); internal_proto(convert_real); ! extern void read_a (fnode *, char *, int); internal_proto(read_a); ! extern void read_f (fnode *, char *, int); internal_proto(read_f); ! extern void read_l (fnode *, char *, int); internal_proto(read_l); ! extern void read_x (int); internal_proto(read_x); ! extern void read_radix (fnode *, char *, int, int); internal_proto(read_radix); ! extern void read_decimal (fnode *, char *, int); internal_proto(read_decimal); /* list_read.c */ ! extern void list_formatted_read (bt, void *, int); internal_proto(list_formatted_read); ! extern void finish_list_read (void); internal_proto(finish_list_read); ! extern void init_at_eol(); ! internal_proto(init_at_eol); ! ! extern void namelist_read(); internal_proto(namelist_read); ! extern void namelist_write(); internal_proto(namelist_write); /* write.c */ ! extern void write_a (fnode *, const char *, int); internal_proto(write_a); ! extern void write_b (fnode *, const char *, int); internal_proto(write_b); ! extern void write_d (fnode *, const char *, int); internal_proto(write_d); ! extern void write_e (fnode *, const char *, int); internal_proto(write_e); ! extern void write_en (fnode *, const char *, int); internal_proto(write_en); ! extern void write_es (fnode *, const char *, int); internal_proto(write_es); ! extern void write_f (fnode *, const char *, int); internal_proto(write_f); ! extern void write_i (fnode *, const char *, int); internal_proto(write_i); ! extern void write_l (fnode *, char *, int); internal_proto(write_l); ! extern void write_o (fnode *, const char *, int); internal_proto(write_o); ! extern void write_x (int, int); internal_proto(write_x); ! extern void write_z (fnode *, const char *, int); internal_proto(write_z); ! extern void list_formatted_write (bt, void *, int); internal_proto(list_formatted_write); #endif --- 671,894 ---- /* unit.c */ ! /* Maximum file offset, computed at library initialization time. */ ! extern gfc_offset max_offset; ! internal_proto(max_offset); ! ! /* Unit tree root. */ ! extern gfc_unit *unit_root; ! internal_proto(unit_root); ! ! extern __gthread_mutex_t unit_lock; ! internal_proto(unit_lock); extern int close_unit (gfc_unit *); internal_proto(close_unit); ! extern int is_internal_unit (st_parameter_dt *); internal_proto(is_internal_unit); + extern int is_array_io (st_parameter_dt *); + internal_proto(is_array_io); + extern gfc_unit *find_unit (int); internal_proto(find_unit); ! extern gfc_unit *find_or_create_unit (int); ! internal_proto(find_unit); ! ! extern gfc_unit *get_unit (st_parameter_dt *, int); internal_proto(get_unit); + extern void unlock_unit (gfc_unit *); + internal_proto(unlock_unit); + /* open.c */ extern void test_endfile (gfc_unit *); internal_proto(test_endfile); ! extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *); internal_proto(new_unit); /* format.c */ ! extern void parse_format (st_parameter_dt *); internal_proto(parse_format); ! extern const fnode *next_format (st_parameter_dt *); internal_proto(next_format); ! extern void unget_format (st_parameter_dt *, const fnode *); internal_proto(unget_format); ! extern void format_error (st_parameter_dt *, const fnode *, const char *); internal_proto(format_error); ! extern void free_format_data (st_parameter_dt *); ! internal_proto(free_format_data); /* transfer.c */ #define SCRATCH_SIZE 300 extern const char *type_name (bt); internal_proto(type_name); ! extern void *read_block (st_parameter_dt *, int *); internal_proto(read_block); ! extern void *write_block (st_parameter_dt *, int); internal_proto(write_block); ! extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *); ! internal_proto(next_array_record); ! ! extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *); ! internal_proto(init_loop_spec); ! ! extern void next_record (st_parameter_dt *, int); internal_proto(next_record); + extern void reverse_memcpy (void *, const void *, size_t); + internal_proto (reverse_memcpy); + /* read.c */ ! extern void set_integer (void *, GFC_INTEGER_LARGEST, int); internal_proto(set_integer); ! extern GFC_UINTEGER_LARGEST max_value (int, int); internal_proto(max_value); ! extern int convert_real (st_parameter_dt *, void *, const char *, int); internal_proto(convert_real); ! extern void read_a (st_parameter_dt *, const fnode *, char *, int); internal_proto(read_a); ! extern void read_f (st_parameter_dt *, const fnode *, char *, int); internal_proto(read_f); ! extern void read_l (st_parameter_dt *, const fnode *, char *, int); internal_proto(read_l); ! extern void read_x (st_parameter_dt *, int); internal_proto(read_x); ! extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int); internal_proto(read_radix); ! extern void read_decimal (st_parameter_dt *, const fnode *, char *, int); internal_proto(read_decimal); /* list_read.c */ ! extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t, ! size_t); internal_proto(list_formatted_read); ! extern void finish_list_read (st_parameter_dt *); internal_proto(finish_list_read); ! extern void namelist_read (st_parameter_dt *); internal_proto(namelist_read); ! extern void namelist_write (st_parameter_dt *); internal_proto(namelist_write); /* write.c */ ! extern void write_a (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_a); ! extern void write_b (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_b); ! extern void write_d (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_d); ! extern void write_e (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_e); ! extern void write_en (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_en); ! extern void write_es (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_es); ! extern void write_f (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_f); ! extern void write_i (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_i); ! extern void write_l (st_parameter_dt *, const fnode *, char *, int); internal_proto(write_l); ! extern void write_o (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_o); ! extern void write_x (st_parameter_dt *, int, int); internal_proto(write_x); ! extern void write_z (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_z); ! extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, ! size_t); internal_proto(list_formatted_write); + /* error.c */ + extern try notify_std (int, const char *); + internal_proto(notify_std); + + /* size_from_kind.c */ + extern size_t size_from_real_kind (int); + internal_proto(size_from_real_kind); + + extern size_t size_from_complex_kind (int); + internal_proto(size_from_complex_kind); + + /* lock.c */ + extern void free_ionml (st_parameter_dt *); + internal_proto(free_ionml); + + static inline void + inc_waiting_locked (gfc_unit *u) + { + #ifdef HAVE_SYNC_FETCH_AND_ADD + (void) __sync_fetch_and_add (&u->waiting, 1); + #else + u->waiting++; + #endif + } + + static inline int + predec_waiting_locked (gfc_unit *u) + { + #ifdef HAVE_SYNC_FETCH_AND_ADD + return __sync_add_and_fetch (&u->waiting, -1); + #else + return --u->waiting; + #endif + } + + static inline void + dec_waiting_unlocked (gfc_unit *u) + { + #ifdef HAVE_SYNC_FETCH_AND_ADD + (void) __sync_fetch_and_add (&u->waiting, -1); + #else + __gthread_mutex_lock (&unit_lock); + u->waiting--; + __gthread_mutex_unlock (&unit_lock); + #endif + } + #endif + + /* ../runtime/environ.c This is here because we return unit_convert. */ + + unit_convert get_unformatted_convert (int); + internal_proto(get_unformatted_convert); diff -Nrcpad gcc-4.0.2/libgfortran/io/list_read.c gcc-4.1.0/libgfortran/io/list_read.c *** gcc-4.0.2/libgfortran/io/list_read.c Mon Sep 5 21:14:36 2005 --- gcc-4.1.0/libgfortran/io/list_read.c Sun Jan 1 05:04:06 2006 *************** GNU General Public License for more deta *** 25,32 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" --- 25,32 ---- 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. */ #include "config.h" *************** Boston, MA 02111-1307, USA. */ *** 48,77 **** the repeat count. Since we can have a lot of potential leading zeros, we have to be able to back up by arbitrary amount. Because the input might not be seekable, we have to buffer the data ! ourselves. Data is buffered in scratch[] until it becomes too ! large, after which we start allocating memory on the heap. */ ! ! static int repeat_count, saved_length, saved_used; ! static int input_complete, at_eol, comma_flag; ! static char last_char, *saved_string; ! static bt saved_type; ! ! /* A namelist specific flag used in the list directed library ! to flag that calls are being made from namelist read (eg. to ignore ! comments or to treat '/' as a terminator) */ ! ! static int namelist_mode; ! ! /* A namelist specific flag used in the list directed library to flag ! read errors and return, so that an attempt can be made to read a ! new object name. */ ! ! static int nml_read_error; ! ! /* Storage area for values except for strings. Must be large enough ! to hold a complex value (two reals) of the largest kind. */ ! ! static char value[32]; #define CASE_DIGITS case '0': case '1': case '2': case '3': case '4': \ case '5': case '6': case '7': case '8': case '9' --- 48,54 ---- the repeat count. Since we can have a lot of potential leading zeros, we have to be able to back up by arbitrary amount. Because the input might not be seekable, we have to buffer the data ! ourselves. */ #define CASE_DIGITS case '0': case '1': case '2': case '3': case '4': \ case '5': case '6': case '7': case '8': case '9' *************** static char value[32]; *** 92,180 **** /* Save a character to a string buffer, enlarging it as necessary. */ static void ! push_char (char c) { char *new; ! if (saved_string == NULL) { ! saved_string = scratch; ! memset (saved_string,0,SCRATCH_SIZE); ! saved_length = SCRATCH_SIZE; ! saved_used = 0; } ! if (saved_used >= saved_length) { ! saved_length = 2 * saved_length; ! new = get_mem (2 * saved_length); ! memset (new,0,2 * saved_length); ! memcpy (new, saved_string, saved_used); ! if (saved_string != scratch) ! free_mem (saved_string); ! saved_string = new; } ! saved_string[saved_used++] = c; } /* Free the input buffer if necessary. */ static void ! free_saved (void) { ! if (saved_string == NULL) return; ! if (saved_string != scratch) ! free_mem (saved_string); ! saved_string = NULL; } static char ! next_char (void) { int length; char c, *p; ! if (last_char != '\0') { ! at_eol = 0; ! c = last_char; ! last_char = '\0'; goto done; } length = 1; ! p = salloc_r (current_unit->s, &length); ! if (p == NULL) { ! generate_error (ERROR_OS, NULL); ! return '\0'; } ! if (length == 0) { ! /* For internal files return a newline instead of signalling EOF. */ ! /* ??? This isn't quite right, but we don't handle internal files ! with multiple records. */ ! if (is_internal_unit ()) ! c = '\n'; else ! longjmp (g.eof_jump, 1); } else ! c = *p; ! done: ! at_eol = (c == '\n' || c == '\r'); return c; } --- 69,199 ---- /* Save a character to a string buffer, enlarging it as necessary. */ static void ! push_char (st_parameter_dt *dtp, char c) { char *new; ! if (dtp->u.p.saved_string == NULL) { ! if (dtp->u.p.scratch == NULL) ! dtp->u.p.scratch = get_mem (SCRATCH_SIZE); ! dtp->u.p.saved_string = dtp->u.p.scratch; ! memset (dtp->u.p.saved_string, 0, SCRATCH_SIZE); ! dtp->u.p.saved_length = SCRATCH_SIZE; ! dtp->u.p.saved_used = 0; } ! if (dtp->u.p.saved_used >= dtp->u.p.saved_length) { ! dtp->u.p.saved_length = 2 * dtp->u.p.saved_length; ! new = get_mem (2 * dtp->u.p.saved_length); ! memset (new, 0, 2 * dtp->u.p.saved_length); ! memcpy (new, dtp->u.p.saved_string, dtp->u.p.saved_used); ! if (dtp->u.p.saved_string != dtp->u.p.scratch) ! free_mem (dtp->u.p.saved_string); ! dtp->u.p.saved_string = new; } ! dtp->u.p.saved_string[dtp->u.p.saved_used++] = c; } /* Free the input buffer if necessary. */ static void ! free_saved (st_parameter_dt *dtp) { ! if (dtp->u.p.saved_string == NULL) return; ! if (dtp->u.p.saved_string != dtp->u.p.scratch) ! free_mem (dtp->u.p.saved_string); ! dtp->u.p.saved_string = NULL; ! dtp->u.p.saved_used = 0; } static char ! next_char (st_parameter_dt *dtp) { int length; + gfc_offset record; char c, *p; ! if (dtp->u.p.last_char != '\0') { ! dtp->u.p.at_eol = 0; ! c = dtp->u.p.last_char; ! dtp->u.p.last_char = '\0'; goto done; } length = 1; ! /* Handle the end-of-record condition for internal array unit */ ! if (is_array_io(dtp) && dtp->u.p.current_unit->bytes_left == 0) { ! c = '\n'; ! record = next_array_record (dtp, dtp->u.p.current_unit->ls); ! ! /* Check for "end-of-file condition */ ! if (record == 0) ! longjmp (*dtp->u.p.eof_jump, 1); ! ! record *= dtp->u.p.current_unit->recl; ! ! if (sseek (dtp->u.p.current_unit->s, record) == FAILURE) ! longjmp (*dtp->u.p.eof_jump, 1); ! ! dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; ! goto done; } ! /* Get the next character and handle end-of-record conditions */ ! p = salloc_r (dtp->u.p.current_unit->s, &length); ! ! if (is_internal_unit(dtp)) { ! if (is_array_io(dtp)) ! { ! /* End of record is handled in the next pass through, above. The ! check for NULL here is cautionary. */ ! if (p == NULL) ! { ! generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); ! return '\0'; ! } ! ! dtp->u.p.current_unit->bytes_left--; ! c = *p; ! } else ! { ! if (p == NULL) ! longjmp (*dtp->u.p.eof_jump, 1); ! if (length == 0) ! c = '\n'; ! else ! c = *p; ! } } else ! { ! if (p == NULL) ! { ! generate_error (&dtp->common, ERROR_OS, NULL); ! return '\0'; ! } ! if (length == 0) ! longjmp (*dtp->u.p.eof_jump, 1); ! c = *p; ! } done: ! dtp->u.p.at_eol = (c == '\n' || c == '\r'); return c; } *************** done: *** 182,190 **** /* Push a character back onto the input. */ static void ! unget_char (char c) { ! last_char = c; } --- 201,209 ---- /* Push a character back onto the input. */ static void ! unget_char (st_parameter_dt *dtp, char c) { ! dtp->u.p.last_char = c; } *************** unget_char (char c) *** 192,208 **** terminated the eating and also places it back on the input. */ static char ! eat_spaces (void) { char c; do { ! c = next_char (); } while (c == ' ' || c == '\t'); ! unget_char (c); return c; } --- 211,227 ---- terminated the eating and also places it back on the input. */ static char ! eat_spaces (st_parameter_dt *dtp) { char c; do { ! c = next_char (dtp); } while (c == ' ' || c == '\t'); ! unget_char (dtp, c); return c; } *************** eat_spaces (void) *** 219,253 **** of the separator. */ static void ! eat_separator (void) { ! char c; ! eat_spaces (); ! comma_flag = 0; ! c = next_char (); switch (c) { case ',': ! comma_flag = 1; ! eat_spaces (); break; case '/': ! input_complete = 1; break; - case '\n': case '\r': ! at_eol = 1; break; case '!': ! if (namelist_mode) { /* Eat a namelist comment. */ do ! c = next_char (); while (c != '\n'); break; --- 238,282 ---- of the separator. */ static void ! eat_separator (st_parameter_dt *dtp) { ! char c, n; ! eat_spaces (dtp); ! dtp->u.p.comma_flag = 0; ! c = next_char (dtp); switch (c) { case ',': ! dtp->u.p.comma_flag = 1; ! eat_spaces (dtp); break; case '/': ! dtp->u.p.input_complete = 1; break; case '\r': ! n = next_char(dtp); ! if (n == '\n') ! dtp->u.p.at_eol = 1; ! else ! { ! unget_char (dtp, n); ! unget_char (dtp, c); ! } ! break; ! ! case '\n': ! dtp->u.p.at_eol = 1; break; case '!': ! if (dtp->u.p.namelist_mode) { /* Eat a namelist comment. */ do ! c = next_char (dtp); while (c != '\n'); break; *************** eat_separator (void) *** 256,262 **** /* Fall Through... */ default: ! unget_char (c); break; } } --- 285,291 ---- /* Fall Through... */ default: ! unget_char (dtp, c); break; } } *************** eat_separator (void) *** 267,297 **** we started on the previous line. */ static void ! finish_separator (void) { char c; restart: ! eat_spaces (); ! c = next_char (); switch (c) { case ',': ! if (comma_flag) ! unget_char (c); else { ! c = eat_spaces (); ! if (c == '\n') goto restart; } break; case '/': ! input_complete = 1; ! if (!namelist_mode) next_record (0); break; case '\n': --- 296,326 ---- we started on the previous line. */ static void ! finish_separator (st_parameter_dt *dtp) { char c; restart: ! eat_spaces (dtp); ! c = next_char (dtp); switch (c) { case ',': ! if (dtp->u.p.comma_flag) ! unget_char (dtp, c); else { ! c = eat_spaces (dtp); ! if (c == '\n' || c == '\r') goto restart; } break; case '/': ! dtp->u.p.input_complete = 1; ! if (!dtp->u.p.namelist_mode) next_record (dtp, 0); break; case '\n': *************** finish_separator (void) *** 299,330 **** goto restart; case '!': ! if (namelist_mode) { do ! c = next_char (); while (c != '\n'); goto restart; } default: ! unget_char (c); break; } } /* This function is needed to catch bad conversions so that namelist can ! attempt to see if saved_string contains a new object name rather than ! a bad value. */ static int ! nml_bad_return (char c) { ! if (namelist_mode) { ! nml_read_error = 1; ! unget_char(c); return 1; } return 0; --- 328,359 ---- goto restart; case '!': ! if (dtp->u.p.namelist_mode) { do ! c = next_char (dtp); while (c != '\n'); goto restart; } default: ! unget_char (dtp, c); break; } } /* This function is needed to catch bad conversions so that namelist can ! attempt to see if dtp->u.p.saved_string contains a new object name rather ! than a bad value. */ static int ! nml_bad_return (st_parameter_dt *dtp, char c) { ! if (dtp->u.p.namelist_mode) { ! dtp->u.p.nml_read_error = 1; ! unget_char (dtp, c); return 1; } return 0; *************** nml_bad_return (char c) *** 332,347 **** /* Convert an unsigned string to an integer. The length value is -1 if we are working on a repeat count. Returns nonzero if we have a ! range problem. As a side effect, frees the saved_string. */ static int ! convert_integer (int length, int negative) { char c, *buffer, message[100]; int m; ! int64_t v, max, max10; ! buffer = saved_string; v = 0; max = (length == -1) ? MAX_REPEAT : max_value (length, 1); --- 361,376 ---- /* Convert an unsigned string to an integer. The length value is -1 if we are working on a repeat count. Returns nonzero if we have a ! range problem. As a side effect, frees the dtp->u.p.saved_string. */ static int ! convert_integer (st_parameter_dt *dtp, int length, int negative) { char c, *buffer, message[100]; int m; ! GFC_INTEGER_LARGEST v, max, max10; ! buffer = dtp->u.p.saved_string; v = 0; max = (length == -1) ? MAX_REPEAT : max_value (length, 1); *************** convert_integer (int length, int negativ *** 369,403 **** { if (negative) v = -v; ! set_integer (value, v, length); } else { ! repeat_count = v; ! if (repeat_count == 0) { st_sprintf (message, "Zero repeat count in item %d of list input", ! g.item_count); ! generate_error (ERROR_READ_VALUE, message); m = 1; } } ! free_saved (); return m; overflow: if (length == -1) st_sprintf (message, "Repeat count overflow in item %d of list input", ! g.item_count); else st_sprintf (message, "Integer overflow while reading item %d", ! g.item_count); ! free_saved (); ! generate_error (ERROR_READ_VALUE, message); return 1; } --- 398,432 ---- { if (negative) v = -v; ! set_integer (dtp->u.p.value, v, length); } else { ! dtp->u.p.repeat_count = v; ! if (dtp->u.p.repeat_count == 0) { st_sprintf (message, "Zero repeat count in item %d of list input", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); m = 1; } } ! free_saved (dtp); return m; overflow: if (length == -1) st_sprintf (message, "Repeat count overflow in item %d of list input", ! dtp->u.p.item_count); else st_sprintf (message, "Integer overflow while reading item %d", ! dtp->u.p.item_count); ! free_saved (dtp); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); return 1; } *************** convert_integer (int length, int negativ *** 408,419 **** should continue on. */ static int ! parse_repeat (void) { char c, message[100]; int repeat; ! c = next_char (); switch (c) { CASE_DIGITS: --- 437,448 ---- should continue on. */ static int ! parse_repeat (st_parameter_dt *dtp) { char c, message[100]; int repeat; ! c = next_char (dtp); switch (c) { CASE_DIGITS: *************** parse_repeat (void) *** 421,438 **** break; CASE_SEPARATORS: ! unget_char (c); ! eat_separator (); return 1; default: ! unget_char (c); return 0; } for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: --- 450,467 ---- break; CASE_SEPARATORS: ! unget_char (dtp, c); ! eat_separator (dtp); return 1; default: ! unget_char (dtp, c); return 0; } for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: *************** parse_repeat (void) *** 442,450 **** { st_sprintf (message, "Repeat count overflow in item %d of list input", ! g.item_count); ! generate_error (ERROR_READ_VALUE, message); return 1; } --- 471,479 ---- { st_sprintf (message, "Repeat count overflow in item %d of list input", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); return 1; } *************** parse_repeat (void) *** 455,463 **** { st_sprintf (message, "Zero repeat count in item %d of list input", ! g.item_count); ! generate_error (ERROR_READ_VALUE, message); return 1; } --- 484,492 ---- { st_sprintf (message, "Zero repeat count in item %d of list input", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); return 1; } *************** parse_repeat (void) *** 469,482 **** } done: ! repeat_count = repeat; return 0; bad_repeat: st_sprintf (message, "Bad repeat count in item %d of list input", ! g.item_count); ! generate_error (ERROR_READ_VALUE, message); return 1; } --- 498,511 ---- } done: ! dtp->u.p.repeat_count = repeat; return 0; bad_repeat: st_sprintf (message, "Bad repeat count in item %d of list input", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); return 1; } *************** parse_repeat (void) *** 484,498 **** /* Read a logical character on the input. */ static void ! read_logical (int length) { char c, message[100]; int v; ! if (parse_repeat ()) return; ! c = next_char (); switch (c) { case 't': --- 513,527 ---- /* Read a logical character on the input. */ static void ! read_logical (st_parameter_dt *dtp, int length) { char c, message[100]; int v; ! if (parse_repeat (dtp)) return; ! c = next_char (dtp); switch (c) { case 't': *************** read_logical (int length) *** 505,511 **** break; case '.': ! c = next_char (); switch (c) { case 't': --- 534,540 ---- break; case '.': ! c = next_char (dtp); switch (c) { case 't': *************** read_logical (int length) *** 523,562 **** break; CASE_SEPARATORS: ! unget_char (c); ! eat_separator (); return; /* Null value. */ default: goto bad_logical; } ! saved_type = BT_LOGICAL; ! saved_length = length; /* Eat trailing garbage. */ do { ! c = next_char (); } while (!is_separator (c)); ! unget_char (c); ! eat_separator (); ! free_saved (); ! set_integer ((int *) value, v, length); return; bad_logical: ! if (nml_bad_return (c)) return; st_sprintf (message, "Bad logical value while reading item %d", ! g.item_count); ! generate_error (ERROR_READ_VALUE, message); } --- 552,591 ---- break; CASE_SEPARATORS: ! unget_char (dtp, c); ! eat_separator (dtp); return; /* Null value. */ default: goto bad_logical; } ! dtp->u.p.saved_type = BT_LOGICAL; ! dtp->u.p.saved_length = length; /* Eat trailing garbage. */ do { ! c = next_char (dtp); } while (!is_separator (c)); ! unget_char (dtp, c); ! eat_separator (dtp); ! free_saved (dtp); ! set_integer ((int *) dtp->u.p.value, v, length); return; bad_logical: ! if (nml_bad_return (dtp, c)) return; st_sprintf (message, "Bad logical value while reading item %d", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); } *************** read_logical (int length) *** 566,579 **** used for repeat counts. */ static void ! read_integer (int length) { char c, message[100]; int negative; negative = 0; ! c = next_char (); switch (c) { case '-': --- 595,608 ---- used for repeat counts. */ static void ! read_integer (st_parameter_dt *dtp, int length) { char c, message[100]; int negative; negative = 0; ! c = next_char (dtp); switch (c) { case '-': *************** read_integer (int length) *** 581,596 **** /* Fall through... */ case '+': ! c = next_char (); goto get_integer; CASE_SEPARATORS: /* Single null. */ ! unget_char (c); ! eat_separator (); return; CASE_DIGITS: ! push_char (c); break; default: --- 610,625 ---- /* Fall through... */ case '+': ! c = next_char (dtp); goto get_integer; CASE_SEPARATORS: /* Single null. */ ! unget_char (dtp, c); ! eat_separator (dtp); return; CASE_DIGITS: ! push_char (dtp, c); break; default: *************** read_integer (int length) *** 601,615 **** for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; case '*': ! push_char ('\0'); goto repeat; CASE_SEPARATORS: /* Not a repeat count. */ --- 630,644 ---- for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; case '*': ! push_char (dtp, '\0'); goto repeat; CASE_SEPARATORS: /* Not a repeat count. */ *************** read_integer (int length) *** 621,640 **** } repeat: ! if (convert_integer (-1, 0)) return; /* Get the real integer. */ ! c = next_char (); switch (c) { CASE_DIGITS: break; CASE_SEPARATORS: ! unget_char (c); ! eat_separator (); return; case '-': --- 650,669 ---- } repeat: ! if (convert_integer (dtp, -1, 0)) return; /* Get the real integer. */ ! c = next_char (dtp); switch (c) { CASE_DIGITS: break; CASE_SEPARATORS: ! unget_char (dtp, c); ! eat_separator (dtp); return; case '-': *************** read_integer (int length) *** 642,663 **** /* Fall through... */ case '+': ! c = next_char (); break; } get_integer: if (!isdigit (c)) goto bad_integer; ! push_char (c); for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; CASE_SEPARATORS: --- 671,692 ---- /* Fall through... */ case '+': ! c = next_char (dtp); break; } get_integer: if (!isdigit (c)) goto bad_integer; ! push_char (dtp, c); for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; CASE_SEPARATORS: *************** read_integer (int length) *** 670,720 **** bad_integer: ! if (nml_bad_return (c)) return; ! free_saved (); ! st_sprintf (message, "Bad integer for item %d in list input", g.item_count); ! generate_error (ERROR_READ_VALUE, message); return; done: ! unget_char (c); ! eat_separator (); ! push_char ('\0'); ! if (convert_integer (length, negative)) { ! free_saved (); return; } ! free_saved (); ! saved_type = BT_INTEGER; } /* Read a character variable. */ static void ! read_character (int length) { char c, quote, message[100]; quote = ' '; /* Space means no quote character. */ ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; CASE_SEPARATORS: ! unget_char (c); /* NULL value. */ ! eat_separator (); return; case '"': --- 699,750 ---- bad_integer: ! if (nml_bad_return (dtp, c)) return; ! free_saved (dtp); ! st_sprintf (message, "Bad integer for item %d in list input", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); return; done: ! unget_char (dtp, c); ! eat_separator (dtp); ! push_char (dtp, '\0'); ! if (convert_integer (dtp, length, negative)) { ! free_saved (dtp); return; } ! free_saved (dtp); ! dtp->u.p.saved_type = BT_INTEGER; } /* Read a character variable. */ static void ! read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) { char c, quote, message[100]; quote = ' '; /* Space means no quote character. */ ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; CASE_SEPARATORS: ! unget_char (dtp, c); /* NULL value. */ ! eat_separator (dtp); return; case '"': *************** read_character (int length) *** 723,729 **** goto get_string; default: ! push_char (c); goto get_string; } --- 753,764 ---- goto get_string; default: ! if (dtp->u.p.namelist_mode) ! { ! unget_char (dtp,c); ! return; ! } ! push_char (dtp, c); goto get_string; } *************** read_character (int length) *** 731,769 **** for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; CASE_SEPARATORS: ! unget_char (c); goto done; /* String was only digits! */ case '*': ! push_char ('\0'); goto got_repeat; default: ! push_char (c); goto get_string; /* Not a repeat count after all. */ } } got_repeat: ! if (convert_integer (-1, 0)) return; /* Now get the real string. */ ! c = next_char (); switch (c) { CASE_SEPARATORS: ! unget_char (c); /* Repeated NULL values. */ ! eat_separator (); return; case '"': --- 766,804 ---- for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; CASE_SEPARATORS: ! unget_char (dtp, c); goto done; /* String was only digits! */ case '*': ! push_char (dtp, '\0'); goto got_repeat; default: ! push_char (dtp, c); goto get_string; /* Not a repeat count after all. */ } } got_repeat: ! if (convert_integer (dtp, -1, 0)) return; /* Now get the real string. */ ! c = next_char (dtp); switch (c) { CASE_SEPARATORS: ! unget_char (dtp, c); /* Repeated NULL values. */ ! eat_separator (dtp); return; case '"': *************** read_character (int length) *** 772,821 **** break; default: ! push_char (c); break; } get_string: for (;;) { ! c = next_char (); switch (c) { case '"': case '\'': if (c != quote) { ! push_char (c); break; } /* See if we have a doubled quote character or the end of the string. */ ! c = next_char (); if (c == quote) { ! push_char (quote); break; } ! unget_char (c); goto done; CASE_SEPARATORS: if (quote == ' ') { ! unget_char (c); goto done; } ! if (c != '\n') ! push_char (c); break; default: ! push_char (c); break; } } --- 807,856 ---- break; default: ! push_char (dtp, c); break; } get_string: for (;;) { ! c = next_char (dtp); switch (c) { case '"': case '\'': if (c != quote) { ! push_char (dtp, c); break; } /* See if we have a doubled quote character or the end of the string. */ ! c = next_char (dtp); if (c == quote) { ! push_char (dtp, quote); break; } ! unget_char (dtp, c); goto done; CASE_SEPARATORS: if (quote == ' ') { ! unget_char (dtp, c); goto done; } ! if (c != '\n' && c != '\r') ! push_char (dtp, c); break; default: ! push_char (dtp, c); break; } } *************** read_character (int length) *** 823,840 **** /* At this point, we have to have a separator, or else the string is invalid. */ done: ! c = next_char (); if (is_separator (c)) { ! unget_char (c); ! eat_separator (); ! saved_type = BT_CHARACTER; } else { ! free_saved (); ! st_sprintf (message, "Invalid string input in item %d", g.item_count); ! generate_error (ERROR_READ_VALUE, message); } } --- 858,876 ---- /* At this point, we have to have a separator, or else the string is invalid. */ done: ! c = next_char (dtp); if (is_separator (c)) { ! unget_char (dtp, c); ! eat_separator (dtp); ! dtp->u.p.saved_type = BT_CHARACTER; } else { ! free_saved (dtp); ! st_sprintf (message, "Invalid string input in item %d", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); } } *************** read_character (int length) *** 843,874 **** are sure is already there. This is a straight real number parser. */ static int ! parse_real (void *buffer, int length) { char c, message[100]; int m, seen_dp; ! c = next_char (); if (c == '-' || c == '+') { ! push_char (c); ! c = next_char (); } if (!isdigit (c) && c != '.') goto bad; ! push_char (c); seen_dp = (c == '.') ? 1 : 0; for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; case '.': --- 879,910 ---- are sure is already there. This is a straight real number parser. */ static int ! parse_real (st_parameter_dt *dtp, void *buffer, int length) { char c, message[100]; int m, seen_dp; ! c = next_char (dtp); if (c == '-' || c == '+') { ! push_char (dtp, c); ! c = next_char (dtp); } if (!isdigit (c) && c != '.') goto bad; ! push_char (dtp, c); seen_dp = (c == '.') ? 1 : 0; for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; case '.': *************** parse_real (void *buffer, int length) *** 876,900 **** goto bad; seen_dp = 1; ! push_char (c); break; case 'e': case 'E': case 'd': case 'D': ! push_char ('e'); goto exp1; case '-': case '+': ! push_char ('e'); ! push_char (c); ! c = next_char (); goto exp2; CASE_SEPARATORS: ! unget_char (c); goto done; default: --- 912,936 ---- goto bad; seen_dp = 1; ! push_char (dtp, c); break; case 'e': case 'E': case 'd': case 'D': ! push_char (dtp, 'e'); goto exp1; case '-': case '+': ! push_char (dtp, 'e'); ! push_char (dtp, c); ! c = next_char (dtp); goto exp2; CASE_SEPARATORS: ! unget_char (dtp, c); goto done; default: *************** parse_real (void *buffer, int length) *** 903,933 **** } exp1: ! c = next_char (); if (c != '-' && c != '+') ! push_char ('+'); else { ! push_char (c); ! c = next_char (); } exp2: if (!isdigit (c)) goto bad; ! push_char (c); for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; CASE_SEPARATORS: ! unget_char (c); goto done; default: --- 939,969 ---- } exp1: ! c = next_char (dtp); if (c != '-' && c != '+') ! push_char (dtp, '+'); else { ! push_char (dtp, c); ! c = next_char (dtp); } exp2: if (!isdigit (c)) goto bad; ! push_char (dtp, c); for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; CASE_SEPARATORS: ! unget_char (dtp, c); goto done; default: *************** parse_real (void *buffer, int length) *** 936,953 **** } done: ! unget_char (c); ! push_char ('\0'); ! m = convert_real (buffer, saved_string, length); ! free_saved (); return m; bad: ! free_saved (); ! st_sprintf (message, "Bad floating point number for item %d", g.item_count); ! generate_error (ERROR_READ_VALUE, message); return 1; } --- 972,990 ---- } done: ! unget_char (dtp, c); ! push_char (dtp, '\0'); ! m = convert_real (dtp, buffer, dtp->u.p.saved_string, length); ! free_saved (dtp); return m; bad: ! free_saved (dtp); ! st_sprintf (message, "Bad floating point number for item %d", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); return 1; } *************** parse_real (void *buffer, int length) *** 957,1057 **** what it is right away. */ static void ! read_complex (int length) { char message[100]; char c; ! if (parse_repeat ()) return; ! c = next_char (); switch (c) { case '(': break; CASE_SEPARATORS: ! unget_char (c); ! eat_separator (); return; default: goto bad_complex; } ! eat_spaces (); ! if (parse_real (value, length)) return; eol_1: ! eat_spaces (); ! c = next_char (); if (c == '\n' || c== '\r') goto eol_1; else ! unget_char (c); ! if (next_char () != ',') goto bad_complex; eol_2: ! eat_spaces (); ! c = next_char (); if (c == '\n' || c== '\r') goto eol_2; else ! unget_char (c); ! if (parse_real (value + length, length)) return; ! eat_spaces (); ! if (next_char () != ')') goto bad_complex; ! c = next_char (); if (!is_separator (c)) goto bad_complex; ! unget_char (c); ! eat_separator (); ! free_saved (); ! saved_type = BT_COMPLEX; return; bad_complex: ! if (nml_bad_return (c)) return; st_sprintf (message, "Bad complex value in item %d of list input", ! g.item_count); ! generate_error (ERROR_READ_VALUE, message); } /* Parse a real number with a possible repeat count. */ static void ! read_real (int length) { char c, message[100]; int seen_dp; seen_dp = 0; ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; case '.': ! push_char (c); seen_dp = 1; break; --- 994,1094 ---- what it is right away. */ static void ! read_complex (st_parameter_dt *dtp, int kind, size_t size) { char message[100]; char c; ! if (parse_repeat (dtp)) return; ! c = next_char (dtp); switch (c) { case '(': break; CASE_SEPARATORS: ! unget_char (dtp, c); ! eat_separator (dtp); return; default: goto bad_complex; } ! eat_spaces (dtp); ! if (parse_real (dtp, dtp->u.p.value, kind)) return; eol_1: ! eat_spaces (dtp); ! c = next_char (dtp); if (c == '\n' || c== '\r') goto eol_1; else ! unget_char (dtp, c); ! if (next_char (dtp) != ',') goto bad_complex; eol_2: ! eat_spaces (dtp); ! c = next_char (dtp); if (c == '\n' || c== '\r') goto eol_2; else ! unget_char (dtp, c); ! if (parse_real (dtp, dtp->u.p.value + size / 2, kind)) return; ! eat_spaces (dtp); ! if (next_char (dtp) != ')') goto bad_complex; ! c = next_char (dtp); if (!is_separator (c)) goto bad_complex; ! unget_char (dtp, c); ! eat_separator (dtp); ! free_saved (dtp); ! dtp->u.p.saved_type = BT_COMPLEX; return; bad_complex: ! if (nml_bad_return (dtp, c)) return; st_sprintf (message, "Bad complex value in item %d of list input", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); } /* Parse a real number with a possible repeat count. */ static void ! read_real (st_parameter_dt *dtp, int length) { char c, message[100]; int seen_dp; seen_dp = 0; ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; case '.': ! push_char (dtp, c); seen_dp = 1; break; *************** read_real (int length) *** 1060,1067 **** goto got_sign; CASE_SEPARATORS: ! unget_char (c); /* Single null. */ ! eat_separator (); return; default: --- 1097,1104 ---- goto got_sign; CASE_SEPARATORS: ! unget_char (dtp, c); /* Single null. */ ! eat_separator (dtp); return; default: *************** read_real (int length) *** 1072,1082 **** for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; case '.': --- 1109,1119 ---- for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; case '.': *************** read_real (int length) *** 1084,1090 **** goto bad_real; seen_dp = 1; ! push_char (c); goto real_loop; case 'E': --- 1121,1127 ---- goto bad_real; seen_dp = 1; ! push_char (dtp, c); goto real_loop; case 'E': *************** read_real (int length) *** 1095,1113 **** case '+': case '-': ! push_char ('e'); ! push_char (c); ! c = next_char (); goto exp2; case '*': ! push_char ('\0'); goto got_repeat; CASE_SEPARATORS: if (c != '\n' && c != ',' && c != '\r') ! unget_char (c); ! goto done; default: --- 1132,1149 ---- case '+': case '-': ! push_char (dtp, 'e'); ! push_char (dtp, c); ! c = next_char (dtp); goto exp2; case '*': ! push_char (dtp, '\0'); goto got_repeat; CASE_SEPARATORS: if (c != '\n' && c != ',' && c != '\r') ! unget_char (dtp, c); goto done; default: *************** read_real (int length) *** 1116,1141 **** } got_repeat: ! if (convert_integer (-1, 0)) return; /* Now get the number itself. */ ! c = next_char (); if (is_separator (c)) { /* Repeated null value. */ ! unget_char (c); ! eat_separator (); return; } if (c != '-' && c != '+') ! push_char ('+'); else { got_sign: ! push_char (c); ! c = next_char (); } if (!isdigit (c) && c != '.') --- 1152,1177 ---- } got_repeat: ! if (convert_integer (dtp, -1, 0)) return; /* Now get the number itself. */ ! c = next_char (dtp); if (is_separator (c)) { /* Repeated null value. */ ! unget_char (dtp, c); ! eat_separator (dtp); return; } if (c != '-' && c != '+') ! push_char (dtp, '+'); else { got_sign: ! push_char (dtp, c); ! c = next_char (dtp); } if (!isdigit (c) && c != '.') *************** read_real (int length) *** 1149,1164 **** seen_dp = 1; } ! push_char (c); real_loop: for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; CASE_SEPARATORS: --- 1185,1200 ---- seen_dp = 1; } ! push_char (dtp, c); real_loop: for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; CASE_SEPARATORS: *************** read_real (int length) *** 1169,1175 **** goto bad_real; seen_dp = 1; ! push_char (c); break; case 'E': --- 1205,1211 ---- goto bad_real; seen_dp = 1; ! push_char (dtp, c); break; case 'E': *************** read_real (int length) *** 1180,1188 **** case '+': case '-': ! push_char ('e'); ! push_char (c); ! c = next_char (); goto exp2; default: --- 1216,1224 ---- case '+': case '-': ! push_char (dtp, 'e'); ! push_char (dtp, c); ! c = next_char (dtp); goto exp2; default: *************** read_real (int length) *** 1191,1220 **** } exp1: ! push_char ('e'); ! c = next_char (); if (c != '+' && c != '-') ! push_char ('+'); else { ! push_char (c); ! c = next_char (); } exp2: if (!isdigit (c)) goto bad_real; ! push_char (c); for (;;) { ! c = next_char (); switch (c) { CASE_DIGITS: ! push_char (c); break; CASE_SEPARATORS: --- 1227,1256 ---- } exp1: ! push_char (dtp, 'e'); ! c = next_char (dtp); if (c != '+' && c != '-') ! push_char (dtp, '+'); else { ! push_char (dtp, c); ! c = next_char (dtp); } exp2: if (!isdigit (c)) goto bad_real; ! push_char (dtp, c); for (;;) { ! c = next_char (dtp); switch (c) { CASE_DIGITS: ! push_char (dtp, c); break; CASE_SEPARATORS: *************** read_real (int length) *** 1226,1250 **** } done: ! unget_char (c); ! eat_separator (); ! push_char ('\0'); ! if (convert_real (value, saved_string, length)) return; ! free_saved (); ! saved_type = BT_REAL; return; bad_real: ! if (nml_bad_return (c)) return; st_sprintf (message, "Bad real number in item %d of list input", ! g.item_count); ! generate_error (ERROR_READ_VALUE, message); } --- 1262,1286 ---- } done: ! unget_char (dtp, c); ! eat_separator (dtp); ! push_char (dtp, '\0'); ! if (convert_real (dtp, dtp->u.p.value, dtp->u.p.saved_string, length)) return; ! free_saved (dtp); ! dtp->u.p.saved_type = BT_REAL; return; bad_real: ! if (nml_bad_return (dtp, c)) return; st_sprintf (message, "Bad real number in item %d of list input", ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); } *************** read_real (int length) *** 1252,1279 **** compatible. Returns nonzero if incompatible. */ static int ! check_type (bt type, int len) { char message[100]; ! if (saved_type != BT_NULL && saved_type != type) { st_sprintf (message, "Read type %s where %s was expected for item %d", ! type_name (saved_type), type_name (type), g.item_count); ! generate_error (ERROR_READ_VALUE, message); return 1; } ! if (saved_type == BT_NULL || saved_type == BT_CHARACTER) return 0; ! if (saved_length != len) { st_sprintf (message, "Read kind %d %s where kind %d is required for item %d", ! saved_length, type_name (saved_type), len, g.item_count); ! generate_error (ERROR_READ_VALUE, message); return 1; } --- 1288,1317 ---- compatible. Returns nonzero if incompatible. */ static int ! check_type (st_parameter_dt *dtp, bt type, int len) { char message[100]; ! if (dtp->u.p.saved_type != BT_NULL && dtp->u.p.saved_type != type) { st_sprintf (message, "Read type %s where %s was expected for item %d", ! type_name (dtp->u.p.saved_type), type_name (type), ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); return 1; } ! if (dtp->u.p.saved_type == BT_NULL || dtp->u.p.saved_type == BT_CHARACTER) return 0; ! if (dtp->u.p.saved_length != len) { st_sprintf (message, "Read kind %d %s where kind %d is required for item %d", ! dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len, ! dtp->u.p.item_count); ! generate_error (&dtp->common, ERROR_READ_VALUE, message); return 1; } *************** check_type (bt type, int len) *** 1283,1483 **** /* Top level data transfer subroutine for list reads. Because we have to deal with repeat counts, the data item is always saved after ! reading, usually in the value[] array. If a repeat count is greater than one, we copy the data item multiple times. */ ! void ! list_formatted_read (bt type, void *p, int len) { char c; int m; ! namelist_mode = 0; ! if (setjmp (g.eof_jump)) { ! generate_error (ERROR_END, NULL); ! return; } ! if (g.first_item) { ! g.first_item = 0; ! input_complete = 0; ! repeat_count = 1; ! at_eol = 0; ! c = eat_spaces (); if (is_separator (c)) { /* Found a null value. */ ! eat_separator (); ! repeat_count = 0; ! if (at_eol) ! finish_separator (); ! else ! return; } } else { ! if (input_complete) ! return; ! if (repeat_count > 0) { ! if (check_type (type, len)) return; goto set_value; } ! if (at_eol) ! finish_separator (); else { ! eat_spaces (); /* trailing spaces prior to end of line */ ! if (at_eol) ! finish_separator (); } ! saved_type = BT_NULL; ! repeat_count = 1; } switch (type) { case BT_INTEGER: ! read_integer (len); break; case BT_LOGICAL: ! read_logical (len); break; case BT_CHARACTER: ! read_character (len); break; case BT_REAL: ! read_real (len); break; case BT_COMPLEX: ! read_complex (len); break; default: ! internal_error ("Bad type for list read"); } ! if (saved_type != BT_CHARACTER && saved_type != BT_NULL) ! saved_length = len; ! if (ioparm.library_return != LIBRARY_OK) ! return; set_value: ! switch (saved_type) { case BT_COMPLEX: - len = 2 * len; - /* Fall through. */ - case BT_INTEGER: case BT_REAL: case BT_LOGICAL: ! memcpy (p, value, len); break; case BT_CHARACTER: ! if (saved_string) ! { ! m = (len < saved_used) ? len : saved_used; ! memcpy (p, saved_string, m); } ! else /* Just delimiters encountered, nothing to copy but SPACE. */ m = 0; ! if (m < len) ! memset (((char *) p) + m, ' ', len - m); break; case BT_NULL: break; } ! if (--repeat_count <= 0) ! free_saved (); } void ! init_at_eol(void) { ! at_eol = 0; } /* Finish a list read. */ void ! finish_list_read (void) { char c; ! free_saved (); ! if (at_eol) { ! at_eol = 0; return; } do { ! c = next_char (); } while (c != '\n'); } /* NAMELIST INPUT ! void namelist_read (void) calls: static void nml_match_name (char *name, int len) ! static int nml_query (void) ! static int nml_get_obj_data (void) calls: ! static void nml_untouch_nodes (void) ! static namelist_info * find_nml_node (char * var_name) static int nml_parse_qualifier(descriptor_dimension * ad, ! nml_loop_spec * ls, int rank) static void nml_touch_nodes (namelist_info * nl) ! static int nml_read_obj (namelist_info * nl, index_type offset) calls: -itself- */ - /* Carries error messages from the qualifier parser. */ - static char parse_err_msg[30]; - - /* Carries error messages for error returns. */ - static char nml_err_msg[100]; - - /* Pointer to the previously read object, in case attempt is made to read - new object name. Should this fail, error message can give previous - name. */ - - static namelist_info * prev_nl; - - /* Lower index for substring qualifier. */ - - static index_type clow; - - /* Upper index for substring qualifier. */ - - static index_type chigh; - /* Inputs a rank-dimensional qualifier, which can contain singlets, doublets, triplets or ':' with the standard meanings. */ static try ! nml_parse_qualifier(descriptor_dimension * ad, ! nml_loop_spec * ls, int rank) { int dim; int indx; --- 1321,1528 ---- /* Top level data transfer subroutine for list reads. Because we have to deal with repeat counts, the data item is always saved after ! reading, usually in the dtp->u.p.value[] array. If a repeat count is greater than one, we copy the data item multiple times. */ ! static void ! list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, ! size_t size) { char c; int m; + jmp_buf eof_jump; ! dtp->u.p.namelist_mode = 0; ! dtp->u.p.eof_jump = &eof_jump; ! if (setjmp (eof_jump)) { ! generate_error (&dtp->common, ERROR_END, NULL); ! goto cleanup; } ! if (dtp->u.p.first_item) { ! dtp->u.p.first_item = 0; ! dtp->u.p.input_complete = 0; ! dtp->u.p.repeat_count = 1; ! dtp->u.p.at_eol = 0; ! c = eat_spaces (dtp); if (is_separator (c)) { /* Found a null value. */ ! eat_separator (dtp); ! dtp->u.p.repeat_count = 0; ! ! /* eat_separator sets this flag if the separator was a comma */ ! if (dtp->u.p.comma_flag) ! goto cleanup; ! ! /* eat_separator sets this flag if the separator was a \n or \r */ ! if (dtp->u.p.at_eol) ! finish_separator (dtp); ! else ! goto cleanup; } } else { ! if (dtp->u.p.input_complete) ! goto cleanup; ! if (dtp->u.p.repeat_count > 0) { ! if (check_type (dtp, type, kind)) return; goto set_value; } ! if (dtp->u.p.at_eol) ! finish_separator (dtp); else { ! eat_spaces (dtp); /* trailing spaces prior to end of line */ ! if (dtp->u.p.at_eol) ! finish_separator (dtp); } ! dtp->u.p.saved_type = BT_NULL; ! dtp->u.p.repeat_count = 1; } switch (type) { case BT_INTEGER: ! read_integer (dtp, kind); break; case BT_LOGICAL: ! read_logical (dtp, kind); break; case BT_CHARACTER: ! read_character (dtp, kind); break; case BT_REAL: ! read_real (dtp, kind); break; case BT_COMPLEX: ! read_complex (dtp, kind, size); break; default: ! internal_error (&dtp->common, "Bad type for list read"); } ! if (dtp->u.p.saved_type != BT_CHARACTER && dtp->u.p.saved_type != BT_NULL) ! dtp->u.p.saved_length = size; ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) ! goto cleanup; set_value: ! switch (dtp->u.p.saved_type) { case BT_COMPLEX: case BT_INTEGER: case BT_REAL: case BT_LOGICAL: ! memcpy (p, dtp->u.p.value, size); break; case BT_CHARACTER: ! if (dtp->u.p.saved_string) ! { ! m = ((int) size < dtp->u.p.saved_used) ! ? (int) size : dtp->u.p.saved_used; ! memcpy (p, dtp->u.p.saved_string, m); } ! else /* Just delimiters encountered, nothing to copy but SPACE. */ m = 0; ! if (m < (int) size) ! memset (((char *) p) + m, ' ', size - m); break; case BT_NULL: break; } ! if (--dtp->u.p.repeat_count <= 0) ! free_saved (dtp); ! ! cleanup: ! dtp->u.p.eof_jump = NULL; } + void ! list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind, ! size_t size, size_t nelems) { ! size_t elem; ! char *tmp; ! ! tmp = (char *) p; ! ! /* Big loop over all the elements. */ ! for (elem = 0; elem < nelems; elem++) ! { ! dtp->u.p.item_count++; ! list_formatted_read_scalar (dtp, type, tmp + size*elem, kind, size); ! } } + /* Finish a list read. */ void ! finish_list_read (st_parameter_dt *dtp) { char c; ! free_saved (dtp); ! if (dtp->u.p.at_eol) { ! dtp->u.p.at_eol = 0; return; } do { ! c = next_char (dtp); } while (c != '\n'); } /* NAMELIST INPUT ! void namelist_read (st_parameter_dt *dtp) calls: static void nml_match_name (char *name, int len) ! static int nml_query (st_parameter_dt *dtp) ! static int nml_get_obj_data (st_parameter_dt *dtp, ! namelist_info **prev_nl, char *) calls: ! static void nml_untouch_nodes (st_parameter_dt *dtp) ! static namelist_info * find_nml_node (st_parameter_dt *dtp, ! char * var_name) static int nml_parse_qualifier(descriptor_dimension * ad, ! array_loop_spec * ls, int rank, char *) static void nml_touch_nodes (namelist_info * nl) ! static int nml_read_obj (namelist_info *nl, index_type offset, ! namelist_info **prev_nl, char *, ! index_type clow, index_type chigh) calls: -itself- */ /* Inputs a rank-dimensional qualifier, which can contain singlets, doublets, triplets or ':' with the standard meanings. */ static try ! nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, ! array_loop_spec *ls, int rank, char *parse_err_msg) { int dim; int indx; *************** nml_parse_qualifier(descriptor_dimension *** 1487,1493 **** /* The next character in the stream should be the '('. */ ! c = next_char (); /* Process the qualifier, by dimension and triplet. */ --- 1532,1538 ---- /* The next character in the stream should be the '('. */ ! c = next_char (dtp); /* Process the qualifier, by dimension and triplet. */ *************** nml_parse_qualifier(descriptor_dimension *** 1495,1507 **** { for (indx=0; indx<3; indx++) { ! free_saved (); ! eat_spaces (); neg = 0; ! /*process a potential sign. */ ! ! c = next_char (); switch (c) { case '-': --- 1540,1551 ---- { for (indx=0; indx<3; indx++) { ! free_saved (dtp); ! eat_spaces (dtp); neg = 0; ! /* Process a potential sign. */ ! c = next_char (dtp); switch (c) { case '-': *************** nml_parse_qualifier(descriptor_dimension *** 1512,1526 **** break; default: ! unget_char (c); break; } ! /*process characters up to the next ':' , ',' or ')' */ ! for (;;) { ! c = next_char (); switch (c) { --- 1556,1569 ---- break; default: ! unget_char (dtp, c); break; } ! /* Process characters up to the next ':' , ',' or ')'. */ for (;;) { ! c = next_char (dtp); switch (c) { *************** nml_parse_qualifier(descriptor_dimension *** 1528,1535 **** break; case ',': case ')': ! if ( (c==',' && dim == rank -1) ! || (c==')' && dim < rank -1)) { st_sprintf (parse_err_msg, "Bad number of index fields"); --- 1571,1578 ---- break; case ',': case ')': ! if ((c==',' && dim == rank -1) ! || (c==')' && dim < rank -1)) { st_sprintf (parse_err_msg, "Bad number of index fields"); *************** nml_parse_qualifier(descriptor_dimension *** 1538,1549 **** break; CASE_DIGITS: ! push_char (c); continue; case ' ': case '\t': ! eat_spaces (); ! c = next_char (); break; default: --- 1581,1592 ---- break; CASE_DIGITS: ! push_char (dtp, c); continue; case ' ': case '\t': ! eat_spaces (dtp); ! c = next_char (dtp); break; default: *************** nml_parse_qualifier(descriptor_dimension *** 1551,1564 **** goto err_ret; } ! if (( c==',' || c==')') && indx==0 && saved_string == 0 ) { st_sprintf (parse_err_msg, "Null index field"); goto err_ret; } ! if ( ( c==':' && indx==1 && saved_string == 0) ! || (indx==2 && saved_string == 0)) { st_sprintf(parse_err_msg, "Bad index triplet"); goto err_ret; --- 1594,1608 ---- goto err_ret; } ! if ((c == ',' || c == ')') && indx == 0 ! && dtp->u.p.saved_string == 0) { st_sprintf (parse_err_msg, "Null index field"); goto err_ret; } ! if ((c == ':' && indx == 1 && dtp->u.p.saved_string == 0) ! || (indx == 2 && dtp->u.p.saved_string == 0)) { st_sprintf(parse_err_msg, "Bad index triplet"); goto err_ret; *************** nml_parse_qualifier(descriptor_dimension *** 1566,1581 **** /* If '( : ? )' or '( ? : )' break and flag read failure. */ null_flag = 0; ! if ( (c==':' && indx==0 && saved_string == 0) ! || (indx==1 && saved_string == 0)) { null_flag = 1; break; } /* Now read the index. */ ! ! if (convert_integer (sizeof(int),neg)) { st_sprintf (parse_err_msg, "Bad integer in index"); goto err_ret; --- 1610,1624 ---- /* If '( : ? )' or '( ? : )' break and flag read failure. */ null_flag = 0; ! if ((c == ':' && indx == 0 && dtp->u.p.saved_string == 0) ! || (indx==1 && dtp->u.p.saved_string == 0)) { null_flag = 1; break; } /* Now read the index. */ ! if (convert_integer (dtp, sizeof(ssize_t), neg)) { st_sprintf (parse_err_msg, "Bad integer in index"); goto err_ret; *************** nml_parse_qualifier(descriptor_dimension *** 1583,1636 **** break; } ! /*feed the index values to the triplet arrays. */ ! if (!null_flag) { if (indx == 0) ! ls[dim].start = *(int *)value; if (indx == 1) ! ls[dim].end = *(int *)value; if (indx == 2) ! ls[dim].step = *(int *)value; } ! /*singlet or doublet indices */ ! if (c==',' || c==')') { if (indx == 0) { ! ls[dim].start = *(int *)value; ! ls[dim].end = *(int *)value; } break; } } ! /*Check the values of the triplet indices. */ ! ! if ( (ls[dim].start > (ssize_t)ad[dim].ubound) ! || (ls[dim].start < (ssize_t)ad[dim].lbound) ! || (ls[dim].end > (ssize_t)ad[dim].ubound) ! || (ls[dim].end < (ssize_t)ad[dim].lbound)) { st_sprintf (parse_err_msg, "Index %d out of range", dim + 1); goto err_ret; } if (((ls[dim].end - ls[dim].start ) * ls[dim].step < 0) ! || (ls[dim].step == 0)) { st_sprintf (parse_err_msg, "Bad range in index %d", dim + 1); goto err_ret; } /* Initialise the loop index counter. */ - ls[dim].idx = ls[dim].start; - } ! eat_spaces (); return SUCCESS; err_ret: --- 1626,1674 ---- break; } ! /* Feed the index values to the triplet arrays. */ if (!null_flag) { if (indx == 0) ! memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t)); if (indx == 1) ! memcpy (&ls[dim].end, dtp->u.p.value, sizeof(ssize_t)); if (indx == 2) ! memcpy (&ls[dim].step, dtp->u.p.value, sizeof(ssize_t)); } ! /* Singlet or doublet indices. */ if (c==',' || c==')') { if (indx == 0) { ! memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t)); ! ls[dim].end = ls[dim].start; } break; } } ! /* Check the values of the triplet indices. */ ! if ((ls[dim].start > (ssize_t)ad[dim].ubound) ! || (ls[dim].start < (ssize_t)ad[dim].lbound) ! || (ls[dim].end > (ssize_t)ad[dim].ubound) ! || (ls[dim].end < (ssize_t)ad[dim].lbound)) { st_sprintf (parse_err_msg, "Index %d out of range", dim + 1); goto err_ret; } if (((ls[dim].end - ls[dim].start ) * ls[dim].step < 0) ! || (ls[dim].step == 0)) { st_sprintf (parse_err_msg, "Bad range in index %d", dim + 1); goto err_ret; } /* Initialise the loop index counter. */ ls[dim].idx = ls[dim].start; } ! eat_spaces (dtp); return SUCCESS; err_ret: *************** err_ret: *** 1639,1650 **** } static namelist_info * ! find_nml_node (char * var_name) { ! namelist_info * t = ionml; while (t != NULL) { ! if (strcmp (var_name,t->var_name) == 0) { t->touched = 1; return t; --- 1677,1688 ---- } static namelist_info * ! find_nml_node (st_parameter_dt *dtp, char * var_name) { ! namelist_info * t = dtp->u.p.ionml; while (t != NULL) { ! if (strcmp (var_name, t->var_name) == 0) { t->touched = 1; return t; *************** find_nml_node (char * var_name) *** 1656,1662 **** /* Visits all the components of a derived type that have not explicitly been identified in the namelist input. ! touched is set and the loop specification initialised to default values */ static void --- 1694,1700 ---- /* Visits all the components of a derived type that have not explicitly been identified in the namelist input. ! touched is set and the loop specification initialised to default values */ static void *************** nml_touch_nodes (namelist_info * nl) *** 1691,1719 **** new object. */ static void ! nml_untouch_nodes (void) { namelist_info * t; ! for (t = ionml; t; t = t->next) t->touched = 0; return; } ! /* Attempts to input name to namelist name. Returns nml_read_error = 1 ! on no match. */ static void ! nml_match_name (char *name, index_type len) { index_type i; char c; ! nml_read_error = 0; for (i = 0; i < len; i++) { ! c = next_char (); if (tolower (c) != tolower (name[i])) { ! nml_read_error = 1; break; } } --- 1729,1757 ---- new object. */ static void ! nml_untouch_nodes (st_parameter_dt *dtp) { namelist_info * t; ! for (t = dtp->u.p.ionml; t; t = t->next) t->touched = 0; return; } ! /* Attempts to input name to namelist name. Returns ! dtp->u.p.nml_read_error = 1 on no match. */ static void ! nml_match_name (st_parameter_dt *dtp, const char *name, index_type len) { index_type i; char c; ! dtp->u.p.nml_read_error = 0; for (i = 0; i < len; i++) { ! c = next_char (dtp); if (tolower (c) != tolower (name[i])) { ! dtp->u.p.nml_read_error = 1; break; } } *************** nml_match_name (char *name, index_type l *** 1725,1754 **** the names alone are printed. */ static void ! nml_query (char c) { gfc_unit * temp_unit; namelist_info * nl; index_type len; char * p; ! if (current_unit->unit_number != options.stdin_unit) return; /* Store the current unit and transfer to stdout. */ ! temp_unit = current_unit; ! current_unit = find_unit (options.stdout_unit); ! if (current_unit) { ! g.mode =WRITING; ! next_record (0); /* Write the namelist in its entirety. */ if (c == '=') ! namelist_write (); /* Or write the list of names. */ --- 1763,1792 ---- the names alone are printed. */ static void ! nml_query (st_parameter_dt *dtp, char c) { gfc_unit * temp_unit; namelist_info * nl; index_type len; char * p; ! if (dtp->u.p.current_unit->unit_number != options.stdin_unit) return; /* Store the current unit and transfer to stdout. */ ! temp_unit = dtp->u.p.current_unit; ! dtp->u.p.current_unit = find_unit (options.stdout_unit); ! if (dtp->u.p.current_unit) { ! dtp->u.p.mode = WRITING; ! next_record (dtp, 0); /* Write the namelist in its entirety. */ if (c == '=') ! namelist_write (dtp); /* Or write the list of names. */ *************** nml_query (char c) *** 1757,1802 **** /* "&namelist_name\n" */ ! len = ioparm.namelist_name_len; ! p = write_block (len + 2); if (!p) goto query_return; memcpy (p, "&", 1); ! memcpy ((char*)(p + 1), ioparm.namelist_name, len); memcpy ((char*)(p + len + 1), "\n", 1); ! for (nl =ionml; nl; nl = nl->next) { /* " var_name\n" */ len = strlen (nl->var_name); ! p = write_block (len + 2); if (!p) goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); memcpy ((char*)(p + len + 1), "\n", 1); } /* "&end\n" */ ! p = write_block (5); if (!p) goto query_return; memcpy (p, "&end\n", 5); } /* Flush the stream to force immediate output. */ ! flush (current_unit->s); } query_return: /* Restore the current unit. */ ! current_unit = temp_unit; ! g.mode = READING; return; } --- 1795,1865 ---- /* "&namelist_name\n" */ ! len = dtp->namelist_name_len; ! #ifdef HAVE_CRLF ! p = write_block (dtp, len + 3); ! #else ! p = write_block (dtp, len + 2); ! #endif if (!p) goto query_return; memcpy (p, "&", 1); ! memcpy ((char*)(p + 1), dtp->namelist_name, len); ! #ifdef HAVE_CRLF ! memcpy ((char*)(p + len + 1), "\r\n", 2); ! #else memcpy ((char*)(p + len + 1), "\n", 1); ! #endif ! for (nl = dtp->u.p.ionml; nl; nl = nl->next) { /* " var_name\n" */ len = strlen (nl->var_name); ! #ifdef HAVE_CRLF ! p = write_block (dtp, len + 3); ! #else ! p = write_block (dtp, len + 2); ! #endif if (!p) goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); + #ifdef HAVE_CRLF + memcpy ((char*)(p + len + 1), "\r\n", 2); + #else memcpy ((char*)(p + len + 1), "\n", 1); + #endif } /* "&end\n" */ ! #ifdef HAVE_CRLF ! p = write_block (dtp, 6); ! #else ! p = write_block (dtp, 5); ! #endif if (!p) goto query_return; + #ifdef HAVE_CRLF + memcpy (p, "&end\r\n", 6); + #else memcpy (p, "&end\n", 5); + #endif } /* Flush the stream to force immediate output. */ ! flush (dtp->u.p.current_unit->s); ! unlock_unit (dtp->u.p.current_unit); } query_return: /* Restore the current unit. */ ! dtp->u.p.current_unit = temp_unit; ! dtp->u.p.mode = READING; return; } *************** query_return: *** 1811,1817 **** error. */ static try ! nml_read_obj (namelist_info * nl, index_type offset) { namelist_info * cmp; --- 1874,1882 ---- error. */ static try ! nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, ! namelist_info **pprev_nl, char *nml_err_msg, ! index_type clow, index_type chigh) { namelist_info * cmp; *************** nml_read_obj (namelist_info * nl, index_ *** 1829,1836 **** if (!nl->touched) return SUCCESS; ! repeat_count = 0; ! eat_spaces(); len = nl->len; switch (nl->type) --- 1894,1901 ---- if (!nl->touched) return SUCCESS; ! dtp->u.p.repeat_count = 0; ! eat_spaces (dtp); len = nl->len; switch (nl->type) *************** nml_read_obj (namelist_info * nl, index_ *** 1838,1849 **** case GFC_DTYPE_INTEGER: case GFC_DTYPE_LOGICAL: - case GFC_DTYPE_REAL: dlen = len; break; case GFC_DTYPE_COMPLEX: ! dlen = 2* len; break; case GFC_DTYPE_CHARACTER: --- 1903,1917 ---- case GFC_DTYPE_INTEGER: case GFC_DTYPE_LOGICAL: dlen = len; break; + case GFC_DTYPE_REAL: + dlen = size_from_real_kind (len); + break; + case GFC_DTYPE_COMPLEX: ! dlen = size_from_complex_kind (len); break; case GFC_DTYPE_CHARACTER: *************** nml_read_obj (namelist_info * nl, index_ *** 1864,1909 **** pdata = (void*)(pdata + (nl->ls[dim].idx - nl->dim[dim].lbound) * nl->dim[dim].stride * nl->size); ! /* Reset the error flag and try to read next value, if ! repeat_count=0 */ ! nml_read_error = 0; nml_carry = 0; ! if (--repeat_count <= 0) { ! if (input_complete) return SUCCESS; ! if (at_eol) ! finish_separator (); ! if (input_complete) return SUCCESS; /* GFC_TYPE_UNKNOWN through for nulls and is detected after the switch block. */ ! saved_type = GFC_DTYPE_UNKNOWN; ! free_saved (); ! switch (nl->type) { case GFC_DTYPE_INTEGER: ! read_integer (len); break; case GFC_DTYPE_LOGICAL: ! read_logical (len); break; case GFC_DTYPE_CHARACTER: ! read_character (len); break; case GFC_DTYPE_REAL: ! read_real (len); break; case GFC_DTYPE_COMPLEX: ! read_complex (len); break; case GFC_DTYPE_DERIVED: --- 1932,1977 ---- pdata = (void*)(pdata + (nl->ls[dim].idx - nl->dim[dim].lbound) * nl->dim[dim].stride * nl->size); ! /* Reset the error flag and try to read next value, if ! dtp->u.p.repeat_count=0 */ ! dtp->u.p.nml_read_error = 0; nml_carry = 0; ! if (--dtp->u.p.repeat_count <= 0) { ! if (dtp->u.p.input_complete) return SUCCESS; ! if (dtp->u.p.at_eol) ! finish_separator (dtp); ! if (dtp->u.p.input_complete) return SUCCESS; /* GFC_TYPE_UNKNOWN through for nulls and is detected after the switch block. */ ! dtp->u.p.saved_type = GFC_DTYPE_UNKNOWN; ! free_saved (dtp); ! switch (nl->type) { case GFC_DTYPE_INTEGER: ! read_integer (dtp, len); break; case GFC_DTYPE_LOGICAL: ! read_logical (dtp, len); break; case GFC_DTYPE_CHARACTER: ! read_character (dtp, len); break; case GFC_DTYPE_REAL: ! read_real (dtp, len); break; case GFC_DTYPE_COMPLEX: ! read_complex (dtp, len, dlen); break; case GFC_DTYPE_DERIVED: *************** nml_read_obj (namelist_info * nl, index_ *** 1914,1920 **** /* Now loop over the components. Update the component pointer with the return value from nml_write_obj. This loop jumps ! past nested derived types by testing if the potential component name contains '%'. */ for (cmp = nl->next; --- 1982,1988 ---- /* Now loop over the components. Update the component pointer with the return value from nml_write_obj. This loop jumps ! past nested derived types by testing if the potential component name contains '%'. */ for (cmp = nl->next; *************** nml_read_obj (namelist_info * nl, index_ *** 1924,1936 **** cmp = cmp->next) { ! if (nml_read_obj (cmp, (index_type)(pdata - nl->mem_pos)) == FAILURE) { free_mem (obj_name); return FAILURE; } ! if (input_complete) { free_mem (obj_name); return SUCCESS; --- 1992,2006 ---- cmp = cmp->next) { ! if (nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos), ! pprev_nl, nml_err_msg, clow, chigh) ! == FAILURE) { free_mem (obj_name); return FAILURE; } ! if (dtp->u.p.input_complete) { free_mem (obj_name); return SUCCESS; *************** nml_read_obj (namelist_info * nl, index_ *** 1942,1983 **** default: st_sprintf (nml_err_msg, "Bad type for namelist object %s", ! nl->var_name ); ! internal_error (nml_err_msg); goto nml_err_ret; } } /* The standard permits array data to stop short of the number of elements specified in the loop specification. In this case, we ! should be here with nml_read_error != 0. Control returns to nml_get_obj_data and an attempt is made to read object name. */ ! prev_nl = nl; ! if (nml_read_error) return SUCCESS; ! if (saved_type == GFC_DTYPE_UNKNOWN) goto incr_idx; /* Note the switch from GFC_DTYPE_type to BT_type at this point. This comes about because the read functions return BT_types. */ ! switch (saved_type) { case BT_COMPLEX: case BT_REAL: case BT_INTEGER: case BT_LOGICAL: ! memcpy (pdata, value, dlen); break; case BT_CHARACTER: ! m = (dlen < saved_used) ? dlen : saved_used; pdata = (void*)( pdata + clow - 1 ); ! memcpy (pdata, saved_string, m); if (m < dlen) memset ((void*)( pdata + m ), ' ', dlen - m); break; --- 2012,2053 ---- default: st_sprintf (nml_err_msg, "Bad type for namelist object %s", ! nl->var_name); ! internal_error (&dtp->common, nml_err_msg); goto nml_err_ret; } } /* The standard permits array data to stop short of the number of elements specified in the loop specification. In this case, we ! should be here with dtp->u.p.nml_read_error != 0. Control returns to nml_get_obj_data and an attempt is made to read object name. */ ! *pprev_nl = nl; ! if (dtp->u.p.nml_read_error) return SUCCESS; ! if (dtp->u.p.saved_type == GFC_DTYPE_UNKNOWN) goto incr_idx; /* Note the switch from GFC_DTYPE_type to BT_type at this point. This comes about because the read functions return BT_types. */ ! switch (dtp->u.p.saved_type) { case BT_COMPLEX: case BT_REAL: case BT_INTEGER: case BT_LOGICAL: ! memcpy (pdata, dtp->u.p.value, dlen); break; case BT_CHARACTER: ! m = (dlen < dtp->u.p.saved_used) ? dlen : dtp->u.p.saved_used; pdata = (void*)( pdata + clow - 1 ); ! memcpy (pdata, dtp->u.p.saved_string, m); if (m < dlen) memset ((void*)( pdata + m ), ' ', dlen - m); break; *************** incr_idx: *** 2010,2016 **** } } while (!nml_carry); ! if (repeat_count > 1) { st_sprintf (nml_err_msg, "Repeat count too large for namelist object %s" , nl->var_name ); --- 2080,2086 ---- } } while (!nml_carry); ! if (dtp->u.p.repeat_count > 1) { st_sprintf (nml_err_msg, "Repeat count too large for namelist object %s" , nl->var_name ); *************** nml_err_ret: *** 2031,2085 **** the manner specified by the object name. */ static try ! nml_get_obj_data (void) { char c; - char * ext_name; namelist_info * nl; namelist_info * first_nl = NULL; namelist_info * root_nl = NULL; int dim; int component_flag; /* Look for end of input or object name. If '?' or '=?' are encountered in stdin, print the node names or the namelist to stdout. */ ! eat_separator (); ! if (input_complete) return SUCCESS; ! if ( at_eol ) ! finish_separator (); ! if (input_complete) return SUCCESS; ! c = next_char (); switch (c) { case '=': ! c = next_char (); if (c != '?') { st_sprintf (nml_err_msg, "namelist read: missplaced = sign"); goto nml_err_ret; } ! nml_query ('='); return SUCCESS; case '?': ! nml_query ('?'); return SUCCESS; case '$': case '&': ! nml_match_name ("end", 3); ! if (nml_read_error) { st_sprintf (nml_err_msg, "namelist not terminated with / or &end"); goto nml_err_ret; } case '/': ! input_complete = 1; return SUCCESS; default : --- 2101,2157 ---- the manner specified by the object name. */ static try ! nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, ! char *nml_err_msg) { char c; namelist_info * nl; namelist_info * first_nl = NULL; namelist_info * root_nl = NULL; int dim; int component_flag; + char parse_err_msg[30]; + index_type clow, chigh; /* Look for end of input or object name. If '?' or '=?' are encountered in stdin, print the node names or the namelist to stdout. */ ! eat_separator (dtp); ! if (dtp->u.p.input_complete) return SUCCESS; ! if (dtp->u.p.at_eol) ! finish_separator (dtp); ! if (dtp->u.p.input_complete) return SUCCESS; ! c = next_char (dtp); switch (c) { case '=': ! c = next_char (dtp); if (c != '?') { st_sprintf (nml_err_msg, "namelist read: missplaced = sign"); goto nml_err_ret; } ! nml_query (dtp, '='); return SUCCESS; case '?': ! nml_query (dtp, '?'); return SUCCESS; case '$': case '&': ! nml_match_name (dtp, "end", 3); ! if (dtp->u.p.nml_read_error) { st_sprintf (nml_err_msg, "namelist not terminated with / or &end"); goto nml_err_ret; } case '/': ! dtp->u.p.input_complete = 1; return SUCCESS; default : *************** nml_get_obj_data (void) *** 2089,2110 **** /* Untouch all nodes of the namelist and reset the flag that is set for derived type components. */ ! nml_untouch_nodes(); component_flag = 0; /* Get the object name - should '!' and '\n' be permitted separators? */ get_name: ! free_saved (); do { ! push_char(tolower(c)); ! c = next_char (); } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' )); ! unget_char (c); /* Check that the name is in the namelist and get pointer to object. Three error conditions exist: (i) An attempt is being made to --- 2161,2182 ---- /* Untouch all nodes of the namelist and reset the flag that is set for derived type components. */ ! nml_untouch_nodes (dtp); component_flag = 0; /* Get the object name - should '!' and '\n' be permitted separators? */ get_name: ! free_saved (dtp); do { ! push_char (dtp, tolower(c)); ! c = next_char (dtp); } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' )); ! unget_char (dtp, c); /* Check that the name is in the namelist and get pointer to object. Three error conditions exist: (i) An attempt is being made to *************** get_name: *** 2113,2142 **** are present for an object. (iii) gives the same error message as (i) */ ! push_char ('\0'); if (component_flag) { ! ext_name = (char*)get_mem (strlen (root_nl->var_name) ! + (saved_string ? strlen (saved_string) : 0) ! + 1); ! strcpy (ext_name, root_nl->var_name); ! strcat (ext_name, saved_string); ! nl = find_nml_node (ext_name); ! free_mem (ext_name); } else ! nl = find_nml_node (saved_string); if (nl == NULL) { ! if (nml_read_error && prev_nl) st_sprintf (nml_err_msg, "Bad data for namelist object %s", ! prev_nl->var_name); else st_sprintf (nml_err_msg, "Cannot match namelist object name %s", ! saved_string); goto nml_err_ret; } --- 2185,2217 ---- are present for an object. (iii) gives the same error message as (i) */ ! push_char (dtp, '\0'); if (component_flag) { ! size_t var_len = strlen (root_nl->var_name); ! size_t saved_len ! = dtp->u.p.saved_string ? strlen (dtp->u.p.saved_string) : 0; ! char ext_name[var_len + saved_len + 1]; ! ! memcpy (ext_name, root_nl->var_name, var_len); ! if (dtp->u.p.saved_string) ! memcpy (ext_name + var_len, dtp->u.p.saved_string, saved_len); ! ext_name[var_len + saved_len] = '\0'; ! nl = find_nml_node (dtp, ext_name); } else ! nl = find_nml_node (dtp, dtp->u.p.saved_string); if (nl == NULL) { ! if (dtp->u.p.nml_read_error && *pprev_nl) st_sprintf (nml_err_msg, "Bad data for namelist object %s", ! (*pprev_nl)->var_name); else st_sprintf (nml_err_msg, "Cannot match namelist object name %s", ! dtp->u.p.saved_string); goto nml_err_ret; } *************** get_name: *** 2156,2169 **** if (c == '(' && nl->var_rank) { ! if (nml_parse_qualifier (nl->dim, nl->ls, nl->var_rank) == FAILURE) { st_sprintf (nml_err_msg, "%s for namelist variable %s", parse_err_msg, nl->var_name); goto nml_err_ret; } ! c = next_char (); ! unget_char (c); } /* Now parse a derived type component. The root namelist_info address --- 2231,2245 ---- if (c == '(' && nl->var_rank) { ! if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank, ! parse_err_msg) == FAILURE) { st_sprintf (nml_err_msg, "%s for namelist variable %s", parse_err_msg, nl->var_name); goto nml_err_ret; } ! c = next_char (dtp); ! unget_char (dtp, c); } /* Now parse a derived type component. The root namelist_info address *************** get_name: *** 2185,2191 **** root_nl = nl; component_flag = 1; ! c = next_char (); goto get_name; } --- 2261,2267 ---- root_nl = nl; component_flag = 1; ! c = next_char (dtp); goto get_name; } *************** get_name: *** 2199,2207 **** if (c == '(' && nl->type == GFC_DTYPE_CHARACTER) { descriptor_dimension chd[1] = { {1, clow, nl->string_length} }; ! nml_loop_spec ind[1] = { {1, clow, nl->string_length, 1} }; ! if (nml_parse_qualifier (chd, ind, 1) == FAILURE) { st_sprintf (nml_err_msg, "%s for namelist variable %s", parse_err_msg, nl->var_name); --- 2275,2283 ---- if (c == '(' && nl->type == GFC_DTYPE_CHARACTER) { descriptor_dimension chd[1] = { {1, clow, nl->string_length} }; ! array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} }; ! if (nml_parse_qualifier (dtp, chd, ind, 1, parse_err_msg) == FAILURE) { st_sprintf (nml_err_msg, "%s for namelist variable %s", parse_err_msg, nl->var_name); *************** get_name: *** 2219,2226 **** goto nml_err_ret; } ! c = next_char (); ! unget_char (c); } /* If a derived type touch its components and restore the root --- 2295,2302 ---- goto nml_err_ret; } ! c = next_char (dtp); ! unget_char (dtp, c); } /* If a derived type touch its components and restore the root *************** get_name: *** 2243,2262 **** /* According to the standard, an equal sign MUST follow an object name. The following is possibly lax - it allows comments, blank lines and so on to ! intervene. eat_spaces (); c = next_char (); would be compliant*/ ! free_saved (); ! eat_separator (); ! if (input_complete) return SUCCESS; ! if (at_eol) ! finish_separator (); ! if (input_complete) return SUCCESS; ! c = next_char (); if (c != '=') { --- 2319,2338 ---- /* According to the standard, an equal sign MUST follow an object name. The following is possibly lax - it allows comments, blank lines and so on to ! intervene. eat_spaces (dtp); c = next_char (dtp); would be compliant*/ ! free_saved (dtp); ! eat_separator (dtp); ! if (dtp->u.p.input_complete) return SUCCESS; ! if (dtp->u.p.at_eol) ! finish_separator (dtp); ! if (dtp->u.p.input_complete) return SUCCESS; ! c = next_char (dtp); if (c != '=') { *************** get_name: *** 2265,2271 **** goto nml_err_ret; } ! if (nml_read_obj (nl, 0) == FAILURE) goto nml_err_ret; return SUCCESS; --- 2341,2347 ---- goto nml_err_ret; } ! if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, clow, chigh) == FAILURE) goto nml_err_ret; return SUCCESS; *************** nml_err_ret: *** 2280,2295 **** completed or there is an error. */ void ! namelist_read (void) { char c; ! namelist_mode = 1; ! input_complete = 0; ! if (setjmp (g.eof_jump)) { ! generate_error (ERROR_END, NULL); return; } --- 2356,2379 ---- completed or there is an error. */ void ! namelist_read (st_parameter_dt *dtp) { char c; + jmp_buf eof_jump; + char nml_err_msg[100]; + /* Pointer to the previously read object, in case attempt is made to read + new object name. Should this fail, error message can give previous + name. */ + namelist_info *prev_nl = NULL; ! dtp->u.p.namelist_mode = 1; ! dtp->u.p.input_complete = 0; ! dtp->u.p.eof_jump = &eof_jump; ! if (setjmp (eof_jump)) { ! dtp->u.p.eof_jump = NULL; ! generate_error (&dtp->common, ERROR_END, NULL); return; } *************** namelist_read (void) *** 2298,2319 **** node names or namelist on stdout. */ find_nml_name: ! switch (c = next_char ()) { case '$': case '&': break; case '=': ! c = next_char (); if (c == '?') ! nml_query ('='); else ! unget_char (c); goto find_nml_name; case '?': ! nml_query ('?'); default: goto find_nml_name; --- 2382,2403 ---- node names or namelist on stdout. */ find_nml_name: ! switch (c = next_char (dtp)) { case '$': case '&': break; case '=': ! c = next_char (dtp); if (c == '?') ! nml_query (dtp, '='); else ! unget_char (dtp, c); goto find_nml_name; case '?': ! nml_query (dtp, '?'); default: goto find_nml_name; *************** find_nml_name: *** 2321,2353 **** /* Match the name of the namelist. */ ! nml_match_name (ioparm.namelist_name, ioparm.namelist_name_len); ! if (nml_read_error) goto find_nml_name; /* Ready to read namelist objects. If there is an error in input from stdin, output the error message and continue. */ ! while (!input_complete) { ! if (nml_get_obj_data () == FAILURE) { ! if (current_unit->unit_number != options.stdin_unit) goto nml_err_ret; st_printf ("%s\n", nml_err_msg); ! flush (find_unit (options.stderr_unit)->s); } } return; /* All namelist error calls return from here */ nml_err_ret: ! generate_error (ERROR_READ_VALUE , nml_err_msg); return; } --- 2405,2448 ---- /* Match the name of the namelist. */ ! nml_match_name (dtp, dtp->namelist_name, dtp->namelist_name_len); ! if (dtp->u.p.nml_read_error) goto find_nml_name; /* Ready to read namelist objects. If there is an error in input from stdin, output the error message and continue. */ ! while (!dtp->u.p.input_complete) { ! if (nml_get_obj_data (dtp, &prev_nl, nml_err_msg) == FAILURE) { ! gfc_unit *u; ! ! if (dtp->u.p.current_unit->unit_number != options.stdin_unit) goto nml_err_ret; + u = find_unit (options.stderr_unit); st_printf ("%s\n", nml_err_msg); ! if (u != NULL) ! { ! flush (u->s); ! unlock_unit (u); ! } } } + dtp->u.p.eof_jump = NULL; + free_saved (dtp); return; /* All namelist error calls return from here */ nml_err_ret: ! dtp->u.p.eof_jump = NULL; ! free_saved (dtp); ! generate_error (&dtp->common, ERROR_READ_VALUE, nml_err_msg); return; } diff -Nrcpad gcc-4.0.2/libgfortran/io/lock.c gcc-4.1.0/libgfortran/io/lock.c *** gcc-4.0.2/libgfortran/io/lock.c Mon Aug 29 20:48:35 2005 --- gcc-4.1.0/libgfortran/io/lock.c Tue Nov 22 10:58:47 2005 *************** GNU General Public License for more deta *** 25,85 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include "libgfortran.h" #include "io.h" - st_parameter ioparm = { }; - iexport_data(ioparm); - - namelist_info *ionml = 0; - global_t g = { }; - - /* library_start()-- Called with a library call is entered. */ void ! library_start (void) { ! if (g.in_library) ! internal_error ("Recursive library calls not allowed"); ! ! /* The in_library flag indicates whether we're currently processing a ! library call. Some calls leave immediately, but READ and WRITE ! processing return control to the caller but are still considered to ! stay within the library. */ ! g.in_library = 1; ! ! if (ioparm.iostat != NULL) ! *ioparm.iostat = ERROR_OK; ! ioparm.library_return = LIBRARY_OK; } - /* library_end()-- Called when a library call is complete in order to - clean up for the next call. */ - void ! library_end (void) { - int t; namelist_info * t1, *t2; - g.in_library = 0; - filename = NULL; - line = 0; - t = ioparm.library_return; - /* Delete the namelist, if it exists. */ ! if (ionml != NULL) { ! t1 = ionml; while (t1 != NULL) { t2 = t1; --- 25,60 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include "libgfortran.h" #include "io.h" /* library_start()-- Called with a library call is entered. */ void ! library_start (st_parameter_common *cmp) { ! if ((cmp->flags & IOPARM_HAS_IOSTAT) != 0) ! *cmp->iostat = ERROR_OK; ! cmp->flags &= ~IOPARM_LIBRETURN_MASK; } void ! free_ionml (st_parameter_dt *dtp) { namelist_info * t1, *t2; /* Delete the namelist, if it exists. */ ! if (dtp->u.p.ionml != NULL) { ! t1 = dtp->u.p.ionml; while (t1 != NULL) { t2 = t1; *************** library_end (void) *** 93,100 **** free_mem (t2); } } ! ionml = NULL; ! ! memset (&ioparm, '\0', sizeof (ioparm)); ! ioparm.library_return = t; } --- 68,72 ---- free_mem (t2); } } ! dtp->u.p.ionml = NULL; } diff -Nrcpad gcc-4.0.2/libgfortran/io/open.c gcc-4.1.0/libgfortran/io/open.c *** gcc-4.0.2/libgfortran/io/open.c Thu May 12 19:10:57 2005 --- gcc-4.1.0/libgfortran/io/open.c Wed Feb 8 20:14:00 2006 *************** *** 1,4 **** ! /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005 ! Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- 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. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,101 **** #include "io.h" ! static st_option access_opt[] = { {"sequential", ACCESS_SEQUENTIAL}, {"direct", ACCESS_DIRECT}, ! {NULL} }; ! static st_option action_opt[] = { { "read", ACTION_READ}, { "write", ACTION_WRITE}, { "readwrite", ACTION_READWRITE}, ! { NULL} }; ! static st_option blank_opt[] = { { "null", BLANK_NULL}, { "zero", BLANK_ZERO}, ! { NULL} }; ! static st_option delim_opt[] = { { "none", DELIM_NONE}, { "apostrophe", DELIM_APOSTROPHE}, { "quote", DELIM_QUOTE}, ! { NULL} }; ! static st_option form_opt[] = { { "formatted", FORM_FORMATTED}, { "unformatted", FORM_UNFORMATTED}, ! { NULL} }; ! static st_option position_opt[] = { { "asis", POSITION_ASIS}, { "rewind", POSITION_REWIND}, { "append", POSITION_APPEND}, ! { NULL} }; ! static st_option status_opt[] = { { "unknown", STATUS_UNKNOWN}, { "old", STATUS_OLD}, { "new", STATUS_NEW}, { "replace", STATUS_REPLACE}, { "scratch", STATUS_SCRATCH}, ! { NULL} }; ! static st_option pad_opt[] = { { "yes", PAD_YES}, { "no", PAD_NO}, ! { NULL} }; /* Given a unit, test to see if the file is positioned at the terminal point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE. --- 36,111 ---- #include "io.h" ! static const st_option access_opt[] = { {"sequential", ACCESS_SEQUENTIAL}, {"direct", ACCESS_DIRECT}, ! {"append", ACCESS_APPEND}, ! {NULL, 0} }; ! static const st_option action_opt[] = { { "read", ACTION_READ}, { "write", ACTION_WRITE}, { "readwrite", ACTION_READWRITE}, ! { NULL, 0} }; ! static const st_option blank_opt[] = { { "null", BLANK_NULL}, { "zero", BLANK_ZERO}, ! { NULL, 0} }; ! static const st_option delim_opt[] = { { "none", DELIM_NONE}, { "apostrophe", DELIM_APOSTROPHE}, { "quote", DELIM_QUOTE}, ! { NULL, 0} }; ! static const st_option form_opt[] = { { "formatted", FORM_FORMATTED}, { "unformatted", FORM_UNFORMATTED}, ! { NULL, 0} }; ! static const st_option position_opt[] = { { "asis", POSITION_ASIS}, { "rewind", POSITION_REWIND}, { "append", POSITION_APPEND}, ! { NULL, 0} }; ! static const st_option status_opt[] = { { "unknown", STATUS_UNKNOWN}, { "old", STATUS_OLD}, { "new", STATUS_NEW}, { "replace", STATUS_REPLACE}, { "scratch", STATUS_SCRATCH}, ! { NULL, 0} }; ! static const st_option pad_opt[] = { { "yes", PAD_YES}, { "no", PAD_NO}, ! { NULL, 0} }; + static const st_option convert_opt[] = + { + { "native", CONVERT_NATIVE}, + { "swap", CONVERT_SWAP}, + { "big_endian", CONVERT_BIG}, + { "little_endian", CONVERT_LITTLE}, + { NULL, 0} + }; /* Given a unit, test to see if the file is positioned at the terminal point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE. *************** test_endfile (gfc_unit * u) *** 114,169 **** changed. */ static void ! edit_modes (gfc_unit * u, unit_flags * flags) { /* Complain about attempts to change the unchangeable. */ if (flags->status != STATUS_UNSPECIFIED && ! u->flags.status != flags->position) ! generate_error (ERROR_BAD_OPTION, "Cannot change STATUS parameter in OPEN statement"); if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access) ! generate_error (ERROR_BAD_OPTION, "Cannot change ACCESS parameter in OPEN statement"); if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form) ! generate_error (ERROR_BAD_OPTION, "Cannot change FORM parameter in OPEN statement"); ! if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl) ! generate_error (ERROR_BAD_OPTION, "Cannot change RECL parameter in OPEN statement"); if (flags->action != ACTION_UNSPECIFIED && u->flags.access != flags->access) ! generate_error (ERROR_BAD_OPTION, "Cannot change ACTION parameter in OPEN statement"); /* Status must be OLD if present. */ ! if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD) ! generate_error (ERROR_BAD_OPTION, ! "OPEN statement must have a STATUS of OLD"); if (u->flags.form == FORM_UNFORMATTED) { if (flags->delim != DELIM_UNSPECIFIED) ! generate_error (ERROR_OPTION_CONFLICT, "DELIM parameter conflicts with UNFORMATTED form in " "OPEN statement"); if (flags->blank != BLANK_UNSPECIFIED) ! generate_error (ERROR_OPTION_CONFLICT, "BLANK parameter conflicts with UNFORMATTED form in " "OPEN statement"); if (flags->pad != PAD_UNSPECIFIED) ! generate_error (ERROR_OPTION_CONFLICT, "PAD paramter conflicts with UNFORMATTED form in " "OPEN statement"); } ! if (ioparm.library_return == LIBRARY_OK) { /* Change the changeable: */ if (flags->blank != BLANK_UNSPECIFIED) --- 124,181 ---- changed. */ static void ! edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) { /* Complain about attempts to change the unchangeable. */ if (flags->status != STATUS_UNSPECIFIED && ! u->flags.status != flags->status) ! generate_error (&opp->common, ERROR_BAD_OPTION, "Cannot change STATUS parameter in OPEN statement"); if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access) ! generate_error (&opp->common, ERROR_BAD_OPTION, "Cannot change ACCESS parameter in OPEN statement"); if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form) ! generate_error (&opp->common, ERROR_BAD_OPTION, "Cannot change FORM parameter in OPEN statement"); ! if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) ! && opp->recl_in != u->recl) ! generate_error (&opp->common, ERROR_BAD_OPTION, "Cannot change RECL parameter in OPEN statement"); if (flags->action != ACTION_UNSPECIFIED && u->flags.access != flags->access) ! generate_error (&opp->common, ERROR_BAD_OPTION, "Cannot change ACTION parameter in OPEN statement"); /* Status must be OLD if present. */ ! if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && ! flags->status != STATUS_UNKNOWN) ! generate_error (&opp->common, ERROR_BAD_OPTION, ! "OPEN statement must have a STATUS of OLD or UNKNOWN"); if (u->flags.form == FORM_UNFORMATTED) { if (flags->delim != DELIM_UNSPECIFIED) ! generate_error (&opp->common, ERROR_OPTION_CONFLICT, "DELIM parameter conflicts with UNFORMATTED form in " "OPEN statement"); if (flags->blank != BLANK_UNSPECIFIED) ! generate_error (&opp->common, ERROR_OPTION_CONFLICT, "BLANK parameter conflicts with UNFORMATTED form in " "OPEN statement"); if (flags->pad != PAD_UNSPECIFIED) ! generate_error (&opp->common, ERROR_OPTION_CONFLICT, "PAD paramter conflicts with UNFORMATTED form in " "OPEN statement"); } ! if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK) { /* Change the changeable: */ if (flags->blank != BLANK_UNSPECIFIED) *************** edit_modes (gfc_unit * u, unit_flags * f *** 201,218 **** break; seek_error: ! generate_error (ERROR_OS, NULL); break; } } /* Open an unused unit. */ ! void ! new_unit (unit_flags * flags) { ! gfc_unit *u; stream *s; char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */]; --- 213,232 ---- break; seek_error: ! generate_error (&opp->common, ERROR_OS, NULL); break; } + + unlock_unit (u); } /* Open an unused unit. */ ! gfc_unit * ! new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) { ! gfc_unit *u2; stream *s; char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */]; *************** new_unit (unit_flags * flags) *** 234,243 **** { if (flags->form == FORM_UNFORMATTED) { ! generate_error (ERROR_OPTION_CONFLICT, "DELIM parameter conflicts with UNFORMATTED form in " "OPEN statement"); ! goto cleanup; } } --- 248,257 ---- { if (flags->form == FORM_UNFORMATTED) { ! generate_error (&opp->common, ERROR_OPTION_CONFLICT, "DELIM parameter conflicts with UNFORMATTED form in " "OPEN statement"); ! goto fail; } } *************** new_unit (unit_flags * flags) *** 247,256 **** { if (flags->form == FORM_UNFORMATTED) { ! generate_error (ERROR_OPTION_CONFLICT, "BLANK parameter conflicts with UNFORMATTED form in " "OPEN statement"); ! goto cleanup; } } --- 261,270 ---- { if (flags->form == FORM_UNFORMATTED) { ! generate_error (&opp->common, ERROR_OPTION_CONFLICT, "BLANK parameter conflicts with UNFORMATTED form in " "OPEN statement"); ! goto fail; } } *************** new_unit (unit_flags * flags) *** 260,278 **** { if (flags->form == FORM_UNFORMATTED) { ! generate_error (ERROR_OPTION_CONFLICT, "PAD paramter conflicts with UNFORMATTED form in " "OPEN statement"); ! goto cleanup; } } if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT) { ! generate_error (ERROR_OPTION_CONFLICT, "ACCESS parameter conflicts with SEQUENTIAL access in " "OPEN statement"); ! goto cleanup; } else if (flags->position == POSITION_UNSPECIFIED) --- 274,292 ---- { if (flags->form == FORM_UNFORMATTED) { ! generate_error (&opp->common, ERROR_OPTION_CONFLICT, "PAD paramter conflicts with UNFORMATTED form in " "OPEN statement"); ! goto fail; } } if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT) { ! generate_error (&opp->common, ERROR_OPTION_CONFLICT, "ACCESS parameter conflicts with SEQUENTIAL access in " "OPEN statement"); ! goto fail; } else if (flags->position == POSITION_UNSPECIFIED) *************** new_unit (unit_flags * flags) *** 284,347 **** /* Checks. */ ! if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0) { ! generate_error (ERROR_MISSING_OPTION, "Missing RECL parameter in OPEN statement"); ! goto cleanup; } ! if (ioparm.recl_in != 0 && ioparm.recl_in <= 0) { ! generate_error (ERROR_BAD_OPTION, "RECL parameter is non-positive in OPEN statement"); ! goto cleanup; } switch (flags->status) { case STATUS_SCRATCH: ! if (ioparm.file == NULL) ! break; ! generate_error (ERROR_BAD_OPTION, "FILE parameter must not be present in OPEN statement"); ! return; case STATUS_OLD: case STATUS_NEW: case STATUS_REPLACE: case STATUS_UNKNOWN: ! if (ioparm.file != NULL) break; ! ioparm.file = tmpname; ! ioparm.file_len = sprintf(ioparm.file, "fort.%d", ioparm.unit); break; default: ! internal_error ("new_unit(): Bad status"); } /* Make sure the file isn't already open someplace else. Do not error if opening file preconnected to stdin, stdout, stderr. */ ! u = find_file (); ! if (u != NULL ! && (options.stdin_unit < 0 || u->unit_number != options.stdin_unit) ! && (options.stdout_unit < 0 || u->unit_number != options.stdout_unit) ! && (options.stderr_unit < 0 || u->unit_number != options.stderr_unit)) { ! generate_error (ERROR_ALREADY_OPEN, NULL); goto cleanup; } /* Open file. */ ! s = open_external (flags); if (s == NULL) { ! generate_error (ERROR_OS, NULL); goto cleanup; } --- 298,371 ---- /* Checks. */ ! if (flags->access == ACCESS_DIRECT ! && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0) { ! generate_error (&opp->common, ERROR_MISSING_OPTION, "Missing RECL parameter in OPEN statement"); ! goto fail; } ! if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0) { ! generate_error (&opp->common, ERROR_BAD_OPTION, "RECL parameter is non-positive in OPEN statement"); ! goto fail; } switch (flags->status) { case STATUS_SCRATCH: ! if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) ! { ! opp->file = NULL; ! break; ! } ! generate_error (&opp->common, ERROR_BAD_OPTION, "FILE parameter must not be present in OPEN statement"); ! goto fail; case STATUS_OLD: case STATUS_NEW: case STATUS_REPLACE: case STATUS_UNKNOWN: ! if ((opp->common.flags & IOPARM_OPEN_HAS_FILE)) break; ! opp->file = tmpname; ! opp->file_len = sprintf(opp->file, "fort.%d", opp->common.unit); break; default: ! internal_error (&opp->common, "new_unit(): Bad status"); } /* Make sure the file isn't already open someplace else. Do not error if opening file preconnected to stdin, stdout, stderr. */ ! u2 = NULL; ! if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0) ! u2 = find_file (opp->file, opp->file_len); ! if (u2 != NULL ! && (options.stdin_unit < 0 || u2->unit_number != options.stdin_unit) ! && (options.stdout_unit < 0 || u2->unit_number != options.stdout_unit) ! && (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit)) { ! unlock_unit (u2); ! generate_error (&opp->common, ERROR_ALREADY_OPEN, NULL); goto cleanup; } + if (u2 != NULL) + unlock_unit (u2); + /* Open file. */ ! s = open_external (opp, flags); if (s == NULL) { ! generate_error (&opp->common, ERROR_OS, NULL); goto cleanup; } *************** new_unit (unit_flags * flags) *** 350,401 **** /* Create the unit structure. */ ! u = get_mem (sizeof (gfc_unit) + ioparm.file_len); ! memset (u, '\0', sizeof (gfc_unit) + ioparm.file_len); ! ! u->unit_number = ioparm.unit; u->s = s; u->flags = *flags; if (flags->position == POSITION_APPEND) ! { ! if (sseek (u->s, file_length (u->s)) == FAILURE) ! generate_error (ERROR_OS, NULL); ! u->endfile = AT_ENDFILE; ! } /* Unspecified recl ends up with a processor dependent value. */ ! u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : g.max_offset; ! u->last_record = 0; ! u->current_record = 0; /* If the file is direct access, calculate the maximum record number via a division now instead of letting the multiplication overflow later. */ if (flags->access == ACCESS_DIRECT) ! u->maxrec = g.max_offset / u->recl; ! ! memmove (u->file, ioparm.file, ioparm.file_len); ! u->file_len = ioparm.file_len; ! insert_unit (u); ! /* The file is now connected. Errors after this point leave the ! file connected. Curiously, the standard requires that the position specifier be ignored for new files so a newly connected file starts out that the initial point. We still need to figure out if the file is at the end or not. */ test_endfile (u); cleanup: /* Free memory associated with a temporary filename. */ ! if (flags->status == STATUS_SCRATCH) ! free_mem (ioparm.file); } --- 374,438 ---- /* Create the unit structure. */ ! u->file = get_mem (opp->file_len); ! if (u->unit_number != opp->common.unit) ! internal_error (&opp->common, "Unit number changed"); u->s = s; u->flags = *flags; + u->read_bad = 0; + u->endfile = NO_ENDFILE; + u->last_record = 0; + u->current_record = 0; + u->mode = READING; + u->maxrec = 0; + u->bytes_left = 0; if (flags->position == POSITION_APPEND) ! { ! if (sseek (u->s, file_length (u->s)) == FAILURE) ! generate_error (&opp->common, ERROR_OS, NULL); ! u->endfile = AT_ENDFILE; ! } /* Unspecified recl ends up with a processor dependent value. */ ! if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) ! u->recl = opp->recl_in; ! else ! u->recl = max_offset; /* If the file is direct access, calculate the maximum record number via a division now instead of letting the multiplication overflow later. */ if (flags->access == ACCESS_DIRECT) ! u->maxrec = max_offset / u->recl; ! memmove (u->file, opp->file, opp->file_len); ! u->file_len = opp->file_len; ! /* Curiously, the standard requires that the position specifier be ignored for new files so a newly connected file starts out that the initial point. We still need to figure out if the file is at the end or not. */ test_endfile (u); + if (flags->status == STATUS_SCRATCH && opp->file != NULL) + free_mem (opp->file); + return u; + cleanup: /* Free memory associated with a temporary filename. */ ! if (flags->status == STATUS_SCRATCH && opp->file != NULL) ! free_mem (opp->file); ! ! fail: ! ! close_unit (u); ! return NULL; } *************** new_unit (unit_flags * flags) *** 403,505 **** modes or closing what is there now and opening the new file. */ static void ! already_open (gfc_unit * u, unit_flags * flags) { ! if (ioparm.file == NULL) { ! edit_modes (u, flags); return; } /* If the file is connected to something else, close it and open a new unit. */ ! if (!compare_file_filename (u->s, ioparm.file, ioparm.file_len)) { ! if (close_unit (u)) { ! generate_error (ERROR_OS, "Error closing file in OPEN statement"); return; } ! new_unit (flags); return; } ! edit_modes (u, flags); } /* Open file. */ ! extern void st_open (void); export_proto(st_open); void ! st_open (void) { unit_flags flags; gfc_unit *u = NULL; ! library_start (); /* Decode options. */ ! flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED : ! find_option (ioparm.access, ioparm.access_len, access_opt, ! "Bad ACCESS parameter in OPEN statement"); ! flags.action = (ioparm.action == NULL) ? ACTION_UNSPECIFIED : ! find_option (ioparm.action, ioparm.action_len, action_opt, ! "Bad ACTION parameter in OPEN statement"); ! flags.blank = (ioparm.blank == NULL) ? BLANK_UNSPECIFIED : ! find_option (ioparm.blank, ioparm.blank_len, blank_opt, ! "Bad BLANK parameter in OPEN statement"); ! flags.delim = (ioparm.delim == NULL) ? DELIM_UNSPECIFIED : ! find_option (ioparm.delim, ioparm.delim_len, delim_opt, ! "Bad DELIM parameter in OPEN statement"); ! flags.pad = (ioparm.pad == NULL) ? PAD_UNSPECIFIED : ! find_option (ioparm.pad, ioparm.pad_len, pad_opt, ! "Bad PAD parameter in OPEN statement"); ! flags.form = (ioparm.form == NULL) ? FORM_UNSPECIFIED : ! find_option (ioparm.form, ioparm.form_len, form_opt, ! "Bad FORM parameter in OPEN statement"); ! flags.position = (ioparm.position == NULL) ? POSITION_UNSPECIFIED : ! find_option (ioparm.position, ioparm.position_len, position_opt, ! "Bad POSITION parameter in OPEN statement"); ! flags.status = (ioparm.status == NULL) ? STATUS_UNSPECIFIED : ! find_option (ioparm.status, ioparm.status_len, status_opt, ! "Bad STATUS parameter in OPEN statement"); ! if (ioparm.unit < 0) ! generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement"); if (flags.position != POSITION_UNSPECIFIED && flags.access == ACCESS_DIRECT) ! generate_error (ERROR_BAD_OPTION, "Cannot use POSITION with direct access files"); if (flags.position == POSITION_UNSPECIFIED) flags.position = POSITION_ASIS; ! if (ioparm.library_return != LIBRARY_OK) ! { ! library_end (); ! return; ! } ! ! u = find_unit (ioparm.unit); ! if (u == NULL) ! new_unit (&flags); ! else ! already_open (u, &flags); library_end (); } --- 440,623 ---- modes or closing what is there now and opening the new file. */ static void ! already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) { ! if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) { ! edit_modes (opp, u, flags); return; } /* If the file is connected to something else, close it and open a new unit. */ ! if (!compare_file_filename (u, opp->file, opp->file_len)) { ! #if !HAVE_UNLINK_OPEN_FILE ! char *path = NULL; ! if (u->file && u->flags.status == STATUS_SCRATCH) { ! path = (char *) gfc_alloca (u->file_len + 1); ! unpack_filename (path, u->file, u->file_len); ! } ! #endif ! ! if (sclose (u->s) == FAILURE) ! { ! unlock_unit (u); ! generate_error (&opp->common, ERROR_OS, ! "Error closing file in OPEN statement"); return; } ! u->s = NULL; ! if (u->file) ! free_mem (u->file); ! u->file = NULL; ! u->file_len = 0; ! ! #if !HAVE_UNLINK_OPEN_FILE ! if (path != NULL) ! unlink (path); ! #endif ! ! u = new_unit (opp, u, flags); ! if (u != NULL) ! unlock_unit (u); return; } ! edit_modes (opp, u, flags); } /* Open file. */ ! extern void st_open (st_parameter_open *opp); export_proto(st_open); void ! st_open (st_parameter_open *opp) { unit_flags flags; gfc_unit *u = NULL; + GFC_INTEGER_4 cf = opp->common.flags; + unit_convert conv; ! library_start (&opp->common); /* Decode options. */ ! flags.access = !(cf & IOPARM_OPEN_HAS_ACCESS) ? ACCESS_UNSPECIFIED : ! find_option (&opp->common, opp->access, opp->access_len, ! access_opt, "Bad ACCESS parameter in OPEN statement"); ! flags.action = !(cf & IOPARM_OPEN_HAS_ACTION) ? ACTION_UNSPECIFIED : ! find_option (&opp->common, opp->action, opp->action_len, ! action_opt, "Bad ACTION parameter in OPEN statement"); ! flags.blank = !(cf & IOPARM_OPEN_HAS_BLANK) ? BLANK_UNSPECIFIED : ! find_option (&opp->common, opp->blank, opp->blank_len, ! blank_opt, "Bad BLANK parameter in OPEN statement"); ! flags.delim = !(cf & IOPARM_OPEN_HAS_DELIM) ? DELIM_UNSPECIFIED : ! find_option (&opp->common, opp->delim, opp->delim_len, ! delim_opt, "Bad DELIM parameter in OPEN statement"); ! flags.pad = !(cf & IOPARM_OPEN_HAS_PAD) ? PAD_UNSPECIFIED : ! find_option (&opp->common, opp->pad, opp->pad_len, ! pad_opt, "Bad PAD parameter in OPEN statement"); ! flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED : ! find_option (&opp->common, opp->form, opp->form_len, ! form_opt, "Bad FORM parameter in OPEN statement"); ! flags.position = !(cf & IOPARM_OPEN_HAS_POSITION) ? POSITION_UNSPECIFIED : ! find_option (&opp->common, opp->position, opp->position_len, ! position_opt, "Bad POSITION parameter in OPEN statement"); ! flags.status = !(cf & IOPARM_OPEN_HAS_STATUS) ? STATUS_UNSPECIFIED : ! find_option (&opp->common, opp->status, opp->status_len, ! status_opt, "Bad STATUS parameter in OPEN statement"); ! /* First, we check wether the convert flag has been set via environment ! variable. This overrides the convert tag in the open statement. */ ! ! conv = get_unformatted_convert (opp->common.unit); ! ! if (conv == CONVERT_NONE) ! { ! /* Nothing has been set by environment variable, check the convert tag. */ ! if (cf & IOPARM_OPEN_HAS_CONVERT) ! conv = find_option (&opp->common, opp->convert, opp->convert_len, ! convert_opt, ! "Bad CONVERT parameter in OPEN statement"); ! else ! conv = compile_options.convert; ! } ! ! /* We use l8_to_l4_offset, which is 0 on little-endian machines ! and 1 on big-endian machines. */ ! switch (conv) ! { ! case CONVERT_NATIVE: ! case CONVERT_SWAP: ! break; ! ! case CONVERT_BIG: ! conv = l8_to_l4_offset ? CONVERT_NATIVE : CONVERT_SWAP; ! break; ! ! case CONVERT_LITTLE: ! conv = l8_to_l4_offset ? CONVERT_SWAP : CONVERT_NATIVE; ! break; ! ! default: ! internal_error (&opp->common, "Illegal value for CONVERT"); ! break; ! } ! ! flags.convert = conv; ! ! if (opp->common.unit < 0) ! generate_error (&opp->common, ERROR_BAD_OPTION, ! "Bad unit number in OPEN statement"); if (flags.position != POSITION_UNSPECIFIED && flags.access == ACCESS_DIRECT) ! generate_error (&opp->common, ERROR_BAD_OPTION, "Cannot use POSITION with direct access files"); + if (flags.access == ACCESS_APPEND) + { + if (flags.position != POSITION_UNSPECIFIED + && flags.position != POSITION_APPEND) + generate_error (&opp->common, ERROR_BAD_OPTION, + "Conflicting ACCESS and POSITION flags in" + " OPEN statement"); + + notify_std (GFC_STD_GNU, + "Extension: APPEND as a value for ACCESS in OPEN statement"); + flags.access = ACCESS_SEQUENTIAL; + flags.position = POSITION_APPEND; + } + if (flags.position == POSITION_UNSPECIFIED) flags.position = POSITION_ASIS; ! if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK) ! { ! u = find_or_create_unit (opp->common.unit); ! if (u->s == NULL) ! { ! u = new_unit (opp, u, &flags); ! if (u != NULL) ! unlock_unit (u); ! } ! else ! already_open (opp, u, &flags); ! } library_end (); } diff -Nrcpad gcc-4.0.2/libgfortran/io/read.c gcc-4.1.0/libgfortran/io/read.c *** gcc-4.0.2/libgfortran/io/read.c Sat Sep 3 19:11:57 2005 --- gcc-4.1.0/libgfortran/io/read.c Fri Dec 16 20:37:28 2005 *************** *** 1,4 **** ! /* Copyright (C) 2002-2003 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! /* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" --- 24,31 ---- 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. */ #include "config.h" *************** Boston, MA 02111-1307, USA. */ *** 43,78 **** * actually place the value into memory. */ void ! set_integer (void *dest, int64_t value, int length) { switch (length) { case 8: { ! int64_t tmp = value; memcpy (dest, (void *) &tmp, length); } break; case 4: { ! int32_t tmp = value; memcpy (dest, (void *) &tmp, length); } break; case 2: { ! int16_t tmp = value; memcpy (dest, (void *) &tmp, length); } break; case 1: { ! int8_t tmp = value; memcpy (dest, (void *) &tmp, length); } break; default: ! internal_error ("Bad integer kind"); } } --- 43,86 ---- * actually place the value into memory. */ void ! set_integer (void *dest, GFC_INTEGER_LARGEST value, int length) { switch (length) { + #ifdef HAVE_GFC_INTEGER_16 + case 16: + { + GFC_INTEGER_16 tmp = value; + memcpy (dest, (void *) &tmp, length); + } + break; + #endif case 8: { ! GFC_INTEGER_8 tmp = value; memcpy (dest, (void *) &tmp, length); } break; case 4: { ! GFC_INTEGER_4 tmp = value; memcpy (dest, (void *) &tmp, length); } break; case 2: { ! GFC_INTEGER_2 tmp = value; memcpy (dest, (void *) &tmp, length); } break; case 1: { ! GFC_INTEGER_1 tmp = value; memcpy (dest, (void *) &tmp, length); } break; default: ! internal_error (NULL, "Bad integer kind"); } } *************** set_integer (void *dest, int64_t value, *** 80,92 **** /* max_value()-- Given a length (kind), return the maximum signed or * unsigned value */ ! uint64_t max_value (int length, int signed_flag) { ! uint64_t value; switch (length) { case 8: value = signed_flag ? 0x7fffffffffffffff : 0xffffffffffffffff; break; --- 88,111 ---- /* max_value()-- Given a length (kind), return the maximum signed or * unsigned value */ ! GFC_UINTEGER_LARGEST max_value (int length, int signed_flag) { ! GFC_UINTEGER_LARGEST value; ! int n; switch (length) { + #if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10 + case 16: + case 10: + value = 1; + for (n = 1; n < 4 * length; n++) + value = (value << 2) + 3; + if (! signed_flag) + value = 2*value+1; + break; + #endif case 8: value = signed_flag ? 0x7fffffffffffffff : 0xffffffffffffffff; break; *************** max_value (int length, int signed_flag) *** 100,106 **** value = signed_flag ? 0x7f : 0xff; break; default: ! internal_error ("Bad integer kind"); } return value; --- 119,125 ---- value = signed_flag ? 0x7f : 0xff; break; default: ! internal_error (NULL, "Bad integer kind"); } return value; *************** max_value (int length, int signed_flag) *** 113,119 **** * infinities. */ int ! convert_real (void *dest, const char *buffer, int length) { errno = 0; --- 132,138 ---- * infinities. */ int ! convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length) { errno = 0; *************** convert_real (void *dest, const char *bu *** 121,148 **** { case 4: { ! float tmp = #if defined(HAVE_STRTOF) strtof (buffer, NULL); #else ! (float) strtod (buffer, NULL); #endif memcpy (dest, (void *) &tmp, length); } break; case 8: { ! double tmp = strtod (buffer, NULL); memcpy (dest, (void *) &tmp, length); } break; default: ! internal_error ("Unsupported real kind during IO"); } if (errno != 0 && errno != EINVAL) { ! generate_error (ERROR_READ_VALUE, "Range error during floating point read"); return 1; } --- 140,183 ---- { case 4: { ! GFC_REAL_4 tmp = #if defined(HAVE_STRTOF) strtof (buffer, NULL); #else ! (GFC_REAL_4) strtod (buffer, NULL); #endif memcpy (dest, (void *) &tmp, length); } break; case 8: { ! GFC_REAL_8 tmp = strtod (buffer, NULL); memcpy (dest, (void *) &tmp, length); } break; + #if defined(HAVE_GFC_REAL_10) && defined (HAVE_STRTOLD) + case 10: + { + GFC_REAL_10 tmp = strtold (buffer, NULL); + memcpy (dest, (void *) &tmp, length); + } + break; + #endif + #if defined(HAVE_GFC_REAL_16) && defined (HAVE_STRTOLD) + case 16: + { + GFC_REAL_16 tmp = strtold (buffer, NULL); + memcpy (dest, (void *) &tmp, length); + } + break; + #endif default: ! internal_error (&dtp->common, "Unsupported real kind during IO"); } if (errno != 0 && errno != EINVAL) { ! generate_error (&dtp->common, ERROR_READ_VALUE, "Range error during floating point read"); return 1; } *************** convert_real (void *dest, const char *bu *** 154,166 **** /* read_l()-- Read a logical value */ void ! read_l (fnode * f, char *dest, int length) { char *p; int w; w = f->u.w; ! p = read_block (&w); if (p == NULL) return; --- 189,201 ---- /* read_l()-- Read a logical value */ void ! read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length) { char *p; int w; w = f->u.w; ! p = read_block (dtp, &w); if (p == NULL) return; *************** read_l (fnode * f, char *dest, int lengt *** 182,196 **** { case 't': case 'T': ! set_integer (dest, 1, length); break; case 'f': case 'F': ! set_integer (dest, 0, length); break; default: bad: ! generate_error (ERROR_READ_VALUE, "Bad value on logical read"); break; } } --- 217,232 ---- { case 't': case 'T': ! set_integer (dest, (GFC_INTEGER_LARGEST) 1, length); break; case 'f': case 'F': ! set_integer (dest, (GFC_INTEGER_LARGEST) 0, length); break; default: bad: ! generate_error (&dtp->common, ERROR_READ_VALUE, ! "Bad value on logical read"); break; } } *************** read_l (fnode * f, char *dest, int lengt *** 199,205 **** /* read_a()-- Read a character record. This one is pretty easy. */ void ! read_a (fnode * f, char *p, int length) { char *source; int w, m, n; --- 235,241 ---- /* read_a()-- Read a character record. This one is pretty easy. */ void ! read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length) { char *source; int w, m, n; *************** read_a (fnode * f, char *p, int length) *** 208,214 **** if (w == -1) /* '(A)' edit descriptor */ w = length; ! source = read_block (&w); if (source == NULL) return; if (w > length) --- 244,252 ---- if (w == -1) /* '(A)' edit descriptor */ w = length; ! dtp->u.p.sf_read_comma = 0; ! source = read_block (dtp, &w); ! dtp->u.p.sf_read_comma = 1; if (source == NULL) return; if (w > length) *************** eat_leading_spaces (int *width, char *p) *** 243,249 **** static char ! next_char (char **p, int *w) { char c, *q; --- 281,287 ---- static char ! next_char (st_parameter_dt *dtp, char **p, int *w) { char c, *q; *************** next_char (char **p, int *w) *** 258,264 **** if (c != ' ') return c; ! if (g.blank_status != BLANK_UNSPECIFIED) return ' '; /* return a blank to signal a null */ /* At this point, the rest of the field has to be trailing blanks */ --- 296,302 ---- if (c != ' ') return c; ! if (dtp->u.p.blank_status != BLANK_UNSPECIFIED) return ' '; /* return a blank to signal a null */ /* At this point, the rest of the field has to be trailing blanks */ *************** next_char (char **p, int *w) *** 279,299 **** * signed values. */ void ! read_decimal (fnode * f, char *dest, int length) { ! unsigned value, maxv, maxv_10; ! int v, w, negative; char c, *p; w = f->u.w; ! p = read_block (&w); if (p == NULL) return; p = eat_leading_spaces (&w, p); if (w == 0) { ! set_integer (dest, 0, length); return; } --- 317,338 ---- * signed values. */ void ! read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length) { ! GFC_UINTEGER_LARGEST value, maxv, maxv_10; ! GFC_INTEGER_LARGEST v; ! int w, negative; char c, *p; w = f->u.w; ! p = read_block (dtp, &w); if (p == NULL) return; p = eat_leading_spaces (&w, p); if (w == 0) { ! set_integer (dest, (GFC_INTEGER_LARGEST) 0, length); return; } *************** read_decimal (fnode * f, char *dest, int *** 324,337 **** for (;;) { ! c = next_char (&p, &w); if (c == '\0') break; if (c == ' ') { ! if (g.blank_status == BLANK_NULL) continue; ! if (g.blank_status == BLANK_ZERO) c = '0'; } if (c < '0' || c > '9') --- 363,376 ---- for (;;) { ! c = next_char (dtp, &p, &w); if (c == '\0') break; if (c == ' ') { ! if (dtp->u.p.blank_status == BLANK_NULL) continue; ! if (dtp->u.p.blank_status == BLANK_ZERO) c = '0'; } if (c < '0' || c > '9') *************** read_decimal (fnode * f, char *dest, int *** 348,354 **** value += c; } ! v = (signed int) value; if (negative) v = -v; --- 387,393 ---- value += c; } ! v = value; if (negative) v = -v; *************** read_decimal (fnode * f, char *dest, int *** 356,366 **** return; bad: ! generate_error (ERROR_READ_VALUE, "Bad value during integer read"); return; overflow: ! generate_error (ERROR_READ_OVERFLOW, "Value overflowed during integer read"); return; } --- 395,406 ---- return; bad: ! generate_error (&dtp->common, ERROR_READ_VALUE, ! "Bad value during integer read"); return; overflow: ! generate_error (&dtp->common, ERROR_READ_OVERFLOW, "Value overflowed during integer read"); return; } *************** read_decimal (fnode * f, char *dest, int *** 372,392 **** * the top bit is set, the value will be incorrect. */ void ! read_radix (fnode * f, char *dest, int length, int radix) { ! unsigned value, maxv, maxv_r; ! int v, w, negative; char c, *p; w = f->u.w; ! p = read_block (&w); if (p == NULL) return; p = eat_leading_spaces (&w, p); if (w == 0) { ! set_integer (dest, 0, length); return; } --- 412,434 ---- * the top bit is set, the value will be incorrect. */ void ! read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length, ! int radix) { ! GFC_UINTEGER_LARGEST value, maxv, maxv_r; ! GFC_INTEGER_LARGEST v; ! int w, negative; char c, *p; w = f->u.w; ! p = read_block (dtp, &w); if (p == NULL) return; p = eat_leading_spaces (&w, p); if (w == 0) { ! set_integer (dest, (GFC_INTEGER_LARGEST) 0, length); return; } *************** read_radix (fnode * f, char *dest, int l *** 417,429 **** for (;;) { ! c = next_char (&p, &w); if (c == '\0') break; if (c == ' ') { ! if (g.blank_status == BLANK_NULL) continue; ! if (g.blank_status == BLANK_ZERO) c = '0'; } switch (radix) --- 459,471 ---- for (;;) { ! c = next_char (dtp, &p, &w); if (c == '\0') break; if (c == ' ') { ! if (dtp->u.p.blank_status == BLANK_NULL) continue; ! if (dtp->u.p.blank_status == BLANK_ZERO) c = '0'; } switch (radix) *************** read_radix (fnode * f, char *dest, int l *** 489,495 **** value += c; } ! v = (signed int) value; if (negative) v = -v; --- 531,537 ---- value += c; } ! v = value; if (negative) v = -v; *************** read_radix (fnode * f, char *dest, int l *** 497,507 **** return; bad: ! generate_error (ERROR_READ_VALUE, "Bad value during integer read"); return; overflow: ! generate_error (ERROR_READ_OVERFLOW, "Value overflowed during integer read"); return; } --- 539,550 ---- return; bad: ! generate_error (&dtp->common, ERROR_READ_VALUE, ! "Bad value during integer read"); return; overflow: ! generate_error (&dtp->common, ERROR_READ_OVERFLOW, "Value overflowed during integer read"); return; } *************** read_radix (fnode * f, char *dest, int l *** 514,520 **** the input. */ void ! read_f (fnode * f, char *dest, int length) { int w, seen_dp, exponent; int exponent_sign, val_sign; --- 557,563 ---- the input. */ void ! read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length) { int w, seen_dp, exponent; int exponent_sign, val_sign; *************** read_f (fnode * f, char *dest, int lengt *** 523,533 **** int i; char *p, *buffer; char *digits; val_sign = 1; seen_dp = 0; w = f->u.w; ! p = read_block (&w); if (p == NULL) return; --- 566,577 ---- int i; char *p, *buffer; char *digits; + char scratch[SCRATCH_SIZE]; val_sign = 1; seen_dp = 0; w = f->u.w; ! p = read_block (dtp, &w); if (p == NULL) return; *************** read_f (fnode * f, char *dest, int lengt *** 584,590 **** case '9': case ' ': ndigits++; ! *p++; w--; break; --- 628,634 ---- case '9': case ' ': ndigits++; ! p++; w--; break; *************** read_f (fnode * f, char *dest, int lengt *** 611,621 **** } /* No exponent has been seen, so we use the current scale factor */ ! exponent = -g.scale_factor; goto done; bad_float: ! generate_error (ERROR_READ_VALUE, "Bad value during floating point read"); return; /* The value read is zero */ --- 655,666 ---- } /* No exponent has been seen, so we use the current scale factor */ ! exponent = -dtp->u.p.scale_factor; goto done; bad_float: ! generate_error (&dtp->common, ERROR_READ_VALUE, ! "Bad value during floating point read"); return; /* The value read is zero */ *************** read_f (fnode * f, char *dest, int lengt *** 623,637 **** switch (length) { case 4: ! *((float *) dest) = 0.0f; break; case 8: ! *((double *) dest) = 0.0; break; default: ! internal_error ("Unsupported real kind during IO"); } return; --- 668,694 ---- switch (length) { case 4: ! *((GFC_REAL_4 *) dest) = 0; break; case 8: ! *((GFC_REAL_8 *) dest) = 0; break; + #ifdef HAVE_GFC_REAL_10 + case 10: + *((GFC_REAL_10 *) dest) = 0; + break; + #endif + + #ifdef HAVE_GFC_REAL_16 + case 16: + *((GFC_REAL_16 *) dest) = 0; + break; + #endif + default: ! internal_error (&dtp->common, "Unsupported real kind during IO"); } return; *************** read_f (fnode * f, char *dest, int lengt *** 669,689 **** p++; w--; ! if (g.blank_status == BLANK_UNSPECIFIED) /* Normal processing of exponent */ ! { while (w > 0 && isdigit (*p)) { exponent = 10 * exponent + *p - '0'; p++; w--; } ! /* Only allow trailing blanks */ while (w > 0) { if (*p != ' ') ! goto bad_float; p++; w--; } --- 726,746 ---- p++; w--; ! if (dtp->u.p.blank_status == BLANK_UNSPECIFIED) /* Normal processing of exponent */ ! { while (w > 0 && isdigit (*p)) { exponent = 10 * exponent + *p - '0'; p++; w--; } ! /* Only allow trailing blanks */ while (w > 0) { if (*p != ' ') ! goto bad_float; p++; w--; } *************** read_f (fnode * f, char *dest, int lengt *** 694,701 **** { if (*p == ' ') { ! if (g.blank_status == BLANK_ZERO) *p = '0'; ! if (g.blank_status == BLANK_NULL) { p++; w--; --- 751,758 ---- { if (*p == ' ') { ! if (dtp->u.p.blank_status == BLANK_ZERO) *p = '0'; ! if (dtp->u.p.blank_status == BLANK_NULL) { p++; w--; *************** read_f (fnode * f, char *dest, int lengt *** 754,761 **** { if (*digits == ' ') { ! if (g.blank_status == BLANK_ZERO) *digits = '0'; ! if (g.blank_status == BLANK_NULL) { digits++; continue; --- 811,818 ---- { if (*digits == ' ') { ! if (dtp->u.p.blank_status == BLANK_ZERO) *digits = '0'; ! if (dtp->u.p.blank_status == BLANK_NULL) { digits++; continue; *************** read_f (fnode * f, char *dest, int lengt *** 769,775 **** sprintf (p, "%d", exponent); /* Do the actual conversion. */ ! convert_real (dest, buffer, length); if (buffer != scratch) free_mem (buffer); --- 826,832 ---- sprintf (p, "%d", exponent); /* Do the actual conversion. */ ! convert_real (dtp, dest, buffer, length); if (buffer != scratch) free_mem (buffer); *************** read_f (fnode * f, char *dest, int lengt *** 782,793 **** * and never look at it. */ void ! read_x (int n) { ! if ((current_unit->flags.pad == PAD_NO || is_internal_unit ()) ! && current_unit->bytes_left < n) ! n = current_unit->bytes_left; if (n > 0) ! read_block (&n); } --- 839,853 ---- * and never look at it. */ void ! read_x (st_parameter_dt *dtp, int n) { ! if ((dtp->u.p.current_unit->flags.pad == PAD_NO || is_internal_unit (dtp)) ! && dtp->u.p.current_unit->bytes_left < n) ! n = dtp->u.p.current_unit->bytes_left; + dtp->u.p.sf_read_comma = 0; if (n > 0) ! read_block (dtp, &n); ! dtp->u.p.sf_read_comma = 1; ! } diff -Nrcpad gcc-4.0.2/libgfortran/io/rewind.c gcc-4.1.0/libgfortran/io/rewind.c *** gcc-4.0.2/libgfortran/io/rewind.c Sat Jun 11 20:21:40 2005 --- gcc-4.1.0/libgfortran/io/rewind.c Thu Jan 1 00:00:00 1970 *************** *** 1,78 **** - /* Copyright (C) 2002-2003 Free Software Foundation, Inc. - Contributed by Andy Vaught - - 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, 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - - #include "config.h" - #include "libgfortran.h" - #include "io.h" - - /* rewind.c-- Implement the rewind statement */ - - extern void st_rewind (void); - export_proto(st_rewind); - - void - st_rewind (void) - { - gfc_unit *u; - - library_start (); - - u = find_unit (ioparm.unit); - if (u != NULL) - { - if (u->flags.access != ACCESS_SEQUENTIAL) - generate_error (ERROR_BAD_OPTION, - "Cannot REWIND a file opened for DIRECT access"); - else - { - /* If we have been writing to the file, the last written record - is the last record in the file, so truncate the file now. - Reset to read mode so two consecutive rewind statements - don't delete the file contents. Flush buffer when switching - mode. */ - if (u->mode == WRITING) - { - flush (u->s); - struncate (u->s); - } - u->mode = READING; - u->last_record = 0; - if (sseek (u->s, 0) == FAILURE) - generate_error (ERROR_OS, NULL); - - u->endfile = NO_ENDFILE; - u->current_record = 0; - test_endfile (u); - } - /* update position for INQUIRE */ - u->flags.position = POSITION_REWIND; - } - - library_end (); - } --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/io/size_from_kind.c gcc-4.1.0/libgfortran/io/size_from_kind.c *** gcc-4.0.2/libgfortran/io/size_from_kind.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/io/size_from_kind.c Tue Nov 29 18:19:25 2005 *************** *** 0 **** --- 1,90 ---- + /* Copyright (C) 2005 Free Software Foundation, Inc. + Contributed by Janne Blomqvist + + This file is part of the GNU Fortran 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. */ + + + /* This file contains utility functions for determining the size of a + variable given its kind. */ + + #include "config.h" + #include "libgfortran.h" + #include "io.h" + + size_t + size_from_real_kind (int kind) + { + switch (kind) + { + #ifdef HAVE_GFC_REAL_4 + case 4: + return sizeof (GFC_REAL_4); + #endif + #ifdef HAVE_GFC_REAL_8 + case 8: + return sizeof (GFC_REAL_8); + #endif + #ifdef HAVE_GFC_REAL_10 + case 10: + return sizeof (GFC_REAL_10); + #endif + #ifdef HAVE_GFC_REAL_16 + case 16: + return sizeof (GFC_REAL_16); + #endif + default: + return kind; + } + } + + + size_t + size_from_complex_kind (int kind) + { + switch (kind) + { + #ifdef HAVE_GFC_COMPLEX_4 + case 4: + return sizeof (GFC_COMPLEX_4); + #endif + #ifdef HAVE_GFC_COMPLEX_8 + case 8: + return sizeof (GFC_COMPLEX_8); + #endif + #ifdef HAVE_GFC_COMPLEX_10 + case 10: + return sizeof (GFC_COMPLEX_10); + #endif + #ifdef HAVE_GFC_COMPLEX_16 + case 16: + return sizeof (GFC_COMPLEX_16); + #endif + default: + return 2 * kind; + } + } + diff -Nrcpad gcc-4.0.2/libgfortran/io/transfer.c gcc-4.1.0/libgfortran/io/transfer.c *** gcc-4.0.2/libgfortran/io/transfer.c Sun Sep 11 18:55:16 2005 --- gcc-4.1.0/libgfortran/io/transfer.c Tue Feb 14 20:21:15 2006 *************** *** 1,4 **** ! /* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. Contributed by Andy Vaught Namelist transfer functions contributed by Paul Thomas --- 1,4 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. Contributed by Andy Vaught Namelist transfer functions contributed by Paul Thomas *************** GNU General Public License for more deta *** 25,32 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* transfer.c -- Top level handling of data transfer statements. */ --- 25,32 ---- 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. */ /* transfer.c -- Top level handling of data transfer statements. */ *************** Boston, MA 02111-1307, USA. */ *** 63,109 **** st_write(), an error inhibits any data from actually being transferred. */ ! extern void transfer_integer (void *, int); export_proto(transfer_integer); ! extern void transfer_real (void *, int); export_proto(transfer_real); ! extern void transfer_logical (void *, int); export_proto(transfer_logical); ! extern void transfer_character (void *, int); export_proto(transfer_character); ! extern void transfer_complex (void *, int); export_proto(transfer_complex); ! gfc_unit *current_unit = NULL; ! static int sf_seen_eor = 0; ! static int eor_condition = 0; ! ! /* Maximum righthand column written to. */ ! static int max_pos; ! /* Number of skips + spaces to be done for T and X-editing. */ ! static int skips; ! /* Number of spaces to be done for T and X-editing. */ ! static int pending_spaces; ! ! char scratch[SCRATCH_SIZE] = { }; ! static char *line_buffer = NULL; ! ! static unit_advance advance_status; ! static st_option advance_opt[] = { {"yes", ADVANCE_YES}, {"no", ADVANCE_NO}, ! {NULL} }; - static void (*transfer) (bt, void *, int); - - typedef enum { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL, FORMATTED_DIRECT, UNFORMATTED_DIRECT --- 63,94 ---- st_write(), an error inhibits any data from actually being transferred. */ ! extern void transfer_integer (st_parameter_dt *, void *, int); export_proto(transfer_integer); ! extern void transfer_real (st_parameter_dt *, void *, int); export_proto(transfer_real); ! extern void transfer_logical (st_parameter_dt *, void *, int); export_proto(transfer_logical); ! extern void transfer_character (st_parameter_dt *, void *, int); export_proto(transfer_character); ! extern void transfer_complex (st_parameter_dt *, void *, int); export_proto(transfer_complex); ! extern void transfer_array (st_parameter_dt *, gfc_array_char *, int, ! gfc_charlen_type); ! export_proto(transfer_array); ! static const st_option advance_opt[] = { {"yes", ADVANCE_YES}, {"no", ADVANCE_NO}, ! {NULL, 0} }; typedef enum { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL, FORMATTED_DIRECT, UNFORMATTED_DIRECT *************** file_mode; *** 112,129 **** static file_mode ! current_mode (void) { file_mode m; ! if (current_unit->flags.access == ACCESS_DIRECT) { ! m = current_unit->flags.form == FORM_FORMATTED ? FORMATTED_DIRECT : UNFORMATTED_DIRECT; } else { ! m = current_unit->flags.form == FORM_FORMATTED ? FORMATTED_SEQUENTIAL : UNFORMATTED_SEQUENTIAL; } --- 97,114 ---- static file_mode ! current_mode (st_parameter_dt *dtp) { file_mode m; ! if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { ! m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ? FORMATTED_DIRECT : UNFORMATTED_DIRECT; } else { ! m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ? FORMATTED_SEQUENTIAL : UNFORMATTED_SEQUENTIAL; } *************** current_mode (void) *** 148,167 **** heap. Hopefully this won't happen very often. */ static char * ! read_sf (int *length) { - static char data[SCRATCH_SIZE]; char *base, *p, *q; ! int n, readlen; if (*length > SCRATCH_SIZE) ! p = base = line_buffer = get_mem (*length); ! else ! p = base = data; /* If we have seen an eor previously, return a length of 0. The caller is responsible for correctly padding the input field. */ ! if (sf_seen_eor) { *length = 0; return base; --- 133,151 ---- heap. Hopefully this won't happen very often. */ static char * ! read_sf (st_parameter_dt *dtp, int *length) { char *base, *p, *q; ! int n, readlen, crlf; ! gfc_offset pos; if (*length > SCRATCH_SIZE) ! dtp->u.p.line_buffer = get_mem (*length); ! p = base = dtp->u.p.line_buffer; /* If we have seen an eor previously, return a length of 0. The caller is responsible for correctly padding the input field. */ ! if (dtp->u.p.sf_seen_eor) { *length = 0; return base; *************** read_sf (int *length) *** 172,185 **** do { ! if (is_internal_unit()) { ! /* readlen may be modified inside salloc_r if ! is_internal_unit() is true. */ readlen = 1; } ! q = salloc_r (current_unit->s, &readlen); if (q == NULL) break; --- 156,169 ---- do { ! if (is_internal_unit (dtp)) { ! /* readlen may be modified inside salloc_r if ! is_internal_unit (dtp) is true. */ readlen = 1; } ! q = salloc_r (dtp->u.p.current_unit->s, &readlen); if (q == NULL) break; *************** read_sf (int *length) *** 187,193 **** EOR below. */ if (readlen < 1 && n == 0) { ! generate_error (ERROR_END, NULL); return NULL; } --- 171,177 ---- EOR below. */ if (readlen < 1 && n == 0) { ! generate_error (&dtp->common, ERROR_END, NULL); return NULL; } *************** read_sf (int *length) *** 197,229 **** /* If we see an EOR during non-advancing I/O, we need to skip the rest of the I/O statement. Set the corresponding flag. */ ! if (advance_status == ADVANCE_NO || g.seen_dollar) ! eor_condition = 1; /* Without padding, terminate the I/O statement without assigning the value. With padding, the value still needs to be assigned, so we can just continue with a short read. */ ! if (current_unit->flags.pad == PAD_NO) { ! generate_error (ERROR_EOR, NULL); return NULL; } - current_unit->bytes_left = 0; *length = n; ! sf_seen_eor = 1; break; } n++; *p++ = *q; ! sf_seen_eor = 0; } while (n < *length); ! current_unit->bytes_left -= *length; ! if (ioparm.size != NULL) ! *ioparm.size += *length; return base; } --- 181,235 ---- /* If we see an EOR during non-advancing I/O, we need to skip the rest of the I/O statement. Set the corresponding flag. */ ! if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar) ! dtp->u.p.eor_condition = 1; ! ! crlf = 0; ! /* If we encounter a CR, it might be a CRLF. */ ! if (*q == '\r') /* Probably a CRLF */ ! { ! readlen = 1; ! pos = stream_offset (dtp->u.p.current_unit->s); ! q = salloc_r (dtp->u.p.current_unit->s, &readlen); ! if (*q != '\n' && readlen == 1) /* Not a CRLF after all. */ ! sseek (dtp->u.p.current_unit->s, pos); ! else ! crlf = 1; ! } /* Without padding, terminate the I/O statement without assigning the value. With padding, the value still needs to be assigned, so we can just continue with a short read. */ ! if (dtp->u.p.current_unit->flags.pad == PAD_NO) { ! generate_error (&dtp->common, ERROR_EOR, NULL); return NULL; } *length = n; ! dtp->u.p.sf_seen_eor = (crlf ? 2 : 1); break; } + /* Short circuit the read if a comma is found during numeric input. + The flag is set to zero during character reads so that commas in + strings are not ignored */ + if (*q == ',') + if (dtp->u.p.sf_read_comma == 1) + { + notify_std (GFC_STD_GNU, "Comma in formatted numeric read."); + *length = n; + break; + } n++; *p++ = *q; ! dtp->u.p.sf_seen_eor = 0; } while (n < *length); ! dtp->u.p.current_unit->bytes_left -= *length; ! if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! *dtp->size += *length; return base; } *************** read_sf (int *length) *** 233,280 **** file, advancing the current position. We return a pointer to a buffer containing the bytes. We return NULL on end of record or end of file. ! If the read is short, then it is because the current record does not have enough data to satisfy the read request and the file was opened with PAD=YES. The caller must assume tailing spaces for short reads. */ void * ! read_block (int *length) { char *source; int nread; ! if (current_unit->flags.form == FORM_FORMATTED && ! current_unit->flags.access == ACCESS_SEQUENTIAL) ! return read_sf (length); /* Special case. */ ! ! if (current_unit->bytes_left < *length) { ! if (current_unit->flags.pad == PAD_NO) { ! generate_error (ERROR_EOR, NULL); /* Not enough data left. */ return NULL; } ! *length = current_unit->bytes_left; } ! current_unit->bytes_left -= *length; nread = *length; ! source = salloc_r (current_unit->s, &nread); ! if (ioparm.size != NULL) ! *ioparm.size += nread; if (nread != *length) { /* Short read, this shouldn't happen. */ ! if (current_unit->flags.pad == PAD_YES) *length = nread; else { ! generate_error (ERROR_EOR, NULL); source = NULL; } } --- 239,287 ---- file, advancing the current position. We return a pointer to a buffer containing the bytes. We return NULL on end of record or end of file. ! If the read is short, then it is because the current record does not have enough data to satisfy the read request and the file was opened with PAD=YES. The caller must assume tailing spaces for short reads. */ void * ! read_block (st_parameter_dt *dtp, int *length) { char *source; int nread; ! if (dtp->u.p.current_unit->bytes_left < *length) { ! if (dtp->u.p.current_unit->flags.pad == PAD_NO) { ! generate_error (&dtp->common, ERROR_EOR, NULL); ! /* Not enough data left. */ return NULL; } ! *length = dtp->u.p.current_unit->bytes_left; } ! if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && ! dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) ! return read_sf (dtp, length); /* Special case. */ ! ! dtp->u.p.current_unit->bytes_left -= *length; nread = *length; ! source = salloc_r (dtp->u.p.current_unit->s, &nread); ! if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! *dtp->size += nread; if (nread != *length) { /* Short read, this shouldn't happen. */ ! if (dtp->u.p.current_unit->flags.pad == PAD_YES) *length = nread; else { ! generate_error (&dtp->common, ERROR_EOR, NULL); source = NULL; } } *************** read_block (int *length) *** 283,353 **** } /* Function for writing a block of bytes to the current file at the current position, advancing the file pointer. We are given a length and return a pointer to a buffer that the caller must (completely) fill in. Returns NULL on error. */ void * ! write_block (int length) { char *dest; ! ! if (!is_internal_unit() && current_unit->bytes_left < length) { ! generate_error (ERROR_EOR, NULL); return NULL; } ! current_unit->bytes_left -= length; ! dest = salloc_w (current_unit->s, &length); ! if (ioparm.size != NULL) ! *ioparm.size += length; return dest; } ! /* Master function for unformatted reads. */ ! static void ! unformatted_read (bt type, void *dest, int length) { ! void *source; ! int w; ! /* Transfer functions get passed the kind of the entity, so we have ! to fix this for COMPLEX data which are twice the size of their ! kind. */ ! if (type == BT_COMPLEX) ! length *= 2; ! w = length; ! source = read_block (&w); ! if (source != NULL) { ! memcpy (dest, source, w); ! if (length != w) ! memset (((char *) dest) + w, ' ', length - w); } } /* Master function for unformatted writes. */ static void ! unformatted_write (bt type, void *source, int length) { ! void *dest; ! /* Correction for kind vs. length as in unformatted_read. */ ! if (type == BT_COMPLEX) ! length *= 2; ! dest = write_block (length); ! if (dest != NULL) ! memcpy (dest, source, length); } --- 290,497 ---- } + /* Reads a block directly into application data space. */ + + static void + read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) + { + int *length; + void *data; + size_t nread; + + if (dtp->u.p.current_unit->bytes_left < *nbytes) + { + if (dtp->u.p.current_unit->flags.pad == PAD_NO) + { + /* Not enough data left. */ + generate_error (&dtp->common, ERROR_EOR, NULL); + return; + } + + *nbytes = dtp->u.p.current_unit->bytes_left; + } + + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && + dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) + { + length = (int *) nbytes; + data = read_sf (dtp, length); /* Special case. */ + memcpy (buf, data, (size_t) *length); + return; + } + + dtp->u.p.current_unit->bytes_left -= *nbytes; + + nread = *nbytes; + if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0) + { + generate_error (&dtp->common, ERROR_OS, NULL); + return; + } + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + *dtp->size += (GFC_INTEGER_4) nread; + + if (nread != *nbytes) + { /* Short read, e.g. if we hit EOF. */ + if (dtp->u.p.current_unit->flags.pad == PAD_YES) + { + memset (((char *) buf) + nread, ' ', *nbytes - nread); + *nbytes = nread; + } + else + generate_error (&dtp->common, ERROR_EOR, NULL); + } + } + + /* Function for writing a block of bytes to the current file at the current position, advancing the file pointer. We are given a length and return a pointer to a buffer that the caller must (completely) fill in. Returns NULL on error. */ void * ! write_block (st_parameter_dt *dtp, int length) { char *dest; ! ! if (dtp->u.p.current_unit->bytes_left < length) { ! generate_error (&dtp->common, ERROR_EOR, NULL); return NULL; } ! dtp->u.p.current_unit->bytes_left -= (gfc_offset) length; ! dest = salloc_w (dtp->u.p.current_unit->s, &length); ! ! if (dest == NULL) ! { ! generate_error (&dtp->common, ERROR_END, NULL); ! return NULL; ! } ! if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ! *dtp->size += length; return dest; } ! /* High level interface to swrite(), taking care of errors. */ ! static try ! write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) { ! if (dtp->u.p.current_unit->bytes_left < nbytes) ! { ! generate_error (&dtp->common, ERROR_EOR, NULL); ! return FAILURE; ! } ! dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes; ! if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0) ! { ! generate_error (&dtp->common, ERROR_OS, NULL); ! return FAILURE; ! } ! if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) { ! *dtp->size += (GFC_INTEGER_4) nbytes; ! return FAILURE; ! } ! ! return SUCCESS; ! } ! ! ! /* Master function for unformatted reads. */ ! ! static void ! unformatted_read (st_parameter_dt *dtp, bt type, ! void *dest, int kind, ! size_t size, size_t nelems) ! { ! /* Currently, character implies size=1. */ ! if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE ! || size == 1 || type == BT_CHARACTER) ! { ! size *= nelems; ! read_block_direct (dtp, dest, &size); ! } ! else ! { ! char buffer[16]; ! char *p; ! size_t i, sz; ! ! /* Break up complex into its constituent reals. */ ! if (type == BT_COMPLEX) ! { ! nelems *= 2; ! size /= 2; ! } ! p = dest; ! ! /* By now, all complex variables have been split into their ! constituent reals. For types with padding, we only need to ! read kind bytes. We don't care about the contents ! of the padding. */ ! ! sz = kind; ! for (i=0; iu.p.current_unit->flags.convert == CONVERT_NATIVE || ! size == 1 || type == BT_CHARACTER) ! { ! size *= nelems; ! write_buf (dtp, source, size); ! } ! else ! { ! char buffer[16]; ! char *p; ! size_t i, sz; ! ! /* Break up complex into its constituent reals. */ ! if (type == BT_COMPLEX) ! { ! nelems *= 2; ! size /= 2; ! } ! p = source; ! ! /* By now, all complex variables have been split into their ! constituent reals. For types with padding, we only need to ! read kind bytes. We don't care about the contents ! of the padding. */ ! ! sz = kind; ! for (i=0; iu.p.item_count, type_name (actual)); ! format_error (dtp, f, buffer); return 1; } *************** require_type (bt expected, bt actual, fn *** 442,451 **** of the next element, then comes back here to process it. */ static void ! formatted_transfer (bt type, void *p, int len) { int pos, bytes_used; ! fnode *f; format_token t; int n; int consume_data_flag; --- 586,597 ---- of the next element, then comes back here to process it. */ static void ! formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, ! size_t size) { + char scratch[SCRATCH_SIZE]; int pos, bytes_used; ! const fnode *f; format_token t; int n; int consume_data_flag; *************** formatted_transfer (bt type, void *p, in *** 454,534 **** n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2); if (type == BT_COMPLEX) ! type = BT_REAL; /* If there's an EOR condition, we simulate finalizing the transfer by doing nothing. */ ! if (eor_condition) return; for (;;) { /* If reversion has occurred and there is another real data item, then we have to move to the next record. */ ! if (g.reversion_flag && n > 0) { ! g.reversion_flag = 0; ! next_record (0); } consume_data_flag = 1 ; ! if (ioparm.library_return != LIBRARY_OK) break; ! f = next_format (); if (f == NULL) return; /* No data descriptors left (already raised). */ /* Now discharge T, TR and X movements to the right. This is delayed ! until a data producing format to supress trailing spaces. */ t = f->format; ! if (g.mode == WRITING && skips != 0 && ((n>0 && ( t == FMT_I || t == FMT_B || t == FMT_O || t == FMT_Z || t == FMT_F || t == FMT_E || t == FMT_EN || t == FMT_ES || t == FMT_G || t == FMT_L || t == FMT_A || t == FMT_D)) || t == FMT_STRING)) { ! if (skips > 0) { ! write_x (skips, pending_spaces); ! max_pos = (int)(current_unit->recl - current_unit->bytes_left); } ! if (skips < 0) { ! move_pos_offset (current_unit->s, skips); ! current_unit->bytes_left -= (gfc_offset)skips; } ! skips = pending_spaces = 0; } ! bytes_used = (int)(current_unit->recl - current_unit->bytes_left); switch (t) { case FMT_I: if (n == 0) goto need_data; ! if (require_type (BT_INTEGER, type, f)) return; ! if (g.mode == READING) ! read_decimal (f, p, len); else ! write_i (f, p, len); break; case FMT_B: if (n == 0) goto need_data; ! if (require_type (BT_INTEGER, type, f)) return; ! if (g.mode == READING) ! read_radix (f, p, len, 2); else ! write_b (f, p, len); break; --- 600,691 ---- n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2); if (type == BT_COMPLEX) ! { ! type = BT_REAL; ! size /= 2; ! } /* If there's an EOR condition, we simulate finalizing the transfer by doing nothing. */ ! if (dtp->u.p.eor_condition) return; + /* Set this flag so that commas in reads cause the read to complete before + the entire field has been read. The next read field will start right after + the comma in the stream. (Set to 0 for character reads). */ + dtp->u.p.sf_read_comma = 1; + + dtp->u.p.line_buffer = scratch; for (;;) { /* If reversion has occurred and there is another real data item, then we have to move to the next record. */ ! if (dtp->u.p.reversion_flag && n > 0) { ! dtp->u.p.reversion_flag = 0; ! next_record (dtp, 0); } consume_data_flag = 1 ; ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) break; ! f = next_format (dtp); if (f == NULL) return; /* No data descriptors left (already raised). */ /* Now discharge T, TR and X movements to the right. This is delayed ! until a data producing format to suppress trailing spaces. */ ! t = f->format; ! if (dtp->u.p.mode == WRITING && dtp->u.p.skips != 0 && ((n>0 && ( t == FMT_I || t == FMT_B || t == FMT_O || t == FMT_Z || t == FMT_F || t == FMT_E || t == FMT_EN || t == FMT_ES || t == FMT_G || t == FMT_L || t == FMT_A || t == FMT_D)) || t == FMT_STRING)) { ! if (dtp->u.p.skips > 0) { ! write_x (dtp, dtp->u.p.skips, dtp->u.p.pending_spaces); ! dtp->u.p.max_pos = (int)(dtp->u.p.current_unit->recl ! - dtp->u.p.current_unit->bytes_left); } ! if (dtp->u.p.skips < 0) { ! move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips); ! dtp->u.p.current_unit->bytes_left -= (gfc_offset) dtp->u.p.skips; } ! dtp->u.p.skips = dtp->u.p.pending_spaces = 0; } ! bytes_used = (int)(dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left); switch (t) { case FMT_I: if (n == 0) goto need_data; ! if (require_type (dtp, BT_INTEGER, type, f)) return; ! if (dtp->u.p.mode == READING) ! read_decimal (dtp, f, p, len); else ! write_i (dtp, f, p, len); break; case FMT_B: if (n == 0) goto need_data; ! if (require_type (dtp, BT_INTEGER, type, f)) return; ! if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, len, 2); else ! write_b (dtp, f, p, len); break; *************** formatted_transfer (bt type, void *p, in *** 536,545 **** if (n == 0) goto need_data; ! if (g.mode == READING) ! read_radix (f, p, len, 8); else ! write_o (f, p, len); break; --- 693,702 ---- if (n == 0) goto need_data; ! if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, len, 8); else ! write_o (dtp, f, p, len); break; *************** formatted_transfer (bt type, void *p, in *** 547,556 **** if (n == 0) goto need_data; ! if (g.mode == READING) ! read_radix (f, p, len, 16); else ! write_z (f, p, len); break; --- 704,713 ---- if (n == 0) goto need_data; ! if (dtp->u.p.mode == READING) ! read_radix (dtp, f, p, len, 16); else ! write_z (dtp, f, p, len); break; *************** formatted_transfer (bt type, void *p, in *** 558,567 **** if (n == 0) goto need_data; ! if (g.mode == READING) ! read_a (f, p, len); else ! write_a (f, p, len); break; --- 715,724 ---- if (n == 0) goto need_data; ! if (dtp->u.p.mode == READING) ! read_a (dtp, f, p, len); else ! write_a (dtp, f, p, len); break; *************** formatted_transfer (bt type, void *p, in *** 569,662 **** if (n == 0) goto need_data; ! if (g.mode == READING) ! read_l (f, p, len); else ! write_l (f, p, len); break; case FMT_D: if (n == 0) goto need_data; ! if (require_type (BT_REAL, type, f)) return; ! if (g.mode == READING) ! read_f (f, p, len); else ! write_d (f, p, len); break; case FMT_E: if (n == 0) goto need_data; ! if (require_type (BT_REAL, type, f)) return; ! if (g.mode == READING) ! read_f (f, p, len); else ! write_e (f, p, len); break; case FMT_EN: if (n == 0) goto need_data; ! if (require_type (BT_REAL, type, f)) return; ! if (g.mode == READING) ! read_f (f, p, len); else ! write_en (f, p, len); break; case FMT_ES: if (n == 0) goto need_data; ! if (require_type (BT_REAL, type, f)) return; ! if (g.mode == READING) ! read_f (f, p, len); else ! write_es (f, p, len); break; case FMT_F: if (n == 0) goto need_data; ! if (require_type (BT_REAL, type, f)) return; ! if (g.mode == READING) ! read_f (f, p, len); else ! write_f (f, p, len); break; case FMT_G: if (n == 0) goto need_data; ! if (g.mode == READING) switch (type) { case BT_INTEGER: ! read_decimal (f, p, len); break; case BT_LOGICAL: ! read_l (f, p, len); break; case BT_CHARACTER: ! read_a (f, p, len); break; case BT_REAL: ! read_f (f, p, len); break; default: goto bad_type; --- 726,819 ---- if (n == 0) goto need_data; ! if (dtp->u.p.mode == READING) ! read_l (dtp, f, p, len); else ! write_l (dtp, f, p, len); break; case FMT_D: if (n == 0) goto need_data; ! if (require_type (dtp, BT_REAL, type, f)) return; ! if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_d (dtp, f, p, len); break; case FMT_E: if (n == 0) goto need_data; ! if (require_type (dtp, BT_REAL, type, f)) return; ! if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_e (dtp, f, p, len); break; case FMT_EN: if (n == 0) goto need_data; ! if (require_type (dtp, BT_REAL, type, f)) return; ! if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_en (dtp, f, p, len); break; case FMT_ES: if (n == 0) goto need_data; ! if (require_type (dtp, BT_REAL, type, f)) return; ! if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_es (dtp, f, p, len); break; case FMT_F: if (n == 0) goto need_data; ! if (require_type (dtp, BT_REAL, type, f)) return; ! if (dtp->u.p.mode == READING) ! read_f (dtp, f, p, len); else ! write_f (dtp, f, p, len); break; case FMT_G: if (n == 0) goto need_data; ! if (dtp->u.p.mode == READING) switch (type) { case BT_INTEGER: ! read_decimal (dtp, f, p, len); break; case BT_LOGICAL: ! read_l (dtp, f, p, len); break; case BT_CHARACTER: ! read_a (dtp, f, p, len); break; case BT_REAL: ! read_f (dtp, f, p, len); break; default: goto bad_type; *************** formatted_transfer (bt type, void *p, in *** 665,696 **** switch (type) { case BT_INTEGER: ! write_i (f, p, len); break; case BT_LOGICAL: ! write_l (f, p, len); break; case BT_CHARACTER: ! write_a (f, p, len); break; case BT_REAL: ! write_d (f, p, len); break; default: bad_type: ! internal_error ("formatted_transfer(): Bad type"); } break; case FMT_STRING: consume_data_flag = 0 ; ! if (g.mode == READING) { ! format_error (f, "Constant string in input format"); return; } ! write_constant_string (f); break; /* Format codes that don't transfer data. */ --- 822,854 ---- switch (type) { case BT_INTEGER: ! write_i (dtp, f, p, len); break; case BT_LOGICAL: ! write_l (dtp, f, p, len); break; case BT_CHARACTER: ! write_a (dtp, f, p, len); break; case BT_REAL: ! write_d (dtp, f, p, len); break; default: bad_type: ! internal_error (&dtp->common, ! "formatted_transfer(): Bad type"); } break; case FMT_STRING: consume_data_flag = 0 ; ! if (dtp->u.p.mode == READING) { ! format_error (dtp, f, "Constant string in input format"); return; } ! write_constant_string (dtp, f); break; /* Format codes that don't transfer data. */ *************** formatted_transfer (bt type, void *p, in *** 698,718 **** case FMT_TR: consume_data_flag = 0 ; ! pos = bytes_used + f->u.n + skips; ! skips = f->u.n + skips; ! pending_spaces = pos - max_pos; ! /* Writes occur just before the switch on f->format, above, so that ! trailing blanks are suppressed. */ ! if (g.mode == READING) ! read_x (f->u.n); break; case FMT_TL: case FMT_T: if (f->format == FMT_TL) ! pos = bytes_used - f->u.n; else /* FMT_T */ { consume_data_flag = 0; --- 856,898 ---- case FMT_TR: consume_data_flag = 0 ; ! pos = bytes_used + f->u.n + dtp->u.p.skips; ! dtp->u.p.skips = f->u.n + dtp->u.p.skips; ! dtp->u.p.pending_spaces = pos - dtp->u.p.max_pos; ! /* Writes occur just before the switch on f->format, above, so ! that trailing blanks are suppressed, unless we are doing a ! non-advancing write in which case we want to output the blanks ! now. */ ! if (dtp->u.p.mode == WRITING ! && dtp->u.p.advance_status == ADVANCE_NO) ! { ! write_x (dtp, dtp->u.p.skips, dtp->u.p.pending_spaces); ! dtp->u.p.skips = dtp->u.p.pending_spaces = 0; ! } ! if (dtp->u.p.mode == READING) ! read_x (dtp, f->u.n); break; case FMT_TL: case FMT_T: if (f->format == FMT_TL) ! { ! ! /* Handle the special case when no bytes have been used yet. ! Cannot go below zero. */ ! if (bytes_used == 0) ! { ! dtp->u.p.pending_spaces -= f->u.n; ! dtp->u.p.pending_spaces = dtp->u.p.pending_spaces < 0 ? 0 ! : dtp->u.p.pending_spaces; ! dtp->u.p.skips -= f->u.n; ! dtp->u.p.skips = dtp->u.p.skips < 0 ? 0 : dtp->u.p.skips; ! } ! ! pos = bytes_used - f->u.n; ! } else /* FMT_T */ { consume_data_flag = 0; *************** formatted_transfer (bt type, void *p, in *** 725,791 **** bring us back again. */ pos = pos < 0 ? 0 : pos; ! skips = skips + pos - bytes_used; ! pending_spaces = pending_spaces + pos - max_pos; ! if (skips == 0) break; /* Writes occur just before the switch on f->format, above, so that trailing blanks are suppressed. */ ! if (g.mode == READING) { ! if (skips > 0) ! read_x (skips); ! if (skips < 0) { ! move_pos_offset (current_unit->s, skips); ! current_unit->bytes_left -= skips; ! skips = pending_spaces = 0; } } ! break; case FMT_S: consume_data_flag = 0 ; ! g.sign_status = SIGN_S; ! break; case FMT_SS: consume_data_flag = 0 ; ! g.sign_status = SIGN_SS; ! break; case FMT_SP: consume_data_flag = 0 ; ! g.sign_status = SIGN_SP; ! break; case FMT_BN: consume_data_flag = 0 ; ! g.blank_status = BLANK_NULL; ! break; case FMT_BZ: consume_data_flag = 0 ; ! g.blank_status = BLANK_ZERO; ! break; case FMT_P: consume_data_flag = 0 ; ! g.scale_factor = f->u.k; break; case FMT_DOLLAR: consume_data_flag = 0 ; ! g.seen_dollar = 1; break; case FMT_SLASH: consume_data_flag = 0 ; ! skips = pending_spaces = 0; ! next_record (0); break; case FMT_COLON: --- 905,991 ---- bring us back again. */ pos = pos < 0 ? 0 : pos; ! dtp->u.p.skips = dtp->u.p.skips + pos - bytes_used; ! dtp->u.p.pending_spaces = dtp->u.p.pending_spaces ! + pos - dtp->u.p.max_pos; ! if (dtp->u.p.skips == 0) break; /* Writes occur just before the switch on f->format, above, so that trailing blanks are suppressed. */ ! if (dtp->u.p.mode == READING) { ! /* Adjust everything for end-of-record condition */ ! if (dtp->u.p.sf_seen_eor && !is_internal_unit (dtp)) { ! if (dtp->u.p.sf_seen_eor == 2) ! { ! /* The EOR was a CRLF (two bytes wide). */ ! dtp->u.p.current_unit->bytes_left -= 2; ! dtp->u.p.skips -= 2; ! } ! else ! { ! /* The EOR marker was only one byte wide. */ ! dtp->u.p.current_unit->bytes_left--; ! dtp->u.p.skips--; ! } ! bytes_used = pos; ! dtp->u.p.sf_seen_eor = 0; ! } ! if (dtp->u.p.skips < 0) ! { ! move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips); ! dtp->u.p.current_unit->bytes_left ! -= (gfc_offset) dtp->u.p.skips; ! dtp->u.p.skips = dtp->u.p.pending_spaces = 0; } + else + read_x (dtp, dtp->u.p.skips); } ! break; case FMT_S: consume_data_flag = 0 ; ! dtp->u.p.sign_status = SIGN_S; ! break; case FMT_SS: consume_data_flag = 0 ; ! dtp->u.p.sign_status = SIGN_SS; ! break; case FMT_SP: consume_data_flag = 0 ; ! dtp->u.p.sign_status = SIGN_SP; ! break; case FMT_BN: consume_data_flag = 0 ; ! dtp->u.p.blank_status = BLANK_NULL; ! break; case FMT_BZ: consume_data_flag = 0 ; ! dtp->u.p.blank_status = BLANK_ZERO; ! break; case FMT_P: consume_data_flag = 0 ; ! dtp->u.p.scale_factor = f->u.k; break; case FMT_DOLLAR: consume_data_flag = 0 ; ! dtp->u.p.seen_dollar = 1; break; case FMT_SLASH: consume_data_flag = 0 ; ! dtp->u.p.skips = dtp->u.p.pending_spaces = 0; ! next_record (dtp, 0); break; case FMT_COLON: *************** formatted_transfer (bt type, void *p, in *** 799,815 **** break; default: ! internal_error ("Bad format node"); } /* Free a buffer that we had to allocate during a sequential formatted read of a block that was larger than the static buffer. */ ! if (line_buffer != NULL) { ! free_mem (line_buffer); ! line_buffer = NULL; } /* Adjust the item count and data pointer. */ --- 999,1015 ---- break; default: ! internal_error (&dtp->common, "Bad format node"); } /* Free a buffer that we had to allocate during a sequential formatted read of a block that was larger than the static buffer. */ ! if (dtp->u.p.line_buffer != scratch) { ! free_mem (dtp->u.p.line_buffer); ! dtp->u.p.line_buffer = scratch; } /* Adjust the item count and data pointer. */ *************** formatted_transfer (bt type, void *p, in *** 817,830 **** if ((consume_data_flag > 0) && (n > 0)) { n--; ! p = ((char *) p) + len; } ! if (g.mode == READING) ! skips = 0; ! pos = (int)(current_unit->recl - current_unit->bytes_left); ! max_pos = (max_pos > pos) ? max_pos : pos; } --- 1017,1030 ---- if ((consume_data_flag > 0) && (n > 0)) { n--; ! p = ((char *) p) + size; } ! if (dtp->u.p.mode == READING) ! dtp->u.p.skips = 0; ! pos = (int)(dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left); ! dtp->u.p.max_pos = (dtp->u.p.max_pos > pos) ? dtp->u.p.max_pos : pos; } *************** formatted_transfer (bt type, void *p, in *** 834,920 **** push the current format node back onto the input, then return and let the user program call us back with the data. */ need_data: ! unget_format (f); } /* Data transfer entry points. The type of the data entity is implicit in the subroutine call. This prevents us from having to share a common enum with the compiler. */ void ! transfer_integer (void *p, int kind) { ! g.item_count++; ! if (ioparm.library_return != LIBRARY_OK) return; ! transfer (BT_INTEGER, p, kind); } void ! transfer_real (void *p, int kind) { ! g.item_count++; ! if (ioparm.library_return != LIBRARY_OK) return; ! transfer (BT_REAL, p, kind); } void ! transfer_logical (void *p, int kind) { ! g.item_count++; ! if (ioparm.library_return != LIBRARY_OK) return; ! transfer (BT_LOGICAL, p, kind); } void ! transfer_character (void *p, int len) { ! g.item_count++; ! if (ioparm.library_return != LIBRARY_OK) return; ! transfer (BT_CHARACTER, p, len); } void ! transfer_complex (void *p, int kind) { ! g.item_count++; ! if (ioparm.library_return != LIBRARY_OK) return; ! transfer (BT_COMPLEX, p, kind); } /* Preposition a sequential unformatted file while reading. */ static void ! us_read (void) { char *p; int n; gfc_offset i; n = sizeof (gfc_offset); ! p = salloc_r (current_unit->s, &n); if (n == 0) ! return; /* end of file */ if (p == NULL || n != sizeof (gfc_offset)) { ! generate_error (ERROR_BAD_US, NULL); return; } ! memcpy (&i, p, sizeof (gfc_offset)); ! current_unit->bytes_left = i; } --- 1034,1259 ---- push the current format node back onto the input, then return and let the user program call us back with the data. */ need_data: ! unget_format (dtp, f); } + static void + formatted_transfer (st_parameter_dt *dtp, bt type, void *p, int kind, + size_t size, size_t nelems) + { + size_t elem; + char *tmp; + + tmp = (char *) p; + + /* Big loop over all the elements. */ + for (elem = 0; elem < nelems; elem++) + { + dtp->u.p.item_count++; + formatted_transfer_scalar (dtp, type, tmp + size*elem, kind, size); + } + } + + /* Data transfer entry points. The type of the data entity is implicit in the subroutine call. This prevents us from having to share a common enum with the compiler. */ void ! transfer_integer (st_parameter_dt *dtp, void *p, int kind) { ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; ! dtp->u.p.transfer (dtp, BT_INTEGER, p, kind, kind, 1); } void ! transfer_real (st_parameter_dt *dtp, void *p, int kind) { ! size_t size; ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; ! size = size_from_real_kind (kind); ! dtp->u.p.transfer (dtp, BT_REAL, p, kind, size, 1); } void ! transfer_logical (st_parameter_dt *dtp, void *p, int kind) { ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; ! dtp->u.p.transfer (dtp, BT_LOGICAL, p, kind, kind, 1); } void ! transfer_character (st_parameter_dt *dtp, void *p, int len) { ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; ! /* Currently we support only 1 byte chars, and the library is a bit ! confused of character kind vs. length, so we kludge it by setting ! kind = length. */ ! dtp->u.p.transfer (dtp, BT_CHARACTER, p, len, len, 1); } void ! transfer_complex (st_parameter_dt *dtp, void *p, int kind) { ! size_t size; ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; ! size = size_from_complex_kind (kind); ! dtp->u.p.transfer (dtp, BT_COMPLEX, p, kind, size, 1); ! } ! ! ! void ! transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, ! gfc_charlen_type charlen) ! { ! index_type count[GFC_MAX_DIMENSIONS]; ! index_type extent[GFC_MAX_DIMENSIONS]; ! index_type stride[GFC_MAX_DIMENSIONS]; ! index_type stride0, rank, size, type, n; ! size_t tsize; ! char *data; ! bt iotype; ! ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) ! return; ! ! type = GFC_DESCRIPTOR_TYPE (desc); ! size = GFC_DESCRIPTOR_SIZE (desc); ! ! /* FIXME: What a kludge: Array descriptors and the IO library use ! different enums for types. */ ! switch (type) ! { ! case GFC_DTYPE_UNKNOWN: ! iotype = BT_NULL; /* Is this correct? */ ! break; ! case GFC_DTYPE_INTEGER: ! iotype = BT_INTEGER; ! break; ! case GFC_DTYPE_LOGICAL: ! iotype = BT_LOGICAL; ! break; ! case GFC_DTYPE_REAL: ! iotype = BT_REAL; ! break; ! case GFC_DTYPE_COMPLEX: ! iotype = BT_COMPLEX; ! break; ! case GFC_DTYPE_CHARACTER: ! iotype = BT_CHARACTER; ! /* FIXME: Currently dtype contains the charlen, which is ! clobbered if charlen > 2**24. That's why we use a separate ! argument for the charlen. However, if we want to support ! non-8-bit charsets we need to fix dtype to contain ! sizeof(chartype) and fix the code below. */ ! size = charlen; ! kind = charlen; ! break; ! case GFC_DTYPE_DERIVED: ! internal_error (&dtp->common, ! "Derived type I/O should have been handled via the frontend."); ! break; ! default: ! internal_error (&dtp->common, "transfer_array(): Bad type"); ! } ! ! if (desc->dim[0].stride == 0) ! desc->dim[0].stride = 1; ! ! rank = GFC_DESCRIPTOR_RANK (desc); ! for (n = 0; n < rank; n++) ! { ! count[n] = 0; ! stride[n] = desc->dim[n].stride; ! extent[n] = desc->dim[n].ubound + 1 - desc->dim[n].lbound; ! ! /* If the extent of even one dimension is zero, then the entire ! array section contains zero elements, so we return. */ ! if (extent[n] == 0) ! return; ! } ! ! stride0 = stride[0]; ! ! /* If the innermost dimension has stride 1, we can do the transfer ! in contiguous chunks. */ ! if (stride0 == 1) ! tsize = extent[0]; ! else ! tsize = 1; ! ! data = GFC_DESCRIPTOR_DATA (desc); ! ! while (data) ! { ! dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize); ! data += stride0 * size * tsize; ! count[0] += tsize; ! n = 0; ! while (count[n] == extent[n]) ! { ! count[n] = 0; ! data -= stride[n] * extent[n] * size; ! n++; ! if (n == rank) ! { ! data = NULL; ! break; ! } ! else ! { ! count[n]++; ! data += stride[n] * size; ! } ! } ! } } /* Preposition a sequential unformatted file while reading. */ static void ! us_read (st_parameter_dt *dtp) { char *p; int n; gfc_offset i; + if (dtp->u.p.current_unit->endfile == AT_ENDFILE) + return; + n = sizeof (gfc_offset); ! p = salloc_r (dtp->u.p.current_unit->s, &n); if (n == 0) ! { ! dtp->u.p.current_unit->endfile = AT_ENDFILE; ! return; /* end of file */ ! } if (p == NULL || n != sizeof (gfc_offset)) { ! generate_error (&dtp->common, ERROR_BAD_US, NULL); return; } ! /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ ! if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE) ! memcpy (&i, p, sizeof (gfc_offset)); ! else ! reverse_memcpy (&i, p, sizeof (gfc_offset)); ! ! dtp->u.p.current_unit->bytes_left = i; } *************** us_read (void) *** 922,951 **** amount to writing a bogus length that will be filled in later. */ static void ! us_write (void) { ! char *p; ! int length; ! ! length = sizeof (gfc_offset); ! p = salloc_w (current_unit->s, &length); ! if (p == NULL) ! { ! generate_error (ERROR_OS, NULL); ! return; ! } ! memset (p, '\0', sizeof (gfc_offset)); /* Bogus value for now. */ ! if (sfree (current_unit->s) == FAILURE) ! generate_error (ERROR_OS, NULL); ! /* For sequential unformatted, we write until we have more bytes than ! can fit in the record markers. If disk space runs out first, it will ! error on the write. */ ! current_unit->recl = g.max_offset; ! current_unit->bytes_left = current_unit->recl; } --- 1261,1283 ---- amount to writing a bogus length that will be filled in later. */ static void ! us_write (st_parameter_dt *dtp) { ! size_t nbytes; ! gfc_offset dummy; ! dummy = 0; ! nbytes = sizeof (gfc_offset); ! if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0) ! generate_error (&dtp->common, ERROR_OS, NULL); ! /* For sequential unformatted, we write until we have more bytes ! than can fit in the record markers. If disk space runs out first, ! it will error on the write. */ ! dtp->u.p.current_unit->recl = max_offset; ! dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; } *************** us_write (void) *** 954,982 **** record. */ static void ! pre_position (void) { ! if (current_unit->current_record) return; /* Already positioned. */ ! switch (current_mode ()) { case UNFORMATTED_SEQUENTIAL: ! if (g.mode == READING) ! us_read (); else ! us_write (); break; case FORMATTED_SEQUENTIAL: case FORMATTED_DIRECT: case UNFORMATTED_DIRECT: ! current_unit->bytes_left = current_unit->recl; break; } ! current_unit->current_record = 1; } --- 1286,1314 ---- record. */ static void ! pre_position (st_parameter_dt *dtp) { ! if (dtp->u.p.current_unit->current_record) return; /* Already positioned. */ ! switch (current_mode (dtp)) { case UNFORMATTED_SEQUENTIAL: ! if (dtp->u.p.mode == READING) ! us_read (dtp); else ! us_write (dtp); break; case FORMATTED_SEQUENTIAL: case FORMATTED_DIRECT: case UNFORMATTED_DIRECT: ! dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; break; } ! dtp->u.p.current_unit->current_record = 1; } *************** pre_position (void) *** 984,1233 **** both reading and writing. */ static void ! data_transfer_init (int read_flag) { unit_flags u_flags; /* Used for creating a unit if needed. */ ! g.mode = read_flag ? READING : WRITING; ! if (ioparm.size != NULL) ! *ioparm.size = 0; /* Initialize the count. */ ! current_unit = get_unit (read_flag); ! if (current_unit == NULL) { /* Open the unit with some default flags. */ ! if (ioparm.unit < 0) { ! generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement"); ! library_end (); return; } memset (&u_flags, '\0', sizeof (u_flags)); u_flags.access = ACCESS_SEQUENTIAL; u_flags.action = ACTION_READWRITE; /* Is it unformatted? */ ! if (ioparm.format == NULL && !ioparm.list_format) u_flags.form = FORM_UNFORMATTED; else u_flags.form = FORM_UNSPECIFIED; u_flags.delim = DELIM_UNSPECIFIED; u_flags.blank = BLANK_UNSPECIFIED; u_flags.pad = PAD_UNSPECIFIED; u_flags.status = STATUS_UNKNOWN; ! new_unit(&u_flags); ! current_unit = get_unit (read_flag); } - if (current_unit == NULL) - return; - - if (is_internal_unit()) - { - current_unit->recl = file_length(current_unit->s); - if (g.mode==WRITING) - empty_internal_buffer (current_unit->s); - else - current_unit->bytes_left = current_unit->recl; - } - /* Check the action. */ ! if (read_flag && current_unit->flags.action == ACTION_WRITE) ! generate_error (ERROR_BAD_ACTION, "Cannot read from file opened for WRITE"); ! if (!read_flag && current_unit->flags.action == ACTION_READ) ! generate_error (ERROR_BAD_ACTION, "Cannot write to file opened for READ"); ! if (ioparm.library_return != LIBRARY_OK) return; /* Check the format. */ ! if (ioparm.format) ! parse_format (); ! if (ioparm.library_return != LIBRARY_OK) return; ! if (current_unit->flags.form == FORM_UNFORMATTED ! && (ioparm.format != NULL || ioparm.list_format)) ! generate_error (ERROR_OPTION_CONFLICT, "Format present for UNFORMATTED data transfer"); ! if (ioparm.namelist_name != NULL && ionml != NULL) { ! if(ioparm.format != NULL) ! generate_error (ERROR_OPTION_CONFLICT, "A format cannot be specified with a namelist"); } ! else if (current_unit->flags.form == FORM_FORMATTED && ! ioparm.format == NULL && !ioparm.list_format) ! generate_error (ERROR_OPTION_CONFLICT, "Missing format for FORMATTED data transfer"); ! if (is_internal_unit () && current_unit->flags.form == FORM_UNFORMATTED) ! generate_error (ERROR_OPTION_CONFLICT, "Internal file cannot be accessed by UNFORMATTED data transfer"); /* Check the record number. */ ! if (current_unit->flags.access == ACCESS_DIRECT && ioparm.rec == 0) { ! generate_error (ERROR_MISSING_OPTION, "Direct access data transfer requires record number"); return; } ! if (current_unit->flags.access == ACCESS_SEQUENTIAL && ioparm.rec != 0) { ! generate_error (ERROR_OPTION_CONFLICT, "Record number not allowed for sequential access data transfer"); return; } /* Process the ADVANCE option. */ ! advance_status = (ioparm.advance == NULL) ? ADVANCE_UNSPECIFIED : ! find_option (ioparm.advance, ioparm.advance_len, advance_opt, ! "Bad ADVANCE parameter in data transfer statement"); ! if (advance_status != ADVANCE_UNSPECIFIED) { ! if (current_unit->flags.access == ACCESS_DIRECT) ! generate_error (ERROR_OPTION_CONFLICT, "ADVANCE specification conflicts with sequential access"); ! if (is_internal_unit ()) ! generate_error (ERROR_OPTION_CONFLICT, "ADVANCE specification conflicts with internal file"); ! if (ioparm.format == NULL || ioparm.list_format) ! generate_error (ERROR_OPTION_CONFLICT, "ADVANCE specification requires an explicit format"); } if (read_flag) { ! if (ioparm.eor != 0 && advance_status != ADVANCE_NO) ! generate_error (ERROR_MISSING_OPTION, "EOR specification requires an ADVANCE specification of NO"); ! if (ioparm.size != NULL && advance_status != ADVANCE_NO) ! generate_error (ERROR_MISSING_OPTION, "SIZE specification requires an ADVANCE specification of NO"); } else { /* Write constraints. */ ! if (ioparm.end != 0) ! generate_error (ERROR_OPTION_CONFLICT, "END specification cannot appear in a write statement"); ! if (ioparm.eor != 0) ! generate_error (ERROR_OPTION_CONFLICT, "EOR specification cannot appear in a write statement"); ! if (ioparm.size != 0) ! generate_error (ERROR_OPTION_CONFLICT, "SIZE specification cannot appear in a write statement"); } ! if (advance_status == ADVANCE_UNSPECIFIED) ! advance_status = ADVANCE_YES; ! if (ioparm.library_return != LIBRARY_OK) return; /* Sanity checks on the record number. */ ! if (ioparm.rec) { ! if (ioparm.rec <= 0) { ! generate_error (ERROR_BAD_OPTION, "Record number must be positive"); return; } ! if (ioparm.rec >= current_unit->maxrec) { ! generate_error (ERROR_BAD_OPTION, "Record number too large"); return; } /* Check to see if we might be reading what we wrote before */ ! if (g.mode == READING && current_unit->mode == WRITING) ! flush(current_unit->s); /* Check whether the record exists to be read. Only a partial record needs to exist. */ ! if (g.mode == READING && (ioparm.rec -1) ! * current_unit->recl >= file_length (current_unit->s)) { ! generate_error (ERROR_BAD_OPTION, "Non-existing record number"); return; } /* Position the file. */ ! if (sseek (current_unit->s, ! (ioparm.rec - 1) * current_unit->recl) == FAILURE) { ! generate_error (ERROR_OS, NULL); return; } } /* Overwriting an existing sequential file ? it is always safe to truncate the file on the first write */ ! if (g.mode == WRITING ! && current_unit->flags.access == ACCESS_SEQUENTIAL ! && current_unit->last_record == 0 && !is_preconnected(current_unit->s)) ! struncate(current_unit->s); ! current_unit->mode = g.mode; /* Set the initial value of flags. */ ! g.blank_status = current_unit->flags.blank; ! g.sign_status = SIGN_S; ! g.scale_factor = 0; ! g.seen_dollar = 0; ! g.first_item = 1; ! g.item_count = 0; ! sf_seen_eor = 0; ! eor_condition = 0; ! pre_position (); /* Set up the subroutine that will handle the transfers. */ if (read_flag) { ! if (current_unit->flags.form == FORM_UNFORMATTED) ! transfer = unformatted_read; else { ! if (ioparm.list_format) ! { ! transfer = list_formatted_read; ! init_at_eol(); ! } else ! transfer = formatted_transfer; } } else { ! if (current_unit->flags.form == FORM_UNFORMATTED) ! transfer = unformatted_write; else { ! if (ioparm.list_format) ! transfer = list_formatted_write; else ! transfer = formatted_transfer; } } --- 1316,1575 ---- both reading and writing. */ static void ! data_transfer_init (st_parameter_dt *dtp, int read_flag) { unit_flags u_flags; /* Used for creating a unit if needed. */ + GFC_INTEGER_4 cf = dtp->common.flags; + namelist_info *ionml; ! ionml = ((cf & IOPARM_DT_IONML_SET) != 0) ? dtp->u.p.ionml : NULL; ! memset (&dtp->u.p, 0, sizeof (dtp->u.p)); ! dtp->u.p.ionml = ionml; ! dtp->u.p.mode = read_flag ? READING : WRITING; ! if ((cf & IOPARM_DT_HAS_SIZE) != 0) ! *dtp->size = 0; /* Initialize the count. */ ! dtp->u.p.current_unit = get_unit (dtp, 1); ! if (dtp->u.p.current_unit->s == NULL) { /* Open the unit with some default flags. */ ! st_parameter_open opp; ! if (dtp->common.unit < 0) { ! close_unit (dtp->u.p.current_unit); ! dtp->u.p.current_unit = NULL; ! generate_error (&dtp->common, ERROR_BAD_OPTION, ! "Bad unit number in OPEN statement"); return; } memset (&u_flags, '\0', sizeof (u_flags)); u_flags.access = ACCESS_SEQUENTIAL; u_flags.action = ACTION_READWRITE; + /* Is it unformatted? */ ! if (!(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT ! | IOPARM_DT_IONML_SET))) u_flags.form = FORM_UNFORMATTED; else u_flags.form = FORM_UNSPECIFIED; + u_flags.delim = DELIM_UNSPECIFIED; u_flags.blank = BLANK_UNSPECIFIED; u_flags.pad = PAD_UNSPECIFIED; u_flags.status = STATUS_UNKNOWN; ! opp.common = dtp->common; ! opp.common.flags &= IOPARM_COMMON_MASK; ! dtp->u.p.current_unit = new_unit (&opp, dtp->u.p.current_unit, &u_flags); ! dtp->common.flags &= ~IOPARM_COMMON_MASK; ! dtp->common.flags |= (opp.common.flags & IOPARM_COMMON_MASK); ! if (dtp->u.p.current_unit == NULL) ! return; } /* Check the action. */ ! if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE) ! generate_error (&dtp->common, ERROR_BAD_ACTION, "Cannot read from file opened for WRITE"); ! if (!read_flag && dtp->u.p.current_unit->flags.action == ACTION_READ) ! generate_error (&dtp->common, ERROR_BAD_ACTION, ! "Cannot write to file opened for READ"); ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; + dtp->u.p.first_item = 1; + /* Check the format. */ ! if ((cf & IOPARM_DT_HAS_FORMAT) != 0) ! parse_format (dtp); ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; ! if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED ! && (cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)) ! != 0) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "Format present for UNFORMATTED data transfer"); ! if ((cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0 && dtp->u.p.ionml != NULL) { ! if ((cf & IOPARM_DT_HAS_FORMAT) != 0) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "A format cannot be specified with a namelist"); } ! else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && ! !(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT))) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "Missing format for FORMATTED data transfer"); ! if (is_internal_unit (dtp) ! && dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "Internal file cannot be accessed by UNFORMATTED data transfer"); /* Check the record number. */ ! if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT ! && (cf & IOPARM_DT_HAS_REC) == 0) { ! generate_error (&dtp->common, ERROR_MISSING_OPTION, "Direct access data transfer requires record number"); return; } ! if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ! && (cf & IOPARM_DT_HAS_REC) != 0) { ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "Record number not allowed for sequential access data transfer"); return; } /* Process the ADVANCE option. */ ! dtp->u.p.advance_status ! = !(cf & IOPARM_DT_HAS_ADVANCE) ? ADVANCE_UNSPECIFIED : ! find_option (&dtp->common, dtp->advance, dtp->advance_len, advance_opt, ! "Bad ADVANCE parameter in data transfer statement"); ! if (dtp->u.p.advance_status != ADVANCE_UNSPECIFIED) { ! if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "ADVANCE specification conflicts with sequential access"); ! if (is_internal_unit (dtp)) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "ADVANCE specification conflicts with internal file"); ! if ((cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)) ! != IOPARM_DT_HAS_FORMAT) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "ADVANCE specification requires an explicit format"); } if (read_flag) { ! if ((cf & IOPARM_EOR) != 0 && dtp->u.p.advance_status != ADVANCE_NO) ! generate_error (&dtp->common, ERROR_MISSING_OPTION, "EOR specification requires an ADVANCE specification of NO"); ! if ((cf & IOPARM_DT_HAS_SIZE) != 0 && dtp->u.p.advance_status != ADVANCE_NO) ! generate_error (&dtp->common, ERROR_MISSING_OPTION, "SIZE specification requires an ADVANCE specification of NO"); } else { /* Write constraints. */ ! if ((cf & IOPARM_END) != 0) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "END specification cannot appear in a write statement"); ! if ((cf & IOPARM_EOR) != 0) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "EOR specification cannot appear in a write statement"); ! if ((cf & IOPARM_DT_HAS_SIZE) != 0) ! generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "SIZE specification cannot appear in a write statement"); } ! if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED) ! dtp->u.p.advance_status = ADVANCE_YES; ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; /* Sanity checks on the record number. */ ! if ((cf & IOPARM_DT_HAS_REC) != 0) { ! if (dtp->rec <= 0) { ! generate_error (&dtp->common, ERROR_BAD_OPTION, ! "Record number must be positive"); return; } ! if (dtp->rec >= dtp->u.p.current_unit->maxrec) { ! generate_error (&dtp->common, ERROR_BAD_OPTION, ! "Record number too large"); return; } /* Check to see if we might be reading what we wrote before */ ! if (dtp->u.p.mode == READING && dtp->u.p.current_unit->mode == WRITING) ! flush(dtp->u.p.current_unit->s); /* Check whether the record exists to be read. Only a partial record needs to exist. */ ! if (dtp->u.p.mode == READING && (dtp->rec -1) ! * dtp->u.p.current_unit->recl >= file_length (dtp->u.p.current_unit->s)) { ! generate_error (&dtp->common, ERROR_BAD_OPTION, ! "Non-existing record number"); return; } /* Position the file. */ ! if (sseek (dtp->u.p.current_unit->s, ! (dtp->rec - 1) * dtp->u.p.current_unit->recl) == FAILURE) { ! generate_error (&dtp->common, ERROR_OS, NULL); return; } } /* Overwriting an existing sequential file ? it is always safe to truncate the file on the first write */ ! if (dtp->u.p.mode == WRITING ! && dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ! && dtp->u.p.current_unit->last_record == 0 && !is_preconnected(dtp->u.p.current_unit->s)) ! struncate(dtp->u.p.current_unit->s); ! /* Bugware for badly written mixed C-Fortran I/O. */ ! flush_if_preconnected(dtp->u.p.current_unit->s); ! ! dtp->u.p.current_unit->mode = dtp->u.p.mode; /* Set the initial value of flags. */ ! dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank; ! dtp->u.p.sign_status = SIGN_S; ! pre_position (dtp); /* Set up the subroutine that will handle the transfers. */ if (read_flag) { ! if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) ! dtp->u.p.transfer = unformatted_read; else { ! if ((cf & IOPARM_DT_LIST_FORMAT) != 0) ! dtp->u.p.transfer = list_formatted_read; else ! dtp->u.p.transfer = formatted_transfer; } } else { ! if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) ! dtp->u.p.transfer = unformatted_write; else { ! if ((cf & IOPARM_DT_LIST_FORMAT) != 0) ! dtp->u.p.transfer = list_formatted_write; else ! dtp->u.p.transfer = formatted_transfer; } } *************** data_transfer_init (int read_flag) *** 1235,1262 **** if (read_flag) { ! if (current_unit->read_bad) { ! generate_error (ERROR_BAD_OPTION, "Cannot READ after a nonadvancing WRITE"); return; } } else { ! if (advance_status == ADVANCE_YES && !g.seen_dollar) ! current_unit->read_bad = 1; } - /* Reset counters for T and X-editing. */ - max_pos = skips = pending_spaces = 0; - /* Start the data transfer if we are doing a formatted transfer. */ ! if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format ! && ioparm.namelist_name == NULL && ionml == NULL) ! formatted_transfer (0, NULL, 0); } /* Space to the next record for read mode. If the file is not seekable, we read MAX_READ chunks until we get to the right --- 1577,1656 ---- if (read_flag) { ! if (dtp->u.p.current_unit->read_bad) { ! generate_error (&dtp->common, ERROR_BAD_OPTION, "Cannot READ after a nonadvancing WRITE"); return; } } else { ! if (dtp->u.p.advance_status == ADVANCE_YES && !dtp->u.p.seen_dollar) ! dtp->u.p.current_unit->read_bad = 1; } /* Start the data transfer if we are doing a formatted transfer. */ ! if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED ! && ((cf & (IOPARM_DT_LIST_FORMAT | IOPARM_DT_HAS_NAMELIST_NAME)) == 0) ! && dtp->u.p.ionml == NULL) ! formatted_transfer (dtp, 0, NULL, 0, 0, 1); ! } ! ! /* Initialize an array_loop_spec given the array descriptor. The function ! returns the index of the last element of the array. */ ! ! gfc_offset ! init_loop_spec (gfc_array_char *desc, array_loop_spec *ls) ! { ! int rank = GFC_DESCRIPTOR_RANK(desc); ! int i; ! gfc_offset index; ! ! index = 1; ! for (i=0; idim[i].lbound; ! ls[i].end = desc->dim[i].ubound; ! ls[i].step = desc->dim[i].stride; ! ! index += (desc->dim[i].ubound - desc->dim[i].lbound) ! * desc->dim[i].stride; ! } ! return index; } + /* Determine the index to the next record in an internal unit array by + by incrementing through the array_loop_spec. TODO: Implement handling + negative strides. */ + + gfc_offset + next_array_record (st_parameter_dt *dtp, array_loop_spec *ls) + { + int i, carry; + gfc_offset index; + + carry = 1; + index = 0; + + for (i = 0; i < dtp->u.p.current_unit->rank; i++) + { + if (carry) + { + ls[i].idx++; + if (ls[i].idx > ls[i].end) + { + ls[i].idx = ls[i].start; + carry = 1; + } + else + carry = 0; + } + index = index + (ls[i].idx - 1) * ls[i].step; + } + return index; + } /* Space to the next record for read mode. If the file is not seekable, we read MAX_READ chunks until we get to the right *************** data_transfer_init (int read_flag) *** 1265,1313 **** #define MAX_READ 4096 static void ! next_record_r (int done) { ! int rlength, length; ! gfc_offset new; char *p; ! switch (current_mode ()) { case UNFORMATTED_SEQUENTIAL: - current_unit->bytes_left += sizeof (gfc_offset); /* Skip over tail */ /* Fall through... */ case FORMATTED_DIRECT: case UNFORMATTED_DIRECT: ! if (current_unit->bytes_left == 0) break; ! if (is_seekable (current_unit->s)) { ! new = file_position (current_unit->s) + current_unit->bytes_left; ! /* Direct access files do not generate END conditions, only I/O errors. */ ! if (sseek (current_unit->s, new) == FAILURE) ! generate_error (ERROR_OS, NULL); } else { /* Seek by reading data. */ ! while (current_unit->bytes_left > 0) { ! rlength = length = (MAX_READ > current_unit->bytes_left) ? ! MAX_READ : current_unit->bytes_left; ! p = salloc_r (current_unit->s, &rlength); if (p == NULL) { ! generate_error (ERROR_OS, NULL); break; } ! current_unit->bytes_left -= length; } } break; --- 1659,1710 ---- #define MAX_READ 4096 static void ! next_record_r (st_parameter_dt *dtp) { ! gfc_offset new, record; ! int bytes_left, rlength, length; char *p; ! switch (current_mode (dtp)) { case UNFORMATTED_SEQUENTIAL: + /* Skip over tail */ + dtp->u.p.current_unit->bytes_left += sizeof (gfc_offset); + /* Fall through... */ case FORMATTED_DIRECT: case UNFORMATTED_DIRECT: ! if (dtp->u.p.current_unit->bytes_left == 0) break; ! if (is_seekable (dtp->u.p.current_unit->s)) { ! new = file_position (dtp->u.p.current_unit->s) ! + dtp->u.p.current_unit->bytes_left; ! /* Direct access files do not generate END conditions, only I/O errors. */ ! if (sseek (dtp->u.p.current_unit->s, new) == FAILURE) ! generate_error (&dtp->common, ERROR_OS, NULL); } else { /* Seek by reading data. */ ! while (dtp->u.p.current_unit->bytes_left > 0) { ! rlength = length = (MAX_READ > dtp->u.p.current_unit->bytes_left) ? ! MAX_READ : dtp->u.p.current_unit->bytes_left; ! p = salloc_r (dtp->u.p.current_unit->s, &rlength); if (p == NULL) { ! generate_error (&dtp->common, ERROR_OS, NULL); break; } ! dtp->u.p.current_unit->bytes_left -= length; } } break; *************** next_record_r (int done) *** 1315,1345 **** case FORMATTED_SEQUENTIAL: length = 1; /* sf_read has already terminated input because of an '\n' */ ! if (sf_seen_eor) { ! sf_seen_eor=0; break; } ! do { ! p = salloc_r (current_unit->s, &length); ! ! /* In case of internal file, there may not be any '\n'. */ ! if (is_internal_unit() && p == NULL) { ! break; } if (p == NULL) { ! generate_error (ERROR_OS, NULL); break; } if (length == 0) { ! current_unit->endfile = AT_ENDFILE; break; } } --- 1712,1761 ---- case FORMATTED_SEQUENTIAL: length = 1; /* sf_read has already terminated input because of an '\n' */ ! if (dtp->u.p.sf_seen_eor) { ! dtp->u.p.sf_seen_eor = 0; break; } ! if (is_internal_unit (dtp)) { ! if (is_array_io (dtp)) { ! record = next_array_record (dtp, dtp->u.p.current_unit->ls); ! ! /* Now seek to this record. */ ! record = record * dtp->u.p.current_unit->recl; ! if (sseek (dtp->u.p.current_unit->s, record) == FAILURE) ! { ! generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); ! break; ! } ! dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; } + else + { + bytes_left = (int) dtp->u.p.current_unit->bytes_left; + p = salloc_r (dtp->u.p.current_unit->s, &bytes_left); + if (p != NULL) + dtp->u.p.current_unit->bytes_left + = dtp->u.p.current_unit->recl; + } + break; + } + else do + { + p = salloc_r (dtp->u.p.current_unit->s, &length); if (p == NULL) { ! generate_error (&dtp->common, ERROR_OS, NULL); break; } if (length == 0) { ! dtp->u.p.current_unit->endfile = AT_ENDFILE; break; } } *************** next_record_r (int done) *** 1348,1555 **** break; } ! if (current_unit->flags.access == ACCESS_SEQUENTIAL) ! test_endfile (current_unit); } /* Position to the next record in write mode. */ static void ! next_record_w (int done) { ! gfc_offset c, m; int length; char *p; /* Zero counters for X- and T-editing. */ ! max_pos = skips = pending_spaces = 0; ! switch (current_mode ()) { case FORMATTED_DIRECT: ! if (current_unit->bytes_left == 0) break; ! length = current_unit->bytes_left; ! p = salloc_w (current_unit->s, &length); ! ! if (p == NULL) goto io_error; - memset (p, ' ', current_unit->bytes_left); - if (sfree (current_unit->s) == FAILURE) - goto io_error; break; case UNFORMATTED_DIRECT: ! if (sfree (current_unit->s) == FAILURE) goto io_error; break; case UNFORMATTED_SEQUENTIAL: ! m = current_unit->recl - current_unit->bytes_left; /* Bytes written. */ ! c = file_position (current_unit->s); ! ! length = sizeof (gfc_offset); /* Write the length tail. */ ! p = salloc_w (current_unit->s, &length); ! if (p == NULL) ! goto io_error; ! ! memcpy (p, &m, sizeof (gfc_offset)); ! if (sfree (current_unit->s) == FAILURE) goto io_error; /* Seek to the head and overwrite the bogus length with the real length. */ ! p = salloc_w_at (current_unit->s, &length, c - m - length); ! if (p == NULL) ! generate_error (ERROR_OS, NULL); ! memcpy (p, &m, sizeof (gfc_offset)); ! if (sfree (current_unit->s) == FAILURE) goto io_error; /* Seek past the end of the current record. */ ! if (sseek (current_unit->s, c + sizeof (gfc_offset)) == FAILURE) goto io_error; break; case FORMATTED_SEQUENTIAL: - #ifdef HAVE_CRLF - length = 2; - #else - length = 1; - #endif - p = salloc_w (current_unit->s, &length); ! if (!is_internal_unit()) { ! if (p) ! { /* No new line for internal writes. */ #ifdef HAVE_CRLF ! p[0] = '\r'; ! p[1] = '\n'; #else ! *p = '\n'; #endif ! } ! else goto io_error; } - if (sfree (current_unit->s) == FAILURE) - goto io_error; - break; io_error: ! generate_error (ERROR_OS, NULL); break; } } - /* Position to the next record, which means moving to the end of the current record. This can happen under several different conditions. If the done flag is not set, we get ready to process the next record. */ void ! next_record (int done) { gfc_offset fp; /* File position. */ ! current_unit->read_bad = 0; ! if (g.mode == READING) ! next_record_r (done); else ! next_record_w (done); /* keep position up to date for INQUIRE */ ! current_unit->flags.position = POSITION_ASIS; ! current_unit->current_record = 0; ! if (current_unit->flags.access == ACCESS_DIRECT) { ! fp = file_position (current_unit->s); /* Calculate next record, rounding up partial records. */ ! current_unit->last_record = (fp + current_unit->recl - 1) ! / current_unit->recl; } else ! current_unit->last_record++; if (!done) ! pre_position (); } /* Finalize the current data transfer. For a nonadvancing transfer, this means advancing to the next record. For internal units close the ! steam associated with the unit. */ static void ! finalize_transfer (void) { ! if (eor_condition) { ! generate_error (ERROR_EOR, NULL); return; } ! if (ioparm.library_return != LIBRARY_OK) return; ! if ((ionml != NULL) && (ioparm.namelist_name != NULL)) { ! if (ioparm.namelist_read_mode) ! namelist_read(); else ! namelist_write(); } ! transfer = NULL; ! if (current_unit == NULL) return; ! if (setjmp (g.eof_jump)) { ! generate_error (ERROR_END, NULL); return; } ! if (ioparm.list_format && g.mode == READING) ! finish_list_read (); else { ! free_fnodes (); ! ! if (advance_status == ADVANCE_NO || g.seen_dollar) { /* Most systems buffer lines, so force the partial record to be written out. */ ! flush (current_unit->s); ! g.seen_dollar = 0; return; } ! next_record (1); ! current_unit->current_record = 0; } ! sfree (current_unit->s); ! if (is_internal_unit ()) ! sclose (current_unit->s); } --- 1764,2055 ---- break; } ! if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) ! test_endfile (dtp->u.p.current_unit); ! } ! ! ! /* Small utility function to write a record marker, taking care of ! byte swapping. */ ! ! inline static int ! write_us_marker (st_parameter_dt *dtp, const gfc_offset buf) ! { ! size_t len = sizeof (gfc_offset); ! /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ ! if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE) ! return swrite (dtp->u.p.current_unit->s, &buf, &len); ! else { ! gfc_offset p; ! reverse_memcpy (&p, &buf, sizeof (gfc_offset)); ! return swrite (dtp->u.p.current_unit->s, &p, &len); ! } } /* Position to the next record in write mode. */ static void ! next_record_w (st_parameter_dt *dtp, int done) { ! gfc_offset c, m, record, max_pos; int length; char *p; /* Zero counters for X- and T-editing. */ ! max_pos = dtp->u.p.max_pos; ! dtp->u.p.max_pos = dtp->u.p.skips = dtp->u.p.pending_spaces = 0; ! switch (current_mode (dtp)) { case FORMATTED_DIRECT: ! if (dtp->u.p.current_unit->bytes_left == 0) break; ! if (sset (dtp->u.p.current_unit->s, ' ', ! dtp->u.p.current_unit->bytes_left) == FAILURE) goto io_error; break; case UNFORMATTED_DIRECT: ! if (sfree (dtp->u.p.current_unit->s) == FAILURE) goto io_error; break; case UNFORMATTED_SEQUENTIAL: ! /* Bytes written. */ ! m = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left; ! c = file_position (dtp->u.p.current_unit->s); /* Write the length tail. */ ! if (write_us_marker (dtp, m) != 0) goto io_error; /* Seek to the head and overwrite the bogus length with the real length. */ ! if (sseek (dtp->u.p.current_unit->s, c - m - sizeof (gfc_offset)) ! == FAILURE) ! goto io_error; ! if (write_us_marker (dtp, m) != 0) goto io_error; /* Seek past the end of the current record. */ ! if (sseek (dtp->u.p.current_unit->s, c + sizeof (gfc_offset)) == FAILURE) goto io_error; break; case FORMATTED_SEQUENTIAL: ! if (dtp->u.p.current_unit->bytes_left == 0) ! break; ! ! if (is_internal_unit (dtp)) { ! if (is_array_io (dtp)) ! { ! length = (int) dtp->u.p.current_unit->bytes_left; ! ! /* If the farthest position reached is greater than current ! position, adjust the position and set length to pad out ! whats left. Otherwise just pad whats left. ! (for character array unit) */ ! m = dtp->u.p.current_unit->recl ! - dtp->u.p.current_unit->bytes_left; ! if (max_pos > m) ! { ! length = (int) (max_pos - m); ! p = salloc_w (dtp->u.p.current_unit->s, &length); ! length = (int) (dtp->u.p.current_unit->recl - max_pos); ! } ! ! if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE) ! { ! generate_error (&dtp->common, ERROR_END, NULL); ! return; ! } ! ! /* Now that the current record has been padded out, ! determine where the next record in the array is. */ ! record = next_array_record (dtp, dtp->u.p.current_unit->ls); ! ! /* Now seek to this record */ ! record = record * dtp->u.p.current_unit->recl; ! ! if (sseek (dtp->u.p.current_unit->s, record) == FAILURE) ! { ! generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); ! return; ! } ! ! dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; ! } ! else ! { ! length = 1; ! ! /* If this is the last call to next_record move to the farthest ! position reached and set length to pad out the remainder ! of the record. (for character scaler unit) */ ! if (done) ! { ! m = dtp->u.p.current_unit->recl ! - dtp->u.p.current_unit->bytes_left; ! if (max_pos > m) ! { ! length = (int) (max_pos - m); ! p = salloc_w (dtp->u.p.current_unit->s, &length); ! length = (int) (dtp->u.p.current_unit->recl - max_pos); ! } ! else ! length = (int) dtp->u.p.current_unit->bytes_left; ! } ! if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE) ! { ! generate_error (&dtp->common, ERROR_END, NULL); ! return; ! } ! } ! } ! else ! { ! /* If this is the last call to next_record move to the farthest ! position reached in preparation for completing the record. ! (for file unit) */ ! if (done) ! { ! m = dtp->u.p.current_unit->recl - ! dtp->u.p.current_unit->bytes_left; ! if (max_pos > m) ! { ! length = (int) (max_pos - m); ! p = salloc_w (dtp->u.p.current_unit->s, &length); ! } ! } ! size_t len; ! const char crlf[] = "\r\n"; #ifdef HAVE_CRLF ! len = 2; #else ! len = 1; #endif ! if (swrite (dtp->u.p.current_unit->s, &crlf[2-len], &len) != 0) goto io_error; } break; io_error: ! generate_error (&dtp->common, ERROR_OS, NULL); break; } } /* Position to the next record, which means moving to the end of the current record. This can happen under several different conditions. If the done flag is not set, we get ready to process the next record. */ void ! next_record (st_parameter_dt *dtp, int done) { gfc_offset fp; /* File position. */ ! dtp->u.p.current_unit->read_bad = 0; ! if (dtp->u.p.mode == READING) ! next_record_r (dtp); else ! next_record_w (dtp, done); /* keep position up to date for INQUIRE */ ! dtp->u.p.current_unit->flags.position = POSITION_ASIS; ! dtp->u.p.current_unit->current_record = 0; ! if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { ! fp = file_position (dtp->u.p.current_unit->s); /* Calculate next record, rounding up partial records. */ ! dtp->u.p.current_unit->last_record = (fp + dtp->u.p.current_unit->recl - 1) ! / dtp->u.p.current_unit->recl; } else ! dtp->u.p.current_unit->last_record++; if (!done) ! pre_position (dtp); } /* Finalize the current data transfer. For a nonadvancing transfer, this means advancing to the next record. For internal units close the ! stream associated with the unit. */ static void ! finalize_transfer (st_parameter_dt *dtp) { + jmp_buf eof_jump; + GFC_INTEGER_4 cf = dtp->common.flags; ! if (dtp->u.p.eor_condition) { ! generate_error (&dtp->common, ERROR_EOR, NULL); return; } ! if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; ! if ((dtp->u.p.ionml != NULL) ! && (cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0) { ! if ((cf & IOPARM_DT_NAMELIST_READ_MODE) != 0) ! namelist_read (dtp); else ! namelist_write (dtp); } ! dtp->u.p.transfer = NULL; ! if (dtp->u.p.current_unit == NULL) return; ! dtp->u.p.eof_jump = &eof_jump; ! if (setjmp (eof_jump)) { ! generate_error (&dtp->common, ERROR_END, NULL); return; } ! if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING) ! finish_list_read (dtp); else { ! dtp->u.p.current_unit->current_record = 0; ! if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar) { /* Most systems buffer lines, so force the partial record to be written out. */ ! flush (dtp->u.p.current_unit->s); ! dtp->u.p.seen_dollar = 0; return; } ! next_record (dtp, 1); } ! sfree (dtp->u.p.current_unit->s); ! if (is_internal_unit (dtp)) ! { ! if (is_array_io (dtp) && dtp->u.p.current_unit->ls != NULL) ! free_mem (dtp->u.p.current_unit->ls); ! sclose (dtp->u.p.current_unit->s); ! } } *************** finalize_transfer (void) *** 1557,1571 **** data transfer, it just updates the length counter. */ static void ! iolength_transfer (bt type, void *dest, int len) { ! if (ioparm.iolength != NULL) ! { ! if (type == BT_COMPLEX) ! *ioparm.iolength += 2*len; ! else ! *ioparm.iolength += len; ! } } --- 2057,2069 ---- data transfer, it just updates the length counter. */ static void ! iolength_transfer (st_parameter_dt *dtp, bt type __attribute__((unused)), ! void *dest __attribute__ ((unused)), ! int kind __attribute__((unused)), ! size_t size, size_t nelems) { ! if ((dtp->common.flags & IOPARM_DT_HAS_IOLENGTH) != 0) ! *dtp->iolength += (GFC_INTEGER_4) size * nelems; } *************** iolength_transfer (bt type, void *dest, *** 1574,1589 **** doesn't have to deal with units at all. */ static void ! iolength_transfer_init (void) { ! if (ioparm.iolength != NULL) ! *ioparm.iolength = 0; ! g.item_count = 0; /* Set up the subroutine that will handle the transfers. */ ! transfer = iolength_transfer; } --- 2072,2087 ---- doesn't have to deal with units at all. */ static void ! iolength_transfer_init (st_parameter_dt *dtp) { ! if ((dtp->common.flags & IOPARM_DT_HAS_IOLENGTH) != 0) ! *dtp->iolength = 0; ! memset (&dtp->u.p, 0, sizeof (dtp->u.p)); /* Set up the subroutine that will handle the transfers. */ ! dtp->u.p.transfer = iolength_transfer; } *************** iolength_transfer_init (void) *** 1592,1717 **** it must still be a runtime library call so that we can determine the iolength for dynamic arrays and such. */ ! extern void st_iolength (void); export_proto(st_iolength); void ! st_iolength (void) { ! library_start (); ! iolength_transfer_init (); } ! extern void st_iolength_done (void); export_proto(st_iolength_done); void ! st_iolength_done (void) { library_end (); } /* The READ statement. */ ! extern void st_read (void); export_proto(st_read); void ! st_read (void) { ! library_start (); ! data_transfer_init (1); /* Handle complications dealing with the endfile record. It is significant that this is the only place where ERROR_END is generated. Reading an end of file elsewhere is either end of record or an I/O error. */ ! if (current_unit->flags.access == ACCESS_SEQUENTIAL) ! switch (current_unit->endfile) { case NO_ENDFILE: break; case AT_ENDFILE: ! if (!is_internal_unit()) { ! generate_error (ERROR_END, NULL); ! current_unit->endfile = AFTER_ENDFILE; } break; case AFTER_ENDFILE: ! generate_error (ERROR_ENDFILE, NULL); break; } } ! extern void st_read_done (void); export_proto(st_read_done); void ! st_read_done (void) { ! finalize_transfer (); library_end (); } ! extern void st_write (void); export_proto(st_write); void ! st_write (void) { ! ! library_start (); ! data_transfer_init (0); } ! extern void st_write_done (void); export_proto(st_write_done); void ! st_write_done (void) { ! finalize_transfer (); /* Deal with endfile conditions associated with sequential files. */ ! if (current_unit != NULL && current_unit->flags.access == ACCESS_SEQUENTIAL) ! switch (current_unit->endfile) { case AT_ENDFILE: /* Remain at the endfile record. */ break; case AFTER_ENDFILE: ! current_unit->endfile = AT_ENDFILE; /* Just at it now. */ break; case NO_ENDFILE: ! if (current_unit->current_record > current_unit->last_record) { /* Get rid of whatever is after this record. */ ! if (struncate (current_unit->s) == FAILURE) ! generate_error (ERROR_OS, NULL); } ! current_unit->endfile = AT_ENDFILE; break; } library_end (); } /* Receives the scalar information for namelist objects and stores it in a linked list of namelist_info types. */ void ! st_set_nml_var (void * var_addr, char * var_name, GFC_INTEGER_4 len, ! gfc_charlen_type string_length, GFC_INTEGER_4 dtype) { namelist_info *t1 = NULL; namelist_info *nml; --- 2090,2238 ---- it must still be a runtime library call so that we can determine the iolength for dynamic arrays and such. */ ! extern void st_iolength (st_parameter_dt *); export_proto(st_iolength); void ! st_iolength (st_parameter_dt *dtp) { ! library_start (&dtp->common); ! iolength_transfer_init (dtp); } ! extern void st_iolength_done (st_parameter_dt *); export_proto(st_iolength_done); void ! st_iolength_done (st_parameter_dt *dtp __attribute__((unused))) { + free_ionml (dtp); + if (dtp->u.p.scratch != NULL) + free_mem (dtp->u.p.scratch); library_end (); } /* The READ statement. */ ! extern void st_read (st_parameter_dt *); export_proto(st_read); void ! st_read (st_parameter_dt *dtp) { ! library_start (&dtp->common); ! data_transfer_init (dtp, 1); /* Handle complications dealing with the endfile record. It is significant that this is the only place where ERROR_END is generated. Reading an end of file elsewhere is either end of record or an I/O error. */ ! if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) ! switch (dtp->u.p.current_unit->endfile) { case NO_ENDFILE: break; case AT_ENDFILE: ! if (!is_internal_unit (dtp)) { ! generate_error (&dtp->common, ERROR_END, NULL); ! dtp->u.p.current_unit->endfile = AFTER_ENDFILE; ! dtp->u.p.current_unit->current_record = 0; } break; case AFTER_ENDFILE: ! generate_error (&dtp->common, ERROR_ENDFILE, NULL); ! dtp->u.p.current_unit->current_record = 0; break; } } ! extern void st_read_done (st_parameter_dt *); export_proto(st_read_done); void ! st_read_done (st_parameter_dt *dtp) { ! flush(dtp->u.p.current_unit->s); ! finalize_transfer (dtp); ! free_format_data (dtp); ! free_ionml (dtp); ! if (dtp->u.p.scratch != NULL) ! free_mem (dtp->u.p.scratch); ! if (dtp->u.p.current_unit != NULL) ! unlock_unit (dtp->u.p.current_unit); library_end (); } ! extern void st_write (st_parameter_dt *); export_proto(st_write); void ! st_write (st_parameter_dt *dtp) { ! library_start (&dtp->common); ! data_transfer_init (dtp, 0); } ! extern void st_write_done (st_parameter_dt *); export_proto(st_write_done); void ! st_write_done (st_parameter_dt *dtp) { ! finalize_transfer (dtp); /* Deal with endfile conditions associated with sequential files. */ ! if (dtp->u.p.current_unit != NULL && dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) ! switch (dtp->u.p.current_unit->endfile) { case AT_ENDFILE: /* Remain at the endfile record. */ break; case AFTER_ENDFILE: ! dtp->u.p.current_unit->endfile = AT_ENDFILE; /* Just at it now. */ break; case NO_ENDFILE: ! if (dtp->u.p.current_unit->current_record > dtp->u.p.current_unit->last_record) { /* Get rid of whatever is after this record. */ ! if (struncate (dtp->u.p.current_unit->s) == FAILURE) ! generate_error (&dtp->common, ERROR_OS, NULL); } ! dtp->u.p.current_unit->endfile = AT_ENDFILE; break; } + free_format_data (dtp); + free_ionml (dtp); + if (dtp->u.p.scratch != NULL) + free_mem (dtp->u.p.scratch); + if (dtp->u.p.current_unit != NULL) + unlock_unit (dtp->u.p.current_unit); library_end (); } /* Receives the scalar information for namelist objects and stores it in a linked list of namelist_info types. */ + extern void st_set_nml_var (st_parameter_dt *dtp, void *, char *, + GFC_INTEGER_4, gfc_charlen_type, GFC_INTEGER_4); + export_proto(st_set_nml_var); + + void ! st_set_nml_var (st_parameter_dt *dtp, void * var_addr, char * var_name, ! GFC_INTEGER_4 len, gfc_charlen_type string_length, ! GFC_INTEGER_4 dtype) { namelist_info *t1 = NULL; namelist_info *nml; *************** st_set_nml_var (void * var_addr, char * *** 1734,1741 **** { nml->dim = (descriptor_dimension*) get_mem (nml->var_rank * sizeof (descriptor_dimension)); ! nml->ls = (nml_loop_spec*) ! get_mem (nml->var_rank * sizeof (nml_loop_spec)); } else { --- 2255,2262 ---- { nml->dim = (descriptor_dimension*) get_mem (nml->var_rank * sizeof (descriptor_dimension)); ! nml->ls = (array_loop_spec*) ! get_mem (nml->var_rank * sizeof (array_loop_spec)); } else { *************** st_set_nml_var (void * var_addr, char * *** 1745,1783 **** nml->next = NULL; ! if (ionml == NULL) ! ionml = nml; else { ! for (t1 = ionml; t1->next; t1 = t1->next); t1->next = nml; } - return; } /* Store the dimensional information for the namelist object. */ void ! st_set_nml_var_dim (GFC_INTEGER_4 n_dim, GFC_INTEGER_4 stride, ! GFC_INTEGER_4 lbound, GFC_INTEGER_4 ubound) { namelist_info * nml; int n; n = (int)n_dim; ! for (nml = ionml; nml->next; nml = nml->next); nml->dim[n].stride = (ssize_t)stride; nml->dim[n].lbound = (ssize_t)lbound; nml->dim[n].ubound = (ssize_t)ubound; } ! extern void st_set_nml_var (void * ,char * , ! GFC_INTEGER_4 ,gfc_charlen_type ,GFC_INTEGER_4); ! export_proto(st_set_nml_var); ! extern void st_set_nml_var_dim (GFC_INTEGER_4, GFC_INTEGER_4, ! GFC_INTEGER_4 ,GFC_INTEGER_4); ! export_proto(st_set_nml_var_dim); --- 2266,2318 ---- nml->next = NULL; ! if ((dtp->common.flags & IOPARM_DT_IONML_SET) == 0) ! { ! dtp->common.flags |= IOPARM_DT_IONML_SET; ! dtp->u.p.ionml = nml; ! } else { ! for (t1 = dtp->u.p.ionml; t1->next; t1 = t1->next); t1->next = nml; } } /* Store the dimensional information for the namelist object. */ + extern void st_set_nml_var_dim (st_parameter_dt *, GFC_INTEGER_4, + GFC_INTEGER_4, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(st_set_nml_var_dim); void ! st_set_nml_var_dim (st_parameter_dt *dtp, GFC_INTEGER_4 n_dim, ! GFC_INTEGER_4 stride, GFC_INTEGER_4 lbound, ! GFC_INTEGER_4 ubound) { namelist_info * nml; int n; n = (int)n_dim; ! for (nml = dtp->u.p.ionml; nml->next; nml = nml->next); nml->dim[n].stride = (ssize_t)stride; nml->dim[n].lbound = (ssize_t)lbound; nml->dim[n].ubound = (ssize_t)ubound; } ! /* Reverse memcpy - used for byte swapping. */ ! void reverse_memcpy (void *dest, const void *src, size_t n) ! { ! char *d, *s; ! size_t i; + d = (char *) dest; + s = (char *) src + n - 1; + + /* Write with ascending order - this is likely faster + on modern architectures because of write combining. */ + for (i=0; i --- 24,31 ---- 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. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,45 **** #include "io.h" /* Subroutines related to units */ #define CACHE_SIZE 3 static gfc_unit internal_unit, *unit_cache[CACHE_SIZE]; ! /* This implementation is based on Stefan Nilsson's article in the * July 1997 Doctor Dobb's Journal, "Treaps in Java". */ --- 34,88 ---- #include "io.h" + /* IO locking rules: + UNIT_LOCK is a master lock, protecting UNIT_ROOT tree and UNIT_CACHE. + Concurrent use of different units should be supported, so + each unit has its own lock, LOCK. + Open should be atomic with its reopening of units and list_read.c + in several places needs find_unit another unit while holding stdin + unit's lock, so it must be possible to acquire UNIT_LOCK while holding + some unit's lock. Therefore to avoid deadlocks, it is forbidden + to acquire unit's private locks while holding UNIT_LOCK, except + for freshly created units (where no other thread can get at their + address yet) or when using just trylock rather than lock operation. + In addition to unit's private lock each unit has a WAITERS counter + and CLOSED flag. WAITERS counter must be either only + atomically incremented/decremented in all places (if atomic builtins + are supported), or protected by UNIT_LOCK in all places (otherwise). + CLOSED flag must be always protected by unit's LOCK. + After finding a unit in UNIT_CACHE or UNIT_ROOT with UNIT_LOCK held, + WAITERS must be incremented to avoid concurrent close from freeing + the unit between unlocking UNIT_LOCK and acquiring unit's LOCK. + Unit freeing is always done under UNIT_LOCK. If close_unit sees any + WAITERS, it doesn't free the unit but instead sets the CLOSED flag + and the thread that decrements WAITERS to zero while CLOSED flag is + set is responsible for freeing it (while holding UNIT_LOCK). + flush_all_units operation is iterating over the unit tree with + increasing UNIT_NUMBER while holding UNIT_LOCK and attempting to + flush each unit (and therefore needs the unit's LOCK held as well). + To avoid deadlocks, it just trylocks the LOCK and if unsuccessful, + remembers the current unit's UNIT_NUMBER, unlocks UNIT_LOCK, acquires + unit's LOCK and after flushing reacquires UNIT_LOCK and restarts with + the smallest UNIT_NUMBER above the last one flushed. + + If find_unit/find_or_create_unit/find_file/get_unit routines return + non-NULL, the returned unit has its private lock locked and when the + caller is done with it, it must call either unlock_unit or close_unit + on it. unlock_unit or close_unit must be always called only with the + private lock held. */ + /* Subroutines related to units */ #define CACHE_SIZE 3 static gfc_unit internal_unit, *unit_cache[CACHE_SIZE]; ! gfc_offset max_offset; ! gfc_unit *unit_root; ! #ifdef __GTHREAD_MUTEX_INIT ! __gthread_mutex_t unit_lock = __GTHREAD_MUTEX_INIT; ! #else ! __gthread_mutex_t unit_lock; ! #endif /* This implementation is based on Stefan Nilsson's article in the * July 1997 Doctor Dobb's Journal, "Treaps in Java". */ *************** compare (int a, int b) *** 104,110 **** /* insert()-- Recursive insertion function. Returns the updated treap. */ static gfc_unit * ! insert (gfc_unit * new, gfc_unit * t) { int c; --- 147,153 ---- /* insert()-- Recursive insertion function. Returns the updated treap. */ static gfc_unit * ! insert (gfc_unit *new, gfc_unit *t) { int c; *************** insert (gfc_unit * new, gfc_unit * t) *** 128,147 **** } if (c == 0) ! internal_error ("insert(): Duplicate key found!"); return t; } ! /* insert_unit()-- Given a new node, insert it into the treap. It is ! * an error to insert a key that already exists. */ ! void ! insert_unit (gfc_unit * new) { ! new->priority = pseudo_random (); ! g.unit_root = insert (new, g.unit_root); } --- 171,202 ---- } if (c == 0) ! internal_error (NULL, "insert(): Duplicate key found!"); return t; } ! /* insert_unit()-- Create a new node, insert it into the treap. */ ! static gfc_unit * ! insert_unit (int n) { ! gfc_unit *u = get_mem (sizeof (gfc_unit)); ! memset (u, '\0', sizeof (gfc_unit)); ! u->unit_number = n; ! #ifdef __GTHREAD_MUTEX_INIT ! { ! __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT; ! u->lock = tmp; ! } ! #else ! __GTHREAD_MUTEX_INIT_FUNCTION (&u->lock); ! #endif ! __gthread_mutex_lock (&u->lock); ! u->priority = pseudo_random (); ! unit_root = insert (u, unit_root); ! return u; } *************** delete_treap (gfc_unit * old, gfc_unit * *** 201,227 **** static void delete_unit (gfc_unit * old) { ! g.unit_root = delete_treap (old, g.unit_root); } /* find_unit()-- Given an integer, return a pointer to the unit ! * structure. Returns NULL if the unit does not exist. */ ! gfc_unit * ! find_unit (int n) { gfc_unit *p; ! int c; for (c = 0; c < CACHE_SIZE; c++) if (unit_cache[c] != NULL && unit_cache[c]->unit_number == n) { p = unit_cache[c]; ! return p; } ! p = g.unit_root; while (p != NULL) { c = compare (n, p->unit_number); --- 256,285 ---- static void delete_unit (gfc_unit * old) { ! unit_root = delete_treap (old, unit_root); } /* find_unit()-- Given an integer, return a pointer to the unit ! * structure. Returns NULL if the unit does not exist, ! * otherwise returns a locked unit. */ ! static gfc_unit * ! find_unit_1 (int n, int do_create) { gfc_unit *p; ! int c, created = 0; + __gthread_mutex_lock (&unit_lock); + retry: for (c = 0; c < CACHE_SIZE; c++) if (unit_cache[c] != NULL && unit_cache[c]->unit_number == n) { p = unit_cache[c]; ! goto found; } ! p = unit_root; while (p != NULL) { c = compare (n, p->unit_number); *************** find_unit (int n) *** 233,238 **** --- 291,302 ---- break; } + if (p == NULL && do_create) + { + p = insert_unit (n); + created = 1; + } + if (p != NULL) { for (c = 0; c < CACHE_SIZE - 1; c++) *************** find_unit (int n) *** 241,259 **** unit_cache[CACHE_SIZE - 1] = p; } return p; } /* get_unit()-- Returns the unit structure associated with the integer * unit or the internal file. */ gfc_unit * ! get_unit (int read_flag) { ! if (ioparm.internal_unit != NULL) { internal_unit.s = ! open_internal (ioparm.internal_unit, ioparm.internal_unit_len); /* Set flags for the internal unit */ --- 305,388 ---- unit_cache[CACHE_SIZE - 1] = p; } + if (created) + { + /* Newly created units have their lock held already + from insert_unit. Just unlock UNIT_LOCK and return. */ + __gthread_mutex_unlock (&unit_lock); + return p; + } + + found: + if (p != NULL) + { + /* Fast path. */ + if (! __gthread_mutex_trylock (&p->lock)) + { + /* assert (p->closed == 0); */ + __gthread_mutex_unlock (&unit_lock); + return p; + } + + inc_waiting_locked (p); + } + + __gthread_mutex_unlock (&unit_lock); + + if (p != NULL) + { + __gthread_mutex_lock (&p->lock); + if (p->closed) + { + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&p->lock); + if (predec_waiting_locked (p) == 0) + free_mem (p); + goto retry; + } + + dec_waiting_unlocked (p); + } return p; } + gfc_unit * + find_unit (int n) + { + return find_unit_1 (n, 0); + } + + gfc_unit * + find_or_create_unit (int n) + { + return find_unit_1 (n, 1); + } + /* get_unit()-- Returns the unit structure associated with the integer * unit or the internal file. */ gfc_unit * ! get_unit (st_parameter_dt *dtp, int do_create) { ! if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0) { + __gthread_mutex_lock (&internal_unit.lock); + internal_unit.recl = dtp->internal_unit_len; + if (is_array_io (dtp)) + { + internal_unit.rank = GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc); + internal_unit.ls = (array_loop_spec *) + get_mem (internal_unit.rank * sizeof (array_loop_spec)); + dtp->internal_unit_len *= + init_loop_spec (dtp->internal_unit_desc, internal_unit.ls); + } + internal_unit.s = ! open_internal (dtp->internal_unit, dtp->internal_unit_len); ! internal_unit.bytes_left = internal_unit.recl; ! internal_unit.last_record=0; ! internal_unit.maxrec=0; ! internal_unit.current_record=0; /* Set flags for the internal unit */ *************** get_unit (int read_flag) *** 261,286 **** internal_unit.flags.action = ACTION_READWRITE; internal_unit.flags.form = FORM_FORMATTED; internal_unit.flags.delim = DELIM_NONE; return &internal_unit; } /* Has to be an external unit */ ! return find_unit (ioparm.unit); } ! /* is_internal_unit()-- Determine if the current unit is internal or ! * not */ int ! is_internal_unit () { ! return current_unit == &internal_unit; } /*************************/ /* Initialize everything */ --- 390,423 ---- internal_unit.flags.action = ACTION_READWRITE; internal_unit.flags.form = FORM_FORMATTED; internal_unit.flags.delim = DELIM_NONE; + internal_unit.flags.pad = PAD_YES; return &internal_unit; } /* Has to be an external unit */ ! return find_unit_1 (dtp->common.unit, do_create); } ! /* is_internal_unit()-- Determine if the current unit is internal or not */ int ! is_internal_unit (st_parameter_dt *dtp) { ! return dtp->u.p.current_unit == &internal_unit; } + /* is_array_io ()-- Determine if the I/O is to/from an array */ + + int + is_array_io (st_parameter_dt *dtp) + { + return dtp->internal_unit_desc != NULL; + } + /*************************/ /* Initialize everything */ *************** void *** 289,302 **** init_units (void) { gfc_unit *u; ! int i; if (options.stdin_unit >= 0) { /* STDIN */ ! u = get_mem (sizeof (gfc_unit)); ! memset (u, '\0', sizeof (gfc_unit)); ! ! u->unit_number = options.stdin_unit; u->s = input_stream (); u->flags.action = ACTION_READ; --- 426,449 ---- init_units (void) { gfc_unit *u; ! unsigned int i; ! ! #ifndef __GTHREAD_MUTEX_INIT ! __GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock); ! #endif ! ! #ifdef __GTHREAD_MUTEX_INIT ! { ! __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT; ! internal_unit.lock = tmp; ! } ! #else ! __GTHREAD_MUTEX_INIT_FUNCTION (&internal_unit.lock); ! #endif if (options.stdin_unit >= 0) { /* STDIN */ ! u = insert_unit (options.stdin_unit); u->s = input_stream (); u->flags.action = ACTION_READ; *************** init_units (void) *** 304,324 **** u->flags.access = ACCESS_SEQUENTIAL; u->flags.form = FORM_FORMATTED; u->flags.status = STATUS_OLD; ! u->flags.blank = BLANK_UNSPECIFIED; u->flags.position = POSITION_ASIS; u->recl = options.default_recl; u->endfile = NO_ENDFILE; ! insert_unit (u); } if (options.stdout_unit >= 0) { /* STDOUT */ ! u = get_mem (sizeof (gfc_unit)); ! memset (u, '\0', sizeof (gfc_unit)); ! ! u->unit_number = options.stdout_unit; u->s = output_stream (); u->flags.action = ACTION_WRITE; --- 451,469 ---- u->flags.access = ACCESS_SEQUENTIAL; u->flags.form = FORM_FORMATTED; u->flags.status = STATUS_OLD; ! u->flags.blank = BLANK_NULL; ! u->flags.pad = PAD_YES; u->flags.position = POSITION_ASIS; u->recl = options.default_recl; u->endfile = NO_ENDFILE; ! __gthread_mutex_unlock (&u->lock); } if (options.stdout_unit >= 0) { /* STDOUT */ ! u = insert_unit (options.stdout_unit); u->s = output_stream (); u->flags.action = ACTION_WRITE; *************** init_units (void) *** 326,346 **** u->flags.access = ACCESS_SEQUENTIAL; u->flags.form = FORM_FORMATTED; u->flags.status = STATUS_OLD; ! u->flags.blank = BLANK_UNSPECIFIED; u->flags.position = POSITION_ASIS; u->recl = options.default_recl; u->endfile = AT_ENDFILE; ! insert_unit (u); } if (options.stderr_unit >= 0) { /* STDERR */ ! u = get_mem (sizeof (gfc_unit)); ! memset (u, '\0', sizeof (gfc_unit)); ! ! u->unit_number = options.stderr_unit; u->s = error_stream (); u->flags.action = ACTION_WRITE; --- 471,488 ---- u->flags.access = ACCESS_SEQUENTIAL; u->flags.form = FORM_FORMATTED; u->flags.status = STATUS_OLD; ! u->flags.blank = BLANK_NULL; u->flags.position = POSITION_ASIS; u->recl = options.default_recl; u->endfile = AT_ENDFILE; ! __gthread_mutex_unlock (&u->lock); } if (options.stderr_unit >= 0) { /* STDERR */ ! u = insert_unit (options.stderr_unit); u->s = error_stream (); u->flags.action = ACTION_WRITE; *************** init_units (void) *** 348,360 **** u->flags.access = ACCESS_SEQUENTIAL; u->flags.form = FORM_FORMATTED; u->flags.status = STATUS_OLD; ! u->flags.blank = BLANK_UNSPECIFIED; u->flags.position = POSITION_ASIS; u->recl = options.default_recl; u->endfile = AT_ENDFILE; ! insert_unit (u); } /* Calculate the maximum file offset in a portable manner. --- 490,502 ---- u->flags.access = ACCESS_SEQUENTIAL; u->flags.form = FORM_FORMATTED; u->flags.status = STATUS_OLD; ! u->flags.blank = BLANK_NULL; u->flags.position = POSITION_ASIS; u->recl = options.default_recl; u->endfile = AT_ENDFILE; ! __gthread_mutex_unlock (&u->lock); } /* Calculate the maximum file offset in a portable manner. *************** init_units (void) *** 362,401 **** * * set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */ ! g.max_offset = 0; ! for (i=0; i < sizeof(g.max_offset) * 8 - 1; i++) ! g.max_offset = g.max_offset + ((gfc_offset) 1 << i); ! } ! /* close_unit()-- Close a unit. The stream is closed, and any memory ! * associated with the stream is freed. Returns nonzero on I/O error. */ ! ! int ! close_unit (gfc_unit * u) { int i, rc; for (i = 0; i < CACHE_SIZE; i++) if (unit_cache[i] == u) unit_cache[i] = NULL; - rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE; - delete_unit (u); ! free_mem (u); return rc; } /* close_units()-- Delete units on completion. We just keep deleting ! * the root of the treap until there is nothing left. */ void close_units (void) { ! while (g.unit_root != NULL) ! close_unit (g.unit_root); } --- 504,581 ---- * * set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */ ! max_offset = 0; ! for (i = 0; i < sizeof (max_offset) * 8 - 1; i++) ! max_offset = max_offset + ((gfc_offset) 1 << i); } ! static int ! close_unit_1 (gfc_unit *u, int locked) { int i, rc; + rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE; + + u->closed = 1; + if (!locked) + __gthread_mutex_lock (&unit_lock); + for (i = 0; i < CACHE_SIZE; i++) if (unit_cache[i] == u) unit_cache[i] = NULL; delete_unit (u); ! ! if (u->file) ! free_mem (u->file); ! u->file = NULL; ! u->file_len = 0; ! ! if (!locked) ! __gthread_mutex_unlock (&u->lock); ! ! /* If there are any threads waiting in find_unit for this unit, ! avoid freeing the memory, the last such thread will free it ! instead. */ ! if (u->waiting == 0) ! free_mem (u); ! ! if (!locked) ! __gthread_mutex_unlock (&unit_lock); return rc; } + void + unlock_unit (gfc_unit *u) + { + __gthread_mutex_unlock (&u->lock); + } + + /* close_unit()-- Close a unit. The stream is closed, and any memory + * associated with the stream is freed. Returns nonzero on I/O error. + * Should be called with the u->lock locked. */ + + int + close_unit (gfc_unit *u) + { + return close_unit_1 (u, 0); + } + /* close_units()-- Delete units on completion. We just keep deleting ! * the root of the treap until there is nothing left. ! * Not sure what to do with locking here. Some other thread might be ! * holding some unit's lock and perhaps hold it indefinitely ! * (e.g. waiting for input from some pipe) and close_units shouldn't ! * delay the program too much. */ void close_units (void) { ! __gthread_mutex_lock (&unit_lock); ! while (unit_root != NULL) ! close_unit_1 (unit_root, 1); ! __gthread_mutex_unlock (&unit_lock); } diff -Nrcpad gcc-4.0.2/libgfortran/io/unix.c gcc-4.1.0/libgfortran/io/unix.c *** gcc-4.0.2/libgfortran/io/unix.c Sun Sep 11 18:55:16 2005 --- gcc-4.1.0/libgfortran/io/unix.c Tue Feb 14 20:21:15 2006 *************** *** 1,4 **** ! /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- ! /* Copyright (C) 2002, 2003, 2004, 2005 ! Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* Unix stream I/O module */ --- 25,32 ---- 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. */ /* Unix stream I/O module */ *************** Boston, MA 02111-1307, USA. */ *** 37,58 **** #include #include #include - #ifdef HAVE_SYS_MMAN_H - #include - #endif #include #include #include "libgfortran.h" #include "io.h" ! #ifndef PATH_MAX ! #define PATH_MAX 1024 #endif ! #ifndef MAP_FAILED ! #define MAP_FAILED ((void *) -1) #endif #ifndef PROT_READ --- 38,58 ---- #include #include #include + #include #include #include #include "libgfortran.h" #include "io.h" + #include "unix.h" ! #ifndef SSIZE_MAX ! #define SSIZE_MAX SHRT_MAX #endif ! #ifndef PATH_MAX ! #define PATH_MAX 1024 #endif #ifndef PROT_READ *************** Boston, MA 02111-1307, USA. */ *** 117,151 **** * 'where' parameter and use the current file pointer. */ - #define BUFFER_SIZE 8192 - - typedef struct - { - stream st; - - int fd; - gfc_offset buffer_offset; /* File offset of the start of the buffer */ - gfc_offset physical_offset; /* Current physical file offset */ - gfc_offset logical_offset; /* Current logical file offset */ - gfc_offset dirty_offset; /* Start of modified bytes in buffer */ - gfc_offset file_length; /* Length of the file, -1 if not seekable. */ - - char *buffer; - int len; /* Physical length of the current buffer */ - int active; /* Length of valid bytes in the buffer */ - - int prot; - int ndirty; /* Dirty bytes starting at dirty_offset */ - - int special_file; /* =1 if the fd refers to a special file */ - - unsigned unbuffered:1, mmaped:1; - - char small_buffer[BUFFER_SIZE]; - - } - unix_stream; - /*move_pos_offset()-- Move the record pointer right or left *relative to current position */ --- 117,122 ---- *************** is_preconnected (stream * s) *** 229,286 **** return 0; } ! /* write()-- Write a buffer to a descriptor, allowing for short writes */ static int ! writen (int fd, char *buffer, int len) { ! int n, n0; ! n0 = len; ! while (len > 0) { ! n = write (fd, buffer, len); ! if (n < 0) ! return n; ! ! buffer += n; ! len -= n; } ! return n0; } ! #if 0 ! /* readn()-- Read bytes into a buffer, allowing for short reads. If ! * fewer than len bytes are returned, it is because we've hit the end ! * of file. */ static int ! readn (int fd, char *buffer, int len) { ! int nread, n; ! nread = 0; ! while (len > 0) { ! n = read (fd, buffer, len); ! if (n < 0) ! return n; ! ! if (n == 0) ! return nread; ! ! buffer += n; ! nread += n; ! len -= n; } ! return nread; } - #endif /* get_oserror()-- Get the most recent operating system error. For --- 200,320 ---- return 0; } ! /* If the stream corresponds to a preconnected unit, we flush the ! corresponding C stream. This is bugware for mixed C-Fortran codes ! where the C code doesn't flush I/O before returning. */ ! void ! flush_if_preconnected (stream * s) ! { ! int fd; ! ! fd = ((unix_stream *) s)->fd; ! if (fd == STDIN_FILENO) ! fflush (stdin); ! else if (fd == STDOUT_FILENO) ! fflush (stdout); ! else if (fd == STDERR_FILENO) ! fflush (stderr); ! } ! ! ! /* Reset a stream after reading/writing. Assumes that the buffers have ! been flushed. */ ! ! inline static void ! reset_stream (unix_stream * s, size_t bytes_rw) ! { ! s->physical_offset += bytes_rw; ! s->logical_offset = s->physical_offset; ! if (s->file_length != -1 && s->physical_offset > s->file_length) ! s->file_length = s->physical_offset; ! } ! ! ! /* Read bytes into a buffer, allowing for short reads. If the nbytes ! * argument is less on return than on entry, it is because we've hit ! * the end of file. */ static int ! do_read (unix_stream * s, void * buf, size_t * nbytes) { ! ssize_t trans; ! size_t bytes_left; ! char *buf_st; ! int status; ! status = 0; ! bytes_left = *nbytes; ! buf_st = (char *) buf; ! /* We must read in a loop since some systems don't restart system ! calls in case of a signal. */ ! while (bytes_left > 0) { ! /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3, ! so we must read in chunks smaller than SSIZE_MAX. */ ! trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX; ! trans = read (s->fd, buf_st, trans); ! if (trans < 0) ! { ! if (errno == EINTR) ! continue; ! else ! { ! status = errno; ! break; ! } ! } ! else if (trans == 0) /* We hit EOF. */ ! break; ! buf_st += trans; ! bytes_left -= trans; } ! *nbytes -= bytes_left; ! return status; } ! /* Write a buffer to a stream, allowing for short writes. */ static int ! do_write (unix_stream * s, const void * buf, size_t * nbytes) { ! ssize_t trans; ! size_t bytes_left; ! char *buf_st; ! int status; ! status = 0; ! bytes_left = *nbytes; ! buf_st = (char *) buf; ! /* We must write in a loop since some systems don't restart system ! calls in case of a signal. */ ! while (bytes_left > 0) { ! /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3, ! so we must write in chunks smaller than SSIZE_MAX. */ ! trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX; ! trans = write (s->fd, buf_st, trans); ! if (trans < 0) ! { ! if (errno == EINTR) ! continue; ! else ! { ! status = errno; ! break; ! } ! } ! buf_st += trans; ! bytes_left -= trans; } ! *nbytes -= bytes_left; ! return status; } /* get_oserror()-- Get the most recent operating system error. For *************** sys_exit (int code) *** 306,316 **** --- 340,353 ---- File descriptor stream functions *********************************************************************/ + /* fd_flush()-- Write bytes that need to be written */ static try fd_flush (unix_stream * s) { + size_t writelen; + if (s->ndirty == 0) return SUCCESS;; *************** fd_flush (unix_stream * s) *** 318,333 **** lseek (s->fd, s->dirty_offset, SEEK_SET) < 0) return FAILURE; ! if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset), ! s->ndirty) < 0) return FAILURE; ! s->physical_offset = s->dirty_offset + s->ndirty; /* don't increment file_length if the file is non-seekable */ if (s->file_length != -1 && s->physical_offset > s->file_length) ! s->file_length = s->physical_offset; ! s->ndirty = 0; return SUCCESS; } --- 355,374 ---- lseek (s->fd, s->dirty_offset, SEEK_SET) < 0) return FAILURE; ! writelen = s->ndirty; ! if (do_write (s, s->buffer + (s->dirty_offset - s->buffer_offset), ! &writelen) != 0) return FAILURE; ! s->physical_offset = s->dirty_offset + writelen; /* don't increment file_length if the file is non-seekable */ if (s->file_length != -1 && s->physical_offset > s->file_length) ! s->file_length = s->physical_offset; ! ! s->ndirty -= writelen; ! if (s->ndirty != 0) ! return FAILURE; return SUCCESS; } *************** fd_flush (unix_stream * s) *** 338,344 **** * to come next. */ static void ! fd_alloc (unix_stream * s, gfc_offset where, int *len) { char *new_buffer; int n, read_len; --- 379,386 ---- * to come next. */ static void ! fd_alloc (unix_stream * s, gfc_offset where, ! int *len __attribute__ ((unused))) { char *new_buffer; int n, read_len; *************** fd_alloc (unix_stream * s, gfc_offset wh *** 380,386 **** s->buffer = new_buffer; s->len = read_len; - s->mmaped = 0; } --- 422,427 ---- *************** static char * *** 392,398 **** fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where) { gfc_offset m; - int n; if (where == -1) where = s->logical_offset; --- 433,438 ---- *************** fd_alloc_r_at (unix_stream * s, int *len *** 414,426 **** if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0) return NULL; ! n = read (s->fd, s->buffer + s->active, s->len - s->active); ! if (n < 0) ! return NULL; ! s->physical_offset = where + n; - s->active += n; if (s->active < *len) *len = s->active; /* Bytes actually available */ --- 454,485 ---- if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0) return NULL; ! /* do_read() hangs on read from terminals for *BSD-systems. Only ! use read() in that case. */ ! if (s->special_file) ! { ! ssize_t n; ! ! n = read (s->fd, s->buffer + s->active, s->len - s->active); ! if (n < 0) ! return NULL; ! ! s->physical_offset = where + n; ! s->active += n; ! } ! else ! { ! size_t n; ! ! n = s->len - s->active; ! if (do_read (s, s->buffer + s->active, &n) != 0) ! return NULL; ! ! s->physical_offset = where + n; ! s->active += n; ! } if (s->active < *len) *len = s->active; /* Bytes actually available */ *************** fd_sfree (unix_stream * s) *** 500,511 **** } ! static int fd_seek (unix_stream * s, gfc_offset offset) { ! s->physical_offset = s->logical_offset = offset; ! return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS; } --- 559,570 ---- } ! static try fd_seek (unix_stream * s, gfc_offset offset) { ! s->logical_offset = offset; ! return SUCCESS; } *************** fd_truncate (unix_stream * s) *** 536,777 **** } s->physical_offset = s->file_length = s->logical_offset; - - return SUCCESS; - } - - - static try - fd_close (unix_stream * s) - { - if (fd_flush (s) == FAILURE) - return FAILURE; - - if (s->buffer != NULL && s->buffer != s->small_buffer) - free_mem (s->buffer); - - if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO) - { - if (close (s->fd) < 0) - return FAILURE; - } - - free_mem (s); - - return SUCCESS; - } - - - static void - fd_open (unix_stream * s) - { - if (isatty (s->fd)) - s->unbuffered = 1; - - s->st.alloc_r_at = (void *) fd_alloc_r_at; - s->st.alloc_w_at = (void *) fd_alloc_w_at; - s->st.sfree = (void *) fd_sfree; - s->st.close = (void *) fd_close; - s->st.seek = (void *) fd_seek; - s->st.truncate = (void *) fd_truncate; - - s->buffer = NULL; - } - - - /********************************************************************* - mmap stream functions - - Because mmap() is not capable of extending a file, we have to keep - track of how long the file is. We also have to be able to detect end - of file conditions. If there are multiple writers to the file (which - can only happen outside the current program), things will get - confused. Then again, things will get confused anyway. - - *********************************************************************/ - - #if HAVE_MMAP - - static int page_size, page_mask; - - /* mmap_flush()-- Deletes a memory mapping if something is mapped. */ - - static try - mmap_flush (unix_stream * s) - { - if (!s->mmaped) - return fd_flush (s); - - if (s->buffer == NULL) - return SUCCESS; - - if (munmap (s->buffer, s->active)) - return FAILURE; - - s->buffer = NULL; s->active = 0; - return SUCCESS; } ! /* mmap_alloc()-- mmap() a section of the file. The whole section is ! * guaranteed to be mappable. */ static try ! mmap_alloc (unix_stream * s, gfc_offset where, int *len) { ! gfc_offset offset; ! int length; ! char *p; ! ! if (mmap_flush (s) == FAILURE) ! return FAILURE; ! offset = where & page_mask; /* Round down to the next page */ ! length = ((where - offset) & page_mask) + 2 * page_size; ! p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset); ! if (p == (char *) MAP_FAILED) ! return FAILURE; ! s->mmaped = 1; ! s->buffer = p; ! s->buffer_offset = offset; ! s->active = length; return SUCCESS; } ! static char * ! mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where) ! { ! gfc_offset m; ! if (where == -1) ! where = s->logical_offset; ! m = where + *len; ! if ((s->buffer == NULL || s->buffer_offset > where || ! m > s->buffer_offset + s->active) && ! mmap_alloc (s, where, len) == FAILURE) ! return NULL; ! if (m > s->file_length) { ! *len = s->file_length - s->logical_offset; ! s->logical_offset = s->file_length; } - else - s->logical_offset = m; ! return s->buffer + (where - s->buffer_offset); } ! static char * ! mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where) ! { ! if (where == -1) ! where = s->logical_offset; ! /* If we're extending the file, we have to use file descriptor ! * methods. */ ! if (where + *len > s->file_length) { ! if (s->mmaped) ! mmap_flush (s); ! return fd_alloc_w_at (s, len, where); } ! if ((s->buffer == NULL || s->buffer_offset > where || ! where + *len > s->buffer_offset + s->active || ! where < s->buffer_offset + s->active) && ! mmap_alloc (s, where, len) == FAILURE) ! return NULL; ! ! s->logical_offset = where + *len; ! ! return s->buffer + where - s->buffer_offset; ! } ! static int ! mmap_seek (unix_stream * s, gfc_offset offset) ! { ! s->logical_offset = offset; ! return SUCCESS; } static try ! mmap_close (unix_stream * s) { ! try t; ! ! t = mmap_flush (s); ! if (close (s->fd) < 0) ! t = FAILURE; ! free_mem (s); ! return t; ! } - static try - mmap_sfree (unix_stream * s) - { return SUCCESS; } ! /* mmap_open()-- mmap_specific open. If the particular file cannot be ! * mmap()-ed, we fall back to the file descriptor functions. */ ! ! static try ! mmap_open (unix_stream * s) { ! char *p; ! int i; ! ! page_size = getpagesize (); ! page_mask = ~0; ! ! p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0); ! if (p == (char *) MAP_FAILED) ! { ! fd_open (s); ! return SUCCESS; ! } ! ! munmap (p, page_size); ! ! i = page_size >> 1; ! while (i != 0) ! { ! page_mask <<= 1; ! i >>= 1; ! } ! s->st.alloc_r_at = (void *) mmap_alloc_r_at; ! s->st.alloc_w_at = (void *) mmap_alloc_w_at; ! s->st.sfree = (void *) mmap_sfree; ! s->st.close = (void *) mmap_close; ! s->st.seek = (void *) mmap_seek; s->st.truncate = (void *) fd_truncate; ! if (lseek (s->fd, s->file_length, SEEK_SET) < 0) ! return FAILURE; ! ! return SUCCESS; } ! #endif /********************************************************************* --- 595,774 ---- } s->physical_offset = s->file_length = s->logical_offset; s->active = 0; return SUCCESS; } ! /* Similar to memset(), but operating on a stream instead of a string. ! Takes care of not using too much memory. */ static try ! fd_sset (unix_stream * s, int c, size_t n) { ! size_t bytes_left; ! int trans; ! void *p; ! bytes_left = n; ! while (bytes_left > 0) ! { ! /* memset() in chunks of BUFFER_SIZE. */ ! trans = (bytes_left < BUFFER_SIZE) ? bytes_left : BUFFER_SIZE; ! p = fd_alloc_w_at (s, &trans, -1); ! if (p) ! memset (p, c, trans); ! else ! return FAILURE; ! bytes_left -= trans; ! } return SUCCESS; } ! /* Stream read function. Avoids using a buffer for big reads. The ! interface is like POSIX read(), but the nbytes argument is a ! pointer; on return it contains the number of bytes written. The ! function return value is the status indicator (0 for success). */ ! static int ! fd_read (unix_stream * s, void * buf, size_t * nbytes) ! { ! void *p; ! int tmp, status; ! if (*nbytes < BUFFER_SIZE && !s->unbuffered) ! { ! tmp = *nbytes; ! p = fd_alloc_r_at (s, &tmp, -1); ! if (p) ! { ! *nbytes = tmp; ! memcpy (buf, p, *nbytes); ! return 0; ! } ! else ! { ! *nbytes = 0; ! return errno; ! } ! } ! /* If the request is bigger than BUFFER_SIZE we flush the buffers ! and read directly. */ ! if (fd_flush (s) == FAILURE) ! { ! *nbytes = 0; ! return errno; ! } ! if (is_seekable ((stream *) s) && s->physical_offset != s->logical_offset ! && lseek (s->fd, s->logical_offset, SEEK_SET) < 0) { ! *nbytes = 0; ! return errno; } ! status = do_read (s, buf, nbytes); ! reset_stream (s, *nbytes); ! return status; } ! /* Stream write function. Avoids using a buffer for big writes. The ! interface is like POSIX write(), but the nbytes argument is a ! pointer; on return it contains the number of bytes written. The ! function return value is the status indicator (0 for success). */ ! static int ! fd_write (unix_stream * s, const void * buf, size_t * nbytes) ! { ! void *p; ! int tmp, status; ! if (*nbytes < BUFFER_SIZE && !s->unbuffered) { ! tmp = *nbytes; ! p = fd_alloc_w_at (s, &tmp, -1); ! if (p) ! { ! *nbytes = tmp; ! memcpy (p, buf, *nbytes); ! return 0; ! } ! else ! { ! *nbytes = 0; ! return errno; ! } } ! /* If the request is bigger than BUFFER_SIZE we flush the buffers ! and write directly. */ ! if (fd_flush (s) == FAILURE) ! { ! *nbytes = 0; ! return errno; ! } + if (is_seekable ((stream *) s) && s->physical_offset != s->logical_offset + && lseek (s->fd, s->logical_offset, SEEK_SET) < 0) + { + *nbytes = 0; + return errno; + } ! status = do_write (s, buf, nbytes); ! reset_stream (s, *nbytes); ! return status; } static try ! fd_close (unix_stream * s) { ! if (fd_flush (s) == FAILURE) ! return FAILURE; ! if (s->buffer != NULL && s->buffer != s->small_buffer) ! free_mem (s->buffer); ! if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO) ! { ! if (close (s->fd) < 0) ! return FAILURE; ! } + free_mem (s); return SUCCESS; } ! static void ! fd_open (unix_stream * s) { ! if (isatty (s->fd)) ! s->unbuffered = 1; ! s->st.alloc_r_at = (void *) fd_alloc_r_at; ! s->st.alloc_w_at = (void *) fd_alloc_w_at; ! s->st.sfree = (void *) fd_sfree; ! s->st.close = (void *) fd_close; ! s->st.seek = (void *) fd_seek; s->st.truncate = (void *) fd_truncate; + s->st.read = (void *) fd_read; + s->st.write = (void *) fd_write; + s->st.set = (void *) fd_sset; ! s->buffer = NULL; } ! /********************************************************************* *************** mem_alloc_w_at (unix_stream * s, int *le *** 811,822 **** { gfc_offset m; if (where == -1) where = s->logical_offset; m = where + *len; ! if (where < s->buffer_offset || m > s->buffer_offset + s->active) return NULL; s->logical_offset = m; --- 808,824 ---- { gfc_offset m; + assert (*len >= 0); /* Negative values not allowed. */ + if (where == -1) where = s->logical_offset; m = where + *len; ! if (where < s->buffer_offset) ! return NULL; ! ! if (m > s->file_length) return NULL; s->logical_offset = m; *************** mem_alloc_w_at (unix_stream * s, int *le *** 825,830 **** --- 827,886 ---- } + /* Stream read function for internal units. This is not actually used + at the moment, as all internal IO is formatted and the formatted IO + routines use mem_alloc_r_at. */ + + static int + mem_read (unix_stream * s, void * buf, size_t * nbytes) + { + void *p; + int tmp; + + tmp = *nbytes; + p = mem_alloc_r_at (s, &tmp, -1); + if (p) + { + *nbytes = tmp; + memcpy (buf, p, *nbytes); + return 0; + } + else + { + *nbytes = 0; + return errno; + } + } + + + /* Stream write function for internal units. This is not actually used + at the moment, as all internal IO is formatted and the formatted IO + routines use mem_alloc_w_at. */ + + static int + mem_write (unix_stream * s, const void * buf, size_t * nbytes) + { + void *p; + int tmp; + + errno = 0; + + tmp = *nbytes; + p = mem_alloc_w_at (s, &tmp, -1); + if (p) + { + *nbytes = tmp; + memcpy (p, buf, *nbytes); + return 0; + } + else + { + *nbytes = 0; + return errno; + } + } + + static int mem_seek (unix_stream * s, gfc_offset offset) { *************** mem_seek (unix_stream * s, gfc_offset of *** 839,846 **** } static int ! mem_truncate (unix_stream * s) { return SUCCESS; } --- 895,921 ---- } + static try + mem_set (unix_stream * s, int c, size_t n) + { + void *p; + int len; + + len = n; + + p = mem_alloc_w_at (s, &len, -1); + if (p) + { + memset (p, c, len); + return SUCCESS; + } + else + return FAILURE; + } + + static int ! mem_truncate (unix_stream * s __attribute__ ((unused))) { return SUCCESS; } *************** mem_close (unix_stream * s) *** 856,862 **** static try ! mem_sfree (unix_stream * s) { return SUCCESS; } --- 931,937 ---- static try ! mem_sfree (unix_stream * s __attribute__ ((unused))) { return SUCCESS; } *************** open_internal (char *base, int length) *** 899,904 **** --- 974,982 ---- s->st.close = (void *) mem_close; s->st.seek = (void *) mem_seek; s->st.truncate = (void *) mem_truncate; + s->st.read = (void *) mem_read; + s->st.write = (void *) mem_write; + s->st.set = (void *) mem_set; return (stream *) s; } *************** open_internal (char *base, int length) *** 908,914 **** * around it. */ static stream * ! fd_to_stream (int fd, int prot, int avoid_mmap) { struct stat statbuf; unix_stream *s; --- 986,992 ---- * around it. */ static stream * ! fd_to_stream (int fd, int prot) { struct stat statbuf; unix_stream *s; *************** fd_to_stream (int fd, int prot, int avoi *** 928,941 **** s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1; s->special_file = !S_ISREG (statbuf.st_mode); - #if HAVE_MMAP - if (avoid_mmap) - fd_open (s); - else - mmap_open (s); - #else fd_open (s); - #endif return (stream *) s; } --- 1006,1012 ---- *************** fd_to_stream (int fd, int prot, int avoi *** 944,958 **** /* Given the Fortran unit number, convert it to a C file descriptor. */ int ! unit_to_fd(int unit) { gfc_unit *us; ! us = find_unit(unit); if (us == NULL) return -1; ! return ((unix_stream *) us->s)->fd; } --- 1015,1032 ---- /* Given the Fortran unit number, convert it to a C file descriptor. */ int ! unit_to_fd (int unit) { gfc_unit *us; + int fd; ! us = find_unit (unit); if (us == NULL) return -1; ! fd = ((unix_stream *) us->s)->fd; ! unlock_unit (us); ! return fd; } *************** unpack_filename (char *cstring, const ch *** 978,988 **** * open it. mkstemp() opens the file for reading and writing, but the * library mode prevents anything that is not allowed. The descriptor * is returned, which is -1 on error. The template is pointed to by ! * ioparm.file, which is copied into the unit structure * and freed later. */ static int ! tempfile (void) { const char *tempdir; char *template; --- 1052,1062 ---- * open it. mkstemp() opens the file for reading and writing, but the * library mode prevents anything that is not allowed. The descriptor * is returned, which is -1 on error. The template is pointed to by ! * opp->file, which is copied into the unit structure * and freed later. */ static int ! tempfile (st_parameter_open *opp) { const char *tempdir; char *template; *************** tempfile (void) *** 1008,1014 **** if (mktemp (template)) do ! #ifdef HAVE_CRLF fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY, S_IREAD | S_IWRITE); #else --- 1082,1088 ---- if (mktemp (template)) do ! #if defined(HAVE_CRLF) && defined(O_BINARY) fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY, S_IREAD | S_IWRITE); #else *************** tempfile (void) *** 1024,1031 **** free_mem (template); else { ! ioparm.file = template; ! ioparm.file_len = strlen (template); /* Don't include trailing nul */ } return fd; --- 1098,1105 ---- free_mem (template); else { ! opp->file = template; ! opp->file_len = strlen (template); /* Don't include trailing nul */ } return fd; *************** tempfile (void) *** 1038,1044 **** * Returns the descriptor, which is less than zero on error. */ static int ! regular_file (unit_flags *flags) { char path[PATH_MAX + 1]; int mode; --- 1112,1118 ---- * Returns the descriptor, which is less than zero on error. */ static int ! regular_file (st_parameter_open *opp, unit_flags *flags) { char path[PATH_MAX + 1]; int mode; *************** regular_file (unit_flags *flags) *** 1046,1052 **** int crflag; int fd; ! if (unpack_filename (path, ioparm.file, ioparm.file_len)) { errno = ENOENT; /* Fake an OS error */ return -1; --- 1120,1126 ---- int crflag; int fd; ! if (unpack_filename (path, opp->file, opp->file_len)) { errno = ENOENT; /* Fake an OS error */ return -1; *************** regular_file (unit_flags *flags) *** 1070,1076 **** break; default: ! internal_error ("regular_file(): Bad action"); } switch (flags->status) --- 1144,1150 ---- break; default: ! internal_error (&opp->common, "regular_file(): Bad action"); } switch (flags->status) *************** regular_file (unit_flags *flags) *** 1093,1104 **** break; default: ! internal_error ("regular_file(): Bad status"); } /* rwflag |= O_LARGEFILE; */ ! #ifdef HAVE_CRLF crflag |= O_BINARY; #endif --- 1167,1178 ---- break; default: ! internal_error (&opp->common, "regular_file(): Bad status"); } /* rwflag |= O_LARGEFILE; */ ! #if defined(HAVE_CRLF) && defined(O_BINARY) crflag |= O_BINARY; #endif *************** regular_file (unit_flags *flags) *** 1144,1169 **** * Returns NULL on operating system error. */ stream * ! open_external (unit_flags *flags) { int fd, prot; if (flags->status == STATUS_SCRATCH) { ! fd = tempfile (); if (flags->action == ACTION_UNSPECIFIED) flags->action = ACTION_READWRITE; #if HAVE_UNLINK_OPEN_FILE /* We can unlink scratch files now and it will go away when closed. */ ! unlink (ioparm.file); #endif } else { /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and * if it succeeds */ ! fd = regular_file (flags); } if (fd < 0) --- 1218,1244 ---- * Returns NULL on operating system error. */ stream * ! open_external (st_parameter_open *opp, unit_flags *flags) { int fd, prot; if (flags->status == STATUS_SCRATCH) { ! fd = tempfile (opp); if (flags->action == ACTION_UNSPECIFIED) flags->action = ACTION_READWRITE; #if HAVE_UNLINK_OPEN_FILE /* We can unlink scratch files now and it will go away when closed. */ ! if (fd >= 0) ! unlink (opp->file); #endif } else { /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and * if it succeeds */ ! fd = regular_file (opp, flags); } if (fd < 0) *************** open_external (unit_flags *flags) *** 1185,1194 **** break; default: ! internal_error ("open_external(): Bad action"); } ! return fd_to_stream (fd, prot, 0); } --- 1260,1269 ---- break; default: ! internal_error (&opp->common, "open_external(): Bad action"); } ! return fd_to_stream (fd, prot); } *************** open_external (unit_flags *flags) *** 1198,1204 **** stream * input_stream (void) { ! return fd_to_stream (STDIN_FILENO, PROT_READ, 1); } --- 1273,1279 ---- stream * input_stream (void) { ! return fd_to_stream (STDIN_FILENO, PROT_READ); } *************** input_stream (void) *** 1208,1214 **** stream * output_stream (void) { ! return fd_to_stream (STDOUT_FILENO, PROT_WRITE, 1); } --- 1283,1289 ---- stream * output_stream (void) { ! return fd_to_stream (STDOUT_FILENO, PROT_WRITE); } *************** output_stream (void) *** 1218,1224 **** stream * error_stream (void) { ! return fd_to_stream (STDERR_FILENO, PROT_WRITE, 1); } /* init_error_stream()-- Return a pointer to the error stream. This --- 1293,1299 ---- stream * error_stream (void) { ! return fd_to_stream (STDERR_FILENO, PROT_WRITE); } /* init_error_stream()-- Return a pointer to the error stream. This *************** error_stream (void) *** 1227,1247 **** * corrupted. */ stream * ! init_error_stream (void) { ! static unix_stream error; ! ! memset (&error, '\0', sizeof (error)); ! error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO; ! error.st.alloc_w_at = (void *) fd_alloc_w_at; ! error.st.sfree = (void *) fd_sfree; ! error.unbuffered = 1; ! error.buffer = error.small_buffer; ! return (stream *) & error; } --- 1302,1320 ---- * corrupted. */ stream * ! init_error_stream (unix_stream *error) { ! memset (error, '\0', sizeof (*error)); ! error->fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO; ! error->st.alloc_w_at = (void *) fd_alloc_w_at; ! error->st.sfree = (void *) fd_sfree; ! error->unbuffered = 1; ! error->buffer = error->small_buffer; ! return (stream *) error; } *************** init_error_stream (void) *** 1250,1259 **** * filename. */ int ! compare_file_filename (stream * s, const char *name, int len) { char path[PATH_MAX + 1]; ! struct stat st1, st2; if (unpack_filename (path, name, len)) return 0; /* Can't be the same */ --- 1323,1335 ---- * filename. */ int ! compare_file_filename (gfc_unit *u, const char *name, int len) { char path[PATH_MAX + 1]; ! struct stat st1; ! #ifdef HAVE_WORKING_STAT ! struct stat st2; ! #endif if (unpack_filename (path, name, len)) return 0; /* Can't be the same */ *************** compare_file_filename (stream * s, const *** 1264,1295 **** if (stat (path, &st1) < 0) return 0; ! fstat (((unix_stream *) s)->fd, &st2); ! return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino); } /* find_file0()-- Recursive work function for find_file() */ static gfc_unit * ! find_file0 (gfc_unit * u, struct stat *st1) { - struct stat st2; gfc_unit *v; if (u == NULL) return NULL; ! if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 && ! st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino) return u; ! v = find_file0 (u->left, st1); if (v != NULL) return v; ! v = find_file0 (u->right, st1); if (v != NULL) return v; --- 1340,1389 ---- if (stat (path, &st1) < 0) return 0; ! #ifdef HAVE_WORKING_STAT ! fstat (((unix_stream *) (u->s))->fd, &st2); return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino); + #else + if (len != u->file_len) + return 0; + return (memcmp(path, u->file, len) == 0); + #endif } + #ifdef HAVE_WORKING_STAT + # define FIND_FILE0_DECL struct stat *st + # define FIND_FILE0_ARGS st + #else + # define FIND_FILE0_DECL const char *file, gfc_charlen_type file_len + # define FIND_FILE0_ARGS file, file_len + #endif + /* find_file0()-- Recursive work function for find_file() */ static gfc_unit * ! find_file0 (gfc_unit *u, FIND_FILE0_DECL) { gfc_unit *v; if (u == NULL) return NULL; ! #ifdef HAVE_WORKING_STAT ! if (u->s != NULL ! && fstat (((unix_stream *) u->s)->fd, &st[1]) >= 0 && ! st[0].st_dev == st[1].st_dev && st[0].st_ino == st[1].st_ino) ! return u; ! #else ! if (compare_string (u->file_len, u->file, file_len, file) == 0) return u; + #endif ! v = find_file0 (u->left, FIND_FILE0_ARGS); if (v != NULL) return v; ! v = find_file0 (u->right, FIND_FILE0_ARGS); if (v != NULL) return v; *************** find_file0 (gfc_unit * u, struct stat *s *** 1301,1318 **** * that has the file already open. Returns a pointer to the unit if so. */ gfc_unit * ! find_file (void) { char path[PATH_MAX + 1]; ! struct stat statbuf; ! if (unpack_filename (path, ioparm.file, ioparm.file_len)) return NULL; ! if (stat (path, &statbuf) < 0) return NULL; ! return find_file0 (g.unit_root, &statbuf); } --- 1395,1505 ---- * that has the file already open. Returns a pointer to the unit if so. */ gfc_unit * ! find_file (const char *file, gfc_charlen_type file_len) { char path[PATH_MAX + 1]; ! struct stat st[2]; ! gfc_unit *u; ! if (unpack_filename (path, file, file_len)) return NULL; ! if (stat (path, &st[0]) < 0) return NULL; ! __gthread_mutex_lock (&unit_lock); ! retry: ! u = find_file0 (unit_root, FIND_FILE0_ARGS); ! if (u != NULL) ! { ! /* Fast path. */ ! if (! __gthread_mutex_trylock (&u->lock)) ! { ! /* assert (u->closed == 0); */ ! __gthread_mutex_unlock (&unit_lock); ! return u; ! } ! ! inc_waiting_locked (u); ! } ! __gthread_mutex_unlock (&unit_lock); ! if (u != NULL) ! { ! __gthread_mutex_lock (&u->lock); ! if (u->closed) ! { ! __gthread_mutex_lock (&unit_lock); ! __gthread_mutex_unlock (&u->lock); ! if (predec_waiting_locked (u) == 0) ! free_mem (u); ! goto retry; ! } ! ! dec_waiting_unlocked (u); ! } ! return u; ! } ! ! static gfc_unit * ! flush_all_units_1 (gfc_unit *u, int min_unit) ! { ! while (u != NULL) ! { ! if (u->unit_number > min_unit) ! { ! gfc_unit *r = flush_all_units_1 (u->left, min_unit); ! if (r != NULL) ! return r; ! } ! if (u->unit_number >= min_unit) ! { ! if (__gthread_mutex_trylock (&u->lock)) ! return u; ! if (u->s) ! flush (u->s); ! __gthread_mutex_unlock (&u->lock); ! } ! u = u->right; ! } ! return NULL; ! } ! ! void ! flush_all_units (void) ! { ! gfc_unit *u; ! int min_unit = 0; ! ! __gthread_mutex_lock (&unit_lock); ! do ! { ! u = flush_all_units_1 (unit_root, min_unit); ! if (u != NULL) ! inc_waiting_locked (u); ! __gthread_mutex_unlock (&unit_lock); ! if (u == NULL) ! return; ! ! __gthread_mutex_lock (&u->lock); ! ! min_unit = u->unit_number + 1; ! ! if (u->closed == 0) ! { ! flush (u->s); ! __gthread_mutex_lock (&unit_lock); ! __gthread_mutex_unlock (&u->lock); ! (void) predec_waiting_locked (u); ! } ! else ! { ! __gthread_mutex_lock (&unit_lock); ! __gthread_mutex_unlock (&u->lock); ! if (predec_waiting_locked (u) == 0) ! free_mem (u); ! } ! } ! while (1); } *************** stream_at_bof (stream * s) *** 1333,1339 **** } ! /* stream_at_eof()-- Returns nonzero if the stream is at the beginning * of the file. */ int --- 1520,1526 ---- } ! /* stream_at_eof()-- Returns nonzero if the stream is at the end * of the file. */ int *************** delete_file (gfc_unit * u) *** 1372,1383 **** * the system */ int ! file_exists (void) { char path[PATH_MAX + 1]; struct stat statbuf; ! if (unpack_filename (path, ioparm.file, ioparm.file_len)) return 0; if (stat (path, &statbuf) < 0) --- 1559,1570 ---- * the system */ int ! file_exists (const char *file, gfc_charlen_type file_len) { char path[PATH_MAX + 1]; struct stat statbuf; ! if (unpack_filename (path, file, file_len)) return 0; if (stat (path, &statbuf) < 0) *************** file_exists (void) *** 1388,1394 **** ! static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN"; /* inquire_sequential()-- Given a fortran string, determine if the * file is suitable for sequential access. Returns a C-style --- 1575,1581 ---- ! static const char yes[] = "YES", no[] = "NO", unknown[] = "UNKNOWN"; /* inquire_sequential()-- Given a fortran string, determine if the * file is suitable for sequential access. Returns a C-style *************** file_position (stream * s) *** 1544,1552 **** int is_seekable (stream * s) { ! /* by convention, if file_length == -1, the file is not seekable ! note that a mmapped file is always seekable, an fd_ file may ! or may not be. */ return ((unix_stream *) s)->file_length!=-1; } --- 1731,1738 ---- int is_seekable (stream * s) { ! /* By convention, if file_length == -1, the file is not ! seekable. */ return ((unix_stream *) s)->file_length!=-1; } *************** stream_ttyname (stream *s) *** 1572,1577 **** --- 1758,1769 ---- #endif } + gfc_offset + stream_offset (stream *s) + { + return (((unix_stream *) s)->logical_offset); + } + /* How files are stored: This is an operating-system specific issue, and therefore belongs here. There are three cases to consider. diff -Nrcpad gcc-4.0.2/libgfortran/io/unix.h gcc-4.1.0/libgfortran/io/unix.h *** gcc-4.0.2/libgfortran/io/unix.h Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/io/unix.h Tue Nov 22 10:58:47 2005 *************** *** 0 **** --- 1,63 ---- + /* Copyright (C) 2002, 2003, 2004, 2005 + Free Software Foundation, Inc. + Contributed by Andy Vaught + + 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. */ + + /* Unix stream I/O module */ + + #define BUFFER_SIZE 8192 + + typedef struct + { + stream st; + + int fd; + gfc_offset buffer_offset; /* File offset of the start of the buffer */ + gfc_offset physical_offset; /* Current physical file offset */ + gfc_offset logical_offset; /* Current logical file offset */ + gfc_offset dirty_offset; /* Start of modified bytes in buffer */ + gfc_offset file_length; /* Length of the file, -1 if not seekable. */ + + char *buffer; + int len; /* Physical length of the current buffer */ + int active; /* Length of valid bytes in the buffer */ + + int prot; + int ndirty; /* Dirty bytes starting at dirty_offset */ + + int special_file; /* =1 if the fd refers to a special file */ + + unsigned unbuffered:1; + + char small_buffer[BUFFER_SIZE]; + + } + unix_stream; + + extern stream *init_error_stream (unix_stream *); + internal_proto(init_error_stream); diff -Nrcpad gcc-4.0.2/libgfortran/io/write.c gcc-4.1.0/libgfortran/io/write.c *** gcc-4.0.2/libgfortran/io/write.c Wed Sep 7 20:21:34 2005 --- gcc-4.1.0/libgfortran/io/write.c Tue Feb 14 15:47:49 2006 *************** GNU General Public License for more deta *** 25,34 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include --- 25,35 ---- 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. */ #include "config.h" + #include #include #include #include *************** Boston, MA 02111-1307, USA. */ *** 37,43 **** #include "libgfortran.h" #include "io.h" - #define star_fill(p, n) memset(p, '*', n) --- 38,43 ---- *************** typedef enum *** 46,62 **** sign_t; - static int no_leading_blank = 0 ; - void ! write_a (fnode * f, const char *source, int len) { int wlen; char *p; wlen = f->u.string.length < 0 ? len : f->u.string.length; ! p = write_block (wlen); if (p == NULL) return; --- 46,60 ---- sign_t; void ! write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len) { int wlen; char *p; wlen = f->u.string.length < 0 ? len : f->u.string.length; ! p = write_block (dtp, wlen); if (p == NULL) return; *************** write_a (fnode * f, const char *source, *** 69,78 **** } } ! static int64_t extract_int (const void *p, int len) { ! int64_t i = 0; if (p == NULL) return i; --- 67,76 ---- } } ! static GFC_INTEGER_LARGEST extract_int (const void *p, int len) { ! GFC_INTEGER_LARGEST i = 0; if (p == NULL) return i; *************** extract_int (const void *p, int len) *** 81,144 **** { case 1: { ! int8_t tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; case 2: { ! int16_t tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; case 4: { ! int32_t tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; case 8: { ! int64_t tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; default: ! internal_error ("bad integer kind"); } return i; } ! static double extract_real (const void *p, int len) { ! double i = 0.0; switch (len) { case 4: { ! float tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; case 8: { ! double tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; default: ! internal_error ("bad real kind"); } return i; - } --- 79,222 ---- { case 1: { ! GFC_INTEGER_1 tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; case 2: { ! GFC_INTEGER_2 tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; case 4: { ! GFC_INTEGER_4 tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; case 8: { ! GFC_INTEGER_8 tmp; ! memcpy ((void *) &tmp, p, len); ! i = tmp; ! } ! break; ! #ifdef HAVE_GFC_INTEGER_16 ! case 16: ! { ! GFC_INTEGER_16 tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; + #endif default: ! internal_error (NULL, "bad integer kind"); } return i; } ! static GFC_UINTEGER_LARGEST ! extract_uint (const void *p, int len) ! { ! GFC_UINTEGER_LARGEST i = 0; ! ! if (p == NULL) ! return i; ! ! switch (len) ! { ! case 1: ! { ! GFC_INTEGER_1 tmp; ! memcpy ((void *) &tmp, p, len); ! i = (GFC_UINTEGER_1) tmp; ! } ! break; ! case 2: ! { ! GFC_INTEGER_2 tmp; ! memcpy ((void *) &tmp, p, len); ! i = (GFC_UINTEGER_2) tmp; ! } ! break; ! case 4: ! { ! GFC_INTEGER_4 tmp; ! memcpy ((void *) &tmp, p, len); ! i = (GFC_UINTEGER_4) tmp; ! } ! break; ! case 8: ! { ! GFC_INTEGER_8 tmp; ! memcpy ((void *) &tmp, p, len); ! i = (GFC_UINTEGER_8) tmp; ! } ! break; ! #ifdef HAVE_GFC_INTEGER_16 ! case 16: ! { ! GFC_INTEGER_16 tmp; ! memcpy ((void *) &tmp, p, len); ! i = (GFC_UINTEGER_16) tmp; ! } ! break; ! #endif ! default: ! internal_error (NULL, "bad integer kind"); ! } ! ! return i; ! } ! ! static GFC_REAL_LARGEST extract_real (const void *p, int len) { ! GFC_REAL_LARGEST i = 0; switch (len) { case 4: { ! GFC_REAL_4 tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; case 8: { ! GFC_REAL_8 tmp; memcpy ((void *) &tmp, p, len); i = tmp; } break; + #ifdef HAVE_GFC_REAL_10 + case 10: + { + GFC_REAL_10 tmp; + memcpy ((void *) &tmp, p, len); + i = tmp; + } + break; + #endif + #ifdef HAVE_GFC_REAL_16 + case 16: + { + GFC_REAL_16 tmp; + memcpy ((void *) &tmp, p, len); + i = tmp; + } + break; + #endif default: ! internal_error (NULL, "bad real kind"); } return i; } *************** extract_real (const void *p, int len) *** 146,159 **** sign_t that gives the sign that we need to produce. */ static sign_t ! calculate_sign (int negative_flag) { sign_t s = SIGN_NONE; if (negative_flag) s = SIGN_MINUS; else ! switch (g.sign_status) { case SIGN_SP: s = SIGN_PLUS; --- 224,237 ---- sign_t that gives the sign that we need to produce. */ static sign_t ! calculate_sign (st_parameter_dt *dtp, int negative_flag) { sign_t s = SIGN_NONE; if (negative_flag) s = SIGN_MINUS; else ! switch (dtp->u.p.sign_status) { case SIGN_SP: s = SIGN_PLUS; *************** calculate_sign (int negative_flag) *** 172,182 **** /* Returns the value of 10**d. */ ! static double calculate_exp (int d) { int i; ! double r = 1.0; for (i = 0; i< (d >= 0 ? d : -d); i++) r *= 10; --- 250,260 ---- /* Returns the value of 10**d. */ ! static GFC_REAL_LARGEST calculate_exp (int d) { int i; ! GFC_REAL_LARGEST r = 1.0; for (i = 0; i< (d >= 0 ? d : -d); i++) r *= 10; *************** calculate_exp (int d) *** 205,217 **** for Gw.dEe, n' ' means e+2 blanks */ static fnode * ! calculate_G_format (fnode *f, double value, int len, int *num_blank) { int e = f->u.real.e; int d = f->u.real.d; int w = f->u.real.w; fnode *newf; ! double m, exp_d; int low, high, mid; int ubound, lbound; --- 283,296 ---- for Gw.dEe, n' ' means e+2 blanks */ static fnode * ! calculate_G_format (st_parameter_dt *dtp, const fnode *f, ! GFC_REAL_LARGEST value, int *num_blank) { int e = f->u.real.e; int d = f->u.real.d; int w = f->u.real.w; fnode *newf; ! GFC_REAL_LARGEST m, exp_d; int low, high, mid; int ubound, lbound; *************** calculate_G_format (fnode *f, double val *** 223,230 **** /* In case of the two data magnitude ranges, generate E editing, Ew.d[Ee]. */ exp_d = calculate_exp (d); ! if ((m > 0.0 && m < 0.1 - 0.05 / (double) exp_d) ! || (m >= (double) exp_d - 0.5 )) { newf->format = FMT_E; newf->u.real.w = w; --- 302,309 ---- /* In case of the two data magnitude ranges, generate E editing, Ew.d[Ee]. */ exp_d = calculate_exp (d); ! if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) || ! ((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003))) { newf->format = FMT_E; newf->u.real.w = w; *************** calculate_G_format (fnode *f, double val *** 243,249 **** while (low <= high) { ! double temp; mid = (low + high) / 2; /* 0.1 * 10**mid - 0.5 * 10**(mid-d-1) */ --- 322,328 ---- while (low <= high) { ! GFC_REAL_LARGEST temp; mid = (low + high) / 2; /* 0.1 * 10**mid - 0.5 * 10**(mid-d-1) */ *************** calculate_G_format (fnode *f, double val *** 287,293 **** newf->u.real.d = - (mid - d - 1); /* For F editing, the scale factor is ignored. */ ! g.scale_factor = 0; return newf; } --- 366,372 ---- newf->u.real.d = - (mid - d - 1); /* For F editing, the scale factor is ignored. */ ! dtp->u.p.scale_factor = 0; return newf; } *************** calculate_G_format (fnode *f, double val *** 295,303 **** /* Output a real number according to its format which is FMT_G free. */ static void ! output_float (fnode *f, double value, int len) { ! /* This must be large enough to accurately hold any value. */ char buffer[32]; char *out; char *digits; --- 374,382 ---- /* Output a real number according to its format which is FMT_G free. */ static void ! output_float (st_parameter_dt *dtp, const fnode *f, GFC_REAL_LARGEST value) { ! /* This must be large enough to accurately hold any value. */ char buffer[32]; char *out; char *digits; *************** output_float (fnode *f, double value, in *** 331,342 **** /* We should always know the field width and precision. */ if (d < 0) ! internal_error ("Unspecified precision"); /* Use sprintf to print the number in the format +D.DDDDe+ddd For an N digit exponent, this gives us (32-6)-N digits after the decimal point, plus another one before the decimal point. */ ! sign = calculate_sign (value < 0.0); if (value < 0) value = -value; --- 410,421 ---- /* We should always know the field width and precision. */ if (d < 0) ! internal_error (&dtp->common, "Unspecified precision"); /* Use sprintf to print the number in the format +D.DDDDe+ddd For an N digit exponent, this gives us (32-6)-N digits after the decimal point, plus another one before the decimal point. */ ! sign = calculate_sign (dtp, value < 0.0); if (value < 0) value = -value; *************** output_float (fnode *f, double value, in *** 345,359 **** edigits = 2; else { ! abslog = fabs(log10 (value)); if (abslog < 100) edigits = 2; else ! edigits = 1 + (int) log10 (abslog); } ! if (ft == FMT_F || ft == FMT_EN ! || ((ft == FMT_D || ft == FMT_E) && g.scale_factor != 0)) { /* Always convert at full precision to avoid double rounding. */ ndigits = 27 - edigits; --- 424,442 ---- edigits = 2; else { ! #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16) ! abslog = fabs((double) log10l(value)); ! #else ! abslog = fabs(log10(value)); ! #endif if (abslog < 100) edigits = 2; else ! edigits = 1 + (int) log10(abslog); } ! if (ft == FMT_F || ft == FMT_EN ! || ((ft == FMT_D || ft == FMT_E) && dtp->u.p.scale_factor != 0)) { /* Always convert at full precision to avoid double rounding. */ ndigits = 27 - edigits; *************** output_float (fnode *f, double value, in *** 370,380 **** ndigits = 27 - edigits; } ! sprintf (buffer, "%+-#31.*e", ndigits - 1, value); ! /* Check the resulting string has punctuation in the correct places. */ if (buffer[2] != '.' || buffer[ndigits + 2] != 'e') ! internal_error ("printf is broken"); /* Read the exponent back in. */ e = atoi (&buffer[ndigits + 3]) + 1; --- 453,480 ---- ndigits = 27 - edigits; } ! /* # The result will always contain a decimal point, even if no ! * digits follow it ! * ! * - The converted value is to be left adjusted on the field boundary ! * ! * + A sign (+ or -) always be placed before a number ! * ! * 31 minimum field width ! * ! * * (ndigits-1) is used as the precision ! * ! * e format: [-]d.dddeÂħdd where there is one digit before the ! * decimal-point character and the number of digits after it is ! * equal to the precision. The exponent always contains at least two ! * digits; if the value is zero, the exponent is 00. ! */ ! sprintf (buffer, "%+-#31.*" GFC_REAL_LARGEST_FORMAT "e", ! ndigits - 1, value); ! /* Check the resulting string has punctuation in the correct places. */ if (buffer[2] != '.' || buffer[ndigits + 2] != 'e') ! internal_error (&dtp->common, "printf is broken"); /* Read the exponent back in. */ e = atoi (&buffer[ndigits + 3]) + 1; *************** output_float (fnode *f, double value, in *** 391,397 **** switch (ft) { case FMT_F: ! nbefore = e + g.scale_factor; if (nbefore < 0) { nzero = -nbefore; --- 491,497 ---- switch (ft) { case FMT_F: ! nbefore = e + dtp->u.p.scale_factor; if (nbefore < 0) { nzero = -nbefore; *************** output_float (fnode *f, double value, in *** 411,417 **** case FMT_E: case FMT_D: ! i = g.scale_factor; if (value != 0.0) e -= i; if (i < 0) --- 511,517 ---- case FMT_E: case FMT_D: ! i = dtp->u.p.scale_factor; if (value != 0.0) e -= i; if (i < 0) *************** output_float (fnode *f, double value, in *** 470,476 **** default: /* Should never happen. */ ! internal_error ("Unexpected format token"); } /* Round the value. */ --- 570,576 ---- default: /* Should never happen. */ ! internal_error (&dtp->common, "Unexpected format token"); } /* Round the value. */ *************** output_float (fnode *f, double value, in *** 541,547 **** edigits = 1; for (i = abs (e); i >= 10; i /= 10) edigits++; ! if (f->u.real.e < 0) { /* Width not specified. Must be no more than 3 digits. */ --- 641,647 ---- edigits = 1; for (i = abs (e); i >= 10; i /= 10) edigits++; ! if (f->u.real.e < 0) { /* Width not specified. Must be no more than 3 digits. */ *************** output_float (fnode *f, double value, in *** 571,577 **** w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1); /* Create the ouput buffer. */ ! out = write_block (w); if (out == NULL) return; --- 671,677 ---- w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1); /* Create the ouput buffer. */ ! out = write_block (dtp, w); if (out == NULL) return; *************** output_float (fnode *f, double value, in *** 583,595 **** break; } if (i == ndigits) ! sign = calculate_sign (0); /* Work out how much padding is needed. */ nblanks = w - (nbefore + nzero + nafter + edigits + 1); if (sign != SIGN_NONE) nblanks--; ! /* Check the value fits in the specified field width. */ if (nblanks < 0 || edigits == -1) { --- 683,695 ---- break; } if (i == ndigits) ! sign = calculate_sign (dtp, 0); /* Work out how much padding is needed. */ nblanks = w - (nbefore + nzero + nafter + edigits + 1); if (sign != SIGN_NONE) nblanks--; ! /* Check the value fits in the specified field width. */ if (nblanks < 0 || edigits == -1) { *************** output_float (fnode *f, double value, in *** 606,615 **** else leadzero = 0; ! /* Padd to full field width. */ ! if ( ( nblanks > 0 ) && !no_leading_blank ) { memset (out, ' ', nblanks); out += nblanks; --- 706,715 ---- else leadzero = 0; ! /* Pad to full field width. */ ! if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank) { memset (out, ' ', nblanks); out += nblanks; *************** output_float (fnode *f, double value, in *** 667,673 **** ndigits -= i; out += nafter; } ! /* Output the exponent. */ if (expchar) { --- 767,773 ---- ndigits -= i; out += nafter; } ! /* Output the exponent. */ if (expchar) { *************** output_float (fnode *f, double value, in *** 684,705 **** memcpy (out, buffer, edigits); } ! if ( no_leading_blank ) { out += edigits; memset( out , ' ' , nblanks ); ! no_leading_blank = 0; } } void ! write_l (fnode * f, char *source, int len) { char *p; ! int64_t n; ! p = write_block (f->u.w); if (p == NULL) return; --- 784,805 ---- memcpy (out, buffer, edigits); } ! if (dtp->u.p.no_leading_blank) { out += edigits; memset( out , ' ' , nblanks ); ! dtp->u.p.no_leading_blank = 0; } } void ! write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len) { char *p; ! GFC_INTEGER_LARGEST n; ! p = write_block (dtp, f->u.w); if (p == NULL) return; *************** write_l (fnode * f, char *source, int le *** 711,719 **** /* Output a real number according to its format. */ static void ! write_float (fnode *f, const char *source, int len) { ! double n; int nb =0, res, save_scale_factor; char * p, fin; fnode *f2 = NULL; --- 811,819 ---- /* Output a real number according to its format. */ static void ! write_float (st_parameter_dt *dtp, const fnode *f, const char *source, int len) { ! GFC_REAL_LARGEST n; int nb =0, res, save_scale_factor; char * p, fin; fnode *f2 = NULL; *************** write_float (fnode *f, const char *sourc *** 722,728 **** if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z) { ! res = isfinite (n); if (res == 0) { nb = f->u.real.w; --- 822,828 ---- if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z) { ! res = isfinite (n); if (res == 0) { nb = f->u.real.w; *************** write_float (fnode *f, const char *sourc *** 731,737 **** not zero. 4 is chosen to allow output of '-Inf' or '+Inf' */ if (nb == 0) nb = 4; ! p = write_block (nb); if (nb < 3) { memset (p, '*',nb); --- 831,839 ---- not zero. 4 is chosen to allow output of '-Inf' or '+Inf' */ if (nb == 0) nb = 4; ! p = write_block (dtp, nb); ! if (p == NULL) ! return; if (nb < 3) { memset (p, '*',nb); *************** write_float (fnode *f, const char *sourc *** 788,808 **** } if (f->format != FMT_G) ! { ! output_float (f, n, len); ! } else { ! save_scale_factor = g.scale_factor; ! f2 = calculate_G_format(f, n, len, &nb); ! output_float (f2, n, len); ! g.scale_factor = save_scale_factor; if (f2 != NULL) free_mem(f2); if (nb > 0) { ! p = write_block (nb); memset (p, ' ', nb); } } --- 890,910 ---- } if (f->format != FMT_G) ! output_float (dtp, f, n); else { ! save_scale_factor = dtp->u.p.scale_factor; ! f2 = calculate_G_format (dtp, f, n, &nb); ! output_float (dtp, f2, n); ! dtp->u.p.scale_factor = save_scale_factor; if (f2 != NULL) free_mem(f2); if (nb > 0) { ! p = write_block (dtp, nb); ! if (p == NULL) ! return; memset (p, ' ', nb); } } *************** write_float (fnode *f, const char *sourc *** 810,826 **** static void ! write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t)) { ! uint32_t ns =0; ! uint64_t n = 0; int w, m, digits, nzero, nblank; ! char *p, *q; w = f->u.integer.w; m = f->u.integer.m; ! n = extract_int (source, len); /* Special case: */ --- 912,930 ---- static void ! write_int (st_parameter_dt *dtp, const fnode *f, const char *source, int len, ! const char *(*conv) (GFC_UINTEGER_LARGEST, char *, size_t)) { ! GFC_UINTEGER_LARGEST n = 0; int w, m, digits, nzero, nblank; ! char *p; ! const char *q; ! char itoa_buf[GFC_BTOA_BUF_SIZE]; w = f->u.integer.w; m = f->u.integer.m; ! n = extract_uint (source, len); /* Special case: */ *************** write_int (fnode *f, const char *source, *** 829,835 **** if (w == 0) w = 1; ! p = write_block (w); if (p == NULL) return; --- 933,939 ---- if (w == 0) w = 1; ! p = write_block (dtp, w); if (p == NULL) return; *************** write_int (fnode *f, const char *source, *** 837,851 **** goto done; } ! ! if (len < 8) ! { ! ns = n; ! q = conv (ns); ! } ! else ! q = conv (n); ! digits = strlen (q); /* Select a width if none was specified. The idea here is to always --- 941,947 ---- goto done; } ! q = conv (n, itoa_buf, sizeof (itoa_buf)); digits = strlen (q); /* Select a width if none was specified. The idea here is to always *************** write_int (fnode *f, const char *source, *** 854,860 **** if (w == 0) w = ((digits < m) ? m : digits); ! p = write_block (w); if (p == NULL) return; --- 950,956 ---- if (w == 0) w = ((digits < m) ? m : digits); ! p = write_block (dtp, w); if (p == NULL) return; *************** write_int (fnode *f, const char *source, *** 873,885 **** } ! if (!no_leading_blank) { ! memset (p, ' ', nblank); ! p += nblank; ! memset (p, '0', nzero); ! p += nzero; ! memcpy (p, q, digits); } else { --- 969,981 ---- } ! if (!dtp->u.p.no_leading_blank) { ! memset (p, ' ', nblank); ! p += nblank; ! memset (p, '0', nzero); ! p += nzero; ! memcpy (p, q, digits); } else { *************** write_int (fnode *f, const char *source, *** 888,894 **** memcpy (p, q, digits); p += digits; memset (p, ' ', nblank); ! no_leading_blank = 0; } done: --- 984,990 ---- memcpy (p, q, digits); p += digits; memset (p, ' ', nblank); ! dtp->u.p.no_leading_blank = 0; } done: *************** write_int (fnode *f, const char *source, *** 896,907 **** } static void ! write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t)) { ! int64_t n = 0; int w, m, digits, nsign, nzero, nblank; ! char *p, *q; sign_t sign; w = f->u.integer.w; m = f->u.integer.m; --- 992,1007 ---- } static void ! write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, ! int len, ! const char *(*conv) (GFC_INTEGER_LARGEST, char *, size_t)) { ! GFC_INTEGER_LARGEST n = 0; int w, m, digits, nsign, nzero, nblank; ! char *p; ! const char *q; sign_t sign; + char itoa_buf[GFC_BTOA_BUF_SIZE]; w = f->u.integer.w; m = f->u.integer.m; *************** write_decimal (fnode *f, const char *sou *** 915,921 **** if (w == 0) w = 1; ! p = write_block (w); if (p == NULL) return; --- 1015,1021 ---- if (w == 0) w = 1; ! p = write_block (dtp, w); if (p == NULL) return; *************** write_decimal (fnode *f, const char *sou *** 923,934 **** goto done; } ! sign = calculate_sign (n < 0); if (n < 0) n = -n; nsign = sign == SIGN_NONE ? 0 : 1; ! q = conv (n); digits = strlen (q); --- 1023,1034 ---- goto done; } ! sign = calculate_sign (dtp, n < 0); if (n < 0) n = -n; nsign = sign == SIGN_NONE ? 0 : 1; ! q = conv (n, itoa_buf, sizeof (itoa_buf)); digits = strlen (q); *************** write_decimal (fnode *f, const char *sou *** 938,944 **** if (w == 0) w = ((digits < m) ? m : digits) + nsign; ! p = write_block (w); if (p == NULL) return; --- 1038,1044 ---- if (w == 0) w = ((digits < m) ? m : digits) + nsign; ! p = write_block (dtp, w); if (p == NULL) return; *************** write_decimal (fnode *f, const char *sou *** 983,1116 **** /* Convert unsigned octal to ascii. */ ! static char * ! otoa (uint64_t n) { char *p; if (n == 0) ! { ! scratch[0] = '0'; ! scratch[1] = '\0'; ! return scratch; ! } ! p = scratch + SCRATCH_SIZE - 1; ! *p-- = '\0'; while (n != 0) { ! *p = '0' + (n & 7); ! p--; n >>= 3; } ! return ++p; } /* Convert unsigned binary to ascii. */ ! static char * ! btoa (uint64_t n) { char *p; if (n == 0) ! { ! scratch[0] = '0'; ! scratch[1] = '\0'; ! return scratch; ! } ! p = scratch + SCRATCH_SIZE - 1; ! *p-- = '\0'; while (n != 0) { ! *p-- = '0' + (n & 1); n >>= 1; } ! return ++p; } void ! write_i (fnode * f, const char *p, int len) { ! write_decimal (f, p, len, (void *) gfc_itoa); } void ! write_b (fnode * f, const char *p, int len) { ! write_int (f, p, len, btoa); } void ! write_o (fnode * f, const char *p, int len) { ! write_int (f, p, len, otoa); } void ! write_z (fnode * f, const char *p, int len) { ! write_int (f, p, len, xtoa); } void ! write_d (fnode *f, const char *p, int len) { ! write_float (f, p, len); } void ! write_e (fnode *f, const char *p, int len) { ! write_float (f, p, len); } void ! write_f (fnode *f, const char *p, int len) { ! write_float (f, p, len); } void ! write_en (fnode *f, const char *p, int len) { ! write_float (f, p, len); } void ! write_es (fnode *f, const char *p, int len) { ! write_float (f, p, len); } /* Take care of the X/TR descriptor. */ void ! write_x (int m, int nspaces) { char *p; ! p = write_block (m); if (p == NULL) return; if (nspaces > 0) ! memset ((char*)(p + m - nspaces), ' ', nspaces); } --- 1083,1211 ---- /* Convert unsigned octal to ascii. */ ! static const char * ! otoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) { char *p; + assert (len >= GFC_OTOA_BUF_SIZE); + if (n == 0) ! return "0"; ! p = buffer + GFC_OTOA_BUF_SIZE - 1; ! *p = '\0'; while (n != 0) { ! *--p = '0' + (n & 7); n >>= 3; } ! return p; } /* Convert unsigned binary to ascii. */ ! static const char * ! btoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) { char *p; + assert (len >= GFC_BTOA_BUF_SIZE); + if (n == 0) ! return "0"; ! p = buffer + GFC_BTOA_BUF_SIZE - 1; ! *p = '\0'; while (n != 0) { ! *--p = '0' + (n & 1); n >>= 1; } ! return p; } void ! write_i (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_decimal (dtp, f, p, len, (void *) gfc_itoa); } void ! write_b (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_int (dtp, f, p, len, btoa); } void ! write_o (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_int (dtp, f, p, len, otoa); } void ! write_z (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_int (dtp, f, p, len, xtoa); } void ! write_d (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_float (dtp, f, p, len); } void ! write_e (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_float (dtp, f, p, len); } void ! write_f (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_float (dtp, f, p, len); } void ! write_en (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_float (dtp, f, p, len); } void ! write_es (st_parameter_dt *dtp, const fnode *f, const char *p, int len) { ! write_float (dtp, f, p, len); } /* Take care of the X/TR descriptor. */ void ! write_x (st_parameter_dt *dtp, int len, int nspaces) { char *p; ! p = write_block (dtp, len); if (p == NULL) return; if (nspaces > 0) ! memset (&p[len - nspaces], ' ', nspaces); } *************** write_x (int m, int nspaces) *** 1121,1131 **** something goes wrong. */ static int ! write_char (char c) { char *p; ! p = write_block (1); if (p == NULL) return 1; --- 1216,1226 ---- something goes wrong. */ static int ! write_char (st_parameter_dt *dtp, char c) { char *p; ! p = write_block (dtp, 1); if (p == NULL) return 1; *************** write_char (char c) *** 1138,1160 **** /* Write a list-directed logical value. */ static void ! write_logical (const char *source, int length) { ! write_char (extract_int (source, length) ? 'T' : 'F'); } /* Write a list-directed integer value. */ static void ! write_integer (const char *source, int length) { char *p; const char *q; int digits; int width; ! q = gfc_itoa (extract_int (source, length)); switch (length) { --- 1233,1256 ---- /* Write a list-directed logical value. */ static void ! write_logical (st_parameter_dt *dtp, const char *source, int length) { ! write_char (dtp, extract_int (source, length) ? 'T' : 'F'); } /* Write a list-directed integer value. */ static void ! write_integer (st_parameter_dt *dtp, const char *source, int length) { char *p; const char *q; int digits; int width; + char itoa_buf[GFC_ITOA_BUF_SIZE]; ! q = gfc_itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf)); switch (length) { *************** write_integer (const char *source, int l *** 1181,1198 **** digits = strlen (q); ! if(width < digits ) ! width = digits ; ! p = write_block (width) ; ! if (no_leading_blank) { memcpy (p, q, digits); ! memset(p + digits ,' ', width - digits) ; } else { ! memset(p ,' ', width - digits) ; ! memcpy (p + width - digits, q, digits); } } --- 1277,1296 ---- digits = strlen (q); ! if (width < digits) ! width = digits; ! p = write_block (dtp, width); ! if (p == NULL) ! return; ! if (dtp->u.p.no_leading_blank) { memcpy (p, q, digits); ! memset (p + digits, ' ', width - digits); } else { ! memset (p, ' ', width - digits); ! memcpy (p + width - digits, q, digits); } } *************** write_integer (const char *source, int l *** 1201,1212 **** the strings if the file has been opened in that mode. */ static void ! write_character (const char *source, int length) { int i, extra; char *p, d; ! switch (current_unit->flags.delim) { case DELIM_APOSTROPHE: d = '\''; --- 1299,1310 ---- the strings if the file has been opened in that mode. */ static void ! write_character (st_parameter_dt *dtp, const char *source, int length) { int i, extra; char *p, d; ! switch (dtp->u.p.current_unit->flags.delim) { case DELIM_APOSTROPHE: d = '\''; *************** write_character (const char *source, int *** 1230,1236 **** extra++; } ! p = write_block (length + extra); if (p == NULL) return; --- 1328,1334 ---- extra++; } ! p = write_block (dtp, length + extra); if (p == NULL) return; *************** write_character (const char *source, int *** 1253,1307 **** /* Output a real number with default format. ! This is 1PG14.7E2 for REAL(4) and 1PG23.15E3 for REAL(8). */ static void ! write_real (const char *source, int length) { fnode f ; ! int org_scale = g.scale_factor; f.format = FMT_G; ! g.scale_factor = 1; ! if (length < 8) { f.u.real.w = 14; f.u.real.d = 7; f.u.real.e = 2; ! } ! else ! { f.u.real.w = 23; f.u.real.d = 15; f.u.real.e = 3; } ! write_float (&f, source , length); ! g.scale_factor = org_scale; } static void ! write_complex (const char *source, int len) { ! if (write_char ('(')) return; ! write_real (source, len); ! if (write_char (',')) return; ! write_real (source + len, len); ! write_char (')'); } /* Write the separator between items. */ static void ! write_separator (void) { char *p; ! p = write_block (options.separator_len); if (p == NULL) return; --- 1351,1420 ---- /* Output a real number with default format. ! This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8), ! 1PG24.15E4 for REAL(10) and 1PG40.31E4 for REAL(16). */ static void ! write_real (st_parameter_dt *dtp, const char *source, int length) { fnode f ; ! int org_scale = dtp->u.p.scale_factor; f.format = FMT_G; ! dtp->u.p.scale_factor = 1; ! switch (length) { + case 4: f.u.real.w = 14; f.u.real.d = 7; f.u.real.e = 2; ! break; ! case 8: f.u.real.w = 23; f.u.real.d = 15; f.u.real.e = 3; + break; + case 10: + f.u.real.w = 28; + f.u.real.d = 19; + f.u.real.e = 4; + break; + case 16: + f.u.real.w = 40; + f.u.real.d = 31; + f.u.real.e = 4; + break; + default: + internal_error (&dtp->common, "bad real kind"); + break; } ! write_float (dtp, &f, source , length); ! dtp->u.p.scale_factor = org_scale; } static void ! write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size) { ! if (write_char (dtp, '(')) return; ! write_real (dtp, source, kind); ! if (write_char (dtp, ',')) return; ! write_real (dtp, source + size / 2, kind); ! write_char (dtp, ')'); } /* Write the separator between items. */ static void ! write_separator (st_parameter_dt *dtp) { char *p; ! p = write_block (dtp, options.separator_len); if (p == NULL) return; *************** write_separator (void) *** 1313,1361 **** TODO: handle skipping to the next record correctly, particularly with strings. */ ! void ! list_formatted_write (bt type, void *p, int len) { ! static int char_flag; ! ! if (current_unit == NULL) return; ! if (g.first_item) { ! g.first_item = 0; ! char_flag = 0; ! write_char (' '); } else { ! if (type != BT_CHARACTER || !char_flag || ! current_unit->flags.delim != DELIM_NONE) ! write_separator (); } switch (type) { case BT_INTEGER: ! write_integer (p, len); break; case BT_LOGICAL: ! write_logical (p, len); break; case BT_CHARACTER: ! write_character (p, len); break; case BT_REAL: ! write_real (p, len); break; case BT_COMPLEX: ! write_complex (p, len); break; default: ! internal_error ("list_formatted_write(): Bad type"); } ! char_flag = (type == BT_CHARACTER); } /* NAMELIST OUTPUT --- 1426,1490 ---- TODO: handle skipping to the next record correctly, particularly with strings. */ ! static void ! list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, ! size_t size) { ! if (dtp->u.p.current_unit == NULL) return; ! if (dtp->u.p.first_item) { ! dtp->u.p.first_item = 0; ! write_char (dtp, ' '); } else { ! if (type != BT_CHARACTER || !dtp->u.p.char_flag || ! dtp->u.p.current_unit->flags.delim != DELIM_NONE) ! write_separator (dtp); } switch (type) { case BT_INTEGER: ! write_integer (dtp, p, kind); break; case BT_LOGICAL: ! write_logical (dtp, p, kind); break; case BT_CHARACTER: ! write_character (dtp, p, kind); break; case BT_REAL: ! write_real (dtp, p, kind); break; case BT_COMPLEX: ! write_complex (dtp, p, kind, size); break; default: ! internal_error (&dtp->common, "list_formatted_write(): Bad type"); } ! dtp->u.p.char_flag = (type == BT_CHARACTER); ! } ! ! ! void ! list_formatted_write (st_parameter_dt *dtp, bt type, void *p, int kind, ! size_t size, size_t nelems) ! { ! size_t elem; ! char *tmp; ! ! tmp = (char *) p; ! ! /* Big loop over all the elements. */ ! for (elem = 0; elem < nelems; elem++) ! { ! dtp->u.p.item_count++; ! list_formatted_write_scalar (dtp, type, tmp + size*elem, kind, size); ! } } /* NAMELIST OUTPUT *************** list_formatted_write (bt type, void *p, *** 1381,1392 **** #define NML_DIGITS 20 - /* Stores the delimiter to be used for character objects. */ - - static char * nml_delim; - static namelist_info * ! nml_write_obj (namelist_info * obj, index_type offset, namelist_info * base, char * base_name) { int rep_ctr; --- 1510,1517 ---- #define NML_DIGITS 20 static namelist_info * ! nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, namelist_info * base, char * base_name) { int rep_ctr; *************** nml_write_obj (namelist_info * obj, inde *** 1412,1434 **** if (obj->type != GFC_DTYPE_DERIVED) { ! write_character ("\n ", 2); len = 0; if (base) { len =strlen (base->var_name); ! for (dim_i = 0; dim_i < strlen (base_name); dim_i++) { cup = toupper (base_name[dim_i]); ! write_character (&cup, 1); } } ! for (dim_i =len; dim_i < strlen (obj->var_name); dim_i++) { cup = toupper (obj->var_name[dim_i]); ! write_character (&cup, 1); } ! write_character ("=", 1); } /* Counts the number of data output on a line, including names. */ --- 1537,1563 ---- if (obj->type != GFC_DTYPE_DERIVED) { ! #ifdef HAVE_CRLF ! write_character (dtp, "\r\n ", 3); ! #else ! write_character (dtp, "\n ", 2); ! #endif len = 0; if (base) { len =strlen (base->var_name); ! for (dim_i = 0; dim_i < (index_type) strlen (base_name); dim_i++) { cup = toupper (base_name[dim_i]); ! write_character (dtp, &cup, 1); } } ! for (dim_i =len; dim_i < (index_type) strlen (obj->var_name); dim_i++) { cup = toupper (obj->var_name[dim_i]); ! write_character (dtp, &cup, 1); } ! write_character (dtp, "=", 1); } /* Counts the number of data output on a line, including names. */ *************** nml_write_obj (namelist_info * obj, inde *** 1436,1446 **** num = 1; len = obj->len; ! obj_size = len; ! if (obj->type == GFC_DTYPE_COMPLEX) ! obj_size = 2*len; ! if (obj->type == GFC_DTYPE_CHARACTER) ! obj_size = obj->string_length; if (obj->var_rank) obj_size = obj->size; --- 1565,1590 ---- num = 1; len = obj->len; ! ! switch (obj->type) ! { ! ! case GFC_DTYPE_REAL: ! obj_size = size_from_real_kind (len); ! break; ! ! case GFC_DTYPE_COMPLEX: ! obj_size = size_from_complex_kind (len); ! break; ! ! case GFC_DTYPE_CHARACTER: ! obj_size = obj->string_length; ! break; ! ! default: ! obj_size = len; ! } ! if (obj->var_rank) obj_size = obj->size; *************** nml_write_obj (namelist_info * obj, inde *** 1483,1533 **** if (rep_ctr > 1) { st_sprintf(rep_buff, " %d*", rep_ctr); ! write_character (rep_buff, strlen (rep_buff)); ! no_leading_blank = 1; } num++; ! /* Output the data, if an intrinsic type, or recurse into this routine to treat derived types. */ switch (obj->type) { case GFC_DTYPE_INTEGER: ! write_integer (p, len); break; case GFC_DTYPE_LOGICAL: ! write_logical (p, len); break; case GFC_DTYPE_CHARACTER: ! if (nml_delim) ! write_character (nml_delim, 1); ! write_character (p, obj->string_length); ! if (nml_delim) ! write_character (nml_delim, 1); break; case GFC_DTYPE_REAL: ! write_real (p, len); break; case GFC_DTYPE_COMPLEX: ! no_leading_blank = 0; num++; ! write_complex (p, len); break; case GFC_DTYPE_DERIVED: /* To treat a derived type, we need to build two strings: ext_name = the name, including qualifiers that prepends ! component names in the output - passed to nml_write_obj. obj_name = the derived type name with no qualifiers but % ! appended. This is used to identify the components. */ /* First ext_name => get length of all possible components */ --- 1627,1677 ---- if (rep_ctr > 1) { st_sprintf(rep_buff, " %d*", rep_ctr); ! write_character (dtp, rep_buff, strlen (rep_buff)); ! dtp->u.p.no_leading_blank = 1; } num++; ! /* Output the data, if an intrinsic type, or recurse into this routine to treat derived types. */ switch (obj->type) { case GFC_DTYPE_INTEGER: ! write_integer (dtp, p, len); break; case GFC_DTYPE_LOGICAL: ! write_logical (dtp, p, len); break; case GFC_DTYPE_CHARACTER: ! if (dtp->u.p.nml_delim) ! write_character (dtp, &dtp->u.p.nml_delim, 1); ! write_character (dtp, p, obj->string_length); ! if (dtp->u.p.nml_delim) ! write_character (dtp, &dtp->u.p.nml_delim, 1); break; case GFC_DTYPE_REAL: ! write_real (dtp, p, len); break; case GFC_DTYPE_COMPLEX: ! dtp->u.p.no_leading_blank = 0; num++; ! write_complex (dtp, p, len, obj_size); break; case GFC_DTYPE_DERIVED: /* To treat a derived type, we need to build two strings: ext_name = the name, including qualifiers that prepends ! component names in the output - passed to nml_write_obj. obj_name = the derived type name with no qualifiers but % ! appended. This is used to identify the components. */ /* First ext_name => get length of all possible components */ *************** nml_write_obj (namelist_info * obj, inde *** 1548,1554 **** { strcat (ext_name, dim_i ? "" : "("); clen = strlen (ext_name); ! st_sprintf (ext_name + clen, "%d", obj->ls[dim_i].idx); strcat (ext_name, (dim_i == obj->var_rank - 1) ? ")" : ","); } --- 1692,1698 ---- { strcat (ext_name, dim_i ? "" : "("); clen = strlen (ext_name); ! st_sprintf (ext_name + clen, "%d", (int) obj->ls[dim_i].idx); strcat (ext_name, (dim_i == obj->var_rank - 1) ? ")" : ","); } *************** nml_write_obj (namelist_info * obj, inde *** 1567,1573 **** cmp && !strncmp (cmp->var_name, obj_name, obj_name_len); cmp = retval) { ! retval = nml_write_obj (cmp, (index_type)(p - obj->mem_pos), obj, ext_name); } --- 1711,1718 ---- cmp && !strncmp (cmp->var_name, obj_name, obj_name_len); cmp = retval) { ! retval = nml_write_obj (dtp, cmp, ! (index_type)(p - obj->mem_pos), obj, ext_name); } *************** nml_write_obj (namelist_info * obj, inde *** 1576,1594 **** goto obj_loop; default: ! internal_error ("Bad type for namelist write"); } /* Reset the leading blank suppression, write a comma and, if 5 values have been output, write a newline and advance to column 2. Reset the repeat counter. */ ! no_leading_blank = 0; ! write_character (",", 1); if (num > 5) { num = 0; ! write_character ("\n ", 2); } rep_ctr = 1; } --- 1721,1743 ---- goto obj_loop; default: ! internal_error (&dtp->common, "Bad type for namelist write"); } /* Reset the leading blank suppression, write a comma and, if 5 values have been output, write a newline and advance to column 2. Reset the repeat counter. */ ! dtp->u.p.no_leading_blank = 0; ! write_character (dtp, ",", 1); if (num > 5) { num = 0; ! #ifdef HAVE_CRLF ! write_character (dtp, "\r\n ", 3); ! #else ! write_character (dtp, "\n ", 2); ! #endif } rep_ctr = 1; } *************** obj_loop: *** 1616,1627 **** } /* This is the entry function for namelist writes. It outputs the name ! of the namelist and iterates through the namelist by calls to ! nml_write_obj. The call below has dummys in the arguments used in the treatment of derived types. */ void ! namelist_write (void) { namelist_info * t1, *t2, *dummy = NULL; index_type i; --- 1765,1776 ---- } /* This is the entry function for namelist writes. It outputs the name ! of the namelist and iterates through the namelist by calls to ! nml_write_obj. The call below has dummys in the arguments used in the treatment of derived types. */ void ! namelist_write (st_parameter_dt *dtp) { namelist_info * t1, *t2, *dummy = NULL; index_type i; *************** namelist_write (void) *** 1632,1678 **** /* Set the delimiter for namelist output. */ ! tmp_delim = current_unit->flags.delim; ! current_unit->flags.delim = DELIM_NONE; switch (tmp_delim) { case (DELIM_QUOTE): ! nml_delim = "\""; break; case (DELIM_APOSTROPHE): ! nml_delim = "'"; break; default: ! nml_delim = NULL; } ! write_character ("&",1); /* Write namelist name in upper case - f95 std. */ ! for (i = 0 ;i < ioparm.namelist_name_len ;i++ ) { ! c = toupper (ioparm.namelist_name[i]); ! write_character (&c ,1); ! } ! if (ionml != NULL) { ! t1 = ionml; while (t1 != NULL) { t2 = t1; ! t1 = nml_write_obj (t2, dummy_offset, dummy, dummy_name); } } ! write_character (" /\n", 4); /* Recover the original delimiter. */ ! current_unit->flags.delim = tmp_delim; } #undef NML_DIGITS - --- 1781,1831 ---- /* Set the delimiter for namelist output. */ ! tmp_delim = dtp->u.p.current_unit->flags.delim; ! dtp->u.p.current_unit->flags.delim = DELIM_NONE; switch (tmp_delim) { case (DELIM_QUOTE): ! dtp->u.p.nml_delim = '"'; break; case (DELIM_APOSTROPHE): ! dtp->u.p.nml_delim = '\''; break; default: ! dtp->u.p.nml_delim = '\0'; ! break; } ! write_character (dtp, "&", 1); /* Write namelist name in upper case - f95 std. */ ! for (i = 0 ;i < dtp->namelist_name_len ;i++ ) { ! c = toupper (dtp->namelist_name[i]); ! write_character (dtp, &c ,1); ! } ! if (dtp->u.p.ionml != NULL) { ! t1 = dtp->u.p.ionml; while (t1 != NULL) { t2 = t1; ! t1 = nml_write_obj (dtp, t2, dummy_offset, dummy, dummy_name); } } ! #ifdef HAVE_CRLF ! write_character (dtp, " /\r\n", 5); ! #else ! write_character (dtp, " /\n", 4); ! #endif /* Recover the original delimiter. */ ! dtp->u.p.current_unit->flags.delim = tmp_delim; } #undef NML_DIGITS diff -Nrcpad gcc-4.0.2/libgfortran/libgfortran.h gcc-4.1.0/libgfortran/libgfortran.h *** gcc-4.0.2/libgfortran/libgfortran.h Thu Aug 11 13:53:22 2005 --- gcc-4.1.0/libgfortran/libgfortran.h Tue Feb 14 17:28:02 2006 *************** *** 1,5 **** ! /* Common declarations for all of libgfor. ! Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. Contributed by Paul Brook , and Andy Vaught --- 1,5 ---- ! /* Common declarations for all of libgfortran. ! Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. Contributed by Paul Brook , and Andy Vaught *************** GNU Lesser General Public License for mo *** 17,24 **** You should have received a copy of the GNU Lesser General Public License along with libgfor; see the file COPYING.LIB. If not, ! write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ /* As a special exception, if you link this library with other files, some of which are compiled with GCC, to produce an executable, --- 17,24 ---- You should have received a copy of the GNU Lesser General Public License along with libgfor; see the file COPYING.LIB. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ /* As a special exception, if you link this library with other files, some of which are compiled with GCC, to produce an executable, *************** Boston, MA 02111-1307, USA. */ *** 38,74 **** #define M_PI 3.14159265358979323846264338327 #endif - #include "config.h" - #include "c99_protos.h" - #if HAVE_COMPLEX_H # include #else #define complex __complex__ #endif #if HAVE_IEEEFP_H #include #endif ! #if HAVE_STDINT_H ! #include ! #endif ! ! #if HAVE_INTTYPES_H ! #include ! #endif ! ! #if !defined(HAVE_STDINT_H) && !defined(HAVE_INTTYPES_H) && defined(TARGET_ILP32) ! typedef char int8_t; ! typedef short int16_t; ! typedef int int32_t; ! typedef long long int64_t; ! typedef unsigned char uint8_t; ! typedef unsigned short uint16_t; ! typedef unsigned int uint32_t; ! typedef unsigned long long uint64_t; ! #endif #if HAVE_SYS_TYPES_H #include --- 38,57 ---- #define M_PI 3.14159265358979323846264338327 #endif #if HAVE_COMPLEX_H # include #else #define complex __complex__ #endif + #include "config.h" + #include "c99_protos.h" + #if HAVE_IEEEFP_H #include #endif ! #include "gstdint.h" #if HAVE_SYS_TYPES_H #include *************** typedef off_t gfc_offset; *** 177,189 **** When isfinite is not available, try to use one of the alternatives, or bail out. */ ! #if (!defined(isfinite) || defined(__CYGWIN__)) #undef isfinite ! #if defined(fpclassify) #define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE) #else ! #define isfinite(x) ((x) - (x) == 0) ! #endif #endif /* !defined(isfinite) */ /* TODO: find the C99 version of these an move into above ifdef. */ --- 160,192 ---- When isfinite is not available, try to use one of the alternatives, or bail out. */ ! ! #if defined(HAVE_BROKEN_ISFINITE) || defined(__CYGWIN__) #undef isfinite ! #endif ! ! #if defined(HAVE_BROKEN_ISNAN) ! #undef isnan ! #endif ! ! #if defined(HAVE_BROKEN_FPCLASSIFY) ! #undef fpclassify ! #endif ! ! #if !defined(isfinite) ! #if !defined(fpclassify) ! #define isfinite(x) ((x) - (x) == 0) ! #else #define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE) + #endif /* !defined(fpclassify) */ + #endif /* !defined(isfinite) */ + + #if !defined(isnan) + #if !defined(fpclassify) + #define isnan(x) ((x) != (x)) #else ! #define isnan(x) (fpclassify(x) == FP_NAN) ! #endif /* !defined(fpclassify) */ #endif /* !defined(isfinite) */ /* TODO: find the C99 version of these an move into above ifdef. */ *************** typedef off_t gfc_offset; *** 191,210 **** #define IMAGPART(z) (__imag__(z)) #define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);} ! typedef int8_t GFC_INTEGER_1; ! typedef int16_t GFC_INTEGER_2; ! typedef int32_t GFC_INTEGER_4; ! typedef int64_t GFC_INTEGER_8; ! typedef uint8_t GFC_UINTEGER_1; ! typedef uint16_t GFC_UINTEGER_2; ! typedef uint32_t GFC_UINTEGER_4; ! typedef uint64_t GFC_UINTEGER_8; ! typedef GFC_INTEGER_4 GFC_LOGICAL_4; ! typedef GFC_INTEGER_8 GFC_LOGICAL_8; ! typedef float GFC_REAL_4; ! typedef double GFC_REAL_8; ! typedef complex float GFC_COMPLEX_4; ! typedef complex double GFC_COMPLEX_8; /* The following two definitions must be consistent with the types used by the compiler. */ --- 194,200 ---- #define IMAGPART(z) (__imag__(z)) #define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);} ! #include "kinds.h" /* The following two definitions must be consistent with the types used by the compiler. */ *************** internal_proto(l8_to_l4_offset); *** 224,231 **** --- 214,232 ---- (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1) #define GFC_INTEGER_8_HUGE \ (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1) + #ifdef HAVE_GFC_INTEGER_16 + #define GFC_INTEGER_16_HUGE \ + (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1) + #endif + #define GFC_REAL_4_HUGE FLT_MAX #define GFC_REAL_8_HUGE DBL_MAX + #ifdef HAVE_GFC_REAL_10 + #define GFC_REAL_10_HUGE LDBL_MAX + #endif + #ifdef HAVE_GFC_REAL_16 + #define GFC_REAL_16_HUGE LDBL_MAX + #endif #ifndef GFC_MAX_DIMENSIONS #define GFC_MAX_DIMENSIONS 7 *************** descriptor_dimension; *** 242,248 **** #define GFC_ARRAY_DESCRIPTOR(r, type) \ struct {\ type *data;\ ! type *base;\ index_type dtype;\ descriptor_dimension dim[r];\ } --- 243,249 ---- #define GFC_ARRAY_DESCRIPTOR(r, type) \ struct {\ type *data;\ ! size_t offset;\ index_type dtype;\ descriptor_dimension dim[r];\ } *************** typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI *** 252,263 **** --- 253,282 ---- typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char; typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4; typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8; + #ifdef HAVE_GFC_INTEGER_16 + typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16; + #endif typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4; typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8; + #ifdef HAVE_GFC_REAL_10 + typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10; + #endif + #ifdef HAVE_GFC_REAL_16 + typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16; + #endif typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4; typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8; + #ifdef HAVE_GFC_COMPLEX_10 + typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10; + #endif + #ifdef HAVE_GFC_COMPLEX_16 + typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16; + #endif typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4; typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8; + #ifdef HAVE_GFC_LOGICAL_16 + typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16; + #endif #define GFC_DTYPE_RANK_MASK 0x07 #define GFC_DTYPE_TYPE_SHIFT 3 *************** typedef struct *** 301,308 **** int mem_check; int use_stderr, all_unbuffered, default_recl; ! int fpu_round, fpu_precision, fpu_invalid, fpu_denormal, fpu_zerodiv, ! fpu_overflow, fpu_underflow, fpu_precision_loss; int sighup, sigint; } --- 320,326 ---- int mem_check; int use_stderr, all_unbuffered, default_recl; ! int fpu_round, fpu_precision, fpe; int sighup, sigint; } *************** typedef struct *** 318,330 **** { int warn_std; int allow_std; } compile_options_t; extern compile_options_t compile_options; internal_proto(compile_options); ! /* Structure for statement options. */ --- 336,351 ---- { int warn_std; int allow_std; + int pedantic; + int convert; } compile_options_t; extern compile_options_t compile_options; internal_proto(compile_options); ! extern void init_compile_options (void); ! internal_proto(init_compile_options); /* Structure for statement options. */ *************** typedef enum *** 356,361 **** --- 377,384 ---- ERROR_BAD_US, ERROR_READ_VALUE, ERROR_READ_OVERFLOW, + ERROR_INTERNAL, + ERROR_INTERNAL_UNIT, ERROR_LAST /* Not a real error, the last error # + 1. */ } error_codes; *************** error_codes; *** 372,377 **** --- 395,408 ---- #define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */ #define GFC_STD_F77 (1<<0) /* Up to and including F77. */ + /* Bitmasks for the various FPE that can be enabled. + Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */ + #define GFC_FPE_INVALID (1<<0) + #define GFC_FPE_DENORMAL (1<<1) + #define GFC_FPE_ZERO (1<<2) + #define GFC_FPE_OVERFLOW (1<<3) + #define GFC_FPE_UNDERFLOW (1<<4) + #define GFC_FPE_PRECISION (1<<5) /* The filename and line number don't go inside the globals structure. They are set by the rest of the program and must be linked to. */ *************** iexport_data_proto(filename); *** 390,400 **** /* main.c */ ! extern void library_start (void); internal_proto(library_start); ! extern void library_end (void); ! internal_proto(library_end); extern void set_args (int, char **); export_proto(set_args); --- 421,434 ---- /* main.c */ ! extern void stupid_function_name_for_static_linking (void); ! internal_proto(stupid_function_name_for_static_linking); ! ! struct st_parameter_common; ! extern void library_start (struct st_parameter_common *); internal_proto(library_start); ! #define library_end() extern void set_args (int, char **); export_proto(set_args); *************** internal_proto(get_args); *** 404,425 **** /* error.c */ ! extern char *gfc_itoa (int64_t); internal_proto(gfc_itoa); ! extern char *xtoa (uint64_t); internal_proto(xtoa); extern void os_error (const char *) __attribute__ ((noreturn)); internal_proto(os_error); ! extern void show_locus (void); internal_proto(show_locus); extern void runtime_error (const char *) __attribute__ ((noreturn)); iexport_proto(runtime_error); ! extern void internal_error (const char *) __attribute__ ((noreturn)); internal_proto(internal_error); extern const char *get_oserror (void); --- 438,465 ---- /* error.c */ ! #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2) ! #define GFC_XTOA_BUF_SIZE (sizeof (GFC_UINTEGER_LARGEST) * 2 + 1) ! #define GFC_OTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1) ! #define GFC_BTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 8 + 1) ! ! extern const char *gfc_itoa (GFC_INTEGER_LARGEST, char *, size_t); internal_proto(gfc_itoa); ! extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t); internal_proto(xtoa); extern void os_error (const char *) __attribute__ ((noreturn)); internal_proto(os_error); ! extern void show_locus (struct st_parameter_common *); internal_proto(show_locus); extern void runtime_error (const char *) __attribute__ ((noreturn)); iexport_proto(runtime_error); ! extern void internal_error (struct st_parameter_common *, const char *) ! __attribute__ ((noreturn)); internal_proto(internal_error); extern const char *get_oserror (void); *************** internal_proto(st_sprintf); *** 439,447 **** extern const char *translate_error (int); internal_proto(translate_error); ! extern void generate_error (int, const char *); internal_proto(generate_error); /* memory.c */ extern void *get_mem (size_t) __attribute__ ((malloc)); --- 479,492 ---- extern const char *translate_error (int); internal_proto(translate_error); ! extern void generate_error (struct st_parameter_common *, int, const char *); internal_proto(generate_error); + /* fpu.c */ + + extern void set_fpu (void); + internal_proto(set_fpu); + /* memory.c */ extern void *get_mem (size_t) __attribute__ ((malloc)); *************** internal_proto(show_variables); *** 469,475 **** /* string.c */ ! extern int find_option (const char *, int, st_option *, const char *); internal_proto(find_option); extern int fstrlen (const char *, int); --- 514,521 ---- /* string.c */ ! extern int find_option (struct st_parameter_common *, const char *, int, ! const st_option *, const char *); internal_proto(find_option); extern int fstrlen (const char *, int); *************** internal_proto(reshape_packed); *** 502,508 **** /* Repacking functions. */ ! /* ??? These eight aren't currently used by the compiler, though we certainly could do so. */ GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *); internal_proto(internal_pack_4); --- 548,554 ---- /* Repacking functions. */ ! /* ??? These aren't currently used by the compiler, though we certainly could do so. */ GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *); internal_proto(internal_pack_4); *************** internal_proto(internal_pack_4); *** 510,533 **** --- 556,599 ---- GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *); internal_proto(internal_pack_8); + #if defined HAVE_GFC_INTEGER_16 + GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *); + internal_proto(internal_pack_16); + #endif + GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *); internal_proto(internal_pack_c4); GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *); internal_proto(internal_pack_c8); + #if defined HAVE_GFC_COMPLEX_10 + GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *); + internal_proto(internal_pack_c10); + #endif + extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *); internal_proto(internal_unpack_4); extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *); internal_proto(internal_unpack_8); + #if defined HAVE_GFC_INTEGER_16 + extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *); + internal_proto(internal_unpack_16); + #endif + extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *); internal_proto(internal_unpack_c4); extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *); internal_proto(internal_unpack_c8); + #if defined HAVE_GFC_COMPLEX_10 + extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *); + internal_proto(internal_unpack_c10); + #endif + /* string_intrinsics.c */ extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *, diff -Nrcpad gcc-4.0.2/libgfortran/libtool-version gcc-4.1.0/libgfortran/libtool-version *** gcc-4.0.2/libgfortran/libtool-version Sun Jul 4 09:06:54 2004 --- gcc-4.1.0/libgfortran/libtool-version Tue Nov 22 10:58:47 2005 *************** *** 3,6 **** # This is a separate file so that version updates don't involve re-running # automake. # CURRENT:REVISION:AGE ! 0:0:0 --- 3,6 ---- # This is a separate file so that version updates don't involve re-running # automake. # CURRENT:REVISION:AGE ! 1:0:0 diff -Nrcpad gcc-4.0.2/libgfortran/m4/all.m4 gcc-4.1.0/libgfortran/m4/all.m4 *** gcc-4.0.2/libgfortran/m4/all.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/all.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(1, ` /* Return true only if all the elements are set. */ result = 1;', *************** ARRAY_FUNCTION(1, *** 44,46 **** --- 47,50 ---- break; }') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/any.m4 gcc-4.1.0/libgfortran/m4/any.m4 *** gcc-4.0.2/libgfortran/m4/any.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/any.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(0, ` result = 0;', ` /* Return true if any of the elements are set. */ *************** ARRAY_FUNCTION(0, *** 44,46 **** --- 47,50 ---- break; }') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/cexp.m4 gcc-4.1.0/libgfortran/m4/cexp.m4 *** gcc-4.0.2/libgfortran/m4/cexp.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/cexp.m4 Thu Jan 1 00:00:00 1970 *************** *** 1,146 **** - `/* Complex exponential functions - Copyright 2002, 2004 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h"' - - include(`mtype.m4')dnl - - /* z = a + ib */ - /* Absolute value. */ - real_type - cabs`'q (complex_type z) - { - return hypot`'q (REALPART (z), IMAGPART (z)); - } - - /* Complex argument. The angle made with the +ve real axis. - Range -pi-pi. */ - real_type - carg`'q (complex_type z) - { - real_type arg; - - return atan2`'q (IMAGPART (z), REALPART (z)); - } - - /* exp(z) = exp(a)*(cos(b) + isin(b)) */ - complex_type - cexp`'q (complex_type z) - { - real_type a; - real_type b; - complex_type v; - - a = REALPART (z); - b = IMAGPART (z); - COMPLEX_ASSIGN (v, cos`'q (b), sin`'q (b)); - return exp`'q (a) * v; - } - - /* log(z) = log (cabs(z)) + i*carg(z) */ - complex_type - clog`'q (complex_type z) - { - complex_type v; - - COMPLEX_ASSIGN (v, log`'q (cabs`'q (z)), carg`'q (z)); - return v; - } - - /* log10(z) = log10 (cabs(z)) + i*carg(z) */ - complex_type - clog10`'q (complex_type z) - { - complex_type v; - - COMPLEX_ASSIGN (v, log10`'q (cabs`'q (z)), carg`'q (z)); - return v; - } - - /* pow(base, power) = cexp (power * clog (base)) */ - complex_type - cpow`'q (complex_type base, complex_type power) - { - return cexp`'q (power * clog`'q (base)); - } - - /* sqrt(z). Algorithm pulled from glibc. */ - complex_type - csqrt`'q (complex_type z) - { - real_type re; - real_type im; - complex_type v; - - re = REALPART (z); - im = IMAGPART (z); - if (im == 0.0) - { - if (re < 0.0) - { - COMPLEX_ASSIGN (v, 0.0, copysign`'q (sqrt`'q (-re), im)); - } - else - { - COMPLEX_ASSIGN (v, fabs`'q (sqrt (re)), - copysign`'q (0.0, im)); - } - } - else if (re == 0.0) - { - real_type r; - - r = sqrt`'q (0.5 * fabs (im)); - - COMPLEX_ASSIGN (v, copysign`'q (r, im), r); - } - else - { - real_type d, r, s; - - d = hypot`'q (re, im); - /* Use the identity 2 Re res Im res = Im x - to avoid cancellation error in d +/- Re x. */ - if (re > 0) - { - r = sqrt`'q (0.5 * d + 0.5 * re); - s = (0.5 * im) / r; - } - else - { - s = sqrt`'q (0.5 * d - 0.5 * re); - r = fabs`'q ((0.5 * im) / s); - } - - COMPLEX_ASSIGN (v, r, copysign`'q (s, im)); - } - return v; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/m4/chyp.m4 gcc-4.1.0/libgfortran/m4/chyp.m4 *** gcc-4.0.2/libgfortran/m4/chyp.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/chyp.m4 Thu Jan 1 00:00:00 1970 *************** *** 1,81 **** - `/* Complex hyperbolic functions - Copyright 2002 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h"' - - include(`mtype.m4')dnl - - /* Complex number z = a + ib. */ - - /* sinh(z) = sinh(a)cos(b) + icosh(a)sin(b) */ - complex_type - csinh`'q (complex_type a) - { - real_type r; - real_type i; - complex_type v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, sinh`'q (r) * cos`'q (i), cosh`'q (r) * sin`'q (i)); - return v; - } - - /* cosh(z) = cosh(a)cos(b) - isinh(a)sin(b) */ - complex_type - ccosh`'q (complex_type a) - { - real_type r; - real_type i; - complex_type v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, cosh`'q (r) * cos`'q (i), - (sinh`'q (r) * sin`'q (i))); - return v; - } - - /* tanh(z) = (tanh(a) + itan(b)) / (1 - itanh(a)tan(b)) */ - complex_type - ctanh`'q (complex_type a) - { - real_type rt; - real_type it; - complex_type n; - complex_type d; - - rt = tanh`'q (REALPART (a)); - it = tan`'q (IMAGPART (a)); - COMPLEX_ASSIGN (n, rt, it); - COMPLEX_ASSIGN (d, 1, - (rt * it)); - - return n / d; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/m4/count.m4 gcc-4.1.0/libgfortran/m4/count.m4 *** gcc-4.0.2/libgfortran/m4/count.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/count.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,42 **** --- 35,46 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(0, ` result = 0;', ` if (*src) result++;') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/cshift1.m4 gcc-4.1.0/libgfortran/m4/cshift1.m4 *** gcc-4.0.2/libgfortran/m4/cshift1.m4 Thu Jul 14 21:17:22 2005 --- gcc-4.1.0/libgfortran/m4/cshift1.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,49 **** #include "libgfortran.h"' include(iparm.m4)dnl ! void cshift1_`'atype_kind (gfc_array_char * ret, ! const gfc_array_char * array, ! const atype * h, const atype_name * pwhich); ! export_proto(cshift1_`'atype_kind); ! void ! cshift1_`'atype_kind (gfc_array_char * ret, ! const gfc_array_char * array, ! const atype * h, const atype_name * pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 35,45 ---- #include "libgfortran.h"' include(iparm.m4)dnl ! `#if defined (HAVE_'atype_name`)' ! static void ! cshift1 (gfc_array_char * ret, const gfc_array_char * array, ! const atype * h, const atype_name * pwhich, index_type size) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** cshift1_`'atype_kind (gfc_array_char * r *** 65,71 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; --- 61,66 ---- *************** cshift1_`'atype_kind (gfc_array_char * r *** 79,92 **** if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); - size = GFC_DESCRIPTOR_SIZE (ret); - if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 74,85 ---- if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** cshift1_`'atype_kind (gfc_array_char * r *** 102,108 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; /* Initialized for avoiding compiler warnings. */ --- 95,100 ---- *************** cshift1_`'atype_kind (gfc_array_char * r *** 202,204 **** --- 194,226 ---- } } } + + void cshift1_`'atype_kind (gfc_array_char *, const gfc_array_char *, + const atype *, const atype_name *); + export_proto(cshift1_`'atype_kind); + + void + cshift1_`'atype_kind (gfc_array_char * ret, + const gfc_array_char * array, + const atype * h, const atype_name * pwhich) + { + cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); + } + + void cshift1_`'atype_kind`'_char (gfc_array_char * ret, GFC_INTEGER_4, + const gfc_array_char * array, + const atype * h, const atype_name * pwhich, + GFC_INTEGER_4); + export_proto(cshift1_`'atype_kind`'_char); + + void + cshift1_`'atype_kind`'_char (gfc_array_char * ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * array, + const atype * h, const atype_name * pwhich, + GFC_INTEGER_4 array_length) + { + cshift1 (ret, array, h, pwhich, array_length); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/ctrig.m4 gcc-4.1.0/libgfortran/m4/ctrig.m4 *** gcc-4.0.2/libgfortran/m4/ctrig.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/ctrig.m4 Thu Jan 1 00:00:00 1970 *************** *** 1,81 **** - `/* Complex trig functions - Copyright 2002 Free Software Foundation, Inc. - Contributed by Paul Brook - - 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., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ - #include - #include "libgfortran.h"' - - include(`mtype.m4')dnl - - /* Complex number z = a + ib. */ - - /* sin(z) = sin(a)cosh(b) + icos(a)sinh(b) */ - complex_type - csin`'q (complex_type a) - { - real_type r; - real_type i; - complex_type v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, sin`'q (r) * cosh`'q (i), cos`'q (r) * sinh`'q (i)); - return v; - } - - /* cos(z) = cos(a)cosh(b) - isin(a)sinh(b) */ - complex_type - ccos`'q (complex_type a) - { - real_type r; - real_type i; - complex_type v; - - r = REALPART (a); - i = IMAGPART (a); - COMPLEX_ASSIGN (v, cos`'q (r) * cosh`'q (i), - (sin`'q (r) * sinh`'q (i))); - return v; - } - - /* tan(z) = (tan(a) + itanh(b)) / (1 - itan(a)tanh(b)) */ - complex_type - ctan`'q (complex_type a) - { - real_type rt; - real_type it; - complex_type n; - complex_type d; - - rt = tan`'q (REALPART (a)); - it = tanh`'q (IMAGPART (a)); - COMPLEX_ASSIGN (n, rt, it); - COMPLEX_ASSIGN (d , 1, - (rt * it)); - - return n / d; - } - --- 0 ---- diff -Nrcpad gcc-4.0.2/libgfortran/m4/dotprod.m4 gcc-4.1.0/libgfortran/m4/dotprod.m4 *** gcc-4.0.2/libgfortran/m4/dotprod.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/dotprod.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern rtype_name dot_product_`'rtype_code (rtype * a, rtype * b); *************** sinclude(`dotprod_asm_'rtype_code`.m4')d *** 75,77 **** --- 77,81 ---- return res; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/dotprodc.m4 gcc-4.1.0/libgfortran/m4/dotprodc.m4 *** gcc-4.0.2/libgfortran/m4/dotprodc.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/dotprodc.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 26,33 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 26,33 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,42 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; extern rtype_name dot_product_`'rtype_code (rtype * a, rtype * b); *************** sinclude(`dotprod_asm_'rtype_code`.m4')d *** 78,80 **** --- 80,84 ---- return res; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/dotprodl.m4 gcc-4.1.0/libgfortran/m4/dotprodl.m4 *** gcc-4.0.2/libgfortran/m4/dotprodl.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/dotprodl.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + extern rtype_name dot_product_`'rtype_code (gfc_array_l4 *, gfc_array_l4 *); export_proto(dot_product_`'rtype_code); *************** dot_product_`'rtype_code (gfc_array_l4 * *** 84,86 **** --- 86,90 ---- return 0; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/eoshift1.m4 gcc-4.1.0/libgfortran/m4/eoshift1.m4 *** gcc-4.0.2/libgfortran/m4/eoshift1.m4 Thu Jul 14 21:17:22 2005 --- gcc-4.1.0/libgfortran/m4/eoshift1.m4 Mon Oct 3 07:22:20 2005 *************** *** 1,5 **** `/* Implementation of the EOSHIFT intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,54 **** #include "libgfortran.h"' include(iparm.m4)dnl ! static const char zeros[16] = ! {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; ! ! extern void eoshift1_`'atype_kind (gfc_array_char *, ! const gfc_array_char *, ! const atype *, const char *, ! const atype_name *); ! export_proto(eoshift1_`'atype_kind); ! void ! eoshift1_`'atype_kind (gfc_array_char *ret, ! const gfc_array_char *array, ! const atype *h, const char *pbound, ! const atype_name *pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 35,46 ---- #include "libgfortran.h"' include(iparm.m4)dnl ! `#if defined (HAVE_'atype_name`)' ! static void ! eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const atype *h, ! const char *pbound, const atype_name *pwhich, index_type size, ! char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** eoshift1_`'atype_kind (gfc_array_char *r *** 70,102 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; atype_name sh; atype_name delta; if (pwhich) which = *pwhich - 1; else which = 0; - if (!pbound) - pbound = zeros; - - size = GFC_DESCRIPTOR_SIZE (ret); - extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 62,93 ---- index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; index_type len; index_type n; int which; atype_name sh; atype_name delta; + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + if (pwhich) which = *pwhich - 1; else which = 0; extent[0] = 1; count[0] = 0; if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** eoshift1_`'atype_kind (gfc_array_char *r *** 130,136 **** rstride[n] = ret->dim[dim].stride * size; sstride[n] = array->dim[dim].stride * size; ! hstride[n] = h->dim[n].stride * size; n++; } } --- 121,127 ---- rstride[n] = ret->dim[dim].stride * size; sstride[n] = array->dim[dim].stride * size; ! hstride[n] = h->dim[n].stride; n++; } } *************** eoshift1_`'atype_kind (gfc_array_char *r *** 181,191 **** dest = rptr; n = delta; ! while (n--) ! { ! memcpy (dest, pbound, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; --- 172,189 ---- dest = rptr; n = delta; ! if (pbound) ! while (n--) ! { ! memcpy (dest, pbound, size); ! dest += roffset; ! } ! else ! while (n--) ! { ! memset (dest, filler, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; *************** eoshift1_`'atype_kind (gfc_array_char *r *** 220,222 **** --- 218,252 ---- } } } + + void eoshift1_`'atype_kind (gfc_array_char *, const gfc_array_char *, + const atype *, const char *, const atype_name *); + export_proto(eoshift1_`'atype_kind); + + void + eoshift1_`'atype_kind (gfc_array_char *ret, const gfc_array_char *array, + const atype *h, const char *pbound, + const atype_name *pwhich) + { + eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + } + + void eoshift1_`'atype_kind`'_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const atype *, + const char *, const atype_name *, + GFC_INTEGER_4, GFC_INTEGER_4); + export_proto(eoshift1_`'atype_kind`'_char); + + void + eoshift1_`'atype_kind`'_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const atype *h, + const char *pbound, const atype_name *pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length + __attribute__((unused))) + { + eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/eoshift3.m4 gcc-4.1.0/libgfortran/m4/eoshift3.m4 *** gcc-4.0.2/libgfortran/m4/eoshift3.m4 Thu Jul 14 21:17:22 2005 --- gcc-4.1.0/libgfortran/m4/eoshift3.m4 Mon Oct 3 07:22:20 2005 *************** *** 1,5 **** `/* Implementation of the EOSHIFT intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the EOSHIFT intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,52 **** #include "libgfortran.h"' include(iparm.m4)dnl ! static const char zeros[16] = ! {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; ! ! extern void eoshift3_`'atype_kind (gfc_array_char *, gfc_array_char *, ! atype *, const gfc_array_char *, ! atype_name *); ! export_proto(eoshift3_`'atype_kind); ! void ! eoshift3_`'atype_kind (gfc_array_char *ret, gfc_array_char *array, ! atype *h, const gfc_array_char *bound, ! atype_name *pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; --- 35,46 ---- #include "libgfortran.h"' include(iparm.m4)dnl ! `#if defined (HAVE_'atype_name`)' ! static void ! eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const atype *h, ! const gfc_array_char *bound, const atype_name *pwhich, ! index_type size, char filler) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; *************** eoshift3_`'atype_kind (gfc_array_char *r *** 72,96 **** index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; - index_type size; index_type len; index_type n; int which; atype_name sh; atype_name delta; if (pwhich) which = *pwhich - 1; else which = 0; - size = GFC_DESCRIPTOR_SIZE (ret); if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->base = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { --- 66,94 ---- index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type dim; index_type len; index_type n; int which; atype_name sh; atype_name delta; + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + if (pwhich) which = *pwhich - 1; else which = 0; if (ret->data == NULL) { int i; ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ! ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { *************** eoshift3_`'atype_kind (gfc_array_char *r *** 107,113 **** extent[0] = 1; count[0] = 0; - size = GFC_DESCRIPTOR_SIZE (array); n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { --- 105,110 ---- *************** eoshift3_`'atype_kind (gfc_array_char *r *** 156,162 **** if (bound) bptr = bound->data; else ! bptr = zeros; while (rptr) { --- 153,159 ---- if (bound) bptr = bound->data; else ! bptr = NULL; while (rptr) { *************** eoshift3_`'atype_kind (gfc_array_char *r *** 190,200 **** dest = rptr; n = delta; ! while (n--) ! { ! memcpy (dest, bptr, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; --- 187,204 ---- dest = rptr; n = delta; ! if (bptr) ! while (n--) ! { ! memcpy (dest, bptr, size); ! dest += roffset; ! } ! else ! while (n--) ! { ! memset (dest, filler, size); ! dest += roffset; ! } /* Advance to the next section. */ rptr += rstride0; *************** eoshift3_`'atype_kind (gfc_array_char *r *** 232,234 **** --- 236,274 ---- } } } + + extern void eoshift3_`'atype_kind (gfc_array_char *, const gfc_array_char *, + const atype *, const gfc_array_char *, + const atype_name *); + export_proto(eoshift3_`'atype_kind); + + void + eoshift3_`'atype_kind (gfc_array_char *ret, const gfc_array_char *array, + const atype *h, const gfc_array_char *bound, + const atype_name *pwhich) + { + eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + } + + extern void eoshift3_`'atype_kind`'_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, + const atype *, + const gfc_array_char *, + const atype_name *, GFC_INTEGER_4, + GFC_INTEGER_4); + export_proto(eoshift3_`'atype_kind`'_char); + + void + eoshift3_`'atype_kind`'_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const atype *h, + const gfc_array_char *bound, + const atype_name *pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length + __attribute__((unused))) + { + eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); + } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/exponent.m4 gcc-4.1.0/libgfortran/m4/exponent.m4 *** gcc-4.0.2/libgfortran/m4/exponent.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/exponent.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h"' include(`mtype.m4')dnl extern GFC_INTEGER_4 exponent_r`'kind (real_type s); export_proto(exponent_r`'kind); --- 25,41 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h"' include(`mtype.m4')dnl + `#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)' + extern GFC_INTEGER_4 exponent_r`'kind (real_type s); export_proto(exponent_r`'kind); *************** exponent_r`'kind (real_type s) *** 42,44 **** --- 46,50 ---- frexp`'q (s, &ret); return ret; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/fraction.m4 gcc-4.1.0/libgfortran/m4/fraction.m4 *** gcc-4.0.2/libgfortran/m4/fraction.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/fraction.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h"' include(`mtype.m4')dnl extern real_type fraction_r`'kind (real_type s); export_proto(fraction_r`'kind); --- 25,41 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h"' include(`mtype.m4')dnl + `#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)' + extern real_type fraction_r`'kind (real_type s); export_proto(fraction_r`'kind); *************** fraction_r`'kind (real_type s) *** 41,43 **** --- 45,49 ---- int dummy_exp; return frexp`'q (s, &dummy_exp); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/head.m4 gcc-4.1.0/libgfortran/m4/head.m4 *** gcc-4.0.2/libgfortran/m4/head.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/head.m4 Wed Aug 17 02:49:08 2005 *************** *** 24,30 **** ! !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., 59 Temple Place - Suite 330, ! !Boston, MA 02111-1307, USA. ! !This file is machine generated.' --- 24,30 ---- ! !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. ! !This file is machine generated.' diff -Nrcpad gcc-4.0.2/libgfortran/m4/iforeach.m4 gcc-4.1.0/libgfortran/m4/iforeach.m4 *** gcc-4.0.2/libgfortran/m4/iforeach.m4 Fri May 20 22:36:36 2005 --- gcc-4.1.0/libgfortran/m4/iforeach.m4 Thu Jul 7 22:08:06 2005 *************** name`'rtype_qual`_'atype_code (rtype * r *** 29,35 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); } else --- 29,35 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); } else *************** void *** 139,145 **** retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->base = 0; retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); } else --- 139,145 ---- retarray->dim[0].ubound = rank-1; retarray->dim[0].stride = 1; retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; ! retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); } else diff -Nrcpad gcc-4.0.2/libgfortran/m4/ifunction.m4 gcc-4.1.0/libgfortran/m4/ifunction.m4 *** gcc-4.0.2/libgfortran/m4/ifunction.m4 Mon May 23 20:03:49 2005 --- gcc-4.1.0/libgfortran/m4/ifunction.m4 Thu Jul 7 22:08:06 2005 *************** name`'rtype_qual`_'atype_code (rtype *re *** 77,83 **** = internal_malloc_size (sizeof (rtype_name) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 77,83 ---- = internal_malloc_size (sizeof (rtype_name) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else *************** void *** 222,228 **** = internal_malloc_size (sizeof (rtype_name) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->base = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else --- 222,228 ---- = internal_malloc_size (sizeof (rtype_name) * retarray->dim[rank-1].stride * extent[rank-1]); ! retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } else diff -Nrcpad gcc-4.0.2/libgfortran/m4/in_pack.m4 gcc-4.1.0/libgfortran/m4/in_pack.m4 *** gcc-4.0.2/libgfortran/m4/in_pack.m4 Mon Jul 18 17:40:43 2005 --- gcc-4.1.0/libgfortran/m4/in_pack.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + /* Allocates a block of memory with internal_malloc if the array needs repacking. */ *************** rtype_name * *** 124,126 **** --- 126,129 ---- return destptr; } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/in_unpack.m4 gcc-4.1.0/libgfortran/m4/in_unpack.m4 *** gcc-4.0.2/libgfortran/m4/in_unpack.m4 Mon Jul 18 17:40:43 2005 --- gcc-4.1.0/libgfortran/m4/in_unpack.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,42 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + dnl Only the kind (ie size) is used to name the function for integers, dnl reals and logicals. For complex, it's c4 and c8. void *************** void *** 112,114 **** --- 114,117 ---- } } + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/matmul.m4 gcc-4.1.0/libgfortran/m4/matmul.m4 *** gcc-4.0.2/libgfortran/m4/matmul.m4 Fri Jul 15 20:47:33 2005 --- gcc-4.1.0/libgfortran/m4/matmul.m4 Mon Nov 14 19:48:31 2005 *************** *** 1,5 **** `/* Implementation of the MATMUL intrinsic ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- `/* Implementation of the MATMUL intrinsic ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,42 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + /* This is a C version of the following fortran pseudo-code. The key point is the loop order -- we access all arrays column-first, which improves the performance enough to boost galgel spec score by 50%. *************** include(iparm.m4)dnl *** 47,61 **** C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_`'rtype_code (rtype * retarray, rtype * a, rtype * b); export_proto(matmul_`'rtype_code); void ! matmul_`'rtype_code (rtype * retarray, rtype * a, rtype * b) { ! rtype_name *abase; ! rtype_name *bbase; ! rtype_name *dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; --- 49,65 ---- C(I,J) = C(I,J)+A(I,K)*B(K,J) */ ! extern void matmul_`'rtype_code (rtype * const restrict retarray, ! rtype * const restrict a, rtype * const restrict b); export_proto(matmul_`'rtype_code); void ! matmul_`'rtype_code (rtype * const restrict retarray, ! rtype * const restrict a, rtype * const restrict b) { ! const rtype_name * restrict abase; ! const rtype_name * restrict bbase; ! rtype_name * restrict dest; index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; *************** matmul_`'rtype_code (rtype * retarray, r *** 93,115 **** retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (rtype_name) * size0 (retarray)); ! retarray->base = 0; } - abase = a->data; - bbase = b->data; - dest = retarray->data; - if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) --- 97,117 ---- retarray->dim[0].lbound = 0; retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; retarray->dim[0].stride = 1; ! retarray->dim[1].lbound = 0; retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound; retarray->dim[1].stride = retarray->dim[0].ubound+1; } ! retarray->data ! = internal_malloc_size (sizeof (rtype_name) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } if (retarray->dim[0].stride == 0) retarray->dim[0].stride = 1; + + /* This prevents constifying the input arguments. */ if (a->dim[0].stride == 0) a->dim[0].stride = 1; if (b->dim[0].stride == 0) *************** sinclude(`matmul_asm_'rtype_code`.m4')dn *** 159,165 **** /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else --- 161,167 ---- /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than an incorrect result. */ ! bystride = 0xDEADBEEF; ycount = 1; } else *************** sinclude(`matmul_asm_'rtype_code`.m4')dn *** 175,183 **** if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! rtype_name *bbase_y; ! rtype_name *dest_y; ! rtype_name *abase_n; rtype_name bbase_yn; if (rystride == ycount) --- 177,185 ---- if (rxstride == 1 && axstride == 1 && bxstride == 1) { ! const rtype_name * restrict bbase_y; ! rtype_name * restrict dest_y; ! const rtype_name * restrict abase_n; rtype_name bbase_yn; if (rystride == ycount) *************** sinclude(`matmul_asm_'rtype_code`.m4')dn *** 217,219 **** --- 219,223 ---- dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride]; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/matmull.m4 gcc-4.1.0/libgfortran/m4/matmull.m4 *** gcc-4.0.2/libgfortran/m4/matmull.m4 Sun May 15 15:58:17 2005 --- gcc-4.1.0/libgfortran/m4/matmull.m4 Mon Nov 14 19:48:31 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,51 **** #include "libgfortran.h"' include(iparm.m4)dnl /* Dimensions: retarray(x,y) a(x, count) b(count,y). Either a or b can be rank 1. In this case x or y is 1. */ ! extern void matmul_`'rtype_code (rtype *, gfc_array_l4 *, gfc_array_l4 *); export_proto(matmul_`'rtype_code); void ! matmul_`'rtype_code (rtype * retarray, gfc_array_l4 * a, gfc_array_l4 * b) { ! GFC_INTEGER_4 *abase; ! GFC_INTEGER_4 *bbase; ! rtype_name *dest; index_type rxstride; index_type rystride; index_type xcount; --- 34,55 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + /* Dimensions: retarray(x,y) a(x, count) b(count,y). Either a or b can be rank 1. In this case x or y is 1. */ ! extern void matmul_`'rtype_code (rtype * const restrict, ! gfc_array_l4 * const restrict, gfc_array_l4 * const restrict); export_proto(matmul_`'rtype_code); void ! matmul_`'rtype_code (rtype * const restrict retarray, ! gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b) { ! const GFC_INTEGER_4 * restrict abase; ! const GFC_INTEGER_4 * restrict bbase; ! rtype_name * restrict dest; index_type rxstride; index_type rystride; index_type xcount; *************** matmul_`'rtype_code (rtype * retarray, g *** 55,62 **** index_type x; index_type y; ! GFC_INTEGER_4 *pa; ! GFC_INTEGER_4 *pb; index_type astride; index_type bstride; index_type count; --- 59,66 ---- index_type x; index_type y; ! const GFC_INTEGER_4 * restrict pa; ! const GFC_INTEGER_4 * restrict pb; index_type astride; index_type bstride; index_type count; *************** matmul_`'rtype_code (rtype * retarray, g *** 92,98 **** retarray->data = internal_malloc_size (sizeof (rtype_name) * size0 ((array_t *) retarray)); ! retarray->base = 0; } abase = a->data; --- 96,102 ---- retarray->data = internal_malloc_size (sizeof (rtype_name) * size0 ((array_t *) retarray)); ! retarray->offset = 0; } abase = a->data; *************** sinclude(`matmul_asm_'rtype_code`.m4')dn *** 192,194 **** --- 196,200 ---- dest += rystride - (rxstride * xcount); } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/maxloc0.m4 gcc-4.1.0/libgfortran/m4/maxloc0.m4 *** gcc-4.0.2/libgfortran/m4/maxloc0.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/maxloc0.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 38,43 **** --- 38,45 ---- include(iparm.m4)dnl include(iforeach.m4)dnl + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + FOREACH_FUNCTION( ` atype_name maxval; *************** MASKED_FOREACH_FUNCTION( *** 61,63 **** --- 63,67 ---- for (n = 0; n < rank; n++) dest[n * dstride] = count[n] + 1; }') + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/maxloc1.m4 gcc-4.1.0/libgfortran/m4/maxloc1.m4 *** gcc-4.0.2/libgfortran/m4/maxloc1.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/maxloc1.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 37,42 **** --- 37,45 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(0, ` atype_name maxval; maxval = atype_min; *************** MASKED_ARRAY_FUNCTION(0, *** 57,59 **** --- 60,63 ---- result = (rtype_name)n + 1; }') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/maxval.m4 gcc-4.1.0/libgfortran/m4/maxval.m4 *** gcc-4.0.2/libgfortran/m4/maxval.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/maxval.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(atype_min, ` result = atype_min;', ` if (*src > result) *************** MASKED_ARRAY_FUNCTION(atype_min, *** 46,48 **** --- 49,52 ---- ` if (*msrc && *src > result) result = *src;') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/minloc0.m4 gcc-4.1.0/libgfortran/m4/minloc0.m4 *** gcc-4.0.2/libgfortran/m4/minloc0.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/minloc0.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 38,43 **** --- 38,45 ---- include(iparm.m4)dnl include(iforeach.m4)dnl + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + FOREACH_FUNCTION( ` atype_name minval; *************** MASKED_FOREACH_FUNCTION( *** 61,63 **** --- 63,67 ---- for (n = 0; n < rank; n++) dest[n * dstride] = count[n] + 1; }') + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/minloc1.m4 gcc-4.1.0/libgfortran/m4/minloc1.m4 *** gcc-4.0.2/libgfortran/m4/minloc1.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/minloc1.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 37,42 **** --- 37,45 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(0, ` atype_name minval; minval = atype_max; *************** MASKED_ARRAY_FUNCTION(0, *** 57,59 **** --- 60,63 ---- result = (rtype_name)n + 1; }') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/minval.m4 gcc-4.1.0/libgfortran/m4/minval.m4 *** gcc-4.0.2/libgfortran/m4/minval.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/minval.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 36,44 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(atype_max, ` result = atype_max;', ` if (*src < result) *************** MASKED_ARRAY_FUNCTION(atype_max, *** 46,48 **** --- 49,52 ---- ` if (*msrc && *src < result) result = *src;') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/mtype.m4 gcc-4.1.0/libgfortran/m4/mtype.m4 *** gcc-4.0.2/libgfortran/m4/mtype.m4 Thu May 13 06:41:03 2004 --- gcc-4.1.0/libgfortran/m4/mtype.m4 Mon Oct 3 07:22:20 2005 *************** dnl Get type kind from filename. *** 2,5 **** define(kind,regexp(file, `_.\([0-9]+\).c$', `\1'))dnl define(complex_type, `GFC_COMPLEX_'kind)dnl define(real_type, `GFC_REAL_'kind)dnl ! define(q,ifelse(kind,4,f,ifelse(kind,8,`',`_'kind)))dnl --- 2,6 ---- define(kind,regexp(file, `_.\([0-9]+\).c$', `\1'))dnl define(complex_type, `GFC_COMPLEX_'kind)dnl define(real_type, `GFC_REAL_'kind)dnl ! define(q,ifelse(kind,4,f,ifelse(kind,8,`',ifelse(kind,10,l,ifelse(kind,16,l,`_'kind)))))dnl ! define(Q,translit(q,`a-z',`A-Z'))dnl diff -Nrcpad gcc-4.0.2/libgfortran/m4/nearest.m4 gcc-4.1.0/libgfortran/m4/nearest.m4 *** gcc-4.0.2/libgfortran/m4/nearest.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/nearest.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include #include "libgfortran.h"' include(`mtype.m4')dnl extern real_type nearest_r`'kind (real_type s, real_type dir); export_proto(nearest_r`'kind); --- 25,42 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include #include "libgfortran.h"' include(`mtype.m4')dnl + `#if defined (HAVE_'real_type`) && defined (HAVE_COPYSIGN'Q`) && defined (HAVE_NEXTAFTER'Q`)' + extern real_type nearest_r`'kind (real_type s, real_type dir); export_proto(nearest_r`'kind); *************** nearest_r`'kind (real_type s, real_type *** 49,51 **** --- 53,57 ---- else return nextafter`'q (s, dir); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/pow.m4 gcc-4.1.0/libgfortran/m4/pow.m4 *** gcc-4.0.2/libgfortran/m4/pow.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/pow.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include "libgfortran.h"' --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h"' *************** include(iparm.m4)dnl *** 37,42 **** --- 37,44 ---- Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming", 3rd Edition, 1998. */ + `#if defined (HAVE_'rtype_name`) && defined (HAVE_'atype_name`)' + rtype_name `pow_'rtype_code`_'atype_code (rtype_name a, atype_name b); export_proto(pow_`'rtype_code`_'atype_code); *************** ifelse(rtype_letter,i,`dnl *** 78,80 **** --- 80,84 ---- } return pow; } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/product.m4 gcc-4.1.0/libgfortran/m4/product.m4 *** gcc-4.0.2/libgfortran/m4/product.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/product.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(1, ` result = 1;', ` result *= *src;') *************** MASKED_ARRAY_FUNCTION(1, *** 44,46 **** --- 47,50 ---- ` if (*msrc) result *= *src;') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/reshape.m4 gcc-4.1.0/libgfortran/m4/reshape.m4 *** gcc-4.0.2/libgfortran/m4/reshape.m4 Sun Jul 17 19:12:01 2005 --- gcc-4.1.0/libgfortran/m4/reshape.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the *************** reshape_`'rtype_ccode (rtype * ret, rtyp *** 99,105 **** ret->dim[n].stride = rs; rs *= rex; } ! ret->base = 0; ret->data = internal_malloc_size ( rs * sizeof (rtype_name)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } --- 101,107 ---- ret->dim[n].stride = rs; rs *= rex; } ! ret->offset = 0; ret->data = internal_malloc_size ( rs * sizeof (rtype_name)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } *************** reshape_`'rtype_ccode (rtype * ret, rtyp *** 258,260 **** --- 260,264 ---- } } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/set_exponent.m4 gcc-4.1.0/libgfortran/m4/set_exponent.m4 *** gcc-4.0.2/libgfortran/m4/set_exponent.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/set_exponent.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,37 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h"' include(`mtype.m4')dnl extern real_type set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i); export_proto(set_exponent_r`'kind); --- 25,41 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ ! ! #include "config.h" #include #include "libgfortran.h"' include(`mtype.m4')dnl + `#if defined (HAVE_'real_type`) && defined (HAVE_SCALBN'Q`) && defined (HAVE_FREXP'Q`)' + extern real_type set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i); export_proto(set_exponent_r`'kind); *************** set_exponent_r`'kind (real_type s, GFC_I *** 41,43 **** --- 45,49 ---- int dummy_exp; return scalbn`'q (frexp`'q (s, &dummy_exp), i); } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/shape.m4 gcc-4.1.0/libgfortran/m4/shape.m4 *** gcc-4.0.2/libgfortran/m4/shape.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/shape.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 34,39 **** --- 34,41 ---- #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + extern void shape_`'rtype_kind (rtype * ret, const rtype * array); export_proto(shape_`'rtype_kind); *************** shape_`'rtype_kind (rtype * ret, const r *** 53,55 **** --- 55,59 ---- array->dim[n].ubound + 1 - array->dim[n].lbound; } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/specific.m4 gcc-4.1.0/libgfortran/m4/specific.m4 *** gcc-4.0.2/libgfortran/m4/specific.m4 Tue May 18 19:03:26 2004 --- gcc-4.1.0/libgfortran/m4/specific.m4 Mon Oct 3 07:22:20 2005 *************** *** 1,5 **** include(head.m4) ! define(atype_code,regexp(file,`_\([ircl][0-9]+\).f90',`\1'))dnl define(atype_letter,substr(atype_code, 0, 1))dnl define(atype_kind,substr(atype_code, 1))dnl define(get_typename2, `$1 (kind=$2)')dnl --- 1,5 ---- include(head.m4) ! define(atype_code,regexp(file,`_\([ircl][0-9]+\).[fF]90',`\1'))dnl define(atype_letter,substr(atype_code, 0, 1))dnl define(atype_kind,substr(atype_code, 1))dnl define(get_typename2, `$1 (kind=$2)')dnl *************** define(atype_name, get_typename(atype_le *** 8,16 **** --- 8,42 ---- define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl define(function_name,`specific__'name`_'atype_code)dnl + define(type,ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW)))))dnl + define(Q,ifelse(atype_kind,4,F,ifelse(atype_kind,8,`',ifelse(atype_kind,10,L,ifelse(atype_kind,16,L,`_'atype_kind)))))dnl + + dnl A few specifics require a function other than their name, or + dnl nothing. The list is currently: + dnl - integer and logical specifics require no libm function + dnl - AINT requires the trunc() family functions + dnl - ANINT requires round() + dnl - CONJG, DIM, SIGN require no libm function + define(needed,ifelse(atype_letter,i,`none',ifelse(atype_letter,l,`none',ifelse(name,aint,trunc,ifelse(name,anint,round,ifelse(name,conjg,none,ifelse(name,dim,none,ifelse(name,sign,none,ifelse(name,abs,fabs,name)))))))))dnl + define(prefix,ifelse(atype_letter,c,C,`'))dnl + + dnl Special case for fabs, for which the corresponding complex function + dnl is not cfabs but cabs. + define(NEEDED,translit(ifelse(prefix`'needed,`Cfabs',`abs',needed),`a-z',`A-Z'))dnl + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + `#if defined (HAVE_GFC_'type`_'atype_kind`)' + ifelse(NEEDED,NONE,`',`#ifdef HAVE_'prefix`'NEEDED`'Q) + elemental function function_name (parm) atype_name, intent (in) :: parm atype_name :: function_name function_name = name (parm) end function + + ifelse(NEEDED,NONE,`',`#endif') + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/specific2.m4 gcc-4.1.0/libgfortran/m4/specific2.m4 *** gcc-4.0.2/libgfortran/m4/specific2.m4 Tue May 18 19:03:26 2004 --- gcc-4.1.0/libgfortran/m4/specific2.m4 Mon Oct 3 07:22:20 2005 *************** *** 1,5 **** include(head.m4) ! define(atype_code,regexp(file,`_\([ircl][0-9]+\).f90',`\1'))dnl define(atype_letter,substr(atype_code, 0, 1))dnl define(atype_kind,substr(atype_code, 1))dnl define(get_typename2, `$1 (kind=$2)')dnl --- 1,5 ---- include(head.m4) ! define(atype_code,regexp(file,`_\([ircl][0-9]+\).[fF]90',`\1'))dnl define(atype_letter,substr(atype_code, 0, 1))dnl define(atype_kind,substr(atype_code, 1))dnl define(get_typename2, `$1 (kind=$2)')dnl *************** define(atype_name, get_typename(atype_le *** 8,16 **** --- 8,30 ---- define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl define(function_name,`specific__'name`_'atype_code)dnl + define(Q,ifelse(atype_kind,4,F,ifelse(atype_kind,8,`',ifelse(atype_kind,10,L,ifelse(atype_kind,16,L,`_'atype_kind)))))dnl + + #include "config.h" + #include "kinds.inc" + #include "c99_protos.inc" + + `#if defined (HAVE_GFC_'ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW))))`_'atype_kind`)' + + ifelse(name,atan2,`#ifdef HAVE_ATAN2'Q,) + elemental function function_name (p1, p2) atype_name, intent (in) :: p1, p2 atype_name :: function_name function_name = name (p1, p2) end function + + ifelse(name,atan2,`#endif',) + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/sum.m4 gcc-4.1.0/libgfortran/m4/sum.m4 *** gcc-4.0.2/libgfortran/m4/sum.m4 Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/m4/sum.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,43 ---- include(iparm.m4)dnl include(ifunction.m4)dnl + + `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + ARRAY_FUNCTION(0, ` result = 0;', ` result += *src;') *************** MASKED_ARRAY_FUNCTION(0, *** 43,45 **** --- 46,50 ---- ` result = 0;', ` if (*msrc) result += *src;') + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/m4/transpose.m4 gcc-4.1.0/libgfortran/m4/transpose.m4 *** gcc-4.0.2/libgfortran/m4/transpose.m4 Sun Jan 23 17:01:00 2005 --- gcc-4.1.0/libgfortran/m4/transpose.m4 Mon Oct 3 07:22:20 2005 *************** GNU General Public License for more deta *** 25,38 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include "libgfortran.h"' include(iparm.m4)dnl extern void transpose_`'rtype_code (rtype * ret, rtype * source); export_proto(transpose_`'rtype_code); --- 25,40 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include #include "libgfortran.h"' include(iparm.m4)dnl + `#if defined (HAVE_'rtype_name`)' + extern void transpose_`'rtype_code (rtype * ret, rtype * source); export_proto(transpose_`'rtype_code); *************** transpose_`'rtype_code (rtype * ret, rty *** 64,71 **** ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (rtype_name) * size0 (ret)); ! ret->base = 0; } if (ret->dim[0].stride == 0) --- 66,73 ---- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; ret->dim[1].stride = ret->dim[0].ubound+1; ! ret->data = internal_malloc_size (sizeof (rtype_name) * size0 ((array_t *) ret)); ! ret->offset = 0; } if (ret->dim[0].stride == 0) *************** transpose_`'rtype_code (rtype * ret, rty *** 97,99 **** --- 99,103 ---- rptr += rxstride - (rystride * xcount); } } + + #endif diff -Nrcpad gcc-4.0.2/libgfortran/mk-kinds-h.sh gcc-4.1.0/libgfortran/mk-kinds-h.sh *** gcc-4.0.2/libgfortran/mk-kinds-h.sh Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/mk-kinds-h.sh Mon Oct 3 07:22:20 2005 *************** *** 0 **** --- 1,67 ---- + #!/bin/sh + + compile="$1" + + # Possible types must be listed in ascending order + possible_integer_kinds="1 2 4 8 16" + possible_real_kinds="4 8 10 16" + + + largest="" + for k in $possible_integer_kinds; do + echo " integer (kind=$k) :: i" > tmp$$.f90 + echo " end" >> tmp$$.f90 + if $compile -c tmp$$.f90 > /dev/null 2>&1; then + s=`expr 8 \* $k` + largest="$k" + + if [ $s -eq 128 ]; then + prefix="__" + else + prefix="" + fi + + echo "typedef ${prefix}int${s}_t GFC_INTEGER_${k};" + echo "typedef ${prefix}uint${s}_t GFC_UINTEGER_${k};" + echo "typedef GFC_INTEGER_${k} GFC_LOGICAL_${k};" + echo "#define HAVE_GFC_LOGICAL_${k}" + echo "#define HAVE_GFC_INTEGER_${k}" + fi + rm -f tmp$$.* + done + + echo "#define GFC_INTEGER_LARGEST GFC_INTEGER_${largest}" + echo "#define GFC_UINTEGER_LARGEST GFC_UINTEGER_${largest}" + echo "" + + + largest_ctype="" + for k in $possible_real_kinds; do + echo " real (kind=$k) :: x" > tmp$$.f90 + echo " end" >> tmp$$.f90 + if $compile -c tmp$$.f90 > /dev/null 2>&1; then + case $k in + 4) ctype="float" ;; + 8) ctype="double" ;; + 10) ctype="long double" ;; + 16) ctype="long double" ;; + *) echo "$0: Unknown type" >&2 ; exit 1 ;; + esac + largest_ctype="$ctype" + echo "typedef ${ctype} GFC_REAL_${k};" + echo "typedef complex ${ctype} GFC_COMPLEX_${k};" + echo "#define HAVE_GFC_REAL_${k}" + echo "#define HAVE_GFC_COMPLEX_${k}" + fi + rm -f tmp$$.* + done + + case $largest_ctype in + float) echo "#define GFC_REAL_LARGEST_FORMAT \"\"" ;; + double) echo "#define GFC_REAL_LARGEST_FORMAT \"l\"" ;; + "long double") echo "#define GFC_REAL_LARGEST_FORMAT \"L\"" ;; + *) echo "$0: Unknown type" >&2 ; exit 1 ;; + esac + echo "#define GFC_REAL_LARGEST $largest_ctype" + + exit 0 diff -Nrcpad gcc-4.0.2/libgfortran/runtime/compile_options.c gcc-4.1.0/libgfortran/runtime/compile_options.c *** gcc-4.0.2/libgfortran/runtime/compile_options.c Fri Aug 12 05:58:56 2005 --- gcc-4.1.0/libgfortran/runtime/compile_options.c Tue Feb 14 14:50:40 2006 *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" --- 24,31 ---- 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. */ #include "config.h" *************** compile_options_t compile_options; *** 37,49 **** /* Prototypes */ ! extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4); export_proto(set_std); void ! set_std (GFC_INTEGER_4 warn_std, GFC_INTEGER_4 allow_std) { compile_options.warn_std = warn_std; compile_options.allow_std = allow_std; } --- 37,51 ---- /* Prototypes */ ! extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4); export_proto(set_std); void ! set_std (GFC_INTEGER_4 warn_std, GFC_INTEGER_4 allow_std, ! GFC_INTEGER_4 pedantic) { + compile_options.pedantic = pedantic; compile_options.warn_std = warn_std; compile_options.allow_std = allow_std; } *************** init_compile_options (void) *** 58,61 **** --- 60,76 ---- | GFC_STD_F2003 | GFC_STD_LEGACY; compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY; + compile_options.pedantic = 0; + } + + /* Function called by the front-end to tell us the + default for unformatted data conversion. */ + + extern void set_convert (int); + export_proto (set_convert); + + void + set_convert (int conv) + { + compile_options.convert = conv; } diff -Nrcpad gcc-4.0.2/libgfortran/runtime/environ.c gcc-4.1.0/libgfortran/runtime/environ.c *** gcc-4.0.2/libgfortran/runtime/environ.c Mon Feb 28 06:34:54 2005 --- gcc-4.1.0/libgfortran/runtime/environ.c Wed Feb 8 20:14:00 2006 *************** GNU General Public License for more deta *** 24,33 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include --- 24,34 ---- 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. */ #include "config.h" + #include #include #include #include *************** Boston, MA 02111-1307, USA. */ *** 46,52 **** * but other variables are checked during execution of the user's * program. */ ! options_t options = { }; typedef struct variable --- 47,53 ---- * but other variables are checked during execution of the user's * program. */ ! options_t options; typedef struct variable *************** typedef struct variable *** 60,67 **** } variable; ! /* print_spaces()-- Print a particular number of spaces */ static void print_spaces (int n) --- 61,69 ---- } variable; + static void init_unformatted (variable *); ! /* print_spaces()-- Print a particular number of spaces. */ static void print_spaces (int n) *************** var_source (variable * v) *** 97,103 **** } ! /* init_integer()-- Initialize an integer environment variable */ static void init_integer (variable * v) --- 99,105 ---- } ! /* init_integer()-- Initialize an integer environment variable. */ static void init_integer (variable * v) *************** init_integer (variable * v) *** 109,114 **** --- 111,144 ---- goto set_default; for (q = p; *q; q++) + if (!isdigit (*q) && (p != q || *q != '-')) + { + v->bad = 1; + goto set_default; + } + + *v->var = atoi (p); + return; + + set_default: + *v->var = v->value; + return; + } + + + /* init_unsigned_integer()-- Initialize an integer environment variable + which has to be positive. */ + + static void + init_unsigned_integer (variable * v) + { + char *p, *q; + + p = getenv (v->name); + if (p == NULL) + goto set_default; + + for (q = p; *q; q++) if (!isdigit (*q)) { v->bad = 1; *************** show_sep (variable * v) *** 298,304 **** static void ! init_string (variable * v) { } --- 328,334 ---- static void ! init_string (variable * v __attribute__ ((unused))) { } *************** choice; *** 328,359 **** enum { FP_ROUND_NEAREST, FP_ROUND_UP, FP_ROUND_DOWN, FP_ROUND_ZERO }; ! static choice rounding[] = { {"NEAREST", FP_ROUND_NEAREST}, {"UP", FP_ROUND_UP}, {"DOWN", FP_ROUND_DOWN}, {"ZERO", FP_ROUND_ZERO}, ! {NULL} }; ! static choice precision[] = { { "24", 1}, { "53", 2}, { "64", 0}, ! { NULL} }; ! static choice signal_choices[] = { { "IGNORE", 1}, { "ABORT", 0}, ! { NULL} }; static void ! init_choice (variable * v, choice * c) { char *p; --- 358,389 ---- enum { FP_ROUND_NEAREST, FP_ROUND_UP, FP_ROUND_DOWN, FP_ROUND_ZERO }; ! static const choice rounding[] = { {"NEAREST", FP_ROUND_NEAREST}, {"UP", FP_ROUND_UP}, {"DOWN", FP_ROUND_DOWN}, {"ZERO", FP_ROUND_ZERO}, ! {NULL, 0} }; ! static const choice precision[] = { { "24", 1}, { "53", 2}, { "64", 0}, ! { NULL, 0} }; ! static const choice signal_choices[] = { { "IGNORE", 1}, { "ABORT", 0}, ! { NULL, 0} }; static void ! init_choice (variable * v, const choice * c) { char *p; *************** init_choice (variable * v, choice * c) *** 380,386 **** static void ! show_choice (variable * v, choice * c) { st_printf ("%s ", var_source (v)); --- 410,416 ---- static void ! show_choice (variable * v, const choice * c) { st_printf ("%s ", var_source (v)); *************** show_signal (variable * v) *** 435,532 **** static variable variable_table[] = { {"GFORTRAN_STDIN_UNIT", 5, &options.stdin_unit, init_integer, show_integer, "Unit number that will be preconnected to standard input\n" ! "(No preconnection if negative)"}, {"GFORTRAN_STDOUT_UNIT", 6, &options.stdout_unit, init_integer, show_integer, "Unit number that will be preconnected to standard output\n" ! "(No preconnection if negative)"}, {"GFORTRAN_STDERR_UNIT", 0, &options.stderr_unit, init_integer, show_integer, "Unit number that will be preconnected to standard error\n" ! "(No preconnection if negative)"}, {"GFORTRAN_USE_STDERR", 1, &options.use_stderr, init_boolean, show_boolean, ! "Sends library output to standard error instead of standard output."}, {"GFORTRAN_TMPDIR", 0, NULL, init_string, show_string, "Directory for scratch files. Overrides the TMP environment variable\n" ! "If TMP is not set " DEFAULT_TEMPDIR " is used."}, {"GFORTRAN_UNBUFFERED_ALL", 0, &options.all_unbuffered, init_boolean, show_boolean, "If TRUE, all output is unbuffered. This will slow down large writes " ! "but can be\nuseful for forcing data to be displayed immediately."}, {"GFORTRAN_SHOW_LOCUS", 1, &options.locus, init_boolean, show_boolean, ! "If TRUE, print filename and line number where runtime errors happen."}, {"GFORTRAN_OPTIONAL_PLUS", 0, &options.optional_plus, init_boolean, show_boolean, ! "Print optional plus signs in numbers where permitted. Default FALSE."}, {"GFORTRAN_DEFAULT_RECL", DEFAULT_RECL, &options.default_recl, ! init_integer, show_integer, "Default maximum record length for sequential files. Most useful for\n" "adjusting line length of preconnected units. Default " ! stringize (DEFAULT_RECL)}, {"GFORTRAN_LIST_SEPARATOR", 0, NULL, init_sep, show_sep, "Separatator to use when writing list output. May contain any number of " ! "spaces\nand at most one comma. Default is a single space."}, /* Memory related controls */ {"GFORTRAN_MEM_INIT", 0, NULL, init_mem, show_mem, "How to initialize allocated memory. Default value is NONE for no " "initialization\n(faster), NAN for a Not-a-Number with the mantissa " ! "0x40f95 or a custom\nhexadecimal value"}, {"GFORTRAN_MEM_CHECK", 0, &options.mem_check, init_boolean, show_boolean, ! "Whether memory still allocated will be reported when the program ends."}, /* Signal handling (Unix). */ {"GFORTRAN_SIGHUP", 0, &options.sighup, init_signal, show_signal, ! "Whether the program will IGNORE or ABORT on SIGHUP."}, {"GFORTRAN_SIGINT", 0, &options.sigint, init_signal, show_signal, ! "Whether the program will IGNORE or ABORT on SIGINT."}, /* Floating point control */ {"GFORTRAN_FPU_ROUND", 0, &options.fpu_round, init_round, show_round, ! "Set floating point rounding. Values are NEAREST, UP, DOWN, ZERO."}, {"GFORTRAN_FPU_PRECISION", 0, &options.fpu_precision, init_precision, show_precision, ! "Precision of intermediate results. Values are 24, 53 and 64."}, ! ! {"GFORTRAN_FPU_INVALID", 1, &options.fpu_invalid, init_boolean, ! show_boolean, ! "Raise a floating point exception on invalid FP operation."}, ! ! {"GFORTRAN_FPU_DENORMAL", 1, &options.fpu_denormal, init_boolean, ! show_boolean, ! "Raise a floating point exception when denormal numbers are encountered."}, ! ! {"GFORTRAN_FPU_ZERO", 0, &options.fpu_zerodiv, init_boolean, show_boolean, ! "Raise a floating point exception when dividing by zero."}, ! ! {"GFORTRAN_FPU_OVERFLOW", 0, &options.fpu_overflow, init_boolean, ! show_boolean, ! "Raise a floating point exception on overflow."}, ! ! {"GFORTRAN_FPU_UNDERFLOW", 0, &options.fpu_underflow, init_boolean, ! show_boolean, ! "Raise a floating point exception on underflow."}, ! {"GFORTRAN_FPU_PRECISION", 0, &options.fpu_precision_loss, init_boolean, ! show_boolean, ! "Raise a floating point exception on precision loss."}, ! {NULL} }; --- 465,545 ---- static variable variable_table[] = { {"GFORTRAN_STDIN_UNIT", 5, &options.stdin_unit, init_integer, show_integer, "Unit number that will be preconnected to standard input\n" ! "(No preconnection if negative)", 0}, {"GFORTRAN_STDOUT_UNIT", 6, &options.stdout_unit, init_integer, show_integer, "Unit number that will be preconnected to standard output\n" ! "(No preconnection if negative)", 0}, {"GFORTRAN_STDERR_UNIT", 0, &options.stderr_unit, init_integer, show_integer, "Unit number that will be preconnected to standard error\n" ! "(No preconnection if negative)", 0}, {"GFORTRAN_USE_STDERR", 1, &options.use_stderr, init_boolean, show_boolean, ! "Sends library output to standard error instead of standard output.", 0}, {"GFORTRAN_TMPDIR", 0, NULL, init_string, show_string, "Directory for scratch files. Overrides the TMP environment variable\n" ! "If TMP is not set " DEFAULT_TEMPDIR " is used.", 0}, {"GFORTRAN_UNBUFFERED_ALL", 0, &options.all_unbuffered, init_boolean, show_boolean, "If TRUE, all output is unbuffered. This will slow down large writes " ! "but can be\nuseful for forcing data to be displayed immediately.", 0}, {"GFORTRAN_SHOW_LOCUS", 1, &options.locus, init_boolean, show_boolean, ! "If TRUE, print filename and line number where runtime errors happen.", 0}, {"GFORTRAN_OPTIONAL_PLUS", 0, &options.optional_plus, init_boolean, show_boolean, ! "Print optional plus signs in numbers where permitted. Default FALSE.", 0}, {"GFORTRAN_DEFAULT_RECL", DEFAULT_RECL, &options.default_recl, ! init_unsigned_integer, show_integer, "Default maximum record length for sequential files. Most useful for\n" "adjusting line length of preconnected units. Default " ! stringize (DEFAULT_RECL), 0}, {"GFORTRAN_LIST_SEPARATOR", 0, NULL, init_sep, show_sep, "Separatator to use when writing list output. May contain any number of " ! "spaces\nand at most one comma. Default is a single space.", 0}, /* Memory related controls */ {"GFORTRAN_MEM_INIT", 0, NULL, init_mem, show_mem, "How to initialize allocated memory. Default value is NONE for no " "initialization\n(faster), NAN for a Not-a-Number with the mantissa " ! "0x40f95 or a custom\nhexadecimal value", 0}, {"GFORTRAN_MEM_CHECK", 0, &options.mem_check, init_boolean, show_boolean, ! "Whether memory still allocated will be reported when the program ends.", ! 0}, /* Signal handling (Unix). */ {"GFORTRAN_SIGHUP", 0, &options.sighup, init_signal, show_signal, ! "Whether the program will IGNORE or ABORT on SIGHUP.", 0}, {"GFORTRAN_SIGINT", 0, &options.sigint, init_signal, show_signal, ! "Whether the program will IGNORE or ABORT on SIGINT.", 0}, /* Floating point control */ {"GFORTRAN_FPU_ROUND", 0, &options.fpu_round, init_round, show_round, ! "Set floating point rounding. Values are NEAREST, UP, DOWN, ZERO.", 0}, {"GFORTRAN_FPU_PRECISION", 0, &options.fpu_precision, init_precision, show_precision, ! "Precision of intermediate results. Values are 24, 53 and 64.", 0}, ! /* GFORTRAN_CONVERT_UNIT - Set the default data conversion for ! unformatted I/O. */ ! {"GFORTRAN_CONVERT_UNIT", 0, 0, init_unformatted, show_string, ! "Set format for unformatted files", 0}, ! {NULL, 0, NULL, NULL, NULL, NULL, 0} }; *************** init_variables (void) *** 550,564 **** int check_buffered (int n) { ! char name[40]; variable v; int rv; if (options.all_unbuffered) return 0; ! strcpy (name, "GFORTRAN_UNBUFFERED_"); ! strcat (name, gfc_itoa (n)); v.name = name; v.value = 2; --- 563,576 ---- int check_buffered (int n) { ! char name[22 + sizeof (n) * 3]; variable v; int rv; if (options.all_unbuffered) return 0; ! sprintf (name, "GFORTRAN_UNBUFFERED_%d", n); v.name = name; v.value = 2; *************** show_variables (void) *** 617,619 **** --- 629,1062 ---- sys_exit (0); } + + /* This is the handling of the GFORTRAN_CONVERT_UNITS environment variable. + It is called from environ.c to parse this variable, and from + open.c to determine if the user specified a default for an + unformatted file. + The syntax of the environment variable is, in bison grammar: + + GFORTRAN_CONVERT_UNITS: mode | mode ';' exception ; + mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ; + exception: mode ':' unit_list | unit_list ; + unit_list: unit_spec | unit_list unit_spec ; + unit_spec: INTEGER | INTEGER '-' INTEGER ; + */ + + /* Defines for the tokens. Other valid tokens are ',', ':', '-'. */ + + + #define NATIVE 257 + #define SWAP 258 + #define BIG 259 + #define LITTLE 260 + /* Some space for additional tokens later. */ + #define INTEGER 273 + #define END (-1) + #define ILLEGAL (-2) + + typedef struct + { + int unit; + unit_convert conv; + } exception_t; + + + static char *p; /* Main character pointer for parsing. */ + static char *lastpos; /* Auxiliary pointer, for backing up. */ + static int unit_num; /* The last unit number read. */ + static int unit_count; /* The number of units found. */ + static int do_count; /* Parsing is done twice - first to count the number + of units, then to fill in the table. This + variable controls what to do. */ + static exception_t *elist; /* The list of exceptions to the default. This is + sorted according to unit number. */ + static int n_elist; /* Number of exceptions to the default. */ + + static unit_convert endian; /* Current endianness. */ + + static unit_convert def; /* Default as specified (if any). */ + + /* Search for a unit number, using a binary search. The + first argument is the unit number to search for. The second argument + is a pointer to an index. + If the unit number is found, the function returns 1, and the index + is that of the element. + If the unit number is not found, the function returns 0, and the + index is the one where the element would be inserted. */ + + static int + search_unit (int unit, int *ip) + { + int low, high, mid; + + low = -1; + high = n_elist; + while (high - low > 1) + { + mid = (low + high) / 2; + if (unit <= elist[mid].unit) + high = mid; + else + low = mid; + } + *ip = high; + if (elist[high].unit == unit) + return 1; + else + return 0; + } + + /* This matches a keyword. If it is found, return the token supplied, + otherwise return ILLEGAL. */ + + static int + match_word (const char *word, int tok) + { + int res; + + if (strncasecmp (p, word, strlen (word)) == 0) + { + p += strlen (word); + res = tok; + } + else + res = ILLEGAL; + return res; + + } + + /* Match an integer and store its value in unit_num. This only works + if p actually points to the start of an integer. The caller has + to ensure this. */ + + static int + match_integer (void) + { + unit_num = 0; + while (isdigit (*p)) + unit_num = unit_num * 10 + (*p++ - '0'); + return INTEGER; + + } + + /* This reads the next token from the GFORTRAN_CONVERT_UNITS variable. + Returned values are the different tokens. */ + + static int + next_token (void) + { + int result; + + lastpos = p; + switch (*p) + { + case '\0': + result = END; + break; + + case ':': + case ',': + case '-': + case ';': + result = *p; + p++; + break; + + case 'b': + case 'B': + result = match_word ("big_endian", BIG); + break; + + case 'l': + case 'L': + result = match_word ("little_endian", LITTLE); + break; + + case 'n': + case 'N': + result = match_word ("native", NATIVE); + break; + + case 's': + case 'S': + result = match_word ("swap", SWAP); + break; + + case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + result = match_integer (); + break; + + default: + result = ILLEGAL; + break; + } + return result; + } + + /* Back up the last token by setting back the character pointer. */ + + static void + push_token (void) + { + p = lastpos; + } + + /* This is called when a unit is identified. If do_count is nonzero, + increment the number of units by one. If do_count is zero, + put the unit into the table. */ + + static void + mark_single (int unit) + { + int i,j; + + if (do_count) + { + unit_count++; + return; + } + if (search_unit (unit, &i)) + { + elist[unit].conv = endian; + } + else + { + for (j=n_elist; j>=i; j--) + elist[j+1] = elist[j]; + + n_elist += 1; + elist[i].unit = unit; + elist[i].conv = endian; + } + } + + /* This is called when a unit range is identified. If do_count is + nonzero, increase the number of units. If do_count is zero, + put the unit into the table. */ + + static void + mark_range (int unit1, int unit2) + { + int i; + if (do_count) + unit_count += abs (unit2 - unit1) + 1; + else + { + if (unit2 < unit1) + for (i=unit2; i<=unit1; i++) + mark_single (i); + else + for (i=unit1; i<=unit2; i++) + mark_single (i); + } + } + + /* Parse the GFORTRAN_CONVERT_UNITS variable. This is called + twice, once to count the units and once to actually mark them in + the table. When counting, we don't check for double occurences + of units. */ + + static int + do_parse (void) + { + int tok, def; + int unit1; + int continue_ulist; + char *start; + + unit_count = 0; + + def = 0; + start = p; + + /* Parse the string. First, let's look for a default. */ + tok = next_token (); + switch (tok) + { + case NATIVE: + endian = CONVERT_NATIVE; + break; + + case SWAP: + endian = CONVERT_SWAP; + break; + + case BIG: + endian = CONVERT_BIG; + break; + + case LITTLE: + endian = CONVERT_LITTLE; + break; + + case INTEGER: + /* A leading digit means that we are looking at an exception. + Reset the position to the beginning, and continue processing + at the exception list. */ + p = start; + goto exceptions; + break; + + case END: + goto end; + break; + + default: + goto error; + break; + } + + tok = next_token (); + switch (tok) + { + case ';': + def = endian; + break; + + case ':': + /* This isn't a default after all. Reset the position to the + beginning, and continue processing at the exception list. */ + p = start; + goto exceptions; + break; + + case END: + goto end; + break; + + default: + goto error; + break; + } + + exceptions: + + /* Loop over all exceptions. */ + while(1) + { + tok = next_token (); + switch (tok) + { + case LITTLE: + if (next_token () != ':') + goto error; + endian = CONVERT_LITTLE; + break; + + case BIG: + if (next_token () != ':') + goto error; + endian = CONVERT_BIG; + break; + + case INTEGER: + push_token (); + break; + + case END: + goto end; + break; + + default: + goto error; + break; + } + /* We arrive here when we want to parse a list of + numbers. */ + continue_ulist = 1; + do + { + tok = next_token (); + if (tok != INTEGER) + goto error; + + unit1 = unit_num; + tok = next_token (); + /* The number can be followed by a - and another number, + which means that this is a unit range, a comma + or a semicolon. */ + if (tok == '-') + { + if (next_token () != INTEGER) + goto error; + + mark_range (unit1, unit_num); + tok = next_token (); + if (tok == END) + goto end; + else if (tok == ';') + continue_ulist = 0; + else if (tok != ',') + goto error; + } + else + { + mark_single (unit1); + switch (tok) + { + case ';': + continue_ulist = 0; + break; + + case ',': + break; + + case END: + goto end; + break; + + default: + goto error; + } + } + } while (continue_ulist); + } + end: + return 0; + error: + def = CONVERT_NONE; + return -1; + } + + void init_unformatted (variable * v) + { + char *val; + val = getenv (v->name); + def = CONVERT_NONE; + n_elist = 0; + + if (val == NULL) + return; + do_count = 1; + p = val; + do_parse (); + if (do_count <= 0) + { + n_elist = 0; + elist = NULL; + } + else + { + elist = get_mem (unit_count * sizeof (exception_t)); + do_count = 0; + p = val; + do_parse (); + } + } + + /* Get the default conversion for for an unformatted unit. */ + + unit_convert + get_unformatted_convert (int unit) + { + int i; + + if (elist == NULL) + return def; + else if (search_unit (unit, &i)) + return elist[i].conv; + else + return def; + } diff -Nrcpad gcc-4.0.2/libgfortran/runtime/error.c gcc-4.1.0/libgfortran/runtime/error.c *** gcc-4.0.2/libgfortran/runtime/error.c Thu Aug 11 13:53:22 2005 --- gcc-4.1.0/libgfortran/runtime/error.c Tue Feb 14 14:50:40 2006 *************** *** 1,4 **** ! /* Copyright (C) 2002-2003 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! /* Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,34 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include #include --- 24,35 ---- 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. */ #include "config.h" + #include #include #include #include *************** Boston, MA 02111-1307, USA. */ *** 36,41 **** --- 37,43 ---- #include "libgfortran.h" #include "../io/io.h" + #include "../io/unix.h" /* Error conditions. The tricky part here is printing a message when * it is the I/O subsystem that is severely wounded. Our goal is to *************** Boston, MA 02111-1307, USA. */ *** 52,86 **** * Other error returns are reserved for the STOP statement with a numeric code. */ ! /* locus variables. These are optionally set by a caller before a ! * library subroutine is called. They are always cleared on exit so ! * that files that report loci and those that do not can be linked ! * together without reporting an erroneous position. */ ! ! char *filename = 0; ! iexport_data(filename); ! ! unsigned line = 0; ! iexport_data(line); ! ! static char buffer[32]; /* buffer for integer/ascii conversions */ ! ! ! /* Returns a pointer to a static buffer. */ ! char * ! gfc_itoa (int64_t n) { int negative; char *p; ! uint64_t t; if (n == 0) ! { ! buffer[0] = '0'; ! buffer[1] = '\0'; ! return buffer; ! } negative = 0; t = n; --- 54,72 ---- * Other error returns are reserved for the STOP statement with a numeric code. */ ! /* gfc_itoa()-- Integer to decimal conversion. */ ! const char * ! gfc_itoa (GFC_INTEGER_LARGEST n, char *buffer, size_t len) { int negative; char *p; ! GFC_UINTEGER_LARGEST t; ! ! assert (len >= GFC_ITOA_BUF_SIZE); if (n == 0) ! return "0"; negative = 0; t = n; *************** gfc_itoa (int64_t n) *** 90,128 **** t = -n; /*must use unsigned to protect from overflow*/ } ! p = buffer + sizeof (buffer) - 1; ! *p-- = '\0'; while (t != 0) { ! *p-- = '0' + (t % 10); t /= 10; } if (negative) ! *p-- = '-'; ! return ++p; } ! /* xtoa()-- Integer to hexadecimal conversion. Returns a pointer to a ! * static buffer. */ ! char * ! xtoa (uint64_t n) { int digit; char *p; if (n == 0) ! { ! buffer[0] = '0'; ! buffer[1] = '\0'; ! return buffer; ! } ! p = buffer + sizeof (buffer) - 1; ! *p-- = '\0'; while (n != 0) { --- 76,111 ---- t = -n; /*must use unsigned to protect from overflow*/ } ! p = buffer + GFC_ITOA_BUF_SIZE - 1; ! *p = '\0'; while (t != 0) { ! *--p = '0' + (t % 10); t /= 10; } if (negative) ! *--p = '-'; ! return p; } ! /* xtoa()-- Integer to hexadecimal conversion. */ ! const char * ! xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) { int digit; char *p; + assert (len >= GFC_XTOA_BUF_SIZE); + if (n == 0) ! return "0"; ! p = buffer + GFC_XTOA_BUF_SIZE - 1; ! *p = '\0'; while (n != 0) { *************** xtoa (uint64_t n) *** 130,140 **** if (digit > 9) digit += 'A' - '0' - 10; ! *p-- = '0' + digit; n >>= 4; } ! return ++p; } --- 113,123 ---- if (digit > 9) digit += 'A' - '0' - 10; ! *--p = '0' + digit; n >>= 4; } ! return p; } *************** st_printf (const char *format, ...) *** 148,158 **** { int count, total; va_list arg; ! char *p, *q; stream *s; total = 0; ! s = init_error_stream (); va_start (arg, format); for (;;) --- 131,144 ---- { int count, total; va_list arg; ! char *p; ! const char *q; stream *s; + char itoa_buf[GFC_ITOA_BUF_SIZE]; + unix_stream err_stream; total = 0; ! s = init_error_stream (&err_stream); va_start (arg, format); for (;;) *************** st_printf (const char *format, ...) *** 186,192 **** break; case 'd': ! q = gfc_itoa (va_arg (arg, int)); count = strlen (q); p = salloc_w (s, &count); --- 172,178 ---- break; case 'd': ! q = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf)); count = strlen (q); p = salloc_w (s, &count); *************** st_printf (const char *format, ...) *** 195,201 **** break; case 'x': ! q = xtoa (va_arg (arg, unsigned)); count = strlen (q); p = salloc_w (s, &count); --- 181,187 ---- break; case 'x': ! q = xtoa (va_arg (arg, unsigned), itoa_buf, sizeof (itoa_buf)); count = strlen (q); p = salloc_w (s, &count); *************** void *** 239,246 **** st_sprintf (char *buffer, const char *format, ...) { va_list arg; ! char c, *p; int count; va_start (arg, format); --- 225,234 ---- st_sprintf (char *buffer, const char *format, ...) { va_list arg; ! char c; ! const char *p; int count; + char itoa_buf[GFC_ITOA_BUF_SIZE]; va_start (arg, format); *************** st_sprintf (char *buffer, const char *fo *** 263,269 **** break; case 'd': ! p = gfc_itoa (va_arg (arg, int)); count = strlen (p); memcpy (buffer, p, count); --- 251,257 ---- break; case 'd': ! p = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf)); count = strlen (p); memcpy (buffer, p, count); *************** st_sprintf (char *buffer, const char *fo *** 291,302 **** * something went wrong */ void ! show_locus (void) { ! if (!options.locus || filename == NULL) return; ! st_printf ("At line %d of file %s\n", line, filename); } --- 279,290 ---- * something went wrong */ void ! show_locus (st_parameter_common *cmp) { ! if (!options.locus || cmp == NULL || cmp->filename == NULL) return; ! st_printf ("At line %d of file %s\n", cmp->line, cmp->filename); } *************** void *** 327,333 **** os_error (const char *message) { recursion_check (); - show_locus (); st_printf ("Operating system error: %s\n%s\n", get_oserror (), message); sys_exit (1); } --- 315,320 ---- *************** void *** 340,346 **** runtime_error (const char *message) { recursion_check (); - show_locus (); st_printf ("Fortran runtime error: %s\n", message); sys_exit (2); } --- 327,332 ---- *************** iexport(runtime_error); *** 351,361 **** * that indicate something deeply wrong. */ void ! internal_error (const char *message) { recursion_check (); ! show_locus (); st_printf ("Internal Error: %s\n", message); sys_exit (3); } --- 337,354 ---- * that indicate something deeply wrong. */ void ! internal_error (st_parameter_common *cmp, const char *message) { recursion_check (); ! show_locus (cmp); st_printf ("Internal Error: %s\n", message); + + /* This function call is here to get the main.o object file included + when linking statically. This works because error.o is supposed to + be always linked in (and the function call is in internal_error + because hopefully it doesn't happen too often). */ + stupid_function_name_for_static_linking(); + sys_exit (3); } *************** translate_error (int code) *** 430,435 **** --- 423,436 ---- p = "Numeric overflow on read"; break; + case ERROR_INTERNAL: + p = "Internal error in run-time library"; + break; + + case ERROR_INTERNAL_UNIT: + p = "Internal unit I/O error"; + break; + default: p = "Unknown error code"; break; *************** translate_error (int code) *** 440,492 **** /* generate_error()-- Come here when an error happens. This ! * subroutine is called if it is possible to continue on after the ! * error. If an IOSTAT variable exists, we set it. If the IOSTAT or ! * ERR label is present, we return, otherwise we terminate the program ! * after print a message. The error code is always required but the * message parameter can be NULL, in which case a string describing * the most recent operating system error is used. */ void ! generate_error (int family, const char *message) { /* Set the error status. */ ! if (ioparm.iostat != NULL) ! *ioparm.iostat = family; /* Report status back to the compiler. */ switch (family) { case ERROR_EOR: ! ioparm.library_return = LIBRARY_EOR; ! if (ioparm.eor != 0) return; break; case ERROR_END: ! ioparm.library_return = LIBRARY_END; ! if (ioparm.end != 0) return; break; default: ! ioparm.library_return = LIBRARY_ERROR; ! if (ioparm.err != 0) return; break; } /* Return if the user supplied an iostat variable. */ ! if (ioparm.iostat != NULL) return; /* Terminate the program */ ! if (message == NULL) ! message = ! (family == ERROR_OS) ? get_oserror () : translate_error (family); ! ! runtime_error (message); } --- 441,500 ---- /* generate_error()-- Come here when an error happens. This ! * subroutine is called if it is possible to continue on after the error. ! * If an IOSTAT or IOMSG variable exists, we set it. If IOSTAT or ! * ERR labels are present, we return, otherwise we terminate the program ! * after printing a message. The error code is always required but the * message parameter can be NULL, in which case a string describing * the most recent operating system error is used. */ void ! generate_error (st_parameter_common *cmp, int family, const char *message) { /* Set the error status. */ ! if ((cmp->flags & IOPARM_HAS_IOSTAT)) ! *cmp->iostat = family; ! ! if (message == NULL) ! message = ! (family == ERROR_OS) ? get_oserror () : translate_error (family); ! ! if (cmp->flags & IOPARM_HAS_IOMSG) ! cf_strcpy (cmp->iomsg, cmp->iomsg_len, message); /* Report status back to the compiler. */ + cmp->flags &= ~IOPARM_LIBRETURN_MASK; switch (family) { case ERROR_EOR: ! cmp->flags |= IOPARM_LIBRETURN_EOR; ! if ((cmp->flags & IOPARM_EOR)) return; break; case ERROR_END: ! cmp->flags |= IOPARM_LIBRETURN_END; ! if ((cmp->flags & IOPARM_END)) return; break; default: ! cmp->flags |= IOPARM_LIBRETURN_ERROR; ! if ((cmp->flags & IOPARM_ERR)) return; break; } /* Return if the user supplied an iostat variable. */ ! if ((cmp->flags & IOPARM_HAS_IOSTAT)) return; /* Terminate the program */ ! recursion_check (); ! show_locus (cmp); ! st_printf ("Fortran runtime error: %s\n", message); ! sys_exit (2); } *************** notify_std (int std, const char * messag *** 500,510 **** { int warning; warning = compile_options.warn_std & std; if ((compile_options.allow_std & std) != 0 && !warning) return SUCCESS; - show_locus (); if (!warning) { st_printf ("Fortran runtime error: %s\n", message); --- 508,520 ---- { int warning; + if (!compile_options.pedantic) + return SUCCESS; + warning = compile_options.warn_std & std; if ((compile_options.allow_std & std) != 0 && !warning) return SUCCESS; if (!warning) { st_printf ("Fortran runtime error: %s\n", message); diff -Nrcpad gcc-4.0.2/libgfortran/runtime/fpu.c gcc-4.1.0/libgfortran/runtime/fpu.c *** gcc-4.0.2/libgfortran/runtime/fpu.c Thu Jan 1 00:00:00 1970 --- gcc-4.1.0/libgfortran/runtime/fpu.c Tue Nov 22 10:58:47 2005 *************** *** 0 **** --- 1,16 ---- + #include "libgfortran.h" + + /* We include the platform-dependent code. */ + #include "fpu-target.h" + + /* Function called by the front-end to tell us + when a FPE should be raised. */ + extern void set_fpe (int); + export_proto(set_fpe); + + void + set_fpe (int exceptions) + { + options.fpe = exceptions; + set_fpu (); + } diff -Nrcpad gcc-4.0.2/libgfortran/runtime/in_pack_generic.c gcc-4.1.0/libgfortran/runtime/in_pack_generic.c *** gcc-4.0.2/libgfortran/runtime/in_pack_generic.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/runtime/in_pack_generic.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include diff -Nrcpad gcc-4.0.2/libgfortran/runtime/in_unpack_generic.c gcc-4.1.0/libgfortran/runtime/in_unpack_generic.c *** gcc-4.0.2/libgfortran/runtime/in_unpack_generic.c Mon Jul 18 17:40:44 2005 --- gcc-4.1.0/libgfortran/runtime/in_unpack_generic.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include diff -Nrcpad gcc-4.0.2/libgfortran/runtime/main.c gcc-4.1.0/libgfortran/runtime/main.c *** gcc-4.0.2/libgfortran/runtime/main.c Thu Aug 11 13:53:22 2005 --- gcc-4.1.0/libgfortran/runtime/main.c Fri Nov 4 08:44:29 2005 *************** *** 1,4 **** ! /* Copyright (C) 2002-2003 Free Software Foundation, Inc. Contributed by Andy Vaught and Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! /* Copyright (C) 2002-2003, 2005 Free Software Foundation, Inc. Contributed by Andy Vaught and Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include --- 24,31 ---- 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. */ #include #include *************** Boston, MA 02111-1307, USA. */ *** 35,40 **** --- 35,48 ---- #include "libgfortran.h" + /* Stupid function to be sure the constructor is always linked in, even + in the case of static linking. See PR libfortran/22298 for details. */ + void + stupid_function_name_for_static_linking (void) + { + return; + } + /* This is the offset (in bytes) required to cast from logical(8)* to logical(4)*. and still get the same result. Will be 0 for little-endian machines and 4 for big-endian machines. */ *************** init (void) *** 96,101 **** --- 104,110 ---- init_variables (); init_units (); + set_fpu (); init_compile_options (); #ifdef DEBUG *************** init (void) *** 114,120 **** /* Cleanup the runtime library. */ static void __attribute__((destructor)) ! cleanup () { close_units (); } --- 123,129 ---- /* Cleanup the runtime library. */ static void __attribute__((destructor)) ! cleanup (void) { close_units (); } diff -Nrcpad gcc-4.0.2/libgfortran/runtime/memory.c gcc-4.1.0/libgfortran/runtime/memory.c *** gcc-4.0.2/libgfortran/runtime/memory.c Thu May 12 19:10:58 2005 --- gcc-4.1.0/libgfortran/runtime/memory.c Mon Oct 3 20:32:44 2005 *************** *** 1,5 **** /* Memory mamagement routines. ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Memory mamagement routines. ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 42,93 **** This causes small overhead, but again, it also helps debugging. */ #define GFC_CHECK_MEMORY - /* We use a double linked list of these structures to keep track of - the memory we allocate internally. We could also use this for user - allocated memory (ALLOCATE/DEALLOCATE). This should be stored in a - seperate list. */ - typedef struct malloc_t - { - int magic; - int marker; - struct malloc_t *prev, *next; - - /* The start of the block. */ - void *data; - } - malloc_t; - - /* We try to make sure we don't get memory corruption by checking for - a magic number. */ - #define GFC_MALLOC_MAGIC 0x4d353941 /* "G95M" */ - - #define HEADER_SIZE offsetof (malloc_t, data) - #define DATA_POINTER(pheader) (&((pheader)->data)) - #define DATA_HEADER(pdata) ((malloc_t *)((char *) (pdata) - HEADER_SIZE)) - - /* The root of the circular double linked list for compiler generated - malloc calls. */ - static malloc_t mem_root = { - .next = &mem_root, - .prev = &mem_root - }; - - #if 0 - /* ??? Disabled because, well, it wasn't being called before transforming - it to a destructor, and turning it on causes testsuite failures. */ - /* Doesn't actually do any cleaning up, just throws an error if something - has got out of sync somewhere. */ - - static void __attribute__((destructor)) - runtime_cleanup (void) - { - /* Make sure all memory we've allocated is freed on exit. */ - if (mem_root.next != &mem_root) - runtime_error ("Unfreed memory on program termination"); - } - #endif - - void * get_mem (size_t n) { --- 42,47 ---- *************** free_mem (void *p) *** 112,158 **** } - /* Allocates a block of memory with a size of N bytes. N does not - include the size of the header. */ - - static malloc_t * - malloc_with_header (size_t n) - { - malloc_t *newmem; - - n = n + HEADER_SIZE; - - newmem = (malloc_t *) get_mem (n); - - if (newmem) - { - newmem->magic = GFC_MALLOC_MAGIC; - newmem->marker = 0; - } - - return newmem; - } - - /* Allocate memory for internal (compiler generated) use. */ void * internal_malloc_size (size_t size) { ! malloc_t *newmem; ! ! newmem = malloc_with_header (size); ! ! if (!newmem) ! os_error ("Out of memory."); ! ! /* Add to end of list. */ ! newmem->next = &mem_root; ! newmem->prev = mem_root.prev; ! mem_root.prev->next = newmem; ! mem_root.prev = newmem; ! return DATA_POINTER (newmem); } extern void *internal_malloc (GFC_INTEGER_4); --- 66,80 ---- } /* Allocate memory for internal (compiler generated) use. */ void * internal_malloc_size (size_t size) { ! if (size == 0) ! return NULL; ! return get_mem (size); } extern void *internal_malloc (GFC_INTEGER_4); *************** internal_malloc64 (GFC_INTEGER_8 size) *** 187,217 **** /* Free internally allocated memory. Pointer is NULLified. Also used to free user allocated memory. */ - /* TODO: keep a list of previously allocated blocks and reuse them. */ void internal_free (void *mem) { ! malloc_t *m; if (!mem) ! runtime_error ("Internal: Possible double free of temporary."); ! m = DATA_HEADER (mem); ! if (m->magic != GFC_MALLOC_MAGIC) ! runtime_error ("Internal: No magic memblock marker. " ! "Possible memory corruption"); ! /* Move markers up the chain, so they don't get lost. */ ! m->prev->marker += m->marker; ! /* Remove from list. */ ! m->prev->next = m->next; ! m->next->prev = m->prev; ! free (m); } - iexport(internal_free); /* User-allocate, one call for each member of the alloc-list of an --- 109,174 ---- /* Free internally allocated memory. Pointer is NULLified. Also used to free user allocated memory. */ void internal_free (void *mem) { ! if (mem != NULL) ! free (mem); ! } ! iexport(internal_free); ! ! /* Reallocate internal memory MEM so it has SIZE bytes of data. ! Allocate a new block if MEM is zero, and free the block if ! SIZE is 0. */ ! ! static void * ! internal_realloc_size (void *mem, size_t size) ! { ! if (size == 0) ! { ! if (mem) ! free (mem); ! return NULL; ! } + if (mem == 0) + return get_mem (size); + + mem = realloc (mem, size); if (!mem) ! os_error ("Out of memory."); ! return mem; ! } ! extern void *internal_realloc (void *, GFC_INTEGER_4); ! export_proto(internal_realloc); ! void * ! internal_realloc (void *mem, GFC_INTEGER_4 size) ! { ! #ifdef GFC_CHECK_MEMORY ! /* Under normal circumstances, this is _never_ going to happen! */ ! if (size < 0) ! runtime_error ("Attempt to allocate a negative amount of memory."); ! #endif ! return internal_realloc_size (mem, (size_t) size); ! } ! extern void *internal_realloc64 (void *, GFC_INTEGER_8); ! export_proto(internal_realloc64); ! ! void * ! internal_realloc64 (void *mem, GFC_INTEGER_8 size) ! { ! #ifdef GFC_CHECK_MEMORY ! /* Under normal circumstances, this is _never_ going to happen! */ ! if (size < 0) ! runtime_error ("Attempt to allocate a negative amount of memory."); ! #endif ! return internal_realloc_size (mem, (size_t) size); } /* User-allocate, one call for each member of the alloc-list of an *************** iexport(internal_free); *** 220,231 **** static void allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat) { ! malloc_t *newmem; if (!mem) runtime_error ("Internal: NULL mem pointer in ALLOCATE."); ! newmem = malloc_with_header (size); if (!newmem) { if (stat) --- 177,188 ---- static void allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat) { ! void *newmem; if (!mem) runtime_error ("Internal: NULL mem pointer in ALLOCATE."); ! newmem = malloc (size ? size : 1); if (!newmem) { if (stat) *************** allocate_size (void **mem, size_t size, *** 237,247 **** runtime_error ("ALLOCATE: Out of memory."); } ! /* We don't keep a list of these at the moment, so just link to itself. */ ! newmem->next = newmem; ! newmem->prev = newmem; ! ! (*mem) = DATA_POINTER (newmem); if (stat) *stat = 0; --- 194,200 ---- runtime_error ("ALLOCATE: Out of memory."); } ! (*mem) = newmem; if (stat) *stat = 0; *************** void *** 290,296 **** deallocate (void **mem, GFC_INTEGER_4 * stat) { if (!mem) ! runtime_error ("Internal: NULL mem pointer in ALLOCATE."); if (!*mem) { --- 243,249 ---- deallocate (void **mem, GFC_INTEGER_4 * stat) { if (!mem) ! runtime_error ("Internal: NULL mem pointer in DEALLOCATE."); if (!*mem) { *************** deallocate (void **mem, GFC_INTEGER_4 * *** 307,314 **** } } ! /* Just use the internal routine. */ ! internal_free (*mem); *mem = NULL; if (stat) --- 260,266 ---- } } ! free (*mem); *mem = NULL; if (stat) diff -Nrcpad gcc-4.0.2/libgfortran/runtime/normalize.c gcc-4.1.0/libgfortran/runtime/normalize.c *** gcc-4.0.2/libgfortran/runtime/normalize.c Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/runtime/normalize.c Wed Aug 17 02:49:08 2005 *************** *** 1,5 **** /* Nelper routines to convert from integer to real. ! Copyright 2004 Free Software Foundation, Inc. Contributed by Paul Brook. This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Nelper routines to convert from integer to real. ! Copyright 2004, 2005 Free Software Foundation, Inc. Contributed by Paul Brook. This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include #include "libgfortran.h" --- 25,32 ---- 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 #include "libgfortran.h" *************** Boston, MA 02111-1307, USA. */ *** 36,42 **** /* Return the largest value less than one representable in a REAL*4. */ static inline GFC_REAL_4 ! almostone_r4 () { #ifdef HAVE_NEXTAFTERF return nextafterf (1.0f, 0.0f); --- 36,42 ---- /* Return the largest value less than one representable in a REAL*4. */ static inline GFC_REAL_4 ! almostone_r4 (void) { #ifdef HAVE_NEXTAFTERF return nextafterf (1.0f, 0.0f); *************** almostone_r4 () *** 65,71 **** /* Return the largest value less than one representable in a REAL*8. */ static inline GFC_REAL_8 ! almostone_r8 () { #ifdef HAVE_NEXTAFTER return nextafter (1.0, 0.0); --- 65,71 ---- /* Return the largest value less than one representable in a REAL*8. */ static inline GFC_REAL_8 ! almostone_r8 (void) { #ifdef HAVE_NEXTAFTER return nextafter (1.0, 0.0); diff -Nrcpad gcc-4.0.2/libgfortran/runtime/pause.c gcc-4.1.0/libgfortran/runtime/pause.c *** gcc-4.0.2/libgfortran/runtime/pause.c Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/runtime/pause.c Tue Nov 22 10:58:47 2005 *************** *** 1,5 **** /* Implementation of the STOP statement. ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the STOP statement. ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** export_proto(pause_numeric); *** 55,62 **** void pause_numeric (GFC_INTEGER_4 code) { - show_locus (); - if (code == -1) st_printf ("PAUSE\n"); else --- 55,60 ---- *************** export_proto(pause_string); *** 71,78 **** void pause_string (char *string, GFC_INTEGER_4 len) { - show_locus (); - st_printf ("PAUSE "); while (len--) st_printf ("%c", *(string++)); --- 69,74 ---- diff -Nrcpad gcc-4.0.2/libgfortran/runtime/select.c gcc-4.1.0/libgfortran/runtime/select.c *** gcc-4.0.2/libgfortran/runtime/select.c Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/runtime/select.c Wed Aug 17 02:49:08 2005 *************** GNU General Public License for more deta *** 24,31 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "libgfortran.h" --- 24,31 ---- 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. */ #include "libgfortran.h" diff -Nrcpad gcc-4.0.2/libgfortran/runtime/stop.c gcc-4.1.0/libgfortran/runtime/stop.c *** gcc-4.0.2/libgfortran/runtime/stop.c Wed Jan 12 21:27:31 2005 --- gcc-4.1.0/libgfortran/runtime/stop.c Tue Nov 22 10:58:47 2005 *************** *** 1,5 **** /* Implementation of the STOP statement. ! Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,5 ---- /* Implementation of the STOP statement. ! Copyright 2002, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 25,32 **** 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., 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include --- 25,32 ---- You should have received a copy of the GNU General Public License along with libgfortran; see the file COPYING. If not, ! write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! Boston, MA 02110-1301, USA. */ #include "config.h" #include *************** Boston, MA 02111-1307, USA. */ *** 37,46 **** void stop_numeric (GFC_INTEGER_4 code) { - show_locus (); - if (code == -1) ! st_printf ("STOP\n"); else st_printf ("STOP %d\n", (int)code); --- 37,44 ---- void stop_numeric (GFC_INTEGER_4 code) { if (code == -1) ! code = 0; else st_printf ("STOP %d\n", (int)code); *************** export_proto(stop_string); *** 55,62 **** void stop_string (const char *string, GFC_INTEGER_4 len) { - show_locus (); - st_printf ("STOP "); while (len--) st_printf ("%c", *(string++)); --- 53,58 ---- diff -Nrcpad gcc-4.0.2/libgfortran/runtime/string.c gcc-4.1.0/libgfortran/runtime/string.c *** gcc-4.0.2/libgfortran/runtime/string.c Tue Jul 12 01:50:37 2005 --- gcc-4.1.0/libgfortran/runtime/string.c Tue Nov 22 10:58:47 2005 *************** *** 1,4 **** ! /* Copyright (C) 2002-2003 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). --- 1,4 ---- ! /* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). *************** GNU General Public License for more deta *** 24,37 **** 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, 59 Temple Place - Suite 330, ! Boston, MA 02111-1307, USA. */ #include "config.h" #include #include "libgfortran.h" ! /* Compare a C-style string with a fortran style string in a case-insensitive manner. Used for decoding string options to various statements. Returns --- 24,37 ---- 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. */ #include "config.h" #include #include "libgfortran.h" ! #include "../io/io.h" /* Compare a C-style string with a fortran style string in a case-insensitive manner. Used for decoding string options to various statements. Returns *************** compare0 (const char *s1, int s1_len, co *** 43,50 **** int len; /* Strip trailing blanks from the Fortran string. */ ! len = fstrlen(s1, s1_len); ! return strncasecmp(s1,s2,len) == 0; } --- 43,50 ---- int len; /* Strip trailing blanks from the Fortran string. */ ! len = fstrlen (s1, s1_len); ! return strncasecmp (s1, s2, len) == 0; } *************** cf_strcpy (char *dest, int dest_len, con *** 104,117 **** if no default is provided. */ int ! find_option (const char *s1, int s1_len, st_option * opts, ! const char *error_message) { for (; opts->name; opts++) if (compare0 (s1, s1_len, opts->name)) return opts->value; ! generate_error (ERROR_BAD_OPTION, error_message); return -1; } --- 104,117 ---- if no default is provided. */ int ! find_option (st_parameter_common *cmp, const char *s1, int s1_len, ! const st_option * opts, const char *error_message) { for (; opts->name; opts++) if (compare0 (s1, s1_len, opts->name)) return opts->value; ! generate_error (cmp, ERROR_BAD_OPTION, error_message); return -1; }