diff options
669 files changed, 20806 insertions, 15500 deletions
diff --git a/ChangeLog.MELT b/ChangeLog.MELT index 2f6a4ffa574..a707aaeefc4 100644 --- a/ChangeLog.MELT +++ b/ChangeLog.MELT @@ -1,4 +1,7 @@ +2009-06-22 Basile Starynkevitch <basile@starynkevitch.net> + MELT branch merged with trunk r148777 + 2009-06-18 Basile Starynkevitch <basile@starynkevitch.net> MELT branch merged with trunk r148653 diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 01d2a0d8b54..308a1f73373 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,395 @@ +2009-06-21 Richard Earnshaw <rearnsha@arm.com> + + * arm.c (thumb1_output_casesi): New function. + * arm.h (CASE_VECTOR_PC_RELATIVE): Thumb-1 code is also relative if + optimizing for size or PIC. + (CASE_VECTOR_SHORTEN_MODE): Handle thumb-1. + * arm.md (UNSPEC_THUMB1_CASESI): New constant. + (casesi): Handle Thumb-1 when optimizing for size or PIC. + (thumb1_casesi_internal_pic): New expand rule. + (thumb1_casesi_dispatch): New pattern. + * aout.h (ASM_OUTPUT_ADDR_DIFF_ELT): Use shortened vectors for + thumb-1 mode. + * coff.h (JUMP_TABLES_IN_TEXT_SECTION): Thumb-1 jump tables are now + in the text seciton when PIC or optimizing for size. + * elf.h (JUMP_TABLES_IN_TEXT_SECTION): Likewise. + * lib1funcs.asm ([__ARM_EABI__]): Add an attribute describing stack + preservation properties of code. + (__gnu_thumb1_case_sqi, __gnu_thumb1_case_uqi): New functions. + (__gnu_thumb1_case_shi, __gnu_thumb1_case_uhi): New functions. + (__gnu_thumb1_case_si): New function. + * t-arm (LIB1ASMSRC): Define here. + (LIB1ASMFUNCS): Add some common functions. + * t-arm-elf (LIB1ASMSRC): Delete. + (LIB1ASMFUNCS): Append to existing set. + * t-pe (LIB1ASMSRC, LIB1ASMFUNCS): Likewise. + * t-strongarm-elf (LIB1ASMSRC, LIB1ASMFUNCS): Likewise. + * t-symbian (LIB1ASMFUNCS): Likewise. + * t-vxworks (LIB1ASMSRC, LIB1ASMFUNCS): Likewise. + * t-wince-pe (LIB1ASMSRC, LIB1ASMFUNCS): Likewise. + +2009-06-21 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/38729 + * tree-ssa-loop-niter.c (find_loop_niter_by_eval): Restrict + to loops with a single exit if -fno-expensive-optimizations. + +2009-06-21 Jakub Jelinek <jakub@redhat.com> + + * var-tracking.c (struct shared_hash_def, shared_hash): New types. + (dataflow_set): Change vars type from htab_t to shared_hash. + (shared_hash_pool, empty_shared_hash): New variables. + (vars_clear): Removed. + (shared_hash_shared, shared_hash_htab, shared_hash_copy, + shared_hash_find_slot_unshare, shared_hash_find_slot, + shared_hash_find_slot_noinsert, shared_hash_find): New + static inlines. + (shared_hash_unshare, shared_hash_destroy): New functions. + (unshare_variable): Unshare set->vars if shared, use + shared_hash_htab. + (vars_copy): Use htab_traverse_noresize instead of htab_traverse. + (get_init_value, find_src_set_src, dump_dataflow_set, + clobber_variable_part, emit_notes_for_differences): Use + shared_hash_htab. + (dataflow_set_init): Remove second argument, set vars to + empty_shared_hash instead of creating a new htab. + (dataflow_set_clear): Call shared_hash_destroy and set vars + to empty_shared_hash instead of calling vars_clear. + (dataflow_set_copy): Don't call vars_copy, instead just share + the src htab with dst. + (variable_union): Use shared_hash_*, use initially NO_INSERT + lookup if set->vars is shared. Don't keep slot cleared before + calling unshare_variable. Unshare set->vars if needed. + Even ->refcount == 1 vars must be unshared if set->vars is shared + and var needs to be modified. + (variable_canonicalize): New function. + (dataflow_set_union): If dst->vars is empty, just share src->vars + with dst->vars and traverse with variable_canonicalize to canonicalize + and unshare what is needed. + (dataflow_set_different): If old_set and new_set use the same shared + htab, they aren't different. If number of htab elements is different, + htabs are different. Use shared_hash_*. + (dataflow_set_destroy): Call shared_hash_destroy instead of + htab_delete. + (compute_bb_dataflow, emit_notes_in_bb, vt_emit_notes): Don't pass + second argument to dataflow_set_init. + (vt_initialize): Likewise. Initialize shared_hash_pool and + empty_shared_hash, move bb in/out initialization afterwards. + Use variable_htab_free instead of NULL as changed_variables del hook. + (variable_was_changed): Change type of second argument to pointer to + dataflow_set. When inserting var into changed_variables, bump + refcount. Unshare set->vars if set is shared htab and slot needs to + be cleared. + (set_variable_part): Use shared_hash_*, use initially NO_INSERT + lookup if set->vars is shared. Unshare set->vars if needed. + Even ->refcount == 1 vars must be unshared if set->vars is shared + and var needs to be modified. Adjust variable_was_changed caller. + (delete_variable_part): Use shared_hash_*. Even ->refcount == 1 + vars must be unshared if set->vars is shared and var needs to be + modified. Adjust variable_was_changed caller. + (emit_note_insn_var_location): Don't pool_free var. + (emit_notes_for_differences_1): Initialize empty_var->refcount to 0 + instead of 1. + (vt_finalize): Call htab_delete on empty_shared_hash->htab and + free_alloc_pool on shared_hash_pool. + +2009-06-20 Anthony Green <green@moxielogic.com> + + * config/moxie/sfp-machine.h (__gcc_CMPtype, CMPtype): Define. + * config/moxie/moxie.h (LOAD_EXTEND_OP): Define. + +2009-06-20 Richard Guenther <rguenther@suse.de> + + * tree-ssa-structalias.c (find_func_aliases): For memset use + a constraint from NULL if we memset to zero. + * tree-ssa-alias.c (ref_maybe_used_by_call_p_1): Add builtins + we explicitly handle that do not read from memory. + (call_may_clobber_ref_p_1): Properly handle builtins that may + set errno. + +2009-06-20 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/40495 + * tree-ssa-structalias.c (get_constraint_exp_for_temp): Remove. + (new_scalar_tmp_constraint_exp): New function. + (process_constraint): Do not create temporary decls. + (process_all_all_constraints): Likewise. + (handle_const_call): Likewise. + (create_function_info_for): Do not set decl. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * config/rs6000/rs6000.c (rs6000_explicit_options): Make static. + (rs6000_attribute_table): Make static; move before use. + +2009-06-19 Eric Botcazou <ebotcazou@adacore.com> + + * tree.c (substitute_in_expr) <COMPONENT_REF>: Tweak and reformat. + <tcc_vl_exp>: Call process_call_operands on the new CALL_EXPR. + Propagate the TREE_READONLY flag without overwriting it. + (substitute_placeholder_in_expr) <tcc_vl_exp>: Likewise. + Propagate the TREE_READONLY flag onto the result. + (process_call_operands): Move around. Use correct constant value. + +2009-06-19 Ramana Radhakrishnan <ramana.radhakrishnan@arm.com> + + PR target/40482 + * config/arm/arm.c (thumb_shiftable_const): Truncate val to + 32 bits. + * config/arm/arm.md: Likewise. + +2009-06-19 Ian Lance Taylor <ian@airs.com> + + * tree-cfg.c (gimple_redirect_edge_and_branch): Change ERROR_MARK + to GIMPLE_ERROR_MARK. + + * c-typeck.c (build_conditional_expr): Add op1_original_type and + op2_original_type parameters. Warn about using different enum + types. + * c-parser.c (c_parser_conditional_expression): Pass original + types to build_conditional_expr. + * c-tree.h (build_conditional_expr): Update declaration. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * config/i386/i386.c (ix86_function_specific_save): Test that + fields match values, rather than testing the values are in a + certain range. + +2009-06-19 Richard Guenther <rguenther@suse.de> + + * tree-ssa-alias.c (ptr_deref_may_alias_decl_p): Handle + ADDR_EXPR pointers. + (ptr_derefs_may_alias_p): Likewise. + (ptr_deref_may_alias_ref_p_1): New function. + (ptr_deref_may_alias_ref_p): Likewise. + (ref_maybe_used_by_call_p_1): Handle builtins that are not + covered by looking at the ESCAPED solution. + (call_may_clobber_ref_p_1): Likewise. + * tree-ssa-structalias.c (get_constraint_for_ptr_offset): + Handle NULL_TREE offset. Do not produce redundant constraints. + (process_all_all_constraints): New helper function. + (do_structure_copy): Use it. + (handle_lhs_call): Likewise. + (find_func_aliases): Handle some builtins with pointer arguments + and/or return values explicitly. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * varasm.c (const_rtx_hash_1): Remove const qualifier from shift. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * rtl.h (SUBREG_PROMOTED_UNSIGNED_P): Add cast to int. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * ggc-page.c (ggc_pch_write_object): Initialize emptyBytes. + * sdbout.c (sdb_debug_hooks): Initialize non-SDB_DEBUGGING_INFO + version. + + * c-decl.c (finish_decl): If -Wc++-compat, warn about + uninitialized const. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * dse.c (struct store_info): Rename bitmap field to bmap. Change + all uses. + + * c-decl.c (in_struct, struct_types): Remove. + (struct c_binding): Add in_struct field. + (c_binding_ptr): Define type, along with VEC. + (struct c_struct_parse_info): Define. + (struct_parse_info): New static variable. + (bind): Initialize in_struct field. + (start_struct): Remove enclosing_in_struct and + enclosing_struct_types parameters. Add + enclosing_struct_parse_info parameter. Change all callers. Set + struct_parse_info rather than in_struct and struct_types. + (grokfield): If -Wc++-compat and there is a symbol binding for the + field name, set the in_struct flag and push it on the + struct_parse_info->fields vector. + (warn_cxx_compat_finish_struct): New static function. + (finish_struct): Remove enclosing_in_struct and + enclosing_struct_types parameters. Add + enclosing_struct_parse_info parameter. Change all callers. Don't + set C_TYPE_DEFINED_IN_STRUCT here. Call + warn_cxx_compat_finish_struct. Free struct_parse_info and set to + parameter. Only push on struct_types if warn_cxx_compat. + (finish_enum): Only push on struct_types if warn_cxx_compat. + (declspecs_add_type): Add loc parameter. Change all callers. + Change all error calls to error_at. Pass loc, not input_location, + to pedwarn calls. Warn if -Wc++-compat and a typedef name is + defined in a struct. If -Wc++-compat and parsing a struct, record + that a typedef name was used. + * c-parser.c (c_parser_declspecs): Get location to pass to + declspecs_add_type. + (c_parser_struct_or_union_specifier): Update calls to start_struct + and finish_struct. + * c-tree.h (struct c_struct_parse_info): Declare. + (finish_struct, start_struct): Update declarations. + (declspecs_add_type): Update declaration. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * c-decl.c (grokdeclarator): If -Wc++-compat, warn about a global + variable with an anonymous type. + +2009-06-19 Uros Bizjak <ubizjak@gmail.com> + + * see.c: Remove for real. + +2009-06-19 Uros Bizjak <ubizjak@gmail.com> + + * optabs.h (enum optab_index): Add new OTI_significand. + (significand_optab): Define corresponding macro. + * optabs.c (init_optabs): Initialize significand_optab. + * genopinit.c (optabs): Implement significand_optab using + significand?f2 patterns. + * builtins.c (expand_builtin_mathfn): Handle + BUILT_IN_SIGNIFICAND{,F,L}. + (expand_builtin): Expand BUILT_IN_SIGNIFICAND{,F,L} using + expand_builtin_mathfn if flag_unsafe_math_optimizations is set. + + * config/i386/i386.md (significandxf2, significand<mode>2): New + expanders to implement significandf, significand and significandl + built-ins as inline x87 intrinsics. + +2009-06-18 Anatoly Sokolov <aesok@post.ru> + + * config/avr/avr.c (avr_override_options): Remove setting value of + PARAM_INLINE_CALL_COST. + +2009-06-18 Richard Henderson <rth@redhat.com> + + PR 40488 + * tree-pass.h (TDF_ASMNAME): New. + * tree-dump.c (dump_options): Add asmname. + * doc/invoke.texi: Document it. + + * tree-pretty-print.c (maybe_dump_asm_name): Merge into... + (dump_decl_name): ...here. + (dump_function_name): New flags arg; mind TDF_ASMNAME. + (dump_generic_node): Update dump_function_name calls. + (print_call_name): New flags arg; update all dump calls. + * diagnostic.h (print_call_name): Update. + * gimple-pretty-print.c (dump_gimple_call): Update. + +2009-06-18 H.J. Lu <hongjiu.lu@intel.com> + + PR target/40470 + * config/i386/i386.h (CLASS_LIKELY_SPILLED_P): Add SSE_FIRST_REG. + +2009-06-18 Diego Novillo <dnovillo@google.com> + + * doc/plugins.texi: Document plugin_is_GPL_compatible. + * plugin.c (str_license): Declare. + (try_init_one_plugin): Assert that the symbol + 'plugin_is_GPL_compatible' exists. + +2009-06-18 Sergei Dyshel <sergeid@il.ibm.com> + + * see.c: Remove. + * Makefile.in (OBJS-common): Remove see.o. + (see.o): Remove. + * common.opt (fsee): Mark as preserved for backward compatibility. + * opts.c (common_handle_option): Add OPT_fsee to the backward + compatibility section. + * passes.c (init_optimization_passes, pass_see): Remove pass. + * timevar.def (TV_SEE): Remove. + * tree-pass.h (pass_see): Remove declaration. + * doc/invoke.texi (-fsee): Remove documentation. + +2009-06-18 Martin Jambor <mjambor@suse.cz> + + * tree-sra.c: Include statistics.h + (sra_stats): New variable. + (sra_initialize): Clear sra_stats. + (create_access_replacement): Increment sra_stats.replacements. + (get_access_replacement): Do not return twice. + (analyze_all_variable_accesses): Increment statistics counter by the + number of scalarized aggregates. + (generate_subtree_copies): Increment sra_stats.subtree_copies. + (sra_modify_expr): Increment sra_stats.exprs. + (load_assign_lhs_subreplacements): Increment sra_stats.subreplacements. + (sra_modify_assign): Increment sra_stats.exprs, + sra_stats.separate_lhs_rhs_handling and sra_stats.deleted. + (perform_intra_sra): Update statistics counters. + * Makefile.in (tree-sra.o): Add statistics.h to dependencies. + +2009-06-18 Sandra Loosemore <sandra@codesourcery.com> + + * config/arm/arm.c (TARGET_SCALAR_MODE_SUPPORTED_P): Redefine. + (arm_scalar_mode_supported_p): New function. + +2009-06-18 Paul Brook <paul@codesourcery.com> + Sandra Loosemore <sandra@codesourcery.com> + + * config/arm/sfp-machine.h (_FP_NANFRAC_H, _FP_NANSIGN_H): Define. + (__extendhfsf2, __truncsfhf2): Define. + * config/arm/fp16.c: New file. + * config/arm/t-bpabi (LIB2FUNCS_STATIC_EXTRA): Add fp16.c. + * config/arm/t-symbian (LIB2FUNCS_STATIC_EXTRA): Add fp16.c. + +2009-06-18 Sandra Loosemore <sandra@codesourcery.com> + + * doc/extend.texi (Half-Precision): New section. + * doc/invoke.texi (Option Summary): List -mfp16-format. + (ARM Options): List neon-fp16 as -mfpu value. Document -mfp16-format. + * config/arm/arm.opt (mfp16-format=): New. + * config/arm/arm.c: Include intl.h. + (TARGET_INVALID_PARAMETER_TYPE): Redefine. + (TARGET_INVALID_RETURN_TYPE): Redefine. + (TARGET_PROMOTED_TYPE): Redefine. + (TARGET_CONVERT_TO_TYPE): Redefine. + (arm_fp16_format): Define. + (all_fpus): Add entry for neon-fp16. + (fp_model_for_fpu): Likewise. + (struct fp16_format): Declare. + (all_fp16_formats): Define. + (arm_init_libfuncs): Add entries for HFmode conversions and arithmetic + functions. + (arm_override_options): Set arm_fp16_format. Call sorry for fp16 + and no ldrh. + (arm_legitimate_index_p): Treat HFmode like HImode. + (thumb1_legitimate_address_p): Make it recognize HFmode constants. + (coproc_secondary_reload_class): Special-case HFmode. + (arm_print_operand): Add 'z' specifier for vld1.16/vst1.16. + (arm_hard_regno_mode_ok): Allow HFmode values in VFP registers. + (arm_init_fp16_builtins): New. + (arm_init_builtins): Call it. + (arm_invalid_parameter_type): New. + (arm_invalid_return_type): New. + (arm_promoted_type): New. + (arm_convert_to_type). + (arm_file_start): Deal with neon-fp16 as fpu_name. Emit tag for fp16 + format. + (arm_emit_fp16_const): New function. + (arm_mangle_type): Mangle __fp16 as "Dh". + * config/arm/arm.h (TARGET_VFPD32): Make it know about + FPUTYPE_NEON_FP16. + (TARGET_NEON_FP16): New. + (TARGET_NEON): Make it know about FPUTYPE_NEON_FP16. + (enum fputype): Add FPUTYPE_NEON_FP16. + (enum arm_fp16_format_type): Declare. + (arm_fp16_format): Declare. + (LARGEST_EXPONENT_IS_NORMAL): Define. + * config/arm/arm-protos.h (arm_emit_fp16_const): Declare. + * config/arm/arm-modes.def (HFmode): Define. + * config/arm/vfp.md: (*movhf_vfp): New. + (extendhfsf2): New. + (truncsfhf2): New. + * config/arm/arm.md: (fpu): Add neon_fp16. + (floatsihf2, floatdihf2): New. + (fix_trunchfsi2, fix_trunchfdi2): New. + (truncdfhf2): New. + (extendhfdf2): New. + (movhf): New. + (*arm32_movhf): New. + (*thumb1_movhf): New. + (consttable_2): Add check for HFmode constants. + (consttable_4): Handle HFmode constants. + 2009-06-18 Uros Bizjak <ubizjak@gmail.com> * convert.c (convert_to_integer): Convert (int)logb() into ilogb(). @@ -1626,8 +2018,8 @@ * config/rs6000/crtsavgpr.asm: Likewise. * config/rs6000/crtsavfpr.asm: Likewise. - * dwarf2out.c (output_cfi_directive): Pass 1 instead of - 0 to second argument of DWARF2_FRAME_REG_OUT macros. + * dwarf2out.c (output_cfi_directive): Pass 1 instead of 0 to second + argument of DWARF2_FRAME_REG_OUT macros. 2009-06-03 Julian Brown <julian@codesourcery.com> diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 5a0327d9bc6..71f48273a93 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20090618 +20090622 diff --git a/gcc/Makefile.in b/gcc/Makefile.in index c1619938b3e..61d22b58086 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -1243,7 +1243,6 @@ OBJS-common = \ sched-rgn.o \ sched-vis.o \ sdbout.o \ - see.o \ sel-sched-ir.o \ sel-sched-dump.o \ sel-sched.o \ @@ -2789,10 +2788,6 @@ fwprop.o : fwprop.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(RTL_H) \ web.o : web.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(RTL_H) \ hard-reg-set.h $(FLAGS_H) $(BASIC_BLOCK_H) $(FUNCTION_H) output.h $(TOPLEV_H) \ $(DF_H) $(OBSTACK_H) $(TIMEVAR_H) $(TREE_PASS_H) -see.o : see.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(RTL_H) \ - hard-reg-set.h $(FLAGS_H) $(BASIC_BLOCK_H) $(FUNCTION_H) output.h \ - $(DF_H) $(OBSTACK_H) $(TIMEVAR_H) $(TREE_PASS_H) $(RECOG_H) $(EXPR_H) \ - $(SPLAY_TREE_H) $(HASHTAB_H) $(REGS_H) dce.h gcse.o : gcse.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(RTL_H) \ $(REGS_H) hard-reg-set.h $(FLAGS_H) $(REAL_H) insn-config.h $(GGC_H) \ $(RECOG_H) $(EXPR_H) $(BASIC_BLOCK_H) $(FUNCTION_H) output.h $(TOPLEV_H) \ @@ -2828,8 +2823,8 @@ tree-ssa-ccp.o : tree-ssa-ccp.c $(TREE_FLOW_H) $(CONFIG_H) \ $(TREE_DUMP_H) $(BASIC_BLOCK_H) $(TREE_PASS_H) langhooks.h \ tree-ssa-propagate.h value-prof.h $(FLAGS_H) $(TARGET_H) $(TOPLEV_H) tree-sra.o : tree-sra.c $(CONFIG_H) $(SYSTEM_H) coretypes.h alloc-pool.h \ - $(TM_H) $(TREE_H) $(GIMPLE_H) $(TREE_FLOW_H) $(DIAGNOSTIC_H) $(TREE_DUMP_H) \ - $(TIMEVAR_H) $(PARAMS_H) $(TARGET_H) $(FLAGS_H) + $(TM_H) $(TREE_H) $(GIMPLE_H) $(TREE_FLOW_H) $(DIAGNOSTIC_H) statistics.h \ + $(TREE_DUMP_H) $(TIMEVAR_H) $(PARAMS_H) $(TARGET_H) $(FLAGS_H) tree-switch-conversion.o : tree-switch-conversion.c $(CONFIG_H) $(SYSTEM_H) \ $(TREE_H) $(TM_P_H) $(TREE_FLOW_H) $(DIAGNOSTIC_H) $(TREE_INLINE_H) \ $(TIMEVAR_H) $(TM_H) coretypes.h $(TREE_DUMP_H) $(GIMPLE_H) \ diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d9e6bcbd235..214bd7839fa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,231 @@ +2009-06-21 Thomas Quinot <quinot@adacore.com> + + * exp_ch3.adb, exp_prag.adb, exp_util.adb, exp_util.ads, freeze.adb, + sem_ch13.adb, sem_elab.adb (Exp_Prag.Expand_Pragma_Import_Or_Interface): + Factor out code to new subprogram... + (Exp_Util.Find_Init_Call): New shared routine to find the init proc call + for a default initialized variable. + (Freeze.Check_Address_Clause): Do not reset Has_Delayed_Freeze on an + entity that has an associated freeze node. + (Sem_Ch13.Analyze_Attribute_Definition_Clause, case Address): + If there is an init call for the object, defer it to the object freeze + point. + (Check_Elab_Call.Find_Init_Call): Rename to Check_Init_Call, to avoid + name clash with new subprogram introduced in Exp_Util. + +2009-06-21 Robert Dewar <dewar@adacore.com> + + * einfo.ads: Minor reformatting + +2009-06-21 Ed Falis <falis@adacore.com> + + * env.c (__gnat_environ): return NULL for vThreads - unimplemented + +2009-06-21 Eric Botcazou <ebotcazou@adacore.com> + + * einfo.ads: Update comments. + +2009-06-21 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_disp.adb (Check_Direct_Call): New routine. Dispatching calls + where the controlling formal is of private class-wide type whose + completion is a synchronized type can be converted into direct calls. + +2009-06-21 Vincent Celier <celier@adacore.com> + + * gnatcmd.adb (Check_Files): When all sources of the project are to be + indicated to gnatcheck, gnatpp or gnatmetric, always specify the list + of sources using -files=, so that the distinction can be made by the + tool of a call with no source (to display the usage) from a call with + a project file that contains no source. + +2009-06-21 Jerome Lambourg <lambourg@adacore.com> + + * exp_ch3.adb (Build_Array_Init_Proc): Do not build the init proc in + case of VM convention arrays. + +2009-06-20 Robert Dewar <dewar@adacore.com> + + * a-nudira.adb: Minor reformatting + +2009-06-20 Ed Schonberg <schonberg@adacore.com> + + * exp_ch3.adb (Build_Record_Init_Proc): When copying initial + expressions (possibly from a parent type) indicate that the scope of + the new itypes is the initialization procedure being built. + +2009-06-20 Robert Dewar <dewar@adacore.com> + + * a-nudira.adb (Fits_In_32_Bits): New name (inverted sense) for + Needs_64, and now computed without anomolies for some dynamic types. + +2009-06-20 Thomas Quinot <quinot@adacore.com> + + * sem_prag.adb: Minor reformatting + + * exp_disp.ads: Minor reformatting + +2009-06-20 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Is_OK_For_Limited_Init): An unchecked conversion of a + function call is a legal expression to initialize a limited object. + + * exp_ch3.adb: Rename various freeze operations that perform expansion + actions, to prevent confusion with subprograms in the freeze package. + +2009-06-20 Ed Schonberg <schonberg@adacore.com> + + * sem.adb (Walk_Library_Units): Check instantiations first. + + * sem_ch6.adb (Analyze_Subprogram_Declaration): Mark a subprogram as a + private primitive if it is a function with a controlling result that is + a type extension with progenitors. + + * exp_ch9.adb (Build_Wrapper_Spec, Build_Wrapper_Body): Handle properly + a primitive operation of a synchronized tagged type that has a + controlling result. + +2009-06-20 Thomas Quinot <quinot@adacore.com> + + * einfo.ads: Fix typo. + +2009-06-20 Ed Falis <falis@adacore.com> + + * s-vxwext.ads, s-vxwext-kernel.adb: Complete previous change. + +2009-06-19 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/trans.c (emit_check): Do not wrap up the result + in a SAVE_EXPR. + (protect_multiple_eval): Always protect complex expressions. + +2009-06-19 Emmanuel Briot <briot@adacore.com> + + * prj-ext.adb, makeutl.adb, makeutl.ads (Executable_Prefix_Path): Now + make sure we always return a name ending with a path separator. + +2009-06-19 Javier Miranda <miranda@adacore.com> + + * sem_ch12.adb (Instantiate_Package_Body, Instantiate_Subprogram_Body): + Save and restore the visibility of the parent when installed. + +2009-06-19 Jose Ruiz <ruiz@adacore.com> + + * s-tposen.ads (Protection_Entry): Replace fields L, Ceiling, and Owner + by Common which contains all these fields. + + * s-tposen.adb (Initialize_Protection_Entry, Lock_Entry, + Lock_Read_Only_Entry, Timed_Protected_Single_Entry_Call, Unlock_Entry): + Remove code duplication in this package by means of calling the + equivalent code in s-taprob. + +2009-06-19 Robert Dewar <dewar@adacore.com> + + * a-einuoc.ads: Minor reformatting + +2009-06-19 Ed Falis <falis@adacore.com> + + * a-einuoc.ads, s-osinte-vxworks.ads, s-vxwext.ads, s-vxwext-kernel.adb, + s-vxwext-kernel.ads, s-vxwext-rtp.ads: Code clean up. + +2009-06-19 Eric Botcazou <ebotcazou@adacore.com> + + * einfo.ads (Handling of Type'Size Values): Fix Object_Size values. + +2009-06-19 Robert Dewar <dewar@adacore.com> + + * a-nudira.adb (Need_64): Handle negative ranges and also dynamic + ranges + + * checks.adb (Determine_Range): Move the test for generic types later. + + * sem_eval.adb (Compile_Time_Compare): Improve circuitry to catch more + cases. + (Eval_Relational_Op): Fold more cases including string compares + + * sem_util.ads, sem_util.adb (References_Generic_Formal_Type): New + function. + +2009-06-19 Robert Dewar <dewar@adacore.com> + + * sem_type.ads, sem_ch12.adb: Minor reformatting + + * s-wchcnv.adb (UTF_32_To_Char_Sequence): Handle invalid data properly + +2009-06-19 Ed Schonberg <schonberg@adacore.com> + + * exp_ch9.adb (Build_Wrapper_Spec): Handle properly an overridden + primitive operation of a rivate extension whose controlling argument + is an out parameter. + + * sem.adb (Walk_Library_Units): exclude generic package declarations + from check. + +2009-06-19 Thomas Quinot <quinot@adacore.com> + + * i-vxwoio.ads: Add comments + +2009-06-19 Thomas Quinot <quinot@adacore.com> + + * socket.c, g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, + g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads, + g-socthi.adb, g-socthi.ads, g-socket.adb, g-sothco.ads + (GNAT.Sockets.Thin.C_Ioctl): Rename to Socket_Ioctl. + (GNAT.Sockets.Thin.Socket_Ioctl): Use new function + Thin_Common.Socket_Ioctl. + (GNAT.Sockets.Thin_Common.Socket_Ioctl): Binding to new C wrapper + __gnat_socket_ioctl. + (__gnat_socket_ioctl): Wrapper for ioctl(2) called with a single int* + argument after the file descriptor and request code. + +2009-06-19 Robert Dewar <dewar@adacore.com> + + * checks.adb: Minor reformatting + +2009-06-19 Jose Ruiz <ruiz@adacore.com> + + * env.c (__gnat_environ): RTX does not support this functionality. + +2009-06-19 Ed Schonberg <schonberg@adacore.com> + + * sem.adb (Walk_Library_Items): Include bodies in the list of units to + traverse, to account for front-end inlining and instantiations in a + spec or in the main unit. + +2009-06-19 Robert Dewar <dewar@adacore.com> + + * checks.adb (Determine_Range): Do not attempt to get range of generic + type. + +2009-06-19 Sergey Rybin <rybin@adacore.com> + + * gnat_ugn.texi, vms_data.ads: Add the documentation for the new + gnatmetric option for generating the schema file for gnatmetric XML + output. Add corresponding VMS qualifier. + +2009-06-19 Robert Dewar <dewar@adacore.com> + + * g-cgi.adb: Minor reformatting + +2009-06-19 Eric Botcazou <ebotcazou@adacore.com> + + * s-intman-solaris.adb (Notify_Exception): Do not discriminate on the + signal code for SIGFPE and raise Program_Error for SIGILL. + + * s-osinte-solaris.ads: Remove signal code constants for SIGFPE. + +2009-06-19 Ed Schonberg <schonberg@adacore.com> + + * sem_ch8.adb (Nvis_Messages): Do not list an entity declared in a + generic package if there is a visibility candidate that is declared in + a regular package. + +2009-06-18 Olivier Hainque <hainque@adacore.com> + + * system-aix64.ads: New file. + * gcc-interface/Makefile.in (aix LIBGNAT_TARGET_PAIRS): Use the + 64bit system.ads for ppc64 multilib variants. + 2009-06-16 Robert Dewar <dewar@adacore.com> Olivier Hainque <hainque@adacore.com> diff --git a/gcc/ada/a-einuoc.adb b/gcc/ada/a-einuoc.adb index a9e378d8098..f70eff0edc0 100644 --- a/gcc/ada/a-einuoc.adb +++ b/gcc/ada/a-einuoc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,18 +29,16 @@ -- -- ------------------------------------------------------------------------------ --- This is a GNAT-specific child function of Ada.Exceptions. It provides --- clearly missing functionality for its parent package, and most reasonably --- would simply be an added function to that package, but this change cannot --- be made in a conforming manner. +--------------------------------------- +-- Ada.Exceptions.Is_Null_Occurrence -- +--------------------------------------- function Ada.Exceptions.Is_Null_Occurrence - (X : Exception_Occurrence) - return Boolean + (X : Exception_Occurrence) return Boolean is begin - -- The null exception is uniquely identified by the fact that the Id - -- value is null. No other exception occurrence can have a null Id. + -- The null exception is uniquely identified by the fact that the Id value + -- is null. No other exception occurrence can have a null Id. if X.Id = Null_Id then return True; diff --git a/gcc/ada/a-einuoc.ads b/gcc/ada/a-einuoc.ads index dfc6b3f39fb..8d772b01f52 100644 --- a/gcc/ada/a-einuoc.ads +++ b/gcc/ada/a-einuoc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -35,6 +35,6 @@ -- be made in a conforming manner. function Ada.Exceptions.Is_Null_Occurrence - (X : Exception_Occurrence) - return Boolean; + (X : Exception_Occurrence) return Boolean; +pragma Preelaborate (Ada.Exceptions.Is_Null_Occurrence); -- This function yields True if X is Null_Occurrence, and False otherwise diff --git a/gcc/ada/a-nudira.adb b/gcc/ada/a-nudira.adb index 087ce56ea08..87abcd8f100 100644 --- a/gcc/ada/a-nudira.adb +++ b/gcc/ada/a-nudira.adb @@ -51,11 +51,34 @@ package body Ada.Numerics.Discrete_Random is type Pointer is access all State; - Need_64 : constant Boolean := Rst'Pos (Rst'Last) > Int'Last; - -- Set if we need more than 32 bits in the result. In practice we will - -- only use the meaningful 48 bits of any 64 bit number generated, since - -- if more than 48 bits are required, we split the computation into two - -- separate parts, since the algorithm does not behave above 48 bits. + Fits_In_32_Bits : constant Boolean := + Rst'Size < 31 + or else (Rst'Size = 31 + and then Rst'Pos (Rst'First) < 0); + -- This is set True if we do not need more than 32 bits in the result. If + -- we need 64-bits, we will only use the meaningful 48 bits of any 64-bit + -- number generated, since if more than 48 bits are required, we split the + -- computation into two separate parts, since the algorithm does not behave + -- above 48 bits. + + -- The way this expression works is that obviously if the size is 31 bits, + -- it fits in 32 bits. In the 32-bit case, it fits in 32-bit signed if the + -- range has negative values. It is too conservative in the case that the + -- programmer has set a size greater than the default, e.g. a size of 33 + -- for an integer type with a range of 1..10, but an over-conservative + -- result is OK. The important thing is that the value is only True if + -- we know the result will fit in 32-bits signed. If the value is False + -- when it could be True, the behavior will be correct, just a bit less + -- efficient than it could have been in some unusual cases. + -- + -- One might assume that we could get a more accurate result by testing + -- the lower and upper bounds of the type Rst against the bounds of 32-bit + -- Integer. However, there is no easy way to do that. Why? Because in the + -- relatively rare case where this expresion has to be evaluated at run + -- time rather than compile time (when the bounds are dynamic), we need a + -- type to use for the computation. But the possible range of upper bound + -- values for Rst (remembering the possibility of 64-bit modular types) is + -- from -2**63 to 2**64-1, and no run-time type has a big enough range. ----------------------- -- Local Subprograms -- @@ -72,9 +95,9 @@ package body Ada.Numerics.Discrete_Random is function Image (Of_State : State) return String is begin return Int'Image (Of_State.X1) & - ',' & + ',' & Int'Image (Of_State.X2) & - ',' & + ',' & Int'Image (Of_State.Q); end Image; @@ -121,7 +144,7 @@ package body Ada.Numerics.Discrete_Random is if TF >= Flt (Rst'Pos (Rst'Last)) + 0.5 then return Rst'First; - elsif Need_64 then + elsif not Fits_In_32_Bits then return Rst'Val (Interfaces.Integer_64 (TF)); else diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 39f63f3a383..4cfcb8e9135 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -3065,7 +3065,7 @@ package body Checks is function OK_Operands return Boolean; -- Used for binary operators. Determines the ranges of the left and -- right operands, and if they are both OK, returns True, and puts - -- the results in Lo_Right, Hi_Right, Lo_Left, Hi_Left + -- the results in Lo_Right, Hi_Right, Lo_Left, Hi_Left. ----------------- -- OK_Operands -- @@ -3095,11 +3095,19 @@ package body Checks is Lor := No_Uint; Hir := No_Uint; - -- If the type is not discrete, or is undefined, then we can't do - -- anything about determining the range. + -- If type is not defined, we can't determine its range - if No (Typ) or else not Is_Discrete_Type (Typ) - or else Error_Posted (N) + if No (Typ) + + -- We don't deal with anything except discrete types + + or else not Is_Discrete_Type (Typ) + + -- Ignore type for which an error has been posted, since range in + -- this case may well be a bogosity deriving from the error. Also + -- ignore if error posted on the reference node. + + or else Error_Posted (N) or else Error_Posted (Typ) then OK := False; return; @@ -3136,6 +3144,15 @@ package body Checks is -- overflow situation, which is a separate check, we are talking here -- only about the expression value). + -- First a check, never try to find the bounds of a generic type, since + -- these bounds are always junk values, and it is only valid to look at + -- the bounds in an instance. + + if Is_Generic_Type (Typ) then + OK := False; + return; + end if; + -- First step, change to use base type unless we know the value is valid if (Is_Entity_Name (N) and then Is_Known_Valid (Entity (N))) @@ -3312,7 +3329,7 @@ package body Checks is case Attribute_Name (N) is -- For Pos/Val attributes, we can refine the range using the - -- possible range of values of the attribute expression + -- possible range of values of the attribute expression. when Name_Pos | Name_Val => Determine_Range diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 546763ffeae..bebdda082f2 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -214,13 +214,13 @@ package Einfo is -- type x1 is range 0..5; 8 3 -- type x2 is range 0..5; --- for x2'size use 12; 12 12 +-- for x2'size use 12; 16 12 --- subtype x3 is x2 range 0 .. 3; 12 2 +-- subtype x3 is x2 range 0 .. 3; 16 2 -- subtype x4 is x2'base range 0 .. 10; 8 4 --- subtype x5 is x2 range 0 .. dynamic; 12 (7) +-- subtype x5 is x2 range 0 .. dynamic; 16 (7) -- subtype x6 is x2'base range 0 .. dynamic; 8 (7) @@ -239,9 +239,12 @@ package Einfo is -- The RM_Size field keeps track of the RM Size as needed in these -- three situations. --- For types other than discrete and fixed-point types, the Object_Size --- and Value_Size are the same (and equivalent to the RM attribute Size). --- Only Size may be specified for such types. +-- For elementary types other than discrete and fixed-point types, the +-- Object_Size and Value_Size are the same (and equivalent to the RM +-- attribute Size). Only Size may be specified for such types. + +-- For composite types, Object_Size and Value_Size are computed from their +-- respective value for the type of each element as well as the layout. -- All size attributes are stored as Uint values. Negative values are used to -- reference GCC expressions for the case of non-static sizes, as explained @@ -2081,9 +2084,9 @@ package Einfo is -- (generic function, generic subprogram), False for all other entities. -- Is_Generic_Type (Flag13) --- Present in all types and subtypes. Set for types which are generic --- formal types. Such types have an Ekind that corresponds to their --- classification, so the Ekind cannot be used to identify generic types. +-- Present in all entities. Set for types which are generic formal types. +-- Such types have an Ekind that corresponds to their classification, so +-- the Ekind cannot be used to identify generic types. -- Is_Generic_Unit (synthesized) -- Applies to all entities. Yields True for a generic unit (generic @@ -3647,7 +3650,7 @@ package Einfo is -- Wrapped_Entity (Node27) -- Present in functions and procedures which have been classified as --- Is_Primitive_Wrapper. Set to the entity being wrapper. +-- Is_Primitive_Wrapper. Set to the entity being wrapped. ------------------ -- Access Kinds -- @@ -4503,6 +4506,7 @@ package Einfo is -- Is_First_Subtype (Flag70) -- Is_Formal_Subprogram (Flag111) -- Is_Generic_Instance (Flag130) + -- Is_Generic_Type (Flag13) -- Is_Hidden (Flag57) -- Is_Hidden_Open_Scope (Flag171) -- Is_Immediately_Visible (Flag7) @@ -4609,7 +4613,6 @@ package Einfo is -- Is_Eliminated (Flag124) -- Is_Frozen (Flag4) -- Is_Generic_Actual_Type (Flag94) - -- Is_Generic_Type (Flag13) -- Is_Protected_Interface (Flag198) -- Is_RACW_Stub_Type (Flag244) -- Is_Synchronized_Interface (Flag199) diff --git a/gcc/ada/env.c b/gcc/ada/env.c index e0ebc0c6081..bcb8bdb9a80 100644 --- a/gcc/ada/env.c +++ b/gcc/ada/env.c @@ -190,7 +190,7 @@ __gnat_setenv (char *name, char *value) char ** __gnat_environ (void) { -#if defined (VMS) +#if defined (VMS) || defined (RTX) || defined (VTHREADS) /* Not implemented */ return NULL; #elif defined (__APPLE__) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 4138dd01858..e8030d9c196 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -166,19 +166,19 @@ package body Exp_Ch3 is -- _controller of type Record_Controller or Limited_Record_Controller -- in the record T. - procedure Freeze_Array_Type (N : Node_Id); + procedure Expand_Freeze_Array_Type (N : Node_Id); -- Freeze an array type. Deals with building the initialization procedure, -- creating the packed array type for a packed array and also with the -- creation of the controlling procedures for the controlled case. The -- argument N is the N_Freeze_Entity node for the type. - procedure Freeze_Enumeration_Type (N : Node_Id); + procedure Expand_Freeze_Enumeration_Type (N : Node_Id); -- Freeze enumeration type with non-standard representation. Builds the -- array and function needed to convert between enumeration pos and -- enumeration representation values. N is the N_Freeze_Entity node -- for the type. - procedure Freeze_Record_Type (N : Node_Id); + procedure Expand_Freeze_Record_Type (N : Node_Id); -- Freeze record type. Builds all necessary discriminant checking -- and other ancillary functions, and builds dispatch tables where -- needed. The argument N is the N_Freeze_Entity node. This processing @@ -641,10 +641,13 @@ package body Exp_Ch3 is -- 1. Initialization is suppressed for the type -- 2. The type is a value type, in the CIL sense. - -- 3. An initialization already exists for the base type + -- 3. The type has CIL/JVM convention. + -- 4. An initialization already exists for the base type if Suppress_Init_Proc (A_Type) or else Is_Value_Type (Comp_Type) + or else Convention (A_Type) = Convention_CIL + or else Convention (A_Type) = Convention_Java or else Present (Base_Init_Proc (A_Type)) then return; @@ -1312,8 +1315,8 @@ package body Exp_Ch3 is Next_Component (Comp); end loop; - -- All components have static initialization. Build positional - -- aggregate from the given expressions or defaults. + -- All components have static initialization. Build positional aggregate + -- from the given expressions or defaults. Agg := Make_Aggregate (Sloc (T), New_List, New_List); Set_Parent (Agg, Parent (T)); @@ -1850,9 +1853,10 @@ package body Exp_Ch3 is -- Take a copy of Exp to ensure that later copies of this component -- declaration in derived types see the original tree, not a node - -- rewritten during expansion of the init_proc. + -- rewritten during expansion of the init_proc. If the copy contains + -- itypes, the scope of the new itypes is the init.proc being built. - Exp := New_Copy_Tree (Exp); + Exp := New_Copy_Tree (Exp, New_Scope => Proc_Id); Res := New_List ( Make_Assignment_Statement (Loc, @@ -1870,7 +1874,7 @@ package body Exp_Ch3 is Make_Assignment_Statement (Loc, Name => Make_Selected_Component (Loc, - Prefix => New_Copy_Tree (Lhs), + Prefix => New_Copy_Tree (Lhs, New_Scope => Proc_Id), Selector_Name => New_Reference_To (First_Tag_Component (Typ), Loc)), @@ -1893,10 +1897,11 @@ package body Exp_Ch3 is then Append_List_To (Res, Make_Adjust_Call ( - Ref => New_Copy_Tree (Lhs), + Ref => New_Copy_Tree (Lhs, New_Scope => Proc_Id), Typ => Etype (Id), Flist_Ref => - Find_Final_List (Etype (Id), New_Copy_Tree (Lhs)), + Find_Final_List + (Etype (Id), New_Copy_Tree (Lhs, New_Scope => Proc_Id)), With_Attach => Make_Integer_Literal (Loc, 1))); end if; @@ -4375,8 +4380,12 @@ package body Exp_Ch3 is -- object being initialized. This is because the call is not a -- source level call. This works fine, because the only possible -- statements depending on freeze status that can appear after the - -- _Init call are rep clauses which can safely appear after actual - -- references to the object. + -- Init_Proc call are rep clauses which can safely appear after + -- actual references to the object. Note that this call may + -- subsequently be removed (if a pragma Import is encountered), + -- or moved to the freeze actions for the object (e.g. if an + -- address clause is applied to the object, causing it to get + -- delayed freezing). Id_Ref := New_Reference_To (Def_Id, Loc); Set_Must_Not_Freeze (Id_Ref); @@ -5082,11 +5091,11 @@ package body Exp_Ch3 is end if; end Clean_Task_Names; - ----------------------- - -- Freeze_Array_Type -- - ----------------------- + ------------------------------ + -- Expand_Freeze_Array_Type -- + ------------------------------ - procedure Freeze_Array_Type (N : Node_Id) is + procedure Expand_Freeze_Array_Type (N : Node_Id) is Typ : constant Entity_Id := Entity (N); Comp_Typ : constant Entity_Id := Component_Type (Typ); Base : constant Entity_Id := Base_Type (Typ); @@ -5169,13 +5178,13 @@ package body Exp_Ch3 is then Build_Array_Init_Proc (Base, N); end if; - end Freeze_Array_Type; + end Expand_Freeze_Array_Type; - ----------------------------- - -- Freeze_Enumeration_Type -- - ----------------------------- + ------------------------------------ + -- Expand_Freeze_Enumeration_Type -- + ------------------------------------ - procedure Freeze_Enumeration_Type (N : Node_Id) is + procedure Expand_Freeze_Enumeration_Type (N : Node_Id) is Typ : constant Entity_Id := Entity (N); Loc : constant Source_Ptr := Sloc (Typ); Ent : Entity_Id; @@ -5465,13 +5474,13 @@ package body Exp_Ch3 is exception when RE_Not_Available => return; - end Freeze_Enumeration_Type; + end Expand_Freeze_Enumeration_Type; - ------------------------ - -- Freeze_Record_Type -- - ------------------------ + ------------------------------- + -- Expand_Freeze_Record_Type -- + ------------------------------- - procedure Freeze_Record_Type (N : Node_Id) is + procedure Expand_Freeze_Record_Type (N : Node_Id) is procedure Add_Internal_Interface_Entities (Tagged_Type : Entity_Id); -- Add to the list of primitives of Tagged_Types the internal entities @@ -5593,7 +5602,7 @@ package body Exp_Ch3 is Wrapper_Body_List : List_Id := No_List; Null_Proc_Decl_List : List_Id := No_List; - -- Start of processing for Freeze_Record_Type + -- Start of processing for Expand_Freeze_Record_Type begin -- Build discriminant checking functions if not a derived type (for @@ -5990,7 +5999,7 @@ package body Exp_Ch3 is Append_Freeze_Actions (Def_Id, Wrapper_Body_List); end if; end if; - end Freeze_Record_Type; + end Expand_Freeze_Record_Type; ------------------------------ -- Freeze_Stream_Operations -- @@ -6074,7 +6083,7 @@ package body Exp_Ch3 is if Is_Record_Type (Def_Id) then if Ekind (Def_Id) = E_Record_Type then - Freeze_Record_Type (N); + Expand_Freeze_Record_Type (N); -- The subtype may have been declared before the type was frozen. If -- the type has controlled components it is necessary to create the @@ -6149,7 +6158,7 @@ package body Exp_Ch3 is -- Freeze processing for array types elsif Is_Array_Type (Def_Id) then - Freeze_Array_Type (N); + Expand_Freeze_Array_Type (N); -- Freeze processing for access types @@ -6356,7 +6365,7 @@ package body Exp_Ch3 is -- is not the same as its representation) if Has_Non_Standard_Rep (Def_Id) then - Freeze_Enumeration_Type (N); + Expand_Freeze_Enumeration_Type (N); end if; -- Private types that are completed by a derivation from a private diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index ddaa632f0ba..cc58d9f4fa4 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1611,7 +1611,7 @@ package body Exp_Ch9 is declare Actuals : List_Id := No_List; Conv_Id : Node_Id; - First_Formal : Node_Id; + First_Form : Node_Id; Formal : Node_Id; Nam : Node_Id; @@ -1619,9 +1619,9 @@ package body Exp_Ch9 is -- Map formals to actuals. Use the list built for the wrapper -- spec, skipping the object notation parameter. - First_Formal := First (Parameter_Specifications (Body_Spec)); + First_Form := First (Parameter_Specifications (Body_Spec)); - Formal := First_Formal; + Formal := First_Form; Next (Formal); if Present (Formal) then @@ -1637,20 +1637,29 @@ package body Exp_Ch9 is end if; -- Special processing for primitives declared between a private - -- type and its completion. + -- type and its completion: the wrapper needs a properly typed + -- parameter if the wrapped operation has a controlling first + -- parameter. Note that this might not be the case for a function + -- with a controlling result. if Is_Private_Primitive_Subprogram (Subp_Id) then if No (Actuals) then Actuals := New_List; end if; - Prepend_To (Actuals, - Unchecked_Convert_To ( - Corresponding_Concurrent_Type (Obj_Typ), - Make_Identifier (Loc, Name_uO))); + if Is_Controlling_Formal (First_Formal (Subp_Id)) then + Prepend_To (Actuals, + Unchecked_Convert_To ( + Corresponding_Concurrent_Type (Obj_Typ), + Make_Identifier (Loc, Name_uO))); - Nam := New_Reference_To (Subp_Id, Loc); + else + Prepend_To (Actuals, + Make_Identifier (Loc, Chars => + Chars (Defining_Identifier (First_Form)))); + end if; + Nam := New_Reference_To (Subp_Id, Loc); else -- An access-to-variable object parameter requires an explicit -- dereference in the unchecked conversion. This case occurs @@ -1659,7 +1668,7 @@ package body Exp_Ch9 is -- O.all.Subp_Id (Formal_1, ..., Formal_N) - if Nkind (Parameter_Type (First_Formal)) = + if Nkind (Parameter_Type (First_Form)) = N_Access_Definition then Conv_Id := @@ -1679,20 +1688,35 @@ package body Exp_Ch9 is New_Reference_To (Subp_Id, Loc)); end if; - -- Create the subprogram body + -- Create the subprogram body. For a function, the call to the + -- actual subprogram has to be converted to the corresponding + -- record if it is a controlling result. if Ekind (Subp_Id) = E_Function then - return - Make_Subprogram_Body (Loc, - Specification => Body_Spec, - Declarations => Empty_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Make_Simple_Return_Statement (Loc, - Make_Function_Call (Loc, - Name => Nam, - Parameter_Associations => Actuals))))); + declare + Res : Node_Id; + + begin + Res := + Make_Function_Call (Loc, + Name => Nam, + Parameter_Associations => Actuals); + + if Has_Controlling_Result (Subp_Id) then + Res := + Unchecked_Convert_To + (Corresponding_Record_Type (Etype (Subp_Id)), Res); + end if; + + return + Make_Subprogram_Body (Loc, + Specification => Body_Spec, + Declarations => Empty_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + Make_Simple_Return_Statement (Loc, Res)))); + end; else return @@ -1819,7 +1843,8 @@ package body Exp_Ch9 is -- Determine whether the parameters of the generated entry wrapper -- and those of a primitive operation are type conformant. During -- this check, the first parameter of the primitive operation is - -- always skipped. + -- skipped if it is a controlling argument: protected functions + -- may have a controlling result. -------------------------------- -- Type_Conformant_Parameters -- @@ -1835,9 +1860,16 @@ package body Exp_Ch9 is Wrapper_Typ : Entity_Id; begin - -- Skip the first parameter of the primitive operation + -- Skip the first (controlling) parameter of primitive operation + + Iface_Op_Param := First (Iface_Op_Params); + + if Present (First_Formal (Iface_Op)) + and then Is_Controlling_Formal (First_Formal (Iface_Op)) + then + Iface_Op_Param := Next (Iface_Op_Param); + end if; - Iface_Op_Param := Next (First (Iface_Op_Params)); Wrapper_Param := First (Wrapper_Params); while Present (Iface_Op_Param) and then Present (Wrapper_Param) @@ -1917,7 +1949,9 @@ package body Exp_Ch9 is -- Skip the object parameter when dealing with primitives declared -- between two views. - if Is_Private_Primitive_Subprogram (Subp_Id) then + if Is_Private_Primitive_Subprogram (Subp_Id) + and then not Has_Controlling_Result (Subp_Id) + then Formal := Next (Formal); end if; @@ -2046,11 +2080,21 @@ package body Exp_Ch9 is New_Formals := Replicate_Formals (Loc, Formals); + -- A function with a controlling result and no first controlling + -- formal needs no additional parameter. + + if Has_Controlling_Result (Subp_Id) + and then + (No (First_Formal (Subp_Id)) + or else not Is_Controlling_Formal (First_Formal (Subp_Id))) + then + null; + -- Routine Subp_Id has been found to override an interface primitive. -- If the interface operation has an access parameter, create a copy -- of it, with the same null exclusion indicator if present. - if Present (First_Param) then + elsif Present (First_Param) then if Nkind (Parameter_Type (First_Param)) = N_Access_Definition then Obj_Param_Typ := Make_Access_Definition (Loc, @@ -2072,30 +2116,49 @@ package body Exp_Ch9 is Out_Present => Out_Present (First_Param), Parameter_Type => Obj_Param_Typ); + Prepend_To (New_Formals, Obj_Param); + -- If we are dealing with a primitive declared between two views, - -- create a default parameter. + -- implemented by a synchronized operation, we need to create + -- a default parameter. The mode of the parameter must match that + -- of the primitive operation. - else pragma Assert (Is_Private_Primitive_Subprogram (Subp_Id)); + else + pragma Assert (Is_Private_Primitive_Subprogram (Subp_Id)); Obj_Param := Make_Parameter_Specification (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO), - In_Present => True, + In_Present => In_Present (Parent (First_Entity (Subp_Id))), Out_Present => Ekind (Subp_Id) /= E_Function, Parameter_Type => New_Reference_To (Obj_Typ, Loc)); + Prepend_To (New_Formals, Obj_Param); end if; - Prepend_To (New_Formals, Obj_Param); - - -- Build the final spec + -- Build the final spec. If it is a function with a controlling + -- result, it is a primitive operation of the corresponding + -- record type, so mark the spec accordingly. if Ekind (Subp_Id) = E_Function then - return - Make_Function_Specification (Loc, - Defining_Unit_Name => Wrapper_Id, - Parameter_Specifications => New_Formals, - Result_Definition => - New_Copy (Result_Definition (Parent (Subp_Id)))); + + declare + Res_Def : Node_Id; + + begin + if Has_Controlling_Result (Subp_Id) then + Res_Def := + New_Occurrence_Of + (Corresponding_Record_Type (Etype (Subp_Id)), Loc); + else + Res_Def := New_Copy (Result_Definition (Parent (Subp_Id))); + end if; + + return + Make_Function_Specification (Loc, + Defining_Unit_Name => Wrapper_Id, + Parameter_Specifications => New_Formals, + Result_Definition => Res_Def); + end; else return Make_Procedure_Specification (Loc, diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index c91798f2450..978f0e65f31 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -146,7 +146,7 @@ package Exp_Disp is -- Snames.adb. -- Categorize the new PPO name as predefined by adding an entry in - -- Is_Predefined_Dispatching_Operation in Exp_Util.adb. + -- Is_Predefined_Dispatching_Operation in Exp_Disp. -- Generate the specification of the new PPO in Make_Predefined_ -- Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 3cb421b4bd3..529fadebdb9 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,7 +29,6 @@ with Debug; use Debug; with Einfo; use Einfo; with Errout; use Errout; with Exp_Ch11; use Exp_Ch11; -with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Expander; use Expander; with Namet; use Namet; @@ -485,29 +484,17 @@ package body Exp_Prag is procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is Def_Id : constant Entity_Id := Entity (Arg2 (N)); - Typ : Entity_Id; Init_Call : Node_Id; begin if Ekind (Def_Id) = E_Variable then - Typ := Etype (Def_Id); - -- Iterate from declaration of object to import pragma, to find - -- generated initialization call for object, if any. + -- Find generated initialization call for object, if any - Init_Call := Next (Parent (Def_Id)); - while Present (Init_Call) and then Init_Call /= N loop - if Has_Non_Null_Base_Init_Proc (Typ) - and then Nkind (Init_Call) = N_Procedure_Call_Statement - and then Is_Entity_Name (Name (Init_Call)) - and then Entity (Name (Init_Call)) = Base_Init_Proc (Typ) - then - Remove (Init_Call); - exit; - else - Next (Init_Call); - end if; - end loop; + Init_Call := Find_Init_Call (Def_Id, Rep_Clause => N); + if Present (Init_Call) then + Remove (Init_Call); + end if; -- Any default initialization expression should be removed -- (e.g., null defaults for access objects, zero initialization @@ -515,9 +502,7 @@ package body Exp_Prag is -- have explicit initialization, so the expression must have -- been generated by the compiler. - if Init_Call = N - and then Present (Expression (Parent (Def_Id))) - then + if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then Set_Expression (Parent (Def_Id), Empty); end if; end if; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1fe6526c77d..be7c71a2551 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1398,6 +1398,74 @@ package body Exp_Util is end if; end Expand_Subtype_From_Expr; + -------------------- + -- Find_Init_Call -- + -------------------- + + function Find_Init_Call + (Var : Entity_Id; + Rep_Clause : Node_Id) return Node_Id + is + Typ : constant Entity_Id := Etype (Var); + + Init_Proc : Entity_Id; + -- Initialization procedure for Typ + + function Find_Init_Call_In_List (From : Node_Id) return Node_Id; + -- Look for init call for Var starting at From and scanning the + -- enclosing list until Rep_Clause or the end of the list is reached. + + ---------------------------- + -- Find_Init_Call_In_List -- + ---------------------------- + + function Find_Init_Call_In_List (From : Node_Id) return Node_Id is + Init_Call : Node_Id; + begin + Init_Call := From; + + while Present (Init_Call) and then Init_Call /= Rep_Clause loop + if Nkind (Init_Call) = N_Procedure_Call_Statement + and then Is_Entity_Name (Name (Init_Call)) + and then Entity (Name (Init_Call)) = Init_Proc + then + return Init_Call; + end if; + Next (Init_Call); + end loop; + + return Empty; + end Find_Init_Call_In_List; + + Init_Call : Node_Id; + + -- Start of processing for Find_Init_Call + + begin + if not Has_Non_Null_Base_Init_Proc (Typ) then + -- No init proc for the type, so obviously no call to be found + + return Empty; + end if; + + Init_Proc := Base_Init_Proc (Typ); + + -- First scan the list containing the declaration of Var + + Init_Call := Find_Init_Call_In_List (From => Next (Parent (Var))); + + -- If not found, also look on Var's freeze actions list, if any, since + -- the init call may have been moved there (case of an address clause + -- applying to Var). + + if No (Init_Call) and then Present (Freeze_Node (Var)) then + Init_Call := Find_Init_Call_In_List + (First (Actions (Freeze_Node (Var)))); + end if; + + return Init_Call; + end Find_Init_Call; + ------------------------ -- Find_Interface_ADT -- ------------------------ diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 5848d5d7171..c310a211aa3 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -343,6 +343,14 @@ package Exp_Util is -- declarations and/or allocations when the type is indefinite (including -- class-wide). + function Find_Init_Call + (Var : Entity_Id; + Rep_Clause : Node_Id) return Node_Id; + -- Look for init_proc call for variable Var, either among declarations + -- between that of Var and a subsequent Rep_Clause applying to Var, or + -- in the list of freeze actions associated with Var, and if found, return + -- that call node. + function Find_Interface_ADT (T : Entity_Id; Iface : Entity_Id) return Elmt_Id; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 079b39cd0ec..406db6438bb 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -536,10 +536,19 @@ package body Freeze is -- Otherwise, we require the address clause to be constant because -- the call to the initialization procedure (or the attach code) has -- to happen at the point of the declaration. + -- Actually the IP call has been moved to the freeze actions + -- anyway, so maybe we can relax this restriction??? else Check_Constant_Address_Clause (Expr, E); - Set_Has_Delayed_Freeze (E, False); + + -- Has_Delayed_Freeze was set on E when the address clause was + -- analyzed. Reset the flag now unless freeze actions were + -- attached to it in the mean time. + + if No (Freeze_Node (E)) then + Set_Has_Delayed_Freeze (E, False); + end if; end if; if not Error_Posted (Expr) @@ -2594,6 +2603,7 @@ package body Freeze is if Is_Array_Type (R_Type) and then not Is_Constrained (R_Type) and then not Is_Imported (E) + and then VM_Target = No_VM and then Has_Foreign_Convention (E) and then Warn_On_Export_Import and then not Has_Warnings_Off (E) @@ -5037,6 +5047,7 @@ package body Freeze is and then not Is_Constrained (Retype) and then Mechanism (E) not in Descriptor_Codes and then Warn_On_Export_Import + and then VM_Target = No_VM then Error_Msg_N ("?foreign convention function& should not return " & diff --git a/gcc/ada/g-cgi.adb b/gcc/ada/g-cgi.adb index b1b6789e4fb..dad37381129 100644 --- a/gcc/ada/g-cgi.adb +++ b/gcc/ada/g-cgi.adb @@ -123,8 +123,9 @@ package body GNAT.CGI is (Natural'Value ("16#" & S (K + 1 .. K + 2) & '#')); K := K + 3; + -- Plus sign is decoded as a space + elsif S (K) = '+' then - -- + sign is decoded as a space Result (J) := ' '; K := K + 1; diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 9cd471afd54..b15f52fdcfa 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -707,10 +707,8 @@ package body GNAT.Sockets is null; end case; - Res := C_Ioctl - (C.int (Socket), - Requests (Request.Name), - Arg'Unchecked_Access); + Res := Socket_Ioctl + (C.int (Socket), Requests (Request.Name), Arg'Unchecked_Access); if Res = Failure then Raise_Socket_Error (Socket_Errno); diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index 093731ce40d..7c0e7f6ef7f 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -247,6 +247,19 @@ package body GNAT.Sockets.Thin is return Res; end C_Connect; + ------------------ + -- Socket_Ioctl -- + ------------------ + + function Socket_Ioctl + (S : C.int; + Req : C.int; + Arg : access C.int) return C.int + is + begin + return C_Ioctl (S, Req, Arg); + end Socket_Ioctl; + --------------- -- C_Recvmsg -- --------------- diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads index 922e64aa22f..42783e5f734 100644 --- a/gcc/ada/g-socthi-mingw.ads +++ b/gcc/ada/g-socthi-mingw.ads @@ -120,10 +120,10 @@ package GNAT.Sockets.Thin is Optval : System.Address; Optlen : not null access C.int) return C.int; - function C_Ioctl - (S : C.int; - Req : C.int; - Arg : access C.int) return C.int; + function Socket_Ioctl + (S : C.int; + Req : C.int; + Arg : access C.int) return C.int; function C_Listen (S : C.int; @@ -234,7 +234,6 @@ private pragma Import (Stdcall, C_Getpeername, "getpeername"); pragma Import (Stdcall, C_Getsockname, "getsockname"); pragma Import (Stdcall, C_Getsockopt, "getsockopt"); - pragma Import (Stdcall, C_Ioctl, "ioctlsocket"); pragma Import (Stdcall, C_Listen, "listen"); pragma Import (Stdcall, C_Recv, "recv"); pragma Import (Stdcall, C_Recvfrom, "recvfrom"); diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb index 6384598f07a..cb2b211d2aa 100644 --- a/gcc/ada/g-socthi-vms.adb +++ b/gcc/ada/g-socthi-vms.adb @@ -74,12 +74,6 @@ package body GNAT.Sockets.Thin is Namelen : C.int) return C.int; pragma Import (C, Syscall_Connect, "connect"); - function Syscall_Ioctl - (S : C.int; - Req : C.int; - Arg : access C.int) return C.int; - pragma Import (C, Syscall_Ioctl, "ioctl"); - function Syscall_Recv (S : C.int; Msg : System.Address; @@ -153,11 +147,11 @@ package body GNAT.Sockets.Thin is and then R /= Failure then -- A socket inherits the properties of its server, especially - -- the FIONBIO flag. Do not use C_Ioctl as this subprogram + -- the FIONBIO flag. Do not use Socket_Ioctl as this subprogram -- tracks sockets set in non-blocking mode by user. Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S)); - Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); + Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access); end if; return R; @@ -220,26 +214,24 @@ package body GNAT.Sockets.Thin is end if; end C_Connect; - ------------- - -- C_Ioctl -- - ------------- + ------------------ + -- Socket_Ioctl -- + ------------------ - function C_Ioctl + function Socket_Ioctl (S : C.int; Req : C.int; Arg : access C.int) return C.int is begin - if not SOSC.Thread_Blocking_IO - and then Req = SOSC.FIONBIO - then + if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then if Arg.all /= 0 then Set_Non_Blocking_Socket (S, True); end if; end if; - return Syscall_Ioctl (S, Req, Arg); - end C_Ioctl; + return C_Ioctl (S, Req, Arg); + end Socket_Ioctl; ------------ -- C_Recv -- @@ -405,10 +397,10 @@ package body GNAT.Sockets.Thin is if not SOSC.Thread_Blocking_IO and then R /= Failure then - -- Do not use C_Ioctl as this subprogram tracks sockets set + -- Do not use Socket_Ioctl as this subprogram tracks sockets set -- in non-blocking mode by user. - Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); + Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access); Set_Non_Blocking_Socket (R, False); end if; diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads index 3799da802d2..3032b0ec72b 100644 --- a/gcc/ada/g-socthi-vms.ads +++ b/gcc/ada/g-socthi-vms.ads @@ -123,10 +123,10 @@ package GNAT.Sockets.Thin is Optval : System.Address; Optlen : not null access C.int) return C.int; - function C_Ioctl - (S : C.int; - Req : C.int; - Arg : access C.int) return C.int; + function Socket_Ioctl + (S : C.int; + Req : C.int; + Arg : access C.int) return C.int; function C_Listen (S : C.int; diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index a35e429fbb2..67e6c25eeb8 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/gcc/ada/g-socthi-vxworks.adb @@ -80,12 +80,6 @@ package body GNAT.Sockets.Thin is Namelen : C.int) return C.int; pragma Import (C, Syscall_Connect, "connect"); - function Syscall_Ioctl - (S : C.int; - Req : C.int; - Arg : access C.int) return C.int; - pragma Import (C, Syscall_Ioctl, "ioctl"); - function Syscall_Recv (S : C.int; Msg : System.Address; @@ -161,11 +155,11 @@ package body GNAT.Sockets.Thin is and then R /= Failure then -- A socket inherits the properties of its server especially - -- the FIONBIO flag. Do not use C_Ioctl as this subprogram + -- the FIONBIO flag. Do not use Socket_Ioctl as this subprogram -- tracks sockets set in non-blocking mode by user. Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S)); - Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); + Res := C_Ioctl (R, SOSC.FIONBIO, Val'Access); -- Is it OK to ignore result ??? end if; @@ -230,26 +224,24 @@ package body GNAT.Sockets.Thin is end if; end C_Connect; - ------------- - -- C_Ioctl -- - ------------- + ------------------ + -- Socket_Ioctl -- + ------------------ - function C_Ioctl - (S : C.int; - Req : C.int; - Arg : access C.int) return C.int + function Socket_Ioctl + (S : C.int; + Req : C.int; + Arg : access C.int) return C.int is begin - if not SOSC.Thread_Blocking_IO - and then Req = SOSC.FIONBIO - then + if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then if Arg.all /= 0 then Set_Non_Blocking_Socket (S, True); end if; end if; - return Syscall_Ioctl (S, Req, Arg); - end C_Ioctl; + return C_Ioctl (S, Req, Arg); + end Socket_Ioctl; ------------ -- C_Recv -- @@ -399,10 +391,10 @@ package body GNAT.Sockets.Thin is if not SOSC.Thread_Blocking_IO and then R /= Failure then - -- Do not use C_Ioctl as this subprogram tracks sockets set + -- Do not use Socket_Ioctl as this subprogram tracks sockets set -- in non-blocking mode by user. - Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); + Res := C_Ioctl (R, SOSC.FIONBIO, Val'Access); -- Is it OK to ignore result ??? Set_Non_Blocking_Socket (R, False); end if; diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads index 14b8ad92428..08fac05d555 100644 --- a/gcc/ada/g-socthi-vxworks.ads +++ b/gcc/ada/g-socthi-vxworks.ads @@ -121,10 +121,10 @@ package GNAT.Sockets.Thin is Optval : System.Address; Optlen : not null access C.int) return C.int; - function C_Ioctl - (S : C.int; - Req : C.int; - Arg : access C.int) return C.int; + function Socket_Ioctl + (S : C.int; + Req : C.int; + Arg : access C.int) return C.int; function C_Listen (S : C.int; diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index 0ffee86af49..b232378fab6 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -76,12 +76,6 @@ package body GNAT.Sockets.Thin is Namelen : C.int) return C.int; pragma Import (C, Syscall_Connect, "connect"); - function Syscall_Ioctl - (S : C.int; - Req : C.int; - Arg : access C.int) return C.int; - pragma Import (C, Syscall_Ioctl, "ioctl"); - function Syscall_Recv (S : C.int; Msg : System.Address; @@ -165,11 +159,11 @@ package body GNAT.Sockets.Thin is and then R /= Failure then -- A socket inherits the properties ot its server especially - -- the FIONBIO flag. Do not use C_Ioctl as this subprogram + -- the FIONBIO flag. Do not use Socket_Ioctl as this subprogram -- tracks sockets set in non-blocking mode by user. Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S)); - Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); + Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access); end if; Disable_SIGPIPE (R); @@ -235,26 +229,24 @@ package body GNAT.Sockets.Thin is end if; end C_Connect; - ------------- - -- C_Ioctl -- - ------------- + ------------------ + -- Socket_Ioctl -- + ------------------ - function C_Ioctl + function Socket_Ioctl (S : C.int; Req : C.int; Arg : access C.int) return C.int is begin - if not SOSC.Thread_Blocking_IO - and then Req = SOSC.FIONBIO - then + if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then if Arg.all /= 0 then Set_Non_Blocking_Socket (S, True); end if; end if; - return Syscall_Ioctl (S, Req, Arg); - end C_Ioctl; + return C_Ioctl (S, Req, Arg); + end Socket_Ioctl; ------------ -- C_Recv -- @@ -404,10 +396,10 @@ package body GNAT.Sockets.Thin is if not SOSC.Thread_Blocking_IO and then R /= Failure then - -- Do not use C_Ioctl as this subprogram tracks sockets set + -- Do not use Socket_Ioctl as this subprogram tracks sockets set -- in non-blocking mode by user. - Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); + Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access); Set_Non_Blocking_Socket (R, False); end if; Disable_SIGPIPE (R); diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index cb19050250b..eb690c5b4a8 100644 --- a/gcc/ada/g-socthi.ads +++ b/gcc/ada/g-socthi.ads @@ -122,10 +122,10 @@ package GNAT.Sockets.Thin is Optval : System.Address; Optlen : not null access C.int) return C.int; - function C_Ioctl - (S : C.int; - Req : C.int; - Arg : access C.int) return C.int; + function Socket_Ioctl + (S : C.int; + Req : C.int; + Arg : access C.int) return C.int; function C_Listen (S : C.int; diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads index 9a8672830fa..c5636a8f1e3 100644 --- a/gcc/ada/g-sothco.ads +++ b/gcc/ada/g-sothco.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2008, AdaCore -- +-- Copyright (C) 2008-2009, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -321,6 +321,11 @@ package GNAT.Sockets.Thin_Common is Cp : C.Strings.chars_ptr; Inp : System.Address) return C.int; + function C_Ioctl + (Fd : C.int; + Req : C.int; + Arg : access C.int) return C.int; + private pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set"); pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set"); @@ -328,5 +333,6 @@ private pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set"); pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set"); pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set"); + pragma Import (C, C_Ioctl, "__gnat_socket_ioctl"); pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname); end GNAT.Sockets.Thin_Common; diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index ef42fa3bea9..8a9bbe3a59b 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1213,7 +1213,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(targ))),) endif ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),) - LIBGNAT_TARGET_PAIRS = \ + LIBGNAT_TARGET_PAIRS_COMMON = \ a-intnam.ads<a-intnam-aix.ads \ s-inmaop.adb<s-inmaop-posix.adb \ s-intman.adb<s-intman-posix.adb \ @@ -1222,9 +1222,25 @@ ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),) s-osprim.adb<s-osprim-posix.adb \ s-taprop.adb<s-taprop-posix.adb \ s-taspri.ads<s-taspri-posix.ads \ - s-tpopsp.adb<s-tpopsp-posix.adb \ + s-tpopsp.adb<s-tpopsp-posix.adb + + LIBGNAT_TARGET_PAIRS_32 = \ system.ads<system-aix.ads + LIBGNAT_TARGET_PAIRS_64 = \ + system.ads<system-aix64.ads + + ifeq ($(findstring ppc64, \ + $(shell $(GCC_FOR_TARGET) $(GNATLIBCFLAGS) \ + -print-multi-os-directory)), \ + ppc64) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_64) + else + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_32) + endif + THREADSLIB = -lpthreads PREFIX_OBJS=$(PREFIX_REAL_OBJS) diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index b59af8cdb19..ed9337c3389 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -6610,10 +6610,7 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason, Node_Id gnat_node) we don't need to evaluate it just for the check. */ TREE_SIDE_EFFECTS (gnu_result) = TREE_SIDE_EFFECTS (gnu_expr); - /* ??? Unfortunately, if we don't put a SAVE_EXPR around this whole thing, - we will repeatedly do the test and, at compile time, we will repeatedly - visit it during unsharing, which leads to an exponential explosion. */ - return save_expr (gnu_result); + return gnu_result; } /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow @@ -7229,8 +7226,15 @@ protect_multiple_eval (tree exp) { tree type = TREE_TYPE (exp); - /* If this has no side effects, we don't need to do anything. */ - if (!TREE_SIDE_EFFECTS (exp)) + /* If EXP has no side effects, we theoritically don't need to do anything. + However, we may be recursively passed more and more complex expressions + involving checks which will be reused multiple times and eventually be + unshared for gimplification; in order to avoid a complexity explosion + at that point, we protect any expressions more complex than a simple + arithmetic expression. */ + if (!TREE_SIDE_EFFECTS (exp) + && (CONSTANT_CLASS_P (exp) + || !EXPRESSION_CLASS_P (skip_simple_arithmetic (exp)))) return exp; /* If this is a conversion, protect what's inside the conversion. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 4e5e2141fda..d936e232ccf 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -17177,6 +17177,13 @@ The following switches control the @command{gnatmetric} output: @item ^-x^/XML^ Generate the XML output +@cindex @option{^-xs^/XSD^} (@command{gnatmetric}) +@item ^-xs^/XSD^ +Generate the XML output and the XML schema file that describes the structure +of the XML metric report, this schema is assigned to the XML file. The schema +file has the same name as the XML output file with @file{.xml} suffix replaced +with @file{.xsd} + @cindex @option{^-nt^/NO_TEXT^} (@command{gnatmetric}) @item ^-nt^/NO_TEXT^ Do not generate the output in text form (implies @option{^-x^/XML^}) @@ -17329,56 +17336,56 @@ to be computed and reported. @cindex @option{--no-lines@var{x}} @end ifclear -@item ^--lines-all^/LINE_COUNT_METRICS=ALL_ON^ +@item ^--lines-all^/LINE_COUNT_METRICS=ALL^ Report all the line metrics -@item ^--no-lines-all^/LINE_COUNT_METRICS=ALL_OFF^ +@item ^--no-lines-all^/LINE_COUNT_METRICS=NONE^ Do not report any of line metrics -@item ^--lines^/LINE_COUNT_METRICS=ALL_LINES_ON^ +@item ^--lines^/LINE_COUNT_METRICS=ALL_LINES^ Report the number of all lines -@item ^--no-lines^/LINE_COUNT_METRICS=ALL_LINES_OFF^ +@item ^--no-lines^/LINE_COUNT_METRICS=NOALL_LINES^ Do not report the number of all lines -@item ^--lines-code^/LINE_COUNT_METRICS=CODE_LINES_ON^ +@item ^--lines-code^/LINE_COUNT_METRICS=CODE_LINES^ Report the number of code lines -@item ^--no-lines-code^/LINE_COUNT_METRICS=CODE_LINES_OFF^ +@item ^--no-lines-code^/LINE_COUNT_METRICS=NOCODE_LINES^ Do not report the number of code lines -@item ^--lines-comment^/LINE_COUNT_METRICS=COMMENT_LINES_ON^ +@item ^--lines-comment^/LINE_COUNT_METRICS=COMMENT_LINES^ Report the number of comment lines -@item ^--no-lines-comment^/LINE_COUNT_METRICS=COMMENT_LINES_OFF^ +@item ^--no-lines-comment^/LINE_COUNT_METRICS=NOCOMMENT_LINES^ Do not report the number of comment lines -@item ^--lines-eol-comment^/LINE_COUNT_METRICS=CODE_COMMENT_LINES_ON^ +@item ^--lines-eol-comment^/LINE_COUNT_METRICS=CODE_COMMENT_LINES^ Report the number of code lines containing end-of-line comments -@item ^--no-lines-eol-comment^/LINE_COUNT_METRICS=CODE_COMMENT_LINES_OFF^ +@item ^--no-lines-eol-comment^/LINE_COUNT_METRICS=NOCODE_COMMENT_LINES^ Do not report the number of code lines containing end-of-line comments -@item ^--lines-ratio^/LINE_COUNT_METRICS=COMMENT_PERCENTAGE_ON^ +@item ^--lines-ratio^/LINE_COUNT_METRICS=COMMENT_PERCENTAGE^ Report the comment percentage in the program text -@item ^--no-lines-ratio^/LINE_COUNT_METRICS=COMMENT_PERCENTAGE_OFF^ +@item ^--no-lines-ratio^/LINE_COUNT_METRICS=NOCOMMENT_PERCENTAGE^ Do not report the comment percentage in the program text -@item ^--lines-blank^/LINE_COUNT_METRICS=BLANK_LINES_ON^ +@item ^--lines-blank^/LINE_COUNT_METRICS=BLANK_LINES^ Report the number of blank lines -@item ^--no-lines-blank^/LINE_COUNT_METRICS=BLANK_LINES_OFF^ +@item ^--no-lines-blank^/LINE_COUNT_METRICS=NOBLANK_LINES^ Do not report the number of blank lines -@item ^--lines-average^/LINE_COUNT_METRICS=AVERAGE_BODY_LINES_ON^ +@item ^--lines-average^/LINE_COUNT_METRICS=AVERAGE_BODY_LINES^ Report the average number of code lines in subprogram bodies, task bodies, entry bodies and statement sequences in package bodies. The metric is computed and reported for the whole set of processed Ada sources only. -@item ^--no-lines-average^/LINE_COUNT_METRICS=AVERAGE_BODY_LINES_OFF^ +@item ^--no-lines-average^/LINE_COUNT_METRICS=NOAVERAGE_BODY_LINES^ Do not report the average number of code lines in subprogram bodies, task bodies, entry bodies and statement sequences in package bodies. @@ -17483,58 +17490,58 @@ following switches to select specific syntax metrics. @cindex @option{--no-syntax@var{x}} (@command{gnatmetric}) @end ifclear -@item ^--syntax-all^/SYNTAX_METRICS=ALL_ON^ +@item ^--syntax-all^/SYNTAX_METRICS=ALL^ Report all the syntax metrics -@item ^--no-syntax-all^/ALL_OFF^ +@item ^--no-syntax-all^/SYNTAX_METRICS=NONE^ Do not report any of syntax metrics -@item ^--declarations^/SYNTAX_METRICS=DECLARATIONS_ON^ +@item ^--declarations^/SYNTAX_METRICS=DECLARATIONS^ Report the total number of declarations -@item ^--no-declarations^/SYNTAX_METRICS=DECLARATIONS_OFF^ +@item ^--no-declarations^/SYNTAX_METRICS=NODECLARATIONS^ Do not report the total number of declarations -@item ^--statements^/SYNTAX_METRICS=STATEMENTS_ON^ +@item ^--statements^/SYNTAX_METRICS=STATEMENTS^ Report the total number of statements -@item ^--no-statements^/SYNTAX_METRICS=STATEMENTS_OFF^ +@item ^--no-statements^/SYNTAX_METRICS=NOSTATEMENTS^ Do not report the total number of statements -@item ^--public-subprograms^/SYNTAX_METRICS=PUBLIC_SUBPROGRAMS_ON^ +@item ^--public-subprograms^/SYNTAX_METRICS=PUBLIC_SUBPROGRAMS^ Report the number of public subprograms in a compilation unit -@item ^--no-public-subprograms^/SYNTAX_METRICS=PUBLIC_SUBPROGRAMS_OFF^ +@item ^--no-public-subprograms^/SYNTAX_METRICS=NOPUBLIC_SUBPROGRAMS^ Do not report the number of public subprograms in a compilation unit -@item ^--all-subprograms^/SYNTAX_METRICS=ALL_SUBPROGRAMS_ON^ +@item ^--all-subprograms^/SYNTAX_METRICS=ALL_SUBPROGRAMS^ Report the number of all the subprograms in a compilation unit -@item ^--no-all-subprograms^/SYNTAX_METRICS=ALL_SUBPROGRAMS_OFF^ +@item ^--no-all-subprograms^/SYNTAX_METRICS=NOALL_SUBPROGRAMS^ Do not report the number of all the subprograms in a compilation unit -@item ^--public-types^/SYNTAX_METRICS=PUBLIC_TYPES_ON^ +@item ^--public-types^/SYNTAX_METRICS=PUBLIC_TYPES^ Report the number of public types in a compilation unit -@item ^--no-public-types^/SYNTAX_METRICS=PUBLIC_TYPES_OFF^ +@item ^--no-public-types^/SYNTAX_METRICS=NOPUBLIC_TYPES^ Do not report the number of public types in a compilation unit -@item ^--all-types^/SYNTAX_METRICS=ALL_TYPES_ON^ +@item ^--all-types^/SYNTAX_METRICS=ALL_TYPES^ Report the number of all the types in a compilation unit -@item ^--no-all-types^/SYNTAX_METRICS=ALL_TYPES_OFF^ +@item ^--no-all-types^/SYNTAX_METRICS=NOALL_TYPES^ Do not report the number of all the types in a compilation unit -@item ^--unit-nesting^/SYNTAX_METRICS=UNIT_NESTING_ON^ +@item ^--unit-nesting^/SYNTAX_METRICS=UNIT_NESTING^ Report the maximal program unit nesting level @item ^--no-unit-nesting^/SYNTAX_METRICS=UNIT_NESTING_OFF^ Do not report the maximal program unit nesting level -@item ^--construct-nesting^/SYNTAX_METRICS=CONSTRUCT_NESTING_ON^ +@item ^--construct-nesting^/SYNTAX_METRICS=CONSTRUCT_NESTING^ Report the maximal construct nesting level -@item ^--no-construct-nesting^/SYNTAX_METRICS=CONSTRUCT_NESTING_OFF^ +@item ^--no-construct-nesting^/SYNTAX_METRICS=NOCONSTRUCT_NESTING^ Do not report the maximal construct nesting level @end table @@ -17597,37 +17604,37 @@ the following switches: @cindex @option{--no-complexity@var{x}} @end ifclear -@item ^--complexity-all^/COMPLEXITY_METRICS=ALL_ON^ +@item ^--complexity-all^/COMPLEXITY_METRICS=ALL^ Report all the complexity metrics -@item ^--no-complexity-all^/COMPLEXITY_METRICS=ALL_OFF^ +@item ^--no-complexity-all^/COMPLEXITY_METRICS=NONE^ Do not report any of complexity metrics -@item ^--complexity-cyclomatic^/COMPLEXITY_METRICS=CYCLOMATIC_ON^ +@item ^--complexity-cyclomatic^/COMPLEXITY_METRICS=CYCLOMATIC^ Report the McCabe Cyclomatic Complexity -@item ^--no-complexity-cyclomatic^/COMPLEXITY_METRICS=CYCLOMATIC_OFF^ +@item ^--no-complexity-cyclomatic^/COMPLEXITY_METRICS=NOCYCLOMATIC^ Do not report the McCabe Cyclomatic Complexity -@item ^--complexity-essential^/COMPLEXITY_METRICS=ESSENTIAL_ON^ +@item ^--complexity-essential^/COMPLEXITY_METRICS=ESSENTIAL^ Report the Essential Complexity -@item ^--no-complexity-essential^/COMPLEXITY_METRICS=ESSENTIAL_OFF^ +@item ^--no-complexity-essential^/COMPLEXITY_METRICS=NOESSENTIAL^ Do not report the Essential Complexity @item ^--loop-nesting^/COMPLEXITY_METRICS=LOOP_NESTING_ON^ Report maximal loop nesting level -@item ^--no-loop-nesting^/COMPLEXITY_METRICS=LOOP_NESTING_OFF^ +@item ^--no-loop-nesting^/COMPLEXITY_METRICS=NOLOOP_NESTING^ Do not report maximal loop nesting level -@item ^--complexity-average^/COMPLEXITY_METRICS=AVERAGE_COMPLEXITY_ON^ +@item ^--complexity-average^/COMPLEXITY_METRICS=AVERAGE_COMPLEXITY^ Report the average McCabe Cyclomatic Complexity for all the subprogram bodies, task bodies, entry bodies and statement sequences in package bodies. The metric is computed and reported for whole set of processed Ada sources only. -@item ^--no-complexity-average^/COMPLEXITY_METRICS=AVERAGE_COMPLEXITY_OFF^ +@item ^--no-complexity-average^/COMPLEXITY_METRICS=NOAVERAGE_COMPLEXITY^ Do not report the average McCabe Cyclomatic Complexity for all the subprogram bodies, task bodies, entry bodies and statement sequences in package bodies @@ -17636,14 +17643,14 @@ bodies, task bodies, entry bodies and statement sequences in package bodies Do not consider @code{exit} statements as @code{goto}s when computing Essential Complexity -@item ^--extra-exit-points^/EXTRA_EXIT_POINTS_ON^ +@item ^--extra-exit-points^/EXTRA_EXIT_POINTS^ Report the extra exit points for subprogram bodies. As an exit point, this metric counts @code{return} statements and raise statements in case when the raised exception is not handled in the same body. In case of a function this metric subtracts 1 from the number of exit points, because a function body must contain at least one @code{return} statement. -@item ^--no-extra-exit-points^/EXTRA_EXIT_POINTS_OFF^ +@item ^--no-extra-exit-points^/NOEXTRA_EXIT_POINTS^ Do not report the extra exit points for subprogram bodies @end table @@ -17716,34 +17723,34 @@ switches to specify the coupling metrics to be computed and reported: @cindex @option{/COUPLING_METRICS} (@command{gnatmetric}) @end ifset -@item ^--coupling-all^/COUPLING_METRICS=ALL_ON^ +@item ^--coupling-all^/COUPLING_METRICS=ALL^ Report all the coupling metrics -@item ^--no-coupling-all^/COUPLING_METRICS=ALL_OFF^ +@item ^--no-coupling-all^/COUPLING_METRICS=NONE^ Do not report any of metrics -@item ^--package-efferent-coupling^/COUPLING_METRICS=PACKAGE_EFFERENT_ON^ +@item ^--package-efferent-coupling^/COUPLING_METRICS=PACKAGE_EFFERENT^ Report package efferent coupling -@item ^--no-package-efferent-coupling^/COUPLING_METRICS=PACKAGE_EFFERENT_OFF^ +@item ^--no-package-efferent-coupling^/COUPLING_METRICS=NOPACKAGE_EFFERENT^ Do not report package efferent coupling -@item ^--package-afferent-coupling^/COUPLING_METRICS=PACKAGE_AFFERENT_ON^ +@item ^--package-afferent-coupling^/COUPLING_METRICS=PACKAGE_AFFERENT^ Report package afferent coupling -@item ^--no-package-afferent-coupling^/COUPLING_METRICS=PACKAGE_AFFERENT_OFF^ +@item ^--no-package-afferent-coupling^/COUPLING_METRICS=NOPACKAGE_AFFERENT^ Do not report package afferent coupling -@item ^--category-efferent-coupling^/COUPLING_METRICS=CATEGORY_EFFERENT_ON^ +@item ^--category-efferent-coupling^/COUPLING_METRICS=CATEGORY_EFFERENT^ Report category efferent coupling -@item ^--no-category-efferent-coupling^/COUPLING_METRICS=CATEGORY_EFFERENT_OFF^ +@item ^--no-category-efferent-coupling^/COUPLING_METRICS=NOCATEGORY_EFFERENT^ Do not report category efferent coupling -@item ^--category-afferent-coupling^/COUPLING_METRICS=CATEGORY_AFFERENT_ON^ +@item ^--category-afferent-coupling^/COUPLING_METRICS=CATEGORY_AFFERENT^ Report category afferent coupling -@item ^--no-category-afferent-coupling^/COUPLING_METRICS=CATEGORY_AFFERENT_OFF^ +@item ^--no-category-afferent-coupling^/COUPLING_METRICS=NOCATEGORY_AFFERENT^ Do not report category afferent coupling @end table diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 8194a42ed8d..9e335d1b5df 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -71,12 +71,9 @@ procedure GNATCmd is -- an old fashioned project file. -p cannot be used in conjunction -- with -P. - Max_Files_On_The_Command_Line : constant := 30; -- Arbitrary - - Temp_File_Name : String_Access := null; + Temp_File_Name : Path_Name_Type := No_Path; -- The name of the temporary text file to put a list of source/object - -- files to pass to a tool, when there are more than - -- Max_Files_On_The_Command_Line files. + -- files to pass to a tool. ASIS_Main : String_Access := null; -- Main for commands Check, Metric and Pretty, when -U is used @@ -311,6 +308,9 @@ procedure GNATCmd is Add_Sources : Boolean := True; Unit_Data : Prj.Unit_Data; Subunit : Boolean := False; + FD : File_Descriptor := Invalid_FD; + Status : Integer; + Success : Boolean; begin -- Check if there is at least one argument that is not a switch @@ -326,8 +326,22 @@ procedure GNATCmd is -- of the main project. if Add_Sources then + + -- For gnatcheck, gnatpp and gnatmetric , create a temporary file and + -- put the list of sources in it. + + if The_Command = Check + or else The_Command = Pretty + or else The_Command = Metric + then + Tempdir.Create_Temp_File (FD, Temp_File_Name); + Last_Switches.Increment_Last; + Last_Switches.Table (Last_Switches.Last) := + new String'("-files=" & Get_Name_String (Temp_File_Name)); + + end if; + declare - Current_Last : constant Integer := Last_Switches.Last; Proj : Project_List; begin @@ -572,70 +586,40 @@ procedure GNATCmd is and then Unit_Data.File_Names (Kind).Name /= No_File and then Unit_Data.File_Names (Kind).Path.Name /= Slash then - Last_Switches.Increment_Last; - Last_Switches.Table (Last_Switches.Last) := - new String' - (Get_Name_String - (Unit_Data.File_Names - (Kind).Path.Display_Name)); - end if; - end loop; - end if; - end loop; - - -- If the list of files is too long, create a temporary text file - -- that lists these files, and pass this temp file to gnatcheck, - -- gnatpp or gnatmetric using switch -files=. - - if Last_Switches.Last - Current_Last > - Max_Files_On_The_Command_Line - then - declare - Temp_File_FD : File_Descriptor; - Buffer : String (1 .. 1_000); - Len : Natural; - OK : Boolean := True; + Get_Name_String + (Unit_Data.File_Names + (Kind).Path.Display_Name); - begin - Create_Temp_File (Temp_File_FD, Temp_File_Name); + if FD /= Invalid_FD then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := ASCII.LF; + Status := + Write (FD, Name_Buffer (1)'Address, Name_Len); - if Temp_File_Name /= null then - for Index in Current_Last + 1 .. - Last_Switches.Last - loop - Len := Last_Switches.Table (Index)'Length; - Buffer (1 .. Len) := Last_Switches.Table (Index).all; - Len := Len + 1; - Buffer (Len) := ASCII.LF; - Buffer (Len + 1) := ASCII.NUL; - OK := - Write (Temp_File_FD, - Buffer (1)'Address, - Len) = Len; - exit when not OK; - end loop; + if Status /= Name_Len then + Osint.Fail ("disk full"); + end if; - if OK then - Close (Temp_File_FD, OK); - else - Close (Temp_File_FD, OK); - OK := False; + else + Last_Switches.Increment_Last; + Last_Switches.Table (Last_Switches.Last) := + new String' + (Get_Name_String + (Unit_Data.File_Names + (Kind).Path.Display_Name)); + end if; end if; + end loop; - -- If there were any problem creating the temp file, then - -- pass the list of files. - - if OK then - - -- Replace list of files with -files=<temp file name> + if FD /= Invalid_FD then + Close (FD, Success); - Last_Switches.Set_Last (Current_Last + 1); - Last_Switches.Table (Last_Switches.Last) := - new String'("-files=" & Temp_File_Name.all); + if not Success then + Osint.Fail ("disk full"); end if; end if; - end; - end if; + end if; + end loop; end; end if; end Check_Files; @@ -752,8 +736,8 @@ procedure GNATCmd is -- If a temporary text file that contains a list of files for a tool -- has been created, delete this temporary file. - if Temp_File_Name /= null then - Delete_File (Temp_File_Name.all, Success); + if Temp_File_Name /= No_Path then + Delete_File (Get_Name_String (Temp_File_Name), Success); end if; end Delete_Temp_Config_Files; diff --git a/gcc/ada/i-vxwoio.ads b/gcc/ada/i-vxwoio.ads index 79aca27ad19..dc695469692 100644 --- a/gcc/ada/i-vxwoio.ads +++ b/gcc/ada/i-vxwoio.ads @@ -53,8 +53,8 @@ package Interfaces.VxWorks.IO is type IOOPT is mod 2 ** int'Size; -- Type of the option codes in ioctl - -- ioctl function codes - -- For more information see ioLib.h + -- ioctl function codes (for more information see ioLib.h) + -- These values could be generated automatically in System.OS_Constants??? FIONREAD : constant FUNCODE := 1; FIOFLUSH : constant FUNCODE := 2; @@ -129,6 +129,9 @@ package Interfaces.VxWorks.IO is function ioctl (Fd : int; Function_Code : FUNCODE; Arg : IOOPT) return int; pragma Import (C, ioctl, "ioctl"); -- Binding to the C routine ioctl + -- + -- Note: we are taking advantage of the fact that on currently supported + -- VxWorks targets, it is fine to directly bind to a variadic C function. ------------------------------ -- Control of Get_Immediate -- diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 17c34ff51f7..46169d5fa62 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -229,7 +229,8 @@ package body Makeutl is return ""; end if; - return Normalize_Pathname (Exec (Exec'First .. Path_Last - 4)); + return Normalize_Pathname (Exec (Exec'First .. Path_Last - 4)) + & Directory_Separator; end Get_Install_Dir; -- Beginning of Executable_Prefix_Path @@ -248,12 +249,17 @@ package body Makeutl is -- directory prefix. declare - Path : constant String_Access := Locate_Exec_On_Path (Exec_Name); + Path : String_Access := Locate_Exec_On_Path (Exec_Name); begin if Path = null then return ""; else - return Get_Install_Dir (Path.all); + declare + Dir : constant String := Get_Install_Dir (Path.all); + begin + Free (Path); + return Dir; + end; end if; end; end Executable_Prefix_Path; diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index c0dc9f16292..ae55ebbe62a 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -62,7 +62,8 @@ package Makeutl is function Executable_Prefix_Path return String; -- Return the absolute path parent directory of the directory where the -- current executable resides, if its directory is named "bin", otherwise - -- return an empty string. + -- return an empty string. When a directory is returned, it is guaranteed + -- to end with a directory separator. procedure Inform (N : Name_Id := No_Name; Msg : String); procedure Inform (N : File_Name_Type; Msg : String); diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 50751c22c3e..37c6296787f 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -263,8 +263,7 @@ package body Prj.Ext is if Get_Mode = Multi_Language then Add_Str_To_Name_Buffer (Path_Separator & Prefix.all & - Directory_Separator & "share" & - Directory_Separator & "gpr"); + "share" & Directory_Separator & "gpr"); end if; Add_Str_To_Name_Buffer diff --git a/gcc/ada/s-intman-solaris.adb b/gcc/ada/s-intman-solaris.adb index e8bd6ffe419..170cd82f8da 100644 --- a/gcc/ada/s-intman-solaris.adb +++ b/gcc/ada/s-intman-solaris.adb @@ -89,40 +89,27 @@ package body System.Interrupt_Management is info : access siginfo_t; context : access ucontext_t) is + pragma Unreferenced (info); + begin -- Perform the necessary context adjustments prior to a raise -- from a signal handler. Adjust_Context_For_Raise (signo, context.all'Address); - -- Check that treatment of exception propagation here - -- is consistent with treatment of the abort signal in - -- System.Task_Primitives.Operations. + -- Check that treatment of exception propagation here is consistent with + -- treatment of the abort signal in System.Task_Primitives.Operations. case signo is when SIGFPE => - case info.si_code is - when FPE_INTDIV | - FPE_INTOVF | - FPE_FLTDIV | - FPE_FLTOVF | - FPE_FLTUND | - FPE_FLTRES | - FPE_FLTINV | - FPE_FLTSUB => - - raise Constraint_Error; - - when others => - pragma Assert (False); - null; - end case; - - when SIGILL | SIGSEGV | SIGBUS => + raise Constraint_Error; + when SIGILL => + raise Program_Error; + when SIGSEGV => + raise Storage_Error; + when SIGBUS => raise Storage_Error; - when others => - pragma Assert (False); null; end case; end Notify_Exception; diff --git a/gcc/ada/s-osinte-solaris.ads b/gcc/ada/s-osinte-solaris.ads index 32213ccabd4..a937f6ea36a 100644 --- a/gcc/ada/s-osinte-solaris.ads +++ b/gcc/ada/s-osinte-solaris.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2009, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -168,15 +168,6 @@ package System.OS_Interface is -- More analysis is needed, after which these declarations may need to -- be changed. - FPE_INTDIV : constant := 1; -- integer divide by zero - FPE_INTOVF : constant := 2; -- integer overflow - FPE_FLTDIV : constant := 3; -- floating point divide by zero - FPE_FLTOVF : constant := 4; -- floating point overflow - FPE_FLTUND : constant := 5; -- floating point underflow - FPE_FLTRES : constant := 6; -- floating point inexact result - FPE_FLTINV : constant := 7; -- invalid floating point operation - FPE_FLTSUB : constant := 8; -- subscript out of range - type greg_t is new int; type gregset_t is array (0 .. 18) of greg_t; diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads index c295b19b0b4..81fc71f1cab 100644 --- a/gcc/ada/s-osinte-vxworks.ads +++ b/gcc/ada/s-osinte-vxworks.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2009, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -406,7 +406,7 @@ package System.OS_Interface is -- semTake() timeout with ticks > NO_WAIT S_objLib_OBJ_TIMEOUT : constant := M_objLib + 4; - type SEM_ID is new System.Address; + subtype SEM_ID is System.VxWorks.Ext.SEM_ID; -- typedef struct semaphore *SEM_ID; -- We use two different kinds of VxWorks semaphores: mutex and binary @@ -420,8 +420,8 @@ package System.OS_Interface is function semMCreate (options : int) return SEM_ID; pragma Import (C, semMCreate, "semMCreate"); - function semDelete (Sem : SEM_ID) return int; - pragma Import (C, semDelete, "semDelete"); + function semDelete (Sem : SEM_ID) return int + renames System.VxWorks.Ext.semDelete; -- Delete a semaphore function semGive (Sem : SEM_ID) return int; diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb index 73e4c9dd2c2..a429903d64b 100644 --- a/gcc/ada/s-tposen.adb +++ b/gcc/ada/s-tposen.adb @@ -318,15 +318,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is Compiler_Info : System.Address; Entry_Body : Entry_Body_Access) is - Init_Priority : Integer := Ceiling_Priority; begin - if Init_Priority = Unspecified_Priority then - Init_Priority := System.Priority'Last; - end if; + Initialize_Protection (Object.Common'Access, Ceiling_Priority); - STPO.Initialize_Lock (Init_Priority, Object.L'Access); - Object.Ceiling := System.Any_Priority (Init_Priority); - Object.Owner := Null_Task; Object.Compiler_Info := Compiler_Info; Object.Call_In_Progress := null; Object.Entry_Body := Entry_Body; @@ -341,45 +335,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- Do not call this procedure from within the run-time system. procedure Lock_Entry (Object : Protection_Entry_Access) is - Ceiling_Violation : Boolean; - begin - -- If pragma Detect_Blocking is active then, as described in the ARM - -- 9.5.1, par. 15, we must check whether this is an external call on a - -- protected subprogram with the same target object as that of the - -- protected action that is currently in progress (i.e., if the caller - -- is already the protected object's owner). If this is the case hence - -- Program_Error must be raised. - - if Detect_Blocking and then Object.Owner = Self then - raise Program_Error; - end if; - - STPO.Write_Lock (Object.L'Access, Ceiling_Violation); - - if Ceiling_Violation then - raise Program_Error; - end if; - - -- We are entering in a protected action, so that we increase the - -- protected object nesting level (if pragma Detect_Blocking is - -- active), and update the protected object's owner. - - if Detect_Blocking then - declare - Self_Id : constant Task_Id := Self; - - begin - -- Update the protected object's owner - - Object.Owner := Self_Id; - - -- Increase protected object nesting level - - Self_Id.Common.Protected_Action_Nesting := - Self_Id.Common.Protected_Action_Nesting + 1; - end; - end if; + Lock (Object.Common'Access); end Lock_Entry; -------------------------- @@ -391,53 +348,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- Do not call this procedure from within the runtime system procedure Lock_Read_Only_Entry (Object : Protection_Entry_Access) is - Ceiling_Violation : Boolean; - begin - -- If pragma Detect_Blocking is active then, as described in the ARM - -- 9.5.1, par. 15, we must check whether this is an external call on a - -- protected subprogram with the same target object as that of the - -- protected action that is currently in progress (i.e., if the caller - -- is already the protected object's owner). If this is the case hence - -- Program_Error must be raised. - - -- Note that in this case (getting read access), several tasks may - -- have read ownership of the protected object, so that this method of - -- storing the (single) protected object's owner does not work - -- reliably for read locks. However, this is the approach taken for two - -- major reasons: first, this function is not currently being used (it - -- is provided for possible future use), and second, it largely - -- simplifies the implementation. - - if Detect_Blocking and then Object.Owner = Self then - raise Program_Error; - end if; - - STPO.Read_Lock (Object.L'Access, Ceiling_Violation); - - if Ceiling_Violation then - raise Program_Error; - end if; - - -- We are entering in a protected action, so that we increase the - -- protected object nesting level (if pragma Detect_Blocking is - -- active), and update the protected object's owner. - - if Detect_Blocking then - declare - Self_Id : constant Task_Id := Self; - - begin - -- Update the protected object's owner - - Object.Owner := Self_Id; - - -- Increase protected object nesting level - - Self_Id.Common.Protected_Action_Nesting := - Self_Id.Common.Protected_Action_Nesting + 1; - end; - end if; + Lock_Read_Only (Object.Common'Access); end Lock_Read_Only_Entry; -------------------- @@ -665,7 +577,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is is Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1); - Ceiling_Violation : Boolean; begin -- If pragma Detect_Blocking is active then Program_Error must be @@ -678,11 +589,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is raise Program_Error with "potentially blocking operation"; end if; - STPO.Write_Lock (Object.L'Access, Ceiling_Violation); - - if Ceiling_Violation then - raise Program_Error; - end if; + Lock (Object.Common'Access); Entry_Call.Mode := Timed_Call; Entry_Call.State := Now_Abortable; @@ -730,32 +637,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is procedure Unlock_Entry (Object : Protection_Entry_Access) is begin - -- We are exiting from a protected action, so that we decrease the - -- protected object nesting level (if pragma Detect_Blocking is - -- active), and remove ownership of the protected object. - - if Detect_Blocking then - declare - Self_Id : constant Task_Id := Self; - - begin - -- Calls to this procedure can only take place when being within - -- a protected action and when the caller is the protected - -- object's owner. - - pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0 - and then Object.Owner = Self_Id); - - -- Remove ownership of the protected object - - Object.Owner := Null_Task; - - Self_Id.Common.Protected_Action_Nesting := - Self_Id.Common.Protected_Action_Nesting - 1; - end; - end if; - - STPO.Unlock (Object.L'Access); + Unlock (Object.Common'Access); end Unlock_Entry; end System.Tasking.Protected_Objects.Single_Entry; diff --git a/gcc/ada/s-tposen.ads b/gcc/ada/s-tposen.ads index 4a6e8ddeefd..8c07cfd3ac9 100644 --- a/gcc/ada/s-tposen.ads +++ b/gcc/ada/s-tposen.ads @@ -275,10 +275,9 @@ package System.Tasking.Protected_Objects.Single_Entry is private type Protection_Entry is record - L : aliased Task_Primitives.Lock; - -- The underlying lock associated with a Protection_Entries. Note that - -- you should never (un)lock Object.L directly, but instead use - -- Lock_Entry/Unlock_Entry. + Common : aliased Protection; + -- State of the protected object. This part is common to any protected + -- object, including those without entries. Compiler_Info : System.Address; -- Pointer to compiler-generated record representing protected object @@ -286,17 +285,6 @@ private Call_In_Progress : Entry_Call_Link; -- Pointer to the entry call being executed (if any) - Ceiling : System.Any_Priority; - -- Ceiling priority associated to the protected object - - Owner : Task_Id; - -- This field contains the protected object's owner. Null_Task - -- indicates that the protected object is not currently being used. - -- This information is used for detecting the type of potentially - -- blocking operations described in the ARM 9.5.1, par. 15 (external - -- calls on a protected subprogram with the same target object as that - -- of the protected action). - Entry_Body : Entry_Body_Access; -- Pointer to executable code for the entry body of the protected type diff --git a/gcc/ada/s-vxwext-kernel.adb b/gcc/ada/s-vxwext-kernel.adb index 733772bdf8a..ad609f3cf81 100644 --- a/gcc/ada/s-vxwext-kernel.adb +++ b/gcc/ada/s-vxwext-kernel.adb @@ -52,4 +52,15 @@ package body System.VxWorks.Ext is function Int_Unlock return int renames intUnlock; + --------------- + -- semDelete -- + --------------- + + function semDelete (Sem : SEM_ID) return int is + function Os_Sem_Delete (Sem : SEM_ID) return int; + pragma Import (C, Os_Sem_Delete, "semDelete"); + begin + return Os_Sem_Delete (Sem); + end semDelete; + end System.VxWorks.Ext; diff --git a/gcc/ada/s-vxwext-kernel.ads b/gcc/ada/s-vxwext-kernel.ads index c1883abdff6..c7fd7fec392 100644 --- a/gcc/ada/s-vxwext-kernel.ads +++ b/gcc/ada/s-vxwext-kernel.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2009, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,6 +36,9 @@ with Interfaces.C; package System.VxWorks.Ext is pragma Preelaborate; + subtype SEM_ID is Long_Integer; + -- typedef struct semaphore *SEM_ID; + type t_id is new Long_Integer; subtype int is Interfaces.C.int; @@ -60,6 +63,9 @@ package System.VxWorks.Ext is (intNum : int) return Interrupt_Vector; pragma Import (C, Interrupt_Number_To_Vector, "__gnat_inum_to_ivec"); + function semDelete (Sem : SEM_ID) return int; + pragma Convention (C, semDelete); + function Task_Cont (tid : t_id) return int; pragma Import (C, Task_Cont, "taskCont"); diff --git a/gcc/ada/s-vxwext-rtp.ads b/gcc/ada/s-vxwext-rtp.ads index 8d094412c6d..9dc0fd40eea 100644 --- a/gcc/ada/s-vxwext-rtp.ads +++ b/gcc/ada/s-vxwext-rtp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2009, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,6 +36,9 @@ with Interfaces.C; package System.VxWorks.Ext is pragma Preelaborate; + subtype SEM_ID is Long_Integer; + -- typedef struct semaphore *SEM_ID; + type t_id is new Long_Integer; subtype int is Interfaces.C.int; @@ -60,6 +63,9 @@ package System.VxWorks.Ext is (intNum : int) return Interrupt_Vector; pragma Convention (C, Interrupt_Number_To_Vector); + function semDelete (Sem : SEM_ID) return int; + pragma Import (C, semDelete, "semDelete"); + function Task_Cont (tid : t_id) return int; pragma Import (C, Task_Cont, "taskResume"); diff --git a/gcc/ada/s-vxwext.ads b/gcc/ada/s-vxwext.ads index dc23cd26d07..bc458395c8b 100644 --- a/gcc/ada/s-vxwext.ads +++ b/gcc/ada/s-vxwext.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2009, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,6 +36,9 @@ with Interfaces.C; package System.VxWorks.Ext is pragma Preelaborate; + subtype SEM_ID is Long_Integer; + -- typedef struct semaphore *SEM_ID; + type t_id is new Long_Integer; subtype int is Interfaces.C.int; @@ -60,6 +63,9 @@ package System.VxWorks.Ext is (intNum : int) return Interrupt_Vector; pragma Import (C, Interrupt_Number_To_Vector, "__gnat_inum_to_ivec"); + function semDelete (Sem : SEM_ID) return int; + pragma Import (C, semDelete, "semDelete"); + function Task_Cont (tid : t_id) return int; pragma Import (C, Task_Cont, "taskResume"); diff --git a/gcc/ada/s-wchcnv.adb b/gcc/ada/s-wchcnv.adb index bb806f08aa5..893232e605a 100644 --- a/gcc/ada/s-wchcnv.adb +++ b/gcc/ada/s-wchcnv.adb @@ -284,6 +284,14 @@ package body System.WCh_Cnv is U : Unsigned_32; begin + -- Raise CE for invalid UTF_32_Code + + if not Val'Valid then + raise Constraint_Error; + end if; + + -- Processing depends on encoding mode + case EM is when WCEM_Hex => @@ -425,10 +433,6 @@ package body System.WCh_Cnv is if Val > 16#FFFF# then if Val > 16#00FF_FFFF# then - if Val > 16#7FFF_FFFF# then - raise Constraint_Error; - end if; - Out_Char (Hexc (Val / 16 ** 7)); Out_Char (Hexc ((Val / 16 ** 6) mod 16)); end if; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 047460442fb..dad352b03d4 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1514,9 +1514,9 @@ package body Sem is -- Calls Action, with some validity checks procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id); - -- Calls Do_Action, first on the units with'ed by this one, then on this - -- unit. If it's an instance body, do the spec first. If it's an - -- instance spec, do the body last. + -- Calls Do_Action, first on the units with'ed by this one, then on + -- this unit. If it's an instance body, do the spec first. If it is + -- an instance spec, do the body last. --------------- -- Do_Action -- @@ -1530,20 +1530,30 @@ package body Sem is pragma Assert (No (CU) or else Nkind (CU) = N_Compilation_Unit); case Nkind (Item) is - when N_Generic_Subprogram_Declaration | - N_Generic_Package_Declaration | - N_Package_Declaration | - N_Subprogram_Declaration | - N_Subprogram_Renaming_Declaration | - N_Package_Renaming_Declaration | - N_Generic_Function_Renaming_Declaration | - N_Generic_Package_Renaming_Declaration | - N_Generic_Procedure_Renaming_Declaration => - null; -- Specs are OK + when N_Generic_Subprogram_Declaration | + N_Generic_Package_Declaration | + N_Package_Declaration | + N_Subprogram_Declaration | + N_Subprogram_Renaming_Declaration | + N_Package_Renaming_Declaration | + N_Generic_Function_Renaming_Declaration | + N_Generic_Package_Renaming_Declaration | + N_Generic_Procedure_Renaming_Declaration => + + -- Specs are OK - when N_Package_Body | N_Subprogram_Body => + null; + + when N_Package_Body => + + -- Package bodies are processed immediately after the + -- corresponding spec. + + null; + + when N_Subprogram_Body => - -- A body must be the main unit + -- A subprogram body must be the main unit pragma Assert (Acts_As_Spec (CU) or else CU = Cunit (Main_Unit)); @@ -1551,9 +1561,9 @@ package body Sem is -- All other cases cannot happen - when N_Function_Instantiation | - N_Procedure_Instantiation | - N_Package_Instantiation => + when N_Function_Instantiation | + N_Procedure_Instantiation | + N_Package_Instantiation => pragma Assert (False, "instantiation"); null; @@ -1590,13 +1600,13 @@ package body Sem is begin if not Done (Get_Cunit_Unit_Number (Withed_Unit)) then if not Nkind_In - (Unit (Withed_Unit), N_Package_Body, - N_Subprogram_Body) + (Unit (Withed_Unit), + N_Generic_Package_Declaration, + N_Package_Body, + N_Subprogram_Body) then Write_Unit_Name - (Unit_Name - (Get_Cunit_Unit_Number - (Withed_Unit))); + (Unit_Name (Get_Cunit_Unit_Number (Withed_Unit))); Write_Str (" not yet walked!"); if Get_Cunit_Unit_Number (Withed_Unit) = Unit_Num then @@ -1716,15 +1726,25 @@ package body Sem is -- processing of the body of a unit named by pragma Extend_System, -- because it has cyclic dependences in some cases. - if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then + -- A body that is not the main unit is present because of inlining + -- and/or instantiations, and it is best to process a body as early + -- as possible after the spec (as if an Elaborate_Body were present). + -- Currently all such bodies are added to the units list. It might + -- be possible to restrict the list to those bodies that are used + -- in the main unit. Possible optimization ??? + + if Nkind (Item) = N_Package_Declaration then declare Body_Unit : constant Node_Id := Library_Unit (CU); + begin if Present (Body_Unit) and then Body_Unit /= Cunit (Main_Unit) and then Unit_Num /= Get_Source_Unit (System_Aux_Id) then Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit)); + Do_Action (Body_Unit, Unit (Body_Unit)); + Done (Get_Cunit_Unit_Number (Body_Unit)) := True; end if; end; end if; @@ -1746,6 +1766,10 @@ package body Sem is Do_Action (Empty, Standard_Package_Node); + -- First place the context of all instance bodies on the corresponding + -- spec, because it may be needed to analyze the code at the place of + -- the instantiation. + Cur := First_Elmt (Comp_Unit_List); while Present (Cur) loop declare @@ -1753,50 +1777,36 @@ package body Sem is N : constant Node_Id := Unit (CU); begin - pragma Assert (Nkind (CU) = N_Compilation_Unit); - - case Nkind (N) is - - -- If it's a body, then ignore it, unless it's an instance (in - -- which case we do the spec), or it's the main unit (in which - -- case we do it). Note that it could be both, in which case we - -- do the with_clauses of spec and body first, + if Nkind (N) = N_Package_Body + and then Is_Generic_Instance (Defining_Entity (N)) + then + Append_List + (Context_Items (CU), Context_Items (Library_Unit (CU))); + end if; - when N_Package_Body | N_Subprogram_Body => - declare - Entity : Node_Id := N; + Next_Elmt (Cur); + end; + end loop; - begin - if Nkind (Entity) = N_Subprogram_Body then - Entity := Specification (Entity); - end if; + -- Now traverse compilation units in order. - Entity := Defining_Unit_Name (Entity); + Cur := First_Elmt (Comp_Unit_List); + while Present (Cur) loop + declare + CU : constant Node_Id := Node (Cur); + N : constant Node_Id := Unit (CU); - if Nkind (Entity) not in N_Entity then + begin + pragma Assert (Nkind (CU) = N_Compilation_Unit); - -- Must be N_Defining_Program_Unit_Name + case Nkind (N) is - Entity := Defining_Identifier (Entity); - end if; + -- If it's a body, then ignore it, unless it's the main unit + -- Otherwise bodies appear in the list because of inlining or + -- instantiations, and they are processed immediately after + -- the corresponding specs. - if Is_Generic_Instance (Entity) then - declare - Spec_Unit : constant Node_Id := Library_Unit (CU); - - begin - -- Move context of body to that of spec, so it - -- appears before the spec itself, in case it - -- contains nested instances that generate late - -- with_clauses that got attached to the body. - - Append_List - (Context_Items (CU), Context_Items (Spec_Unit)); - Do_Unit_And_Dependents - (Spec_Unit, Unit (Spec_Unit)); - end; - end if; - end; + when N_Package_Body | N_Subprogram_Body => if CU = Cunit (Main_Unit) then Do_Unit_And_Dependents (CU, N); diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index a1873e86def..7d14962318c 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -248,17 +248,18 @@ package Sem is -- be available at the freeze point. In_Inlined_Body : Boolean := False; - -- Switch to indicate that we are analyzing and resolving an inlined - -- body. Type checking is disabled in this context, because types are - -- known to be compatible. This avoids problems with private types whose - -- full view is derived from private types. + -- Switch to indicate that we are analyzing and resolving an inlined body. + -- Type checking is disabled in this context, because types are known to be + -- compatible. This avoids problems with private types whose full view is + -- derived from private types. Inside_A_Generic : Boolean := False; - -- This flag is set if we are processing a generic specification, - -- generic definition, or generic body. When this flag is True the - -- Expander_Active flag is False to disable any code expansion (see - -- package Expander). Only the generic processing can modify the - -- status of this flag, any other client should regard it as read-only. + -- This flag is set if we are processing a generic specification, generic + -- definition, or generic body. When this flag is True the Expander_Active + -- flag is False to disable any code expansion (see package Expander). Only + -- the generic processing can modify the status of this flag, any other + -- client should regard it as read-only. + -- Probably should be called Inside_A_Generic_Template ??? Inside_Freezing_Actions : Nat := 0; -- Flag indicating whether we are within a call to Expand_N_Freeze_Actions. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index b84cf1ea8d1..a3f7cde4814 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4360,7 +4360,7 @@ package body Sem_Ch12 is Old_Main : constant Entity_Id := Cunit_Entity (Main_Unit); begin - -- A new compilation unit node is built for the instance declaration. + -- A new compilation unit node is built for the instance declaration Decl_Cunit := Make_Compilation_Unit (Sloc (N), @@ -8562,6 +8562,9 @@ package body Sem_Ch12 is Parent_Installed : Boolean := False; Save_Style_Check : constant Boolean := Style_Check; + Par_Ent : Entity_Id := Empty; + Par_Vis : Boolean := False; + begin Gen_Body_Id := Corresponding_Body (Gen_Decl); @@ -8637,11 +8640,15 @@ package body Sem_Ch12 is if Ekind (Scope (Gen_Unit)) = E_Generic_Package and then Nkind (Gen_Id) = N_Expanded_Name then - Install_Parent (Entity (Prefix (Gen_Id)), In_Body => True); + Par_Ent := Entity (Prefix (Gen_Id)); + Par_Vis := Is_Immediately_Visible (Par_Ent); + Install_Parent (Par_Ent, In_Body => True); Parent_Installed := True; elsif Is_Child_Unit (Gen_Unit) then - Install_Parent (Scope (Gen_Unit), In_Body => True); + Par_Ent := Scope (Gen_Unit); + Par_Vis := Is_Immediately_Visible (Par_Ent); + Install_Parent (Par_Ent, In_Body => True); Parent_Installed := True; end if; @@ -8712,6 +8719,10 @@ package body Sem_Ch12 is if Parent_Installed then Remove_Parent (In_Body => True); + + -- Restore the previous visibility of the parent + + Set_Is_Immediately_Visible (Par_Ent, Par_Vis); end if; Restore_Private_Views (Act_Decl_Id); @@ -8806,6 +8817,9 @@ package body Sem_Ch12 is Parent_Installed : Boolean := False; Save_Style_Check : constant Boolean := Style_Check; + Par_Ent : Entity_Id := Empty; + Par_Vis : Boolean := False; + begin Gen_Body_Id := Corresponding_Body (Gen_Decl); @@ -8909,11 +8923,15 @@ package body Sem_Ch12 is if Ekind (Scope (Gen_Unit)) = E_Generic_Package and then Nkind (Gen_Id) = N_Expanded_Name then - Install_Parent (Entity (Prefix (Gen_Id)), In_Body => True); + Par_Ent := Entity (Prefix (Gen_Id)); + Par_Vis := Is_Immediately_Visible (Par_Ent); + Install_Parent (Par_Ent, In_Body => True); Parent_Installed := True; elsif Is_Child_Unit (Gen_Unit) then - Install_Parent (Scope (Gen_Unit), In_Body => True); + Par_Ent := Scope (Gen_Unit); + Par_Vis := Is_Immediately_Visible (Par_Ent); + Install_Parent (Par_Ent, In_Body => True); Parent_Installed := True; end if; @@ -8994,6 +9012,10 @@ package body Sem_Ch12 is if Parent_Installed then Remove_Parent (In_Body => True); + + -- Restore the previous visibility of the parent + + Set_Is_Immediately_Visible (Par_Ent, Par_Vis); end if; Restore_Env; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 89cfbb66cb6..11bb5ed998e 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -977,6 +977,21 @@ package body Sem_Ch13 is Set_Has_Delayed_Freeze (U_Ent); + -- If an initialization call has been generated for this + -- object, it needs to be deferred to after the freeze node + -- we have just now added, otherwise GIGI will see a + -- reference to the variable (as actual to the IP call) + -- before its definition. + + declare + Init_Call : constant Node_Id := Find_Init_Call (U_Ent, N); + begin + if Present (Init_Call) then + Remove (Init_Call); + Append_Freeze_Action (U_Ent, Init_Call); + end if; + end; + if Is_Exported (U_Ent) then Error_Msg_N ("& cannot be exported if an address clause is given", diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index cb66334fc45..dcc8736d79d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15322,8 +15322,10 @@ package body Sem_Ch3 is -- N_Type_Conversion node to force displacement of the pointer to -- reference the component containing the secondary dispatch table. -- Otherwise a type conversion is not a legal context. + -- A return statement for a build-in-place function returning a + -- synchronized type also introduces an unchecked conversion. - when N_Type_Conversion => + when N_Type_Conversion | N_Unchecked_Type_Conversion => return not Comes_From_Source (Exp) and then OK_For_Limited_Init_In_05 (Expression (Original_Node (Exp))); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index b51128705ae..b1f202c3652 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2685,11 +2685,18 @@ package body Sem_Ch6 is New_Overloaded_Entity (Designator); Check_Delayed_Subprogram (Designator); - -- If the type of the first formal of the current subprogram is a non - -- generic tagged private type , mark the subprogram as being a private - -- primitive. + -- If the type of the first formal of the current subprogram is a + -- nongeneric tagged private type, mark the subprogram as being a + -- private primitive. Ditto if this is a function with controlling + -- result, and the return type is currently private. + + if Has_Controlling_Result (Designator) + and then Is_Private_Type (Etype (Designator)) + and then not Is_Generic_Actual_Type (Etype (Designator)) + then + Set_Is_Private_Primitive (Designator); - if Present (First_Formal (Designator)) then + elsif Present (First_Formal (Designator)) then declare Formal_Typ : constant Entity_Id := Etype (First_Formal (Designator)); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 8ddefb58af0..4063b12397e 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3694,6 +3694,7 @@ package body Sem_Ch8 is procedure Nvis_Messages is Comp_Unit : Node_Id; Ent : Entity_Id; + Found : Boolean := False; Hidden : Boolean := False; Item : Node_Id; @@ -3781,10 +3782,25 @@ package body Sem_Ch8 is if Is_Hidden (Ent) then Error_Msg_N ("non-visible (private) declaration#!", N); + + -- If the entity is declared in a generic package, it + -- cannot be visible, so there is no point in adding it + -- to the list of candidates if another homograph from a + -- non-generic package has been seen. + + elsif Ekind (Scope (Ent)) = E_Generic_Package + and then Found + then + null; + else Error_Msg_N -- CODEFIX ("non-visible declaration#!", N); + if Ekind (Scope (Ent)) /= E_Generic_Package then + Found := True; + end if; + if Is_Compilation_Unit (Ent) and then Nkind (Parent (Parent (N))) = N_Use_Package_Clause diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 7c69da1ade1..9a0f878aa8a 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -301,11 +301,74 @@ package body Sem_Disp is -- If a controlling formal has a statically tagged actual, the tag of -- this actual is to be used for any tag-indeterminate actual. + procedure Check_Direct_Call; + -- In the case when the controlling actual is a class-wide type whose + -- root type's completion is a task or protected type, the call is in + -- fact direct. This routine detects the above case and modifies the + -- call accordingly. + procedure Check_Dispatching_Context; -- If the call is tag-indeterminate and the entity being called is -- abstract, verify that the context is a call that will eventually -- provide a tag for dispatching, or has provided one already. + ----------------------- + -- Check_Direct_Call -- + ----------------------- + + procedure Check_Direct_Call is + Typ : Entity_Id := Etype (Control); + + begin + if Is_Class_Wide_Type (Typ) then + Typ := Root_Type (Typ); + end if; + + -- Detect whether the controlling type is a private type completed + -- by a task or protected type. + + if Is_Private_Type (Typ) + and then Present (Full_View (Typ)) + and then Is_Concurrent_Type (Full_View (Typ)) + and then Present (Corresponding_Record_Type (Full_View (Typ))) + then + Typ := Corresponding_Record_Type (Full_View (Typ)); + + -- The concurrent record's list of primitives should contain a + -- wrapper for the entity of the call, retrieve it. + + declare + Prim : Entity_Id; + Prim_Elmt : Elmt_Id; + Wrapper_Found : Boolean := False; + + begin + Prim_Elmt := First_Elmt (Primitive_Operations (Typ)); + while Present (Prim_Elmt) loop + Prim := Node (Prim_Elmt); + + if Is_Primitive_Wrapper (Prim) + and then Wrapped_Entity (Prim) = Subp_Entity + then + Wrapper_Found := True; + exit; + end if; + + Next_Elmt (Prim_Elmt); + end loop; + + -- A primitive declared between two views should have a + -- corresponding wrapper. + + pragma Assert (Wrapper_Found); + + -- Modify the call by setting the proper entity + + Set_Entity (Name (N), Prim); + end; + end if; + end Check_Direct_Call; + ------------------------------- -- Check_Dispatching_Context -- ------------------------------- @@ -484,6 +547,11 @@ package body Sem_Disp is Set_Controlling_Argument (N, Control); Check_Restriction (No_Dispatching_Calls, N); + -- The dispatching call may need to be converted into a direct + -- call in certain cases. + + Check_Direct_Call; + -- If there is a statically tagged actual and a tag-indeterminate -- call to a function of the ancestor (such as that provided by a -- default), then treat this as a dispatching call and propagate diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 34065991103..60a07322dc4 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1460,18 +1460,18 @@ package body Sem_Elab is Process_Init_Proc : declare Unit_Decl : constant Node_Id := Unit_Declaration_Node (Ent); - function Find_Init_Call (Nod : Node_Id) return Traverse_Result; + function Check_Init_Call (Nod : Node_Id) return Traverse_Result; -- Find subprogram calls within body of Init_Proc for Traverse -- instantiation below. - procedure Traverse_Body is new Traverse_Proc (Find_Init_Call); + procedure Traverse_Body is new Traverse_Proc (Check_Init_Call); -- Traversal procedure to find all calls with body of Init_Proc - -------------------- - -- Find_Init_Call -- - -------------------- + --------------------- + -- Check_Init_Call -- + --------------------- - function Find_Init_Call (Nod : Node_Id) return Traverse_Result is + function Check_Init_Call (Nod : Node_Id) return Traverse_Result is Func : Entity_Id; begin @@ -1491,7 +1491,7 @@ package body Sem_Elab is else return OK; end if; - end Find_Init_Call; + end Check_Init_Call; -- Start of processing for Process_Init_Proc diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index b659853ae11..19abf4b3672 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -194,6 +194,12 @@ package body Sem_Eval is -- call to Check_Non_Static_Context on the operand. If Fold is False on -- return, then all processing is complete, and the caller should -- return, since there is nothing else to do. + -- + -- If Stat is set True on return, then Is_Static_Expression is also set + -- true in node N. There are some cases where this is over-enthusiastic, + -- e.g. in the two operand case below, for string comaprison, the result + -- is not static even though the two operands are static. In such cases, + -- the caller must reset the Is_Static_Expression flag in N. procedure Test_Expression_Is_Foldable (N : Node_Id; @@ -393,8 +399,8 @@ package body Sem_Eval is Assume_Valid : Boolean; Rec : Boolean := False) return Compare_Result is - Ltyp : Entity_Id := Etype (L); - Rtyp : Entity_Id := Etype (R); + Ltyp : Entity_Id := Underlying_Type (Etype (L)); + Rtyp : Entity_Id := Underlying_Type (Etype (R)); -- These get reset to the base type for the case of entities where -- Is_Known_Valid is not set. This takes care of handling possible -- invalid representations using the value of the base type, in @@ -683,23 +689,46 @@ package body Sem_Eval is if L = R then return EQ; - -- If expressions have no types, then do not attempt to determine - -- if they are the same, since something funny is going on. One - -- case in which this happens is during generic template analysis, - -- when bounds are not fully analyzed. + -- If expressions have no types, then do not attempt to determine if + -- they are the same, since something funny is going on. One case in + -- which this happens is during generic template analysis, when bounds + -- are not fully analyzed. elsif No (Ltyp) or else No (Rtyp) then return Unknown; - -- We only attempt compile time analysis for scalar values, and - -- not for packed arrays represented as modular types, where the - -- semantics of comparison is quite different. + -- We do not attempt comparisons for packed arrays arrays represented as + -- modular types, where the semantics of comparison is quite different. - elsif not Is_Scalar_Type (Ltyp) - or else Is_Packed_Array_Type (Ltyp) + elsif Is_Packed_Array_Type (Ltyp) + and then Is_Modular_Integer_Type (Ltyp) then return Unknown; + -- For access types, the only time we know the result at compile time + -- (apart from identical operands, which we handled already, is if we + -- know one operand is null and the other is not, or both operands are + -- known null. + + elsif Is_Access_Type (Ltyp) then + if Known_Null (L) then + if Known_Null (R) then + return EQ; + elsif Known_Non_Null (R) then + return NE; + else + return Unknown; + end if; + + elsif Known_Non_Null (L) + and then Known_Null (R) + then + return NE; + + else + return Unknown; + end if; + -- Case where comparison involves two compile time known values elsif Compile_Time_Known_Value (L) @@ -728,8 +757,42 @@ package body Sem_Eval is end if; end; - -- For the integer case we know exactly (note that this includes the - -- fixed-point case, where we know the run time integer values now) + -- For string types, we have two string literals and we proceed to + -- compare them using the Ada style dictionary string comparison. + + elsif not Is_Scalar_Type (Ltyp) then + declare + Lstring : constant String_Id := Strval (Expr_Value_S (L)); + Rstring : constant String_Id := Strval (Expr_Value_S (R)); + Llen : constant Nat := String_Length (Lstring); + Rlen : constant Nat := String_Length (Rstring); + + begin + for J in 1 .. Nat'Min (Llen, Rlen) loop + declare + LC : constant Char_Code := Get_String_Char (Lstring, J); + RC : constant Char_Code := Get_String_Char (Rstring, J); + begin + if LC < RC then + return LT; + elsif LC > RC then + return GT; + end if; + end; + end loop; + + if Llen < Rlen then + return LT; + elsif Llen > Rlen then + return GT; + else + return EQ; + end if; + end; + + -- For remaining scalar cases we know exactly (note that this does + -- include the fixed-point case, where we know the run time integer + -- values now) else declare @@ -754,12 +817,36 @@ package body Sem_Eval is -- Cases where at least one operand is not known at compile time else - -- Remaining checks apply only for non-generic discrete types + -- Remaining checks apply only for discrete types if not Is_Discrete_Type (Ltyp) or else not Is_Discrete_Type (Rtyp) - or else Is_Generic_Type (Ltyp) - or else Is_Generic_Type (Rtyp) + then + return Unknown; + end if; + + -- Defend against generic types, or actually any expressions that + -- contain a reference to a generic type from within a generic + -- template. We don't want to do any range analysis of such + -- expressions for two reasons. First, the bounds of a generic type + -- itself are junk and cannot be used for any kind of analysis. + -- Second, we may have a case where the range at run time is indeed + -- known, but we don't want to do compile time analysis in the + -- template based on that range since in an instance the value may be + -- static, and able to be elaborated without reference to the bounds + -- of types involved. As an example, consider: + + -- (F'Pos (F'Last) + 1) > Integer'Last + + -- The expression on the left side of > is Universal_Integer and thus + -- acquires the type Integer for evaluation at run time, and at run + -- time it is true that this condition is always False, but within + -- an instance F may be a type with a static range greater than the + -- range of Integer, and the expression statically evaluates to True. + + if References_Generic_Formal_Type (L) + or else + References_Generic_Formal_Type (R) then return Unknown; end if; @@ -770,11 +857,11 @@ package body Sem_Eval is if not Assume_Valid and then not Assume_No_Invalid_Values then if Is_Entity_Name (L) and then not Is_Known_Valid (Entity (L)) then - Ltyp := Base_Type (Ltyp); + Ltyp := Underlying_Type (Base_Type (Ltyp)); end if; if Is_Entity_Name (R) and then not Is_Known_Valid (Entity (R)) then - Rtyp := Base_Type (Rtyp); + Rtyp := Underlying_Type (Base_Type (Rtyp)); end if; end if; @@ -821,7 +908,7 @@ package body Sem_Eval is -- attempt this optimization with generic types, since the type -- bounds may not be meaningful in this case. - -- We are in danger of an infinite recursion here. It does not seem + -- We are in danger of an infinite recursion here. It does not seem -- useful to go more than one level deep, so the parameter Rec is -- used to protect ourselves against this infinite recursion. @@ -829,46 +916,51 @@ package body Sem_Eval is -- See if we can get a decisive check against one operand and -- a bound of the other operand (four possible tests here). + -- Note that we avoid testing junk bounds of a generic type. + + if not Is_Generic_Type (Rtyp) then + case Compile_Time_Compare (L, Type_Low_Bound (Rtyp), + Discard'Access, + Assume_Valid, Rec => True) + is + when LT => return LT; + when LE => return LE; + when EQ => return LE; + when others => null; + end case; - case Compile_Time_Compare (L, Type_Low_Bound (Rtyp), - Discard'Access, - Assume_Valid, Rec => True) - is - when LT => return LT; - when LE => return LE; - when EQ => return LE; - when others => null; - end case; - - case Compile_Time_Compare (L, Type_High_Bound (Rtyp), - Discard'Access, - Assume_Valid, Rec => True) - is - when GT => return GT; - when GE => return GE; - when EQ => return GE; - when others => null; - end case; + case Compile_Time_Compare (L, Type_High_Bound (Rtyp), + Discard'Access, + Assume_Valid, Rec => True) + is + when GT => return GT; + when GE => return GE; + when EQ => return GE; + when others => null; + end case; + end if; - case Compile_Time_Compare (Type_Low_Bound (Ltyp), R, - Discard'Access, - Assume_Valid, Rec => True) - is - when GT => return GT; - when GE => return GE; - when EQ => return GE; - when others => null; - end case; + if not Is_Generic_Type (Ltyp) then + case Compile_Time_Compare (Type_Low_Bound (Ltyp), R, + Discard'Access, + Assume_Valid, Rec => True) + is + when GT => return GT; + when GE => return GE; + when EQ => return GE; + when others => null; + end case; - case Compile_Time_Compare (Type_High_Bound (Ltyp), R, - Discard'Access, - Assume_Valid, Rec => True) - is - when LT => return LT; - when LE => return LE; - when EQ => return LE; - when others => null; - end case; + case Compile_Time_Compare (Type_High_Bound (Ltyp), R, + Discard'Access, + Assume_Valid, Rec => True) + is + when LT => return LT; + when LE => return LE; + when EQ => return LE; + when others => null; + end case; + end if; end if; -- Next attempt is to decompose the expressions to extract @@ -1053,6 +1145,15 @@ package body Sem_Eval is Indx := First_Index (T); while Present (Indx) loop Typ := Underlying_Type (Etype (Indx)); + + -- Never look at junk bounds of a generic type + + if Is_Generic_Type (Typ) then + return False; + end if; + + -- Otherwise check bounds for compile time known + if not Compile_Time_Known_Value (Type_Low_Bound (Typ)) then return False; elsif not Compile_Time_Known_Value (Type_High_Bound (Typ)) then @@ -2395,7 +2496,8 @@ package body Sem_Eval is ------------------------ -- Relational operations are static functions, so the result is static - -- if both operands are static (RM 4.9(7), 4.9(20)). + -- if both operands are static (RM 4.9(7), 4.9(20)), except that for + -- strings, the result is never static, even if the operands are. procedure Eval_Relational_Op (N : Node_Id) is Left : constant Node_Id := Left_Opnd (N); @@ -2597,94 +2699,116 @@ package body Sem_Eval is end Length_Mismatch; end if; - -- Another special case: comparisons of access types, where one or both - -- operands are known to be null, so the result can be determined. - - if Is_Access_Type (Typ) then - if Known_Null (Left) then - if Known_Null (Right) then - Fold_Uint (N, Test (Nkind (N) = N_Op_Eq), False); - Warn_On_Known_Condition (N); - return; - - elsif Known_Non_Null (Right) then - Fold_Uint (N, Test (Nkind (N) = N_Op_Ne), False); - Warn_On_Known_Condition (N); - return; - end if; + -- Test for expression being foldable - elsif Known_Non_Null (Left) then - if Known_Null (Right) then - Fold_Uint (N, Test (Nkind (N) = N_Op_Ne), False); - Warn_On_Known_Condition (N); - return; - end if; - end if; - end if; + Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold); - -- Can only fold if type is scalar (don't fold string ops) + -- Only comparisons of scalars can give static results. In particular, + -- comparisons of strings never yield a static result, even if both + -- operands are static strings. if not Is_Scalar_Type (Typ) then - Check_Non_Static_Context (Left); - Check_Non_Static_Context (Right); - return; - end if; - - -- If not foldable we are done - - Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold); - - if not Fold then - return; + Stat := False; + Set_Is_Static_Expression (N, False); end if; - -- Integer and Enumeration (discrete) type cases + -- For static real type expressions, we cannot use Compile_Time_Compare + -- since it worries about run-time results which are not exact. - if Is_Discrete_Type (Typ) then + if Stat and then Is_Real_Type (Typ) then declare - Left_Int : constant Uint := Expr_Value (Left); - Right_Int : constant Uint := Expr_Value (Right); + Left_Real : constant Ureal := Expr_Value_R (Left); + Right_Real : constant Ureal := Expr_Value_R (Right); begin case Nkind (N) is - when N_Op_Eq => Result := Left_Int = Right_Int; - when N_Op_Ne => Result := Left_Int /= Right_Int; - when N_Op_Lt => Result := Left_Int < Right_Int; - when N_Op_Le => Result := Left_Int <= Right_Int; - when N_Op_Gt => Result := Left_Int > Right_Int; - when N_Op_Ge => Result := Left_Int >= Right_Int; + when N_Op_Eq => Result := (Left_Real = Right_Real); + when N_Op_Ne => Result := (Left_Real /= Right_Real); + when N_Op_Lt => Result := (Left_Real < Right_Real); + when N_Op_Le => Result := (Left_Real <= Right_Real); + when N_Op_Gt => Result := (Left_Real > Right_Real); + when N_Op_Ge => Result := (Left_Real >= Right_Real); when others => raise Program_Error; end case; - Fold_Uint (N, Test (Result), Stat); + Fold_Uint (N, Test (Result), True); end; - -- Real type case + -- For all other cases, we use Compile_Time_Compare to do the compare else - pragma Assert (Is_Real_Type (Typ)); - declare - Left_Real : constant Ureal := Expr_Value_R (Left); - Right_Real : constant Ureal := Expr_Value_R (Right); + CR : constant Compare_Result := + Compile_Time_Compare (Left, Right, Assume_Valid => False); begin + if CR = Unknown then + return; + end if; + case Nkind (N) is - when N_Op_Eq => Result := (Left_Real = Right_Real); - when N_Op_Ne => Result := (Left_Real /= Right_Real); - when N_Op_Lt => Result := (Left_Real < Right_Real); - when N_Op_Le => Result := (Left_Real <= Right_Real); - when N_Op_Gt => Result := (Left_Real > Right_Real); - when N_Op_Ge => Result := (Left_Real >= Right_Real); + when N_Op_Eq => + if CR = EQ then + Result := True; + elsif CR = NE or else CR = GT or else CR = LT then + Result := False; + else + return; + end if; + + when N_Op_Ne => + if CR = NE or else CR = GT or else CR = LT then + Result := True; + elsif CR = EQ then + Result := False; + else + return; + end if; + + when N_Op_Lt => + if CR = LT then + Result := True; + elsif CR = EQ or else CR = GT or else CR = GE then + Result := False; + else + return; + end if; + + when N_Op_Le => + if CR = LT or else CR = EQ or else CR = LE then + Result := True; + elsif CR = GT then + Result := False; + else + return; + end if; + + when N_Op_Gt => + if CR = GT then + Result := True; + elsif CR = EQ or else CR = LT or else CR = LE then + Result := False; + else + return; + end if; + + when N_Op_Ge => + if CR = GT or else CR = EQ or else CR = GE then + Result := True; + elsif CR = LT then + Result := False; + else + return; + end if; when others => raise Program_Error; end case; - - Fold_Uint (N, Test (Result), Stat); end; + + Fold_Uint (N, Test (Result), Stat); end if; Warn_On_Known_Condition (N); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f69fcda99eb..ea43c9135c4 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2802,8 +2802,7 @@ package body Sem_Prag is end if; if Warn_On_Export_Import and then Is_Exported (Def_Id) then - Error_Msg_N - ("?duplicate Export_Object pragma", N); + Error_Msg_N ("?duplicate Export_Object pragma", N); else Set_Exported (Def_Id, Arg_Internal); end if; @@ -2843,8 +2842,8 @@ package body Sem_Prag is ("?duplicate Import_Object pragma", N); -- Check for explicit initialization present. Note that an - -- initialization that generated by the code generator, e.g. - -- for an access type, does not count here. + -- initialization generated by the code generator, e.g. for an + -- access type, does not count here. elsif Present (Expression (Parent (Def_Id))) and then @@ -3141,12 +3140,10 @@ package body Sem_Prag is Formal := First_Formal (Ent); if No (Formal) then - Error_Pragma - ("at least one parameter required for pragma%"); + Error_Pragma ("at least one parameter required for pragma%"); elsif Ekind (Formal) /= E_Out_Parameter then - Error_Pragma - ("first parameter must have mode out for pragma%"); + Error_Pragma ("first parameter must have mode out for pragma%"); else Set_Is_Valued_Procedure (Ent); diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads index a4986fc6192..879432435fd 100644 --- a/gcc/ada/sem_type.ads +++ b/gcc/ada/sem_type.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -55,12 +55,12 @@ package Sem_Type is -- Corresponding to the set of interpretations for a given overloadable -- identifier, there is a set of possible types corresponding to the types -- that the overloaded call may return. We keep a 1-to-1 correspondence - -- between interpretations and types: for user-defined subprograms the - -- type is the declared return type. For operators, the type is determined - -- by the type of the arguments. If the arguments themselves are - -- overloaded, we enter the operator name in the names table for each - -- possible result type. In most cases, arguments are not overloaded and - -- only one interpretation is present anyway. + -- between interpretations and types: for user-defined subprograms the type + -- is the declared return type. For operators, the type is determined by + -- the type of the arguments. If the arguments themselves are overloaded, + -- we enter the operator name in the names table for each possible result + -- type. In most cases, arguments are not overloaded and only one + -- interpretation is present anyway. type Interp is record Nam : Entity_Id; @@ -97,23 +97,22 @@ package Sem_Type is -- Invoked by gnatf when processing multiple files procedure Collect_Interps (N : Node_Id); - -- Invoked when the name N has more than one visible interpretation. - -- This is the high level routine which accumulates the possible - -- interpretations of the node. The first meaning and type of N have - -- already been stored in N. If the name is an expanded name, the homonyms - -- are only those that belong to the same scope. + -- Invoked when the name N has more than one visible interpretation. This + -- is the high level routine which accumulates the possible interpretations + -- of the node. The first meaning and type of N have already been stored + -- in N. If the name is an expanded name, the homonyms are only those that + -- belong to the same scope. function Is_Invisible_Operator (N : Node_Id; T : Entity_Id) return Boolean; - -- Check whether a predefined operation with universal operands appears - -- in a context in which the operators of the expected type are not - -- visible. + -- Check whether a predefined operation with universal operands appears in + -- a context in which the operators of the expected type are not visible. procedure List_Interps (Nam : Node_Id; Err : Node_Id); - -- List candidate interpretations of an overloaded name. Used for - -- various error reports. + -- List candidate interpretations of an overloaded name. Used for various + -- error reports. procedure Add_One_Interp (N : Node_Id; @@ -121,13 +120,13 @@ package Sem_Type is T : Entity_Id; Opnd_Type : Entity_Id := Empty); -- Add (E, T) to the list of interpretations of the node being resolved. - -- For calls and operators, i.e. for nodes that have a name field, - -- E is an overloadable entity, and T is its type. For constructs such - -- as indexed expressions, the caller sets E equal to T, because the - -- overloading comes from other fields, and the node itself has no name - -- to resolve. Hidden denotes whether an interpretation has been disabled - -- by an abstract operator. Add_One_Interp includes semantic processing to - -- deal with adding entries that hide one another etc. + -- For calls and operators, i.e. for nodes that have a name field, E is an + -- overloadable entity, and T is its type. For constructs such as indexed + -- expressions, the caller sets E equal to T, because the overloading comes + -- from other fields, and the node itself has no name to resolve. Hidden + -- denotes whether an interpretation has been disabled by an abstract + -- operator. Add_One_Interp includes semantic processing to deal with + -- adding entries that hide one another etc. -- For operators, the legality of the operation depends on the visibility -- of T and its scope. If the operator is an equality or comparison, T is @@ -166,10 +165,9 @@ package Sem_Type is -- New_N, its new copy. It has no effect in the non-overloaded case. function Covers (T1, T2 : Entity_Id) return Boolean; - -- This is the basic type compatibility routine. T1 is the expected - -- type, imposed by context, and T2 is the actual type. The processing - -- reflects both the definition of type coverage and the rules - -- for operand matching. + -- This is the basic type compatibility routine. T1 is the expected type, + -- imposed by context, and T2 is the actual type. The processing reflects + -- both the definition of type coverage and the rules for operand matching. function Disambiguate (N : Node_Id; @@ -188,24 +186,24 @@ package Sem_Type is -- opposed to an operator, type and mode conformance are required. function Find_Unique_Type (L : Node_Id; R : Node_Id) return Entity_Id; - -- Used in second pass of resolution, for equality and comparison nodes. - -- L is the left operand, whose type is known to be correct, and R is - -- the right operand, which has one interpretation compatible with that - -- of L. Return the type intersection of the two. + -- Used in second pass of resolution, for equality and comparison nodes. L + -- is the left operand, whose type is known to be correct, and R is the + -- right operand, which has one interpretation compatible with that of L. + -- Return the type intersection of the two. function Has_Compatible_Type (N : Node_Id; Typ : Entity_Id) return Boolean; - -- Verify that some interpretation of the node N has a type compatible - -- with Typ. If N is not overloaded, then its unique type must be - -- compatible with Typ. Otherwise iterate through the interpretations - -- of N looking for a compatible one. + -- Verify that some interpretation of the node N has a type compatible with + -- Typ. If N is not overloaded, then its unique type must be compatible + -- with Typ. Otherwise iterate through the interpretations of N looking for + -- a compatible one. function Hides_Op (F : Entity_Id; Op : Entity_Id) return Boolean; - -- A user-defined function hides a predefined operator if it is - -- matches the signature of the operator, and is declared in an - -- open scope, or in the scope of the result type. + -- A user-defined function hides a predefined operator if it is matches the + -- signature of the operator, and is declared in an open scope, or in the + -- scope of the result type. function Interface_Present_In_Ancestor (Typ : Entity_Id; @@ -241,15 +239,15 @@ package Sem_Type is -- real type, or a one dimensional array with a discrete component type. function Valid_Boolean_Arg (T : Entity_Id) return Boolean; - -- A valid argument of a boolean operator is either some boolean type, - -- or a one-dimensional array of boolean type. + -- A valid argument of a boolean operator is either some boolean type, or a + -- one-dimensional array of boolean type. procedure Write_Interp_Ref (Map_Ptr : Int); - -- Debugging procedure to display entry in Interp_Map. Would not be - -- needed if it were possible to debug instantiations of Table. + -- Debugging procedure to display entry in Interp_Map. Would not be needed + -- if it were possible to debug instantiations of Table. procedure Write_Overloads (N : Node_Id); - -- Debugging procedure to output info on possibly overloaded entities - -- for specified node. + -- Debugging procedure to output info on possibly overloaded entities for + -- specified node. end Sem_Type; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 31f3ccd1a4d..05aadcbd995 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -9482,6 +9482,51 @@ package body Sem_Util is return Token_Node; end Real_Convert; + ------------------------------------ + -- References_Generic_Formal_Type -- + ------------------------------------ + + function References_Generic_Formal_Type (N : Node_Id) return Boolean is + + function Process (N : Node_Id) return Traverse_Result; + -- Process one node in search for generic formal type + + ------------- + -- Process -- + ------------- + + function Process (N : Node_Id) return Traverse_Result is + begin + if Nkind (N) in N_Has_Entity then + declare + E : constant Entity_Id := Entity (N); + begin + if Present (E) then + if Is_Generic_Type (E) then + return Abandon; + elsif Present (Etype (E)) + and then Is_Generic_Type (Etype (E)) + then + return Abandon; + end if; + end if; + end; + end if; + + return Atree.OK; + end Process; + + function Traverse is new Traverse_Func (Process); + -- Traverse tree to look for generic type + + begin + if Inside_A_Generic then + return Traverse (N) = Abandon; + else + return False; + end if; + end References_Generic_Formal_Type; + -------------------- -- Remove_Homonym -- -------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 9e2d3ffcf1e..b4adabf26a9 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1026,6 +1026,10 @@ package Sem_Util is -- S is a possibly signed syntactically valid real literal. The result -- returned is an N_Real_Literal node representing the literal value. + function References_Generic_Formal_Type (N : Node_Id) return Boolean; + -- Returns True if the expression Expr contains any references to a + -- generic type. This can only happen within a generic template. + procedure Remove_Homonym (E : Entity_Id); -- Removes E from the homonym chain diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index 226f3be8592..df3b1206428 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -73,6 +73,7 @@ extern fd_set *__gnat_new_socket_set (fd_set *); extern void __gnat_remove_socket_from_set (fd_set *, int); extern void __gnat_reset_socket_set (fd_set *); extern int __gnat_get_h_errno (void); +extern int __gnat_socket_ioctl (int, int, int *); #if defined (__vxworks) || defined (_WIN32) extern int __gnat_inet_pton (int, const char *, void *); #endif @@ -409,6 +410,17 @@ __gnat_get_h_errno (void) { #endif } +/* Wrapper for ioctl(2), which is a variadic function */ + +int +__gnat_socket_ioctl (int fd, int req, int *arg) { +#if defined (_WIN32) + return ioctlsocket (fd, req, arg); +#else + return ioctl (fd, req, arg); +#endif +} + #ifndef HAVE_INET_PTON #ifdef VMS diff --git a/gcc/ada/system-aix64.ads b/gcc/ada/system-aix64.ads new file mode 100644 index 00000000000..c32125281da --- /dev/null +++ b/gcc/ada/system-aix64.ads @@ -0,0 +1,155 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M -- +-- -- +-- S p e c -- +-- (PPC/AIX64 Version) -- +-- -- +-- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package System is + pragma Pure; + -- Note that we take advantage of the implementation permission to make + -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada + -- 2005, this is Pure in any case (AI-362). + + type Name is (SYSTEM_NAME_GNAT); + System_Name : constant Name := SYSTEM_NAME_GNAT; + + -- System-Dependent Named Numbers + + Min_Int : constant := Long_Long_Integer'First; + Max_Int : constant := Long_Long_Integer'Last; + + Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; + Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; + + Max_Base_Digits : constant := Long_Long_Float'Digits; + Max_Digits : constant := Long_Long_Float'Digits; + + Max_Mantissa : constant := 63; + Fine_Delta : constant := 2.0 ** (-Max_Mantissa); + + Tick : constant := 0.01; + + -- Storage-related Declarations + + type Address is private; + pragma Preelaborable_Initialization (Address); + Null_Address : constant Address; + + Storage_Unit : constant := 8; + Word_Size : constant := 64; + Memory_Size : constant := 2 ** 64; + + -- Address comparison + + function "<" (Left, Right : Address) return Boolean; + function "<=" (Left, Right : Address) return Boolean; + function ">" (Left, Right : Address) return Boolean; + function ">=" (Left, Right : Address) return Boolean; + function "=" (Left, Right : Address) return Boolean; + + pragma Import (Intrinsic, "<"); + pragma Import (Intrinsic, "<="); + pragma Import (Intrinsic, ">"); + pragma Import (Intrinsic, ">="); + pragma Import (Intrinsic, "="); + + -- Other System-Dependent Declarations + + type Bit_Order is (High_Order_First, Low_Order_First); + Default_Bit_Order : constant Bit_Order := High_Order_First; + pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning + + -- Priority-related Declarations (RM D.1) + + -- 0 .. 126 corresponds to the system priority range 1 .. 127. + -- + -- If the scheduling policy is SCHED_FIFO or SCHED_RR the runtime makes use + -- of the entire range provided by the system. + -- + -- If the scheduling policy is SCHED_OTHER the only valid system priority + -- is 1 and that is the only value ever passed to the system, regardless of + -- how priorities are set by user programs. + + Max_Priority : constant Positive := 125; + Max_Interrupt_Priority : constant Positive := 126; + + subtype Any_Priority is Integer range 0 .. 126; + subtype Priority is Any_Priority range 0 .. 125; + subtype Interrupt_Priority is Any_Priority range 126 .. 126; + + Default_Priority : constant Priority := + (Priority'First + Priority'Last) / 2; + +private + + type Address is mod Memory_Size; + Null_Address : constant Address := 0; + + -------------------------------------- + -- System Implementation Parameters -- + -------------------------------------- + + -- These parameters provide information about the target that is used + -- by the compiler. They are in the private part of System, where they + -- can be accessed using the special circuitry in the Targparm unit + -- whose source should be consulted for more detailed descriptions + -- of the individual switch values. + + Backend_Divide_Checks : constant Boolean := False; + Backend_Overflow_Checks : constant Boolean := True; + Command_Line_Args : constant Boolean := True; + Configurable_Run_Time : constant Boolean := False; + Denorm : constant Boolean := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + Preallocated_Stacks : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : constant Boolean := True; + Stack_Check_Limits : constant Boolean := False; + Support_64_Bit_Divides : constant Boolean := True; + Support_Aggregates : constant Boolean := True; + Support_Composite_Assign : constant Boolean := True; + Support_Composite_Compare : constant Boolean := True; + Support_Long_Shifts : constant Boolean := True; + Always_Compatible_Rep : constant Boolean := True; + Suppress_Standard_Library : constant Boolean := False; + Use_Ada_Main_Program_Name : constant Boolean := False; + ZCX_By_Default : constant Boolean := False; + GCC_ZCX_Support : constant Boolean := True; -- Post GCC 4 only + +end System; diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index f4841df6df7..04c3c3864da 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -4892,41 +4892,41 @@ package VMS_Data is -- NODOC (see /SYNTAX_METRICS) S_Metric_Syntax : aliased constant S := "/SYNTAX_METRICS=" & - "ALL_ON " & + "ALL " & "--syntax-all " & - "ALL_OFF " & + "NONE " & "--no-syntax-all " & - "DECLARATIONS_ON " & + "DECLARATIONS " & "--declarations " & - "DECLARATIONS_OFF " & + "NODECLARATIONS " & "--no-declarations " & - "STATEMENTS_ON " & + "STATEMENTS " & "--statements " & - "STATEMENTS_OFF " & + "NOSTATEMENTS " & "--no-statements " & - "PUBLIC_SUBPROGRAMS_ON " & + "PUBLIC_SUBPROGRAMS " & "--public-subprograms " & - "PUBLIC_SUBPROGRAMS_OFF " & + "NOPUBLIC_SUBPROGRAMS " & "--no-public-subprograms " & - "ALL_SUBPROGRAMS_ON " & + "ALL_SUBPROGRAMS " & "--all-subprograms " & - "ALL_SUBPROGRAMS_OFF " & + "NOALL_SUBPROGRAMS " & "--no-all-subprograms " & - "PUBLIC_TYPES_ON " & + "PUBLIC_TYPES " & "--public-types " & - "PUBLIC_TYPES_OFF " & + "NOPUBLIC_TYPES " & "--no-public-types " & - "ALL_TYPES_ON " & + "ALL_TYPES " & "--all-types " & - "ALL_TYPES_OFF " & + "NOALL_TYPES " & "--no-all-types " & - "UNIT_NESTING_ON " & + "UNIT_NESTING " & "--unit-nesting " & - "UNIT_NESTING_OFF " & + "NOUNIT_NESTING " & "--no-unit-nesting " & - "CONSTRUCT_NESTING_ON " & + "CONSTRUCT_NESTING " & "--construct-nesting " & - "CONSTRUCT_NESTING_OFF " & + "NOCONSTRUCT_NESTING " & "--no-construct-nesting"; -- /SYNTAX_METRICS(option, option ...) -- @@ -4937,31 +4937,28 @@ package VMS_Data is -- -- option may be one of the following: -- - -- ALL_ON (D) All the syntax element metrics are computed - -- ALL_OFF None of syntax element metrics is computed - -- DECLARATIONS_ON Compute the total number of declarations - -- DECLARATIONS_OFF Do not compute the total number of - -- declarations - -- STATEMENTS_ON Compute the total number of statements - -- STATEMENTS_OFF Do not compute the total number of - -- statements - -- PUBLIC_SUBPROGRAMS_ON Compute the number of public subprograms - -- PUBLIC_SUBPROGRAMS_OFF Do not compute the number of public - -- subprograms - -- ALL_SUBPROGRAMS_ON Compute the number of all the subprograms - -- ALL_SUBPROGRAMS_OFF Do not compute the number of all the - -- subprograms - -- PUBLIC_TYPES_ON Compute the number of public types - -- PUBLIC_TYPES_OFF Do not compute the number of public types - -- ALL_TYPES_ON Compute the number of all the types - -- ALL_TYPES_OFF Do not compute the number of all the types - -- UNIT_NESTING_ON Compute the maximal program unit nesting - -- level - -- UNIT_NESTING_OFF Do not compute the maximal program unit - -- nesting level - -- CONSTRUCT_NESTING_ON Compute the maximal construct nesting level - -- CONSTRUCT_NESTING_OFF Do not compute the maximal construct nesting - -- level + -- ALL (D) All the syntax element metrics are computed + -- NONE None of syntax element metrics is computed + -- DECLARATIONS Compute the total number of declarations + -- NODECLARATIONS Do not compute the total number of declarations + -- STATEMENTS Compute the total number of statements + -- NOSTATEMENTS Do not compute the total number of statements + -- PUBLIC_SUBPROGRAMS Compute the number of public subprograms + -- NOPUBLIC_SUBPROGRAMS Do not compute the number of public subprograms + -- ALL_SUBPROGRAMS Compute the number of all the subprograms + -- NOALL_SUBPROGRAMS Do not compute the number of all the + -- subprograms + -- PUBLIC_TYPES Compute the number of public types + -- NOPUBLIC_TYPES Do not compute the number of public types + -- ALL_TYPES Compute the number of all the types + -- NOALL_TYPES Do not compute the number of all the types + -- UNIT_NESTING Compute the maximal program unit nesting + -- level + -- NOUNIT_NESTING Do not compute the maximal program unit + -- nesting level + -- CONSTRUCT_NESTING Compute the maximal construct nesting level + -- NOCONSTRUCT_NESTING Do not compute the maximal construct nesting + -- level -- -- All combinations of syntax element metrics options are allowed. @@ -4987,6 +4984,8 @@ package VMS_Data is "!-x,!-nt,!-sfn " & "XML " & "-x " & + "XSD " & + "-xs " & "NO_TEXT " & "-nt " & "SHORT_SOURCE_FILE_NAME " & @@ -5000,6 +4999,9 @@ package VMS_Data is -- DEFAULT (D) Generate the text output only, use full -- argument source names in global information -- XML Generate the output in XML format + -- XSD Generate the output in XML format, and + -- generate an XML schema file that describes + -- the structure of XML metrics report -- NO_TEXT Do not generate the text output (implies XML) -- SHORT_SOURCE_FILE_NAME Use short argument source names in output @@ -5030,37 +5032,37 @@ package VMS_Data is -- NODOC (see /LINE_COUNT_METRICS) S_Metric_Lines : aliased constant S := "/LINE_COUNT_METRICS=" & - "ALL_ON " & + "ALL " & "--lines-all " & - "ALL_OFF " & + "NONE " & "--no-lines-all " & - "ALL_LINES_ON " & + "ALL_LINES " & "--lines " & - "ALL_LINES_OFF " & + "NOALL_LINES " & "--no-lines " & - "CODE_LINES_ON " & + "CODE_LINES " & "--lines-code " & - "CODE_LINES_OFF " & + "NOCODE_LINES " & "--no-lines-code " & - "COMMENT_LINES_ON " & + "COMMENT_LINES " & "--lines-comment " & - "COMMENT_LINES_OFF " & + "NOCOMMENT_LINES " & "--no-lines-comment " & - "CODE_COMMENT_LINES_ON " & + "CODE_COMMENT_LINES " & "--lines-eol-comment " & - "CODE_COMMENT_LINES_OFF " & + "NOCODE_COMMENT_LINES " & "--no-lines-eol-comment " & - "COMMENT_PERCENTAGE_ON " & + "COMMENT_PERCENTAGE " & "--lines-ratio " & - "COMMENT_PERCENTAGE_OFF " & + "NOCOMMENT_PERCENTAGE " & "--no-lines-ratio " & - "BLANK_LINES_ON " & + "BLANK_LINES " & "--lines-blank " & - "BLANK_LINES_OFF " & + "NOBLANK_LINES " & "--no-lines-blank " & - "AVERAGE_BODY_LINES_ON " & + "AVERAGE_BODY_LINES " & "--lines-average " & - "AVERAGE_BODY_LINES_OFF " & + "NOAVERAGE_BODY_LINES " & "--no-lines-average"; -- /LINE_COUNT_METRICS=(option, option ...) @@ -5071,55 +5073,59 @@ package VMS_Data is -- -- option may be one of the following: -- - -- ALL_ON (D) All the line metrics are computed - -- ALL_OFF None of line metrics is computed - -- ALL_LINES_ON All lines are computed - -- ALL_LINES_OFF All lines are not computed - -- CODE_LINES_ON Lines with Ada code are computed - -- CODE_LINES_OFF Lines with Ada code are not computed - -- COMMENT_LINES_ON Comment lines are computed - -- COMMENT_LINES_OFF Comment lines are not computed - -- COMMENT_PERCENTAGE_ON Ratio between comment lines and all the - -- lines containing comments and program code - -- is computed - -- COMMENT_PERCENTAGE_OFF Ratio between comment lines and all the - -- lines containing comments and program code - -- is not computed - -- BLANK_LINES_ON Blank lines are computed - -- BLANK_LINES_OFF Blank lines are not computed - -- AVERAGE_BODY_LINES_ON Average number of code lines in subprogram, - -- task and entry bodies and statement - -- sequences of package bodies is computed - -- AVERAGE_BODY_LINES_OFF Average number of code lines in subprogram, - -- task and entry bodies and statement - -- sequences of package bodies is not computed + -- ALL (D) All the line metrics are computed + -- NONE None of line metrics is computed + -- ALL_LINES All lines are computed + -- NOALL_LINES All lines are not computed + -- CODE_LINES Lines with Ada code are computed + -- NOCODE_LINES Lines with Ada code are not computed + -- COMMENT_LINES Comment lines are computed + -- NOCOMMENT_LINES Comment lines are not computed + -- CODE_COMMENT_LINES Lines containing both code and comment parts + -- are computed + -- NOCODE_COMMENT_LINES Lines containing both code and comment parts + -- are not computed + -- COMMENT_PERCENTAGE Ratio between comment lines and all the lines + -- containing comments and program code is + -- computed + -- NOCOMMENT_PERCENTAGE Ratio between comment lines and all the lines + -- containing comments and program code is not + -- computed + -- BLANK_LINES Blank lines are computed + -- NOBLANK_LINES Blank lines are not computed + -- AVERAGE_BODY_LINES Average number of code lines in subprogram, + -- task and entry bodies and statement sequences + -- of package bodies is computed + -- NOAVERAGE_BODY_LINES Average number of code lines in subprogram, + -- task and entry bodies and statement sequences + -- of package bodies is not computed -- -- All combinations of line metrics options are allowed. S_Metric_Complexity : aliased constant S := "/COMPLEXITY_METRICS=" & - "ALL_ON " & + "ALL " & "--complexity-all " & - "ALL_OFF " & + "NONE " & "--no-complexity-all " & - "CYCLOMATIC_ON " & + "CYCLOMATIC " & "--complexity-cyclomatic " & - "CYCLOMATIC_OFF " & + "NOCYCLOMATIC " & "--no-complexity-cyclomatic "& - "ESSENTIAL_ON " & + "ESSENTIAL " & "--complexity-essential " & - "ESSENTIAL_OFF " & + "NOESSENTIAL " & "--no-complexity-essential " & - "LOOP_NESTING_ON " & + "LOOP_NESTING " & "--loop-nesting " & - "LOOP_NESTING_OFF " & + "NOLOOP_NESTING " & "--no-loop-nesting " & - "AVERAGE_COMPLEXITY_ON " & + "AVERAGE_COMPLEXITY " & "--complexity-average " & - "AVERAGE_COMPLEXITY_OFF " & + "NOAVERAGE_COMPLEXITY " & "--no-complexity-average " & - "EXTRA_EXIT_POINTS_ON " & + "EXTRA_EXIT_POINTS " & "--extra-exit-points " & - "EXTRA_EXIT_POINTS_OFF " & + "NOEXTRA_EXIT_POINTS " & "--no-extra-exit-points"; -- /COMPLEXITY_METRICS=(option, option ...) @@ -5130,44 +5136,43 @@ package VMS_Data is -- -- option may be one of the following: -- - -- ALL_ON (D) All the complexity metrics are computed - -- ALL_OFF None of complexity metrics is computed - -- CYCLOMATIC_ON Compute the McCabe Cyclomatic Complexity - -- CYCLOMATIC_OFF Do not compute the McCabe Cyclomatic - -- Complexity - -- ESSENTIAL_ON Compute the Essential Complexity - -- ESSENTIAL_OFF Do not compute the Essential Complexity - -- LOOP_NESTIMG_ON Compute the maximal loop nesting - -- LOOP_NESTIMG_OFF Do not compute the maximal loop nesting - -- AVERAGE_COMPLEXITY_ON Compute the average complexity for - -- executable bodies - -- AVERAGE_COMPLEXITY_OFF Do not compute the average complexity for - -- executable bodies - -- EXTRA_EXIT_POINTS_ON Compute extra exit points metric - -- EXTRA_EXIT_POINTS_OFF Do not compute extra exit points metric + -- ALL (D) All the complexity metrics are computed + -- NONE None of complexity metrics is computed + -- CYCLOMATIC Compute the McCabe Cyclomatic Complexity + -- NOCYCLOMATIC Do not compute the McCabe Cyclomatic Complexity + -- ESSENTIAL Compute the Essential Complexity + -- NOESSENTIAL Do not compute the Essential Complexity + -- LOOP_NESTING Compute the maximal loop nesting + -- NOLOOP_NESTING Do not compute the maximal loop nesting + -- AVERAGE_COMPLEXITY Compute the average complexity for executable + -- bodies + -- NOAVERAGE_COMPLEXITY Do not compute the average complexity for + -- executable bodies + -- EXTRA_EXIT_POINTS Compute extra exit points metric + -- NOEXTRA_EXIT_POINTS Do not compute extra exit points metric -- -- All combinations of line metrics options are allowed. S_Metric_Coupling : aliased constant S := "/COUPLING_METRICS=" & - "ALL_ON " & + "ALL " & "--coupling-all " & - "ALL_OFF " & + "NONE " & "--no-coupling-all " & - "PACKAGE_EFFERENT_ON " & + "PACKAGE_EFFERENT " & "--package-efferent-coupling " & - "PACKAGE_EFFERENT_OFF " & + "NOPACKAGE_EFFERENT " & "--no-package-efferent-coupling " & - "PACKAGE_AFFERENT_ON " & + "PACKAGE_AFFERENT " & "--package-afferent-coupling " & - "PACKAGE_AFFERENT_OFF " & + "NOPACKAGE_AFFERENT " & "--no-package-afferent-coupling " & - "CATEGORY_EFFERENT_ON " & + "CATEGORY_EFFERENT " & "--category-efferent-coupling " & - "CATEGORY_EFFERENT_OFF " & + "NOCATEGORY_EFFERENT " & "--no-category-efferent-coupling " & - "CATEGORY_AFFERENT_ON " & + "CATEGORY_AFFERENT " & "--category-afferent-coupling " & - "CATEGORY_AFFERENT_OFF " & + "NOCATEGORY_AFFERENT " & "--no-category-afferent-coupling"; -- /COUPLING_METRICS=(option, option ...) @@ -5176,16 +5181,16 @@ package VMS_Data is -- -- option may be one of the following: -- - -- ALL_ON All the coupling metrics are computed - -- ALL_OFF (D) None of coupling metrics is computed - -- PACKAGE_EFFERENT_ON Compute package efferent coupling - -- PACKAGE_EFFERENT_OFF Do not compute package efferent coupling - -- PACKAGE_AFFERENT_ON Compute package afferent coupling - -- PACKAGE_AFFERENT_OFF Do not compute package afferent coupling - -- CATEGORY_EFFERENT_ON Compute category efferent coupling - -- CATEGORY_EFFERENT_OFF Do not compute category efferent coupling - -- CATEGORY_AFFERENT_ON Compute category afferent coupling - -- CATEGORY_AFFERENT_OFF Do not compute category afferent coupling + -- ALL All the coupling metrics are computed + -- NONE (D) None of coupling metrics is computed + -- PACKAGE_EFFERENT Compute package efferent coupling + -- NOPACKAGE_EFFERENT Do not compute package efferent coupling + -- PACKAGE_AFFERENT Compute package afferent coupling + -- NOPACKAGE_AFFERENT Do not compute package afferent coupling + -- CATEGORY_EFFERENT Compute category efferent coupling + -- NOCATEGORY_EFFERENT Do not compute category efferent coupling + -- CATEGORY_AFFERENT Compute category afferent coupling + -- NOCATEGORY_AFFERENT Do not compute category afferent coupling -- -- All combinations of coupling metrics options are allowed. diff --git a/gcc/builtins.c b/gcc/builtins.c index a6d26efa776..e906ef78eae 100644 --- a/gcc/builtins.c +++ b/gcc/builtins.c @@ -1975,6 +1975,8 @@ expand_builtin_mathfn (tree exp, rtx target, rtx subtarget) /* Else fallthrough and expand as rint. */ CASE_FLT_FN (BUILT_IN_RINT): builtin_optab = rint_optab; break; + CASE_FLT_FN (BUILT_IN_SIGNIFICAND): + builtin_optab = significand_optab; break; default: gcc_unreachable (); } @@ -6332,6 +6334,7 @@ expand_builtin (tree exp, rtx target, rtx subtarget, enum machine_mode mode, CASE_FLT_FN (BUILT_IN_ASIN): CASE_FLT_FN (BUILT_IN_ACOS): CASE_FLT_FN (BUILT_IN_ATAN): + CASE_FLT_FN (BUILT_IN_SIGNIFICAND): /* Treat these like sqrt only if unsafe math optimizations are allowed, because of possible accuracy problems. */ if (! flag_unsafe_math_optimizations) diff --git a/gcc/c-decl.c b/gcc/c-decl.c index 4e48bac7f54..8234e0124ea 100644 --- a/gcc/c-decl.c +++ b/gcc/c-decl.c @@ -126,15 +126,6 @@ static GTY(()) struct stmt_tree_s c_stmt_tree; tree c_break_label; tree c_cont_label; -/* True if we are currently parsing the fields of a struct or - union. */ - -static bool in_struct; - -/* A list of types defined in the current struct or union. */ - -static VEC(tree,heap) *struct_types; - /* Linked list of TRANSLATION_UNIT_DECLS for the translation units included in this invocation. Note that the current translation unit is not included in this list. */ @@ -223,7 +214,7 @@ struct GTY((chain_next ("%h.prev"))) c_binding { BOOL_BITFIELD invisible : 1; /* normal lookup should ignore this binding */ BOOL_BITFIELD nested : 1; /* do not set DECL_CONTEXT when popping */ BOOL_BITFIELD inner_comp : 1; /* incomplete array completed in inner scope */ - /* one free bit */ + BOOL_BITFIELD in_struct : 1; /* currently defined as struct field */ location_t locus; /* location for nested bindings */ }; #define B_IN_SCOPE(b1, b2) ((b1)->depth == (b2)->depth) @@ -513,6 +504,34 @@ static bool keep_next_level_flag; static bool next_is_function_body; +/* A VEC of pointers to c_binding structures. */ + +typedef struct c_binding *c_binding_ptr; +DEF_VEC_P(c_binding_ptr); +DEF_VEC_ALLOC_P(c_binding_ptr,heap); + +/* Information that we keep for a struct or union while it is being + parsed. */ + +struct c_struct_parse_info +{ + /* If warn_cxx_compat, a list of types defined within this + struct. */ + VEC(tree,heap) *struct_types; + /* If warn_cxx_compat, a list of field names which have bindings, + and which are defined in this struct, but which are not defined + in any enclosing struct. This is used to clear the in_struct + field of the c_bindings structure. */ + VEC(c_binding_ptr,heap) *fields; + /* If warn_cxx_compat, a list of typedef names used when defining + fields in this struct. */ + VEC(tree,heap) *typedefs_seen; +}; + +/* Information for the struct or union currently being parsed, or + NULL if not parsing a struct or union. */ +static struct c_struct_parse_info *struct_parse_info; + /* Forward declarations. */ static tree lookup_name_in_scope (tree, struct c_scope *); static tree c_make_fname_decl (location_t, tree, int); @@ -588,6 +607,7 @@ bind (tree name, tree decl, struct c_scope *scope, bool invisible, b->invisible = invisible; b->nested = nested; b->inner_comp = 0; + b->in_struct = 0; b->locus = locus; b->u.type = NULL; @@ -4332,6 +4352,14 @@ finish_decl (tree decl, location_t init_loc, tree init, push_cleanup (decl, cleanup, false); } } + + if (warn_cxx_compat + && TREE_CODE (decl) == VAR_DECL + && TREE_READONLY (decl) + && !DECL_EXTERNAL (decl) + && DECL_INITIAL (decl) == NULL_TREE) + warning_at (DECL_SOURCE_LOCATION (decl), OPT_Wc___compat, + "uninitialized const %qD is invalid in C++", decl); } /* Given a parsed parameter declaration, decode it into a PARM_DECL. */ @@ -5875,6 +5903,19 @@ grokdeclarator (const struct c_declarator *declarator, name of a variable. Thus, if it's known before this, die horribly. */ gcc_assert (!DECL_ASSEMBLER_NAME_SET_P (decl)); + if (warn_cxx_compat + && TREE_CODE (decl) == VAR_DECL + && TREE_PUBLIC (decl) + && TREE_STATIC (decl) + && (TREE_CODE (TREE_TYPE (decl)) == RECORD_TYPE + || TREE_CODE (TREE_TYPE (decl)) == UNION_TYPE + || TREE_CODE (TREE_TYPE (decl)) == ENUMERAL_TYPE) + && TYPE_NAME (TREE_TYPE (decl)) == NULL_TREE) + warning_at (DECL_SOURCE_LOCATION (decl), OPT_Wc___compat, + ("non-local variable %qD with anonymous type is " + "questionable in C++"), + decl); + return decl; } } @@ -6276,16 +6317,14 @@ xref_tag (enum tree_code code, tree name) LOC is the location of the struct's definition. CODE says which kind of tag NAME ought to be. - This stores the current value of the file static IN_STRUCT in - *ENCLOSING_IN_STRUCT, and sets IN_STRUCT to true. Similarly, this - sets STRUCT_TYPES in *ENCLOSING_STRUCT_TYPES, and sets STRUCT_TYPES - to an empty vector. The old values are restored in - finish_struct. */ + This stores the current value of the file static STRUCT_PARSE_INFO + in *ENCLOSING_STRUCT_PARSE_INFO, and points STRUCT_PARSE_INFO at a + new c_struct_parse_info structure. The old value of + STRUCT_PARSE_INFO is restored in finish_struct. */ tree start_struct (location_t loc, enum tree_code code, tree name, - bool *enclosing_in_struct, - VEC(tree,heap) **enclosing_struct_types) + struct c_struct_parse_info **enclosing_struct_parse_info) { /* If there is already a tag defined at this scope (as a forward reference), just return it. */ @@ -6333,10 +6372,11 @@ start_struct (location_t loc, enum tree_code code, tree name, C_TYPE_BEING_DEFINED (ref) = 1; TYPE_PACKED (ref) = flag_pack_struct; - *enclosing_in_struct = in_struct; - *enclosing_struct_types = struct_types; - in_struct = true; - struct_types = VEC_alloc(tree, heap, 0); + *enclosing_struct_parse_info = struct_parse_info; + struct_parse_info = XNEW (struct c_struct_parse_info); + struct_parse_info->struct_types = VEC_alloc (tree, heap, 0); + struct_parse_info->fields = VEC_alloc (c_binding_ptr, heap, 0); + struct_parse_info->typedefs_seen = VEC_alloc (tree, heap, 0); /* FIXME: This will issue a warning for a use of a type defined within a statement expr used within sizeof, et. al. This is not @@ -6424,6 +6464,25 @@ grokfield (location_t loc, finish_decl (value, loc, NULL_TREE, NULL_TREE, NULL_TREE); DECL_INITIAL (value) = width; + if (warn_cxx_compat && DECL_NAME (value) != NULL_TREE) + { + /* If we currently have a binding for this field, set the + in_struct field in the binding, so that we warn about lookups + which find it. */ + struct c_binding *b = I_SYMBOL_BINDING (DECL_NAME (value)); + if (b != NULL) + { + /* If the in_struct field is not yet set, push it on a list + to be cleared when this struct is finished. */ + if (!b->in_struct) + { + VEC_safe_push (c_binding_ptr, heap, + struct_parse_info->fields, b); + b->in_struct = 1; + } + } + } + return value; } @@ -6484,25 +6543,80 @@ detect_field_duplicates (tree fieldlist) } } +/* Finish up struct info used by -Wc++-compat. */ + +static void +warn_cxx_compat_finish_struct (tree fieldlist) +{ + unsigned int ix; + tree x; + struct c_binding *b; + + /* Set the C_TYPE_DEFINED_IN_STRUCT flag for each type defined in + the current struct. We do this now at the end of the struct + because the flag is used to issue visibility warnings, and we + only want to issue those warnings if the type is referenced + outside of the struct declaration. */ + for (ix = 0; VEC_iterate (tree, struct_parse_info->struct_types, ix, x); ++ix) + C_TYPE_DEFINED_IN_STRUCT (x) = 1; + + /* The TYPEDEFS_SEEN field of STRUCT_PARSE_INFO is a list of + typedefs used when declaring fields in this struct. If the name + of any of the fields is also a typedef name then the struct would + not parse in C++, because the C++ lookup rules say that the + typedef name would be looked up in the context of the struct, and + would thus be the field rather than the typedef. */ + if (!VEC_empty (tree, struct_parse_info->typedefs_seen) + && fieldlist != NULL_TREE) + { + /* Use a pointer_set using the name of the typedef. We can use + a pointer_set because identifiers are interned. */ + struct pointer_set_t *tset = pointer_set_create (); + + for (ix = 0; + VEC_iterate (tree, struct_parse_info->typedefs_seen, ix, x); + ++ix) + pointer_set_insert (tset, DECL_NAME (x)); + + for (x = fieldlist; x != NULL_TREE; x = TREE_CHAIN (x)) + { + if (pointer_set_contains (tset, DECL_NAME (x))) + { + warning_at (DECL_SOURCE_LOCATION (x), OPT_Wc___compat, + ("using %qD as both field and typedef name is " + "invalid in C++"), + x); + /* FIXME: It would be nice to report the location where + the typedef name is used. */ + } + } + + pointer_set_destroy (tset); + } + + /* For each field which has a binding and which was not defined in + an enclosing struct, clear the in_struct field. */ + for (ix = 0; + VEC_iterate (c_binding_ptr, struct_parse_info->fields, ix, b); + ++ix) + b->in_struct = 0; +} + /* Fill in the fields of a RECORD_TYPE or UNION_TYPE node, T. LOC is the location of the RECORD_TYPE or UNION_TYPE's definition. FIELDLIST is a chain of FIELD_DECL nodes for the fields. ATTRIBUTES are attributes to be applied to the structure. - ENCLOSING_IN_STRUCT is the value of IN_STRUCT, and - ENCLOSING_STRUCT_TYPES is the value of STRUCT_TYPES, when the - struct was started. This sets the C_TYPE_DEFINED_IN_STRUCT flag - for any type defined in the current struct. */ + ENCLOSING_STRUCT_PARSE_INFO is the value of STRUCT_PARSE_INFO when + the struct was started. */ tree finish_struct (location_t loc, tree t, tree fieldlist, tree attributes, - bool enclosing_in_struct, - VEC(tree,heap) *enclosing_struct_types) + struct c_struct_parse_info *enclosing_struct_parse_info) { tree x; bool toplevel = file_scope == current_scope; int saw_named_field; - unsigned int ix; /* If this type was previously laid out as a forward reference, make sure we lay it out again. */ @@ -6760,23 +6874,22 @@ finish_struct (location_t loc, tree t, tree fieldlist, tree attributes, add_stmt (build_stmt (loc, DECL_EXPR, build_decl (loc, TYPE_DECL, NULL, t))); - /* Set the C_TYPE_DEFINED_IN_STRUCT flag for each type defined in - the current struct. We do this now at the end of the struct - because the flag is used to issue visibility warnings when using - -Wc++-compat, and we only want to issue those warnings if the - type is referenced outside of the struct declaration. */ - for (ix = 0; VEC_iterate (tree, struct_types, ix, x); ++ix) - C_TYPE_DEFINED_IN_STRUCT (x) = 1; + if (warn_cxx_compat) + warn_cxx_compat_finish_struct (fieldlist); - VEC_free (tree, heap, struct_types); + VEC_free (tree, heap, struct_parse_info->struct_types); + VEC_free (c_binding_ptr, heap, struct_parse_info->fields); + VEC_free (tree, heap, struct_parse_info->typedefs_seen); + XDELETE (struct_parse_info); - in_struct = enclosing_in_struct; - struct_types = enclosing_struct_types; + struct_parse_info = enclosing_struct_parse_info; /* If this struct is defined inside a struct, add it to - STRUCT_TYPES. */ - if (in_struct && !in_sizeof && !in_typeof && !in_alignof) - VEC_safe_push (tree, heap, struct_types, t); + struct_types. */ + if (warn_cxx_compat + && struct_parse_info != NULL + && !in_sizeof && !in_typeof && !in_alignof) + VEC_safe_push (tree, heap, struct_parse_info->struct_types, t); return t; } @@ -6990,9 +7103,11 @@ finish_enum (tree enumtype, tree values, tree attributes) rest_of_type_compilation (enumtype, toplevel); /* If this enum is defined inside a struct, add it to - STRUCT_TYPES. */ - if (in_struct && !in_sizeof && !in_typeof && !in_alignof) - VEC_safe_push (tree, heap, struct_types, enumtype); + struct_types. */ + if (warn_cxx_compat + && struct_parse_info != NULL + && !in_sizeof && !in_typeof && !in_alignof) + VEC_safe_push (tree, heap, struct_parse_info->struct_types, enumtype); return enumtype; } @@ -8254,7 +8369,8 @@ declspecs_add_qual (struct c_declspecs *specs, tree qual) returning SPECS. */ struct c_declspecs * -declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) +declspecs_add_type (location_t loc, struct c_declspecs *specs, + struct c_typespec spec) { tree type = spec.spec; specs->non_sc_seen_p = true; @@ -8271,7 +8387,7 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) enum rid i = C_RID_CODE (type); if (specs->type) { - error ("two or more data types in declaration specifiers"); + error_at (loc, "two or more data types in declaration specifiers"); return specs; } if ((int) i <= (int) RID_LAST_MODIFIER) @@ -8283,203 +8399,257 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) case RID_LONG: if (specs->long_long_p) { - error ("%<long long long%> is too long for GCC"); + error_at (loc, "%<long long long%> is too long for GCC"); break; } if (specs->long_p) { if (specs->typespec_word == cts_double) { - error ("both %<long long%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long long%> and %<double%> in " + "declaration specifiers")); break; } - pedwarn_c90 (input_location, OPT_Wlong_long, + pedwarn_c90 (loc, OPT_Wlong_long, "ISO C90 does not support %<long long%>"); specs->long_long_p = 1; break; } if (specs->short_p) - error ("both %<long%> and %<short%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<short%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_void) - error ("both %<long%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<void%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_bool) - error ("both %<long%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_char) - error ("both %<long%> and %<char%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<char%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_float) - error ("both %<long%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<float%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat32) - error ("both %<long%> and %<_Decimal32%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<_Decimal32%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat64) - error ("both %<long%> and %<_Decimal64%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<_Decimal64%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat128) - error ("both %<long%> and %<_Decimal128%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<_Decimal128%> in " + "declaration specifiers")); else specs->long_p = true; break; case RID_SHORT: dupe = specs->short_p; if (specs->long_p) - error ("both %<long%> and %<short%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<short%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_void) - error ("both %<short%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<void%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_bool) - error ("both %<short%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_char) - error ("both %<short%> and %<char%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<char%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_float) - error ("both %<short%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<float%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_double) - error ("both %<short%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<double%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat32) - error ("both %<short%> and %<_Decimal32%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<_Decimal32%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat64) - error ("both %<short%> and %<_Decimal64%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<_Decimal64%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat128) - error ("both %<short%> and %<_Decimal128%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<_Decimal128%> in " + "declaration specifiers")); else specs->short_p = true; break; case RID_SIGNED: dupe = specs->signed_p; if (specs->unsigned_p) - error ("both %<signed%> and %<unsigned%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<unsigned%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_void) - error ("both %<signed%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<void%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_bool) - error ("both %<signed%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_float) - error ("both %<signed%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<float%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_double) - error ("both %<signed%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<double%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat32) - error ("both %<signed%> and %<_Decimal32%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<_Decimal32%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat64) - error ("both %<signed%> and %<_Decimal64%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<_Decimal64%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat128) - error ("both %<signed%> and %<_Decimal128%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<_Decimal128%> in " + "declaration specifiers")); else specs->signed_p = true; break; case RID_UNSIGNED: dupe = specs->unsigned_p; if (specs->signed_p) - error ("both %<signed%> and %<unsigned%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<unsigned%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_void) - error ("both %<unsigned%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<void%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_bool) - error ("both %<unsigned%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_float) - error ("both %<unsigned%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<float%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_double) - error ("both %<unsigned%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<double%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat32) - error ("both %<unsigned%> and %<_Decimal32%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<_Decimal32%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat64) - error ("both %<unsigned%> and %<_Decimal64%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<_Decimal64%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat128) - error ("both %<unsigned%> and %<_Decimal128%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<_Decimal128%> in " + "declaration specifiers")); else specs->unsigned_p = true; break; case RID_COMPLEX: dupe = specs->complex_p; if (!flag_isoc99 && !in_system_header) - pedwarn (input_location, OPT_pedantic, "ISO C90 does not support complex types"); + pedwarn (loc, OPT_pedantic, + "ISO C90 does not support complex types"); if (specs->typespec_word == cts_void) - error ("both %<complex%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<void%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_bool) - error ("both %<complex%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat32) - error ("both %<complex%> and %<_Decimal32%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<_Decimal32%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat64) - error ("both %<complex%> and %<_Decimal64%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<_Decimal64%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat128) - error ("both %<complex%> and %<_Decimal128%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<_Decimal128%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_fract) - error ("both %<complex%> and %<_Fract%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<_Fract%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_accum) - error ("both %<complex%> and %<_Accum%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<_Accum%> in " + "declaration specifiers")); else if (specs->saturating_p) - error ("both %<complex%> and %<_Sat%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<_Sat%> in " + "declaration specifiers")); else specs->complex_p = true; break; case RID_SAT: dupe = specs->saturating_p; - pedwarn (input_location, OPT_pedantic, "ISO C does not support saturating types"); + pedwarn (loc, OPT_pedantic, + "ISO C does not support saturating types"); if (specs->typespec_word == cts_void) - error ("both %<_Sat%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<void%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_bool) - error ("both %<_Sat%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_char) - error ("both %<_Sat%> and %<char%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<char%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_int) - error ("both %<_Sat%> and %<int%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<int%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_float) - error ("both %<_Sat%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<float%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_double) - error ("both %<_Sat%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<double%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat32) - error ("both %<_Sat%> and %<_Decimal32%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<_Decimal32%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat64) - error ("both %<_Sat%> and %<_Decimal64%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<_Decimal64%> in " + "declaration specifiers")); else if (specs->typespec_word == cts_dfloat128) - error ("both %<_Sat%> and %<_Decimal128%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<_Decimal128%> in " + "declaration specifiers")); else if (specs->complex_p) - error ("both %<_Sat%> and %<complex%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<complex%> in " + "declaration specifiers")); else specs->saturating_p = true; break; @@ -8488,7 +8658,7 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) } if (dupe) - error ("duplicate %qE", type); + error_at (loc, "duplicate %qE", type); return specs; } @@ -8498,110 +8668,137 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) "_Decimal64", "_Decimal128", "_Fract" or "_Accum". */ if (specs->typespec_word != cts_none) { - error ("two or more data types in declaration specifiers"); + error_at (loc, + "two or more data types in declaration specifiers"); return specs; } switch (i) { case RID_VOID: if (specs->long_p) - error ("both %<long%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<void%> in " + "declaration specifiers")); else if (specs->short_p) - error ("both %<short%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<void%> in " + "declaration specifiers")); else if (specs->signed_p) - error ("both %<signed%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<void%> in " + "declaration specifiers")); else if (specs->unsigned_p) - error ("both %<unsigned%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<void%> in " + "declaration specifiers")); else if (specs->complex_p) - error ("both %<complex%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<void%> in " + "declaration specifiers")); else if (specs->saturating_p) - error ("both %<_Sat%> and %<void%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<void%> in " + "declaration specifiers")); else specs->typespec_word = cts_void; return specs; case RID_BOOL: if (specs->long_p) - error ("both %<long%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->short_p) - error ("both %<short%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->signed_p) - error ("both %<signed%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->unsigned_p) - error ("both %<unsigned%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->complex_p) - error ("both %<complex%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<complex%> and %<_Bool%> in " + "declaration specifiers")); else if (specs->saturating_p) - error ("both %<_Sat%> and %<_Bool%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<_Bool%> in " + "declaration specifiers")); else specs->typespec_word = cts_bool; return specs; case RID_CHAR: if (specs->long_p) - error ("both %<long%> and %<char%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<char%> in " + "declaration specifiers")); else if (specs->short_p) - error ("both %<short%> and %<char%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<char%> in " + "declaration specifiers")); else if (specs->saturating_p) - error ("both %<_Sat%> and %<char%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<char%> in " + "declaration specifiers")); else specs->typespec_word = cts_char; return specs; case RID_INT: if (specs->saturating_p) - error ("both %<_Sat%> and %<int%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<int%> in " + "declaration specifiers")); else specs->typespec_word = cts_int; return specs; case RID_FLOAT: if (specs->long_p) - error ("both %<long%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long%> and %<float%> in " + "declaration specifiers")); else if (specs->short_p) - error ("both %<short%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<float%> in " + "declaration specifiers")); else if (specs->signed_p) - error ("both %<signed%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<float%> in " + "declaration specifiers")); else if (specs->unsigned_p) - error ("both %<unsigned%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<float%> in " + "declaration specifiers")); else if (specs->saturating_p) - error ("both %<_Sat%> and %<float%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<float%> in " + "declaration specifiers")); else specs->typespec_word = cts_float; return specs; case RID_DOUBLE: if (specs->long_long_p) - error ("both %<long long%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<long long%> and %<double%> in " + "declaration specifiers")); else if (specs->short_p) - error ("both %<short%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<short%> and %<double%> in " + "declaration specifiers")); else if (specs->signed_p) - error ("both %<signed%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<signed%> and %<double%> in " + "declaration specifiers")); else if (specs->unsigned_p) - error ("both %<unsigned%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<unsigned%> and %<double%> in " + "declaration specifiers")); else if (specs->saturating_p) - error ("both %<_Sat%> and %<double%> in " - "declaration specifiers"); + error_at (loc, + ("both %<_Sat%> and %<double%> in " + "declaration specifiers")); else specs->typespec_word = cts_double; return specs; @@ -8617,26 +8814,40 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) else str = "_Decimal128"; if (specs->long_long_p) - error ("both %<long long%> and %<%s%> in " - "declaration specifiers", str); + error_at (loc, + ("both %<long long%> and %<%s%> in " + "declaration specifiers"), + str); if (specs->long_p) - error ("both %<long%> and %<%s%> in " - "declaration specifiers", str); + error_at (loc, + ("both %<long%> and %<%s%> in " + "declaration specifiers"), + str); else if (specs->short_p) - error ("both %<short%> and %<%s%> in " - "declaration specifiers", str); + error_at (loc, + ("both %<short%> and %<%s%> in " + "declaration specifiers"), + str); else if (specs->signed_p) - error ("both %<signed%> and %<%s%> in " - "declaration specifiers", str); + error_at (loc, + ("both %<signed%> and %<%s%> in " + "declaration specifiers"), + str); else if (specs->unsigned_p) - error ("both %<unsigned%> and %<%s%> in " - "declaration specifiers", str); + error_at (loc, + ("both %<unsigned%> and %<%s%> in " + "declaration specifiers"), + str); else if (specs->complex_p) - error ("both %<complex%> and %<%s%> in " - "declaration specifiers", str); + error_at (loc, + ("both %<complex%> and %<%s%> in " + "declaration specifiers"), + str); else if (specs->saturating_p) - error ("both %<_Sat%> and %<%s%> in " - "declaration specifiers", str); + error_at (loc, + ("both %<_Sat%> and %<%s%> in " + "declaration specifiers"), + str); else if (i == RID_DFLOAT32) specs->typespec_word = cts_dfloat32; else if (i == RID_DFLOAT64) @@ -8645,8 +8856,10 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) specs->typespec_word = cts_dfloat128; } if (!targetm.decimal_float_supported_p ()) - error ("decimal floating point not supported for this target"); - pedwarn (input_location, OPT_pedantic, + error_at (loc, + ("decimal floating point not supported " + "for this target")); + pedwarn (loc, OPT_pedantic, "ISO C does not support decimal floating point"); return specs; case RID_FRACT: @@ -8658,16 +8871,19 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) else str = "_Accum"; if (specs->complex_p) - error ("both %<complex%> and %<%s%> in " - "declaration specifiers", str); + error_at (loc, + ("both %<complex%> and %<%s%> in " + "declaration specifiers"), + str); else if (i == RID_FRACT) specs->typespec_word = cts_fract; else specs->typespec_word = cts_accum; } if (!targetm.fixed_point_supported_p ()) - error ("fixed-point types not supported for this target"); - pedwarn (input_location, OPT_pedantic, + error_at (loc, + "fixed-point types not supported for this target"); + pedwarn (loc, OPT_pedantic, "ISO C does not support fixed-point types"); return specs; default: @@ -8685,7 +8901,7 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) if (specs->type || specs->typespec_word != cts_none || specs->long_p || specs->short_p || specs->signed_p || specs->unsigned_p || specs->complex_p) - error ("two or more data types in declaration specifiers"); + error_at (loc, "two or more data types in declaration specifiers"); else if (TREE_CODE (type) == TYPE_DECL) { if (TREE_TYPE (type) == error_mark_node) @@ -8696,13 +8912,26 @@ declspecs_add_type (struct c_declspecs *specs, struct c_typespec spec) specs->decl_attr = DECL_ATTRIBUTES (type); specs->typedef_p = true; specs->explicit_signed_p = C_TYPEDEF_EXPLICITLY_SIGNED (type); + + /* If this typedef name is defined in a struct, then a C++ + lookup would return a different value. */ + if (warn_cxx_compat + && I_SYMBOL_BINDING (DECL_NAME (type))->in_struct) + warning_at (loc, OPT_Wc___compat, + "C++ lookup of %qD would return a field, not a type", + type); + + /* If we are parsing a struct, record that a struct field + used a typedef. */ + if (warn_cxx_compat && struct_parse_info != NULL) + VEC_safe_push (tree, heap, struct_parse_info->typedefs_seen, type); } } else if (TREE_CODE (type) == IDENTIFIER_NODE) { tree t = lookup_name (type); if (!t || TREE_CODE (t) != TYPE_DECL) - error ("%qE fails to be a typedef or built in type", type); + error_at (loc, "%qE fails to be a typedef or built in type", type); else if (TREE_TYPE (t) == error_mark_node) ; else diff --git a/gcc/c-parser.c b/gcc/c-parser.c index 2b78c3042fa..29e399fcdc1 100644 --- a/gcc/c-parser.c +++ b/gcc/c-parser.c @@ -1447,6 +1447,7 @@ c_parser_declspecs (c_parser *parser, struct c_declspecs *specs, { struct c_typespec t; tree attrs; + location_t loc = c_parser_peek_token (parser)->location; if (c_parser_next_token_is (parser, CPP_NAME)) { tree value = c_parser_peek_token (parser)->value; @@ -1482,7 +1483,7 @@ c_parser_declspecs (c_parser *parser, struct c_declspecs *specs, t.expr = NULL_TREE; t.expr_const_operands = true; } - declspecs_add_type (specs, t); + declspecs_add_type (loc, specs, t); continue; } if (c_parser_next_token_is (parser, CPP_LESS)) @@ -1498,7 +1499,7 @@ c_parser_declspecs (c_parser *parser, struct c_declspecs *specs, t.spec = objc_get_protocol_qualified_type (NULL_TREE, proto); t.expr = NULL_TREE; t.expr_const_operands = true; - declspecs_add_type (specs, t); + declspecs_add_type (loc, specs, t); continue; } gcc_assert (c_parser_next_token_is (parser, CPP_KEYWORD)); @@ -1547,7 +1548,7 @@ c_parser_declspecs (c_parser *parser, struct c_declspecs *specs, t.spec = c_parser_peek_token (parser)->value; t.expr = NULL_TREE; t.expr_const_operands = true; - declspecs_add_type (specs, t); + declspecs_add_type (loc, specs, t); c_parser_consume_token (parser); break; case RID_ENUM: @@ -1556,7 +1557,7 @@ c_parser_declspecs (c_parser *parser, struct c_declspecs *specs, attrs_ok = true; seen_type = true; t = c_parser_enum_specifier (parser); - declspecs_add_type (specs, t); + declspecs_add_type (loc, specs, t); break; case RID_STRUCT: case RID_UNION: @@ -1566,7 +1567,7 @@ c_parser_declspecs (c_parser *parser, struct c_declspecs *specs, seen_type = true; t = c_parser_struct_or_union_specifier (parser); invoke_plugin_callbacks (PLUGIN_FINISH_TYPE, t.spec); - declspecs_add_type (specs, t); + declspecs_add_type (loc, specs, t); break; case RID_TYPEOF: /* ??? The old parser rejected typeof after other type @@ -1577,7 +1578,7 @@ c_parser_declspecs (c_parser *parser, struct c_declspecs *specs, attrs_ok = true; seen_type = true; t = c_parser_typeof_specifier (parser); - declspecs_add_type (specs, t); + declspecs_add_type (loc, specs, t); break; case RID_CONST: case RID_VOLATILE: @@ -1815,10 +1816,8 @@ c_parser_struct_or_union_specifier (c_parser *parser) { /* Parse a struct or union definition. Start the scope of the tag before parsing components. */ - bool in_struct; - VEC(tree,heap) *struct_types; - tree type = start_struct (struct_loc, code, ident, - &in_struct, &struct_types); + struct c_struct_parse_info *struct_info; + tree type = start_struct (struct_loc, code, ident, &struct_info); tree postfix_attrs; /* We chain the components in reverse order, then put them in forward order at the end. Each struct-declaration may @@ -1908,8 +1907,7 @@ c_parser_struct_or_union_specifier (c_parser *parser) } postfix_attrs = c_parser_attributes (parser); ret.spec = finish_struct (struct_loc, type, nreverse (contents), - chainon (attrs, postfix_attrs), - in_struct, struct_types); + chainon (attrs, postfix_attrs), struct_info); ret.kind = ctsk_tagdef; ret.expr = NULL_TREE; ret.expr_const_operands = true; @@ -4599,7 +4597,8 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after) c_inhibit_evaluation_warnings -= cond.value == truthvalue_true_node; ret.value = build_conditional_expr (colon_loc, cond.value, cond.original_code == C_MAYBE_CONST_EXPR, - exp1.value, exp2.value); + exp1.value, exp1.original_type, + exp2.value, exp2.original_type); ret.original_code = ERROR_MARK; if (exp1.value == error_mark_node || exp2.value == error_mark_node) ret.original_type = NULL; diff --git a/gcc/c-tree.h b/gcc/c-tree.h index f565df58f31..c01cc664fe8 100644 --- a/gcc/c-tree.h +++ b/gcc/c-tree.h @@ -430,6 +430,7 @@ extern void gen_aux_info_record (tree, int, int, int); /* in c-decl.c */ struct c_spot_bindings; +struct c_struct_parse_info; extern struct obstack parser_obstack; extern tree c_break_label; extern tree c_cont_label; @@ -465,7 +466,8 @@ extern void c_maybe_initialize_eh (void); extern void finish_decl (tree, location_t, tree, tree, tree); extern tree finish_enum (tree, tree, tree); extern void finish_function (void); -extern tree finish_struct (location_t, tree, tree, tree, bool, VEC(tree,heap) *); +extern tree finish_struct (location_t, tree, tree, tree, + struct c_struct_parse_info *); extern struct c_arg_info *get_parm_info (bool); extern tree grokfield (location_t, struct c_declarator *, struct c_declspecs *, tree, tree *); @@ -487,7 +489,8 @@ extern tree start_enum (location_t, struct c_enum_contents *, tree); extern int start_function (struct c_declspecs *, struct c_declarator *, tree); extern tree start_decl (struct c_declarator *, struct c_declspecs *, bool, tree); -extern tree start_struct (location_t, enum tree_code, tree, bool *, VEC(tree,heap) **); +extern tree start_struct (location_t, enum tree_code, tree, + struct c_struct_parse_info **); extern void store_parm_decls (void); extern void store_parm_decls_from (struct c_arg_info *); extern tree xref_tag (enum tree_code, tree); @@ -504,7 +507,8 @@ extern struct c_declarator *make_pointer_declarator (struct c_declspecs *, struct c_declarator *); extern struct c_declspecs *build_null_declspecs (void); extern struct c_declspecs *declspecs_add_qual (struct c_declspecs *, tree); -extern struct c_declspecs *declspecs_add_type (struct c_declspecs *, +extern struct c_declspecs *declspecs_add_type (location_t, + struct c_declspecs *, struct c_typespec); extern struct c_declspecs *declspecs_add_scspec (struct c_declspecs *, tree); extern struct c_declspecs *declspecs_add_attrs (struct c_declspecs *, tree); @@ -552,7 +556,8 @@ extern struct c_expr parser_build_unary_op (location_t, enum tree_code, extern struct c_expr parser_build_binary_op (location_t, enum tree_code, struct c_expr, struct c_expr); -extern tree build_conditional_expr (location_t, tree, bool, tree, tree); +extern tree build_conditional_expr (location_t, tree, bool, tree, tree, + tree, tree); extern tree build_compound_expr (location_t, tree, tree); extern tree c_cast_expr (location_t, struct c_type_name *, tree); extern tree build_c_cast (location_t, tree, tree); diff --git a/gcc/c-typeck.c b/gcc/c-typeck.c index 0a40a888d53..df1e1718405 100644 --- a/gcc/c-typeck.c +++ b/gcc/c-typeck.c @@ -3770,7 +3770,8 @@ c_mark_addressable (tree exp) tree build_conditional_expr (location_t colon_loc, tree ifexp, bool ifexp_bcp, - tree op1, tree op2) + tree op1, tree op1_original_type, tree op2, + tree op2_original_type) { tree type1; tree type2; @@ -3843,6 +3844,20 @@ build_conditional_expr (location_t colon_loc, tree ifexp, bool ifexp_bcp, } } + if (warn_cxx_compat) + { + tree t1 = op1_original_type ? op1_original_type : TREE_TYPE (orig_op1); + tree t2 = op2_original_type ? op2_original_type : TREE_TYPE (orig_op2); + + if (TREE_CODE (t1) == ENUMERAL_TYPE + && TREE_CODE (t2) == ENUMERAL_TYPE + && TYPE_MAIN_VARIANT (t1) != TYPE_MAIN_VARIANT (t2)) + warning_at (colon_loc, OPT_Wc___compat, + ("different enum types in conditional is " + "invalid in C++: %qT vs %qT"), + t1, t2); + } + /* Quickly detect the usual case where op1 and op2 have the same type after promotion. */ if (TYPE_MAIN_VARIANT (type1) == TYPE_MAIN_VARIANT (type2)) diff --git a/gcc/common.opt b/gcc/common.opt index 77e054a53ab..76f5de0229b 100644 --- a/gcc/common.opt +++ b/gcc/common.opt @@ -1135,8 +1135,8 @@ Common Report Var(flag_section_anchors) Optimization Access data in the same section from shared anchor points fsee -Common Report Var(flag_see) Init(0) -Eliminate redundant sign extensions using LCM. +Common +Does nothing. Preserved for backward compatibility. fshow-column Common C ObjC C++ ObjC++ Report Var(flag_show_column) Init(1) diff --git a/gcc/config/arm/aout.h b/gcc/config/arm/aout.h index e9104220feb..5abad67dd69 100644 --- a/gcc/config/arm/aout.h +++ b/gcc/config/arm/aout.h @@ -243,7 +243,30 @@ if (TARGET_ARM) \ asm_fprintf (STREAM, "\tb\t%LL%d\n", VALUE); \ else if (TARGET_THUMB1) \ - asm_fprintf (STREAM, "\t.word\t%LL%d-%LL%d\n", VALUE, REL); \ + { \ + if (flag_pic || optimize_size) \ + { \ + switch (GET_MODE(body)) \ + { \ + case QImode: \ + asm_fprintf (STREAM, "\t.byte\t(%LL%d-%LL%d)/2\n", \ + VALUE, REL); \ + break; \ + case HImode: /* TBH */ \ + asm_fprintf (STREAM, "\t.2byte\t(%LL%d-%LL%d)/2\n", \ + VALUE, REL); \ + break; \ + case SImode: \ + asm_fprintf (STREAM, "\t.word\t%LL%d-%LL%d\n", \ + VALUE, REL); \ + break; \ + default: \ + gcc_unreachable(); \ + } \ + } \ + else \ + asm_fprintf (STREAM, "\t.word\t%LL%d+1\n", VALUE); \ + } \ else /* Thumb-2 */ \ { \ switch (GET_MODE(body)) \ diff --git a/gcc/config/arm/arm-modes.def b/gcc/config/arm/arm-modes.def index 73b5b4d3d0d..813ce8ec142 100644 --- a/gcc/config/arm/arm-modes.def +++ b/gcc/config/arm/arm-modes.def @@ -25,6 +25,11 @@ FIXME What format is this? */ FLOAT_MODE (XF, 12, 0); +/* Half-precision floating point */ +FLOAT_MODE (HF, 2, 0); +ADJUST_FLOAT_FORMAT (HF, ((arm_fp16_format == ARM_FP16_FORMAT_ALTERNATIVE) + ? &arm_half_format : &ieee_half_format)); + /* CCFPEmode should be used with floating inequalities, CCFPmode should be used with floating equalities. CC_NOOVmode should be used with SImode integer equalities. diff --git a/gcc/config/arm/arm-protos.h b/gcc/config/arm/arm-protos.h index 857d575e5d3..07772eb8c88 100644 --- a/gcc/config/arm/arm-protos.h +++ b/gcc/config/arm/arm-protos.h @@ -140,6 +140,7 @@ extern void arm_final_prescan_insn (rtx); extern int arm_debugger_arg_offset (int, rtx); extern bool arm_is_long_call_p (tree); extern int arm_emit_vector_const (FILE *, rtx); +extern void arm_emit_fp16_const (rtx c); extern const char * arm_output_load_gr (rtx *); extern const char *vfp_output_fstmd (rtx *); extern void arm_set_return_address (rtx, rtx); @@ -182,7 +183,8 @@ extern rtx arm_return_addr (int, rtx); extern void thumb_reload_out_hi (rtx *); extern void thumb_reload_in_hi (rtx *); extern void thumb_set_return_address (rtx, rtx); -extern const char *thumb2_output_casesi(rtx *); +extern const char *thumb1_output_casesi (rtx *); +extern const char *thumb2_output_casesi (rtx *); #endif /* Defined in pe.c. */ diff --git a/gcc/config/arm/arm.c b/gcc/config/arm/arm.c index 3809270b2c5..6f615c59312 100644 --- a/gcc/config/arm/arm.c +++ b/gcc/config/arm/arm.c @@ -53,6 +53,7 @@ #include "debug.h" #include "langhooks.h" #include "df.h" +#include "intl.h" /* Forward definitions of types. */ typedef struct minipool_node Mnode; @@ -200,6 +201,11 @@ static bool arm_tls_symbol_p (rtx x); static int arm_issue_rate (void); static void arm_output_dwarf_dtprel (FILE *, int, rtx) ATTRIBUTE_UNUSED; static bool arm_allocate_stack_slots_for_args (void); +static const char *arm_invalid_parameter_type (const_tree t); +static const char *arm_invalid_return_type (const_tree t); +static tree arm_promoted_type (const_tree t); +static tree arm_convert_to_type (tree type, tree expr); +static bool arm_scalar_mode_supported_p (enum machine_mode); /* Initialize the GCC target structure. */ @@ -407,6 +413,21 @@ static bool arm_allocate_stack_slots_for_args (void); #undef TARGET_LEGITIMATE_ADDRESS_P #define TARGET_LEGITIMATE_ADDRESS_P arm_legitimate_address_p +#undef TARGET_INVALID_PARAMETER_TYPE +#define TARGET_INVALID_PARAMETER_TYPE arm_invalid_parameter_type + +#undef TARGET_INVALID_RETURN_TYPE +#define TARGET_INVALID_RETURN_TYPE arm_invalid_return_type + +#undef TARGET_PROMOTED_TYPE +#define TARGET_PROMOTED_TYPE arm_promoted_type + +#undef TARGET_CONVERT_TO_TYPE +#define TARGET_CONVERT_TO_TYPE arm_convert_to_type + +#undef TARGET_SCALAR_MODE_SUPPORTED_P +#define TARGET_SCALAR_MODE_SUPPORTED_P arm_scalar_mode_supported_p + struct gcc_target targetm = TARGET_INITIALIZER; /* Obstack for minipool constant handling. */ @@ -440,6 +461,9 @@ enum fputype arm_fpu_tune; /* Whether to use floating point hardware. */ enum float_abi_type arm_float_abi; +/* Which __fp16 format to use. */ +enum arm_fp16_format_type arm_fp16_format; + /* Which ABI to use. */ enum arm_abi_type arm_abi; @@ -719,15 +743,16 @@ struct fpu_desc static const struct fpu_desc all_fpus[] = { - {"fpa", FPUTYPE_FPA}, - {"fpe2", FPUTYPE_FPA_EMU2}, - {"fpe3", FPUTYPE_FPA_EMU2}, - {"maverick", FPUTYPE_MAVERICK}, - {"vfp", FPUTYPE_VFP}, - {"vfp3", FPUTYPE_VFP3}, - {"vfpv3", FPUTYPE_VFP3}, - {"vfpv3-d16", FPUTYPE_VFP3D16}, - {"neon", FPUTYPE_NEON} + {"fpa", FPUTYPE_FPA}, + {"fpe2", FPUTYPE_FPA_EMU2}, + {"fpe3", FPUTYPE_FPA_EMU2}, + {"maverick", FPUTYPE_MAVERICK}, + {"vfp", FPUTYPE_VFP}, + {"vfp3", FPUTYPE_VFP3}, + {"vfpv3", FPUTYPE_VFP3}, + {"vfpv3-d16", FPUTYPE_VFP3D16}, + {"neon", FPUTYPE_NEON}, + {"neon-fp16", FPUTYPE_NEON_FP16} }; @@ -745,7 +770,8 @@ static const enum arm_fp_model fp_model_for_fpu[] = ARM_FP_MODEL_VFP, /* FPUTYPE_VFP */ ARM_FP_MODEL_VFP, /* FPUTYPE_VFP3D16 */ ARM_FP_MODEL_VFP, /* FPUTYPE_VFP3 */ - ARM_FP_MODEL_VFP /* FPUTYPE_NEON */ + ARM_FP_MODEL_VFP, /* FPUTYPE_NEON */ + ARM_FP_MODEL_VFP /* FPUTYPE_NEON_FP16 */ }; @@ -766,6 +792,23 @@ static const struct float_abi all_float_abis[] = }; +struct fp16_format +{ + const char *name; + enum arm_fp16_format_type fp16_format_type; +}; + + +/* Available values for -mfp16-format=. */ + +static const struct fp16_format all_fp16_formats[] = +{ + {"none", ARM_FP16_FORMAT_NONE}, + {"ieee", ARM_FP16_FORMAT_IEEE}, + {"alternative", ARM_FP16_FORMAT_ALTERNATIVE} +}; + + struct abi_name { const char *name; @@ -923,6 +966,44 @@ arm_init_libfuncs (void) set_optab_libfunc (umod_optab, DImode, NULL); set_optab_libfunc (smod_optab, SImode, NULL); set_optab_libfunc (umod_optab, SImode, NULL); + + /* Half-precision float operations. The compiler handles all operations + with NULL libfuncs by converting the SFmode. */ + switch (arm_fp16_format) + { + case ARM_FP16_FORMAT_IEEE: + case ARM_FP16_FORMAT_ALTERNATIVE: + + /* Conversions. */ + set_conv_libfunc (trunc_optab, HFmode, SFmode, + (arm_fp16_format == ARM_FP16_FORMAT_IEEE + ? "__gnu_f2h_ieee" + : "__gnu_f2h_alternative")); + set_conv_libfunc (sext_optab, SFmode, HFmode, + (arm_fp16_format == ARM_FP16_FORMAT_IEEE + ? "__gnu_h2f_ieee" + : "__gnu_h2f_alternative")); + + /* Arithmetic. */ + set_optab_libfunc (add_optab, HFmode, NULL); + set_optab_libfunc (sdiv_optab, HFmode, NULL); + set_optab_libfunc (smul_optab, HFmode, NULL); + set_optab_libfunc (neg_optab, HFmode, NULL); + set_optab_libfunc (sub_optab, HFmode, NULL); + + /* Comparisons. */ + set_optab_libfunc (eq_optab, HFmode, NULL); + set_optab_libfunc (ne_optab, HFmode, NULL); + set_optab_libfunc (lt_optab, HFmode, NULL); + set_optab_libfunc (le_optab, HFmode, NULL); + set_optab_libfunc (ge_optab, HFmode, NULL); + set_optab_libfunc (gt_optab, HFmode, NULL); + set_optab_libfunc (unord_optab, HFmode, NULL); + break; + + default: + break; + } } /* On AAPCS systems, this is the "struct __va_list". */ @@ -1294,6 +1375,23 @@ arm_override_options (void) tune_flags = all_cores[(int)arm_tune].flags; + if (target_fp16_format_name) + { + for (i = 0; i < ARRAY_SIZE (all_fp16_formats); i++) + { + if (streq (all_fp16_formats[i].name, target_fp16_format_name)) + { + arm_fp16_format = all_fp16_formats[i].fp16_format_type; + break; + } + } + if (i == ARRAY_SIZE (all_fp16_formats)) + error ("invalid __fp16 format option: -mfp16-format=%s", + target_fp16_format_name); + } + else + arm_fp16_format = ARM_FP16_FORMAT_NONE; + if (target_abi_name) { for (i = 0; i < ARRAY_SIZE (arm_all_abis); i++) @@ -1525,6 +1623,10 @@ arm_override_options (void) if (TARGET_THUMB2 && TARGET_IWMMXT) sorry ("Thumb-2 iWMMXt"); + /* __fp16 support currently assumes the core has ldrh. */ + if (!arm_arch4 && arm_fp16_format != ARM_FP16_FORMAT_NONE) + sorry ("__fp16 and no ldrh"); + /* If soft-float is specified then don't use FPU. */ if (TARGET_SOFT_FLOAT) arm_fpu_arch = FPUTYPE_NONE; @@ -4173,6 +4275,7 @@ arm_legitimate_index_p (enum machine_mode mode, rtx index, RTX_CODE outer, if (GET_MODE_SIZE (mode) <= 4 && ! (arm_arch4 && (mode == HImode + || mode == HFmode || (mode == QImode && outer == SIGN_EXTEND)))) { if (code == MULT) @@ -4201,13 +4304,15 @@ arm_legitimate_index_p (enum machine_mode mode, rtx index, RTX_CODE outer, load. */ if (arm_arch4) { - if (mode == HImode || (outer == SIGN_EXTEND && mode == QImode)) + if (mode == HImode + || mode == HFmode + || (outer == SIGN_EXTEND && mode == QImode)) range = 256; else range = 4096; } else - range = (mode == HImode) ? 4095 : 4096; + range = (mode == HImode || mode == HFmode) ? 4095 : 4096; return (code == CONST_INT && INTVAL (index) < range @@ -4380,7 +4485,8 @@ thumb1_legitimate_address_p (enum machine_mode mode, rtx x, int strict_p) return 1; /* This is PC relative data after arm_reorg runs. */ - else if (GET_MODE_SIZE (mode) >= 4 && reload_completed + else if ((GET_MODE_SIZE (mode) >= 4 || mode == HFmode) + && reload_completed && (GET_CODE (x) == LABEL_REF || (GET_CODE (x) == CONST && GET_CODE (XEXP (x, 0)) == PLUS @@ -7121,6 +7227,13 @@ arm_eliminable_register (rtx x) enum reg_class coproc_secondary_reload_class (enum machine_mode mode, rtx x, bool wb) { + if (mode == HFmode) + { + if (s_register_operand (x, mode) || neon_vector_mem_operand (x, 2)) + return NO_REGS; + return GENERAL_REGS; + } + if (TARGET_NEON && (GET_MODE_CLASS (mode) == MODE_VECTOR_INT || GET_MODE_CLASS (mode) == MODE_VECTOR_FLOAT) @@ -13926,6 +14039,31 @@ arm_print_operand (FILE *stream, rtx x, int code) } return; + /* Register specifier for vld1.16/vst1.16. Translate the S register + number into a D register number and element index. */ + case 'z': + { + int mode = GET_MODE (x); + int regno; + + if (GET_MODE_SIZE (mode) != 2 || GET_CODE (x) != REG) + { + output_operand_lossage ("invalid operand for code '%c'", code); + return; + } + + regno = REGNO (x); + if (!VFP_REGNO_OK_FOR_SINGLE (regno)) + { + output_operand_lossage ("invalid operand for code '%c'", code); + return; + } + + regno = regno - FIRST_VFP_REGNUM; + fprintf (stream, "d%d[%d]", regno/2, ((regno % 2) ? 2 : 0)); + } + return; + default: if (x == 0) { @@ -14723,6 +14861,12 @@ arm_hard_regno_mode_ok (unsigned int regno, enum machine_mode mode) if (mode == DFmode) return VFP_REGNO_OK_FOR_DOUBLE (regno); + /* VFP registers can hold HFmode values, but there is no point in + putting them there unless we have the NEON extensions for + loading/storing them, too. */ + if (mode == HFmode) + return TARGET_NEON_FP16 && VFP_REGNO_OK_FOR_SINGLE (regno); + if (TARGET_NEON) return (VALID_NEON_DREG_MODE (mode) && VFP_REGNO_OK_FOR_DOUBLE (regno)) || (VALID_NEON_QREG_MODE (mode) @@ -16209,6 +16353,15 @@ arm_init_neon_builtins (void) } static void +arm_init_fp16_builtins (void) +{ + tree fp16_type = make_node (REAL_TYPE); + TYPE_PRECISION (fp16_type) = 16; + layout_type (fp16_type); + (*lang_hooks.types.register_builtin_type) (fp16_type, "__fp16"); +} + +static void arm_init_builtins (void) { arm_init_tls_builtins (); @@ -16218,6 +16371,71 @@ arm_init_builtins (void) if (TARGET_NEON) arm_init_neon_builtins (); + + if (arm_fp16_format) + arm_init_fp16_builtins (); +} + +/* Implement TARGET_INVALID_PARAMETER_TYPE. */ + +static const char * +arm_invalid_parameter_type (const_tree t) +{ + if (SCALAR_FLOAT_TYPE_P (t) && TYPE_PRECISION (t) == 16) + return N_("function parameters cannot have __fp16 type"); + return NULL; +} + +/* Implement TARGET_INVALID_PARAMETER_TYPE. */ + +static const char * +arm_invalid_return_type (const_tree t) +{ + if (SCALAR_FLOAT_TYPE_P (t) && TYPE_PRECISION (t) == 16) + return N_("functions cannot return __fp16 type"); + return NULL; +} + +/* Implement TARGET_PROMOTED_TYPE. */ + +static tree +arm_promoted_type (const_tree t) +{ + if (SCALAR_FLOAT_TYPE_P (t) && TYPE_PRECISION (t) == 16) + return float_type_node; + return NULL_TREE; +} + +/* Implement TARGET_CONVERT_TO_TYPE. + Specifically, this hook implements the peculiarity of the ARM + half-precision floating-point C semantics that requires conversions between + __fp16 to or from double to do an intermediate conversion to float. */ + +static tree +arm_convert_to_type (tree type, tree expr) +{ + tree fromtype = TREE_TYPE (expr); + if (!SCALAR_FLOAT_TYPE_P (fromtype) || !SCALAR_FLOAT_TYPE_P (type)) + return NULL_TREE; + if ((TYPE_PRECISION (fromtype) == 16 && TYPE_PRECISION (type) > 32) + || (TYPE_PRECISION (type) == 16 && TYPE_PRECISION (fromtype) > 32)) + return convert (type, convert (float_type_node, expr)); + return NULL_TREE; +} + +/* Implement TARGET_SCALAR_MODE_SUPPORTED_P. + This simply adds HFmode as a supported mode; even though we don't + implement arithmetic on this type directly, it's supported by + optabs conversions, much the way the double-word arithmetic is + special-cased in the default hook. */ + +static bool +arm_scalar_mode_supported_p (enum machine_mode mode) +{ + if (mode == HFmode) + return (arm_fp16_format != ARM_FP16_FORMAT_NONE); + else + return default_scalar_mode_supported_p (mode); } /* Errors in the source file can cause expand_expr to return const0_rtx @@ -17297,6 +17515,7 @@ thumb_shiftable_const (unsigned HOST_WIDE_INT val) unsigned HOST_WIDE_INT mask = 0xff; int i; + val = val & (unsigned HOST_WIDE_INT)0xffffffffu; if (val == 0) /* XXX */ return 0; @@ -18413,6 +18632,10 @@ arm_file_start (void) fpu_name = "neon"; set_float_abi_attributes = 1; break; + case FPUTYPE_NEON_FP16: + fpu_name = "neon-fp16"; + set_float_abi_attributes = 1; + break; default: abort(); } @@ -18466,6 +18689,11 @@ arm_file_start (void) val = 6; asm_fprintf (asm_out_file, "\t.eabi_attribute 30, %d\n", val); + /* Tag_ABI_FP_16bit_format. */ + if (arm_fp16_format) + asm_fprintf (asm_out_file, "\t.eabi_attribute 38, %d\n", + (int)arm_fp16_format); + if (arm_lang_output_object_attributes_hook) arm_lang_output_object_attributes_hook(); } @@ -18695,6 +18923,23 @@ arm_emit_vector_const (FILE *file, rtx x) return 1; } +/* Emit a fp16 constant appropriately padded to occupy a 4-byte word. + HFmode constant pool entries are actually loaded with ldr. */ +void +arm_emit_fp16_const (rtx c) +{ + REAL_VALUE_TYPE r; + long bits; + + REAL_VALUE_FROM_CONST_DOUBLE (r, c); + bits = real_to_target (NULL, &r, HFmode); + if (WORDS_BIG_ENDIAN) + assemble_zeros (2); + assemble_integer (GEN_INT (bits), 2, BITS_PER_WORD, 1); + if (!WORDS_BIG_ENDIAN) + assemble_zeros (2); +} + const char * arm_output_load_gr (rtx *operands) { @@ -19615,6 +19860,32 @@ arm_output_shift(rtx * operands, int set_flags) return ""; } +/* Output a Thumb-1 casesi dispatch sequence. */ +const char * +thumb1_output_casesi (rtx *operands) +{ + rtx diff_vec = PATTERN (next_real_insn (operands[0])); + addr_diff_vec_flags flags; + + gcc_assert (GET_CODE (diff_vec) == ADDR_DIFF_VEC); + + flags = ADDR_DIFF_VEC_FLAGS (diff_vec); + + switch (GET_MODE(diff_vec)) + { + case QImode: + return (ADDR_DIFF_VEC_FLAGS (diff_vec).offset_unsigned ? + "bl\t%___gnu_thumb1_case_uqi" : "bl\t%___gnu_thumb1_case_sqi"); + case HImode: + return (ADDR_DIFF_VEC_FLAGS (diff_vec).offset_unsigned ? + "bl\t%___gnu_thumb1_case_uhi" : "bl\t%___gnu_thumb1_case_shi"); + case SImode: + return "bl\t%___gnu_thumb1_case_si"; + default: + gcc_unreachable (); + } +} + /* Output a Thumb-2 casesi instruction. */ const char * thumb2_output_casesi (rtx *operands) @@ -19724,6 +19995,10 @@ arm_mangle_type (const_tree type) return "St9__va_list"; } + /* Half-precision float. */ + if (TREE_CODE (type) == REAL_TYPE && TYPE_PRECISION (type) == 16) + return "Dh"; + if (TREE_CODE (type) != VECTOR_TYPE) return NULL; diff --git a/gcc/config/arm/arm.h b/gcc/config/arm/arm.h index ee0eee694d2..98115d8a140 100644 --- a/gcc/config/arm/arm.h +++ b/gcc/config/arm/arm.h @@ -215,20 +215,25 @@ extern void (*arm_lang_output_object_attributes_hook)(void); /* FPU is has the full VFPv3/NEON register file of 32 D registers. */ #define TARGET_VFPD32 (arm_fp_model == ARM_FP_MODEL_VFP \ && (arm_fpu_arch == FPUTYPE_VFP3 \ - || arm_fpu_arch == FPUTYPE_NEON)) + || arm_fpu_arch == FPUTYPE_NEON \ + || arm_fpu_arch == FPUTYPE_NEON_FP16)) /* FPU supports VFPv3 instructions. */ #define TARGET_VFP3 (arm_fp_model == ARM_FP_MODEL_VFP \ && (arm_fpu_arch == FPUTYPE_VFP3D16 \ || TARGET_VFPD32)) +/* FPU supports NEON/VFP half-precision floating-point. */ +#define TARGET_NEON_FP16 (arm_fpu_arch == FPUTYPE_NEON_FP16) + /* FPU supports Neon instructions. The setting of this macro gets revealed via __ARM_NEON__ so we add extra guards upon TARGET_32BIT and TARGET_HARD_FLOAT to ensure that NEON instructions are available. */ #define TARGET_NEON (TARGET_32BIT && TARGET_HARD_FLOAT \ && arm_fp_model == ARM_FP_MODEL_VFP \ - && arm_fpu_arch == FPUTYPE_NEON) + && (arm_fpu_arch == FPUTYPE_NEON \ + || arm_fpu_arch == FPUTYPE_NEON_FP16)) /* "DSP" multiply instructions, eg. SMULxy. */ #define TARGET_DSP_MULTIPLY \ @@ -308,7 +313,9 @@ enum fputype /* VFPv3. */ FPUTYPE_VFP3, /* Neon. */ - FPUTYPE_NEON + FPUTYPE_NEON, + /* Neon with half-precision float extensions. */ + FPUTYPE_NEON_FP16 }; /* Recast the floating point class to be the floating point attribute. */ @@ -333,6 +340,21 @@ extern enum float_abi_type arm_float_abi; #define TARGET_DEFAULT_FLOAT_ABI ARM_FLOAT_ABI_SOFT #endif +/* Which __fp16 format to use. + The enumeration values correspond to the numbering for the + Tag_ABI_FP_16bit_format attribute. + */ +enum arm_fp16_format_type +{ + ARM_FP16_FORMAT_NONE = 0, + ARM_FP16_FORMAT_IEEE = 1, + ARM_FP16_FORMAT_ALTERNATIVE = 2 +}; + +extern enum arm_fp16_format_type arm_fp16_format; +#define LARGEST_EXPONENT_IS_NORMAL(bits) \ + ((bits) == 16 && arm_fp16_format == ARM_FP16_FORMAT_ALTERNATIVE) + /* Which ABI to use. */ enum arm_abi_type { @@ -2174,12 +2196,24 @@ typedef struct for the index in the tablejump instruction. */ #define CASE_VECTOR_MODE Pmode -#define CASE_VECTOR_PC_RELATIVE TARGET_THUMB2 - -#define CASE_VECTOR_SHORTEN_MODE(min, max, body) \ - ((min < 0 || max >= 0x2000 || !TARGET_THUMB2) ? SImode \ - : (max >= 0x200) ? HImode \ - : QImode) +#define CASE_VECTOR_PC_RELATIVE (TARGET_THUMB2 \ + || (TARGET_THUMB \ + && (optimize_size || flag_pic))) + +#define CASE_VECTOR_SHORTEN_MODE(min, max, body) \ + (TARGET_THUMB \ + ? (min >= 0 && max < 512 \ + ? (ADDR_DIFF_VEC_FLAGS (body).offset_unsigned = 1, QImode) \ + : min >= -256 && max < 256 \ + ? (ADDR_DIFF_VEC_FLAGS (body).offset_unsigned = 0, QImode) \ + : min >= 0 && max < 8192 \ + ? (ADDR_DIFF_VEC_FLAGS (body).offset_unsigned = 1, HImode) \ + : min >= -4096 && max < 4096 \ + ? (ADDR_DIFF_VEC_FLAGS (body).offset_unsigned = 0, HImode) \ + : SImode) \ + : ((min < 0 || max >= 0x2000 || !TARGET_THUMB2) ? SImode \ + : (max >= 0x200) ? HImode \ + : QImode)) /* signed 'char' is most compatible, but RISC OS wants it unsigned. unsigned is probably best, but may break some code. */ diff --git a/gcc/config/arm/arm.md b/gcc/config/arm/arm.md index 40e41c56021..47972424dbf 100644 --- a/gcc/config/arm/arm.md +++ b/gcc/config/arm/arm.md @@ -99,6 +99,7 @@ ; correctly for PIC usage. (UNSPEC_GOTSYM_OFF 24) ; The offset of the start of the the GOT from a ; a given symbolic address. + (UNSPEC_THUMB1_CASESI 25) ; A Thumb1 compressed dispatch-table call. ] ) @@ -158,7 +159,7 @@ ; Floating Point Unit. If we only have floating point emulation, then there ; is no point in scheduling the floating point insns. (Well, for best ; performance we should try and group them together). -(define_attr "fpu" "none,fpa,fpe2,fpe3,maverick,vfp,vfpv3d16,vfpv3,neon" +(define_attr "fpu" "none,fpa,fpe2,fpe3,maverick,vfp,vfpv3d16,vfpv3,neon,neon_fp16" (const (symbol_ref "arm_fpu_attr"))) ; LENGTH of an instruction (in bytes) @@ -3734,6 +3735,34 @@ ;; Fixed <--> Floating conversion insns +(define_expand "floatsihf2" + [(set (match_operand:HF 0 "general_operand" "") + (float:HF (match_operand:SI 1 "general_operand" "")))] + "TARGET_EITHER" + " + { + rtx op1 = gen_reg_rtx (SFmode); + expand_float (op1, operands[1], 0); + op1 = convert_to_mode (HFmode, op1, 0); + emit_move_insn (operands[0], op1); + DONE; + }" +) + +(define_expand "floatdihf2" + [(set (match_operand:HF 0 "general_operand" "") + (float:HF (match_operand:DI 1 "general_operand" "")))] + "TARGET_EITHER" + " + { + rtx op1 = gen_reg_rtx (SFmode); + expand_float (op1, operands[1], 0); + op1 = convert_to_mode (HFmode, op1, 0); + emit_move_insn (operands[0], op1); + DONE; + }" +) + (define_expand "floatsisf2" [(set (match_operand:SF 0 "s_register_operand" "") (float:SF (match_operand:SI 1 "s_register_operand" "")))] @@ -3758,6 +3787,30 @@ } ") +(define_expand "fix_trunchfsi2" + [(set (match_operand:SI 0 "general_operand" "") + (fix:SI (fix:HF (match_operand:HF 1 "general_operand" ""))))] + "TARGET_EITHER" + " + { + rtx op1 = convert_to_mode (SFmode, operands[1], 0); + expand_fix (operands[0], op1, 0); + DONE; + }" +) + +(define_expand "fix_trunchfdi2" + [(set (match_operand:DI 0 "general_operand" "") + (fix:DI (fix:HF (match_operand:HF 1 "general_operand" ""))))] + "TARGET_EITHER" + " + { + rtx op1 = convert_to_mode (SFmode, operands[1], 0); + expand_fix (operands[0], op1, 0); + DONE; + }" +) + (define_expand "fix_truncsfsi2" [(set (match_operand:SI 0 "s_register_operand" "") (fix:SI (fix:SF (match_operand:SF 1 "s_register_operand" ""))))] @@ -3797,6 +3850,22 @@ "TARGET_32BIT && TARGET_HARD_FLOAT" "" ) + +/* DFmode -> HFmode conversions have to go through SFmode. */ +(define_expand "truncdfhf2" + [(set (match_operand:HF 0 "general_operand" "") + (float_truncate:HF + (match_operand:DF 1 "general_operand" "")))] + "TARGET_EITHER" + " + { + rtx op1; + op1 = convert_to_mode (SFmode, operands[1], 0); + op1 = convert_to_mode (HFmode, op1, 0); + emit_move_insn (operands[0], op1); + DONE; + }" +) ;; Zero and sign extension instructions. @@ -4660,6 +4729,21 @@ "TARGET_32BIT && TARGET_HARD_FLOAT" "" ) + +/* HFmode -> DFmode conversions have to go through SFmode. */ +(define_expand "extendhfdf2" + [(set (match_operand:DF 0 "general_operand" "") + (float_extend:DF (match_operand:HF 1 "general_operand" "")))] + "TARGET_EITHER" + " + { + rtx op1; + op1 = convert_to_mode (SFmode, operands[1], 0); + op1 = convert_to_mode (DFmode, op1, 0); + emit_insn (gen_movdf (operands[0], op1)); + DONE; + }" +) ;; Move insns (including loads and stores) @@ -5083,7 +5167,7 @@ (set (match_dup 0) (ashift:SI (match_dup 0) (match_dup 2)))] " { - unsigned HOST_WIDE_INT val = INTVAL (operands[1]); + unsigned HOST_WIDE_INT val = INTVAL (operands[1]) & 0xffffffffu; unsigned HOST_WIDE_INT mask = 0xff; int i; @@ -5808,6 +5892,107 @@ (set_attr "pool_range" "*,32,*,*,*,*")] ) +;; HFmode moves +(define_expand "movhf" + [(set (match_operand:HF 0 "general_operand" "") + (match_operand:HF 1 "general_operand" ""))] + "TARGET_EITHER" + " + if (TARGET_32BIT) + { + if (GET_CODE (operands[0]) == MEM) + operands[1] = force_reg (HFmode, operands[1]); + } + else /* TARGET_THUMB1 */ + { + if (can_create_pseudo_p ()) + { + if (GET_CODE (operands[0]) != REG) + operands[1] = force_reg (HFmode, operands[1]); + } + } + " +) + +(define_insn "*arm32_movhf" + [(set (match_operand:HF 0 "nonimmediate_operand" "=r,m,r,r") + (match_operand:HF 1 "general_operand" " m,r,r,F"))] + "TARGET_32BIT && !(TARGET_HARD_FLOAT && TARGET_NEON_FP16) + && ( s_register_operand (operands[0], HFmode) + || s_register_operand (operands[1], HFmode))" + "* + switch (which_alternative) + { + case 0: /* ARM register from memory */ + return \"ldr%(h%)\\t%0, %1\\t%@ __fp16\"; + case 1: /* memory from ARM register */ + return \"str%(h%)\\t%1, %0\\t%@ __fp16\"; + case 2: /* ARM register from ARM register */ + return \"mov%?\\t%0, %1\\t%@ __fp16\"; + case 3: /* ARM register from constant */ + { + REAL_VALUE_TYPE r; + long bits; + rtx ops[4]; + + REAL_VALUE_FROM_CONST_DOUBLE (r, operands[1]); + bits = real_to_target (NULL, &r, HFmode); + ops[0] = operands[0]; + ops[1] = GEN_INT (bits); + ops[2] = GEN_INT (bits & 0xff00); + ops[3] = GEN_INT (bits & 0x00ff); + + if (arm_arch_thumb2) + output_asm_insn (\"movw%?\\t%0, %1\", ops); + else + output_asm_insn (\"mov%?\\t%0, %2\;orr%?\\t%0, %0, %3\", ops); + return \"\"; + } + default: + gcc_unreachable (); + } + " + [(set_attr "conds" "unconditional") + (set_attr "type" "load1,store1,*,*") + (set_attr "length" "4,4,4,8") + (set_attr "predicable" "yes") + ] +) + +(define_insn "*thumb1_movhf" + [(set (match_operand:HF 0 "nonimmediate_operand" "=l,l,m,*r,*h") + (match_operand:HF 1 "general_operand" "l,mF,l,*h,*r"))] + "TARGET_THUMB1 + && ( s_register_operand (operands[0], HFmode) + || s_register_operand (operands[1], HFmode))" + "* + switch (which_alternative) + { + case 1: + { + rtx addr; + gcc_assert (GET_CODE(operands[1]) == MEM); + addr = XEXP (operands[1], 0); + if (GET_CODE (addr) == LABEL_REF + || (GET_CODE (addr) == CONST + && GET_CODE (XEXP (addr, 0)) == PLUS + && GET_CODE (XEXP (XEXP (addr, 0), 0)) == LABEL_REF + && GET_CODE (XEXP (XEXP (addr, 0), 1)) == CONST_INT)) + { + /* Constant pool entry. */ + return \"ldr\\t%0, %1\"; + } + return \"ldrh\\t%0, %1\"; + } + case 2: return \"strh\\t%1, %0\"; + default: return \"mov\\t%0, %1\"; + } + " + [(set_attr "length" "2") + (set_attr "type" "*,load1,store1,*,*") + (set_attr "pool_range" "*,1020,*,*,*")] +) + (define_expand "movsf" [(set (match_operand:SF 0 "general_operand" "") (match_operand:SF 1 "general_operand" ""))] @@ -8717,37 +8902,33 @@ (match_operand:SI 2 "const_int_operand" "") ; total range (match_operand:SI 3 "" "") ; table label (match_operand:SI 4 "" "")] ; Out of range label - "TARGET_32BIT" + "TARGET_32BIT || optimize_size || flag_pic" " { - rtx reg; + enum insn_code code; if (operands[1] != const0_rtx) { - reg = gen_reg_rtx (SImode); + rtx reg = gen_reg_rtx (SImode); emit_insn (gen_addsi3 (reg, operands[0], GEN_INT (-INTVAL (operands[1])))); operands[0] = reg; } - if (!const_ok_for_arm (INTVAL (operands[2]))) - operands[2] = force_reg (SImode, operands[2]); - if (TARGET_ARM) - { - emit_jump_insn (gen_arm_casesi_internal (operands[0], operands[2], - operands[3], operands[4])); - } + code = CODE_FOR_arm_casesi_internal; + else if (TARGET_THUMB) + code = CODE_FOR_thumb1_casesi_internal_pic; else if (flag_pic) - { - emit_jump_insn (gen_thumb2_casesi_internal_pic (operands[0], - operands[2], operands[3], operands[4])); - } + code = CODE_FOR_thumb2_casesi_internal_pic; else - { - emit_jump_insn (gen_thumb2_casesi_internal (operands[0], operands[2], - operands[3], operands[4])); - } + code = CODE_FOR_thumb2_casesi_internal; + + if (!insn_data[(int) code].operand[1].predicate(operands[2], SImode)) + operands[2] = force_reg (SImode, operands[2]); + + emit_jump_insn (GEN_FCN ((int) code) (operands[0], operands[2], + operands[3], operands[4])); DONE; }" ) @@ -8774,6 +8955,37 @@ (set_attr "length" "12")] ) +(define_expand "thumb1_casesi_internal_pic" + [(match_operand:SI 0 "s_register_operand" "") + (match_operand:SI 1 "thumb1_cmp_operand" "") + (match_operand 2 "" "") + (match_operand 3 "" "")] + "TARGET_THUMB" + { + rtx reg0; + rtx test = gen_rtx_GTU (VOIDmode, operands[0], operands[1]); + emit_jump_insn (gen_cbranchsi4 (test, operands[0], operands[1], + operands[3])); + reg0 = gen_rtx_REG (SImode, 0); + emit_move_insn (reg0, operands[0]); + emit_jump_insn (gen_thumb1_casesi_dispatch (operands[2]/*, operands[3]*/)); + DONE; + } +) + +(define_insn "thumb1_casesi_dispatch" + [(parallel [(set (pc) (unspec [(reg:SI 0) + (label_ref (match_operand 0 "" "")) +;; (label_ref (match_operand 1 "" "")) +] + UNSPEC_THUMB1_CASESI)) + (clobber (reg:SI IP_REGNUM)) + (clobber (reg:SI LR_REGNUM))])] + "TARGET_THUMB" + "* return thumb1_output_casesi(operands);" + [(set_attr "length" "4")] +) + (define_expand "indirect_jump" [(set (pc) (match_operand:SI 0 "s_register_operand" ""))] @@ -10674,6 +10886,7 @@ "TARGET_THUMB1" "* making_const_table = TRUE; + gcc_assert (GET_MODE_CLASS (GET_MODE (operands[0])) != MODE_FLOAT); assemble_integer (operands[0], 2, BITS_PER_WORD, 1); assemble_zeros (2); return \"\"; @@ -10686,19 +10899,23 @@ "TARGET_EITHER" "* { + rtx x = operands[0]; making_const_table = TRUE; - switch (GET_MODE_CLASS (GET_MODE (operands[0]))) + switch (GET_MODE_CLASS (GET_MODE (x))) { case MODE_FLOAT: - { - REAL_VALUE_TYPE r; - REAL_VALUE_FROM_CONST_DOUBLE (r, operands[0]); - assemble_real (r, GET_MODE (operands[0]), BITS_PER_WORD); - break; - } + if (GET_MODE (x) == HFmode) + arm_emit_fp16_const (x); + else + { + REAL_VALUE_TYPE r; + REAL_VALUE_FROM_CONST_DOUBLE (r, x); + assemble_real (r, GET_MODE (x), BITS_PER_WORD); + } + break; default: - assemble_integer (operands[0], 4, BITS_PER_WORD, 1); - mark_symbol_refs_as_used (operands[0]); + assemble_integer (x, 4, BITS_PER_WORD, 1); + mark_symbol_refs_as_used (x); break; } return \"\"; diff --git a/gcc/config/arm/arm.opt b/gcc/config/arm/arm.opt index 6aca3950db5..a39bb3a8d5c 100644 --- a/gcc/config/arm/arm.opt +++ b/gcc/config/arm/arm.opt @@ -78,6 +78,10 @@ Specify if floating point hardware should be used mfp= Target RejectNegative Joined Undocumented Var(target_fpe_name) +mfp16-format= +Target RejectNegative Joined Var(target_fp16_format_name) +Specify the __fp16 floating-point format + ;; Now ignored. mfpe Target RejectNegative Mask(FPE) Undocumented diff --git a/gcc/config/arm/coff.h b/gcc/config/arm/coff.h index d5f4ed8eac5..bd3e6f85dd4 100644 --- a/gcc/config/arm/coff.h +++ b/gcc/config/arm/coff.h @@ -60,8 +60,9 @@ Otherwise, the readonly data section is used. */ /* We put ARM and Thumb-2 jump tables in the text section, because it makes the code more efficient, but for Thumb-1 it's better to put them out of - band. */ -#define JUMP_TABLES_IN_TEXT_SECTION (TARGET_32BIT) + band unless we are generating compressed tables. */ +#define JUMP_TABLES_IN_TEXT_SECTION \ + (TARGET_32BIT || (TARGET_THUMB && (optimize_size || flag_pic))) #undef READONLY_DATA_SECTION_ASM_OP #define READONLY_DATA_SECTION_ASM_OP "\t.section .rdata" diff --git a/gcc/config/arm/elf.h b/gcc/config/arm/elf.h index 7c3eddbe058..88400884ec1 100644 --- a/gcc/config/arm/elf.h +++ b/gcc/config/arm/elf.h @@ -100,8 +100,9 @@ Otherwise, the readonly data section is used. */ /* We put ARM and Thumb-2 jump tables in the text section, because it makes the code more efficient, but for Thumb-1 it's better to put them out of - band. */ -#define JUMP_TABLES_IN_TEXT_SECTION (TARGET_32BIT) + band unless we are generating compressed tables. */ +#define JUMP_TABLES_IN_TEXT_SECTION \ + (TARGET_32BIT || (TARGET_THUMB && (optimize_size || flag_pic))) #ifndef LINK_SPEC #define LINK_SPEC "%{mbig-endian:-EB} %{mlittle-endian:-EL} -X" diff --git a/gcc/config/arm/fp16.c b/gcc/config/arm/fp16.c new file mode 100644 index 00000000000..936caeb78d0 --- /dev/null +++ b/gcc/config/arm/fp16.c @@ -0,0 +1,145 @@ +/* Half-float conversion routines. + + Copyright (C) 2008, 2009 Free Software Foundation, Inc. + Contributed by CodeSourcery. + + This file is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 3, or (at your option) any + later version. + + This file is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + Under Section 7 of GPL version 3, you are granted additional + permissions described in the GCC Runtime Library Exception, version + 3.1, as published by the Free Software Foundation. + + You should have received a copy of the GNU General Public License and + a copy of the GCC Runtime Library Exception along with this program; + see the files COPYING3 and COPYING.RUNTIME respectively. If not, see + <http://www.gnu.org/licenses/>. */ + +static inline unsigned short +__gnu_f2h_internal(unsigned int a, int ieee) +{ + unsigned short sign = (a >> 16) & 0x8000; + int aexp = (a >> 23) & 0xff; + unsigned int mantissa = a & 0x007fffff; + unsigned int mask; + unsigned int increment; + + if (aexp == 0xff) + { + if (!ieee) + return sign; + return sign | 0x7e00 | (mantissa >> 13); + } + + if (aexp == 0 && mantissa == 0) + return sign; + + aexp -= 127; + + /* Decimal point between bits 22 and 23. */ + mantissa |= 0x00800000; + if (aexp < -14) + { + mask = 0x007fffff; + if (aexp < -25) + aexp = -26; + else if (aexp != -25) + mask >>= 24 + aexp; + } + else + mask = 0x00001fff; + + /* Round. */ + if (mantissa & mask) + { + increment = (mask + 1) >> 1; + if ((mantissa & mask) == increment) + increment = mantissa & (increment << 1); + mantissa += increment; + if (mantissa >= 0x01000000) + { + mantissa >>= 1; + aexp++; + } + } + + if (ieee) + { + if (aexp > 15) + return sign | 0x7c00; + } + else + { + if (aexp > 16) + return sign | 0x7fff; + } + + if (aexp < -24) + return sign; + + if (aexp < -14) + { + mantissa >>= -14 - aexp; + aexp = -14; + } + + /* We leave the leading 1 in the mantissa, and subtract one + from the exponent bias to compensate. */ + return sign | (((aexp + 14) << 10) + (mantissa >> 13)); +} + +unsigned int +__gnu_h2f_internal(unsigned short a, int ieee) +{ + unsigned int sign = (unsigned int)(a & 0x8000) << 16; + int aexp = (a >> 10) & 0x1f; + unsigned int mantissa = a & 0x3ff; + + if (aexp == 0x1f && ieee) + return sign | 0x7f800000 | (mantissa << 13); + + if (aexp == 0) + { + int shift; + + if (mantissa == 0) + return sign; + + shift = __builtin_clz(mantissa) - 21; + mantissa <<= shift; + aexp = -shift; + } + + return sign | (((aexp + 0x70) << 23) + (mantissa << 13)); +} + +unsigned short +__gnu_f2h_ieee(unsigned int a) +{ + return __gnu_f2h_internal(a, 1); +} + +unsigned int +__gnu_h2f_ieee(unsigned short a) +{ + return __gnu_h2f_internal(a, 1); +} + +unsigned short +__gnu_f2h_alternative(unsigned int x) +{ + return __gnu_f2h_internal(x, 0); +} + +unsigned int +__gnu_h2f_alternative(unsigned short a) +{ + return __gnu_h2f_internal(a, 0); +} diff --git a/gcc/config/arm/lib1funcs.asm b/gcc/config/arm/lib1funcs.asm index cc5b94e91fe..987bfcb3ba4 100644 --- a/gcc/config/arm/lib1funcs.asm +++ b/gcc/config/arm/lib1funcs.asm @@ -27,8 +27,17 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined(__ELF__) && defined(__linux__) .section .note.GNU-stack,"",%progbits .previous -#endif - +#endif /* __ELF__ and __linux__ */ + +#ifdef __ARM_EABI__ +/* Some attributes that are common to all routines in this file. */ + /* Tag_ABI_align8_needed: This code does not require 8-byte + alignment from the caller. */ + /* .eabi_attribute 24, 0 -- default setting. */ + /* Tag_ABI_align8_preserved: This code preserves 8-byte + alignment in any callee. */ + .eabi_attribute 25, 1 +#endif /* __ARM_EABI__ */ /* ------------------------------------------------------------------------ */ /* We need to know what prefix to add to function names. */ @@ -1533,6 +1542,111 @@ LSYM(Lchange_\register): #endif /* L_interwork_call_via_rX */ #endif /* !__thumb2__ */ + +/* Functions to support compact pic switch tables in thumb1 state. + All these routines take an index into the table in r0. The + table is at LR & ~1 (but this must be rounded up in the case + of 32-bit entires). They are only permitted to clobber r12 + and r14 and r0 must be preserved on exit. */ +#ifdef L_thumb1_case_sqi + + .text + .align 0 + .force_thumb + .syntax unified + THUMB_FUNC_START __gnu_thumb1_case_sqi + push {r1} + mov r1, lr + lsrs r1, r1, #1 + lsls r1, r1, #1 + ldrsb r1, [r1, r0] + lsls r1, r1, #1 + add lr, lr, r1 + pop {r1} + bx lr + SIZE (__gnu_thumb1_case_sqi) +#endif + +#ifdef L_thumb1_case_uqi + + .text + .align 0 + .force_thumb + .syntax unified + THUMB_FUNC_START __gnu_thumb1_case_uqi + push {r1} + mov r1, lr + lsrs r1, r1, #1 + lsls r1, r1, #1 + ldrb r1, [r1, r0] + lsls r1, r1, #1 + add lr, lr, r1 + pop {r1} + bx lr + SIZE (__gnu_thumb1_case_uqi) +#endif + +#ifdef L_thumb1_case_shi + + .text + .align 0 + .force_thumb + .syntax unified + THUMB_FUNC_START __gnu_thumb1_case_shi + push {r0, r1} + mov r1, lr + lsrs r1, r1, #1 + lsls r0, r0, #1 + lsls r1, r1, #1 + ldrsh r1, [r1, r0] + lsls r1, r1, #1 + add lr, lr, r1 + pop {r0, r1} + bx lr + SIZE (__gnu_thumb1_case_shi) +#endif + +#ifdef L_thumb1_case_uhi + + .text + .align 0 + .force_thumb + .syntax unified + THUMB_FUNC_START __gnu_thumb1_case_uhi + push {r0, r1} + mov r1, lr + lsrs r1, r1, #1 + lsls r0, r0, #1 + lsls r1, r1, #1 + ldrh r1, [r1, r0] + lsls r1, r1, #1 + add lr, lr, r1 + pop {r0, r1} + bx lr + SIZE (__gnu_thumb1_case_uhi) +#endif + +#ifdef L_thumb1_case_si + + .text + .align 0 + .force_thumb + .syntax unified + THUMB_FUNC_START __gnu_thumb1_case_si + push {r0, r1} + mov r1, lr + adds.n r1, r1, #2 /* Align to word. */ + lsrs r1, r1, #2 + lsls r0, r0, #2 + lsls r1, r1, #2 + ldr r0, [r1, r0] + adds r0, r0, r1 + mov lr, r0 + pop {r0, r1} + mov pc, lr /* We know we were called from thumb code. */ + SIZE (__gnu_thumb1_case_si) +#endif + #endif /* Arch supports thumb. */ #ifndef __symbian__ diff --git a/gcc/config/arm/sfp-machine.h b/gcc/config/arm/sfp-machine.h index 4a456ae03a2..a89d05a00ba 100644 --- a/gcc/config/arm/sfp-machine.h +++ b/gcc/config/arm/sfp-machine.h @@ -19,9 +19,11 @@ typedef int __gcc_CMPtype __attribute__ ((mode (__libgcc_cmp_return__))); #define _FP_DIV_MEAT_D(R,X,Y) _FP_DIV_MEAT_2_udiv(D,R,X,Y) #define _FP_DIV_MEAT_Q(R,X,Y) _FP_DIV_MEAT_4_udiv(Q,R,X,Y) +#define _FP_NANFRAC_H ((_FP_QNANBIT_H << 1) - 1) #define _FP_NANFRAC_S ((_FP_QNANBIT_S << 1) - 1) #define _FP_NANFRAC_D ((_FP_QNANBIT_D << 1) - 1), -1 #define _FP_NANFRAC_Q ((_FP_QNANBIT_Q << 1) - 1), -1, -1, -1 +#define _FP_NANSIGN_H 0 #define _FP_NANSIGN_S 0 #define _FP_NANSIGN_D 0 #define _FP_NANSIGN_Q 0 @@ -97,5 +99,7 @@ typedef int __gcc_CMPtype __attribute__ ((mode (__libgcc_cmp_return__))); #define __fixdfdi __aeabi_d2lz #define __fixunsdfdi __aeabi_d2ulz #define __floatdidf __aeabi_l2d +#define __extendhfsf2 __gnu_h2f_ieee +#define __truncsfhf2 __gnu_f2h_ieee #endif /* __ARM_EABI__ */ diff --git a/gcc/config/arm/t-arm b/gcc/config/arm/t-arm index c47297f828b..de2bbc4ca68 100644 --- a/gcc/config/arm/t-arm +++ b/gcc/config/arm/t-arm @@ -33,6 +33,9 @@ MD_INCLUDES= $(srcdir)/config/arm/arm-tune.md \ $(srcdir)/config/arm/neon.md \ $(srcdir)/config/arm/thumb2.md +LIB1ASMSRC = arm/lib1funcs.asm +LIB1ASMFUNCS = _thumb1_case_sqi _thumb1_case_uqi _thumb1_case_shi \ + _thumb1_case_uhi _thumb1_case_si s-config s-conditions s-flags s-codes s-constants s-emit s-recog s-preds \ s-opinit s-extract s-peep s-attr s-attrtab s-output: $(MD_INCLUDES) diff --git a/gcc/config/arm/t-arm-elf b/gcc/config/arm/t-arm-elf index a268ddb8cd6..6a90d331148 100644 --- a/gcc/config/arm/t-arm-elf +++ b/gcc/config/arm/t-arm-elf @@ -17,12 +17,11 @@ # along with GCC; see the file COPYING3. If not see # <http://www.gnu.org/licenses/>. -LIB1ASMSRC = arm/lib1funcs.asm # For most CPUs we have an assembly soft-float implementations. # However this is not true for ARMv6M. Here we want to use the soft-fp C # implementation. The soft-fp code is only build for ARMv6M. This pulls # in the asm implementation for other CPUs. -LIB1ASMFUNCS = _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _bb_init_func \ +LIB1ASMFUNCS += _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _bb_init_func \ _call_via_rX _interwork_call_via_rX \ _lshrdi3 _ashrdi3 _ashldi3 \ _arm_negdf2 _arm_addsubdf3 _arm_muldivdf3 _arm_cmpdf2 _arm_unorddf2 \ @@ -30,7 +29,7 @@ LIB1ASMFUNCS = _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _bb_init_func \ _arm_truncdfsf2 _arm_negsf2 _arm_addsubsf3 _arm_muldivsf3 \ _arm_cmpsf2 _arm_unordsf2 _arm_fixsfsi _arm_fixunssfsi \ _arm_floatdidf _arm_floatdisf _arm_floatundidf _arm_floatundisf \ - _clzsi2 _clzdi2 + _clzsi2 _clzdi2 MULTILIB_OPTIONS = marm/mthumb MULTILIB_DIRNAMES = arm thumb diff --git a/gcc/config/arm/t-bpabi b/gcc/config/arm/t-bpabi index c31d357bedb..61da9ec7b4c 100644 --- a/gcc/config/arm/t-bpabi +++ b/gcc/config/arm/t-bpabi @@ -23,6 +23,8 @@ LIB1ASMFUNCS += _aeabi_lcmp _aeabi_ulcmp _aeabi_ldivmod _aeabi_uldivmod LIB2FUNCS_EXTRA = $(srcdir)/config/arm/bpabi.c \ $(srcdir)/config/arm/unaligned-funcs.c +LIB2FUNCS_STATIC_EXTRA = $(srcdir)/config/arm/fp16.c + UNWIND_H = $(srcdir)/config/arm/unwind-arm.h LIB2ADDEH = $(srcdir)/config/arm/unwind-arm.c \ $(srcdir)/config/arm/libunwind.S \ diff --git a/gcc/config/arm/t-pe b/gcc/config/arm/t-pe index e965a1c61c2..8adfd1f90c2 100644 --- a/gcc/config/arm/t-pe +++ b/gcc/config/arm/t-pe @@ -17,8 +17,7 @@ # along with GCC; see the file COPYING3. If not see # <http://www.gnu.org/licenses/>. -LIB1ASMSRC = arm/lib1funcs.asm -LIB1ASMFUNCS = _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _call_via_rX _interwork_call_via_rX _clzsi2 _clzdi2 +LIB1ASMFUNCS += _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _call_via_rX _interwork_call_via_rX _clzsi2 _clzdi2 # We want fine grained libraries, so use the new code to build the # floating point emulation libraries. diff --git a/gcc/config/arm/t-strongarm-elf b/gcc/config/arm/t-strongarm-elf index bf130635f85..64d7ca69499 100644 --- a/gcc/config/arm/t-strongarm-elf +++ b/gcc/config/arm/t-strongarm-elf @@ -16,8 +16,7 @@ # along with GCC; see the file COPYING3. If not see # <http://www.gnu.org/licenses/>. -LIB1ASMSRC = arm/lib1funcs.asm -LIB1ASMFUNCS = _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _bb_init_func _clzsi2 _clzdi2 +LIB1ASMFUNCS += _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _bb_init_func _clzsi2 _clzdi2 # We want fine grained libraries, so use the new code to build the # floating point emulation libraries. diff --git a/gcc/config/arm/t-symbian b/gcc/config/arm/t-symbian index 5b6f0078914..4a1476f6791 100644 --- a/gcc/config/arm/t-symbian +++ b/gcc/config/arm/t-symbian @@ -16,7 +16,7 @@ # along with GCC; see the file COPYING3. If not see # <http://www.gnu.org/licenses/>. -LIB1ASMFUNCS = _bb_init_func _call_via_rX _interwork_call_via_rX _clzsi2 _clzdi2 +LIB1ASMFUNCS += _bb_init_func _call_via_rX _interwork_call_via_rX _clzsi2 _clzdi2 # These functions have __aeabi equivalents and will never be called by GCC. # By putting them in LIB1ASMFUNCS, we avoid the standard libgcc2.c code being @@ -35,6 +35,9 @@ UNWIND_H = $(srcdir)/config/arm/unwind-arm.h LIB2ADDEH = $(srcdir)/unwind-c.c $(srcdir)/config/arm/pr-support.c LIB2ADDEHDEP = $(UNWIND_H) +# Include half-float helpers. +LIB2FUNCS_STATIC_EXTRA = $(srcdir)/config/arm/fp16.c + # Create a multilib for processors with VFP floating-point, and a # multilib for those without -- using the soft-float ABI in both # cases. Symbian OS object should be compiled with interworking diff --git a/gcc/config/arm/t-vxworks b/gcc/config/arm/t-vxworks index c9514b5a4e5..af01ac412db 100644 --- a/gcc/config/arm/t-vxworks +++ b/gcc/config/arm/t-vxworks @@ -16,8 +16,7 @@ # along with GCC; see the file COPYING3. If not see # <http://www.gnu.org/licenses/>. -LIB1ASMSRC = arm/lib1funcs.asm -LIB1ASMFUNCS = _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _bb_init_func _call_via_rX _interwork_call_via_rX _clzsi2 _clzdi2 +LIB1ASMFUNCS += _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _bb_init_func _call_via_rX _interwork_call_via_rX _clzsi2 _clzdi2 # We want fine grained libraries, so use the new code to build the # floating point emulation libraries. diff --git a/gcc/config/arm/t-wince-pe b/gcc/config/arm/t-wince-pe index 4fcb48376bd..54fabc8a21e 100644 --- a/gcc/config/arm/t-wince-pe +++ b/gcc/config/arm/t-wince-pe @@ -16,8 +16,7 @@ # along with GCC; see the file COPYING3. If not see # <http://www.gnu.org/licenses/>. -LIB1ASMSRC = arm/lib1funcs.asm -LIB1ASMFUNCS = _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _call_via_rX _interwork_call_via_rX _clzsi2 _clzdi2 +LIB1ASMFUNCS += _udivsi3 _divsi3 _umodsi3 _modsi3 _dvmd_tls _call_via_rX _interwork_call_via_rX _clzsi2 _clzdi2 # We want fine grained libraries, so use the new code to build the # floating point emulation libraries. diff --git a/gcc/config/arm/vfp.md b/gcc/config/arm/vfp.md index 737f81ccb27..eb18864ecbf 100644 --- a/gcc/config/arm/vfp.md +++ b/gcc/config/arm/vfp.md @@ -185,6 +185,61 @@ (set_attr "neg_pool_range" "*, 0,*,*,*,*,1008,*")] ) +;; HFmode moves +(define_insn "*movhf_vfp" + [(set (match_operand:HF 0 "nonimmediate_operand" "= t,Um,r,m,t,r,t,r,r") + (match_operand:HF 1 "general_operand" " Um, t,m,r,t,r,r,t,F"))] + "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_NEON_FP16 + && ( s_register_operand (operands[0], HFmode) + || s_register_operand (operands[1], HFmode))" + "* + switch (which_alternative) + { + case 0: /* S register from memory */ + return \"vld1.16\\t{%z0}, %A1\"; + case 1: /* memory from S register */ + return \"vst1.16\\t{%z1}, %A0\"; + case 2: /* ARM register from memory */ + return \"ldrh\\t%0, %1\\t%@ __fp16\"; + case 3: /* memory from ARM register */ + return \"strh\\t%1, %0\\t%@ __fp16\"; + case 4: /* S register from S register */ + return \"fcpys\\t%0, %1\"; + case 5: /* ARM register from ARM register */ + return \"mov\\t%0, %1\\t%@ __fp16\"; + case 6: /* S register from ARM register */ + return \"fmsr\\t%0, %1\"; + case 7: /* ARM register from S register */ + return \"fmrs\\t%0, %1\"; + case 8: /* ARM register from constant */ + { + REAL_VALUE_TYPE r; + long bits; + rtx ops[4]; + + REAL_VALUE_FROM_CONST_DOUBLE (r, operands[1]); + bits = real_to_target (NULL, &r, HFmode); + ops[0] = operands[0]; + ops[1] = GEN_INT (bits); + ops[2] = GEN_INT (bits & 0xff00); + ops[3] = GEN_INT (bits & 0x00ff); + + if (arm_arch_thumb2) + output_asm_insn (\"movw\\t%0, %1\", ops); + else + output_asm_insn (\"mov\\t%0, %2\;orr\\t%0, %0, %3\", ops); + return \"\"; + } + default: + gcc_unreachable (); + } + " + [(set_attr "conds" "unconditional") + (set_attr "type" "*,*,load1,store1,fcpys,*,r_2_f,f_2_r,*") + (set_attr "neon_type" "neon_vld1_1_2_regs,neon_vst1_1_2_regs_vst2_2_regs,*,*,*,*,*,*,*") + (set_attr "length" "4,4,4,4,4,4,4,4,8")] +) + ;; SFmode moves ;; Disparage the w<->r cases because reloading an invalid address is @@ -736,6 +791,24 @@ (set_attr "type" "f_cvt")] ) +(define_insn "extendhfsf2" + [(set (match_operand:SF 0 "s_register_operand" "=t") + (float_extend:SF (match_operand:HF 1 "s_register_operand" "t")))] + "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_NEON_FP16" + "vcvtb%?.f32.f16\\t%0, %1" + [(set_attr "predicable" "yes") + (set_attr "type" "f_cvt")] +) + +(define_insn "truncsfhf2" + [(set (match_operand:HF 0 "s_register_operand" "=t") + (float_truncate:HF (match_operand:SF 1 "s_register_operand" "t")))] + "TARGET_32BIT && TARGET_HARD_FLOAT && TARGET_NEON_FP16" + "vcvtb%?.f16.f32\\t%0, %1" + [(set_attr "predicable" "yes") + (set_attr "type" "f_cvt")] +) + (define_insn "*truncsisf2_vfp" [(set (match_operand:SI 0 "s_register_operand" "=t") (fix:SI (fix:SF (match_operand:SF 1 "s_register_operand" "t"))))] diff --git a/gcc/config/avr/avr.c b/gcc/config/avr/avr.c index 1e79644fc2e..d0df1be5b78 100644 --- a/gcc/config/avr/avr.c +++ b/gcc/config/avr/avr.c @@ -380,9 +380,6 @@ avr_override_options (void) flag_delete_null_pointer_checks = 0; - if (!PARAM_SET_P (PARAM_INLINE_CALL_COST)) - set_param_value ("inline-call-cost", 5); - for (t = avr_mcu_types; t->name; t++) if (strcmp (t->name, avr_mcu_name) == 0) break; diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c index 61774cc0fdf..06ae734af30 100644 --- a/gcc/config/i386/i386.c +++ b/gcc/config/i386/i386.c @@ -3424,12 +3424,6 @@ override_options (bool main_args_p) static void ix86_function_specific_save (struct cl_target_option *ptr) { - gcc_assert (IN_RANGE (ix86_arch, 0, 255)); - gcc_assert (IN_RANGE (ix86_schedule, 0, 255)); - gcc_assert (IN_RANGE (ix86_tune, 0, 255)); - gcc_assert (IN_RANGE (ix86_fpmath, 0, 255)); - gcc_assert (IN_RANGE (ix86_branch_cost, 0, 255)); - ptr->arch = ix86_arch; ptr->schedule = ix86_schedule; ptr->tune = ix86_tune; @@ -3439,6 +3433,14 @@ ix86_function_specific_save (struct cl_target_option *ptr) ptr->arch_specified = ix86_arch_specified; ptr->ix86_isa_flags_explicit = ix86_isa_flags_explicit; ptr->target_flags_explicit = target_flags_explicit; + + /* The fields are char but the variables are not; make sure the + values fit in the fields. */ + gcc_assert (ptr->arch == ix86_arch); + gcc_assert (ptr->schedule == ix86_schedule); + gcc_assert (ptr->tune == ix86_tune); + gcc_assert (ptr->fpmath == ix86_fpmath); + gcc_assert (ptr->branch_cost == ix86_branch_cost); } /* Restore the current options */ diff --git a/gcc/config/i386/i386.h b/gcc/config/i386/i386.h index 657c8ae3eef..7592f6b420c 100644 --- a/gcc/config/i386/i386.h +++ b/gcc/config/i386/i386.h @@ -1498,6 +1498,7 @@ enum reg_class || ((CLASS) == AD_REGS) \ || ((CLASS) == SIREG) \ || ((CLASS) == DIREG) \ + || ((CLASS) == SSE_FIRST_REG) \ || ((CLASS) == FP_TOP_REG) \ || ((CLASS) == FP_SECOND_REG)) diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md index 59d9e829ed0..a71ca43c163 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -18531,7 +18531,7 @@ (define_expand "scalb<mode>3" [(use (match_operand:MODEF 0 "register_operand" "")) (use (match_operand:MODEF 1 "general_operand" "")) - (use (match_operand:MODEF 2 "register_operand" ""))] + (use (match_operand:MODEF 2 "general_operand" ""))] "TARGET_USE_FANCY_MATH_387 && (!(SSE_FLOAT_MODE_P (<MODE>mode) && TARGET_SSE_MATH) || TARGET_MIX_SSE_I387) @@ -18552,6 +18552,34 @@ emit_insn (gen_truncxf<mode>2_i387_noop (operands[0], op0)); DONE; }) + +(define_expand "significandxf2" + [(parallel [(set (match_operand:XF 0 "register_operand" "") + (unspec:XF [(match_operand:XF 1 "register_operand" "")] + UNSPEC_XTRACT_FRACT)) + (set (match_dup 2) + (unspec:XF [(match_dup 1)] UNSPEC_XTRACT_EXP))])] + "TARGET_USE_FANCY_MATH_387 + && flag_unsafe_math_optimizations" +{ + operands[2] = gen_reg_rtx (XFmode); +}) + +(define_expand "significand<mode>2" + [(use (match_operand:MODEF 0 "register_operand" "")) + (use (match_operand:MODEF 1 "register_operand" ""))] + "TARGET_USE_FANCY_MATH_387 + && (!(SSE_FLOAT_MODE_P (<MODE>mode) && TARGET_SSE_MATH) + || TARGET_MIX_SSE_I387) + && flag_unsafe_math_optimizations" +{ + rtx op0 = gen_reg_rtx (XFmode); + rtx op1 = gen_reg_rtx (XFmode); + + emit_insn (gen_fxtract_extend<mode>xf3_i387 (op0, op1, operands[1])); + emit_insn (gen_truncxf<mode>2_i387_noop (operands[0], op0)); + DONE; +}) (define_insn "sse4_1_round<mode>2" diff --git a/gcc/config/moxie/moxie.h b/gcc/config/moxie/moxie.h index e63190978f0..73a1a5101e0 100644 --- a/gcc/config/moxie/moxie.h +++ b/gcc/config/moxie/moxie.h @@ -518,6 +518,9 @@ do \ #define MOVE_MAX 4 #define TRULY_NOOP_TRUNCATION(op,ip) 1 +/* All load operations zero extend. */ +#define LOAD_EXTEND_OP(MEM) ZERO_EXTEND + #define RETURN_POPS_ARGS(FUNDECL, FUNTYPE, STACK_SIZE) 0 /* A C expression that is nonzero if X is a legitimate constant for diff --git a/gcc/config/moxie/sfp-machine.h b/gcc/config/moxie/sfp-machine.h index 57f515e9fc6..98f9f1bf491 100644 --- a/gcc/config/moxie/sfp-machine.h +++ b/gcc/config/moxie/sfp-machine.h @@ -3,6 +3,11 @@ #define _FP_WS_TYPE signed long #define _FP_I_TYPE long +/* The type of the result of a floating point comparison. This must + match `__libgcc_cmp_return__' in GCC for the target. */ +typedef int __gcc_CMPtype __attribute__ ((mode (__libgcc_cmp_return__))); +#define CMPtype __gcc_CMPtype + #define _FP_MUL_MEAT_S(R,X,Y) \ _FP_MUL_MEAT_1_wide(_FP_WFRACBITS_S,R,X,Y,umul_ppmm) #define _FP_MUL_MEAT_D(R,X,Y) \ diff --git a/gcc/config/rs6000/rs6000.c b/gcc/config/rs6000/rs6000.c index 592d8dd4fb1..9465c9f945a 100644 --- a/gcc/config/rs6000/rs6000.c +++ b/gcc/config/rs6000/rs6000.c @@ -258,7 +258,7 @@ static GTY(()) section *toc_section; int rs6000_alignment_flags; /* True for any options that were explicitly set. */ -struct { +static struct { bool aix_struct_ret; /* True if -maix-struct-ret was used. */ bool alignment; /* True if -malign- was used. */ bool spe_abi; /* True if -mabi=spe/no-spe was used. */ @@ -775,7 +775,6 @@ static bool rs6000_ms_bitfield_layout_p (const_tree); static tree rs6000_handle_struct_attribute (tree *, tree, tree, int, bool *); static void rs6000_eliminate_indexed_memrefs (rtx operands[2]); static const char *rs6000_mangle_type (const_tree); -EXPORTED_CONST struct attribute_spec rs6000_attribute_table[]; static void rs6000_set_default_type_attributes (tree); static rtx rs6000_savres_routine_sym (rs6000_stack_t *, bool, bool, bool); static rtx rs6000_emit_stack_reset (rs6000_stack_t *, rtx, rtx, int, bool); @@ -1034,6 +1033,22 @@ static const char alt_reg_names[][8] = "sfp" }; #endif + +/* Table of valid machine attributes. */ + +static const struct attribute_spec rs6000_attribute_table[] = +{ + /* { name, min_len, max_len, decl_req, type_req, fn_type_req, handler } */ + { "altivec", 1, 1, false, true, false, rs6000_handle_altivec_attribute }, + { "longcall", 0, 0, false, true, true, rs6000_handle_longcall_attribute }, + { "shortcall", 0, 0, false, true, true, rs6000_handle_longcall_attribute }, + { "ms_struct", 0, 0, false, false, false, rs6000_handle_struct_attribute }, + { "gcc_struct", 0, 0, false, false, false, rs6000_handle_struct_attribute }, +#ifdef SUBTARGET_ATTRIBUTE_TABLE + SUBTARGET_ATTRIBUTE_TABLE, +#endif + { NULL, 0, 0, false, false, false, NULL } +}; #ifndef MASK_STRICT_ALIGN #define MASK_STRICT_ALIGN 0 @@ -20571,22 +20586,6 @@ rs6000_initialize_trampoline (rtx addr, rtx fnaddr, rtx cxt) } -/* Table of valid machine attributes. */ - -const struct attribute_spec rs6000_attribute_table[] = -{ - /* { name, min_len, max_len, decl_req, type_req, fn_type_req, handler } */ - { "altivec", 1, 1, false, true, false, rs6000_handle_altivec_attribute }, - { "longcall", 0, 0, false, true, true, rs6000_handle_longcall_attribute }, - { "shortcall", 0, 0, false, true, true, rs6000_handle_longcall_attribute }, - { "ms_struct", 0, 0, false, false, false, rs6000_handle_struct_attribute }, - { "gcc_struct", 0, 0, false, false, false, rs6000_handle_struct_attribute }, -#ifdef SUBTARGET_ATTRIBUTE_TABLE - SUBTARGET_ATTRIBUTE_TABLE, -#endif - { NULL, 0, 0, false, false, false, NULL } -}; - /* Handle the "altivec" attribute. The attribute may have arguments as follows: diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 62f93a98526..8f9d6d80669 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,16 @@ +2009-06-18 Aldy Hernandez <aldyh@redhat.com> + + * class.c (get_vtable_decl): Replace finish_decl with cp_finish_decl. + * decl.c (finish_decl): Remove. + (declare_global_var): Replace finish_decl with cp_finish_decl. + (start_method): Same. + * rtti.c (emit_tinfo_decl): Same. + * pt.c (tsubst_expr): Same. + (instantiate_decl): Same. + * decl2.c (grokbitfield): Same. + * name-lookup.c (pushdecl_top_level_1): Same. + * cp-tree.h: Remove finish_decl. + 2009-06-16 David Edelsohn <edelsohn@gnu.org> * g++-spec.c (LIBSTDCXX_STATIC): Default to NULL. diff --git a/gcc/cp/class.c b/gcc/cp/class.c index b762019cf83..d86ff646429 100644 --- a/gcc/cp/class.c +++ b/gcc/cp/class.c @@ -774,7 +774,7 @@ get_vtable_decl (tree type, int complete) if (complete) { DECL_EXTERNAL (decl) = 1; - finish_decl (decl, NULL_TREE, NULL_TREE, NULL_TREE); + cp_finish_decl (decl, NULL_TREE, false, NULL_TREE, 0); } return decl; diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index 8c45b8a3a68..c49a8778617 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -4333,7 +4333,6 @@ extern tree start_decl (const cp_declarator *, cp_decl_specifier_seq *, int, extern void start_decl_1 (tree, bool); extern bool check_array_initializer (tree, tree, tree); extern void cp_finish_decl (tree, tree, bool, tree, int); -extern void finish_decl (tree, tree, tree, tree); extern int cp_complete_array_type (tree *, tree, bool); extern tree build_ptrmemfunc_type (tree); extern tree build_ptrmem_type (tree, tree); diff --git a/gcc/cp/decl.c b/gcc/cp/decl.c index 296d1438515..9ebfd27d9ca 100644 --- a/gcc/cp/decl.c +++ b/gcc/cp/decl.c @@ -5880,15 +5880,6 @@ cp_finish_decl (tree decl, tree init, bool init_const_expr_p, mark_decl_referenced (decl); } -/* This is here for a midend callback from c-common.c. */ - -void -finish_decl (tree decl, tree init, tree origtype ATTRIBUTE_UNUSED, - tree asmspec_tree) -{ - cp_finish_decl (decl, init, /*init_const_expr_p=*/false, asmspec_tree, 0); -} - /* Returns a declaration for a VAR_DECL as if: extern "C" TYPE NAME; @@ -5911,7 +5902,7 @@ declare_global_var (tree name, tree type) library), then it is possible that our declaration will be merged with theirs by pushdecl. */ decl = pushdecl (decl); - finish_decl (decl, NULL_TREE, NULL_TREE, NULL_TREE); + cp_finish_decl (decl, NULL_TREE, false, NULL_TREE, 0); pop_from_top_level (); return decl; @@ -12523,7 +12514,7 @@ start_method (cp_decl_specifier_seq *declspecs, } } - finish_decl (fndecl, NULL_TREE, NULL_TREE, NULL_TREE); + cp_finish_decl (fndecl, NULL_TREE, false, NULL_TREE, 0); /* Make a place for the parms. */ begin_scope (sk_function_parms, fndecl); diff --git a/gcc/cp/decl2.c b/gcc/cp/decl2.c index 308f767cc09..119196408e8 100644 --- a/gcc/cp/decl2.c +++ b/gcc/cp/decl2.c @@ -1002,7 +1002,7 @@ grokbitfield (const cp_declarator *declarator, error ("static member %qD cannot be a bit-field", value); return NULL_TREE; } - finish_decl (value, NULL_TREE, NULL_TREE, NULL_TREE); + cp_finish_decl (value, NULL_TREE, false, NULL_TREE, 0); if (width != error_mark_node) { diff --git a/gcc/cp/name-lookup.c b/gcc/cp/name-lookup.c index 143fcf31568..69ee8bfea39 100644 --- a/gcc/cp/name-lookup.c +++ b/gcc/cp/name-lookup.c @@ -3555,7 +3555,7 @@ pushdecl_top_level_1 (tree x, tree *init, bool is_friend) push_to_top_level (); x = pushdecl_namespace_level (x, is_friend); if (init) - finish_decl (x, *init, NULL_TREE, NULL_TREE); + cp_finish_decl (x, *init, false, NULL_TREE, 0); pop_from_top_level (); POP_TIMEVAR_AND_RETURN (TV_NAME_LOOKUP, x); } diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c index 5645b23e27f..977a1011871 100644 --- a/gcc/cp/pt.c +++ b/gcc/cp/pt.c @@ -10819,7 +10819,7 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl, init = t; } - finish_decl (decl, init, NULL_TREE, NULL_TREE); + cp_finish_decl (decl, init, false, NULL_TREE, 0); } } } @@ -15727,7 +15727,7 @@ instantiate_decl (tree d, int defer_ok, /* The initializer is placed in DECL_INITIAL by regenerate_decl_from_template. Pull it out so that - finish_decl can process it. */ + cp_finish_decl can process it. */ init = DECL_INITIAL (d); DECL_INITIAL (d) = NULL_TREE; DECL_INITIALIZED_P (d) = 0; @@ -15739,7 +15739,7 @@ instantiate_decl (tree d, int defer_ok, /* Enter the scope of D so that access-checking works correctly. */ push_nested_class (DECL_CONTEXT (d)); - finish_decl (d, init, NULL_TREE, NULL_TREE); + cp_finish_decl (d, init, false, NULL_TREE, 0); pop_nested_class (); } else if (TREE_CODE (d) == FUNCTION_DECL) diff --git a/gcc/cp/rtti.c b/gcc/cp/rtti.c index c26caa9cb3d..c78d92be09b 100644 --- a/gcc/cp/rtti.c +++ b/gcc/cp/rtti.c @@ -1532,7 +1532,7 @@ emit_tinfo_decl (tree decl) init = get_pseudo_ti_init (type, get_pseudo_ti_index (type)); DECL_INITIAL (decl) = init; mark_used (decl); - finish_decl (decl, init, NULL_TREE, NULL_TREE); + cp_finish_decl (decl, init, false, NULL_TREE, 0); return true; } else diff --git a/gcc/diagnostic.h b/gcc/diagnostic.h index 004fabd33d2..cf17cf9bea3 100644 --- a/gcc/diagnostic.h +++ b/gcc/diagnostic.h @@ -226,7 +226,7 @@ extern void print_generic_expr (FILE *, tree, int); extern void print_generic_decl (FILE *, tree, int); extern void debug_c_tree (tree); extern void dump_omp_clauses (pretty_printer *, tree, int, int); -extern void print_call_name (pretty_printer *, tree); +extern void print_call_name (pretty_printer *, tree, int); /* In gimple-pretty-print.c */ extern void debug_generic_expr (tree); diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index 6817af5d6aa..1cf6e760b4c 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -35,6 +35,7 @@ extensions, accepted by GCC in C89 mode and in C++. * Long Long:: Double-word integers---@code{long long int}. * Complex:: Data types for complex numbers. * Floating Types:: Additional Floating Types. +* Half-Precision:: Half-Precision Floating Point. * Decimal Float:: Decimal Floating Types. * Hex Floats:: Hexadecimal floating-point constants. * Fixed-Point:: Fixed-Point Types. @@ -921,6 +922,55 @@ Not all targets support additional floating point types. @code{__float80} is supported on i386, x86_64 and ia64 targets and target @code{__float128} is supported on x86_64 and ia64 targets. +@node Half-Precision +@section Half-Precision Floating Point +@cindex half-precision floating point +@cindex @code{__fp16} data type + +On ARM targets, GCC supports half-precision (16-bit) floating point via +the @code{__fp16} type. You must enable this type explicitly +with the @option{-mfp16-format} command-line option in order to use it. + +ARM supports two incompatible representations for half-precision +floating-point values. You must choose one of the representations and +use it consistently in your program. + +Specifying @option{-mfp16-format=ieee} selects the IEEE 754-2008 format. +This format can represent normalized values in the range of @math{2^{-14}} to 65504. +There are 11 bits of significand precision, approximately 3 +decimal digits. + +Specifying @option{-mfp16-format=alternative} selects the ARM +alternative format. This representation is similar to the IEEE +format, but does not support infinities or NaNs. Instead, the range +of exponents is extended, so that this format can represent normalized +values in the range of @math{2^{-14}} to 131008. + +The @code{__fp16} type is a storage format only. For purposes +of arithmetic and other operations, @code{__fp16} values in C or C++ +expressions are automatically promoted to @code{float}. In addition, +you cannot declare a function with a return value or parameters +of type @code{__fp16}. + +Note that conversions from @code{double} to @code{__fp16} +involve an intermediate conversion to @code{float}. Because +of rounding, this can sometimes produce a different result than a +direct conversion. + +ARM provides hardware support for conversions between +@code{__fp16} and @code{float} values +as an extension to VFP and NEON (Advanced SIMD). GCC generates +code using the instructions provided by this extension if you compile +with the options @option{-mfpu=neon-fp16 -mfloat-abi=softfp}, +in addition to the @option{-mfp16-format} option to select +a half-precision format. + +Language-level support for the @code{__fp16} data type is +independent of whether GCC generates code using hardware floating-point +instructions. In cases where hardware support is not specified, GCC +implements conversions between @code{__fp16} and @code{float} values +as library calls. + @node Decimal Float @section Decimal Floating Types @cindex decimal floating types diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 6b83e8a533a..6e3a4fdc9a3 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -364,7 +364,7 @@ Objective-C and Objective-C++ Dialects}. -frounding-math -fsched2-use-superblocks @gol -fsched2-use-traces -fsched-spec-load -fsched-spec-load-dangerous @gol -fsched-stalled-insns-dep[=@var{n}] -fsched-stalled-insns[=@var{n}] @gol --fschedule-insns -fschedule-insns2 -fsection-anchors -fsee @gol +-fschedule-insns -fschedule-insns2 -fsection-anchors @gol -fselective-scheduling -fselective-scheduling2 @gol -fsel-sched-pipelining -fsel-sched-pipelining-outer-loops @gol -fsignaling-nans -fsingle-precision-constant -fsplit-ivs-in-unroller @gol @@ -444,6 +444,7 @@ Objective-C and Objective-C++ Dialects}. -msched-prolog -mno-sched-prolog @gol -mlittle-endian -mbig-endian -mwords-little-endian @gol -mfloat-abi=@var{name} -msoft-float -mhard-float -mfpe @gol +-mfp16-format=@var{name} -mthumb-interwork -mno-thumb-interwork @gol -mcpu=@var{name} -march=@var{name} -mfpu=@var{name} @gol -mstructure-size-boundary=@var{n} @gol @@ -5098,6 +5099,10 @@ meaningful will be ignored. The following options are available Print the address of each node. Usually this is not meaningful as it changes according to the environment and source file. Its primary use is for tying up a dump file with a debug environment. +@item asmname +If @code{DECL_ASSEMBLER_NAME} has been set for a given decl, use that +in the dump instead of @code{DECL_NAME}. Its primary use is ease of +use working backward from mangled names in the assembly file. @item slim Inhibit dumping of members of a scope or body of a function merely because that scope has been reached. Only dump such items when they @@ -6225,11 +6230,6 @@ match the reality and hurt the performance. This only makes sense when scheduling after register allocation, i.e.@: with @option{-fschedule-insns2} or at @option{-O2} or higher. -@item -fsee -@opindex fsee -Eliminate redundant sign extension instructions and move the non-redundant -ones to optimal placement using lazy code motion (LCM). - @item -freschedule-modulo-scheduled-loops @opindex freschedule-modulo-scheduled-loops The modulo scheduling comes before the traditional scheduling, if a loop @@ -9306,14 +9306,21 @@ of the @option{-mcpu=} option. Permissible names are: @samp{armv2}, @opindex mfp This specifies what floating point hardware (or hardware emulation) is available on the target. Permissible names are: @samp{fpa}, @samp{fpe2}, -@samp{fpe3}, @samp{maverick}, @samp{vfp}, @samp{vfpv3}, @samp{vfpv3-d16} and -@samp{neon}. @option{-mfp} and @option{-mfpe} +@samp{fpe3}, @samp{maverick}, @samp{vfp}, @samp{vfpv3}, @samp{vfpv3-d16}, +@samp{neon}, and @samp{neon-fp16}. @option{-mfp} and @option{-mfpe} are synonyms for @option{-mfpu}=@samp{fpe}@var{number}, for compatibility with older versions of GCC@. If @option{-msoft-float} is specified this specifies the format of floating point values. +@item -mfp16-format=@var{name} +@opindex mfp16-format +Specify the format of the @code{__fp16} half-precision floating-point type. +Permissible names are @samp{none}, @samp{ieee}, and @samp{alternative}; +the default is @samp{none}, in which case the @code{__fp16} type is not +defined. @xref{Half-Precision}, for more information. + @item -mstructure-size-boundary=@var{n} @opindex mstructure-size-boundary The size of all structures and unions will be rounded up to a multiple diff --git a/gcc/doc/plugins.texi b/gcc/doc/plugins.texi index 9ae0a185f69..791e04b7412 100644 --- a/gcc/doc/plugins.texi +++ b/gcc/doc/plugins.texi @@ -32,6 +32,26 @@ address of the callback function that will handle that event. The header @file{gcc-plugin.h} must be the first gcc header to be included. +@subsection Plugin license check + +Every plugin should define the global symbol @code{plugin_is_GPL_compatible} +to assert that it has been licensed under a GPL-compatible license. +If this symbol does not exist, the compiler will emit a fatal error +and exit with the error message: + +@smallexample +fatal error: plugin <name> is not licensed under a GPL-compatible license +<name>: undefined symbol: plugin_is_GPL_compatible +compilation terminated +@end smallexample + +The type of the symbol is irrelevant. The compiler merely asserts that +it exists in the global scope. Something like this is enough: + +@smallexample +int plugin_is_GPL_compatible; +@end smallexample + @subsection Plugin initialization Every plugin should export a function called @code{plugin_init} that diff --git a/gcc/dse.c b/gcc/dse.c index 534324d0f5b..ca227ea15dd 100644 --- a/gcc/dse.c +++ b/gcc/dse.c @@ -244,7 +244,7 @@ struct store_info { /* A bitmap with one bit per byte. Cleared bit means the position is needed. Used if IS_LARGE is false. */ - bitmap bitmap; + bitmap bmap; /* Number of set bits (i.e. unneeded bytes) in BITMAP. If it is equal to END - BEGIN, the whole store is unused. */ @@ -791,7 +791,7 @@ free_store_info (insn_info_t insn_info) { store_info_t next = store_info->next; if (store_info->is_large) - BITMAP_FREE (store_info->positions_needed.large.bitmap); + BITMAP_FREE (store_info->positions_needed.large.bmap); if (store_info->cse_base) pool_free (cse_store_info_pool, store_info); else @@ -1213,10 +1213,10 @@ set_position_unneeded (store_info_t s_info, int pos) { if (__builtin_expect (s_info->is_large, false)) { - if (!bitmap_bit_p (s_info->positions_needed.large.bitmap, pos)) + if (!bitmap_bit_p (s_info->positions_needed.large.bmap, pos)) { s_info->positions_needed.large.count++; - bitmap_set_bit (s_info->positions_needed.large.bitmap, pos); + bitmap_set_bit (s_info->positions_needed.large.bmap, pos); } } else @@ -1233,7 +1233,7 @@ set_all_positions_unneeded (store_info_t s_info) { int pos, end = s_info->end - s_info->begin; for (pos = 0; pos < end; pos++) - bitmap_set_bit (s_info->positions_needed.large.bitmap, pos); + bitmap_set_bit (s_info->positions_needed.large.bmap, pos); s_info->positions_needed.large.count = end; } else @@ -1263,7 +1263,7 @@ all_positions_needed_p (store_info_t s_info, int start, int width) { int end = start + width; while (start < end) - if (bitmap_bit_p (s_info->positions_needed.large.bitmap, start++)) + if (bitmap_bit_p (s_info->positions_needed.large.bmap, start++)) return false; return true; } @@ -1605,7 +1605,7 @@ record_store (rtx body, bb_info_t bb_info) { store_info->is_large = true; store_info->positions_needed.large.count = 0; - store_info->positions_needed.large.bitmap = BITMAP_ALLOC (NULL); + store_info->positions_needed.large.bmap = BITMAP_ALLOC (NULL); } else { @@ -2721,7 +2721,7 @@ dse_step1 (void) for (s_info = ptr->store_rec; s_info; s_info = s_info->next) if (s_info->is_large) { - BITMAP_FREE (s_info->positions_needed.large.bitmap); + BITMAP_FREE (s_info->positions_needed.large.bmap); s_info->is_large = false; } } diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d6a608285b9..c42c91d26d8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,56 @@ +2009-06-22 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/40443 + * interface.c (gfc_search_interface): Hold back a match to an + elementary procedure until all other possibilities are + exhausted. + +2009-06-22 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/40472 + * simplify.c (gfc_simplify_spread): Restrict the result size to + the limit for an array constructor. + +2009-06-21 Janus Weil <janus@gcc.gnu.org> + + PR fortran/39850 + * interface.c (gfc_compare_interfaces): Take care of implicit typing + when checking the function attribute. Plus another bugfix. + (compare_parameter): Set attr.function and attr.subroutine according + to the usage of a procedure as actual argument. + +2009-06-20 Tobias Burnus <burnus@net-b.de> + + PR fortran/40452 + * trans-decl.c (add_argument_checking): Disable bounds check + for allowed argument storage association. + +2009-06-19 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/40440 + * trans-expr.c (gfc_conv_procedure_call): Do not deallocate + allocatable components if the argument is a pointer. + +2009-06-19 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * gfortran.h (gfc_expr): Use mpc_t to represent complex numbers. + + * arith.c, dump-parse-tree.c, expr.c, module.c, resolve.c, + simplify.c, target-memory.c, target-memory.h, trans-const.c, + trans-expr.c: Convert to mpc_t throughout. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * cpp.c (struct gfc_cpp_option_data): Give this struct, used for + the global variable gfc_cpp_option, a name. + +2009-06-19 Janus Weil <janus@gcc.gnu.org> + + PR fortran/40450 + * trans-expr.c (gfc_conv_procedure_call): Only add an extra addr_expr + to a procedure pointer actual argument, if it is not itself a + dummy arg. + 2009-06-18 Janus Weil <janus@gcc.gnu.org> PR fortran/40451 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 9aaf1bc03a9..2aa3c40fd40 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -429,8 +429,12 @@ gfc_constant_result (bt type, int kind, locus *where) case BT_COMPLEX: gfc_set_model_kind (kind); +#ifdef HAVE_mpc + mpc_init2 (result->value.complex, mpfr_get_default_prec()); +#else mpfr_init (result->value.complex.r); mpfr_init (result->value.complex.i); +#endif break; default: @@ -543,21 +547,23 @@ gfc_range_check (gfc_expr *e) break; case BT_COMPLEX: - rc = gfc_check_real_range (e->value.complex.r, e->ts.kind); + rc = gfc_check_real_range (mpc_realref (e->value.complex), e->ts.kind); if (rc == ARITH_UNDERFLOW) - mpfr_set_ui (e->value.complex.r, 0, GFC_RND_MODE); + mpfr_set_ui (mpc_realref (e->value.complex), 0, GFC_RND_MODE); if (rc == ARITH_OVERFLOW) - mpfr_set_inf (e->value.complex.r, mpfr_sgn (e->value.complex.r)); + mpfr_set_inf (mpc_realref (e->value.complex), + mpfr_sgn (mpc_realref (e->value.complex))); if (rc == ARITH_NAN) - mpfr_set_nan (e->value.complex.r); + mpfr_set_nan (mpc_realref (e->value.complex)); - rc2 = gfc_check_real_range (e->value.complex.i, e->ts.kind); + rc2 = gfc_check_real_range (mpc_imagref (e->value.complex), e->ts.kind); if (rc == ARITH_UNDERFLOW) - mpfr_set_ui (e->value.complex.i, 0, GFC_RND_MODE); + mpfr_set_ui (mpc_imagref (e->value.complex), 0, GFC_RND_MODE); if (rc == ARITH_OVERFLOW) - mpfr_set_inf (e->value.complex.i, mpfr_sgn (e->value.complex.i)); + mpfr_set_inf (mpc_imagref (e->value.complex), + mpfr_sgn (mpc_imagref (e->value.complex))); if (rc == ARITH_NAN) - mpfr_set_nan (e->value.complex.i); + mpfr_set_nan (mpc_imagref (e->value.complex)); if (rc == ARITH_OK) rc = rc2; @@ -633,8 +639,12 @@ gfc_arith_uminus (gfc_expr *op1, gfc_expr **resultp) break; case BT_COMPLEX: +#ifdef HAVE_mpc + mpc_neg (result->value.complex, op1->value.complex, GFC_MPC_RND_MODE); +#else mpfr_neg (result->value.complex.r, op1->value.complex.r, GFC_RND_MODE); mpfr_neg (result->value.complex.i, op1->value.complex.i, GFC_RND_MODE); +#endif break; default: @@ -667,11 +677,16 @@ gfc_arith_plus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) break; case BT_COMPLEX: +#ifdef HAVE_mpc + mpc_add (result->value.complex, op1->value.complex, op2->value.complex, + GFC_MPC_RND_MODE); +#else mpfr_add (result->value.complex.r, op1->value.complex.r, op2->value.complex.r, GFC_RND_MODE); mpfr_add (result->value.complex.i, op1->value.complex.i, op2->value.complex.i, GFC_RND_MODE); +#endif break; default: @@ -704,11 +719,16 @@ gfc_arith_minus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) break; case BT_COMPLEX: +#ifdef HAVE_mpc + mpc_sub (result->value.complex, op1->value.complex, + op2->value.complex, GFC_MPC_RND_MODE); +#else mpfr_sub (result->value.complex.r, op1->value.complex.r, op2->value.complex.r, GFC_RND_MODE); mpfr_sub (result->value.complex.i, op1->value.complex.i, op2->value.complex.i, GFC_RND_MODE); +#endif break; default: @@ -725,7 +745,6 @@ static arith gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) { gfc_expr *result; - mpfr_t x, y; arith rc; result = gfc_constant_result (op1->ts.type, op1->ts.kind, &op1->where); @@ -742,7 +761,13 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) break; case BT_COMPLEX: - gfc_set_model (op1->value.complex.r); + gfc_set_model (mpc_realref (op1->value.complex)); +#ifdef HAVE_mpc + mpc_mul (result->value.complex, op1->value.complex, op2->value.complex, + GFC_MPC_RND_MODE); +#else + { + mpfr_t x, y; mpfr_init (x); mpfr_init (y); @@ -755,6 +780,8 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) mpfr_add (result->value.complex.i, x, y, GFC_RND_MODE); mpfr_clears (x, y, NULL); + } +#endif break; default: @@ -771,7 +798,6 @@ static arith gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) { gfc_expr *result; - mpfr_t x, y, div; arith rc; rc = ARITH_OK; @@ -803,15 +829,35 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) break; case BT_COMPLEX: - if (mpfr_sgn (op2->value.complex.r) == 0 + if ( +#ifdef HAVE_mpc + mpc_cmp_si_si (op2->value.complex, 0, 0) == 0 +#else + mpfr_sgn (op2->value.complex.r) == 0 && mpfr_sgn (op2->value.complex.i) == 0 +#endif && gfc_option.flag_range_check == 1) { rc = ARITH_DIV0; break; } - gfc_set_model (op1->value.complex.r); + gfc_set_model (mpc_realref (op1->value.complex)); + +#ifdef HAVE_mpc + if (mpc_cmp_si_si (op2->value.complex, 0, 0) == 0) + { + /* In Fortran, return (NaN + NaN I) for any zero divisor. See + PR 40318. */ + mpfr_set_nan (mpc_realref (result->value.complex)); + mpfr_set_nan (mpc_imagref (result->value.complex)); + } + else + mpc_div (result->value.complex, op1->value.complex, op2->value.complex, + GFC_MPC_RND_MODE); +#else + { + mpfr_t x, y, div; mpfr_init (x); mpfr_init (y); mpfr_init (div); @@ -833,6 +879,8 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) GFC_RND_MODE); mpfr_clears (x, y, div, NULL); + } +#endif break; default: @@ -851,9 +899,13 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) static void complex_reciprocal (gfc_expr *op) { + gfc_set_model (mpc_realref (op->value.complex)); +#ifdef HAVE_mpc + mpc_ui_div (op->value.complex, 1, op->value.complex, GFC_MPC_RND_MODE); +#else + { mpfr_t mod, tmp; - gfc_set_model (op->value.complex.r); mpfr_init (mod); mpfr_init (tmp); @@ -867,6 +919,8 @@ complex_reciprocal (gfc_expr *op) mpfr_div (op->value.complex.i, op->value.complex.i, mod, GFC_RND_MODE); mpfr_clears (tmp, mod, NULL); + } +#endif } @@ -883,7 +937,7 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power) { mpfr_t x_r, x_i, tmp, re, im; - gfc_set_model (base->value.complex.r); + gfc_set_model (mpc_realref (base->value.complex)); mpfr_init (x_r); mpfr_init (x_i); mpfr_init (tmp); @@ -891,12 +945,16 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power) mpfr_init (im); /* res = 1 */ +#ifdef HAVE_mpc + mpc_set_ui (result->value.complex, 1, GFC_MPC_RND_MODE); +#else mpfr_set_ui (result->value.complex.r, 1, GFC_RND_MODE); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); +#endif /* x = base */ - mpfr_set (x_r, base->value.complex.r, GFC_RND_MODE); - mpfr_set (x_i, base->value.complex.i, GFC_RND_MODE); + mpfr_set (x_r, mpc_realref (base->value.complex), GFC_RND_MODE); + mpfr_set (x_i, mpc_imagref (base->value.complex), GFC_RND_MODE); /* Macro for complex multiplication. We have to take care that res_r/res_i and a_r/a_i can (and will) be the same variable. */ @@ -910,8 +968,8 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power) mpfr_add (res_i, im, tmp, GFC_RND_MODE), \ mpfr_set (res_r, re, GFC_RND_MODE) -#define res_r result->value.complex.r -#define res_i result->value.complex.i +#define res_r mpc_realref (result->value.complex) +#define res_i mpc_imagref (result->value.complex) /* for (; power > 0; x *= x) */ for (; mpz_cmp_si (power, 0) > 0; CMULT(x_r,x_i,x_r,x_i,x_r,x_i)) @@ -966,8 +1024,12 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) break; case BT_COMPLEX: +#ifdef HAVE_mpc + mpc_set_ui (result->value.complex, 1, GFC_MPC_RND_MODE); +#else mpfr_set_ui (result->value.complex.r, 1, GFC_RND_MODE); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); +#endif break; default: @@ -1089,8 +1151,6 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) case BT_COMPLEX: { - mpfr_t x, y, r, t; - if (init_flag) { if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger " @@ -1099,16 +1159,27 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) return ARITH_PROHIBIT; } - gfc_set_model (op1->value.complex.r); + { + mpfr_t x, y, r, t; + + gfc_set_model (mpc_realref (op1->value.complex)); mpfr_init (r); +#ifdef HAVE_mpc + mpc_abs (r, op1->value.complex, GFC_RND_MODE); +#else mpfr_hypot (r, op1->value.complex.r, op1->value.complex.i, GFC_RND_MODE); +#endif if (mpfr_cmp_si (r, 0) == 0) { +#ifdef HAVE_mpc + mpc_set_ui (result->value.complex, 0, GFC_MPC_RND_MODE); +#else mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); +#endif mpfr_clear (r); break; } @@ -1116,25 +1187,30 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) mpfr_init (t); +#ifdef HAVE_mpc + mpc_arg (t, op1->value.complex, GFC_RND_MODE); +#else mpfr_atan2 (t, op1->value.complex.i, op1->value.complex.r, GFC_RND_MODE); +#endif mpfr_init (x); mpfr_init (y); - mpfr_mul (x, op2->value.complex.r, r, GFC_RND_MODE); - mpfr_mul (y, op2->value.complex.i, t, GFC_RND_MODE); + mpfr_mul (x, mpc_realref (op2->value.complex), r, GFC_RND_MODE); + mpfr_mul (y, mpc_imagref (op2->value.complex), t, GFC_RND_MODE); mpfr_sub (x, x, y, GFC_RND_MODE); mpfr_exp (x, x, GFC_RND_MODE); - mpfr_mul (y, op2->value.complex.r, t, GFC_RND_MODE); - mpfr_mul (t, op2->value.complex.i, r, GFC_RND_MODE); + mpfr_mul (y, mpc_realref (op2->value.complex), t, GFC_RND_MODE); + mpfr_mul (t, mpc_imagref (op2->value.complex), r, GFC_RND_MODE); mpfr_add (y, y, t, GFC_RND_MODE); mpfr_cos (t, y, GFC_RND_MODE); mpfr_sin (y, y, GFC_RND_MODE); - mpfr_mul (result->value.complex.r, x, t, GFC_RND_MODE); - mpfr_mul (result->value.complex.i, x, y, GFC_RND_MODE); + mpfr_mul (mpc_realref (result->value.complex), x, t, GFC_RND_MODE); + mpfr_mul (mpc_imagref (result->value.complex), x, y, GFC_RND_MODE); mpfr_clears (r, t, x, y, NULL); + } } break; default: @@ -1252,8 +1328,12 @@ gfc_compare_expr (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op) static int compare_complex (gfc_expr *op1, gfc_expr *op2) { +#ifdef HAVE_mpc + return mpc_cmp (op1->value.complex, op2->value.complex) == 0; +#else return (mpfr_equal_p (op1->value.complex.r, op2->value.complex.r) && mpfr_equal_p (op1->value.complex.i, op2->value.complex.i)); +#endif } @@ -2122,8 +2202,13 @@ gfc_convert_complex (gfc_expr *real, gfc_expr *imag, int kind) gfc_expr *e; e = gfc_constant_result (BT_COMPLEX, kind, &real->where); +#ifdef HAVE_mpc + mpc_set_fr_fr (e->value.complex, real->value.real, imag->value.real, + GFC_MPC_RND_MODE); +#else mpfr_set (e->value.complex.r, real->value.real, GFC_RND_MODE); mpfr_set (e->value.complex.i, imag->value.real, GFC_RND_MODE); +#endif return e; } @@ -2243,10 +2328,15 @@ gfc_int2complex (gfc_expr *src, int kind) result = gfc_constant_result (BT_COMPLEX, kind, &src->where); +#ifdef HAVE_mpc + mpc_set_z (result->value.complex, src->value.integer, GFC_MPC_RND_MODE); +#else mpfr_set_z (result->value.complex.r, src->value.integer, GFC_RND_MODE); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); +#endif - if ((rc = gfc_check_real_range (result->value.complex.r, kind)) != ARITH_OK) + if ((rc = gfc_check_real_range (mpc_realref (result->value.complex), kind)) + != ARITH_OK) { arith_error (rc, &src->ts, &result->ts, &src->where); gfc_free_expr (result); @@ -2321,16 +2411,20 @@ gfc_real2complex (gfc_expr *src, int kind) result = gfc_constant_result (BT_COMPLEX, kind, &src->where); +#ifdef HAVE_mpc + mpc_set_fr (result->value.complex, src->value.real, GFC_MPC_RND_MODE); +#else mpfr_set (result->value.complex.r, src->value.real, GFC_RND_MODE); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); +#endif - rc = gfc_check_real_range (result->value.complex.r, kind); + rc = gfc_check_real_range (mpc_realref (result->value.complex), kind); 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); + mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE); } else if (rc != ARITH_OK) { @@ -2353,7 +2447,8 @@ gfc_complex2int (gfc_expr *src, int kind) result = gfc_constant_result (BT_INTEGER, kind, &src->where); - gfc_mpfr_to_mpz (result->value.integer, src->value.complex.r, &src->where); + gfc_mpfr_to_mpz (result->value.integer, mpc_realref (src->value.complex), + &src->where); if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK) { @@ -2376,7 +2471,11 @@ gfc_complex2real (gfc_expr *src, int kind) result = gfc_constant_result (BT_REAL, kind, &src->where); +#ifdef HAVE_mpc + mpc_real (result->value.real, src->value.complex, GFC_RND_MODE); +#else mpfr_set (result->value.real, src->value.complex.r, GFC_RND_MODE); +#endif rc = gfc_check_real_range (result->value.real, kind); @@ -2407,16 +2506,20 @@ gfc_complex2complex (gfc_expr *src, int kind) result = gfc_constant_result (BT_COMPLEX, kind, &src->where); +#ifdef HAVE_mpc + mpc_set (result->value.complex, src->value.complex, GFC_MPC_RND_MODE); +#else mpfr_set (result->value.complex.r, src->value.complex.r, GFC_RND_MODE); mpfr_set (result->value.complex.i, src->value.complex.i, GFC_RND_MODE); +#endif - rc = gfc_check_real_range (result->value.complex.r, kind); + rc = gfc_check_real_range (mpc_realref (result->value.complex), kind); 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); + mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE); } else if (rc != ARITH_OK) { @@ -2425,13 +2528,13 @@ gfc_complex2complex (gfc_expr *src, int kind) return NULL; } - rc = gfc_check_real_range (result->value.complex.i, kind); + rc = gfc_check_real_range (mpc_imagref (result->value.complex), kind); 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); + mpfr_set_ui (mpc_imagref (result->value.complex), 0, GFC_RND_MODE); } else if (rc != ARITH_OK) { @@ -2579,8 +2682,13 @@ gfc_hollerith2complex (gfc_expr *src, int kind) hollerith2representation (result, src); gfc_interpret_complex (kind, (unsigned char *) result->representation.string, - result->representation.length, result->value.complex.r, - result->value.complex.i); + result->representation.length, +#ifdef HAVE_mpc + result->value.complex +#else + result->value.complex.r, result->value.complex.i +#endif + ); return result; } diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index 9187bed7efe..ec8bb59504c 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.c @@ -66,7 +66,7 @@ typedef struct gfc_cpp_macro_queue } gfc_cpp_macro_queue; static gfc_cpp_macro_queue *cpp_define_queue, *cpp_undefine_queue; -struct +struct gfc_cpp_option_data { /* Argument of -cpp, implied by SPEC; if NULL, preprocessing disabled. */ diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index f6de8e824bc..cfd8a7d9d04 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -402,13 +402,15 @@ show_expr (gfc_expr *p) case BT_COMPLEX: fputs ("(complex ", dumpfile); - mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE); + mpfr_out_str (stdout, 10, 0, mpc_realref (p->value.complex), + GFC_RND_MODE); if (p->ts.kind != gfc_default_complex_kind) fprintf (dumpfile, "_%d", p->ts.kind); fputc (' ', dumpfile); - mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE); + mpfr_out_str (stdout, 10, 0, mpc_imagref (p->value.complex), + GFC_RND_MODE); if (p->ts.kind != gfc_default_complex_kind) fprintf (dumpfile, "_%d", p->ts.kind); diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 13c6b636355..d2f73d6d461 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -156,8 +156,12 @@ free_expr0 (gfc_expr *e) break; case BT_COMPLEX: +#ifdef HAVE_mpc + mpc_clear (e->value.complex); +#else mpfr_clear (e->value.complex.r); mpfr_clear (e->value.complex.i); +#endif break; default: @@ -439,10 +443,15 @@ gfc_copy_expr (gfc_expr *p) case BT_COMPLEX: gfc_set_model_kind (q->ts.kind); +#ifdef HAVE_mpc + mpc_init2 (q->value.complex, mpfr_get_default_prec()); + mpc_set (q->value.complex, p->value.complex, GFC_MPC_RND_MODE); +#else mpfr_init (q->value.complex.r); mpfr_init (q->value.complex.i); mpfr_set (q->value.complex.r, p->value.complex.r, GFC_RND_MODE); mpfr_set (q->value.complex.i, p->value.complex.i, GFC_RND_MODE); +#endif break; case BT_CHARACTER: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 7b9c69753c9..f0de489d3df 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1555,6 +1555,12 @@ gfc_intrinsic_sym; #include <gmp.h> #include <mpfr.h> +#ifdef HAVE_mpc +#include <mpc.h> +#else +#define mpc_realref(X) ((X).r) +#define mpc_imagref(X) ((X).i) +#endif #define GFC_RND_MODE GMP_RNDN #define GFC_MPC_RND_MODE MPC_RNDNN @@ -1613,10 +1619,14 @@ typedef struct gfc_expr mpfr_t real; +#ifdef HAVE_mpc + mpc_t +#else struct { mpfr_t r, i; } +#endif complex; struct diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 4954389848b..53cc95fe76e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -939,7 +939,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag, { gfc_formal_arglist *f1, *f2; - if (s1->attr.function && !s2->attr.function) + if (s1->attr.function && (s2->attr.subroutine + || (!s2->attr.function && s2->ts.type == BT_UNKNOWN + && gfc_get_default_type (s2->name, s2->ns)->type == BT_UNKNOWN))) { if (errmsg != NULL) snprintf (errmsg, err_len, "'%s' is not a function", s2->name); @@ -967,8 +969,6 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag, "of '%s'", s2->name); return 0; } - if (s1->attr.if_source == IFSRC_DECL) - return 1; } if (s1->attr.if_source == IFSRC_UNKNOWN @@ -1388,6 +1388,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (actual->ts.type == BT_PROCEDURE) { char err[200]; + gfc_symbol *act_sym = actual->symtree->n.sym; if (formal->attr.flavor != FL_PROCEDURE) { @@ -1396,7 +1397,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return 0; } - if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0, 1, err, + if (!gfc_compare_interfaces (formal, act_sym, 0, 1, err, sizeof(err))) { if (where) @@ -1405,6 +1406,13 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return 0; } + if (formal->attr.function && !act_sym->attr.function) + gfc_add_function (&act_sym->attr, act_sym->name, &act_sym->declared_at); + + if (formal->attr.subroutine && !act_sym->attr.subroutine) + gfc_add_subroutine (&act_sym->attr, act_sym->name, + &act_sym->declared_at); + return 1; } @@ -2417,6 +2425,7 @@ gfc_symbol * gfc_search_interface (gfc_interface *intr, int sub_flag, gfc_actual_arglist **ap) { + gfc_symbol *elem_sym = NULL; for (; intr; intr = intr->next) { if (sub_flag && intr->sym->attr.function) @@ -2425,10 +2434,19 @@ gfc_search_interface (gfc_interface *intr, int sub_flag, continue; if (gfc_arglist_matches_symbol (ap, intr->sym)) - return intr->sym; + { + /* Satisfy 12.4.4.1 such that an elemental match has lower + weight than a non-elemental match. */ + if (intr->sym->attr.elemental) + { + elem_sym = intr->sym; + continue; + } + return intr->sym; + } } - return NULL; + return elem_sym ? elem_sym : NULL; } diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 5bd7c27eea5..8cf829af408 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3027,8 +3027,8 @@ mio_expr (gfc_expr **ep) case BT_COMPLEX: gfc_set_model_kind (e->ts.kind); - mio_gmp_real (&e->value.complex.r); - mio_gmp_real (&e->value.complex.i); + mio_gmp_real (&mpc_realref (e->value.complex)); + mio_gmp_real (&mpc_imagref (e->value.complex)); break; case BT_LOGICAL: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4117d80f994..ccee61f00f0 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7610,31 +7610,39 @@ build_default_init_expr (gfc_symbol *sym) break; case BT_COMPLEX: +#ifdef HAVE_mpc + mpc_init2 (init_expr->value.complex, mpfr_get_default_prec()); +#else mpfr_init (init_expr->value.complex.r); mpfr_init (init_expr->value.complex.i); +#endif switch (gfc_option.flag_init_real) { case GFC_INIT_REAL_SNAN: init_expr->is_snan = 1; /* Fall through. */ case GFC_INIT_REAL_NAN: - mpfr_set_nan (init_expr->value.complex.r); - mpfr_set_nan (init_expr->value.complex.i); + mpfr_set_nan (mpc_realref (init_expr->value.complex)); + mpfr_set_nan (mpc_imagref (init_expr->value.complex)); break; case GFC_INIT_REAL_INF: - mpfr_set_inf (init_expr->value.complex.r, 1); - mpfr_set_inf (init_expr->value.complex.i, 1); + mpfr_set_inf (mpc_realref (init_expr->value.complex), 1); + mpfr_set_inf (mpc_imagref (init_expr->value.complex), 1); break; case GFC_INIT_REAL_NEG_INF: - mpfr_set_inf (init_expr->value.complex.r, -1); - mpfr_set_inf (init_expr->value.complex.i, -1); + mpfr_set_inf (mpc_realref (init_expr->value.complex), -1); + mpfr_set_inf (mpc_imagref (init_expr->value.complex), -1); break; case GFC_INIT_REAL_ZERO: +#ifdef HAVE_mpc + mpc_set_ui (init_expr->value.complex, 0, GFC_MPC_RND_MODE); +#else mpfr_set_ui (init_expr->value.complex.r, 0.0, GFC_RND_MODE); mpfr_set_ui (init_expr->value.complex.i, 0.0, GFC_RND_MODE); +#endif break; default: diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 5269e8f206e..79341d3d1e1 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -214,26 +214,6 @@ convert_mpz_to_signed (mpz_t x, int bitsize) } } -/* Helper function to convert to/from mpfr_t & mpc_t and call the - supplied mpc function on the respective values. */ - -#ifdef HAVE_mpc -static void -call_mpc_func (mpfr_ptr result_re, mpfr_ptr result_im, - mpfr_srcptr input_re, mpfr_srcptr input_im, - int (*func)(mpc_ptr, mpc_srcptr, mpc_rnd_t)) -{ - mpc_t c; - mpc_init2 (c, mpfr_get_default_prec()); - mpc_set_fr_fr (c, input_re, input_im, GFC_MPC_RND_MODE); - func (c, c, GFC_MPC_RND_MODE); - mpfr_set (result_re, mpc_realref (c), GFC_RND_MODE); - mpfr_set (result_im, mpc_imagref (c), GFC_RND_MODE); - mpc_clear (c); -} -#endif - - /* Test that the expression is an constant array. */ static bool @@ -303,8 +283,12 @@ init_result_expr (gfc_expr *e, int init, gfc_expr *array) break; case BT_COMPLEX: +#ifdef HAVE_mpc + mpc_set_si (e->value.complex, init, GFC_MPC_RND_MODE); +#else mpfr_set_si (e->value.complex.r, init, GFC_RND_MODE); mpfr_set_si (e->value.complex.i, 0, GFC_RND_MODE); +#endif break; case BT_CHARACTER: @@ -660,8 +644,12 @@ gfc_simplify_abs (gfc_expr *e) gfc_set_model_kind (e->ts.kind); +#ifdef HAVE_mpc + mpc_abs (result->value.real, e->value.complex, GFC_RND_MODE); +#else mpfr_hypot (result->value.real, e->value.complex.r, e->value.complex.i, GFC_RND_MODE); +#endif result = range_check (result, "CABS"); break; @@ -867,7 +855,7 @@ gfc_simplify_aimag (gfc_expr *e) return NULL; result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); - mpfr_set (result->value.real, e->value.complex.i, GFC_RND_MODE); + mpfr_set (result->value.real, mpc_imagref (e->value.complex), GFC_RND_MODE); return range_check (result, "AIMAG"); } @@ -1286,22 +1274,36 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) result = gfc_constant_result (BT_COMPLEX, kind, &x->where); +#ifndef HAVE_mpc mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); +#endif switch (x->ts.type) { case BT_INTEGER: if (!x->is_boz) +#ifdef HAVE_mpc + mpc_set_z (result->value.complex, x->value.integer, GFC_MPC_RND_MODE); +#else mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE); +#endif break; case BT_REAL: +#ifdef HAVE_mpc + mpc_set_fr (result->value.complex, x->value.real, GFC_RND_MODE); +#else mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE); +#endif break; case BT_COMPLEX: +#ifdef HAVE_mpc + mpc_set (result->value.complex, x->value.complex, GFC_MPC_RND_MODE); +#else mpfr_set (result->value.complex.r, x->value.complex.r, GFC_RND_MODE); mpfr_set (result->value.complex.i, x->value.complex.i, GFC_RND_MODE); +#endif break; default: @@ -1314,12 +1316,13 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) { case BT_INTEGER: if (!y->is_boz) - mpfr_set_z (result->value.complex.i, y->value.integer, - GFC_RND_MODE); + mpfr_set_z (mpc_imagref (result->value.complex), + y->value.integer, GFC_RND_MODE); break; case BT_REAL: - mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE); + mpfr_set (mpc_imagref (result->value.complex), + y->value.real, GFC_RND_MODE); break; default: @@ -1336,7 +1339,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) ts.type = BT_REAL; if (!gfc_convert_boz (x, &ts)) return &gfc_bad_expr; - mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE); + mpfr_set (mpc_realref (result->value.complex), + x->value.real, GFC_RND_MODE); } if (y && y->is_boz) @@ -1347,7 +1351,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) ts.type = BT_REAL; if (!gfc_convert_boz (y, &ts)) return &gfc_bad_expr; - mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE); + mpfr_set (mpc_imagref (result->value.complex), + y->value.real, GFC_RND_MODE); } return range_check (result, name); @@ -1429,7 +1434,11 @@ gfc_simplify_conjg (gfc_expr *e) return NULL; result = gfc_copy_expr (e); +#ifdef HAVE_mpc + mpc_conj (result->value.complex, result->value.complex, GFC_MPC_RND_MODE); +#else mpfr_neg (result->value.complex.i, result->value.complex.i, GFC_RND_MODE); +#endif return range_check (result, "CONJG"); } @@ -1453,8 +1462,7 @@ gfc_simplify_cos (gfc_expr *x) case BT_COMPLEX: gfc_set_model_kind (x->ts.kind); #ifdef HAVE_mpc - call_mpc_func (result->value.complex.r, result->value.complex.i, - x->value.complex.r, x->value.complex.i, mpc_cos); + mpc_cos (result->value.complex, x->value.complex, GFC_MPC_RND_MODE); #else { mpfr_t xp, xq; @@ -1898,8 +1906,7 @@ gfc_simplify_exp (gfc_expr *x) case BT_COMPLEX: gfc_set_model_kind (x->ts.kind); #ifdef HAVE_mpc - call_mpc_func (result->value.complex.r, result->value.complex.i, - x->value.complex.r, x->value.complex.i, mpc_exp); + mpc_exp (result->value.complex, x->value.complex, GFC_MPC_RND_MODE); #else { mpfr_t xp, xq; @@ -3281,8 +3288,8 @@ gfc_simplify_log (gfc_expr *x) break; case BT_COMPLEX: - if ((mpfr_sgn (x->value.complex.r) == 0) - && (mpfr_sgn (x->value.complex.i) == 0)) + if ((mpfr_sgn (mpc_realref (x->value.complex)) == 0) + && (mpfr_sgn (mpc_imagref (x->value.complex)) == 0)) { gfc_error ("Complex argument of LOG at %L cannot be zero", &x->where); @@ -3292,8 +3299,7 @@ gfc_simplify_log (gfc_expr *x) gfc_set_model_kind (x->ts.kind); #ifdef HAVE_mpc - call_mpc_func (result->value.complex.r, result->value.complex.i, - x->value.complex.r, x->value.complex.i, mpc_log); + mpc_log (result->value.complex, x->value.complex, GFC_MPC_RND_MODE); #else { mpfr_t xr, xi; @@ -4204,7 +4210,11 @@ gfc_simplify_realpart (gfc_expr *e) return NULL; result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); +#ifdef HAVE_mpc + mpc_real (result->value.real, e->value.complex, GFC_RND_MODE); +#else mpfr_set (result->value.real, e->value.complex.r, GFC_RND_MODE); +#endif return range_check (result, "REALPART"); } @@ -4986,8 +4996,7 @@ gfc_simplify_sin (gfc_expr *x) case BT_COMPLEX: gfc_set_model (x->value.real); #ifdef HAVE_mpc - call_mpc_func (result->value.complex.r, result->value.complex.i, - x->value.complex.r, x->value.complex.i, mpc_sin); + mpc_sin (result->value.complex, x->value.complex, GFC_MPC_RND_MODE); #else { mpfr_t xp, xq; @@ -5090,6 +5099,7 @@ gfc_simplify_spread (gfc_expr *source, gfc_expr *dim_expr, gfc_expr *ncopies_exp { gfc_expr *result = 0L; int i, j, dim, ncopies; + mpz_t size; if ((!gfc_is_constant_expr (source) && !is_constant_array_expr (source)) @@ -5105,6 +5115,12 @@ gfc_simplify_spread (gfc_expr *source, gfc_expr *dim_expr, gfc_expr *ncopies_exp gfc_extract_int (ncopies_expr, &ncopies); ncopies = MAX (ncopies, 0); + /* Do not allow the array size to exceed the limit for an array + constructor. */ + gfc_array_size (source, &size); + if (mpz_get_si (size)*ncopies > gfc_option.flag_max_array_constructor) + return NULL; + if (source->expr_type == EXPR_CONSTANT) { gcc_assert (dim == 0); @@ -5200,8 +5216,7 @@ gfc_simplify_sqrt (gfc_expr *e) case BT_COMPLEX: gfc_set_model (e->value.real); #ifdef HAVE_mpc - call_mpc_func (result->value.complex.r, result->value.complex.i, - e->value.complex.r, e->value.complex.i, mpc_sqrt); + mpc_sqrt (result->value.complex, e->value.complex, GFC_MPC_RND_MODE); #else { /* Formula taken from Numerical Recipes to avoid over- and diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 07d5e194355..4fe41d58ffb 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -164,12 +164,29 @@ encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size) static int -encode_complex (int kind, mpfr_t real, mpfr_t imaginary, unsigned char *buffer, - size_t buffer_size) +encode_complex (int kind, +#ifdef HAVE_mpc + mpc_t cmplx, +#else + mpfr_t real, mpfr_t imaginary, +#endif + unsigned char *buffer, size_t buffer_size) { int size; - size = encode_float (kind, real, &buffer[0], buffer_size); - size += encode_float (kind, imaginary, &buffer[size], buffer_size - size); + size = encode_float (kind, +#ifdef HAVE_mpc + mpc_realref (cmplx), +#else + real, +#endif + &buffer[0], buffer_size); + size += encode_float (kind, +#ifdef HAVE_mpc + mpc_imagref (cmplx), +#else + imaginary, +#endif + &buffer[size], buffer_size - size); return size; } @@ -266,8 +283,14 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, return encode_float (source->ts.kind, source->value.real, buffer, buffer_size); case BT_COMPLEX: - return encode_complex (source->ts.kind, source->value.complex.r, - source->value.complex.i, buffer, buffer_size); + return encode_complex (source->ts.kind, +#ifdef HAVE_mpc + source->value.complex, +#else + source->value.complex.r, + source->value.complex.i, +#endif + buffer, buffer_size); case BT_LOGICAL: return encode_logical (source->ts.kind, source->value.logical, buffer, buffer_size); @@ -368,12 +391,28 @@ gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size, int gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size, - mpfr_t real, mpfr_t imaginary) +#ifdef HAVE_mpc + mpc_t complex +#else + mpfr_t real, mpfr_t imaginary +#endif + ) { int size; - size = gfc_interpret_float (kind, &buffer[0], buffer_size, real); + size = gfc_interpret_float (kind, &buffer[0], buffer_size, +#ifdef HAVE_mpc + mpc_realref (complex) +#else + real +#endif + ); size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, - imaginary); +#ifdef HAVE_mpc + mpc_imagref (complex) +#else + imaginary +#endif + ); return size; } @@ -520,8 +559,13 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, case BT_COMPLEX: result->representation.length = gfc_interpret_complex (result->ts.kind, buffer, buffer_size, +#ifdef HAVE_mpc + result->value.complex +#else result->value.complex.r, - result->value.complex.i); + result->value.complex.i +#endif + ); break; case BT_LOGICAL: @@ -722,10 +766,19 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts) } else { +#ifdef HAVE_mpc + mpc_init2 (expr->value.complex, mpfr_get_default_prec()); +#else mpfr_init (expr->value.complex.r); mpfr_init (expr->value.complex.i); +#endif gfc_interpret_complex (ts->kind, buffer, buffer_size, - expr->value.complex.r, expr->value.complex.i); +#ifdef HAVE_mpc + expr->value.complex +#else + expr->value.complex.r, expr->value.complex.i +#endif + ); } expr->is_boz = 0; expr->ts.type = ts->type; diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h index bc3a1e8c044..0052e5aed8f 100644 --- a/gcc/fortran/target-memory.h +++ b/gcc/fortran/target-memory.h @@ -39,7 +39,11 @@ int gfc_target_encode_expr (gfc_expr *, unsigned char *, size_t); int gfc_interpret_integer (int, unsigned char *, size_t, mpz_t); int gfc_interpret_float (int, unsigned char *, size_t, mpfr_t); +#ifdef HAVE_mpc +int gfc_interpret_complex (int, unsigned char *, size_t, mpc_t); +#else int gfc_interpret_complex (int, unsigned char *, size_t, mpfr_t, mpfr_t); +#endif int gfc_interpret_logical (int, unsigned char *, size_t, int *); int gfc_interpret_character (unsigned char *, size_t, gfc_expr *); int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *); diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 5b105bef248..4b7b2c027ee 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -307,9 +307,9 @@ gfc_conv_constant_to_tree (gfc_expr * expr) expr->representation.string)); else { - tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r, + tree real = gfc_conv_mpfr_to_tree (mpc_realref (expr->value.complex), expr->ts.kind, expr->is_snan); - tree imag = gfc_conv_mpfr_to_tree (expr->value.complex.i, + tree imag = gfc_conv_mpfr_to_tree (mpc_imagref (expr->value.complex), expr->ts.kind, expr->is_snan); return build_complex (gfc_typenode_for_spec (&expr->ts), diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5af00a91a03..091d3946852 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3835,7 +3835,11 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) /* For POINTER, ALLOCATABLE and assumed-shape dummy arguments, the string lengths must match exactly. Otherwise, it is only required - that the actual string length is *at least* the expected one. */ + that the actual string length is *at least* the expected one. + Sequence association allows for a mismatch of the string length + if the actual argument is (part of) an array, but only if the + dummy argument is an array. (See "Sequence association" in + Section 12.4.1.4 for F95 and 12.4.1.5 for F2003.) */ if (fsym->attr.pointer || fsym->attr.allocatable || (fsym->as && fsym->as->type == AS_ASSUMED_SHAPE)) { @@ -3843,6 +3847,8 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) message = _("Actual string length does not match the declared one" " for dummy argument '%s' (%ld/%ld)"); } + else if (fsym->as && fsym->as->rank != 0) + continue; else { comparison = LT_EXPR; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index a4d00df7fa7..f79ad4b3cc7 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2646,7 +2646,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (fsym && e->expr_type != EXPR_NULL && ((fsym->attr.pointer && fsym->attr.flavor != FL_PROCEDURE) - || fsym->attr.proc_pointer)) + || (fsym->attr.proc_pointer + && !(e->expr_type == EXPR_VARIABLE + && e->symtree->n.sym->attr.dummy)))) { /* Scalar pointer dummy args require an extra level of indirection. The null pointer already contains @@ -2737,6 +2739,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, dealt with in trans-array.c(gfc_conv_array_parameter). */ if (e && e->ts.type == BT_DERIVED && e->ts.derived->attr.alloc_comp + && !(e->symtree && e->symtree->n.sym->attr.pointer) && (e->expr_type != EXPR_VARIABLE && !e->rank)) { int parm_rank; @@ -4405,10 +4408,10 @@ is_zero_initializer_p (gfc_expr * expr) return expr->value.logical == 0; case BT_COMPLEX: - return mpfr_zero_p (expr->value.complex.r) - && MPFR_SIGN (expr->value.complex.r) >= 0 - && mpfr_zero_p (expr->value.complex.i) - && MPFR_SIGN (expr->value.complex.i) >= 0; + return mpfr_zero_p (mpc_realref (expr->value.complex)) + && MPFR_SIGN (mpc_realref (expr->value.complex)) >= 0 + && mpfr_zero_p (mpc_imagref (expr->value.complex)) + && MPFR_SIGN (mpc_imagref (expr->value.complex)) >= 0; default: break; diff --git a/gcc/genopinit.c b/gcc/genopinit.c index f8cbf9549f8..52e0dd9462a 100644 --- a/gcc/genopinit.c +++ b/gcc/genopinit.c @@ -178,6 +178,7 @@ static const char * const optabs[] = "optab_handler (expm1_optab, $A)->insn_code = CODE_FOR_$(expm1$a2$)", "optab_handler (ldexp_optab, $A)->insn_code = CODE_FOR_$(ldexp$a3$)", "optab_handler (scalb_optab, $A)->insn_code = CODE_FOR_$(scalb$a3$)", + "optab_handler (significand_optab, $A)->insn_code = CODE_FOR_$(significand$a2$)", "optab_handler (logb_optab, $A)->insn_code = CODE_FOR_$(logb$a2$)", "optab_handler (ilogb_optab, $A)->insn_code = CODE_FOR_$(ilogb$a2$)", "optab_handler (log_optab, $A)->insn_code = CODE_FOR_$(log$a2$)", diff --git a/gcc/ggc-page.c b/gcc/ggc-page.c index 4f872b294f1..744355e3de3 100644 --- a/gcc/ggc-page.c +++ b/gcc/ggc-page.c @@ -2165,7 +2165,7 @@ ggc_pch_write_object (struct ggc_pch_data *d ATTRIBUTE_UNUSED, size_t size, bool is_string ATTRIBUTE_UNUSED) { unsigned order; - static const char emptyBytes[256]; + static const char emptyBytes[256] = { 0 }; if (size < NUM_SIZE_LOOKUP) order = size_lookup[size]; diff --git a/gcc/gimple-pretty-print.c b/gcc/gimple-pretty-print.c index 9ea461d58ba..f3f3b1af611 100644 --- a/gcc/gimple-pretty-print.c +++ b/gcc/gimple-pretty-print.c @@ -508,7 +508,7 @@ dump_gimple_call (pretty_printer *buffer, gimple gs, int spc, int flags) pp_space (buffer); } - print_call_name (buffer, gimple_call_fn (gs)); + print_call_name (buffer, gimple_call_fn (gs), flags); pp_string (buffer, " ("); dump_gimple_call_args (buffer, gs, flags); pp_character (buffer, ')'); diff --git a/gcc/objc/ChangeLog b/gcc/objc/ChangeLog index 2fe4b25be8c..426a6a8a2f3 100644 --- a/gcc/objc/ChangeLog +++ b/gcc/objc/ChangeLog @@ -1,3 +1,11 @@ +2009-06-19 Ian Lance Taylor <iant@google.com> + + * objc-act.c (objc_in_struct, objc_struct_types): Remove. + (objc_struct_info): New static variable. + (objc_start_struct): Pass &objc_struct_info, not &objc_in_struct + and &objc_struct_types, to start_struct. + (objc_finish_struct): Likewise for finish_struct. + 2009-06-15 Ian Lance Taylor <iant@google.com> * objc-act.c (objc_start_function): Don't set diff --git a/gcc/objc/objc-act.c b/gcc/objc/objc-act.c index f114b65ef4a..b6a01ed316b 100644 --- a/gcc/objc/objc-act.c +++ b/gcc/objc/objc-act.c @@ -420,8 +420,7 @@ static int generating_instance_variables = 0; is compiled as part of obj-c++. */ static bool objc_building_struct; -static bool objc_in_struct ATTRIBUTE_UNUSED; -static VEC(tree,heap) *objc_struct_types ATTRIBUTE_UNUSED; +static struct c_struct_parse_info *objc_struct_info ATTRIBUTE_UNUSED; /* Start building a struct for objc. */ @@ -430,8 +429,7 @@ objc_start_struct (tree name) { gcc_assert (!objc_building_struct); objc_building_struct = true; - return start_struct (input_location, RECORD_TYPE, - name, &objc_in_struct, &objc_struct_types); + return start_struct (input_location, RECORD_TYPE, name, &objc_struct_info); } /* Finish building a struct for objc. */ @@ -442,7 +440,7 @@ objc_finish_struct (tree type, tree fieldlist) gcc_assert (objc_building_struct); objc_building_struct = false; return finish_struct (input_location, type, fieldlist, NULL_TREE, - objc_in_struct, objc_struct_types); + objc_struct_info); } /* Some platforms pass small structures through registers versus diff --git a/gcc/objcp/ChangeLog b/gcc/objcp/ChangeLog index 45985f8db0b..526830f588b 100644 --- a/gcc/objcp/ChangeLog +++ b/gcc/objcp/ChangeLog @@ -1,3 +1,9 @@ +2009-06-19 Ian Lance Taylor <iant@google.com> + + * objcp-decl.h (start_struct): Remove in_struct and struct_types + parameters. Add struct_info parameter. + (finish_struct): Likewise. + 2009-06-13 Aldy Hernandez <aldyh@redhat.com> * objcp-decl.h (start_struct): Add location argument. diff --git a/gcc/objcp/objcp-decl.h b/gcc/objcp/objcp-decl.h index 07d39abaf8f..50d98287662 100644 --- a/gcc/objcp/objcp-decl.h +++ b/gcc/objcp/objcp-decl.h @@ -37,9 +37,9 @@ extern tree objcp_end_compound_stmt (tree, int); invoke the original C++ functions if needed). */ #ifdef OBJCP_REMAP_FUNCTIONS -#define start_struct(loc, code, name, in_struct, struct_types) \ +#define start_struct(loc, code, name, struct_info) \ objcp_start_struct (loc, code, name) -#define finish_struct(loc, t, fieldlist, attributes, in_struct, struct_types) \ +#define finish_struct(loc, t, fieldlist, attributes, struct_info) \ objcp_finish_struct (loc, t, fieldlist, attributes) #define finish_function() \ objcp_finish_function () diff --git a/gcc/optabs.c b/gcc/optabs.c index 99da304b5c1..34d284a588b 100644 --- a/gcc/optabs.c +++ b/gcc/optabs.c @@ -6271,6 +6271,7 @@ init_optabs (void) init_optab (expm1_optab, UNKNOWN); init_optab (ldexp_optab, UNKNOWN); init_optab (scalb_optab, UNKNOWN); + init_optab (significand_optab, UNKNOWN); init_optab (logb_optab, UNKNOWN); init_optab (ilogb_optab, UNKNOWN); init_optab (log_optab, UNKNOWN); diff --git a/gcc/optabs.h b/gcc/optabs.h index 096feda7df2..82f8084883a 100644 --- a/gcc/optabs.h +++ b/gcc/optabs.h @@ -242,6 +242,8 @@ enum optab_index OTI_ldexp, /* Multiply floating-point number by integral power of radix */ OTI_scalb, + /* Mantissa of a floating-point number */ + OTI_significand, /* Radix-independent exponent */ OTI_logb, OTI_ilogb, @@ -462,6 +464,7 @@ extern struct optab_d optab_table[OTI_MAX]; #define expm1_optab (&optab_table[OTI_expm1]) #define ldexp_optab (&optab_table[OTI_ldexp]) #define scalb_optab (&optab_table[OTI_scalb]) +#define significand_optab (&optab_table[OTI_significand]) #define logb_optab (&optab_table[OTI_logb]) #define ilogb_optab (&optab_table[OTI_ilogb]) #define log_optab (&optab_table[OTI_log]) diff --git a/gcc/opts.c b/gcc/opts.c index 210140c63c3..94e70ba9676 100644 --- a/gcc/opts.c +++ b/gcc/opts.c @@ -2067,6 +2067,7 @@ common_handle_option (size_t scode, const char *arg, int value, flag_pedantic_errors = pedantic = 1; break; + case OPT_fsee: case OPT_fcse_skip_blocks: case OPT_floop_optimize: case OPT_frerun_loop_opt: diff --git a/gcc/passes.c b/gcc/passes.c index 6870973229d..36ffd222135 100644 --- a/gcc/passes.c +++ b/gcc/passes.c @@ -768,7 +768,6 @@ init_optimization_passes (void) NEXT_PASS (pass_df_initialize_no_opt); NEXT_PASS (pass_stack_ptr_mod); NEXT_PASS (pass_mode_switching); - NEXT_PASS (pass_see); NEXT_PASS (pass_match_asm_constraints); NEXT_PASS (pass_sms); NEXT_PASS (pass_sched); diff --git a/gcc/plugin.c b/gcc/plugin.c index 93151f8a8a7..396850a3a97 100644 --- a/gcc/plugin.c +++ b/gcc/plugin.c @@ -25,7 +25,7 @@ along with GCC; see the file COPYING3. If not see /* If plugin support is not enabled, do not try to execute any code that may reference libdl. The generic code is still compiled in to - avoid including to many conditional compilation paths in the rest + avoid including too many conditional compilation paths in the rest of the compiler. */ #ifdef ENABLE_PLUGIN #include <dlfcn.h> @@ -95,6 +95,10 @@ static struct pass_list_node *prev_added_pass_node; /* Each plugin should define an initialization function with exactly this name. */ static const char *str_plugin_init_func_name = "plugin_init"; + +/* Each plugin should define this symbol to assert that it is + distributed under a GPL-compatible license. */ +static const char *str_license = "plugin_is_GPL_compatible"; #endif /* Helper function for the hash table that compares the base_name of the @@ -595,6 +599,11 @@ try_init_one_plugin (struct plugin_name_args *plugin) /* Clear any existing error. */ dlerror (); + /* Check the plugin license. */ + if (dlsym (dl_handle, str_license) == NULL) + fatal_error ("plugin %s is not licensed under a GPL-compatible license\n" + "%s", plugin->full_name, dlerror ()); + PTR_UNION_AS_VOID_PTR (plugin_init_union) = dlsym (dl_handle, str_plugin_init_func_name); plugin_init = PTR_UNION_AS_CAST_PTR (plugin_init_union); diff --git a/gcc/rtl.h b/gcc/rtl.h index de9d9a80753..637c227ec12 100644 --- a/gcc/rtl.h +++ b/gcc/rtl.h @@ -1120,7 +1120,7 @@ do { \ } while (0) #define SUBREG_PROMOTED_UNSIGNED_P(RTX) \ ((RTL_FLAG_CHECK1("SUBREG_PROMOTED_UNSIGNED_P", (RTX), SUBREG)->volatil) \ - ? -1 : (RTX)->unchanging) + ? -1 : (int) (RTX)->unchanging) /* Access various components of an ASM_OPERANDS rtx. */ diff --git a/gcc/sdbout.c b/gcc/sdbout.c index 0e1cf18dfb2..dbcba690436 100644 --- a/gcc/sdbout.c +++ b/gcc/sdbout.c @@ -1,6 +1,6 @@ /* Output sdb-format symbol table information from GNU compiler. Copyright (C) 1988, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008 + 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. This file is part of GCC. @@ -1698,7 +1698,37 @@ sdbout_init (const char *input_file_name ATTRIBUTE_UNUSED) #else /* SDB_DEBUGGING_INFO */ /* This should never be used, but its address is needed for comparisons. */ -const struct gcc_debug_hooks sdb_debug_hooks; +const struct gcc_debug_hooks sdb_debug_hooks = +{ + 0, /* init */ + 0, /* finish */ + 0, /* define */ + 0, /* undef */ + 0, /* start_source_file */ + 0, /* end_source_file */ + 0, /* begin_block */ + 0, /* end_block */ + 0, /* ignore_block */ + 0, /* source_line */ + 0, /* begin_prologue */ + 0, /* end_prologue */ + 0, /* end_epilogue */ + 0, /* begin_function */ + 0, /* end_function */ + 0, /* function_decl */ + 0, /* global_decl */ + 0, /* type_decl */ + 0, /* imported_module_or_decl */ + 0, /* deferred_inline_function */ + 0, /* outlining_inline_function */ + 0, /* label */ + 0, /* handle_pch */ + 0, /* var_location */ + 0, /* switch_text_section */ + 0, /* set_name */ + 0 /* start_end_main_source_file */ +}; + #endif /* SDB_DEBUGGING_INFO */ diff --git a/gcc/see.c b/gcc/see.c deleted file mode 100644 index 27e70216f05..00000000000 --- a/gcc/see.c +++ /dev/null @@ -1,3894 +0,0 @@ -/* Sign extension elimination optimization for GNU compiler. - Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - Contributed by Leehod Baruch <leehod@il.ibm.com> - -This file is part of GCC. - -GCC is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free --Software Foundation; either version 3, or (at your option) any later -version. - -GCC is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with GCC; see the file COPYING3. If not see -<http://www.gnu.org/licenses/>. - -Problem description: --------------------- -In order to support 32bit computations on a 64bit machine, sign -extension instructions are generated to ensure the correctness of -the computation. -A possible policy (as currently implemented) is to generate a sign -extension right after each 32bit computation. -Depending on the instruction set of the architecture, some of these -sign extension instructions may be redundant. -There are two cases in which the extension may be redundant: - -Case1: -The instruction that uses the 64bit operands that are sign -extended has a dual mode that works with 32bit operands. -For example: - - int32 a, b; - - a = .... --> a = .... - a = sign extend a --> - b = .... --> b = .... - b = sign extend a --> - --> - cmpd a, b --> cmpw a, b //half word compare - -Case2: -The instruction that defines the 64bit operand (which is later sign -extended) has a dual mode that defines and sign-extends simultaneously -a 32bit operand. For example: - - int32 a; - - ld a --> lwa a // load half word and sign extend - a = sign extend a --> - --> - return a --> return a - - -General idea for solution: --------------------------- -First, try to merge the sign extension with the instruction that -defines the source of the extension and (separately) with the -instructions that uses the extended result. By doing this, both cases -of redundancies (as described above) will be eliminated. - -Then, use partial redundancy elimination to place the non redundant -ones at optimal placements. - - -Implementation by example: --------------------------- -Note: The instruction stream is not changed till the last phase. - -Phase 0: Initial code, as currently generated by gcc. - - def1 def3 - se1 def2 se3 - | \ | / | - | \ | / | - | \ | / | - | \ | / | - | \ | / | - | \|/ | - use1 use2 use3 - use4 -def1 + se1: -set ((reg:SI 10) (..def1rhs..)) -set ((reg:DI 100) (sign_extend:DI (reg:SI 10))) - -def2: -set ((reg:DI 100) (const_int 7)) - -def3 + se3: -set ((reg:SI 20) (..def3rhs..)) -set ((reg:DI 100) (sign_extend:DI (reg:SI 20))) - -use1: -set ((reg:CC...) (compare:CC (reg:DI 100) (...))) - -use2, use3, use4: -set ((...) (reg:DI 100)) - -Phase 1: Propagate extensions to uses. - - def1 def3 - se1 def2 se3 - | \ | / | - | \ | / | - | \ | / | - | \ | / | - | \ | / | - | \|/ | - se se se - use1 use2 use3 - se - use4 - -From here, all of the subregs are lowpart ! - -def1, def2, def3: No change. - -use1: -set ((reg:DI 100) (sign_extend:DI ((subreg:SI (reg:DI 100))))) -set ((reg:CC...) (compare:CC (reg:DI 100) (...))) - -use2, use3, use4: -set ((reg:DI 100) (sign_extend:DI ((subreg:SI (reg:DI 100))))) -set ((...) (reg:DI 100)) - - -Phase 2: Merge and eliminate locally redundant extensions. - - - *def1 def2 *def3 - [se removed] se se3 - | \ | / | - | \ | / | - | \ | / | - | \ | / | - | \ | / | - | \|/ | - [se removed] se se - *use1 use2 use3 - [se removed] - use4 - -The instructions that were changed at this phase are marked with -asterisk. - -*def1: Merge failed. - Remove the sign extension instruction, modify def1 and - insert a move instruction to assure to correctness of the code. -set ((subreg:SI (reg:DI 100)) (..def1rhs..)) -set ((reg:SI 10) (subreg:SI (reg:DI 100))) - -def2 + se: There is no need for merge. - Def2 is not changed but a sign extension instruction is - created. -set ((reg:DI 100) (const_int 7)) -set ((reg:DI 100) (sign_extend:DI ((subreg:SI (reg:DI 100))))) - -*def3 + se3: Merge succeeded. -set ((reg:DI 100) (sign_extend:DI (..def3rhs..))) -set ((reg:SI 20) (reg:DI 100)) -set ((reg:DI 100) (sign_extend:DI (reg:SI 20))) -(The extension instruction is the original one). - -*use1: Merge succeeded. Remove the sign extension instruction. -set ((reg:CC...) - (compare:CC (subreg:SI (reg:DI 100)) (...))) - -use2, use3: Merge failed. No change. - -use4: The extension is locally redundant, therefore it is eliminated - at this point. - - -Phase 3: Eliminate globally redundant extensions. - -Following the LCM output: - - def1 def2 def3 - se se3 - | \ | / | - | \ | / | - | se | / | - | \ | / | - | \ | / | - | \|/ | - [ses removed] - use1 use2 use3 - use4 - -se: -set ((reg:DI 100) (sign_extend:DI ((subreg:SI (reg:DI 100))))) - -se3: -set ((reg:DI 100) (sign_extend:DI (reg:SI 20))) - - -Phase 4: Commit changes to the insn stream. - - - def1 def3 *def1 def2 *def3 - se1 def2 se3 [se removed] [se removed] - | \ | / | | \ | / | - | \ | / | ------> | \ | / | - | \ | / | ------> | se | / | - | \ | / | | \ | / | - | \ | / | | \ | / | - | \|/ | | \|/ | - use1 use2 use3 *use1 use2 use3 - use4 use4 - -The instructions that were changed during the whole optimization are -marked with asterisk. - -The result: - -def1 + se1: -[ set ((reg:SI 10) (..def1rhs..)) ] - Deleted -[ set ((reg:DI 100) (sign_extend:DI (reg:SI 10))) ] - Deleted -set ((subreg:SI (reg:DI 100)) (..def3rhs..)) - Inserted -set ((reg:SI 10) (subreg:SI (reg:DI 100))) - Inserted - -def2: -set ((reg:DI 100) (const_int 7)) - No change - -def3 + se3: -[ set ((reg:SI 20) (..def3rhs..)) ] - Deleted -[ set ((reg:DI 100) (sign_extend:DI (reg:SI 20))) ] - Deleted -set ((reg:DI 100) (sign_extend:DI (..def3rhs..))) - Inserted -set ((reg:SI 20) (reg:DI 100)) - Inserted - -use1: -[ set ((reg:CC...) (compare:CC (reg:DI 100) (...))) ] - Deleted -set ((reg:CC...) - Inserted - (compare:CC (subreg:SI (reg:DI 100)) (...))) - -use2, use3, use4: -set ((...) (reg:DI 100)) - No change - -se: - Inserted -set ((reg:DI 100) (sign_extend:DI ((subreg:SI (reg:DI 100))))) - -Note: Most of the simple move instructions that were inserted will be - trivially dead and therefore eliminated. - -The implementation outline: ---------------------------- -Some definitions: - A web is RELEVANT if at the end of phase 1, his leader's - relevancy is {ZERO, SIGN}_EXTENDED_DEF. The source_mode of - the web is the source_mode of his leader. - A definition is a candidate for the optimization if it is part - of a RELEVANT web and his local source_mode is not narrower - then the source_mode of its web. - A use is a candidate for the optimization if it is part of a - RELEVANT web. - A simple explicit extension is a single set instruction that - extends a register (or a subregister) to a register (or - subregister). - A complex explicit extension is an explicit extension instruction - that is not simple. - A def extension is a simple explicit extension that is - also a candidate for the optimization. This extension is part - of the instruction stream, it is not generated by this - optimization. - A use extension is a simple explicit extension that is generated - and stored for candidate use during this optimization. It is - not emitted to the instruction stream till the last phase of - the optimization. - A reference is an instruction that satisfy at least on of these - criteria: - - It contains a definition with EXTENDED_DEF relevancy in a RELEVANT web. - - It is followed by a def extension. - - It contains a candidate use. - -Phase 1: Propagate extensions to uses. - In this phase, we find candidate extensions for the optimization - and we generate (but not emit) proper extensions "right before the - uses". - - a. Build a DF object. - b. Traverse over all the instructions that contains a definition - and set their local relevancy and local source_mode like this: - - If the instruction is a simple explicit extension instruction, - mark it as {ZERO, SIGN}_EXTENDED_DEF according to the extension - type and mark its source_mode to be the mode of the quantity - that is been extended. - - Otherwise, If the instruction has an implicit extension, - which means that its high part is an extension of its low part, - or if it is a complicated explicit extension, mark it as - EXTENDED_DEF and set its source_mode to be the narrowest - mode that is been extended in the instruction. - c. Traverse over all the instructions that contains a use and set - their local relevancy to RELEVANT_USE (except for few corner - cases). - d. Produce the web. During union of two entries, update the - relevancy and source_mode of the leader. There are two major - guide lines for this update: - - If one of the entries is NOT_RELEVANT, mark the leader - NOT_RELEVANT. - - If one is ZERO_EXTENDED_DEF and the other is SIGN_EXTENDED_DEF - (or vice versa) mark the leader as NOT_RELEVANT. We don't - handle this kind of mixed webs. - (For more details about this update process, - see see_update_leader_extra_info ()). - e. Generate uses extensions according to the relevancy and - source_mode of the webs. - -Phase 2: Merge and eliminate locally redundant extensions. - In this phase, we try to merge def extensions and use - extensions with their references, and eliminate redundant extensions - in the same basic block. - - Traverse over all the references. Do this in basic block number and - luid number forward order. - For each reference do: - a. Peephole optimization - try to merge it with all its - def extensions and use extensions in the following - order: - - Try to merge only the def extensions, one by one. - - Try to merge only the use extensions, one by one. - - Try to merge any couple of use extensions simultaneously. - - Try to merge any def extension with one or two uses - extensions simultaneously. - b. Handle each EXTENDED_DEF in it as if it was already merged with - an extension. - - During the merge process we save the following data for each - register in each basic block: - a. The first instruction that defines the register in the basic - block. - b. The last instruction that defines the register in the basic - block. - c. The first extension of this register before the first - instruction that defines it in the basic block. - c. The first extension of this register after the last - instruction that defines it in the basic block. - This data will help us eliminate (or more precisely, not generate) - locally redundant extensions, and will be useful in the next stage. - - While merging extensions with their reference there are 4 possible - situations: - a. A use extension was merged with the reference: - Delete the extension instruction and save the merged reference - for phase 4. (For details, see see_use_extension_merged ()) - b. A use extension failed to be merged with the reference: - If there is already such an extension in the same basic block - and it is not dead at this point, delete the unmerged extension - (it is locally redundant), otherwise properly update the above - basic block data. - (For details, see see_merge_one_use_extension ()) - c. A def extension was merged with the reference: - Mark this extension as a merged_def extension and properly - update the above basic block data. - (For details, see see_merge_one_def_extension ()) - d. A def extension failed to be merged with the reference: - Replace the definition of the NARROWmode register in the - reference with the proper subreg of WIDEmode register and save - the result as a merged reference. Also, properly update the - the above basic block data. - (For details, see see_def_extension_not_merged ()) - -Phase 3: Eliminate globally redundant extensions. -In this phase, we set the bit vectors input of the edge based LCM -using the recorded data on the registers in each basic block. -We also save pointers for all the anticipatable and available -occurrences of the relevant extensions. Then we run the LCM. - - a. Initialize the comp, antloc, kill bit vectors to zero and the - transp bit vector to ones. - - b. Traverse over all the references. Do this in basic block number - and luid number forward order. For each reference: - - Go over all its use extensions. For each such extension - - If it is not dead from the beginning of the basic block SET - the antloc bit of the current extension in the current - basic block bits. - If it is not dead till the end of the basic block SET the - comp bit of the current extension in the current basic - block bits. - - Go over all its def extensions that were merged with - it. For each such extension - - If it is not dead till the end of the basic block SET the - comp bit of the current extension in the current basic - block bits. - RESET the proper transp and kill bits. - - Go over all its def extensions that were not merged - with it. For each such extension - - RESET the transp bit and SET the kill bit of the current - extension in the current basic block bits. - - c. Run the edge based LCM. - -Phase 4: Commit changes to the insn stream. -This is the only phase that actually changes the instruction stream. -Up to this point the optimization could be aborted at any time. -Here we insert extensions at their best placements and delete the -redundant ones according to the output of the LCM. We also replace -some of the instructions according to the second phase merges results. - - a. Use the pre_delete_map (from the output of the LCM) in order to - delete redundant extensions. This will prevent them from been - emitted in the first place. - - b. Insert extensions on edges where needed according to - pre_insert_map and edge_list (from the output of the LCM). - - c. For each reference do- - - Emit all the uses extensions that were not deleted until now, - right before the reference. - - Delete all the merged and unmerged def extensions from - the instruction stream. - - Replace the reference with the merged one, if exist. - -The implementation consists of four data structures: -- Data structure I - Purpose: To handle the relevancy of the uses, definitions and webs. - Relevant structures: web_entry (from df.h), see_entry_extra_info. - Details: This is a disjoint-set data structure. Most of its functions are - implemented in web.c. Each definition and use in the code are - elements. A web_entry structure is allocated for each element to - hold the element's relevancy and source_mode. The union rules are - defined in see_update_leader_extra_info (). -- Data structure II - Purpose: To store references and their extensions (uses and defs) - and to enable traverse over these references according to basic - block order. - Relevant structure: see_ref_s. - Details: This data structure consists of an array of splay trees. One splay - tree for each basic block. The splay tree nodes are references and - the keys are the luids of the references. - A see_ref_s structure is allocated for each reference. It holds the - reference itself, its def and uses extensions and later the merged - version of the reference. - Using this data structure we can traverse over all the references of - a basic block and their extensions in forward order. -- Data structure III. - Purpose: To store local properties of registers for each basic block. - This data will later help us build the LCM sbitmap_vectors - input. - Relevant structure: see_register_properties. - Details: This data structure consists of an array of hash tables. One hash - for each basic block. The hash node are a register properties - and the keys are the numbers of the registers. - A see_register_properties structure is allocated for each register - that we might be interested in its properties. - Using this data structure we can easily find the properties of a - register in a specific basic block. This is necessary for locally - redundancy elimination and for setting up the LCM input. -- Data structure IV. - Purpose: To store the extensions that are candidate for PRE and their - anticipatable and available occurrences. - Relevant structure: see_occr, see_pre_extension_expr. - Details: This data structure is a hash tables. Its nodes are the extensions - that are candidate for PRE. - A see_pre_extension_expr structure is allocated for each candidate - extension. It holds a copy of the extension and a linked list of all - the anticipatable and available occurrences of it. - We use this data structure when we read the output of the LCM. */ - -#include "config.h" -#include "system.h" -#include "coretypes.h" -#include "tm.h" - -#include "obstack.h" -#include "rtl.h" -#include "output.h" -#include "df.h" -#include "insn-config.h" -#include "recog.h" -#include "expr.h" -#include "splay-tree.h" -#include "hashtab.h" -#include "regs.h" -#include "timevar.h" -#include "tree-pass.h" -#include "dce.h" - -/* Used to classify defs and uses according to relevancy. */ -enum entry_type { - NOT_RELEVANT, - SIGN_EXTENDED_DEF, - ZERO_EXTENDED_DEF, - EXTENDED_DEF, - RELEVANT_USE -}; - -/* Used to classify extensions in relevant webs. */ -enum extension_type { - DEF_EXTENSION, - EXPLICIT_DEF_EXTENSION, - IMPLICIT_DEF_EXTENSION, - USE_EXTENSION -}; - -/* Global data structures and flags. */ - -/* This structure will be assigned for each web_entry structure (defined - in df.h). It is placed in the extra_info field of a web_entry and holds the - relevancy and source mode of the web_entry. */ - -struct see_entry_extra_info -{ - /* The relevancy of the ref. */ - enum entry_type relevancy; - /* The relevancy of the ref. - This field is updated only once - when this structure is created. */ - enum entry_type local_relevancy; - /* The source register mode. */ - enum machine_mode source_mode; - /* This field is used only if the relevancy is ZERO/SIGN_EXTENDED_DEF. - It is updated only once when this structure is created. */ - enum machine_mode local_source_mode; - /* This field is used only if the relevancy is EXTENDED_DEF. - It holds the narrowest mode that is sign extended. */ - enum machine_mode source_mode_signed; - /* This field is used only if the relevancy is EXTENDED_DEF. - It holds the narrowest mode that is zero extended. */ - enum machine_mode source_mode_unsigned; -}; - -/* There is one such structure for every reference. It stores the reference - itself as well as its extensions (uses and definitions). - Used as the value in splay_tree see_bb_splay_ar[]. */ -struct see_ref_s -{ - /* The luid of the insn. */ - unsigned int luid; - /* The insn of the ref. */ - rtx insn; - /* The merged insn that was formed from the reference's insn and extensions. - If all merges failed, it remains NULL. */ - rtx merged_insn; - /* The def extensions of the reference that were not merged with - it. */ - htab_t unmerged_def_se_hash; - /* The def extensions of the reference that were merged with - it. Implicit extensions of the reference will be stored here too. */ - htab_t merged_def_se_hash; - /* The uses extensions of reference. */ - htab_t use_se_hash; -}; - -/* There is one such structure for every relevant extended register in a - specific basic block. This data will help us build the LCM sbitmap_vectors - input. */ -struct see_register_properties -{ - /* The register number. */ - unsigned int regno; - /* The last luid of the reference that defines this register in this basic - block. */ - int last_def; - /* The luid of the reference that has the first extension of this register - that appears before any definition in this basic block. */ - int first_se_before_any_def; - /* The luid of the reference that has the first extension of this register - that appears after the last definition in this basic block. */ - int first_se_after_last_def; -}; - -/* Occurrence of an expression. - There must be at most one available occurrence and at most one anticipatable - occurrence per basic block. */ -struct see_occr -{ - /* Next occurrence of this expression. */ - struct see_occr *next; - /* The insn that computes the expression. */ - rtx insn; - int block_num; -}; - -/* There is one such structure for every relevant extension expression. - It holds a copy of this extension instruction as well as a linked lists of - pointers to all the antic and avail occurrences of it. */ -struct see_pre_extension_expr -{ - /* A copy of the extension instruction. */ - rtx se_insn; - /* Index in the available expression bitmaps. */ - int bitmap_index; - /* List of anticipatable occurrences in basic blocks in the function. - An "anticipatable occurrence" is the first occurrence in the basic block, - the operands are not modified in the basic block prior to the occurrence - and the output is not used between the start of the block and the - occurrence. */ - struct see_occr *antic_occr; - /* List of available occurrence in basic blocks in the function. - An "available occurrence" is the last occurrence in the basic block and - the operands are not modified by following statements in the basic block - [including this insn]. */ - struct see_occr *avail_occr; -}; - -/* Helper structure for the note_uses and see_replace_src functions. */ -struct see_replace_data -{ - rtx from; - rtx to; -}; - -/* Helper structure for the note_uses and see_mentioned_reg functions. */ -struct see_mentioned_reg_data -{ - rtx reg; - bool mentioned; -}; - -/* An array of web_entries. The i'th definition in the df object is associated - with def_entry[i] */ -static struct web_entry *def_entry = NULL; -/* An array of web_entries. The i'th use in the df object is associated with - use_entry[i] */ -static struct web_entry *use_entry = NULL; -/* Array of splay_trees. - see_bb_splay_ar[i] refers to the splay tree of the i'th basic block. - The splay tree will hold see_ref_s structures. The key is the luid - of the insn. This way we can traverse over the references of each basic - block in forward or backward order. */ -static splay_tree *see_bb_splay_ar = NULL; -/* Array of hashes. - see_bb_hash_ar[i] refers to the hash of the i'th basic block. - The hash will hold see_register_properties structure. The key is regno. */ -static htab_t *see_bb_hash_ar = NULL; -/* Hash table that holds a copy of all the extensions. The key is the right - hand side of the se_insn field. */ -static htab_t see_pre_extension_hash = NULL; - -/* Local LCM properties of expressions. */ -/* Nonzero for expressions that are transparent in the block. */ -static sbitmap *transp = NULL; -/* Nonzero for expressions that are computed (available) in the block. */ -static sbitmap *comp = NULL; -/* Nonzero for expressions that are locally anticipatable in the block. */ -static sbitmap *antloc = NULL; -/* Nonzero for expressions that are locally killed in the block. */ -static sbitmap *ae_kill = NULL; -/* Nonzero for expressions which should be inserted on a specific edge. */ -static sbitmap *pre_insert_map = NULL; -/* Nonzero for expressions which should be deleted in a specific block. */ -static sbitmap *pre_delete_map = NULL; -/* Contains the edge_list returned by pre_edge_lcm. */ -static struct edge_list *edge_list = NULL; -/* Records the last basic block at the beginning of the optimization. */ -static int last_bb; -/* Records the number of uses at the beginning of the optimization. */ -static unsigned int uses_num; -/* Records the number of definitions at the beginning of the optimization. */ -static unsigned int defs_num; - -#define ENTRY_EI(ENTRY) ((struct see_entry_extra_info *) (ENTRY)->extra_info) - -/* Functions implementation. */ - -/* Verifies that EXTENSION's pattern is this: - - set (reg/subreg reg1) (sign/zero_extend:WIDEmode (reg/subreg reg2)) - - If it doesn't have the expected pattern return NULL. - Otherwise, if RETURN_DEST_REG is set, return reg1 else return reg2. */ - -static rtx -see_get_extension_reg (rtx extension, bool return_dest_reg) -{ - rtx set, rhs, lhs; - rtx reg1 = NULL; - rtx reg2 = NULL; - - /* Parallel pattern for extension not supported for the moment. */ - if (GET_CODE (PATTERN (extension)) == PARALLEL) - return NULL; - - set = single_set (extension); - if (!set) - return NULL; - lhs = SET_DEST (set); - rhs = SET_SRC (set); - - if (REG_P (lhs)) - reg1 = lhs; - else if (REG_P (SUBREG_REG (lhs))) - reg1 = SUBREG_REG (lhs); - else - return NULL; - - if (GET_CODE (rhs) != SIGN_EXTEND && GET_CODE (rhs) != ZERO_EXTEND) - return NULL; - - rhs = XEXP (rhs, 0); - if (REG_P (rhs)) - reg2 = rhs; - else if (REG_P (SUBREG_REG (rhs))) - reg2 = SUBREG_REG (rhs); - else - return NULL; - - if (return_dest_reg) - return reg1; - return reg2; -} - -/* Verifies that EXTENSION's pattern is this: - - set (reg/subreg reg1) (sign/zero_extend: (...expr...) - - If it doesn't have the expected pattern return UNKNOWN. - Otherwise, set SOURCE_MODE to be the mode of the extended expr and return - the rtx code of the extension. */ - -static enum entry_type -see_get_extension_data (rtx extension, enum machine_mode *source_mode) -{ - rtx rhs, lhs, set; - - if (!extension || !INSN_P (extension)) - return NOT_RELEVANT; - - /* Parallel pattern for extension not supported for the moment. */ - if (GET_CODE (PATTERN (extension)) == PARALLEL) - return NOT_RELEVANT; - - set = single_set (extension); - if (!set) - return NOT_RELEVANT; - rhs = SET_SRC (set); - lhs = SET_DEST (set); - - /* Don't handle extensions to something other then register or - subregister. */ - if (!REG_P (lhs) && GET_CODE (lhs) != SUBREG) - return NOT_RELEVANT; - - if (GET_CODE (rhs) != SIGN_EXTEND && GET_CODE (rhs) != ZERO_EXTEND) - return NOT_RELEVANT; - - if (!REG_P (XEXP (rhs, 0)) - && !(GET_CODE (XEXP (rhs, 0)) == SUBREG - && REG_P (SUBREG_REG (XEXP (rhs, 0))))) - return NOT_RELEVANT; - - *source_mode = GET_MODE (XEXP (rhs, 0)); - - if (GET_CODE (rhs) == SIGN_EXTEND) - return SIGN_EXTENDED_DEF; - return ZERO_EXTENDED_DEF; -} - - -/* Generate instruction with the pattern: - set ((reg r) (sign/zero_extend (subreg:mode (reg r)))) - (the register r on both sides of the set is the same register). - And recognize it. - If the recognition failed, this is very bad, return NULL (This will abort - the entire optimization). - Otherwise, return the generated instruction. */ - -static rtx -see_gen_normalized_extension (rtx reg, enum entry_type extension_code, - enum machine_mode mode) -{ - rtx subreg, insn; - rtx extension = NULL; - - if (!reg - || !REG_P (reg) - || (extension_code != SIGN_EXTENDED_DEF - && extension_code != ZERO_EXTENDED_DEF)) - return NULL; - - subreg = gen_lowpart_SUBREG (mode, reg); - if (extension_code == SIGN_EXTENDED_DEF) - extension = gen_rtx_SIGN_EXTEND (GET_MODE (reg), subreg); - else - extension = gen_rtx_ZERO_EXTEND (GET_MODE (reg), subreg); - - start_sequence (); - emit_insn (gen_rtx_SET (VOIDmode, reg, extension)); - insn = get_insns (); - end_sequence (); - - if (insn_invalid_p (insn)) - /* Recognition failed, this is very bad for this optimization. - Abort the optimization. */ - return NULL; - return insn; -} - -/* Hashes and splay_trees related functions implementation. */ - -/* Helper functions for the pre_extension hash. - This kind of hash will hold see_pre_extension_expr structures. - - The key is the right hand side of the se_insn field. - Note that the se_insn is an expression that looks like: - - set ((reg:WIDEmode r1) (sign_extend:WIDEmode - (subreg:NARROWmode (reg:WIDEmode r2)))) */ - -/* Return TRUE if P1 has the same value in its rhs as P2. - Otherwise, return FALSE. - P1 and P2 are see_pre_extension_expr structures. */ - -static int -eq_descriptor_pre_extension (const void *p1, const void *p2) -{ - const struct see_pre_extension_expr *const extension1 = - (const struct see_pre_extension_expr *) p1; - const struct see_pre_extension_expr *const extension2 = - (const struct see_pre_extension_expr *) p2; - rtx set1 = single_set (extension1->se_insn); - rtx set2 = single_set (extension2->se_insn); - rtx rhs1, rhs2; - - gcc_assert (set1 && set2); - rhs1 = SET_SRC (set1); - rhs2 = SET_SRC (set2); - - return rtx_equal_p (rhs1, rhs2); -} - - -/* P is a see_pre_extension_expr struct, use the RHS of the se_insn field. - Note that the RHS is an expression that looks like this: - (sign_extend:WIDEmode (subreg:NARROWmode (reg:WIDEmode r))) */ - -static hashval_t -hash_descriptor_pre_extension (const void *p) -{ - const struct see_pre_extension_expr *const extension = - (const struct see_pre_extension_expr *) p; - rtx set = single_set (extension->se_insn); - rtx rhs; - - gcc_assert (set); - rhs = SET_SRC (set); - - return hash_rtx (rhs, GET_MODE (rhs), 0, NULL, 0); -} - - -/* Free the allocated memory of the current see_pre_extension_expr struct. - - It frees the two linked list of the occurrences structures. */ - -static void -hash_del_pre_extension (void *p) -{ - struct see_pre_extension_expr *const extension = - (struct see_pre_extension_expr *) p; - struct see_occr *curr_occr = extension->antic_occr; - struct see_occr *next_occr = NULL; - - /* Free the linked list of the anticipatable occurrences. */ - while (curr_occr) - { - next_occr = curr_occr->next; - free (curr_occr); - curr_occr = next_occr; - } - - /* Free the linked list of the available occurrences. */ - curr_occr = extension->avail_occr; - while (curr_occr) - { - next_occr = curr_occr->next; - free (curr_occr); - curr_occr = next_occr; - } - - /* Free the see_pre_extension_expr structure itself. */ - free (extension); -} - - -/* Helper functions for the register_properties hash. - This kind of hash will hold see_register_properties structures. - - The value of the key is the regno field of the structure. */ - -/* Return TRUE if P1 has the same value in the regno field as P2. - Otherwise, return FALSE. - Where P1 and P2 are see_register_properties structures. */ - -static int -eq_descriptor_properties (const void *p1, const void *p2) -{ - const struct see_register_properties *const curr_prop1 = - (const struct see_register_properties *) p1; - const struct see_register_properties *const curr_prop2 = - (const struct see_register_properties *) p2; - - return curr_prop1->regno == curr_prop2->regno; -} - - -/* P is a see_register_properties struct, use the register number in the - regno field. */ - -static hashval_t -hash_descriptor_properties (const void *p) -{ - const struct see_register_properties *const curr_prop = - (const struct see_register_properties *) p; - return curr_prop->regno; -} - - -/* Free the allocated memory of the current see_register_properties struct. */ -static void -hash_del_properties (void *p) -{ - struct see_register_properties *const curr_prop = - (struct see_register_properties *) p; - free (curr_prop); -} - - -/* Helper functions for an extension hash. - This kind of hash will hold insns that look like: - - set ((reg:WIDEmode r1) (sign_extend:WIDEmode - (subreg:NARROWmode (reg:WIDEmode r2)))) - or - set ((reg:WIDEmode r1) (sign_extend:WIDEmode (reg:NARROWmode r2))) - - The value of the key is (REGNO (reg:WIDEmode r1)) - It is possible to search this hash in two ways: - 1. By a register rtx. The Value that is been compared to the keys is the - REGNO of it. - 2. By an insn with the above pattern. The Value that is been compared to - the keys is the REGNO of the reg on the lhs. */ - -/* Return TRUE if P1 has the same value as P2. Otherwise, return FALSE. - Where P1 is an insn and P2 is an insn or a register. */ - -static int -eq_descriptor_extension (const void *p1, const void *p2) -{ - const_rtx const insn = (const_rtx) p1; - const_rtx const element = (const_rtx) p2; - rtx set1 = single_set (insn); - rtx dest_reg1; - rtx set2 = NULL; - const_rtx dest_reg2 = NULL; - - gcc_assert (set1 && element && (REG_P (element) || INSN_P (element))); - - dest_reg1 = SET_DEST (set1); - - if (INSN_P (element)) - { - set2 = single_set (element); - dest_reg2 = SET_DEST (set2); - } - else - dest_reg2 = element; - - return REGNO (dest_reg1) == REGNO (dest_reg2); -} - - -/* If P is an insn, use the register number of its lhs - otherwise, P is a register, use its number. */ - -static hashval_t -hash_descriptor_extension (const void *p) -{ - const_rtx const r = (const_rtx) p; - rtx set, lhs; - - if (r && REG_P (r)) - return REGNO (r); - - gcc_assert (r && INSN_P (r)); - set = single_set (r); - gcc_assert (set); - lhs = SET_DEST (set); - return REGNO (lhs); -} - - -/* Helper function for a see_bb_splay_ar[i] splay tree. - It frees all the allocated memory of a struct see_ref_s pointer. - - VALUE is the value of a splay tree node. */ - -static void -see_free_ref_s (splay_tree_value value) -{ - struct see_ref_s *ref_s = (struct see_ref_s *)value; - - if (ref_s->unmerged_def_se_hash) - htab_delete (ref_s->unmerged_def_se_hash); - if (ref_s->merged_def_se_hash) - htab_delete (ref_s->merged_def_se_hash); - if (ref_s->use_se_hash) - htab_delete (ref_s->use_se_hash); - free (ref_s); -} - - -/* Rest of the implementation. */ - -/* Search the extension hash for a suitable entry for EXTENSION. - TYPE is the type of EXTENSION (USE_EXTENSION or DEF_EXTENSION). - - If TYPE is DEF_EXTENSION we need to normalize EXTENSION before searching the - extension hash. - - If a suitable entry was found, return the slot. Otherwise, store EXTENSION - in the hash and return NULL. */ - -static struct see_pre_extension_expr * -see_seek_pre_extension_expr (rtx extension, enum extension_type type) -{ - struct see_pre_extension_expr **slot_pre_exp, temp_pre_exp; - rtx dest_extension_reg = see_get_extension_reg (extension, 1); - enum entry_type extension_code; - enum machine_mode source_extension_mode; - - if (type == DEF_EXTENSION) - { - extension_code = see_get_extension_data (extension, - &source_extension_mode); - gcc_assert (extension_code != NOT_RELEVANT); - extension = - see_gen_normalized_extension (dest_extension_reg, extension_code, - source_extension_mode); - } - temp_pre_exp.se_insn = extension; - slot_pre_exp = - (struct see_pre_extension_expr **) htab_find_slot (see_pre_extension_hash, - &temp_pre_exp, INSERT); - if (*slot_pre_exp == NULL) - /* This is the first time this extension instruction is encountered. Store - it in the hash. */ - { - (*slot_pre_exp) = XNEW (struct see_pre_extension_expr); - (*slot_pre_exp)->se_insn = extension; - (*slot_pre_exp)->bitmap_index = - (htab_elements (see_pre_extension_hash) - 1); - (*slot_pre_exp)->antic_occr = NULL; - (*slot_pre_exp)->avail_occr = NULL; - return NULL; - } - return *slot_pre_exp; -} - - -/* This function defines how to update the extra_info of the web_entry. - - FIRST is the pointer of the extra_info of the first web_entry. - SECOND is the pointer of the extra_info of the second web_entry. - The first web_entry will be the predecessor (leader) of the second web_entry - after the union. - - Return true if FIRST and SECOND points to the same web entry structure and - nothing is done. Otherwise, return false. */ - -static bool -see_update_leader_extra_info (struct web_entry *first, struct web_entry *second) -{ - struct see_entry_extra_info *first_ei, *second_ei; - - first = unionfind_root (first); - second = unionfind_root (second); - - if (unionfind_union (first, second)) - return true; - - first_ei = (struct see_entry_extra_info *) first->extra_info; - second_ei = (struct see_entry_extra_info *) second->extra_info; - - gcc_assert (first_ei && second_ei); - - if (second_ei->relevancy == NOT_RELEVANT) - { - first_ei->relevancy = NOT_RELEVANT; - return false; - } - switch (first_ei->relevancy) - { - case NOT_RELEVANT: - break; - case RELEVANT_USE: - switch (second_ei->relevancy) - { - case RELEVANT_USE: - break; - case EXTENDED_DEF: - first_ei->relevancy = second_ei->relevancy; - first_ei->source_mode_signed = second_ei->source_mode_signed; - first_ei->source_mode_unsigned = second_ei->source_mode_unsigned; - break; - case SIGN_EXTENDED_DEF: - case ZERO_EXTENDED_DEF: - first_ei->relevancy = second_ei->relevancy; - first_ei->source_mode = second_ei->source_mode; - break; - default: - gcc_unreachable (); - } - break; - case SIGN_EXTENDED_DEF: - switch (second_ei->relevancy) - { - case SIGN_EXTENDED_DEF: - /* The mode of the root should be the wider one in this case. */ - first_ei->source_mode = - (first_ei->source_mode > second_ei->source_mode) ? - first_ei->source_mode : second_ei->source_mode; - break; - case RELEVANT_USE: - break; - case ZERO_EXTENDED_DEF: - /* Don't mix webs with zero extend and sign extend. */ - first_ei->relevancy = NOT_RELEVANT; - break; - case EXTENDED_DEF: - if (second_ei->source_mode_signed == MAX_MACHINE_MODE) - first_ei->relevancy = NOT_RELEVANT; - else - /* The mode of the root should be the wider one in this case. */ - first_ei->source_mode = - (first_ei->source_mode > second_ei->source_mode_signed) ? - first_ei->source_mode : second_ei->source_mode_signed; - break; - default: - gcc_unreachable (); - } - break; - /* This case is similar to the previous one, with little changes. */ - case ZERO_EXTENDED_DEF: - switch (second_ei->relevancy) - { - case SIGN_EXTENDED_DEF: - /* Don't mix webs with zero extend and sign extend. */ - first_ei->relevancy = NOT_RELEVANT; - break; - case RELEVANT_USE: - break; - case ZERO_EXTENDED_DEF: - /* The mode of the root should be the wider one in this case. */ - first_ei->source_mode = - (first_ei->source_mode > second_ei->source_mode) ? - first_ei->source_mode : second_ei->source_mode; - break; - case EXTENDED_DEF: - if (second_ei->source_mode_unsigned == MAX_MACHINE_MODE) - first_ei->relevancy = NOT_RELEVANT; - else - /* The mode of the root should be the wider one in this case. */ - first_ei->source_mode = - (first_ei->source_mode > second_ei->source_mode_unsigned) ? - first_ei->source_mode : second_ei->source_mode_unsigned; - break; - default: - gcc_unreachable (); - } - break; - case EXTENDED_DEF: - if (first_ei->source_mode_signed != MAX_MACHINE_MODE - && first_ei->source_mode_unsigned != MAX_MACHINE_MODE) - { - switch (second_ei->relevancy) - { - case SIGN_EXTENDED_DEF: - first_ei->relevancy = SIGN_EXTENDED_DEF; - first_ei->source_mode = - (first_ei->source_mode_signed > second_ei->source_mode) ? - first_ei->source_mode_signed : second_ei->source_mode; - break; - case RELEVANT_USE: - break; - case ZERO_EXTENDED_DEF: - first_ei->relevancy = ZERO_EXTENDED_DEF; - first_ei->source_mode = - (first_ei->source_mode_unsigned > second_ei->source_mode) ? - first_ei->source_mode_unsigned : second_ei->source_mode; - break; - case EXTENDED_DEF: - if (second_ei->source_mode_unsigned != MAX_MACHINE_MODE) - first_ei->source_mode_unsigned = - (first_ei->source_mode_unsigned > - second_ei->source_mode_unsigned) ? - first_ei->source_mode_unsigned : - second_ei->source_mode_unsigned; - if (second_ei->source_mode_signed != MAX_MACHINE_MODE) - first_ei->source_mode_signed = - (first_ei->source_mode_signed > - second_ei->source_mode_signed) ? - first_ei->source_mode_signed : second_ei->source_mode_signed; - break; - default: - gcc_unreachable (); - } - } - else if (first_ei->source_mode_signed == MAX_MACHINE_MODE) - { - gcc_assert (first_ei->source_mode_unsigned != MAX_MACHINE_MODE); - switch (second_ei->relevancy) - { - case SIGN_EXTENDED_DEF: - first_ei->relevancy = NOT_RELEVANT; - break; - case RELEVANT_USE: - break; - case ZERO_EXTENDED_DEF: - first_ei->relevancy = ZERO_EXTENDED_DEF; - first_ei->source_mode = - (first_ei->source_mode_unsigned > second_ei->source_mode) ? - first_ei->source_mode_unsigned : second_ei->source_mode; - break; - case EXTENDED_DEF: - if (second_ei->source_mode_unsigned == MAX_MACHINE_MODE) - first_ei->relevancy = NOT_RELEVANT; - else - first_ei->source_mode_unsigned = - (first_ei->source_mode_unsigned > - second_ei->source_mode_unsigned) ? - first_ei->source_mode_unsigned : - second_ei->source_mode_unsigned; - break; - default: - gcc_unreachable (); - } - } - else - { - gcc_assert (first_ei->source_mode_unsigned == MAX_MACHINE_MODE); - gcc_assert (first_ei->source_mode_signed != MAX_MACHINE_MODE); - switch (second_ei->relevancy) - { - case SIGN_EXTENDED_DEF: - first_ei->relevancy = SIGN_EXTENDED_DEF; - first_ei->source_mode = - (first_ei->source_mode_signed > second_ei->source_mode) ? - first_ei->source_mode_signed : second_ei->source_mode; - break; - case RELEVANT_USE: - break; - case ZERO_EXTENDED_DEF: - first_ei->relevancy = NOT_RELEVANT; - break; - case EXTENDED_DEF: - if (second_ei->source_mode_signed == MAX_MACHINE_MODE) - first_ei->relevancy = NOT_RELEVANT; - else - first_ei->source_mode_signed = - (first_ei->source_mode_signed > - second_ei->source_mode_signed) ? - first_ei->source_mode_signed : second_ei->source_mode_signed; - break; - default: - gcc_unreachable (); - } - } - break; - default: - /* Unknown pattern type. */ - gcc_unreachable (); - } - - return false; -} - - -/* Free global data structures. */ - -static void -see_free_data_structures (void) -{ - int i; - unsigned int j; - - /* Free the bitmap vectors. */ - if (transp) - { - sbitmap_vector_free (transp); - transp = NULL; - sbitmap_vector_free (comp); - comp = NULL; - sbitmap_vector_free (antloc); - antloc = NULL; - sbitmap_vector_free (ae_kill); - ae_kill = NULL; - } - if (pre_insert_map) - { - sbitmap_vector_free (pre_insert_map); - pre_insert_map = NULL; - } - if (pre_delete_map) - { - sbitmap_vector_free (pre_delete_map); - pre_delete_map = NULL; - } - if (edge_list) - { - free_edge_list (edge_list); - edge_list = NULL; - } - - /* Free the extension hash. */ - htab_delete (see_pre_extension_hash); - - /* Free the array of hashes. */ - for (i = 0; i < last_bb; i++) - if (see_bb_hash_ar[i]) - htab_delete (see_bb_hash_ar[i]); - free (see_bb_hash_ar); - - /* Free the array of splay trees. */ - for (i = 0; i < last_bb; i++) - if (see_bb_splay_ar[i]) - splay_tree_delete (see_bb_splay_ar[i]); - free (see_bb_splay_ar); - - /* Free the array of web entries and their extra info field. */ - for (j = 0; j < defs_num; j++) - free (def_entry[j].extra_info); - free (def_entry); - for (j = 0; j < uses_num; j++) - free (use_entry[j].extra_info); - free (use_entry); -} - - -/* Initialize global data structures and variables. */ - -static void -see_initialize_data_structures (void) -{ - unsigned int max_reg = max_reg_num (); - unsigned int i; - - /* Build the df object. */ - df_set_flags (DF_EQ_NOTES); - df_chain_add_problem (DF_DU_CHAIN + DF_UD_CHAIN); - df_analyze (); - df_set_flags (DF_DEFER_INSN_RESCAN); - - if (dump_file) - df_dump (dump_file); - - /* Record the last basic block at the beginning of the optimization. */ - last_bb = last_basic_block; - - /* Record the number of uses and defs at the beginning of the optimization. */ - uses_num = 0; - defs_num = 0; - for (i = 0; i < max_reg; i++) - { - uses_num += DF_REG_USE_COUNT (i) + DF_REG_EQ_USE_COUNT (i); - defs_num += DF_REG_DEF_COUNT (i); - } - - /* Allocate web entries array for the union-find data structure. */ - def_entry = XCNEWVEC (struct web_entry, defs_num); - use_entry = XCNEWVEC (struct web_entry, uses_num); - - /* Allocate an array of splay trees. - One splay tree for each basic block. */ - see_bb_splay_ar = XCNEWVEC (splay_tree, last_bb); - - /* Allocate an array of hashes. - One hash for each basic block. */ - see_bb_hash_ar = XCNEWVEC (htab_t, last_bb); - - /* Allocate the extension hash. It will hold the extensions that we want - to PRE. */ - see_pre_extension_hash = htab_create (10, - hash_descriptor_pre_extension, - eq_descriptor_pre_extension, - hash_del_pre_extension); -} - - -/* Function called by note_uses to check if a register is used in a - subexpressions. - - X is a pointer to the subexpression and DATA is a pointer to a - see_mentioned_reg_data structure that contains the register to look for and - a place for the result. */ - -static void -see_mentioned_reg (rtx *x, void *data) -{ - struct see_mentioned_reg_data *d - = (struct see_mentioned_reg_data *) data; - - if (reg_mentioned_p (d->reg, *x)) - d->mentioned = true; -} - - -/* We don't want to merge a use extension with a reference if the extended - register is used only in a simple move instruction. We also don't want to - merge a def extension with a reference if the source register of the - extension is defined only in a simple move in the reference. - - REF is the reference instruction. - EXTENSION is the use extension or def extension instruction. - TYPE is the type of the extension (use or def). - - Return true if the reference is complicated enough, so we would like to merge - it with the extension. Otherwise, return false. */ - -static bool -see_want_to_be_merged_with_extension (rtx ref, rtx extension, - enum extension_type type) -{ - rtx pat; - rtx dest_extension_reg = see_get_extension_reg (extension, 1); - rtx source_extension_reg = see_get_extension_reg (extension, 0); - enum rtx_code code; - struct see_mentioned_reg_data d; - int i; - - pat = PATTERN (ref); - code = GET_CODE (pat); - - if (code == PARALLEL) - { - for (i = 0; i < XVECLEN (pat, 0); i++) - { - rtx sub = XVECEXP (pat, 0, i); - - if (GET_CODE (sub) == SET - && (REG_P (SET_DEST (sub)) - || (GET_CODE (SET_DEST (sub)) == SUBREG - && REG_P (SUBREG_REG (SET_DEST (sub))))) - && (REG_P (SET_SRC (sub)) - || (GET_CODE (SET_SRC (sub)) == SUBREG - && REG_P (SUBREG_REG (SET_SRC (sub)))))) - { - /* This is a simple move SET. */ - if (type == DEF_EXTENSION - && reg_mentioned_p (source_extension_reg, SET_DEST (sub))) - return false; - } - else - { - /* This is not a simple move SET. - Check if it uses the source of the extension. */ - if (type == USE_EXTENSION) - { - d.reg = dest_extension_reg; - d.mentioned = false; - note_uses (&sub, see_mentioned_reg, &d); - if (d.mentioned) - return true; - } - } - } - if (type == USE_EXTENSION) - return false; - } - else - { - if (code == SET - && (REG_P (SET_DEST (pat)) - || (GET_CODE (SET_DEST (pat)) == SUBREG - && REG_P (SUBREG_REG (SET_DEST (pat))))) - && (REG_P (SET_SRC (pat)) - || (GET_CODE (SET_SRC (pat)) == SUBREG - && REG_P (SUBREG_REG (SET_SRC (pat)))))) - /* This is a simple move SET. */ - return false; - } - - return true; -} - - -/* Print the register number of the current see_register_properties - structure. - - This is a subroutine of see_main called via htab_traverse. - SLOT contains the current see_register_properties structure pointer. */ - -static int -see_print_register_properties (void **slot, void *b ATTRIBUTE_UNUSED) -{ - const struct see_register_properties *const prop = - (const struct see_register_properties *) *slot; - - gcc_assert (prop); - fprintf (dump_file, "Property found for register %d\n", prop->regno); - return 1; -} - - -/* Print the extension instruction of the current see_register_properties - structure. - - This is a subroutine of see_main called via htab_traverse. - SLOT contains the current see_pre_extension_expr structure pointer. */ - -static int -see_print_pre_extension_expr (void **slot, void *b ATTRIBUTE_UNUSED) -{ - const struct see_pre_extension_expr *const pre_extension = - (const struct see_pre_extension_expr *) *slot; - - gcc_assert (pre_extension - && pre_extension->se_insn - && INSN_P (pre_extension->se_insn)); - - fprintf (dump_file, "Index %d for:\n", pre_extension->bitmap_index); - print_rtl_single (dump_file, pre_extension->se_insn); - - return 1; -} - - -/* Phase 4 implementation: Commit changes to the insn stream. */ - -/* Delete the merged def extension. - - This is a subroutine of see_commit_ref_changes called via htab_traverse. - - SLOT contains the current def extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_delete_merged_def_extension (void **slot, void *b ATTRIBUTE_UNUSED) -{ - rtx def_se = (rtx) *slot; - - if (dump_file) - { - fprintf (dump_file, "Deleting merged def extension:\n"); - print_rtl_single (dump_file, def_se); - } - - if (INSN_DELETED_P (def_se)) - /* This def extension is an implicit one. No need to delete it since - it is not in the insn stream. */ - return 1; - - delete_insn (def_se); - return 1; -} - - -/* Delete the unmerged def extension. - - This is a subroutine of see_commit_ref_changes called via htab_traverse. - - SLOT contains the current def extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_delete_unmerged_def_extension (void **slot, void *b ATTRIBUTE_UNUSED) -{ - rtx def_se = (rtx) *slot; - - if (dump_file) - { - fprintf (dump_file, "Deleting unmerged def extension:\n"); - print_rtl_single (dump_file, def_se); - } - - delete_insn (def_se); - return 1; -} - - -/* Emit the non-redundant use extension to the instruction stream. - - This is a subroutine of see_commit_ref_changes called via htab_traverse. - - SLOT contains the current use extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_emit_use_extension (void **slot, void *b) -{ - rtx use_se = (rtx) *slot; - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - - if (INSN_DELETED_P (use_se)) - /* This use extension was previously removed according to the lcm - output. */ - return 1; - - if (dump_file) - { - fprintf (dump_file, "Inserting use extension:\n"); - print_rtl_single (dump_file, use_se); - } - - add_insn_before (use_se, curr_ref_s->insn, NULL); - - return 1; -} - - -/* For each relevant reference: - a. Emit the non-redundant use extensions. - b. Delete the def extensions. - c. Replace the original reference with the merged one (if exists) and add the - move instructions that were generated. - - This is a subroutine of see_commit_changes called via splay_tree_foreach. - - STN is the current node in the see_bb_splay_ar[i] splay tree. It holds a - see_ref_s structure. */ - -static int -see_commit_ref_changes (splay_tree_node stn, - void *data ATTRIBUTE_UNUSED) -{ - htab_t use_se_hash = ((struct see_ref_s *) (stn->value))->use_se_hash; - htab_t unmerged_def_se_hash = - ((struct see_ref_s *) (stn->value))->unmerged_def_se_hash; - htab_t merged_def_se_hash = - ((struct see_ref_s *) (stn->value))->merged_def_se_hash; - rtx ref = ((struct see_ref_s *) (stn->value))->insn; - rtx merged_ref = ((struct see_ref_s *) (stn->value))->merged_insn; - - /* Emit the non-redundant use extensions. */ - if (use_se_hash) - htab_traverse_noresize (use_se_hash, see_emit_use_extension, - (PTR) (stn->value)); - - /* Delete the def extensions. */ - if (unmerged_def_se_hash) - htab_traverse (unmerged_def_se_hash, see_delete_unmerged_def_extension, - (PTR) (stn->value)); - - if (merged_def_se_hash) - htab_traverse (merged_def_se_hash, see_delete_merged_def_extension, - (PTR) (stn->value)); - - /* Replace the original reference with the merged one (if exists) and add the - move instructions that were generated. */ - if (merged_ref && !INSN_DELETED_P (ref)) - { - if (dump_file) - { - fprintf (dump_file, "Replacing orig reference:\n"); - print_rtl_single (dump_file, ref); - fprintf (dump_file, "With merged reference:\n"); - print_rtl_single (dump_file, merged_ref); - } - emit_insn_after (merged_ref, ref); - delete_insn (ref); - } - - /* Continue to the next reference. */ - return 0; -} - - -/* Insert partially redundant expressions on edges to make the expressions fully - redundant. - - INDEX_MAP is a mapping of an index to an expression. - Return true if an instruction was inserted on an edge. - Otherwise, return false. */ - -static bool -see_pre_insert_extensions (struct see_pre_extension_expr **index_map) -{ - int num_edges = NUM_EDGES (edge_list); - int set_size = pre_insert_map[0]->size; - size_t pre_extension_num = htab_elements (see_pre_extension_hash); - - int did_insert = 0; - int e; - int i; - int j; - - for (e = 0; e < num_edges; e++) - { - int indx; - basic_block bb = INDEX_EDGE_PRED_BB (edge_list, e); - - for (i = indx = 0; i < set_size; i++, indx += SBITMAP_ELT_BITS) - { - SBITMAP_ELT_TYPE insert = pre_insert_map[e]->elms[i]; - - for (j = indx; insert && j < (int) pre_extension_num; - j++, insert >>= 1) - if (insert & 1) - { - struct see_pre_extension_expr *expr = index_map[j]; - int idx = expr->bitmap_index; - rtx se_insn = NULL; - edge eg = INDEX_EDGE (edge_list, e); - - start_sequence (); - emit_insn (copy_insn (PATTERN (expr->se_insn))); - se_insn = get_insns (); - end_sequence (); - - if (eg->flags & EDGE_ABNORMAL) - { - rtx new_insn = NULL; - - new_insn = insert_insn_end_bb_new (se_insn, bb); - gcc_assert (new_insn && INSN_P (new_insn)); - - if (dump_file) - { - fprintf (dump_file, - "PRE: end of bb %d, insn %d, ", - bb->index, INSN_UID (new_insn)); - fprintf (dump_file, - "inserting expression %d\n", idx); - } - } - else - { - insert_insn_on_edge (se_insn, eg); - - if (dump_file) - { - fprintf (dump_file, "PRE: edge (%d,%d), ", - bb->index, - INDEX_EDGE_SUCC_BB (edge_list, e)->index); - fprintf (dump_file, "inserting expression %d\n", idx); - } - } - did_insert = true; - } - } - } - return did_insert; -} - - -/* Since all the redundant extensions must be anticipatable, they must be a use - extensions. Mark them as deleted. This will prevent them from been emitted - in the first place. - - This is a subroutine of see_commit_changes called via htab_traverse. - - SLOT contains the current see_pre_extension_expr structure pointer. */ - -static int -see_pre_delete_extension (void **slot, void *b ATTRIBUTE_UNUSED) -{ - struct see_pre_extension_expr *const expr = - (struct see_pre_extension_expr *) *slot; - struct see_occr *occr; - int indx = expr->bitmap_index; - - for (occr = expr->antic_occr; occr != NULL; occr = occr->next) - { - if (TEST_BIT (pre_delete_map[occr->block_num], indx)) - { - /* Mark as deleted. */ - INSN_DELETED_P (occr->insn) = 1; - if (dump_file) - { - fprintf (dump_file,"Redundant extension deleted:\n"); - print_rtl_single (dump_file, occr->insn); - } - } - } - return 1; -} - - -/* Create the index_map mapping of an index to an expression. - - This is a subroutine of see_commit_changes called via htab_traverse. - - SLOT contains the current see_pre_extension_expr structure pointer. - B a pointer to see_pre_extension_expr structure pointer. */ - -static int -see_map_extension (void **slot, void *b) -{ - struct see_pre_extension_expr *const expr = - (struct see_pre_extension_expr *) *slot; - struct see_pre_extension_expr **const index_map = - (struct see_pre_extension_expr **) b; - - index_map[expr->bitmap_index] = expr; - - return 1; -} - - -/* Phase 4 top level function. - In this phase we finally change the instruction stream. - Here we insert extensions at their best placements and delete the - redundant ones according to the output of the LCM. We also replace - some of the instructions according to phase 2 merges results. */ - -static void -see_commit_changes (void) -{ - struct see_pre_extension_expr **index_map; - size_t pre_extension_num = htab_elements (see_pre_extension_hash); - bool did_insert = false; - int i; - - index_map = XCNEWVEC (struct see_pre_extension_expr *, pre_extension_num); - - if (dump_file) - fprintf (dump_file, - "* Phase 4: Commit changes to the insn stream. *\n"); - - /* Produce a mapping of all the pre_extensions. */ - htab_traverse (see_pre_extension_hash, see_map_extension, (PTR) index_map); - - /* Delete redundant extension. This will prevent them from been emitted in - the first place. */ - htab_traverse (see_pre_extension_hash, see_pre_delete_extension, NULL); - - /* Insert extensions on edges, according to the LCM result. */ - did_insert = see_pre_insert_extensions (index_map); - - if (did_insert) - commit_edge_insertions (); - - /* Commit the rest of the changes. */ - for (i = 0; i < last_bb; i++) - { - if (see_bb_splay_ar[i]) - { - /* Traverse over all the references in the basic block in forward - order. */ - splay_tree_foreach (see_bb_splay_ar[i], - see_commit_ref_changes, NULL); - } - } - - free (index_map); -} - - -/* Phase 3 implementation: Eliminate globally redundant extensions. */ - -/* Analyze the properties of a merged def extension for the LCM and record avail - occurrences. - - This is a subroutine of see_analyze_ref_local_prop called - via htab_traverse. - - SLOT contains the current def extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_analyze_merged_def_local_prop (void **slot, void *b) -{ - rtx def_se = (rtx) *slot; - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - rtx ref = curr_ref_s->insn; - struct see_pre_extension_expr *extension_expr; - int indx; - int bb_num = BLOCK_NUM (ref); - htab_t curr_bb_hash; - struct see_register_properties *curr_prop, **slot_prop; - struct see_register_properties temp_prop; - rtx dest_extension_reg = see_get_extension_reg (def_se, 1); - struct see_occr *curr_occr = NULL; - struct see_occr *tmp_occr = NULL; - - extension_expr = see_seek_pre_extension_expr (def_se, DEF_EXTENSION); - /* The extension_expr must be found. */ - gcc_assert (extension_expr); - - curr_bb_hash = see_bb_hash_ar[bb_num]; - gcc_assert (curr_bb_hash); - temp_prop.regno = REGNO (dest_extension_reg); - slot_prop = - (struct see_register_properties **) htab_find_slot (curr_bb_hash, - &temp_prop, INSERT); - curr_prop = *slot_prop; - gcc_assert (curr_prop); - - indx = extension_expr->bitmap_index; - - /* Reset the transparency bit. */ - RESET_BIT (transp[bb_num], indx); - /* Reset the killed bit. */ - RESET_BIT (ae_kill[bb_num], indx); - - if (curr_prop->first_se_after_last_def == DF_INSN_LUID (ref)) - { - /* Set the available bit. */ - SET_BIT (comp[bb_num], indx); - /* Record the available occurrence. */ - curr_occr = XNEW (struct see_occr); - curr_occr->next = NULL; - curr_occr->insn = def_se; - curr_occr->block_num = bb_num; - tmp_occr = extension_expr->avail_occr; - if (!tmp_occr) - extension_expr->avail_occr = curr_occr; - else - { - while (tmp_occr->next) - tmp_occr = tmp_occr->next; - tmp_occr->next = curr_occr; - } - } - - return 1; -} - - -/* Analyze the properties of a unmerged def extension for the LCM. - - This is a subroutine of see_analyze_ref_local_prop called - via htab_traverse. - - SLOT contains the current def extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_analyze_unmerged_def_local_prop (void **slot, void *b) -{ - rtx def_se = (rtx) *slot; - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - rtx ref = curr_ref_s->insn; - struct see_pre_extension_expr *extension_expr; - int indx; - int bb_num = BLOCK_NUM (ref); - htab_t curr_bb_hash; - struct see_register_properties *curr_prop, **slot_prop; - struct see_register_properties temp_prop; - rtx dest_extension_reg = see_get_extension_reg (def_se, 1); - - extension_expr = see_seek_pre_extension_expr (def_se, DEF_EXTENSION); - /* The extension_expr must be found. */ - gcc_assert (extension_expr); - - curr_bb_hash = see_bb_hash_ar[bb_num]; - gcc_assert (curr_bb_hash); - temp_prop.regno = REGNO (dest_extension_reg); - slot_prop = - (struct see_register_properties **) htab_find_slot (curr_bb_hash, - &temp_prop, INSERT); - curr_prop = *slot_prop; - gcc_assert (curr_prop); - - indx = extension_expr->bitmap_index; - - /* Reset the transparency bit. */ - RESET_BIT (transp[bb_num], indx); - /* Set the killed bit. */ - SET_BIT (ae_kill[bb_num], indx); - - return 1; -} - - -/* Analyze the properties of a use extension for the LCM and record any and - avail occurrences. - - This is a subroutine of see_analyze_ref_local_prop called - via htab_traverse. - - SLOT contains the current use extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_analyze_use_local_prop (void **slot, void *b) -{ - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - rtx use_se = (rtx) *slot; - rtx ref = curr_ref_s->insn; - rtx dest_extension_reg = see_get_extension_reg (use_se, 1); - struct see_pre_extension_expr *extension_expr; - struct see_register_properties *curr_prop, **slot_prop; - struct see_register_properties temp_prop; - struct see_occr *curr_occr = NULL; - struct see_occr *tmp_occr = NULL; - htab_t curr_bb_hash; - int indx; - int bb_num = BLOCK_NUM (ref); - - extension_expr = see_seek_pre_extension_expr (use_se, USE_EXTENSION); - /* The extension_expr must be found. */ - gcc_assert (extension_expr); - - curr_bb_hash = see_bb_hash_ar[bb_num]; - gcc_assert (curr_bb_hash); - temp_prop.regno = REGNO (dest_extension_reg); - slot_prop = - (struct see_register_properties **) htab_find_slot (curr_bb_hash, - &temp_prop, INSERT); - curr_prop = *slot_prop; - gcc_assert (curr_prop); - - indx = extension_expr->bitmap_index; - - if (curr_prop->first_se_before_any_def == DF_INSN_LUID (ref)) - { - /* Set the anticipatable bit. */ - SET_BIT (antloc[bb_num], indx); - /* Record the anticipatable occurrence. */ - curr_occr = XNEW (struct see_occr); - curr_occr->next = NULL; - curr_occr->insn = use_se; - curr_occr->block_num = bb_num; - tmp_occr = extension_expr->antic_occr; - if (!tmp_occr) - extension_expr->antic_occr = curr_occr; - else - { - while (tmp_occr->next) - tmp_occr = tmp_occr->next; - tmp_occr->next = curr_occr; - } - if (curr_prop->last_def < 0) - { - /* Set the available bit. */ - SET_BIT (comp[bb_num], indx); - /* Record the available occurrence. */ - curr_occr = XNEW (struct see_occr); - curr_occr->next = NULL; - curr_occr->insn = use_se; - curr_occr->block_num = bb_num; - tmp_occr = extension_expr->avail_occr; - if (!tmp_occr) - extension_expr->avail_occr = curr_occr; - else - { - while (tmp_occr->next) - tmp_occr = tmp_occr->next; - tmp_occr->next = curr_occr; - } - } - /* Note: there is no need to reset the killed bit since it must be zero at - this point. */ - } - else if (curr_prop->first_se_after_last_def == DF_INSN_LUID (ref)) - { - /* Set the available bit. */ - SET_BIT (comp[bb_num], indx); - /* Reset the killed bit. */ - RESET_BIT (ae_kill[bb_num], indx); - /* Record the available occurrence. */ - curr_occr = XNEW (struct see_occr); - curr_occr->next = NULL; - curr_occr->insn = use_se; - curr_occr->block_num = bb_num; - tmp_occr = extension_expr->avail_occr; - if (!tmp_occr) - extension_expr->avail_occr = curr_occr; - else - { - while (tmp_occr->next) - tmp_occr = tmp_occr->next; - tmp_occr->next = curr_occr; - } - } - return 1; -} - - -/* Here we traverse over all the merged and unmerged extensions of the reference - and analyze their properties for the LCM. - - This is a subroutine of see_execute_LCM called via splay_tree_foreach. - - STN is the current node in the see_bb_splay_ar[i] splay tree. It holds a - see_ref_s structure. */ - -static int -see_analyze_ref_local_prop (splay_tree_node stn, - void *data ATTRIBUTE_UNUSED) -{ - htab_t use_se_hash = ((struct see_ref_s *) (stn->value))->use_se_hash; - htab_t unmerged_def_se_hash = - ((struct see_ref_s *) (stn->value))->unmerged_def_se_hash; - htab_t merged_def_se_hash = - ((struct see_ref_s *) (stn->value))->merged_def_se_hash; - - /* Analyze use extensions that were not merged with the reference. */ - if (use_se_hash) - htab_traverse_noresize (use_se_hash, see_analyze_use_local_prop, - (PTR) (stn->value)); - - /* Analyze def extensions that were not merged with the reference. */ - if (unmerged_def_se_hash) - htab_traverse (unmerged_def_se_hash, see_analyze_unmerged_def_local_prop, - (PTR) (stn->value)); - - /* Analyze def extensions that were merged with the reference. */ - if (merged_def_se_hash) - htab_traverse (merged_def_se_hash, see_analyze_merged_def_local_prop, - (PTR) (stn->value)); - - /* Continue to the next definition. */ - return 0; -} - - -/* Phase 3 top level function. - In this phase, we set the input bit vectors of the LCM according to data - gathered in phase 2. - Then we run the edge based LCM. */ - -static void -see_execute_LCM (void) -{ - size_t pre_extension_num = htab_elements (see_pre_extension_hash); - int i = 0; - - if (dump_file) - fprintf (dump_file, - "* Phase 3: Eliminate globally redundant extensions. *\n"); - - /* Initialize the global sbitmap vectors. */ - transp = sbitmap_vector_alloc (last_bb, pre_extension_num); - comp = sbitmap_vector_alloc (last_bb, pre_extension_num); - antloc = sbitmap_vector_alloc (last_bb, pre_extension_num); - ae_kill = sbitmap_vector_alloc (last_bb, pre_extension_num); - sbitmap_vector_ones (transp, last_bb); - sbitmap_vector_zero (comp, last_bb); - sbitmap_vector_zero (antloc, last_bb); - sbitmap_vector_zero (ae_kill, last_bb); - - /* Traverse over all the splay trees of the basic blocks. */ - for (i = 0; i < last_bb; i++) - { - if (see_bb_splay_ar[i]) - { - /* Traverse over all the references in the basic block in forward - order. */ - splay_tree_foreach (see_bb_splay_ar[i], - see_analyze_ref_local_prop, NULL); - } - } - - /* Add fake exit edges before running the lcm. */ - add_noreturn_fake_exit_edges (); - - /* Run the LCM. */ - edge_list = pre_edge_lcm (pre_extension_num, transp, comp, antloc, - ae_kill, &pre_insert_map, &pre_delete_map); - - /* Remove the fake edges. */ - remove_fake_exit_edges (); -} - - -/* Phase 2 implementation: Merge and eliminate locally redundant extensions. */ - -/* In this function we set the register properties for the register that is - defined and extended in the reference. - The properties are defined in see_register_properties structure which is - allocated per basic block and per register. - Later the extension is inserted into the see_pre_extension_hash for the next - phase of the optimization. - - This is a subroutine of see_handle_extensions_for_one_ref called - via htab_traverse. - - SLOT contains the current def extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_set_prop_merged_def (void **slot, void *b) -{ - rtx def_se = (rtx) *slot; - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - rtx insn = curr_ref_s->insn; - rtx dest_extension_reg = see_get_extension_reg (def_se, 1); - htab_t curr_bb_hash; - struct see_register_properties *curr_prop = NULL; - struct see_register_properties **slot_prop; - struct see_register_properties temp_prop; - int ref_luid = DF_INSN_LUID (insn); - - curr_bb_hash = see_bb_hash_ar[BLOCK_NUM (curr_ref_s->insn)]; - if (!curr_bb_hash) - { - /* The hash doesn't exist yet. Create it. */ - curr_bb_hash = htab_create (10, - hash_descriptor_properties, - eq_descriptor_properties, - hash_del_properties); - see_bb_hash_ar[BLOCK_NUM (curr_ref_s->insn)] = curr_bb_hash; - } - - /* Find the right register properties in the right basic block. */ - temp_prop.regno = REGNO (dest_extension_reg); - slot_prop = - (struct see_register_properties **) htab_find_slot (curr_bb_hash, - &temp_prop, INSERT); - - if (slot_prop && *slot_prop != NULL) - { - /* Property already exists. */ - curr_prop = *slot_prop; - gcc_assert (curr_prop->regno == REGNO (dest_extension_reg)); - - curr_prop->last_def = ref_luid; - curr_prop->first_se_after_last_def = ref_luid; - } - else - { - /* Property doesn't exist yet. */ - curr_prop = XNEW (struct see_register_properties); - curr_prop->regno = REGNO (dest_extension_reg); - curr_prop->last_def = ref_luid; - curr_prop->first_se_before_any_def = -1; - curr_prop->first_se_after_last_def = ref_luid; - *slot_prop = curr_prop; - } - - /* Insert the def_se into see_pre_extension_hash if it isn't already - there. */ - see_seek_pre_extension_expr (def_se, DEF_EXTENSION); - - return 1; -} - - -/* In this function we set the register properties for the register that is - defined but not extended in the reference. - The properties are defined in see_register_properties structure which is - allocated per basic block and per register. - Later the extension is inserted into the see_pre_extension_hash for the next - phase of the optimization. - - This is a subroutine of see_handle_extensions_for_one_ref called - via htab_traverse. - - SLOT contains the current def extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_set_prop_unmerged_def (void **slot, void *b) -{ - rtx def_se = (rtx) *slot; - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - rtx insn = curr_ref_s->insn; - rtx dest_extension_reg = see_get_extension_reg (def_se, 1); - htab_t curr_bb_hash; - struct see_register_properties *curr_prop = NULL; - struct see_register_properties **slot_prop; - struct see_register_properties temp_prop; - int ref_luid = DF_INSN_LUID (insn); - - curr_bb_hash = see_bb_hash_ar[BLOCK_NUM (curr_ref_s->insn)]; - if (!curr_bb_hash) - { - /* The hash doesn't exist yet. Create it. */ - curr_bb_hash = htab_create (10, - hash_descriptor_properties, - eq_descriptor_properties, - hash_del_properties); - see_bb_hash_ar[BLOCK_NUM (curr_ref_s->insn)] = curr_bb_hash; - } - - /* Find the right register properties in the right basic block. */ - temp_prop.regno = REGNO (dest_extension_reg); - slot_prop = - (struct see_register_properties **) htab_find_slot (curr_bb_hash, - &temp_prop, INSERT); - - if (slot_prop && *slot_prop != NULL) - { - /* Property already exists. */ - curr_prop = *slot_prop; - gcc_assert (curr_prop->regno == REGNO (dest_extension_reg)); - - curr_prop->last_def = ref_luid; - curr_prop->first_se_after_last_def = -1; - } - else - { - /* Property doesn't exist yet. */ - curr_prop = XNEW (struct see_register_properties); - curr_prop->regno = REGNO (dest_extension_reg); - curr_prop->last_def = ref_luid; - curr_prop->first_se_before_any_def = -1; - curr_prop->first_se_after_last_def = -1; - *slot_prop = curr_prop; - } - - /* Insert the def_se into see_pre_extension_hash if it isn't already - there. */ - see_seek_pre_extension_expr (def_se, DEF_EXTENSION); - - return 1; -} - - -/* In this function we set the register properties for the register that is used - in the reference. - The properties are defined in see_register_properties structure which is - allocated per basic block and per register. - When a redundant use extension is found it is removed from the hash of the - reference. - If the extension is non redundant it is inserted into the - see_pre_extension_hash for the next phase of the optimization. - - This is a subroutine of see_handle_extensions_for_one_ref called - via htab_traverse. - - SLOT contains the current use extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_set_prop_unmerged_use (void **slot, void *b) -{ - rtx use_se = (rtx) *slot; - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - rtx insn = curr_ref_s->insn; - rtx dest_extension_reg = see_get_extension_reg (use_se, 1); - htab_t curr_bb_hash; - struct see_register_properties *curr_prop = NULL; - struct see_register_properties **slot_prop; - struct see_register_properties temp_prop; - bool locally_redundant = false; - int ref_luid = DF_INSN_LUID (insn); - - curr_bb_hash = see_bb_hash_ar[BLOCK_NUM (curr_ref_s->insn)]; - if (!curr_bb_hash) - { - /* The hash doesn't exist yet. Create it. */ - curr_bb_hash = htab_create (10, - hash_descriptor_properties, - eq_descriptor_properties, - hash_del_properties); - see_bb_hash_ar[BLOCK_NUM (curr_ref_s->insn)] = curr_bb_hash; - } - - /* Find the right register properties in the right basic block. */ - temp_prop.regno = REGNO (dest_extension_reg); - slot_prop = - (struct see_register_properties **) htab_find_slot (curr_bb_hash, - &temp_prop, INSERT); - - if (slot_prop && *slot_prop != NULL) - { - /* Property already exists. */ - curr_prop = *slot_prop; - gcc_assert (curr_prop->regno == REGNO (dest_extension_reg)); - - - if (curr_prop->last_def < 0 && curr_prop->first_se_before_any_def < 0) - curr_prop->first_se_before_any_def = ref_luid; - else if (curr_prop->last_def < 0 - && curr_prop->first_se_before_any_def >= 0) - { - /* In this case the extension is locally redundant. */ - htab_clear_slot (curr_ref_s->use_se_hash, (PTR *)slot); - locally_redundant = true; - } - else if (curr_prop->last_def >= 0 - && curr_prop->first_se_after_last_def < 0) - curr_prop->first_se_after_last_def = ref_luid; - else if (curr_prop->last_def >= 0 - && curr_prop->first_se_after_last_def >= 0) - { - /* In this case the extension is locally redundant. */ - htab_clear_slot (curr_ref_s->use_se_hash, (PTR *)slot); - locally_redundant = true; - } - else - gcc_unreachable (); - } - else - { - /* Property doesn't exist yet. Create a new one. */ - curr_prop = XNEW (struct see_register_properties); - curr_prop->regno = REGNO (dest_extension_reg); - curr_prop->last_def = -1; - curr_prop->first_se_before_any_def = ref_luid; - curr_prop->first_se_after_last_def = -1; - *slot_prop = curr_prop; - } - - /* Insert the use_se into see_pre_extension_hash if it isn't already - there. */ - if (!locally_redundant) - see_seek_pre_extension_expr (use_se, USE_EXTENSION); - if (locally_redundant && dump_file) - { - fprintf (dump_file, "Locally redundant extension:\n"); - print_rtl_single (dump_file, use_se); - } - return 1; -} - - -/* Print an extension instruction. - - This is a subroutine of see_handle_extensions_for_one_ref called - via htab_traverse. - SLOT contains the extension instruction. */ - -static int -see_print_one_extension (void **slot, void *b ATTRIBUTE_UNUSED) -{ - rtx def_se = (rtx) *slot; - - gcc_assert (def_se && INSN_P (def_se)); - print_rtl_single (dump_file, def_se); - - return 1; -} - -/* Function called by note_uses to replace used subexpressions. - - X is a pointer to the subexpression and DATA is a pointer to a - see_replace_data structure that contains the data for the replacement. */ - -static void -see_replace_src (rtx *x, void *data) -{ - struct see_replace_data *d - = (struct see_replace_data *) data; - - *x = replace_rtx (*x, d->from, d->to); -} - - -static rtx -see_copy_insn (rtx insn) -{ - rtx pat = copy_insn (PATTERN (insn)), ret; - - if (NONJUMP_INSN_P (insn)) - ret = make_insn_raw (pat); - else if (JUMP_P (insn)) - ret = make_jump_insn_raw (pat); - else if (CALL_P (insn)) - { - start_sequence (); - ret = emit_call_insn (pat); - end_sequence (); - if (CALL_INSN_FUNCTION_USAGE (insn)) - CALL_INSN_FUNCTION_USAGE (ret) - = copy_rtx (CALL_INSN_FUNCTION_USAGE (insn)); - SIBLING_CALL_P (ret) = SIBLING_CALL_P (insn); - RTL_CONST_CALL_P (ret) = RTL_CONST_CALL_P (insn); - RTL_PURE_CALL_P (ret) = RTL_PURE_CALL_P (insn); - RTL_LOOPING_CONST_OR_PURE_CALL_P (ret) - = RTL_LOOPING_CONST_OR_PURE_CALL_P (insn); - } - else - gcc_unreachable (); - if (REG_NOTES (insn)) - REG_NOTES (ret) = copy_rtx (REG_NOTES (insn)); - INSN_LOCATOR (ret) = INSN_LOCATOR (insn); - RTX_FRAME_RELATED_P (ret) = RTX_FRAME_RELATED_P (insn); - PREV_INSN (ret) = NULL_RTX; - NEXT_INSN (ret) = NULL_RTX; - return ret; -} - - -/* At this point the pattern is expected to be: - - ref: set (dest_reg) (rhs) - def_se: set (dest_extension_reg) (sign/zero_extend (source_extension_reg)) - - The merge of these two instructions didn't succeed. - - We try to generate the pattern: - set (subreg (dest_extension_reg)) (rhs) - - We do this in 4 steps: - a. Replace every use of dest_reg with a new pseudo register. - b. Replace every instance of dest_reg with the subreg. - c. Replace every use of the new pseudo register back to dest_reg. - d. Try to recognize and simplify. - - If the manipulation failed, leave the original ref but try to generate and - recognize a simple move instruction: - set (subreg (dest_extension_reg)) (dest_reg) - This move instruction will be emitted right after the ref to the instruction - stream and assure the correctness of the code after def_se will be removed. - - CURR_REF_S is the current reference. - DEF_SE is the extension that couldn't be merged. */ - -static void -see_def_extension_not_merged (struct see_ref_s *curr_ref_s, rtx def_se) -{ - struct see_replace_data d; - /* If the original insn was already merged with an extension before, - take the merged one. */ - rtx ref = curr_ref_s->merged_insn - ? curr_ref_s->merged_insn : curr_ref_s->insn; - rtx merged_ref_next = curr_ref_s->merged_insn - ? NEXT_INSN (curr_ref_s->merged_insn) : NULL_RTX; - rtx ref_copy = see_copy_insn (ref); - rtx source_extension_reg = see_get_extension_reg (def_se, 0); - rtx dest_extension_reg = see_get_extension_reg (def_se, 1); - rtx set, rhs; - rtx dest_reg, dest_real_reg; - rtx new_pseudo_reg, subreg; - enum machine_mode source_extension_mode = GET_MODE (source_extension_reg); - enum machine_mode dest_mode; - - set = single_set (def_se); - gcc_assert (set); - rhs = SET_SRC (set); - gcc_assert (GET_CODE (rhs) == SIGN_EXTEND - || GET_CODE (rhs) == ZERO_EXTEND); - dest_reg = XEXP (rhs, 0); - gcc_assert (REG_P (dest_reg) - || (GET_CODE (dest_reg) == SUBREG - && REG_P (SUBREG_REG (dest_reg)))); - dest_real_reg = REG_P (dest_reg) ? dest_reg : SUBREG_REG (dest_reg); - dest_mode = GET_MODE (dest_reg); - - subreg = gen_lowpart_SUBREG (dest_mode, dest_extension_reg); - new_pseudo_reg = gen_reg_rtx (source_extension_mode); - - /* Step a: Replace every use of dest_real_reg with a new pseudo register. */ - d.from = dest_real_reg; - d.to = new_pseudo_reg; - note_uses (&PATTERN (ref_copy), see_replace_src, &d); - /* Step b: Replace every instance of dest_reg with the subreg. */ - ref_copy = replace_rtx (ref_copy, dest_reg, copy_rtx (subreg)); - - /* Step c: Replace every use of the new pseudo register back to - dest_real_reg. */ - d.from = new_pseudo_reg; - d.to = dest_real_reg; - note_uses (&PATTERN (ref_copy), see_replace_src, &d); - - if (rtx_equal_p (PATTERN (ref), PATTERN (ref_copy)) - || insn_invalid_p (ref_copy)) - { - /* The manipulation failed. */ - df_insn_delete (NULL, INSN_UID (ref_copy)); - - /* Create a new copy. */ - ref_copy = see_copy_insn (ref); - - if (curr_ref_s->merged_insn) - df_insn_delete (NULL, INSN_UID (curr_ref_s->merged_insn)); - - /* Create a simple move instruction that will replace the def_se. */ - start_sequence (); - emit_insn (ref_copy); - emit_move_insn (subreg, dest_reg); - if (merged_ref_next != NULL_RTX) - emit_insn (merged_ref_next); - curr_ref_s->merged_insn = get_insns (); - end_sequence (); - - if (dump_file) - { - fprintf (dump_file, "Following def merge failure a move "); - fprintf (dump_file, "insn was added after the ref.\n"); - fprintf (dump_file, "Original ref:\n"); - print_rtl_single (dump_file, ref); - fprintf (dump_file, "Move insn that was added:\n"); - print_rtl_single (dump_file, NEXT_INSN (curr_ref_s->merged_insn)); - } - return; - } - - /* The manipulation succeeded. Store the new manipulated reference. */ - - /* It is possible for dest_reg to appear multiple times in ref_copy. In this - case, ref_copy now has invalid sharing. Copying solves the problem. - We don't use copy_rtx as an optimization for the common case (no sharing). - We can't just use copy_rtx_if_shared since it does nothing on INSNs. - Another possible solution would be to make validate_replace_rtx_1 - public and use it instead of replace_rtx. */ - reset_used_flags (PATTERN (ref_copy)); - reset_used_flags (REG_NOTES (ref_copy)); - PATTERN (ref_copy) = copy_rtx_if_shared (PATTERN (ref_copy)); - REG_NOTES (ref_copy) = copy_rtx_if_shared (REG_NOTES (ref_copy)); - - /* Try to simplify the new manipulated insn. */ - validate_simplify_insn (ref_copy); - - if (curr_ref_s->merged_insn) - df_insn_delete (NULL, INSN_UID (curr_ref_s->merged_insn)); - - /* Create a simple move instruction to assure the correctness of the code. */ - start_sequence (); - emit_insn (ref_copy); - emit_move_insn (dest_reg, subreg); - if (merged_ref_next != NULL_RTX) - emit_insn (merged_ref_next); - curr_ref_s->merged_insn = get_insns (); - end_sequence (); - - if (dump_file) - { - fprintf (dump_file, "Following merge failure the ref was transformed!\n"); - fprintf (dump_file, "Original ref:\n"); - print_rtl_single (dump_file, ref); - fprintf (dump_file, "Transformed ref:\n"); - print_rtl_single (dump_file, curr_ref_s->merged_insn); - fprintf (dump_file, "Move insn that was added:\n"); - print_rtl_single (dump_file, NEXT_INSN (curr_ref_s->merged_insn)); - } -} - - -/* Merge the reference instruction (ref) with the current use extension. - - use_se extends a NARROWmode register to a WIDEmode register. - ref uses the WIDEmode register. - - The pattern we try to merge is this: - use_se: set (dest_extension_reg) (sign/zero_extend (source_extension_reg)) - ref: use (dest_extension_reg) - - where dest_extension_reg and source_extension_reg can be subregs. - - The merge is done by generating, simplifying and recognizing the pattern: - use (sign/zero_extend (source_extension_reg)) - - If ref is too simple (according to see_want_to_be_merged_with_extension ()) - we don't try to merge it with use_se and we continue as if the merge failed. - - This is a subroutine of see_handle_extensions_for_one_ref called - via htab_traverse. - SLOT contains the current use extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_merge_one_use_extension (void **slot, void *b) -{ - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - rtx use_se = (rtx) *slot; - rtx ref = curr_ref_s->merged_insn - ? curr_ref_s->merged_insn : curr_ref_s->insn; - rtx merged_ref_next = curr_ref_s->merged_insn - ? NEXT_INSN (curr_ref_s->merged_insn) : NULL_RTX; - rtx ref_copy = see_copy_insn (ref); - rtx extension_set = single_set (use_se); - rtx extension_rhs = NULL; - rtx dest_extension_reg = see_get_extension_reg (use_se, 1); - rtx note = NULL; - rtx simplified_note = NULL; - - gcc_assert (use_se && curr_ref_s && extension_set); - - extension_rhs = SET_SRC (extension_set); - - /* In REG_EQUIV and REG_EQUAL notes that mention the register we need to - replace the uses of the dest_extension_reg with the rhs of the extension - instruction. This is necessary since there might not be an extension in - the path between the definition and the note when this optimization is - over. */ - note = find_reg_equal_equiv_note (ref_copy); - if (note) - { - simplified_note = simplify_replace_rtx (XEXP (note, 0), - dest_extension_reg, - extension_rhs); - if (rtx_equal_p (XEXP (note, 0), simplified_note)) - /* Replacement failed. Remove the note. */ - remove_note (ref_copy, note); - else - set_unique_reg_note (ref_copy, REG_NOTE_KIND (note), - simplified_note); - } - - if (!see_want_to_be_merged_with_extension (ref, use_se, USE_EXTENSION)) - { - /* The use in the reference is too simple. Don't try to merge. */ - if (dump_file) - { - fprintf (dump_file, "Use merge skipped!\n"); - fprintf (dump_file, "Original instructions:\n"); - print_rtl_single (dump_file, use_se); - print_rtl_single (dump_file, ref); - } - df_insn_delete (NULL, INSN_UID (ref_copy)); - /* Don't remove the current use_se from the use_se_hash and continue to - the next extension. */ - return 1; - } - - validate_replace_src_group (dest_extension_reg, extension_rhs, ref_copy); - - if (!num_changes_pending ()) - /* In this case this is not a real use (the only use is/was in the notes - list). Remove the use extension from the hash. This will prevent it - from been emitted in the first place. */ - { - if (dump_file) - { - fprintf (dump_file, "Use extension not necessary before:\n"); - print_rtl_single (dump_file, ref); - } - htab_clear_slot (curr_ref_s->use_se_hash, (PTR *)slot); - - if (curr_ref_s->merged_insn) - df_insn_delete (NULL, INSN_UID (curr_ref_s->merged_insn)); - - if (merged_ref_next != NULL_RTX) - { - start_sequence (); - emit_insn (ref_copy); - emit_insn (merged_ref_next); - curr_ref_s->merged_insn = get_insns (); - end_sequence (); - } - else - curr_ref_s->merged_insn = ref_copy; - return 1; - } - - if (!apply_change_group ()) - { - /* The merge failed. */ - if (dump_file) - { - fprintf (dump_file, "Use merge failed!\n"); - fprintf (dump_file, "Original instructions:\n"); - print_rtl_single (dump_file, use_se); - print_rtl_single (dump_file, ref); - } - df_insn_delete (NULL, INSN_UID (ref_copy)); - /* Don't remove the current use_se from the use_se_hash and continue to - the next extension. */ - return 1; - } - - /* The merge succeeded! */ - - /* Try to simplify the new merged insn. */ - validate_simplify_insn (ref_copy); - - if (curr_ref_s->merged_insn) - df_insn_delete (NULL, INSN_UID (curr_ref_s->merged_insn)); - - if (merged_ref_next != NULL_RTX) - { - start_sequence (); - emit_insn (ref_copy); - emit_insn (merged_ref_next); - curr_ref_s->merged_insn = get_insns (); - end_sequence (); - } - else - curr_ref_s->merged_insn = ref_copy; - - if (dump_file) - { - fprintf (dump_file, "Use merge succeeded!\n"); - fprintf (dump_file, "Original instructions:\n"); - print_rtl_single (dump_file, use_se); - print_rtl_single (dump_file, ref); - fprintf (dump_file, "Merged instruction:\n"); - print_rtl_single (dump_file, curr_ref_s->merged_insn); - } - - /* Remove the current use_se from the use_se_hash. This will prevent it from - been emitted in the first place. */ - htab_clear_slot (curr_ref_s->use_se_hash, (PTR *)slot); - return 1; -} - - -/* Merge the reference instruction (ref) with the extension that follows it - in the same basic block (def_se). - ref sets a NARROWmode register and def_se extends it to WIDEmode register. - - The pattern we try to merge is this: - ref: set (dest_reg) (rhs) - def_se: set (dest_extension_reg) (sign/zero_extend (source_extension_reg)) - - where dest_reg and source_extension_reg can both be subregs (together) - and (REGNO (dest_reg) == REGNO (source_extension_reg)) - - The merge is done by generating, simplifying and recognizing the pattern: - set (dest_extension_reg) (sign/zero_extend (rhs)) - If ref is a parallel instruction we just replace the relevant set in it. - - If ref is too simple (according to see_want_to_be_merged_with_extension ()) - we don't try to merge it with def_se and we continue as if the merge failed. - - This is a subroutine of see_handle_extensions_for_one_ref called - via htab_traverse. - - SLOT contains the current def extension instruction. - B is the see_ref_s structure pointer. */ - -static int -see_merge_one_def_extension (void **slot, void *b) -{ - struct see_ref_s *curr_ref_s = (struct see_ref_s *) b; - rtx def_se = (rtx) *slot; - /* If the original insn was already merged with an extension before, - take the merged one. */ - rtx ref = curr_ref_s->merged_insn - ? curr_ref_s->merged_insn : curr_ref_s->insn; - rtx merged_ref_next = curr_ref_s->merged_insn - ? NEXT_INSN (curr_ref_s->merged_insn) : NULL_RTX; - rtx ref_copy = see_copy_insn (ref); - rtx new_set = NULL; - rtx source_extension_reg = see_get_extension_reg (def_se, 0); - rtx dest_extension_reg = see_get_extension_reg (def_se, 1); - rtx *rtx_slot, subreg; - rtx temp_extension = NULL; - rtx simplified_temp_extension = NULL; - rtx *pat; - enum rtx_code code; - enum entry_type extension_code; - enum machine_mode source_extension_mode; - enum machine_mode source_mode = VOIDmode; - enum machine_mode dest_extension_mode; - bool merge_success = false; - int i; - - gcc_assert (def_se - && INSN_P (def_se) - && curr_ref_s - && ref - && INSN_P (ref)); - - if (!see_want_to_be_merged_with_extension (ref, def_se, DEF_EXTENSION)) - { - /* The definition in the reference is too simple. Don't try to merge. */ - if (dump_file) - { - fprintf (dump_file, "Def merge skipped!\n"); - fprintf (dump_file, "Original instructions:\n"); - print_rtl_single (dump_file, ref); - print_rtl_single (dump_file, def_se); - } - - df_insn_delete (NULL, INSN_UID (ref_copy)); - see_def_extension_not_merged (curr_ref_s, def_se); - /* Continue to the next extension. */ - return 1; - } - - extension_code = see_get_extension_data (def_se, &source_mode); - - /* Try to merge and simplify the extension. */ - source_extension_mode = GET_MODE (source_extension_reg); - dest_extension_mode = GET_MODE (dest_extension_reg); - - pat = &PATTERN (ref_copy); - code = GET_CODE (*pat); - - if (code == PARALLEL) - { - bool need_to_apply_change = false; - - for (i = 0; i < XVECLEN (*pat, 0); i++) - { - rtx *sub = &XVECEXP (*pat, 0, i); - - if (GET_CODE (*sub) == SET - && GET_MODE (SET_SRC (*sub)) != VOIDmode - && GET_MODE (SET_DEST (*sub)) == source_mode - && ((REG_P (SET_DEST (*sub)) - && REGNO (SET_DEST (*sub)) == REGNO (source_extension_reg)) - || (GET_CODE (SET_DEST (*sub)) == SUBREG - && REG_P (SUBREG_REG (SET_DEST (*sub))) - && (REGNO (SUBREG_REG (SET_DEST (*sub))) == - REGNO (source_extension_reg))))) - { - rtx orig_src = SET_SRC (*sub); - - if (extension_code == SIGN_EXTENDED_DEF) - temp_extension = gen_rtx_SIGN_EXTEND (dest_extension_mode, - orig_src); - else - temp_extension = gen_rtx_ZERO_EXTEND (dest_extension_mode, - orig_src); - simplified_temp_extension = simplify_rtx (temp_extension); - temp_extension = - (simplified_temp_extension) ? simplified_temp_extension : - temp_extension; - new_set = gen_rtx_SET (VOIDmode, dest_extension_reg, - temp_extension); - validate_change (ref_copy, sub, new_set, 1); - need_to_apply_change = true; - } - } - if (need_to_apply_change) - if (apply_change_group ()) - merge_success = true; - } - else if (code == SET - && GET_MODE (SET_SRC (*pat)) != VOIDmode - && GET_MODE (SET_DEST (*pat)) == source_mode - && ((REG_P (SET_DEST (*pat)) - && REGNO (SET_DEST (*pat)) == REGNO (source_extension_reg)) - || (GET_CODE (SET_DEST (*pat)) == SUBREG - && REG_P (SUBREG_REG (SET_DEST (*pat))) - && (REGNO (SUBREG_REG (SET_DEST (*pat))) == - REGNO (source_extension_reg))))) - { - rtx orig_src = SET_SRC (*pat); - - if (extension_code == SIGN_EXTENDED_DEF) - temp_extension = gen_rtx_SIGN_EXTEND (dest_extension_mode, orig_src); - else - temp_extension = gen_rtx_ZERO_EXTEND (dest_extension_mode, orig_src); - simplified_temp_extension = simplify_rtx (temp_extension); - temp_extension = (simplified_temp_extension) ? simplified_temp_extension : - temp_extension; - new_set = gen_rtx_SET (VOIDmode, dest_extension_reg, temp_extension); - if (validate_change (ref_copy, pat, new_set, 0)) - merge_success = true; - } - if (!merge_success) - { - /* The merge failed. */ - if (dump_file) - { - fprintf (dump_file, "Def merge failed!\n"); - fprintf (dump_file, "Original instructions:\n"); - print_rtl_single (dump_file, ref); - print_rtl_single (dump_file, def_se); - } - - df_insn_delete (NULL, INSN_UID (ref_copy)); - see_def_extension_not_merged (curr_ref_s, def_se); - /* Continue to the next extension. */ - return 1; - } - - /* The merge succeeded! */ - if (curr_ref_s->merged_insn) - df_insn_delete (NULL, INSN_UID (curr_ref_s->merged_insn)); - - /* Create a simple move instruction to assure the correctness of the code. */ - subreg = gen_lowpart_SUBREG (source_extension_mode, dest_extension_reg); - start_sequence (); - emit_insn (ref_copy); - emit_move_insn (source_extension_reg, subreg); - if (merged_ref_next != NULL_RTX) - emit_insn (merged_ref_next); - curr_ref_s->merged_insn = get_insns (); - end_sequence (); - - if (dump_file) - { - fprintf (dump_file, "Def merge succeeded!\n"); - fprintf (dump_file, "Original instructions:\n"); - print_rtl_single (dump_file, ref); - print_rtl_single (dump_file, def_se); - fprintf (dump_file, "Merged instruction:\n"); - print_rtl_single (dump_file, curr_ref_s->merged_insn); - fprintf (dump_file, "Move instruction that was added:\n"); - print_rtl_single (dump_file, NEXT_INSN (curr_ref_s->merged_insn)); - } - - /* Remove the current def_se from the unmerged_def_se_hash and insert it to - the merged_def_se_hash. */ - htab_clear_slot (curr_ref_s->unmerged_def_se_hash, (PTR *)slot); - if (!curr_ref_s->merged_def_se_hash) - curr_ref_s->merged_def_se_hash = htab_create (10, - hash_descriptor_extension, - eq_descriptor_extension, - NULL); - rtx_slot = (rtx *) htab_find_slot (curr_ref_s->merged_def_se_hash, - dest_extension_reg, INSERT); - gcc_assert (*rtx_slot == NULL); - *rtx_slot = def_se; - - return 1; -} - - -/* Try to eliminate extensions in this order: - a. Try to merge only the def extensions, one by one. - b. Try to merge only the use extensions, one by one. - - TODO: - Try to merge any couple of use extensions simultaneously. - Try to merge any def extension with one or two uses extensions - simultaneously. - - After all the merges are done, update the register properties for the basic - block and eliminate locally redundant use extensions. - - This is a subroutine of see_merge_and_eliminate_extensions called - via splay_tree_foreach. - STN is the current node in the see_bb_splay_ar[i] splay tree. It holds a - see_ref_s structure. */ - -static int -see_handle_extensions_for_one_ref (splay_tree_node stn, - void *data ATTRIBUTE_UNUSED) -{ - htab_t use_se_hash = ((struct see_ref_s *) (stn->value))->use_se_hash; - htab_t unmerged_def_se_hash = - ((struct see_ref_s *) (stn->value))->unmerged_def_se_hash; - htab_t merged_def_se_hash; - rtx ref = ((struct see_ref_s *) (stn->value))->insn; - - if (dump_file) - { - fprintf (dump_file, "Handling ref:\n"); - print_rtl_single (dump_file, ref); - } - - /* a. Try to eliminate only def extensions, one by one. */ - if (unmerged_def_se_hash) - htab_traverse_noresize (unmerged_def_se_hash, see_merge_one_def_extension, - (PTR) (stn->value)); - - if (use_se_hash) - /* b. Try to eliminate only use extensions, one by one. */ - htab_traverse_noresize (use_se_hash, see_merge_one_use_extension, - (PTR) (stn->value)); - - merged_def_se_hash = ((struct see_ref_s *) (stn->value))->merged_def_se_hash; - - if (dump_file) - { - fprintf (dump_file, "The hashes of the current reference:\n"); - if (unmerged_def_se_hash) - { - fprintf (dump_file, "unmerged_def_se_hash:\n"); - htab_traverse (unmerged_def_se_hash, see_print_one_extension, NULL); - } - if (merged_def_se_hash) - { - fprintf (dump_file, "merged_def_se_hash:\n"); - htab_traverse (merged_def_se_hash, see_print_one_extension, NULL); - } - if (use_se_hash) - { - fprintf (dump_file, "use_se_hash:\n"); - htab_traverse (use_se_hash, see_print_one_extension, NULL); - } - } - - /* Now that all the merges are done, update the register properties of the - basic block and eliminate locally redundant extensions. - It is important that we first traverse the use extensions hash and - afterwards the def extensions hashes. */ - - if (use_se_hash) - htab_traverse_noresize (use_se_hash, see_set_prop_unmerged_use, - (PTR) (stn->value)); - - if (unmerged_def_se_hash) - htab_traverse (unmerged_def_se_hash, see_set_prop_unmerged_def, - (PTR) (stn->value)); - - if (merged_def_se_hash) - htab_traverse (merged_def_se_hash, see_set_prop_merged_def, - (PTR) (stn->value)); - - /* Continue to the next definition. */ - return 0; -} - - -/* Phase 2 top level function. - In this phase, we try to merge def extensions and use extensions with their - references, and eliminate redundant extensions in the same basic block. - We also gather information for the next phases. */ - -static void -see_merge_and_eliminate_extensions (void) -{ - int i = 0; - - if (dump_file) - fprintf (dump_file, - "* Phase 2: Merge and eliminate locally redundant extensions. *\n"); - - /* Traverse over all the splay trees of the basic blocks. */ - for (i = 0; i < last_bb; i++) - { - if (see_bb_splay_ar[i]) - { - if (dump_file) - fprintf (dump_file, "Handling references for bb %d\n", i); - /* Traverse over all the references in the basic block in forward - order. */ - splay_tree_foreach (see_bb_splay_ar[i], - see_handle_extensions_for_one_ref, NULL); - } - } -} - - -/* Phase 1 implementation: Propagate extensions to uses. */ - -/* Insert REF_INSN into the splay tree of its basic block. - SE_INSN is the extension to store in the proper hash according to TYPE. - - Return true if everything went well. - Otherwise, return false (this will cause the optimization to be aborted). */ - -static bool -see_store_reference_and_extension (rtx ref_insn, rtx se_insn, - enum extension_type type) -{ - rtx *rtx_slot; - int curr_bb_num; - splay_tree_node stn = NULL; - htab_t se_hash = NULL; - struct see_ref_s *ref_s = NULL; - - /* Check the arguments. */ - gcc_assert (ref_insn && se_insn); - if (!see_bb_splay_ar) - return false; - - curr_bb_num = BLOCK_NUM (ref_insn); - gcc_assert (curr_bb_num < last_bb && curr_bb_num >= 0); - - /* Insert the reference to the splay tree of its basic block. */ - if (!see_bb_splay_ar[curr_bb_num]) - /* The splay tree for this block doesn't exist yet, create it. */ - see_bb_splay_ar[curr_bb_num] = splay_tree_new (splay_tree_compare_ints, - NULL, see_free_ref_s); - else - /* Splay tree already exists, check if the current reference is already - in it. */ - { - stn = splay_tree_lookup (see_bb_splay_ar[curr_bb_num], - DF_INSN_LUID (ref_insn)); - if (stn) - switch (type) - { - case EXPLICIT_DEF_EXTENSION: - se_hash = - ((struct see_ref_s *) (stn->value))->unmerged_def_se_hash; - if (!se_hash) - { - se_hash = htab_create (10, - hash_descriptor_extension, - eq_descriptor_extension, - NULL); - ((struct see_ref_s *) (stn->value))->unmerged_def_se_hash = - se_hash; - } - break; - case IMPLICIT_DEF_EXTENSION: - se_hash = ((struct see_ref_s *) (stn->value))->merged_def_se_hash; - if (!se_hash) - { - se_hash = htab_create (10, - hash_descriptor_extension, - eq_descriptor_extension, - NULL); - ((struct see_ref_s *) (stn->value))->merged_def_se_hash = - se_hash; - } - break; - case USE_EXTENSION: - se_hash = ((struct see_ref_s *) (stn->value))->use_se_hash; - if (!se_hash) - { - se_hash = htab_create (10, - hash_descriptor_extension, - eq_descriptor_extension, - NULL); - ((struct see_ref_s *) (stn->value))->use_se_hash = se_hash; - } - break; - default: - gcc_unreachable (); - } - } - - /* Initialize a new see_ref_s structure and insert it to the splay - tree. */ - if (!stn) - { - ref_s = XNEW (struct see_ref_s); - ref_s->luid = DF_INSN_LUID (ref_insn); - ref_s->insn = ref_insn; - ref_s->merged_insn = NULL; - - /* Initialize the hashes. */ - switch (type) - { - case EXPLICIT_DEF_EXTENSION: - ref_s->unmerged_def_se_hash = htab_create (10, - hash_descriptor_extension, - eq_descriptor_extension, - NULL); - se_hash = ref_s->unmerged_def_se_hash; - ref_s->merged_def_se_hash = NULL; - ref_s->use_se_hash = NULL; - break; - case IMPLICIT_DEF_EXTENSION: - ref_s->merged_def_se_hash = htab_create (10, - hash_descriptor_extension, - eq_descriptor_extension, - NULL); - se_hash = ref_s->merged_def_se_hash; - ref_s->unmerged_def_se_hash = NULL; - ref_s->use_se_hash = NULL; - break; - case USE_EXTENSION: - ref_s->use_se_hash = htab_create (10, - hash_descriptor_extension, - eq_descriptor_extension, - NULL); - se_hash = ref_s->use_se_hash; - ref_s->unmerged_def_se_hash = NULL; - ref_s->merged_def_se_hash = NULL; - break; - default: - gcc_unreachable (); - } - } - - /* Insert the new extension instruction into the correct se_hash of the - current reference. */ - rtx_slot = (rtx *) htab_find_slot (se_hash, se_insn, INSERT); - if (*rtx_slot != NULL) - { - gcc_assert (type == USE_EXTENSION); - gcc_assert (rtx_equal_p (PATTERN (*rtx_slot), PATTERN (se_insn))); - } - else - *rtx_slot = se_insn; - - /* If this is a new reference, insert it into the splay_tree. */ - if (!stn) - splay_tree_insert (see_bb_splay_ar[curr_bb_num], - DF_INSN_LUID (ref_insn), (splay_tree_value) ref_s); - return true; -} - - -/* Go over all the defs, for each relevant definition (defined below) store its - instruction as a reference. - - A definition is relevant if its root has - ((entry_type == SIGN_EXTENDED_DEF) || (entry_type == ZERO_EXTENDED_DEF)) and - his source_mode is not narrower then the roots source_mode. - - Return the number of relevant defs or negative number if something bad had - happened and the optimization should be aborted. */ - -static int -see_handle_relevant_defs (df_ref ref, rtx insn) -{ - struct web_entry *root_entry = NULL; - rtx se_insn = NULL; - enum entry_type extension_code; - rtx reg = DF_REF_REAL_REG (ref); - rtx ref_insn = NULL; - unsigned int i = DF_REF_ID (ref); - - root_entry = unionfind_root (&def_entry[DF_REF_ID (ref)]); - - if (ENTRY_EI (root_entry)->relevancy != SIGN_EXTENDED_DEF - && ENTRY_EI (root_entry)->relevancy != ZERO_EXTENDED_DEF) - /* The current web is not relevant. Continue to the next def. */ - return 0; - - if (root_entry->reg) - /* It isn't possible to have two different register for the same - web. */ - gcc_assert (rtx_equal_p (root_entry->reg, reg)); - else - root_entry->reg = reg; - - /* The current definition is an EXTENDED_DEF or a definition that its - source_mode is narrower then its web's source_mode. - This means that we need to generate the implicit extension explicitly - and store it in the current reference's merged_def_se_hash. */ - if (ENTRY_EI (&def_entry[i])->local_relevancy == EXTENDED_DEF - || (ENTRY_EI (&def_entry[i])->local_source_mode < - ENTRY_EI (root_entry)->source_mode)) - { - - if (ENTRY_EI (root_entry)->relevancy == SIGN_EXTENDED_DEF) - extension_code = SIGN_EXTENDED_DEF; - else - extension_code = ZERO_EXTENDED_DEF; - - se_insn = - see_gen_normalized_extension (reg, extension_code, - ENTRY_EI (root_entry)->source_mode); - - /* This is a dummy extension, mark it as deleted. */ - INSN_DELETED_P (se_insn) = 1; - - if (!see_store_reference_and_extension (insn, se_insn, - IMPLICIT_DEF_EXTENSION)) - /* Something bad happened. Abort the optimization. */ - return -1; - return 1; - } - - ref_insn = PREV_INSN (insn); - gcc_assert (BLOCK_NUM (ref_insn) == BLOCK_NUM (insn)); - - if (!see_store_reference_and_extension (ref_insn, insn, - EXPLICIT_DEF_EXTENSION)) - /* Something bad happened. Abort the optimization. */ - return -1; - - return 0; -} - -/* Go over all the uses, for each use in relevant web store its instruction as - a reference and generate an extension before it. - - Return the number of relevant uses or negative number if something bad had - happened and the optimization should be aborted. */ - -static int -see_handle_relevant_uses (df_ref ref, rtx insn) -{ - struct web_entry *root_entry = NULL; - rtx se_insn = NULL; - enum entry_type extension_code; - rtx reg = DF_REF_REAL_REG (ref); - - root_entry = unionfind_root (&use_entry[DF_REF_ID (ref)]); - - if (ENTRY_EI (root_entry)->relevancy != SIGN_EXTENDED_DEF - && ENTRY_EI (root_entry)->relevancy != ZERO_EXTENDED_DEF) - /* The current web is not relevant. Continue to the next use. */ - return 0; - - if (root_entry->reg) - /* It isn't possible to have two different register for the same - web. */ - gcc_assert (rtx_equal_p (root_entry->reg, reg)); - else - root_entry->reg = reg; - - /* Generate the use extension. */ - if (ENTRY_EI (root_entry)->relevancy == SIGN_EXTENDED_DEF) - extension_code = SIGN_EXTENDED_DEF; - else - extension_code = ZERO_EXTENDED_DEF; - - se_insn = - see_gen_normalized_extension (reg, extension_code, - ENTRY_EI (root_entry)->source_mode); - if (!se_insn) - /* This is very bad, abort the transformation. */ - return -1; - - if (!see_store_reference_and_extension (insn, se_insn, - USE_EXTENSION)) - /* Something bad happened. Abort the optimization. */ - return -1; - return 1; -} - -static int -see_handle_relevant_refs (void) -{ - int num_relevant_refs = 0; - basic_block bb; - - FOR_ALL_BB (bb) - { - rtx insn; - FOR_BB_INSNS (bb, insn) - { - unsigned int uid = INSN_UID (insn); - - if (INSN_P (insn)) - { - df_ref *use_rec; - df_ref *def_rec; - - for (use_rec = DF_INSN_UID_USES (uid); *use_rec; use_rec++) - { - df_ref use = *use_rec; - int result = see_handle_relevant_uses (use, insn); - if (result == -1) - return -1; - num_relevant_refs += result; - } - for (use_rec = DF_INSN_UID_EQ_USES (uid); *use_rec; use_rec++) - { - df_ref use = *use_rec; - int result = see_handle_relevant_uses (use, insn); - if (result == -1) - return -1; - num_relevant_refs += result; - } - for (def_rec = DF_INSN_UID_DEFS (uid); *def_rec; def_rec++) - { - df_ref def = *def_rec; - int result = see_handle_relevant_defs (def, insn); - if (result == -1) - return -1; - num_relevant_refs += result; - } - } - } - } - return num_relevant_refs; -} - - -/* Initialized the use_entry field for REF in INSN at INDEX with ET. */ - -static void -see_update_uses_relevancy (rtx insn, df_ref ref, - enum entry_type et, unsigned int index) -{ - struct see_entry_extra_info *curr_entry_extra_info; - - if (dump_file) - { - rtx reg = DF_REF_REAL_REG (ref); - fprintf (dump_file, "u%i insn %i reg %i ", - index, (insn ? INSN_UID (insn) : -1), REGNO (reg)); - if (et == NOT_RELEVANT) - fprintf (dump_file, "NOT RELEVANT \n"); - else - fprintf (dump_file, "RELEVANT USE \n"); - } - - DF_REF_ID (ref) = index; - curr_entry_extra_info = XNEW (struct see_entry_extra_info); - curr_entry_extra_info->relevancy = et; - curr_entry_extra_info->local_relevancy = et; - use_entry[index].extra_info = curr_entry_extra_info; - use_entry[index].reg = NULL; - use_entry[index].pred = NULL; -} - - -/* A definition in a candidate for this optimization only if its pattern is - recognized as relevant in this function. - INSN is the instruction to be recognized. - -- If this is the pattern of a common sign extension after definition: - PREV_INSN (INSN): def (reg:NARROWmode r) - INSN: set ((reg:WIDEmode r') - (sign_extend:WIDEmode (reg:NARROWmode r))) - return SIGN_EXTENDED_DEF and set SOURCE_MODE to NARROWmode. - -- If this is the pattern of a common zero extension after definition: - PREV_INSN (INSN): def (reg:NARROWmode r) - INSN: set ((reg:WIDEmode r') - (zero_extend:WIDEmode (reg:NARROWmode r))) - return ZERO_EXTENDED_DEF and set SOURCE_MODE to NARROWmode. - -- Otherwise, - - For the pattern: - INSN: set ((reg:WIDEmode r) (sign_extend:WIDEmode (...expr...))) - return EXTENDED_DEF and set SOURCE_MODE to the mode of expr. - - For the pattern: - INSN: set ((reg:WIDEmode r) (zero_extend:WIDEmode (...expr...))) - return EXTENDED_DEF and set SOURCE_MODE_UNSIGNED to the mode of expr. - - For the pattern: - INSN: set ((reg:WIDEmode r) (CONST_INT (...))) - return EXTENDED_DEF and set SOURCE_MODE(_UNSIGNED) to the narrowest mode that - is implicitly sign(zero) extended to WIDEmode in the INSN. - -- FIXME: Extensions that are not adjacent to their definition and EXTENDED_DEF - that is part of a PARALLEL instruction are not handled. - These restriction can be relaxed. */ - -static enum entry_type -see_analyze_one_def (rtx insn, enum machine_mode *source_mode, - enum machine_mode *source_mode_unsigned) -{ - enum entry_type extension_code; - rtx rhs = NULL; - rtx lhs = NULL; - rtx set = NULL; - rtx source_register = NULL; - rtx prev_insn = NULL; - rtx next_insn = NULL; - enum machine_mode mode; - enum machine_mode next_source_mode; - HOST_WIDE_INT val = 0; - HOST_WIDE_INT val2 = 0; - int i = 0; - - *source_mode = MAX_MACHINE_MODE; - *source_mode_unsigned = MAX_MACHINE_MODE; - - extension_code = see_get_extension_data (insn, source_mode); - switch (extension_code) - { - case SIGN_EXTENDED_DEF: - case ZERO_EXTENDED_DEF: - source_register = see_get_extension_reg (insn, 0); - /* FIXME: This restriction can be relaxed. The only thing that is - important is that the reference would be inside the same basic block - as the extension. */ - prev_insn = PREV_INSN (insn); - if (!prev_insn || !INSN_P (prev_insn)) - return NOT_RELEVANT; - - if (!reg_set_between_p (source_register, PREV_INSN (prev_insn), insn)) - return NOT_RELEVANT; - - /* If we can't use copy_rtx on the reference it can't be a reference. */ - if (GET_CODE (PATTERN (prev_insn)) == PARALLEL - && asm_noperands (PATTERN (prev_insn)) >= 0) - return NOT_RELEVANT; - - /* Now, check if this extension is a reference itself. If so, it is not - relevant. Handling this extension as relevant would make things much - more complicated. */ - next_insn = NEXT_INSN (insn); - if (next_insn - && INSN_P (next_insn) - && (see_get_extension_data (next_insn, &next_source_mode) != - NOT_RELEVANT)) - { - rtx curr_dest_register = see_get_extension_reg (insn, 1); - rtx next_source_register = see_get_extension_reg (next_insn, 0); - - if (REGNO (curr_dest_register) == REGNO (next_source_register)) - return NOT_RELEVANT; - } - - return extension_code; - - case NOT_RELEVANT: - /* This may still be an EXTENDED_DEF. */ - - /* FIXME: This restriction can be relaxed. It is possible to handle - PARALLEL insns too. */ - set = single_set (insn); - if (!set) - return NOT_RELEVANT; - rhs = SET_SRC (set); - lhs = SET_DEST (set); - - /* Don't handle extensions to something other then register or - subregister. */ - if (!REG_P (lhs) && GET_CODE (lhs) != SUBREG) - return NOT_RELEVANT; - - switch (GET_CODE (rhs)) - { - case SIGN_EXTEND: - *source_mode = GET_MODE (XEXP (rhs, 0)); - *source_mode_unsigned = MAX_MACHINE_MODE; - return EXTENDED_DEF; - case ZERO_EXTEND: - *source_mode = MAX_MACHINE_MODE; - *source_mode_unsigned = GET_MODE (XEXP (rhs, 0)); - return EXTENDED_DEF; - case CONST_INT: - - val = INTVAL (rhs); - - /* Find the narrowest mode, val could fit into. */ - for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT), i = 0; - GET_MODE_BITSIZE (mode) < BITS_PER_WORD; - mode = GET_MODE_WIDER_MODE (mode), i++) - { - val2 = trunc_int_for_mode (val, mode); - if (val2 == val && *source_mode == MAX_MACHINE_MODE) - *source_mode = mode; - if (val == (val & (HOST_WIDE_INT)GET_MODE_MASK (mode)) - && *source_mode_unsigned == MAX_MACHINE_MODE) - *source_mode_unsigned = mode; - if (*source_mode != MAX_MACHINE_MODE - && *source_mode_unsigned !=MAX_MACHINE_MODE) - return EXTENDED_DEF; - } - if (*source_mode != MAX_MACHINE_MODE - || *source_mode_unsigned !=MAX_MACHINE_MODE) - return EXTENDED_DEF; - return NOT_RELEVANT; - default: - return NOT_RELEVANT; - } - default: - gcc_unreachable (); - } -} - - -/* Initialized the def_entry field for REF in INSN at INDEX with ET. */ - -static void -see_update_defs_relevancy (rtx insn, df_ref ref, - enum entry_type et, - enum machine_mode source_mode, - enum machine_mode source_mode_unsigned, - unsigned int index) -{ - struct see_entry_extra_info *curr_entry_extra_info - = XNEW (struct see_entry_extra_info); - curr_entry_extra_info->relevancy = et; - curr_entry_extra_info->local_relevancy = et; - - DF_REF_ID (ref) = index; - - if (et != EXTENDED_DEF) - { - curr_entry_extra_info->source_mode = source_mode; - curr_entry_extra_info->local_source_mode = source_mode; - } - else - { - curr_entry_extra_info->source_mode_signed = source_mode; - curr_entry_extra_info->source_mode_unsigned = source_mode_unsigned; - } - def_entry[index].extra_info = curr_entry_extra_info; - def_entry[index].reg = NULL; - def_entry[index].pred = NULL; - - if (dump_file) - { - rtx reg = DF_REF_REAL_REG (ref); - if (et == NOT_RELEVANT) - { - fprintf (dump_file, "d%i insn %i reg %i ", - index, (insn ? INSN_UID (insn) : -1), REGNO (reg)); - fprintf (dump_file, "NOT RELEVANT \n"); - } - else - { - fprintf (dump_file, "d%i insn %i reg %i ", - index, INSN_UID (insn), REGNO (reg)); - fprintf (dump_file, "RELEVANT - "); - switch (et) - { - case SIGN_EXTENDED_DEF : - fprintf (dump_file, "SIGN_EXTENDED_DEF, source_mode = %s\n", - GET_MODE_NAME (source_mode)); - break; - case ZERO_EXTENDED_DEF : - fprintf (dump_file, "ZERO_EXTENDED_DEF, source_mode = %s\n", - GET_MODE_NAME (source_mode)); - break; - case EXTENDED_DEF : - fprintf (dump_file, "EXTENDED_DEF, "); - if (source_mode != MAX_MACHINE_MODE - && source_mode_unsigned != MAX_MACHINE_MODE) - { - fprintf (dump_file, "positive const, "); - fprintf (dump_file, "source_mode_signed = %s, ", - GET_MODE_NAME (source_mode)); - fprintf (dump_file, "source_mode_unsigned = %s\n", - GET_MODE_NAME (source_mode_unsigned)); - } - else if (source_mode != MAX_MACHINE_MODE) - fprintf (dump_file, "source_mode_signed = %s\n", - GET_MODE_NAME (source_mode)); - else - fprintf (dump_file, "source_mode_unsigned = %s\n", - GET_MODE_NAME (source_mode_unsigned)); - break; - default : - gcc_unreachable (); - } - } - } -} - - -/* Updates the relevancy of all the uses and all defs. - - The information of the u'th use is stored in use_entry[u] and the - information of the d'th definition is stored in def_entry[d]. - - Currently all the uses are relevant for the optimization except for - uses that are in LIBCALL or RETVAL instructions. */ - -static void -see_update_relevancy (void) -{ - unsigned int d = 0; - unsigned int u = 0; - enum entry_type et; - enum machine_mode source_mode; - enum machine_mode source_mode_unsigned; - basic_block bb; - - if (!def_entry) - return; - - FOR_ALL_BB (bb) - { - df_ref *use_rec; - df_ref *def_rec; - rtx insn; - FOR_BB_INSNS (bb, insn) - { - unsigned int uid = INSN_UID (insn); - if (INSN_P (insn)) - { - et = RELEVANT_USE; - - for (use_rec = DF_INSN_UID_USES (uid); *use_rec; use_rec++) - { - df_ref use = *use_rec; - see_update_uses_relevancy (insn, use, et, u); - u++; - } - - for (use_rec = DF_INSN_UID_EQ_USES (uid); *use_rec; use_rec++) - { - df_ref use = *use_rec; - see_update_uses_relevancy (insn, use, et, u); - u++; - } - - et = see_analyze_one_def (insn, &source_mode, &source_mode_unsigned); - for (def_rec = DF_INSN_UID_DEFS (uid); *def_rec; def_rec++) - { - df_ref def = *def_rec; - see_update_defs_relevancy (insn, def, et, source_mode, - source_mode_unsigned, d); - d++; - } - } - } - - for (use_rec = df_get_artificial_uses (bb->index); *use_rec; use_rec++) - { - df_ref use = *use_rec; - see_update_uses_relevancy (NULL, use, NOT_RELEVANT, u); - u++; - } - - for (def_rec = df_get_artificial_defs (bb->index); *def_rec; def_rec++) - { - df_ref def = *def_rec; - see_update_defs_relevancy (NULL, def, NOT_RELEVANT, - MAX_MACHINE_MODE, MAX_MACHINE_MODE, d); - d++; - } - } -} - - -/* Phase 1 top level function. - In this phase the relevancy of all the definitions and uses are checked, - later the webs are produces and the extensions are generated. - These extensions are not emitted yet into the insns stream. - - returns true if at list one relevant web was found and there were no - problems, otherwise return false. */ - -static bool -see_propagate_extensions_to_uses (void) -{ - int num_relevant_refs; - basic_block bb; - - if (dump_file) - fprintf (dump_file, - "* Phase 1: Propagate extensions to uses. *\n"); - - /* Update the relevancy of references using the DF object. */ - see_update_relevancy (); - - /* Produce the webs and update the extra_info of the root. - In general, a web is relevant if all its definitions and uses are relevant - and there is at least one definition that was marked as SIGN_EXTENDED_DEF - or ZERO_EXTENDED_DEF. */ - FOR_ALL_BB (bb) - { - rtx insn; - df_ref *use_rec; - - FOR_BB_INSNS (bb, insn) - { - unsigned int uid = INSN_UID (insn); - if (INSN_P (insn)) - { - for (use_rec = DF_INSN_UID_USES (uid); *use_rec; use_rec++) - { - df_ref use = *use_rec; - union_defs (use, def_entry, use_entry, see_update_leader_extra_info); - } - - for (use_rec = DF_INSN_UID_EQ_USES (uid); *use_rec; use_rec++) - { - df_ref use = *use_rec; - union_defs (use, def_entry, use_entry, see_update_leader_extra_info); - } - } - } - - for (use_rec = df_get_artificial_uses (bb->index); *use_rec; use_rec++) - { - df_ref use = *use_rec; - union_defs (use, def_entry, use_entry, see_update_leader_extra_info); - } - } - - /* Generate use extensions for references and insert these - references to see_bb_splay_ar data structure. */ - num_relevant_refs = see_handle_relevant_refs (); - - return num_relevant_refs > 0; -} - - -/* Main entry point for the sign extension elimination optimization. */ - -static void -see_main (void) -{ - bool cont = false; - int i = 0; - - /* Initialize global data structures. */ - see_initialize_data_structures (); - - /* Phase 1: Propagate extensions to uses. */ - cont = see_propagate_extensions_to_uses (); - - if (cont) - { - init_recog (); - - /* Phase 2: Merge and eliminate locally redundant extensions. */ - see_merge_and_eliminate_extensions (); - - /* Phase 3: Eliminate globally redundant extensions. */ - see_execute_LCM (); - - /* Phase 4: Commit changes to the insn stream. */ - see_commit_changes (); - - if (dump_file) - { - /* For debug purpose only. */ - fprintf (dump_file, "see_pre_extension_hash:\n"); - htab_traverse (see_pre_extension_hash, see_print_pre_extension_expr, - NULL); - - for (i = 0; i < last_bb; i++) - { - if (see_bb_hash_ar[i]) - /* Traverse over all the references in the basic block in - forward order. */ - { - fprintf (dump_file, - "Searching register properties in bb %d\n", i); - htab_traverse (see_bb_hash_ar[i], - see_print_register_properties, NULL); - } - } - } - } - - /* Free global data structures. */ - see_free_data_structures (); -} - - -static bool -gate_handle_see (void) -{ - return optimize > 1 && flag_see; -} - -static unsigned int -rest_of_handle_see (void) -{ - see_main (); - df_clear_flags (DF_DEFER_INSN_RESCAN); - df_process_deferred_rescans (); - run_fast_dce (); - return 0; -} - -struct rtl_opt_pass pass_see = -{ - { - RTL_PASS, - "see", /* name */ - gate_handle_see, /* gate */ - rest_of_handle_see, /* execute */ - NULL, /* sub */ - NULL, /* next */ - 0, /* static_pass_number */ - TV_SEE, /* tv_id */ - 0, /* properties_required */ - 0, /* properties_provided */ - 0, /* properties_destroyed */ - 0, /* todo_flags_start */ - TODO_df_verify | - TODO_df_finish | TODO_verify_rtl_sharing | - TODO_dump_func /* todo_flags_finish */ - } -}; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e0d1f6f421c..00dee392eb3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,191 @@ +2009-06-22 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/40443 + * gfortran.dg/generic_18.f90: New test. + +2009-06-22 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/40472 + * gfortran.dg/spread_size_limit.f90: New test. + +2009-06-21 Uros Bizjak <ubizjak@gmail.com> + + * gcc.c-torture/unsorted/dump-noaddr.x (dump_compare): Use --dumpbase + to put dump files in a subdirectory. + * gcc/testsuite/lib/gcc-dg.exp (cleanup-saved-temps): Also remove + ".o" temporary files. + +2009-06-21 Janus Weil <janus@gcc.gnu.org> + + PR fortran/39850 + * gfortran.dg/interface_19.f90: Add 'cleanup-modules'. + * gfortran.dg/interface_20.f90: Ditto. + * gfortran.dg/interface_21.f90: Ditto. + * gfortran.dg/interface_22.f90: Ditto. + * gfortran.dg/interface_30.f90: New. + * gfortran.dg/proc_ptr_11.f90: Fix invalid test case. + +2009-06-21 Uros Bizjak <ubizjak@gmail.com> + + * gcc.dg/tree-ssa/fre-vce-1.c: Cleanup "fre" tree dump. + * gcc.dg/vect/vect-shift-2.c: Cleanup "vect" tree dump. + * gcc.dg/vect/vect.exp (VECT_SLP_CFLAGS): Initialize with original + DEFAULT_VECTFLAGS. + +2009-06-21 Ira Rosen <irar@il.ibm.com> + Revital Eres <eres@il.ibm.com> + + PR testsuite/40359 + * gcc.dg/vect/vect-50.c: Fix syntax error in the check. + * gcc.dg/vect/vect-42.c: Likewise and separate vec_no_align check. + * gcc.dg/vect/vect-96.c: Fix syntax error in the check. + +2009-06-21 Ira Rosen <irar@il.ibm.com> + + PR testsuite/40475 + * gcc.dg/vect/vect-nest-cycle-1.c: Fail to vectorize on targets + without misalignment support. + * gcc.dg/vect/vect-nest-cycle-2.c: Likewise. + +2009-06-20 Tobias Burnus <burnus@net-b.de> + + PR fortran/40452 + * gfortran.dg/bounds_check_strlen_9.f90: New test. + +2009-06-19 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/40440 + * gfortran.dg/alloc_comp_result_2.f90: New test. + +2009-06-19 Ramana Radhakrishnan <ramana.radhakrishnan@arm.com> + + PR target/40482 + * gcc.target/arm/pr40482.c: New test. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * gcc.dg/Wcxx-compat-18.c: New testcase. + +2009-06-19 Richard Guenther <rguenther@suse.de> + + * gcc.c-torture/execute/20090618-1.c: New testcase. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * gcc.dg/Wcxx-compat-17.c: New testcase. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * gcc.dg/Wcxx-compat-15.c: New testcase. + +2009-06-19 Ian Lance Taylor <iant@google.com> + + * gcc.dg/Wcxx-compat-16.c: New testcase. + +2009-06-19 Uros Bizjak <ubizjak@gmail.com> + + * gcc.dg/builtins-34.c: Add significand cases. + +2009-06-19 Uros Bizjak <ubizjak@gmail.com> + + PR testsuite/40491 + * testsuite/gcc.dg/20080522-1.c: Remove testcase for real. + * testsuite/gcc.dg/20080528-1.c: Ditto. + +2009-06-19 Janus Weil <janus@gcc.gnu.org> + + PR fortran/40450 + * gfortran.dg/proc_ptr_20.f90: New. + +2009-06-18 H.J. Lu <hongjiu.lu@intel.com> + + PR target/40470 + * gcc.dg/torture/pr40470-1.c: New. + * gcc.dg/torture/pr40470-2.c: Likewise. + * gcc.dg/torture/pr40470-3.c: Likewise. + * gcc.dg/torture/pr40470-4.c: Likewise. + +2009-06-18 Diego Novillo <dnovillo@google.com> + + * gcc.dg/plugin/selfassign.c: Declare plugin_is_GPL_compatible. + * gcc.dg/plugin/ggcplug.c: Likewise. + * gcc.dg/plugin/one_time_plugin.c: Likewise. + * g++.dg/plugin/selfassign.c: Likewise. + * g++.dg/plugin/attribute_plugin.c: Likewise. + * g++.dg/plugin/dumb_plugin.c: Likewise. + +2009-06-18 Manuel López-Ibáñez <manu@gcc.gnu.org> + + * gcc.dg/cpp/arith-3.c: Add column info. + +2009-06-18 Sandra Loosemore <sandra@codesourcery.com> + + * gcc.target/arm/fp16-compile-none-2.c: New. + * gcc.target/arm/fp16-compile-ieee-12.c: New. + * gcc.target/arm/fp16-compile-alt-12.c: New. + +2009-06-18 Sandra Loosemore <sandra@codesourcery.com> + + * gcc.target/arm/fp16-compile-alt-1.c: New. + * gcc.target/arm/fp16-compile-alt-2.c: New. + * gcc.target/arm/fp16-compile-alt-3.c: New. + * gcc.target/arm/fp16-compile-alt-4.c: New. + * gcc.target/arm/fp16-compile-alt-5.c: New. + * gcc.target/arm/fp16-compile-alt-6.c: New. + * gcc.target/arm/fp16-compile-alt-7.c: New. + * gcc.target/arm/fp16-compile-alt-8.c: New. + * gcc.target/arm/fp16-compile-alt-9.c: New. + * gcc.target/arm/fp16-compile-alt-10.c: New. + * gcc.target/arm/fp16-compile-alt-11.c: New. + * gcc.target/arm/fp16-compile-ieee-1.c: New. + * gcc.target/arm/fp16-compile-ieee-2.c: New. + * gcc.target/arm/fp16-compile-ieee-3.c: New. + * gcc.target/arm/fp16-compile-ieee-4.c: New. + * gcc.target/arm/fp16-compile-ieee-5.c: New. + * gcc.target/arm/fp16-compile-ieee-6.c: New. + * gcc.target/arm/fp16-compile-ieee-7.c: New. + * gcc.target/arm/fp16-compile-ieee-8.c: New. + * gcc.target/arm/fp16-compile-ieee-9.c: New. + * gcc.target/arm/fp16-compile-ieee-10.c: New. + * gcc.target/arm/fp16-compile-ieee-11.c: New. + * gcc.target/arm/fp16-compile-none-1.c: New. + * gcc.target/arm/fp16-compile-exprtype.c: New. + * gcc.target/arm/fp16-compile-vcvt.c: New. + * gcc.target/arm/fp16-builtins-1.c: New. + * gcc.target/arm/fp16-rounding-alt-1.c: New. + * gcc.target/arm/fp16-rounding-ieee-1.c: New. + * gcc.target/arm/fp16-param-1.c: New. + * gcc.target/arm/fp16-return-1.c: New. + * gcc.target/arm/fp16-unprototyped-1.c: New. + * gcc.target/arm/fp16-unprototyped-2.c: New. + * gcc.target/arm/fp16-variadic-1.c: New. + * gcc.dg/torture/arm-fp16-compile-assign.c: New. + * gcc.dg/torture/arm-fp16-compile-convert.c: New. + * gcc.dg/torture/arm-fp16-int-convert-alt.c: New. + * gcc.dg/torture/arm-fp16-int-convert-ieee.c: New. + * gcc.dg/torture/arm-fp16-ops.h: New. + * gcc.dg/torture/arm-fp16-ops-1.c: New. + * gcc.dg/torture/arm-fp16-ops-2.c: New. + * gcc.dg/torture/arm-fp16-ops-3.c: New. + * gcc.dg/torture/arm-fp16-ops-4.c: New. + * gcc.dg/torture/arm-fp16-ops-5.c: New. + * gcc.dg/torture/arm-fp16-ops-6.c: New. + * gcc.dg/torture/arm-fp16-ops-7.c: New. + * gcc.dg/torture/arm-fp16-ops-8.c: New. + * g++.dg/ext/arm-fp16/fp16-overload-1.C: New. + * g++.dg/ext/arm-fp16/fp16-return-1.C: New. + * g++.dg/ext/arm-fp16/fp16-param-1.C: New. + * g++.dg/ext/arm-fp16/fp16-mangle-1.C: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops.h: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops-1.C: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops-2.C: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops-3.C: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops-4.C: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops-5.C: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops-6.C: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops-7.C: New. + * g++.dg/ext/arm-fp16/arm-fp16-ops-8.C: New. + 2009-06-18 Uros Bizjak <ubizjak@gmail.com> * gcc.dg/builtins-65.c: New test. diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-1.C b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-1.C new file mode 100644 index 00000000000..0c601e68c41 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-1.C @@ -0,0 +1,5 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +#include "arm-fp16-ops.h" diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-2.C b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-2.C new file mode 100644 index 00000000000..244e31082f9 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-2.C @@ -0,0 +1,5 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee -ffast-math" } */ + +#include "arm-fp16-ops.h" diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-3.C b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-3.C new file mode 100644 index 00000000000..8f9ab64bc45 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-3.C @@ -0,0 +1,5 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=alternative" } */ + +#include "arm-fp16-ops.h" diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-4.C b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-4.C new file mode 100644 index 00000000000..4877f392c06 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-4.C @@ -0,0 +1,5 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=alternative -ffast-math" } */ + +#include "arm-fp16-ops.h" diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-5.C b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-5.C new file mode 100644 index 00000000000..6bc4cf6ea65 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-5.C @@ -0,0 +1,14 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -mfpu=neon-fp16 -mfloat-abi=softfp" } */ + +#include "arm-fp16-ops.h" + +/* We've specified options for hardware float, including fp16 support, so + we should not see any calls to libfuncs here. */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf2" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf3" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h\[a-z\]*_ieee" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h2f_ieee" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_f2h_ieee" } } */ diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-6.C b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-6.C new file mode 100644 index 00000000000..9401a5935c3 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-6.C @@ -0,0 +1,14 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -ffast-math -mfpu=neon-fp16 -mfloat-abi=softfp" } */ + +#include "arm-fp16-ops.h" + +/* We've specified options for hardware float, including fp16 support, so + we should not see any calls to libfuncs here. */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf2" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf3" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h\[a-z\]*_ieee" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h2f_ieee" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_f2h_ieee" } } */ diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-7.C b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-7.C new file mode 100644 index 00000000000..debc193df93 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-7.C @@ -0,0 +1,12 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -mfpu=neon -mfloat-abi=softfp" } */ + +#include "arm-fp16-ops.h" + +/* We've specified options for hardware float, so we should not see any + calls to libfuncs here except for those to the conversion functions. */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf2" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf3" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h\[a-z\]*_ieee" } } */ diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-8.C b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-8.C new file mode 100644 index 00000000000..a6e72388a1c --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops-8.C @@ -0,0 +1,12 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -ffast-math -mfpu=neon -mfloat-abi=softfp" } */ + +#include "arm-fp16-ops.h" + +/* We've specified options for hardware float, so we should not see any + calls to libfuncs here except for those to the conversion functions. */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf2" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf3" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h\[a-z\]*_ieee" } } */ diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops.h b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops.h new file mode 100644 index 00000000000..320494ee71c --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/arm-fp16-ops.h @@ -0,0 +1,135 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ + +#include <assert.h> + +#define CHECK(e,r) assert ((e) == r) +#define CHECK2(e,r) (assert ((e) == r), temp = (e), assert (temp == r)) +#define TEST(e) assert (e) +#define TESTNOT(e) assert (!(e)) + +volatile __fp16 h0 = 0.0; +volatile __fp16 h1 = 1.0; +volatile __fp16 h42 = 42.0; +volatile __fp16 hm2 = -2.0; +volatile __fp16 temp; + +volatile float f0 = 0.0; +volatile float f1 = 1.0; +volatile float f42 = 42.0; +volatile float fm2 = -2.0; + +int main (void) +{ + TEST (h1); + TESTNOT (h0); + TEST (!h0); + TESTNOT (!h1); + + CHECK2 (-h1, -1.0); + CHECK2 (+h1, 1.0); + + CHECK (h1++, 1.0); + CHECK (h1, 2.0); + CHECK (++h1, 3.0); + CHECK (h1, 3.0); + + CHECK (--h1, 2.0); + CHECK (h1, 2.0); + CHECK (h1--, 2.0); + CHECK (h1, 1.0); + + CHECK2 (h42 * hm2, -84.0); + CHECK2 (h42 * (__fp16) -2.0, -84.0); + CHECK2 (h42 * fm2, -84.0); + CHECK2 (f42 * hm2, -84.0); + + CHECK2 (h42 / hm2, -21.0); + CHECK2 (h42 / (__fp16) -2.0, -21.0); + CHECK2 (h42 / fm2, -21.0); + CHECK2 (f42 / hm2, -21.0); + + CHECK2 (hm2 + h42, 40.0); + CHECK2 ((__fp16)-2.0 + h42, 40.0); + CHECK2 (hm2 + f42, 40.0); + CHECK2 (fm2 + h42, 40.0); + + CHECK2 (hm2 - h42, -44.0); + CHECK2 ((__fp16)-2.0 - h42, -44.0); + CHECK2 (hm2 - f42, -44.0); + CHECK2 (fm2 - h42, -44.0); + + TEST (hm2 < h42); + TEST (hm2 < (__fp16)42.0); + TEST (hm2 < f42); + TEST (fm2 < h42); + + TEST (h42 > hm2); + TEST ((__fp16)42.0 > hm2); + TEST (h42 > fm2); + TEST (f42 > hm2); + + TEST (hm2 <= h42); + TEST (hm2 <= (__fp16)42.0); + TEST (hm2 <= f42); + TEST (fm2 <= h42); + + TEST (h42 >= hm2); + TEST (h42 >= (__fp16)-2.0); + TEST (h42 >= fm2); + TEST (f42 >= hm2); + + TESTNOT (h1 == hm2); + TEST (h1 == h1); + TEST (h1 == (__fp16)1.0); + TEST (h1 == f1); + TEST (f1 == h1); + + TEST (h1 != hm2); + TESTNOT (h1 != h1); + TESTNOT (h1 != (__fp16)1.0); + TESTNOT (h1 != f1); + TESTNOT (f1 != h1); + + CHECK2 ((h1 ? hm2 : h42), -2.0); + CHECK2 ((h0 ? hm2 : h42), 42.0); + + CHECK (h0 = h42, 42.0); + CHECK (h0, 42.0); + CHECK (h0 = (__fp16)-2.0, -2.0); + CHECK (h0, -2.0); + CHECK (h0 = f0, 0.0); + CHECK (h0, 0.0); + + CHECK (h0 += h1, 1.0); + CHECK (h0, 1.0); + CHECK (h0 += (__fp16)1.0, 2.0); + CHECK (h0, 2.0); + CHECK (h0 += fm2, 0.0); + CHECK (h0, 0.0); + + CHECK (h0 -= h1, -1.0); + CHECK (h0, -1.0); + CHECK (h0 -= (__fp16)1.0, -2.0); + CHECK (h0, -2.0); + CHECK (h0 -= fm2, 0.0); + CHECK (h0, 0.0); + + h0 = hm2; + CHECK (h0 *= hm2, 4.0); + CHECK (h0, 4.0); + CHECK (h0 *= (__fp16)-2.0, -8.0); + CHECK (h0, -8.0); + CHECK (h0 *= fm2, 16.0); + CHECK (h0, 16.0); + + CHECK (h0 /= hm2, -8.0); + CHECK (h0, -8.0); + CHECK (h0 /= (__fp16)-2.0, 4.0); + CHECK (h0, 4.0); + CHECK (h0 /= fm2, -2.0); + CHECK (h0, -2.0); + + CHECK ((h0, h1), 1.0); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-mangle-1.C b/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-mangle-1.C new file mode 100644 index 00000000000..25a872af6d4 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-mangle-1.C @@ -0,0 +1,14 @@ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Test mangling */ + +/* { dg-final { scan-assembler "\t.global\t_Z1fPDh" } } */ +void f (__fp16 *x) { } + +/* { dg-final { scan-assembler "\t.global\t_Z1gPDhS_" } } */ +void g (__fp16 *x, __fp16 *y) { } + +/* { dg-final { scan-assembler "\t.global\t_ZN1SIDhDhE1iE" } } */ +template <typename T, typename U> struct S { static int i; }; +template <> int S<__fp16, __fp16>::i = 3; diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-overload-1.C b/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-overload-1.C new file mode 100644 index 00000000000..bf0139d7cef --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-overload-1.C @@ -0,0 +1,16 @@ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* __fp16 values are autoconverted to float and should therefore be treated + * just like float for overloading purposes. */ + +extern int frobnify (float x); +extern int frobnify (double x); + +int g (void) +{ + return frobnify ((__fp16)1.0); +} + +/* { dg-final { scan-assembler "_Z8frobnifyf" } } */ +/* { dg-final { scan-assembler-not " _Z8frobnifyd" } } */ diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-param-1.C b/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-param-1.C new file mode 100644 index 00000000000..03feb1a4d65 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-param-1.C @@ -0,0 +1,10 @@ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Functions cannot have parameters of type __fp16. */ +extern void f (__fp16); /* { dg-error "parameters cannot have __fp16 type" } */ +extern void (*pf) (__fp16); /* { dg-error "parameters cannot have __fp16 type" } */ + +/* These should be OK. */ +extern void g (__fp16 *); +extern void (*pg) (__fp16 *); diff --git a/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-return-1.C b/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-return-1.C new file mode 100644 index 00000000000..406dfacd399 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/arm-fp16/fp16-return-1.C @@ -0,0 +1,10 @@ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Functions cannot return type __fp16. */ +extern __fp16 f (void); /* { dg-error "cannot return __fp16" } */ +extern __fp16 (*pf) (void); /* { dg-error "cannot return __fp16" } */ + +/* These should be OK. */ +extern __fp16 *g (void); +extern __fp16 *(*pg) (void); diff --git a/gcc/testsuite/g++.dg/plugin/attribute_plugin.c b/gcc/testsuite/g++.dg/plugin/attribute_plugin.c index 16b34964350..deaebf1b16d 100644 --- a/gcc/testsuite/g++.dg/plugin/attribute_plugin.c +++ b/gcc/testsuite/g++.dg/plugin/attribute_plugin.c @@ -9,6 +9,8 @@ #include "tree-pass.h" #include "intl.h" +int plugin_is_GPL_compatible; + /* Attribute handler callback */ static tree diff --git a/gcc/testsuite/g++.dg/plugin/dumb_plugin.c b/gcc/testsuite/g++.dg/plugin/dumb_plugin.c index 24da5440391..18f42c09dcb 100644 --- a/gcc/testsuite/g++.dg/plugin/dumb_plugin.c +++ b/gcc/testsuite/g++.dg/plugin/dumb_plugin.c @@ -10,6 +10,7 @@ #include "tree-pass.h" #include "intl.h" +int plugin_is_GPL_compatible; /* Callback function to invoke after GCC finishes parsing a struct. */ diff --git a/gcc/testsuite/g++.dg/plugin/selfassign.c b/gcc/testsuite/g++.dg/plugin/selfassign.c index 2bc1d861358..75b6161b31d 100644 --- a/gcc/testsuite/g++.dg/plugin/selfassign.c +++ b/gcc/testsuite/g++.dg/plugin/selfassign.c @@ -14,6 +14,7 @@ #include "tree-pass.h" #include "intl.h" +int plugin_is_GPL_compatible; /* Indicate whether to check overloaded operator '=', which is performed by default. To disable it, use -fplugin-arg-NAME-no-check-operator-eq. */ diff --git a/gcc/testsuite/gcc.c-torture/execute/20090618-1.c b/gcc/testsuite/gcc.c-torture/execute/20090618-1.c new file mode 100644 index 00000000000..f522116eba1 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/20090618-1.c @@ -0,0 +1,21 @@ +extern void abort (void); + +struct X { int *p; int *q; }; + +int foo(void) +{ + int i = 0, j = 1; + struct X x, y; + int **p; + y.p = &i; + x.q = &j; + p = __builtin_mempcpy (&x, &y, sizeof (int *)); + return **p; +} + +int main() +{ + if (foo() != 1) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/unsorted/dump-noaddr.x b/gcc/testsuite/gcc.c-torture/unsorted/dump-noaddr.x index 6e066c6e8c9..1655b382885 100644 --- a/gcc/testsuite/gcc.c-torture/unsorted/dump-noaddr.x +++ b/gcc/testsuite/gcc.c-torture/unsorted/dump-noaddr.x @@ -2,28 +2,19 @@ proc dump_compare { src options } { global srcdir subdir global tmpdir - - exec echo $src - + global torture_with_loops set option_list $torture_with_loops - set dumpbase dump-noaddr - # ??? passing -dumpbase to the gcc driver doesn't work, since it will pass - # another -dumpbase option to override it. + set dumpbase dump-noaddr.c + # loop through all the options foreach option $option_list { -# c-torture-compile ${dumpbase}_1 "$option $options -DMASK=1 -x c -da -fdump-tree-all" -# c-torture-compile ${dumpbase}_2 "$option $options -DMASK=2 -x c -da -fdump-tree-all" -# c-torture-compile ${dumpbase}_3 "$option $options -DMASK=3 -x c -da -fdump-tree-all" file delete -force dump1 - file delete -force dump2 file mkdir dump1 + c-torture-compile $src "$option $options --dumpbase=dump1/$dumpbase -DMASK=1 -x c --param ggc-min-heapsize=1 -fdump-rtl-all -fdump-tree-all -fdump-noaddr" + file delete -force dump2 file mkdir dump2 - cd dump1 - c-torture-compile $src "$option $options -DMASK=1 -x c --param ggc-min-heapsize=1 -da -fdump-tree-all -fdump-noaddr" - cd ../dump2 - c-torture-compile $src "$option $options -DMASK=2 -x c -da -fdump-tree-all -fdump-noaddr" - cd .. + c-torture-compile $src "$option $options --dumpbase=dump2/$dumpbase -DMASK=2 -x c -fdump-rtl-all -fdump-tree-all -fdump-noaddr" foreach dump1 [lsort [glob -nocomplain dump1/*]] { regsub dump1/ $dump1 dump2/ dump2 set dumptail "gcc.c-torture/unsorted/[file tail $dump1]" diff --git a/gcc/testsuite/gcc.dg/20080522-1.c b/gcc/testsuite/gcc.dg/20080522-1.c deleted file mode 100644 index e2598439b79..00000000000 --- a/gcc/testsuite/gcc.dg/20080522-1.c +++ /dev/null @@ -1,20 +0,0 @@ -/* { dg-do compile } -/* { dg-options "-O2 -fsee" } */ - -int f(const char* ptr, int bar) { - return (((const char *)0 - ptr ) & (bar - 1)) == 0; -} - - -int g(const char* ptr, const char *test, int N, int bar) { - if (N == 0) { - } - else if (N > 0) { - int count = 0; - while ( count < N) { - if (!f(ptr, bar)) - count++; - } - } - return f(test, bar) ; -} diff --git a/gcc/testsuite/gcc.dg/20080528-1.c b/gcc/testsuite/gcc.dg/20080528-1.c deleted file mode 100644 index 9fe978051eb..00000000000 --- a/gcc/testsuite/gcc.dg/20080528-1.c +++ /dev/null @@ -1,9 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-O2 -fsee" } */ - -unsigned long g(int a, int b) { - return a / b; -} -unsigned long f(long int a) { - return g(a, 1<<13); -} diff --git a/gcc/testsuite/gcc.dg/Wcxx-compat-15.c b/gcc/testsuite/gcc.dg/Wcxx-compat-15.c new file mode 100644 index 00000000000..82a76ec4d0f --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wcxx-compat-15.c @@ -0,0 +1,33 @@ +/* { dg-do compile } */ +/* { dg-options "-Wc++-compat" } */ + +typedef int myint1; +typedef int myint2; +typedef int myint3; +struct s1 +{ + myint1 myint1; /* { dg-warning "invalid in C\[+\]\[+\]" } */ + myint2 *myint2; /* { dg-warning "invalid in C\[+\]\[+\]" } */ + int myint3; + struct s2 + { + myint3 f2; /* { dg-warning "C\[+\]\[+\]" } */ + } f1; +}; + +struct s3 +{ + int myint1; + struct s4 + { + int myint1; + } f1; + struct s5 + { + int myint1; + struct s6 + { + myint1 f4; /* { dg-warning "C\[+\]\[+\]" } */ + } f3; + } f2; +}; diff --git a/gcc/testsuite/gcc.dg/Wcxx-compat-16.c b/gcc/testsuite/gcc.dg/Wcxx-compat-16.c new file mode 100644 index 00000000000..51b503bf607 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wcxx-compat-16.c @@ -0,0 +1,12 @@ +/* { dg-do compile } */ +/* { dg-options "-Wc++-compat" } */ + +struct { int f1; } g1; /* { dg-warning "C\[+\]\[+\]" } */ +static struct { int f2; } g2; +struct s { int f3; } g3; +union { int f4; } g4; /* { dg-warning "C\[+\]\[+\]" } */ +static union { int f5; } g5; +union u { int f6; } g6; +enum { A } g7; /* { dg-warning "C\[+\]\[+\]" } */ +static enum { B } g8; +enum E { C } g9; diff --git a/gcc/testsuite/gcc.dg/Wcxx-compat-17.c b/gcc/testsuite/gcc.dg/Wcxx-compat-17.c new file mode 100644 index 00000000000..78760d641ff --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wcxx-compat-17.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* { dg-options "-Wc++-compat" } */ +const int v1; /* { dg-warning "invalid in C\[+\]\[+\]" } */ +const char * const v2; /* { dg-warning "invalid in C\[+\]\[+\]" } */ +struct s { int f1; int f2; }; +const struct s v3; /* { dg-warning "invalid in C\[+\]\[+\]" } */ +const int v4 = 1; +const char * const v5 = 0; +const struct s v6 = { 0, 0 }; +const struct s v7 = { 0 }; +void +f() +{ + const int v11; /* { dg-warning "invalid in C\[+\]\[+\]" } */ + const char * const v12; /* { dg-warning "invalid in C\[+\]\[+\]" } */ + const struct s v13; /* { dg-warning "invalid in C\[+\]\[+\]" } */ + const int v14 = 1; + const char * const v15 = 0; + const struct s v16 = { 0, 0 }; + const struct s v17 = { 0 }; +} diff --git a/gcc/testsuite/gcc.dg/Wcxx-compat-18.c b/gcc/testsuite/gcc.dg/Wcxx-compat-18.c new file mode 100644 index 00000000000..9ae2d770a4c --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wcxx-compat-18.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-Wc++-compat" } */ +enum E1 { A }; +enum E2 { B }; +int +f1 (int i) +{ + return (int) (i ? A : B); /* { dg-warning "invalid in C\[+\]\[+\]" } */ +} +extern enum E1 f2(); +int +f3 (int i) +{ + return (int) (i ? f2 () : B); /* { dg-warning "invalid in C\[+\]\[+\]" } */ +} diff --git a/gcc/testsuite/gcc.dg/builtins-34.c b/gcc/testsuite/gcc.dg/builtins-34.c index ee8d7513f91..e348a1ca943 100644 --- a/gcc/testsuite/gcc.dg/builtins-34.c +++ b/gcc/testsuite/gcc.dg/builtins-34.c @@ -1,7 +1,6 @@ /* Copyright (C) 2004 Free Software Foundation. - Check that exp10, exp10f, exp10l, exp2, exp2f, exp2l, pow10, pow10f, - pow10l, expm1, expm1f and expm1l built-in functions compile. + Check that various built-in functions compile. Written by Uros Bizjak, 13th February 2004. */ @@ -16,6 +15,7 @@ extern double ldexp(double, int); extern double scalb(double, double); extern double scalbn(double, int); extern double scalbln(double, long); +extern double significand(double); extern float exp10f(float); extern float exp2f(float); extern float pow10f(float); @@ -24,6 +24,7 @@ extern float ldexpf(float, int); extern float scalbf(float, float); extern float scalbnf(float, int); extern float scalblnf(float, long); +extern float significandf(float); extern long double exp10l(long double); extern long double exp2l(long double); extern long double pow10l(long double); @@ -32,6 +33,7 @@ extern long double ldexpl(long double, int); extern long double scalbl(long double, long double); extern long double scalbnl(long double, int); extern long double scalblnl(long double, long); +extern long double significandl(long double); double test1(double x) @@ -74,6 +76,11 @@ double test8(double x, long exp) return scalbln(x, exp); } +double test9(double x) +{ + return significand(x); +} + float test1f(float x) { return exp10f(x); @@ -114,6 +121,11 @@ float test8f(float x, long exp) return scalblnf(x, exp); } +float test9f(float x) +{ + return significandf(x); +} + long double test1l(long double x) { return exp10l(x); @@ -153,3 +165,8 @@ long double test8l(long double x, long exp) { return scalblnl(x, exp); } + +long double test9l(long double x) +{ + return significandl(x); +} diff --git a/gcc/testsuite/gcc.dg/cpp/arith-3.c b/gcc/testsuite/gcc.dg/cpp/arith-3.c index 3015d31657a..2f94e981162 100644 --- a/gcc/testsuite/gcc.dg/cpp/arith-3.c +++ b/gcc/testsuite/gcc.dg/cpp/arith-3.c @@ -9,7 +9,7 @@ Please keep changes to arith-2.c and arith-3.c in sync. */ /* { dg-do preprocess } */ -/* { dg-options "-std=c99" } */ +/* { dg-options "-std=c99 -fshow-column" } */ #include <limits.h> @@ -274,7 +274,7 @@ # error /* { dg-bogus "error" } */ #endif -#if -5 / (2 - 2) /* { dg-error "division by zero" } */ +#if -5 / (2 - 2) /* { dg-error "13:division by zero" } */ #endif #if LONG_UDIVISION != LONG_UDIVISION_ANSWER @@ -286,7 +286,7 @@ #endif /* Binary %. Cannot overflow. */ -#if -5 % (2 - 2) /* { dg-error "division by zero" } */ +#if -5 % (2 - 2) /* { dg-error "13:division by zero" } */ #endif #if TARG_MIN % 1 /* { dg-bogus "overflow" } */ diff --git a/gcc/testsuite/gcc.dg/plugin/ggcplug.c b/gcc/testsuite/gcc.dg/plugin/ggcplug.c index f90e77bcf72..49b5c95e4e9 100644 --- a/gcc/testsuite/gcc.dg/plugin/ggcplug.c +++ b/gcc/testsuite/gcc.dg/plugin/ggcplug.c @@ -13,7 +13,7 @@ #include "intl.h" #include "gcc-plugin.h" - +int plugin_is_GPL_compatible; /* our callback is the same for all PLUGIN_GGC_START, PLUGIN_GGC_MARKING, PLUGIN_GGC_END events; it just increments the diff --git a/gcc/testsuite/gcc.dg/plugin/one_time_plugin.c b/gcc/testsuite/gcc.dg/plugin/one_time_plugin.c index 8ae327a68f9..635776fc5bc 100644 --- a/gcc/testsuite/gcc.dg/plugin/one_time_plugin.c +++ b/gcc/testsuite/gcc.dg/plugin/one_time_plugin.c @@ -9,6 +9,8 @@ #include "tree-pass.h" #include "intl.h" +int plugin_is_GPL_compatible; + static bool one_pass_gate (void) { return true; diff --git a/gcc/testsuite/gcc.dg/plugin/selfassign.c b/gcc/testsuite/gcc.dg/plugin/selfassign.c index 2bc1d861358..52a03bfef3c 100644 --- a/gcc/testsuite/gcc.dg/plugin/selfassign.c +++ b/gcc/testsuite/gcc.dg/plugin/selfassign.c @@ -15,6 +15,8 @@ #include "intl.h" +int plugin_is_GPL_compatible; + /* Indicate whether to check overloaded operator '=', which is performed by default. To disable it, use -fplugin-arg-NAME-no-check-operator-eq. */ bool check_operator_eq = true; diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-compile-assign.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-compile-assign.c new file mode 100644 index 00000000000..d6143d27881 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-compile-assign.c @@ -0,0 +1,29 @@ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Test basic assignments and conversions for __fp16. */ + +__fp16 h0 = -1.0; +__fp16 h1 = 0.0; +__fp16 h2 = 1234.0; +__fp16 h3 = 42.0; +float f1 = 2.0; +float f2 = -999.9; + +void f (__fp16 *p) +{ + __fp16 t; + + h0 = 1.0; + h1 = h2; + h2 = f1; + f2 = h2; + + t = *p; + *p = h3; + h3 = t; +} + +/* Make sure we are not falling through to undefined libcalls. */ +/* { dg-final { scan-assembler-not "__truncsfhf" } } */ +/* { dg-final { scan-assembler-not "__extendhfsf" } } */ diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-compile-convert.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-compile-convert.c new file mode 100644 index 00000000000..04341959f4f --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-compile-convert.c @@ -0,0 +1,41 @@ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Test basic assignments and conversions for __fp16. */ + +__fp16 h1 = 0.0; +__fp16 h2 = 1234.0; +char c1 = 1; +char c2 = 2; +short s1 = 10; +short s2 = 20; +int i1 = -100; +int i2 = -200; +long long l1 = 1000.0; +long long l2 = 2000.0; +double d1 = -10000.0; +double d2 = -20000.0; + +void f (void) +{ + c1 = h1; + h2 = c2; + + h1 = s1; + s2 = h2; + + i1 = h1; + h2 = i2; + + h1 = l1; + l2 = h2; + + d1 = h1; + h2 = d2; +} + +/* Make sure we are not falling through to undefined libcalls. */ +/* { dg-final { scan-assembler-not "__float.ihf" } } */ +/* { dg-final { scan-assembler-not "__fixhf.i" } } */ +/* { dg-final { scan-assembler-not "__trunc.fhf" } } */ +/* { dg-final { scan-assembler-not "__extendhf.f" } } */ diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-int-convert-alt.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-int-convert-alt.c new file mode 100644 index 00000000000..bcd7aeff19e --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-int-convert-alt.c @@ -0,0 +1,17 @@ +/* Test floating-point conversions. Standard types and __fp16. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=alternative" } */ + +#include "fp-int-convert.h" +#define FP16_MANT_DIG 11 + +int +main (void) +{ + TEST_I_F(signed char, unsigned char, float, FP16_MANT_DIG); + TEST_I_F(signed short, unsigned short, float, FP16_MANT_DIG); + TEST_I_F(signed int, unsigned int, float, FP16_MANT_DIG); + TEST_I_F(signed long, unsigned long, float, FP16_MANT_DIG); + TEST_I_F(signed long long, unsigned long long, float, FP16_MANT_DIG); + exit (0); +} diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-int-convert-ieee.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-int-convert-ieee.c new file mode 100644 index 00000000000..1314d4b0e6d --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-int-convert-ieee.c @@ -0,0 +1,17 @@ +/* Test floating-point conversions. Standard types and __fp16. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +#include "fp-int-convert.h" +#define FP16_MANT_DIG 11 + +int +main (void) +{ + TEST_I_F(signed char, unsigned char, float, FP16_MANT_DIG); + TEST_I_F(signed short, unsigned short, float, FP16_MANT_DIG); + TEST_I_F(signed int, unsigned int, float, FP16_MANT_DIG); + TEST_I_F(signed long, unsigned long, float, FP16_MANT_DIG); + TEST_I_F(signed long long, unsigned long long, float, FP16_MANT_DIG); + exit (0); +} diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-1.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-1.c new file mode 100644 index 00000000000..0c601e68c41 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-1.c @@ -0,0 +1,5 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee" } */ + +#include "arm-fp16-ops.h" diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-2.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-2.c new file mode 100644 index 00000000000..244e31082f9 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-2.c @@ -0,0 +1,5 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=ieee -ffast-math" } */ + +#include "arm-fp16-ops.h" diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-3.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-3.c new file mode 100644 index 00000000000..8f9ab64bc45 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-3.c @@ -0,0 +1,5 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=alternative" } */ + +#include "arm-fp16-ops.h" diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-4.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-4.c new file mode 100644 index 00000000000..4877f392c06 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-4.c @@ -0,0 +1,5 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do run { target arm*-*-* } } */ +/* { dg-options "-mfp16-format=alternative -ffast-math" } */ + +#include "arm-fp16-ops.h" diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-5.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-5.c new file mode 100644 index 00000000000..6bc4cf6ea65 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-5.c @@ -0,0 +1,14 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -mfpu=neon-fp16 -mfloat-abi=softfp" } */ + +#include "arm-fp16-ops.h" + +/* We've specified options for hardware float, including fp16 support, so + we should not see any calls to libfuncs here. */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf2" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf3" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h\[a-z\]*_ieee" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h2f_ieee" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_f2h_ieee" } } */ diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-6.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-6.c new file mode 100644 index 00000000000..9401a5935c3 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-6.c @@ -0,0 +1,14 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -ffast-math -mfpu=neon-fp16 -mfloat-abi=softfp" } */ + +#include "arm-fp16-ops.h" + +/* We've specified options for hardware float, including fp16 support, so + we should not see any calls to libfuncs here. */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf2" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf3" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h\[a-z\]*_ieee" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h2f_ieee" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_f2h_ieee" } } */ diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-7.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-7.c new file mode 100644 index 00000000000..debc193df93 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-7.c @@ -0,0 +1,12 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -mfpu=neon -mfloat-abi=softfp" } */ + +#include "arm-fp16-ops.h" + +/* We've specified options for hardware float, so we should not see any + calls to libfuncs here except for those to the conversion functions. */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf2" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf3" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h\[a-z\]*_ieee" } } */ diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-8.c b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-8.c new file mode 100644 index 00000000000..a6e72388a1c --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops-8.c @@ -0,0 +1,12 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ +/* { dg-do compile { target arm*-*-* } } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -ffast-math -mfpu=neon -mfloat-abi=softfp" } */ + +#include "arm-fp16-ops.h" + +/* We've specified options for hardware float, so we should not see any + calls to libfuncs here except for those to the conversion functions. */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf2" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__.*hf3" } } */ +/* { dg-final { scan-assembler-not "\tbl\t__gnu_h\[a-z\]*_ieee" } } */ diff --git a/gcc/testsuite/gcc.dg/torture/arm-fp16-ops.h b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops.h new file mode 100644 index 00000000000..320494ee71c --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/arm-fp16-ops.h @@ -0,0 +1,135 @@ +/* Test various operators on __fp16 and mixed __fp16/float operands. */ + +#include <assert.h> + +#define CHECK(e,r) assert ((e) == r) +#define CHECK2(e,r) (assert ((e) == r), temp = (e), assert (temp == r)) +#define TEST(e) assert (e) +#define TESTNOT(e) assert (!(e)) + +volatile __fp16 h0 = 0.0; +volatile __fp16 h1 = 1.0; +volatile __fp16 h42 = 42.0; +volatile __fp16 hm2 = -2.0; +volatile __fp16 temp; + +volatile float f0 = 0.0; +volatile float f1 = 1.0; +volatile float f42 = 42.0; +volatile float fm2 = -2.0; + +int main (void) +{ + TEST (h1); + TESTNOT (h0); + TEST (!h0); + TESTNOT (!h1); + + CHECK2 (-h1, -1.0); + CHECK2 (+h1, 1.0); + + CHECK (h1++, 1.0); + CHECK (h1, 2.0); + CHECK (++h1, 3.0); + CHECK (h1, 3.0); + + CHECK (--h1, 2.0); + CHECK (h1, 2.0); + CHECK (h1--, 2.0); + CHECK (h1, 1.0); + + CHECK2 (h42 * hm2, -84.0); + CHECK2 (h42 * (__fp16) -2.0, -84.0); + CHECK2 (h42 * fm2, -84.0); + CHECK2 (f42 * hm2, -84.0); + + CHECK2 (h42 / hm2, -21.0); + CHECK2 (h42 / (__fp16) -2.0, -21.0); + CHECK2 (h42 / fm2, -21.0); + CHECK2 (f42 / hm2, -21.0); + + CHECK2 (hm2 + h42, 40.0); + CHECK2 ((__fp16)-2.0 + h42, 40.0); + CHECK2 (hm2 + f42, 40.0); + CHECK2 (fm2 + h42, 40.0); + + CHECK2 (hm2 - h42, -44.0); + CHECK2 ((__fp16)-2.0 - h42, -44.0); + CHECK2 (hm2 - f42, -44.0); + CHECK2 (fm2 - h42, -44.0); + + TEST (hm2 < h42); + TEST (hm2 < (__fp16)42.0); + TEST (hm2 < f42); + TEST (fm2 < h42); + + TEST (h42 > hm2); + TEST ((__fp16)42.0 > hm2); + TEST (h42 > fm2); + TEST (f42 > hm2); + + TEST (hm2 <= h42); + TEST (hm2 <= (__fp16)42.0); + TEST (hm2 <= f42); + TEST (fm2 <= h42); + + TEST (h42 >= hm2); + TEST (h42 >= (__fp16)-2.0); + TEST (h42 >= fm2); + TEST (f42 >= hm2); + + TESTNOT (h1 == hm2); + TEST (h1 == h1); + TEST (h1 == (__fp16)1.0); + TEST (h1 == f1); + TEST (f1 == h1); + + TEST (h1 != hm2); + TESTNOT (h1 != h1); + TESTNOT (h1 != (__fp16)1.0); + TESTNOT (h1 != f1); + TESTNOT (f1 != h1); + + CHECK2 ((h1 ? hm2 : h42), -2.0); + CHECK2 ((h0 ? hm2 : h42), 42.0); + + CHECK (h0 = h42, 42.0); + CHECK (h0, 42.0); + CHECK (h0 = (__fp16)-2.0, -2.0); + CHECK (h0, -2.0); + CHECK (h0 = f0, 0.0); + CHECK (h0, 0.0); + + CHECK (h0 += h1, 1.0); + CHECK (h0, 1.0); + CHECK (h0 += (__fp16)1.0, 2.0); + CHECK (h0, 2.0); + CHECK (h0 += fm2, 0.0); + CHECK (h0, 0.0); + + CHECK (h0 -= h1, -1.0); + CHECK (h0, -1.0); + CHECK (h0 -= (__fp16)1.0, -2.0); + CHECK (h0, -2.0); + CHECK (h0 -= fm2, 0.0); + CHECK (h0, 0.0); + + h0 = hm2; + CHECK (h0 *= hm2, 4.0); + CHECK (h0, 4.0); + CHECK (h0 *= (__fp16)-2.0, -8.0); + CHECK (h0, -8.0); + CHECK (h0 *= fm2, 16.0); + CHECK (h0, 16.0); + + CHECK (h0 /= hm2, -8.0); + CHECK (h0, -8.0); + CHECK (h0 /= (__fp16)-2.0, 4.0); + CHECK (h0, 4.0); + CHECK (h0 /= fm2, -2.0); + CHECK (h0, -2.0); + + CHECK ((h0, h1), 1.0); + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr40470-1.c b/gcc/testsuite/gcc.dg/torture/pr40470-1.c new file mode 100644 index 00000000000..cb2510e883b --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr40470-1.c @@ -0,0 +1,22 @@ +/* { dg-do compile { target i?86-*-* x86_64-*-* } } */ +/* { dg-options "-msse4" } */ +#include <nmmintrin.h> +__m128i load (char *); +char * +foo (char *p1, char *p2, + int bmsk, __m128i mask1, __m128i mask2) +{ + int len = 0; + __m128i frag1, frag2; + int cmp_s; + if( !p2[0]) return p1; + if( !p1[0] ) return NULL; + frag2 = load (p2); + frag1 = load (p1); + frag2 = _mm_blendv_epi8(frag2, mask2, mask1); + frag1 = _mm_blendv_epi8(frag1, mask2, mask1); + cmp_s = _mm_cmpistrs(frag2, frag1, 0x0c); + if( cmp_s ) + __asm("bsfl %[bmsk], %[len]" : [len] "=r" (len) : [bmsk] "r" (bmsk) ); + return p1 + len; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr40470-2.c b/gcc/testsuite/gcc.dg/torture/pr40470-2.c new file mode 100644 index 00000000000..b0414bbea91 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr40470-2.c @@ -0,0 +1,27 @@ +/* { dg-do compile { target i?86-*-* x86_64-*-* } } */ +/* { dg-options "-msse4" } */ +#include <nmmintrin.h> +__m128i load (char *); +char * +foo (const unsigned char *s1, const unsigned char *s2, + int bmsk, __m128i frag2) +{ + int len = 0; + char *p1 = (char *) s1; + char *p2 = (char *) s2; + __m128i frag1, fruc, mask; + int cmp_c, cmp_s; + if( !p2[0]) return (char *) s1; + if( !p1[0] ) return NULL; + if( p2[1]) frag2 = load (p2); + frag1 = load (p1); + fruc = _mm_loadu_si128 ((__m128i *) s1); + mask = _mm_cmpistrm(fruc, frag2, 0x44); + frag2 = _mm_blendv_epi8(frag2, mask, mask); + frag1 = _mm_blendv_epi8(frag1, mask, mask); + cmp_c = _mm_cmpistrc(frag2, frag1, 0x0c); + cmp_s = _mm_cmpistrs(frag2, frag1, 0x0c); + if( cmp_s & cmp_c ) + __asm("bsfl %[bmsk], %[len]" : [len] "=r" (len) : [bmsk] "r" (bmsk) ); + return p2 + len; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr40470-3.c b/gcc/testsuite/gcc.dg/torture/pr40470-3.c new file mode 100644 index 00000000000..5c4c361de55 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr40470-3.c @@ -0,0 +1,22 @@ +/* { dg-do compile { target i?86-*-* x86_64-*-* } } */ +/* { dg-options "-msse4" } */ +#include <nmmintrin.h> +__m128i load (char *); +char * +foo (char *p1, char *p2, + int bmsk, __m128i mask1, __m128i mask2) +{ + int len = 0; + __m128i frag1, frag2; + int cmp_s; + if( !p2[0]) return p1; + if( !p1[0] ) return NULL; + frag2 = load (p2); + frag1 = load (p1); + frag2 = _mm_blendv_epi8(frag2, mask2, mask1); + frag1 = _mm_blendv_epi8(frag1, mask1, mask2); + cmp_s = _mm_cmpistrs(frag2, frag1, 0x0c); + if( cmp_s ) + __asm("bsfl %[bmsk], %[len]" : [len] "=r" (len) : [bmsk] "r" (bmsk) ); + return p1 + len; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr40470-4.c b/gcc/testsuite/gcc.dg/torture/pr40470-4.c new file mode 100644 index 00000000000..f9d0e509500 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr40470-4.c @@ -0,0 +1,29 @@ +/* { dg-do compile { target i?86-*-* x86_64-*-* } } */ +/* { dg-options "-msse4" } */ +#include <nmmintrin.h> +__m128i load (char *); +char * +foo (const unsigned char *s1, const unsigned char *s2, + int bmsk, __m128i frag2) +{ + int len = 0; + char *p1 = (char *) s1; + char *p2 = (char *) s2; + __m128i frag1, fruc1, fruc2, mask1, mask2; + int cmp_c, cmp_s; + if( !p2[0]) return (char *) s1; + if( !p1[0] ) return NULL; + if( p2[1]) frag2 = load (p2); + frag1 = load (p1); + fruc1 = _mm_loadu_si128 ((__m128i *) s1); + fruc2 = _mm_loadu_si128 ((__m128i *) s2); + mask1 = _mm_cmpistrm(fruc1, frag2, 0x44); + mask2 = _mm_cmpistrm(fruc2, frag1, 0x14); + frag2 = _mm_blendv_epi8(frag2, mask1, mask2); + frag1 = _mm_blendv_epi8(frag1, mask2, mask1); + cmp_c = _mm_cmpistrc(frag2, frag1, 0x0c); + cmp_s = _mm_cmpistrs(frag2, frag1, 0x0c); + if( cmp_s & cmp_c ) + __asm("bsfl %[bmsk], %[len]" : [len] "=r" (len) : [bmsk] "r" (bmsk) ); + return p2 + len; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/fre-vce-1.c b/gcc/testsuite/gcc.dg/tree-ssa/fre-vce-1.c index f8c12c8d6c5..2bc6da33235 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/fre-vce-1.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/fre-vce-1.c @@ -33,3 +33,5 @@ void a2 (struct s1 sv, int i) /* { dg-final { scan-tree-dump-times "sv_\[0-9\]\\\(D\\\)->i" 2 "fre" } } */ /* { dg-final { scan-tree-dump-times "sv.i" 2 "fre" } } */ + +/* { dg-final { cleanup-tree-dump "fre" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-42.c b/gcc/testsuite/gcc.dg/vect/vect-42.c index 482a333d1ef..ebed418e338 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-42.c +++ b/gcc/testsuite/gcc.dg/vect/vect-42.c @@ -63,7 +63,8 @@ int main (void) } /* { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" } } */ -/* { dg-final { scan-tree-dump-times "Alignment of access forced using versioning" 3 "vect" { target { vect_no_align || { { ! vector_alignment_reachable} && {!vect_hw_misalign} } } } } } */ +/* { dg-final { scan-tree-dump-times "Alignment of access forced using versioning" 3 "vect" { target vect_no_align } } } */ +/* { dg-final { scan-tree-dump-times "Alignment of access forced using versioning" 1 "vect" { target { { ! vector_alignment_reachable } && { ! vect_hw_misalign } } } } } */ /* { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 4 "vect" { xfail { { vect_no_align || vect_hw_misalign } || { ! vector_alignment_reachable } } } } } */ /* { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 1 "vect" { xfail { { vect_no_align || vect_hw_misalign } || { ! vector_alignment_reachable } } } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-50.c b/gcc/testsuite/gcc.dg/vect/vect-50.c index f247679a989..70b683e1a9d 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-50.c +++ b/gcc/testsuite/gcc.dg/vect/vect-50.c @@ -65,5 +65,5 @@ int main (void) /* { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 3 "vect" { target vect_hw_misalign } } } */ /* { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 1 "vect" { xfail { { vect_no_align || vect_hw_misalign } || {! vector_alignment_reachable} } } } } */ /* { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 3 "vect" { target vect_no_align } } } */ -/* { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 1 "vect" { target { {! vector_alignment_reachable} && {!vect_no_align && !vect_hw_misalign} } } } } */ +/* { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 1 "vect" { target { {! vector_alignment_reachable} && { {! vect_no_align } && {! vect_hw_misalign } } } } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-96.c b/gcc/testsuite/gcc.dg/vect/vect-96.c index 1a6feca71cf..219c82b0897 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-96.c +++ b/gcc/testsuite/gcc.dg/vect/vect-96.c @@ -45,5 +45,5 @@ int main (void) /* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } } */ /* { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 1 "vect" { target { {! vect_no_align} && vector_alignment_reachable } } } } */ /* { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 1 "vect" { xfail { { vect_no_align || vect_hw_misalign } || {! vector_alignment_reachable} } } } } */ -/* { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 1 "vect" { target { vect_no_align || { {! vector_alignment_reachable} && {!vect_hw_misalign} } } } } } */ +/* { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 1 "vect" { target { vect_no_align || { {! vector_alignment_reachable} && {! vect_hw_misalign} } } } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-nest-cycle-1.c b/gcc/testsuite/gcc.dg/vect/vect-nest-cycle-1.c index 0cf2ca06d14..84883ca191e 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-nest-cycle-1.c +++ b/gcc/testsuite/gcc.dg/vect/vect-nest-cycle-1.c @@ -43,6 +43,6 @@ int main () return 0; } -/* { dg-final { scan-tree-dump-times "OUTER LOOP VECTORIZED" 1 "vect" } } */ +/* { dg-final { scan-tree-dump-times "OUTER LOOP VECTORIZED" 1 "vect" { xfail vect_no_align } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-nest-cycle-2.c b/gcc/testsuite/gcc.dg/vect/vect-nest-cycle-2.c index fd63a785d00..3237d22a9fa 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-nest-cycle-2.c +++ b/gcc/testsuite/gcc.dg/vect/vect-nest-cycle-2.c @@ -43,6 +43,6 @@ int main () return 0; } -/* { dg-final { scan-tree-dump-times "OUTER LOOP VECTORIZED" 1 "vect" } } */ +/* { dg-final { scan-tree-dump-times "OUTER LOOP VECTORIZED" 1 "vect" { xfail vect_no_align } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-shift-2.c b/gcc/testsuite/gcc.dg/vect/vect-shift-2.c index 93e1154fb42..641fe1ab434 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-shift-2.c +++ b/gcc/testsuite/gcc.dg/vect/vect-shift-2.c @@ -187,3 +187,5 @@ int main () TRACE_DONE (); return 0; } + +/* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect.exp b/gcc/testsuite/gcc.dg/vect/vect.exp index 42435eb3130..ea314ea3ac8 100644 --- a/gcc/testsuite/gcc.dg/vect/vect.exp +++ b/gcc/testsuite/gcc.dg/vect/vect.exp @@ -121,8 +121,9 @@ lappend DEFAULT_VECTCFLAGS "-O2" dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/nodump-*.\[cS\]]] \ "" $DEFAULT_VECTCFLAGS -lappend DEFAULT_VECTCFLAGS "-fdump-tree-vect-details" set VECT_SLP_CFLAGS $DEFAULT_VECTCFLAGS + +lappend DEFAULT_VECTCFLAGS "-fdump-tree-vect-details" lappend VECT_SLP_CFLAGS "-fdump-tree-slp-details" # Main loop. diff --git a/gcc/testsuite/gcc.target/arm/fp16-builtins-1.c b/gcc/testsuite/gcc.target/arm/fp16-builtins-1.c new file mode 100644 index 00000000000..868768028cd --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-builtins-1.c @@ -0,0 +1,92 @@ +/* Test type-generic builtins with __fp16 arguments. + Except as otherwise noted, they should behave exactly + the same as those with float arguments. */ + +/* { dg-do run } */ +/* { dg-options "-mfp16-format=ieee -std=gnu99" } */ + +#include <stdlib.h> +#include <math.h> + +volatile __fp16 h1, h2; +volatile float f1, f2; + +void +set1 (double x) +{ + h1 = x; + f1 = h1; +} + +void +set2 (double x, double y) +{ + h1 = x; + f1 = h1; + h2 = y; + f2 = h2; +} + +#define test1(p,x) \ + set1 (x); \ + hp = (p (h1) ? 1 : 0); \ + fp = (p (f1) ? 1 : 0); \ + if (hp ^ fp) abort () + +#define test2(p,x,y) \ + set2 (x,y); \ + hp = (p (h1, h2) ? 1 : 0); \ + fp = (p (f1, f2) ? 1 : 0); \ + if (hp ^ fp) abort () + +int +main (void) +{ + int hp, fp; + + test1 (__builtin_isfinite, 17.0); + test1 (__builtin_isfinite, INFINITY); + test1 (__builtin_isinf, -0.5); + test1 (__builtin_isinf, INFINITY); + test1 (__builtin_isnan, 493.0); + test1 (__builtin_isnan, NAN); + test1 (__builtin_isnormal, 3.14159); + + test2 (__builtin_isgreater, 5.0, 3.0); + test2 (__builtin_isgreater, 3.0, 5.0); + test2 (__builtin_isgreater, 73.5, 73.5); + test2 (__builtin_isgreater, 1.0, NAN); + + test2 (__builtin_isgreaterequal, 5.0, 3.0); + test2 (__builtin_isgreaterequal, 3.0, 5.0); + test2 (__builtin_isgreaterequal, 73.5, 73.5); + test2 (__builtin_isgreaterequal, 1.0, NAN); + + test2 (__builtin_isless, 5.0, 3.0); + test2 (__builtin_isless, 3.0, 5.0); + test2 (__builtin_isless, 73.5, 73.5); + test2 (__builtin_isless, 1.0, NAN); + + test2 (__builtin_islessequal, 5.0, 3.0); + test2 (__builtin_islessequal, 3.0, 5.0); + test2 (__builtin_islessequal, 73.5, 73.5); + test2 (__builtin_islessequal, 1.0, NAN); + + test2 (__builtin_islessgreater, 5.0, 3.0); + test2 (__builtin_islessgreater, 3.0, 5.0); + test2 (__builtin_islessgreater, 73.5, 73.5); + test2 (__builtin_islessgreater, 1.0, NAN); + + test2 (__builtin_isunordered, 5.0, 3.0); + test2 (__builtin_isunordered, 3.0, 5.0); + test2 (__builtin_isunordered, 73.5, 73.5); + test2 (__builtin_isunordered, 1.0, NAN); + + /* Test that __builtin_isnormal recognizes a denormalized __fp16 value, + even if it's representable as a normalized float. */ + h1 = 5.96046E-8; + if (__builtin_isnormal (h1)) + abort (); + + return 0; +} diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-1.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-1.c new file mode 100644 index 00000000000..3abcd947a6f --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-1.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +__fp16 xx = 0.0; + +/* { dg-final { scan-assembler "\t.eabi_attribute 38, 2" } } */ +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.space\t2" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-10.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-10.c new file mode 100644 index 00000000000..2e3d31fdf07 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-10.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative -pedantic -std=gnu99" } */ + +#include <math.h> + +/* NaNs are not representable in the alternative format; we should get a + diagnostic. */ +__fp16 xx = NAN; /* { dg-warning "overflow" } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-11.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-11.c new file mode 100644 index 00000000000..62a7a3df5ff --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-11.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative -pedantic -std=gnu99" } */ + +#include <math.h> + +/* Infinities are not representable in the alternative format; + we should get a diagnostic, and the value set to the largest + representable value. */ +/* 0x7fff = 32767 */ +__fp16 xx = INFINITY; /* { dg-warning "overflow" } */ + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t32767" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-12.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-12.c new file mode 100644 index 00000000000..09586e9b8fc --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-12.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +float xx __attribute__((mode(HF))) = 0.0; + +/* { dg-final { scan-assembler "\t.eabi_attribute 38, 2" } } */ +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.space\t2" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-2.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-2.c new file mode 100644 index 00000000000..b7fe99d5370 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-2.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* 0x3c00 = 15360 */ +__fp16 xx = 1.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t15360" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-3.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-3.c new file mode 100644 index 00000000000..f325a84fe77 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-3.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* 0xc000 = 49152 */ +__fp16 xx = -2.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t49152" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-4.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-4.c new file mode 100644 index 00000000000..4b9b3311732 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-4.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* 0x7bff = 31743 */ +__fp16 xx = 65504.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t31743" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-5.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-5.c new file mode 100644 index 00000000000..458f5073b3f --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-5.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* 0x3555 = 13653 */ +__fp16 xx = (1.0/3.0); + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t13653" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-6.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-6.c new file mode 100644 index 00000000000..dbb4a999924 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-6.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +/* This number is the maximum value representable in the alternative + encoding. */ +/* 0x7fff = 32767 */ +__fp16 xx = 131008.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t32767" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-7.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-7.c new file mode 100644 index 00000000000..40940a63421 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-7.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative -pedantic" } */ + +/* This number overflows the range of the alternative encoding. Since this + encoding doesn't have infinities, we should get a pedantic warning, + and the value should be set to the largest representable value. */ +/* 0x7fff = 32767 */ +__fp16 xx = 123456789.0; /* { dg-warning "overflow" } */ + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t32767" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-8.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-8.c new file mode 100644 index 00000000000..cbc0a3947e2 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-8.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* This is the minimum normalized value. */ +/* 0x0400 = 1024 */ +__fp16 xx = 6.10352E-5; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t1024" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-alt-9.c b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-9.c new file mode 100644 index 00000000000..6487c8d67dd --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-alt-9.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=alternative" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* This is the minimum denormalized value. */ +/* 0x0001 = 1 */ +__fp16 xx = 5.96046E-8; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t1" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-exprtype.c b/gcc/testsuite/gcc.target/arm/fp16-compile-exprtype.c new file mode 100644 index 00000000000..1d8953b489a --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-exprtype.c @@ -0,0 +1,29 @@ +/* Test that expressions involving __fp16 values have the right types. */ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* This produces a diagnostic if EXPR doesn't have type TYPE. */ +#define CHECK(expr,type) \ + do { \ + type v; \ + __typeof (expr) *p = &v; \ + } while (0); + +volatile __fp16 f1; +volatile __fp16 f2; + +int +main (void) +{ + CHECK (f1, __fp16); + CHECK (+f1, float); + CHECK (-f1, float); + CHECK (f1+f2, float); + CHECK ((__fp16)(f1+f2), __fp16); + CHECK ((__fp16)99.99, __fp16); + CHECK ((f1+f2, f1), __fp16); +} + + + + diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-1.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-1.c new file mode 100644 index 00000000000..d5d0ba2e4fb --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-1.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +__fp16 xx = 0.0; + +/* { dg-final { scan-assembler "\t.eabi_attribute 38, 1" } } */ +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.space\t2" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-10.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-10.c new file mode 100644 index 00000000000..51604374e36 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-10.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee -std=gnu99" } */ + +#include <math.h> + +/* 0x7e00 = 32256 */ +__fp16 xx = NAN; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t32256" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-11.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-11.c new file mode 100644 index 00000000000..afab518b9c7 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-11.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee -std=gnu99" } */ + +#include <math.h> + +/* 0x7c00 = 31744 */ +__fp16 xx = INFINITY; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t31744" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-12.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-12.c new file mode 100644 index 00000000000..244c96ffd37 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-12.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +float xx __attribute__((mode(HF))) = 0.0; + +/* { dg-final { scan-assembler "\t.eabi_attribute 38, 1" } } */ +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.space\t2" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-2.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-2.c new file mode 100644 index 00000000000..35f2031c719 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-2.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* 0x3c00 = 15360 */ +__fp16 xx = 1.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t15360" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-3.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-3.c new file mode 100644 index 00000000000..90edd01198a --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-3.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* 0xc000 = 49152 */ +__fp16 xx = -2.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t49152" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-4.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-4.c new file mode 100644 index 00000000000..20676d89db5 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-4.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* 0x7bff = 31743 */ +__fp16 xx = 65504.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t31743" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-5.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-5.c new file mode 100644 index 00000000000..aff9e1356d6 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-5.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* 0x3555 = 13653 */ +__fp16 xx = (1.0/3.0); + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t13653" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-6.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-6.c new file mode 100644 index 00000000000..c736e63a3ce --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-6.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* This number is too big and is represented as infinity. */ +/* 0x7c00 = 31744 */ +__fp16 xx = 131008.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t31744" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-7.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-7.c new file mode 100644 index 00000000000..93163772bbb --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-7.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee -pedantic" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* This number is too big and is represented as infinity. */ +/* We should *not* get an overflow warning here. */ +/* 0x7c00 = 31744 */ +__fp16 xx = 123456789.0; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t31744" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-8.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-8.c new file mode 100644 index 00000000000..a9646739f91 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-8.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* This is the minimum normalized value. */ +/* 0x0400 = 1024 */ +__fp16 xx = 6.10352E-5; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t1024" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-9.c b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-9.c new file mode 100644 index 00000000000..11b31ce4044 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-ieee-9.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Encoding taken from: http://en.wikipedia.org/wiki/Half_precision */ +/* This is the minimum denormalized value. */ +/* 0x0001 = 1 */ +__fp16 xx = 5.96046E-8; + +/* { dg-final { scan-assembler "\t.size\txx, 2" } } */ +/* { dg-final { scan-assembler "\t.short\t1" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-none-1.c b/gcc/testsuite/gcc.target/arm/fp16-compile-none-1.c new file mode 100644 index 00000000000..ca2912333c5 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-none-1.c @@ -0,0 +1,6 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=none" } */ + +/* __fp16 type name is not recognized unless you explicitly enable it + by selecting -mfp16-format=ieee or -mfp16-format=alternative. */ +__fp16 xx = 0.0; /* { dg-error "expected" } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-none-2.c b/gcc/testsuite/gcc.target/arm/fp16-compile-none-2.c new file mode 100644 index 00000000000..eb7eef5eaf2 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-none-2.c @@ -0,0 +1,7 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=none" } */ + +/* mode(HF) attributes are not recognized unless you explicitly enable + half-precision floating point by selecting -mfp16-format=ieee or + -mfp16-format=alternative. */ +float xx __attribute__((mode(HF))) = 0.0; /* { dg-error "HF" } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-compile-vcvt.c b/gcc/testsuite/gcc.target/arm/fp16-compile-vcvt.c new file mode 100644 index 00000000000..01d1e826923 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-compile-vcvt.c @@ -0,0 +1,19 @@ +/* { dg-do compile } */ +/* { dg-require-effective-target arm_neon_ok } */ +/* { dg-options "-mfp16-format=ieee -mfpu=neon-fp16 -mfloat-abi=softfp" } */ + +/* Test generation of VFP __fp16 instructions. */ + +__fp16 h1 = 0.0; +__fp16 h2 = 1234.0; +float f1 = 2.0; +float f2 = -999.9; + +void f (void) +{ + h1 = f1; + f2 = h2; +} + +/* { dg-final { scan-assembler "\tvcvtb.f32.f16" } } */ +/* { dg-final { scan-assembler "\tvcvtb.f16.f32" } } */ diff --git a/gcc/testsuite/gcc.target/arm/fp16-param-1.c b/gcc/testsuite/gcc.target/arm/fp16-param-1.c new file mode 100644 index 00000000000..af4845f9fd5 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-param-1.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Functions cannot have parameters of type __fp16. */ +extern void f (__fp16); /* { dg-error "parameters cannot have __fp16 type" } */ +extern void (*pf) (__fp16); /* { dg-error "parameters cannot have __fp16 type" } */ + +/* These should be OK. */ +extern void g (__fp16 *); +extern void (*pg) (__fp16 *); diff --git a/gcc/testsuite/gcc.target/arm/fp16-return-1.c b/gcc/testsuite/gcc.target/arm/fp16-return-1.c new file mode 100644 index 00000000000..f763941268a --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-return-1.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +/* Functions cannot return type __fp16. */ +extern __fp16 f (void); /* { dg-error "cannot return __fp16" } */ +extern __fp16 (*pf) (void); /* { dg-error "cannot return __fp16" } */ + +/* These should be OK. */ +extern __fp16 *g (void); +extern __fp16 *(*pg) (void); diff --git a/gcc/testsuite/gcc.target/arm/fp16-rounding-alt-1.c b/gcc/testsuite/gcc.target/arm/fp16-rounding-alt-1.c new file mode 100644 index 00000000000..f50b4475f19 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-rounding-alt-1.c @@ -0,0 +1,47 @@ +/* Test intermediate rounding of double to float and then to __fp16, using + an example of a number that would round differently if it went directly + from double to __fp16. */ + +/* { dg-do run } */ +/* { dg-options "-mfp16-format=alternative" } */ + +#include <stdlib.h> + +/* The original double value. */ +#define ORIG 0x1.0020008p0 + +/* The expected (double)((__fp16)((float)ORIG)) value. */ +#define ROUNDED 0x1.0000000p0 + +typedef union u { + __fp16 f; + unsigned short h; +} ufh; + +ufh s = { ORIG }; +ufh r = { ROUNDED }; + +double d = ORIG; + +int +main (void) +{ + ufh x; + + /* Test that the rounding is correct for static initializers. */ + if (s.h != r.h) + abort (); + + /* Test that the rounding is correct for a casted constant expression + not in a static initializer. */ + x.f = (__fp16)ORIG; + if (x.h != r.h) + abort (); + + /* Test that the rounding is correct for a runtime conversion. */ + x.f = (__fp16)d; + if (x.h != r.h) + abort (); + + return 0; +} diff --git a/gcc/testsuite/gcc.target/arm/fp16-rounding-ieee-1.c b/gcc/testsuite/gcc.target/arm/fp16-rounding-ieee-1.c new file mode 100644 index 00000000000..866d4d82403 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-rounding-ieee-1.c @@ -0,0 +1,47 @@ +/* Test intermediate rounding of double to float and then to __fp16, using + an example of a number that would round differently if it went directly + from double to __fp16. */ + +/* { dg-do run } */ +/* { dg-options "-mfp16-format=ieee" } */ + +#include <stdlib.h> + +/* The original double value. */ +#define ORIG 0x1.0020008p0 + +/* The expected (double)((__fp16)((float)ORIG)) value. */ +#define ROUNDED 0x1.0000000p0 + +typedef union u { + __fp16 f; + unsigned short h; +} ufh; + +ufh s = { ORIG }; +ufh r = { ROUNDED }; + +double d = ORIG; + +int +main (void) +{ + ufh x; + + /* Test that the rounding is correct for static initializers. */ + if (s.h != r.h) + abort (); + + /* Test that the rounding is correct for a casted constant expression + not in a static initializer. */ + x.f = (__fp16)ORIG; + if (x.h != r.h) + abort (); + + /* Test that the rounding is correct for a runtime conversion. */ + x.f = (__fp16)d; + if (x.h != r.h) + abort (); + + return 0; +} diff --git a/gcc/testsuite/gcc.target/arm/fp16-unprototyped-1.c b/gcc/testsuite/gcc.target/arm/fp16-unprototyped-1.c new file mode 100644 index 00000000000..70c29564888 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-unprototyped-1.c @@ -0,0 +1,21 @@ +/* Test promotion of __fp16 to double as arguments to unprototyped + function in another compilation unit. */ + +/* { dg-do run } */ +/* { dg-options "-mfp16-format=ieee" } */ +/* { dg-additional-sources "fp16-unprototyped-2.c" } */ + +#include <stdlib.h> + +extern int f (); + +static __fp16 x = 42.0; +static __fp16 y = -42.0; + +int +main (void) +{ + if (!f (x, y)) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.target/arm/fp16-unprototyped-2.c b/gcc/testsuite/gcc.target/arm/fp16-unprototyped-2.c new file mode 100644 index 00000000000..0c0f9cda6ba --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-unprototyped-2.c @@ -0,0 +1,12 @@ +/* { dg-do compile } */ +/* { dg-options "-mfp16-format=ieee" } */ + +extern int f (); + +int +f (double xx, double yy) +{ + if (xx == 42.0 && yy == -42.0) + return 1; + return 0; +} diff --git a/gcc/testsuite/gcc.target/arm/fp16-variadic-1.c b/gcc/testsuite/gcc.target/arm/fp16-variadic-1.c new file mode 100644 index 00000000000..52b438638a1 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/fp16-variadic-1.c @@ -0,0 +1,37 @@ +/* Test promotion of __fp16 to double as arguments to variadic function. */ + +/* { dg-do run } */ +/* { dg-options "-mfp16-format=ieee" } */ + +#include <stdlib.h> +#include <stdarg.h> + +extern int f (int n, ...); + +int +f (int n, ...) +{ + if (n == 2) + { + double xx, yy; + va_list ap; + va_start (ap, n); + xx = va_arg (ap, double); + yy = va_arg (ap, double); + va_end (ap); + if (xx == 42.0 && yy == -42.0) + return 1; + } + return 0; +} + +static __fp16 x = 42.0; +static __fp16 y = -42.0; + +int +main (void) +{ + if (!f (2, x, y)) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.target/arm/pr40482.c b/gcc/testsuite/gcc.target/arm/pr40482.c new file mode 100644 index 00000000000..4303a4f2e9e --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/pr40482.c @@ -0,0 +1,7 @@ +/* { dg-options "-mthumb -Os" } */ +/* { dg-final { scan-assembler-not "ldr" } } */ + +unsigned int foo (unsigned int i ) +{ + return i | 0xff000000; +} diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 new file mode 100644 index 00000000000..be61f2afbe6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! Tests the fix for PR40440, in which gfortran tried to deallocate +! the allocatable components of the actual argument of CALL SUB +! +! Contributed by Juergen Reuter <juergen.reuter@desy.de> +! Reduced testcase from Tobias Burnus <burnus@gcc.gnu.org> +! + implicit none + type t + integer, allocatable :: A(:) + end type t + type (t) :: arg + arg = t ([1,2,3]) + call sub (func (arg)) +contains + function func (a) + type(t), pointer :: func + type(t), target :: a + integer, save :: i = 0 + if (i /= 0) call abort ! multiple calls would cause this abort + i = i + 1 + func => a + end function func + subroutine sub (a) + type(t), intent(IN), target :: a + if (any (a%A .ne. [1,2,3])) call abort + end subroutine sub +end diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_9.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_9.f90 new file mode 100644 index 00000000000..89622e24967 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_9.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! +! PR fortran/40452 +! The following program is valid Fortran 90 and later. +! The storage-sequence association of the dummy argument +! allows that the actual argument ["ab", "cd"] is mapped +! to the dummy argument a(1) which perfectly fits. +! (The dummy needs to be an array, however.) +! + +program test + implicit none + call sub(["ab", "cd"]) +contains + subroutine sub(a) + character(len=4) :: a(1) + print *, a(1) + end subroutine sub +end program test diff --git a/gcc/testsuite/gfortran.dg/generic_18.f90 b/gcc/testsuite/gfortran.dg/generic_18.f90 new file mode 100644 index 00000000000..1e23838d712 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/generic_18.f90 @@ -0,0 +1,54 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR40443 in which the final call to the generic +! 'SpecElem' was resolved to the elemental rather than the specific +! procedure, which is required by the second part of 12.4.4.1. +! +! Contributed by Ian Harvey <ian_harvey@bigpond.com> +! +MODULE SomeOptions + IMPLICIT NONE + INTERFACE ElemSpec + MODULE PROCEDURE ElemProc + MODULE PROCEDURE SpecProc + END INTERFACE ElemSpec + INTERFACE SpecElem + MODULE PROCEDURE SpecProc + MODULE PROCEDURE ElemProc + END INTERFACE SpecElem +CONTAINS + ELEMENTAL SUBROUTINE ElemProc(a) + CHARACTER, INTENT(OUT) :: a + !**** + a = 'E' + END SUBROUTINE ElemProc + + SUBROUTINE SpecProc(a) + CHARACTER, INTENT(OUT) :: a(:) + !**** + a = 'S' + END SUBROUTINE SpecProc +END MODULE SomeOptions + +PROGRAM MakeAChoice + USE SomeOptions + IMPLICIT NONE + CHARACTER scalar, array(2) + !**** + CALL ElemSpec(scalar) ! Should choose the elemental (and does) + WRITE (*, 100) scalar + CALL ElemSpec(array) ! Should choose the specific (and does) + WRITE (*, 100) array + !---- + CALL SpecElem(scalar) ! Should choose the elemental (and does) + WRITE (*, 100) scalar + CALL SpecElem(array) ! Should choose the specific (but didn't) + WRITE (*, 100) array + !---- + 100 FORMAT(A,:,', ',A) +END PROGRAM MakeAChoice +! { dg-final { scan-tree-dump-times "specproc" 3 "original" } } +! { dg-final { scan-tree-dump-times "elemproc" 3 "original" } } +! { dg-final { cleanup-tree-dump "original" } } +! { dg-final { cleanup-modules "SomeOptions" } } diff --git a/gcc/testsuite/gfortran.dg/interface_19.f90 b/gcc/testsuite/gfortran.dg/interface_19.f90 index 2d72caa058d..7a88fc91b3e 100644 --- a/gcc/testsuite/gfortran.dg/interface_19.f90 +++ b/gcc/testsuite/gfortran.dg/interface_19.f90 @@ -27,3 +27,6 @@ intrinsic dcos call sub() call sub(dcos) end + +! { dg-final { cleanup-modules "m" } } + diff --git a/gcc/testsuite/gfortran.dg/interface_20.f90 b/gcc/testsuite/gfortran.dg/interface_20.f90 index 829add2ff9b..9a7dc5cb131 100644 --- a/gcc/testsuite/gfortran.dg/interface_20.f90 +++ b/gcc/testsuite/gfortran.dg/interface_20.f90 @@ -18,3 +18,6 @@ implicit none intrinsic cos call sub(cos) ! { dg-error "wrong number of arguments" } end + +! { dg-final { cleanup-modules "m" } } + diff --git a/gcc/testsuite/gfortran.dg/interface_21.f90 b/gcc/testsuite/gfortran.dg/interface_21.f90 index e3db771a93d..566a9ef3707 100644 --- a/gcc/testsuite/gfortran.dg/interface_21.f90 +++ b/gcc/testsuite/gfortran.dg/interface_21.f90 @@ -20,3 +20,6 @@ implicit none EXTERNAL foo ! implicit interface is undefined call sub(foo) ! { dg-error "is not a function" } end + +! { dg-final { cleanup-modules "m" } } + diff --git a/gcc/testsuite/gfortran.dg/interface_22.f90 b/gcc/testsuite/gfortran.dg/interface_22.f90 index 6228fc9f133..fa8e517a186 100644 --- a/gcc/testsuite/gfortran.dg/interface_22.f90 +++ b/gcc/testsuite/gfortran.dg/interface_22.f90 @@ -23,3 +23,6 @@ module gswap module procedure sreal, schar, sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" } end interface swap end module gswap + +! { dg-final { cleanup-modules "foo g gswap" } } + diff --git a/gcc/testsuite/gfortran.dg/interface_30.f90 b/gcc/testsuite/gfortran.dg/interface_30.f90 new file mode 100644 index 00000000000..0576a42510e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_30.f90 @@ -0,0 +1,37 @@ +! { dg-do compile } +! +! PR39850: Too strict checking for procedures as actual argument +! +! Original test case by Tobias Burnus <burnus@gcc.gnu.org> +! Modified by Janus Weil <janus@gcc.gnu.org> + +real function func() + print *,"func" + func = 42.0 +end function func + +program test + external func1,func2,func3,func4 ! subroutine or implicitly typed real function + call sub1(func1) + call sub2(func2) + call sub1(func3) + call sub2(func3) ! { dg-error "Type mismatch in argument" } + call sub2(func4) + call sub1(func4) ! { dg-error "Interface mismatch in dummy procedure" } +contains + subroutine sub1(a1) + interface + real function a1() + end function + end interface + print *, a1() + end subroutine sub1 + subroutine sub2(a2) + interface + subroutine a2 + end subroutine + end interface + call a2() + end subroutine +end + diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 index 469ebd448b1..4e8b3c25314 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 @@ -55,7 +55,7 @@ program bsp end function add integer function f(x) - integer :: x + integer,intent(in) :: x f = 317 + x end function diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_20.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_20.f90 new file mode 100644 index 00000000000..79c9ba8f1ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_20.f90 @@ -0,0 +1,42 @@ +! { dg-do run } +! +! PR 40450: [F03] procedure pointer as actual argument +! +! Contributed by John McFarland <john.mcfarland@swri.org> + +MODULE m + ABSTRACT INTERFACE + SUBROUTINE sub() + END SUBROUTINE sub + END INTERFACE + +CONTAINS + + SUBROUTINE passf(f2) + PROCEDURE(sub), POINTER:: f2 + CALL callf(f2) + END SUBROUTINE passf + + SUBROUTINE callf(f3) + PROCEDURE(sub), POINTER :: f3 + PRINT*, 'calling f' + CALL f3() + END SUBROUTINE callf +END MODULE m + + +PROGRAM prog + USE m + PROCEDURE(sub), POINTER :: f1 + f1 => s + CALL passf(f1) + +CONTAINS + + SUBROUTINE s + PRINT*, 'sub' + END SUBROUTINE s +END PROGRAM prog + +! { dg-final { cleanup-modules "m" } } + diff --git a/gcc/testsuite/gfortran.dg/spread_size_limit.f90 b/gcc/testsuite/gfortran.dg/spread_size_limit.f90 new file mode 100644 index 00000000000..62bc7a4a374 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/spread_size_limit.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR40472 in which simplify_spread had mo limit on the +! siz that it would try to expand to. +! +! Contributed by Philippe Marguinaud <philippe.marguinaud@meteo.fr> +! +REAL, DIMENSION(720,360) :: ZLON_MASK +ZLON_MASK(:,:)= SPREAD( (/ (JLON , JLON=1,720) /) , DIM=2, NCOPIES=360 ) +print *, zlon_mask(100,100) +END +! { dg-final { scan-tree-dump-times "_gfortran_spread" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } + diff --git a/gcc/testsuite/lib/gcc-dg.exp b/gcc/testsuite/lib/gcc-dg.exp index 98e2f667bdb..7e684171be9 100644 --- a/gcc/testsuite/lib/gcc-dg.exp +++ b/gcc/testsuite/lib/gcc-dg.exp @@ -460,7 +460,7 @@ proc cleanup-dump { suffix } { # Remove files kept by --save-temps for the current test. # -# Currently this is only .i, .ii and .s files, but more can be added +# Currently this is only .i, .ii, .s and .o files, but more can be added # if there are tests generating them. # ARGS is a list of suffixes to NOT delete. proc cleanup-saved-temps { args } { @@ -468,7 +468,7 @@ proc cleanup-saved-temps { args } { set suffixes {} # add the to-be-kept suffixes - foreach suffix {".ii" ".i" ".s"} { + foreach suffix {".ii" ".i" ".s" ".o"} { if {[lsearch $args $suffix] < 0} { lappend suffixes $suffix } diff --git a/gcc/timevar.def b/gcc/timevar.def index 6878738e9cf..eb52eecc3db 100644 --- a/gcc/timevar.def +++ b/gcc/timevar.def @@ -167,7 +167,6 @@ DEFTIMEVAR (TV_BRANCH_PROB , "branch prediction") DEFTIMEVAR (TV_VPT , "value profile opts") DEFTIMEVAR (TV_COMBINE , "combiner") DEFTIMEVAR (TV_IFCVT , "if-conversion") -DEFTIMEVAR (TV_SEE , "see") DEFTIMEVAR (TV_REGMOVE , "regmove") DEFTIMEVAR (TV_MODE_SWITCH , "mode switching") DEFTIMEVAR (TV_SMS , "sms modulo scheduling") diff --git a/gcc/tree-cfg.c b/gcc/tree-cfg.c index 8470d765681..4c7c0db12b6 100644 --- a/gcc/tree-cfg.c +++ b/gcc/tree-cfg.c @@ -4947,7 +4947,7 @@ gimple_redirect_edge_and_branch (edge e, basic_block dest) gsi = gsi_last_bb (bb); stmt = gsi_end_p (gsi) ? NULL : gsi_stmt (gsi); - switch (stmt ? gimple_code (stmt) : ERROR_MARK) + switch (stmt ? gimple_code (stmt) : GIMPLE_ERROR_MARK) { case GIMPLE_COND: /* For COND_EXPR, we only need to redirect the edge. */ diff --git a/gcc/tree-dump.c b/gcc/tree-dump.c index 893da7ab104..1cb650442b7 100644 --- a/gcc/tree-dump.c +++ b/gcc/tree-dump.c @@ -803,6 +803,7 @@ struct dump_option_value_info static const struct dump_option_value_info dump_options[] = { {"address", TDF_ADDRESS}, + {"asmname", TDF_ASMNAME}, {"slim", TDF_SLIM}, {"raw", TDF_RAW}, {"graph", TDF_GRAPH}, diff --git a/gcc/tree-pass.h b/gcc/tree-pass.h index 1268e35609f..db3ebce28cc 100644 --- a/gcc/tree-pass.h +++ b/gcc/tree-pass.h @@ -75,6 +75,9 @@ enum tree_dump_index dumper to print stmts. */ #define TDF_RHS_ONLY (1 << 17) /* a flag to only print the RHS of a gimple stmt. */ +#define TDF_ASMNAME (1 << 18) /* display asm names of decls */ + + /* In tree-dump.c */ extern char *get_dump_file_name (int); @@ -479,7 +482,6 @@ extern struct rtl_opt_pass pass_split_all_insns; extern struct rtl_opt_pass pass_fast_rtl_byte_dce; extern struct rtl_opt_pass pass_lower_subreg2; extern struct rtl_opt_pass pass_mode_switching; -extern struct rtl_opt_pass pass_see; extern struct rtl_opt_pass pass_sms; extern struct rtl_opt_pass pass_sched; extern struct rtl_opt_pass pass_ira; diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index 2361c254eac..d754aaba732 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -155,72 +155,42 @@ print_generic_expr (FILE *file, tree t, int flags) dump_generic_node (&buffer, t, 0, flags, false); } -/* Dump the assembly name of a decl node if it's sufficiently different - from the decl name. */ - -static void -maybe_dump_asm_name (pretty_printer *buffer, tree node, int flags) -{ - tree n, a; - - if (flags & TDF_SLIM) - return; - if (DECL_NAME (node) == NULL || !DECL_ASSEMBLER_NAME_SET_P (node)) - return; - - n = DECL_NAME (node); - a = DECL_ASSEMBLER_NAME (node); - if (n == a) - return; - if (strncmp (IDENTIFIER_POINTER (n), "__builtin_", 10) == 0) - return; - - pp_space (buffer); - pp_character (buffer, '['); - pp_tree_identifier (buffer, a); - pp_character (buffer, ']'); -} - /* Dump the name of a _DECL node and its DECL_UID if TDF_UID is set in FLAGS. */ static void dump_decl_name (pretty_printer *buffer, tree node, int flags) { - tree t = node; - - if (DECL_NAME (t)) - pp_tree_identifier (buffer, DECL_NAME (t)); - if ((flags & TDF_UID) - || DECL_NAME (t) == NULL_TREE) + if (DECL_NAME (node)) + { + if ((flags & TDF_ASMNAME) && DECL_ASSEMBLER_NAME_SET_P (node)) + pp_tree_identifier (buffer, DECL_ASSEMBLER_NAME (node)); + else + pp_tree_identifier (buffer, DECL_NAME (node)); + } + if ((flags & TDF_UID) || DECL_NAME (node) == NULL_TREE) { - if (TREE_CODE (t) == LABEL_DECL - && LABEL_DECL_UID (t) != -1) - pp_printf (buffer, "L.%d", (int) LABEL_DECL_UID (t)); + if (TREE_CODE (node) == LABEL_DECL && LABEL_DECL_UID (node) != -1) + pp_printf (buffer, "L.%d", (int) LABEL_DECL_UID (node)); else { - char c = TREE_CODE (t) == CONST_DECL ? 'C' : 'D'; - pp_printf (buffer, "%c.%u", c, DECL_UID (t)); + char c = TREE_CODE (node) == CONST_DECL ? 'C' : 'D'; + pp_printf (buffer, "%c.%u", c, DECL_UID (node)); } } - - maybe_dump_asm_name (buffer, node, flags); } /* Like the above, but used for pretty printing function calls. */ static void -dump_function_name (pretty_printer *buffer, tree node) +dump_function_name (pretty_printer *buffer, tree node, int flags) { - if (DECL_NAME (node)) - { - if (TREE_CODE (node) == NOP_EXPR) - node = TREE_OPERAND (node, 0); - pp_string (buffer, lang_hooks.decl_printable_name (node, 1)); - maybe_dump_asm_name (buffer, node, 0); - } + if (TREE_CODE (node) == NOP_EXPR) + node = TREE_OPERAND (node, 0); + if (DECL_NAME (node) && (flags & TDF_ASMNAME) == 0) + pp_string (buffer, lang_hooks.decl_printable_name (node, 1)); else - dump_decl_name (buffer, node, 0); + dump_decl_name (buffer, node, flags); } /* Dump a function declaration. NODE is the FUNCTION_TYPE. BUFFER, SPC and @@ -1356,7 +1326,7 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags, break; case CALL_EXPR: - print_call_name (buffer, CALL_EXPR_FN (node)); + print_call_name (buffer, CALL_EXPR_FN (node), flags); /* Print parameters. */ pp_space (buffer); @@ -2693,7 +2663,7 @@ op_symbol (const_tree op) the gimple_call_fn of a GIMPLE_CALL. */ void -print_call_name (pretty_printer *buffer, tree node) +print_call_name (pretty_printer *buffer, tree node, int flags) { tree op0 = node; @@ -2706,7 +2676,7 @@ print_call_name (pretty_printer *buffer, tree node) case VAR_DECL: case PARM_DECL: case FUNCTION_DECL: - dump_function_name (buffer, op0); + dump_function_name (buffer, op0, flags); break; case ADDR_EXPR: @@ -2717,20 +2687,20 @@ print_call_name (pretty_printer *buffer, tree node) case COND_EXPR: pp_string (buffer, "("); - dump_generic_node (buffer, TREE_OPERAND (op0, 0), 0, 0, false); + dump_generic_node (buffer, TREE_OPERAND (op0, 0), 0, flags, false); pp_string (buffer, ") ? "); - dump_generic_node (buffer, TREE_OPERAND (op0, 1), 0, 0, false); + dump_generic_node (buffer, TREE_OPERAND (op0, 1), 0, flags, false); pp_string (buffer, " : "); - dump_generic_node (buffer, TREE_OPERAND (op0, 2), 0, 0, false); + dump_generic_node (buffer, TREE_OPERAND (op0, 2), 0, flags, false); break; case COMPONENT_REF: /* The function is a pointer contained in a structure. */ if (TREE_CODE (TREE_OPERAND (op0, 0)) == INDIRECT_REF || TREE_CODE (TREE_OPERAND (op0, 0)) == VAR_DECL) - dump_function_name (buffer, TREE_OPERAND (op0, 1)); + dump_function_name (buffer, TREE_OPERAND (op0, 1), flags); else - dump_generic_node (buffer, TREE_OPERAND (op0, 0), 0, 0, false); + dump_generic_node (buffer, TREE_OPERAND (op0, 0), 0, flags, false); /* else We can have several levels of structures and a function pointer inside. This is not implemented yet... */ @@ -2739,14 +2709,14 @@ print_call_name (pretty_printer *buffer, tree node) case ARRAY_REF: if (TREE_CODE (TREE_OPERAND (op0, 0)) == VAR_DECL) - dump_function_name (buffer, TREE_OPERAND (op0, 0)); + dump_function_name (buffer, TREE_OPERAND (op0, 0), flags); else - dump_generic_node (buffer, op0, 0, 0, false); + dump_generic_node (buffer, op0, 0, flags, false); break; case SSA_NAME: case OBJ_TYPE_REF: - dump_generic_node (buffer, op0, 0, 0, false); + dump_generic_node (buffer, op0, 0, flags, false); break; default: diff --git a/gcc/tree-sra.c b/gcc/tree-sra.c index a2f783afaed..497b47b1175 100644 --- a/gcc/tree-sra.c +++ b/gcc/tree-sra.c @@ -80,6 +80,7 @@ along with GCC; see the file COPYING3. If not see #include "gimple.h" #include "tree-flow.h" #include "diagnostic.h" +#include "statistics.h" #include "tree-dump.h" #include "timevar.h" #include "params.h" @@ -219,6 +220,33 @@ static struct access *work_queue_head; representative fields are dumped, otherwise those which only describe the individual access are. */ +static struct +{ + /* Number of created scalar replacements. */ + int replacements; + + /* Number of times sra_modify_expr or sra_modify_assign themselves changed an + expression. */ + int exprs; + + /* Number of statements created by generate_subtree_copies. */ + int subtree_copies; + + /* Number of statements created by load_assign_lhs_subreplacements. */ + int subreplacements; + + /* Number of times sra_modify_assign has deleted a statement. */ + int deleted; + + /* Number of times sra_modify_assign has to deal with subaccesses of LHS and + RHS reparately due to type conversions or nonexistent matching + references. */ + int separate_lhs_rhs_handling; + + /* Number of processed aggregates is readily available in + analyze_all_variable_accesses and so is not stored here. */ +} sra_stats; + static void dump_access (FILE *f, struct access *access, bool grp) { @@ -435,6 +463,7 @@ sra_initialize (void) access_pool = create_alloc_pool ("SRA accesses", sizeof (struct access), 16); link_pool = create_alloc_pool ("SRA links", sizeof (struct assign_link), 16); base_access_vec = pointer_map_create (); + memset (&sra_stats, 0, sizeof (sra_stats)); } /* Hook fed to pointer_map_traverse, deallocate stored vectors. */ @@ -1275,6 +1304,7 @@ create_access_replacement (struct access *access) print_generic_expr (dump_file, repl, 0); fprintf (dump_file, "\n"); } + sra_stats.replacements++; return repl; } @@ -1286,10 +1316,8 @@ get_access_replacement (struct access *access) { gcc_assert (access->grp_to_be_replaced); - if (access->replacement_decl) - return access->replacement_decl; - - access->replacement_decl = create_access_replacement (access); + if (!access->replacement_decl) + access->replacement_decl = create_access_replacement (access); return access->replacement_decl; } @@ -1597,7 +1625,7 @@ analyze_all_variable_accesses (void) { tree var; referenced_var_iterator rvi; - bool res = false; + int res = 0; FOR_EACH_REFERENCED_VAR (var, rvi) if (bitmap_bit_p (candidate_bitmap, DECL_UID (var))) @@ -1621,7 +1649,7 @@ analyze_all_variable_accesses (void) if (analyze_access_trees (access)) { - res = true; + res++; if (dump_file && (dump_flags & TDF_DETAILS)) { fprintf (dump_file, "\nAccess trees for "); @@ -1635,7 +1663,13 @@ analyze_all_variable_accesses (void) disqualify_candidate (var, "No scalar replacements to be created."); } - return res; + if (res) + { + statistics_counter_event (cfun, "Scalarized aggregates", res); + return true; + } + else + return false; } /* Return true iff a reference statement into aggregate AGG can be built for @@ -1726,6 +1760,7 @@ generate_subtree_copies (struct access *access, tree agg, insert_after ? GSI_NEW_STMT : GSI_SAME_STMT); stmt = gimple_build_assign (expr, repl); + sra_stats.subtree_copies++; } if (insert_after) @@ -1862,6 +1897,7 @@ sra_modify_expr (tree *expr, gimple_stmt_iterator *gsi, bool write, gcc_assert (useless_type_conversion_p (type, access->type)); *expr = repl; } + sra_stats.exprs++; } if (access->first_child) @@ -1956,6 +1992,7 @@ load_assign_lhs_subreplacements (struct access *lacc, struct access *top_racc, stmt = gimple_build_assign (get_access_replacement (lacc), rhs); gsi_insert_after (new_gsi, stmt, GSI_NEW_STMT); update_stmt (stmt); + sra_stats.subreplacements++; } else if (lacc->grp_read && !lacc->grp_covered && !*refreshed) { @@ -2059,6 +2096,7 @@ sra_modify_assign (gimple *stmt, gimple_stmt_iterator *gsi, modify_this_stmt = true; if (lacc->grp_partial_lhs) force_gimple_rhs = true; + sra_stats.exprs++; } if (racc && racc->grp_to_be_replaced) @@ -2067,6 +2105,7 @@ sra_modify_assign (gimple *stmt, gimple_stmt_iterator *gsi, modify_this_stmt = true; if (racc->grp_partial_lhs) force_gimple_rhs = true; + sra_stats.exprs++; } if (modify_this_stmt) @@ -2158,6 +2197,7 @@ sra_modify_assign (gimple *stmt, gimple_stmt_iterator *gsi, if (access_has_children_p (lacc)) generate_subtree_copies (lacc->first_child, lacc->base, 0, 0, 0, gsi, true, true); + sra_stats.separate_lhs_rhs_handling++; } else { @@ -2184,6 +2224,7 @@ sra_modify_assign (gimple *stmt, gimple_stmt_iterator *gsi, unlink_stmt_vdef (*stmt); gsi_remove (&orig_gsi, true); + sra_stats.deleted++; return SRA_SA_REMOVED; } } @@ -2199,6 +2240,7 @@ sra_modify_assign (gimple *stmt, gimple_stmt_iterator *gsi, gcc_assert (*stmt == gsi_stmt (*gsi)); unlink_stmt_vdef (*stmt); gsi_remove (gsi, true); + sra_stats.deleted++; return SRA_SA_REMOVED; } else @@ -2274,6 +2316,18 @@ perform_intra_sra (void) scan_function (sra_modify_expr, sra_modify_assign, NULL, false, NULL); initialize_parameter_reductions (); + + statistics_counter_event (cfun, "Scalar replacements created", + sra_stats.replacements); + statistics_counter_event (cfun, "Modified expressions", sra_stats.exprs); + statistics_counter_event (cfun, "Subtree copy stmts", + sra_stats.subtree_copies); + statistics_counter_event (cfun, "Subreplacement stmts", + sra_stats.subreplacements); + statistics_counter_event (cfun, "Deleted stmts", sra_stats.deleted); + statistics_counter_event (cfun, "Separate LHS and RHS handling", + sra_stats.separate_lhs_rhs_handling); + ret = TODO_update_ssa; out: diff --git a/gcc/tree-ssa-alias.c b/gcc/tree-ssa-alias.c index 6cbec5de2bf..98955246aea 100644 --- a/gcc/tree-ssa-alias.c +++ b/gcc/tree-ssa-alias.c @@ -168,14 +168,9 @@ ptr_deref_may_alias_decl_p (tree ptr, tree decl) { struct ptr_info_def *pi; - /* ??? During SCCVN/PRE we can end up with *&x during valueizing - operands. Likewise we can end up with dereferencing constant - pointers. Just bail out in these cases for now. */ - if (TREE_CODE (ptr) == ADDR_EXPR - || TREE_CODE (ptr) == INTEGER_CST) - return true; - - gcc_assert (TREE_CODE (ptr) == SSA_NAME + gcc_assert ((TREE_CODE (ptr) == SSA_NAME + || TREE_CODE (ptr) == ADDR_EXPR + || TREE_CODE (ptr) == INTEGER_CST) && (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == PARM_DECL || TREE_CODE (decl) == RESULT_DECL)); @@ -184,6 +179,29 @@ ptr_deref_may_alias_decl_p (tree ptr, tree decl) if (!may_be_aliased (decl)) return false; + /* ADDR_EXPR pointers either just offset another pointer or directly + specify the pointed-to set. */ + if (TREE_CODE (ptr) == ADDR_EXPR) + { + tree base = get_base_address (TREE_OPERAND (ptr, 0)); + if (base + && INDIRECT_REF_P (base)) + ptr = TREE_OPERAND (base, 0); + else if (base + && SSA_VAR_P (base)) + return operand_equal_p (base, decl, 0); + else if (base + && CONSTANT_CLASS_P (base)) + return false; + else + return true; + } + + /* We can end up with dereferencing constant pointers. + Just bail out in this case. */ + if (TREE_CODE (ptr) == INTEGER_CST) + return true; + /* If we do not have useful points-to information for this pointer we cannot disambiguate anything else. */ pi = SSA_NAME_PTR_INFO (ptr); @@ -202,18 +220,46 @@ ptr_derefs_may_alias_p (tree ptr1, tree ptr2) { struct ptr_info_def *pi1, *pi2; - /* ??? During SCCVN/PRE we can end up with *&x during valueizing - operands. Likewise we can end up with dereferencing constant - pointers. Just bail out in these cases for now. */ - if (TREE_CODE (ptr1) == ADDR_EXPR - || TREE_CODE (ptr1) == INTEGER_CST - || TREE_CODE (ptr2) == ADDR_EXPR + gcc_assert ((TREE_CODE (ptr1) == SSA_NAME + || TREE_CODE (ptr1) == ADDR_EXPR + || TREE_CODE (ptr1) == INTEGER_CST) + && (TREE_CODE (ptr2) == SSA_NAME + || TREE_CODE (ptr2) == ADDR_EXPR + || TREE_CODE (ptr2) == INTEGER_CST)); + + /* ADDR_EXPR pointers either just offset another pointer or directly + specify the pointed-to set. */ + if (TREE_CODE (ptr1) == ADDR_EXPR) + { + tree base = get_base_address (TREE_OPERAND (ptr1, 0)); + if (base + && INDIRECT_REF_P (base)) + ptr1 = TREE_OPERAND (base, 0); + else if (base + && SSA_VAR_P (base)) + return ptr_deref_may_alias_decl_p (ptr2, base); + else + return true; + } + if (TREE_CODE (ptr2) == ADDR_EXPR) + { + tree base = get_base_address (TREE_OPERAND (ptr2, 0)); + if (base + && INDIRECT_REF_P (base)) + ptr2 = TREE_OPERAND (base, 0); + else if (base + && SSA_VAR_P (base)) + return ptr_deref_may_alias_decl_p (ptr1, base); + else + return true; + } + + /* We can end up with dereferencing constant pointers. + Just bail out in this case. */ + if (TREE_CODE (ptr1) == INTEGER_CST || TREE_CODE (ptr2) == INTEGER_CST) return true; - gcc_assert (TREE_CODE (ptr1) == SSA_NAME - && TREE_CODE (ptr2) == SSA_NAME); - /* We may end up with two empty points-to solutions for two same pointers. In this case we still want to say both pointers alias, so shortcut that here. */ @@ -232,6 +278,31 @@ ptr_derefs_may_alias_p (tree ptr1, tree ptr2) return pt_solutions_intersect (&pi1->pt, &pi2->pt); } +/* Return true if dereferencing PTR may alias *REF. + The caller is responsible for applying TBAA to see if PTR + may access *REF at all. */ + +static bool +ptr_deref_may_alias_ref_p_1 (tree ptr, ao_ref *ref) +{ + tree base = ao_ref_base (ref); + + if (INDIRECT_REF_P (base)) + return ptr_derefs_may_alias_p (ptr, TREE_OPERAND (base, 0)); + else if (SSA_VAR_P (base)) + return ptr_deref_may_alias_decl_p (ptr, base); + + return true; +} + +static bool +ptr_deref_may_alias_ref_p (tree ptr, tree ref) +{ + ao_ref r; + ao_ref_init (&r, ref); + return ptr_deref_may_alias_ref_p_1 (ptr, &r); +} + /* Dump alias information on FILE. */ @@ -778,7 +849,7 @@ refs_output_dependent_p (tree store1, tree store2) static bool ref_maybe_used_by_call_p_1 (gimple call, tree ref) { - tree base; + tree base, callee; unsigned i; int flags = gimple_call_flags (call); @@ -803,13 +874,64 @@ ref_maybe_used_by_call_p_1 (gimple call, tree ref) && !is_global_var (base)) goto process_args; + callee = gimple_call_fndecl (call); + + /* Handle those builtin functions explicitly that do not act as + escape points. See tree-ssa-structalias.c:find_func_aliases + for the list of builtins we might need to handle here. */ + if (callee != NULL_TREE + && DECL_BUILT_IN_CLASS (callee) == BUILT_IN_NORMAL) + switch (DECL_FUNCTION_CODE (callee)) + { + /* All the following functions clobber memory pointed to by + their first argument. */ + case BUILT_IN_STRCPY: + case BUILT_IN_STRNCPY: + case BUILT_IN_BCOPY: + case BUILT_IN_MEMCPY: + case BUILT_IN_MEMMOVE: + case BUILT_IN_MEMPCPY: + case BUILT_IN_STPCPY: + case BUILT_IN_STPNCPY: + case BUILT_IN_STRCAT: + case BUILT_IN_STRNCAT: + { + tree src = gimple_call_arg (call, 1); + return ptr_deref_may_alias_ref_p (src, ref); + } + /* The following builtins do not read from memory. */ + case BUILT_IN_FREE: + case BUILT_IN_MEMSET: + case BUILT_IN_FREXP: + case BUILT_IN_FREXPF: + case BUILT_IN_FREXPL: + case BUILT_IN_GAMMA_R: + case BUILT_IN_GAMMAF_R: + case BUILT_IN_GAMMAL_R: + case BUILT_IN_LGAMMA_R: + case BUILT_IN_LGAMMAF_R: + case BUILT_IN_LGAMMAL_R: + case BUILT_IN_MODF: + case BUILT_IN_MODFF: + case BUILT_IN_MODFL: + case BUILT_IN_REMQUO: + case BUILT_IN_REMQUOF: + case BUILT_IN_REMQUOL: + case BUILT_IN_SINCOS: + case BUILT_IN_SINCOSF: + case BUILT_IN_SINCOSL: + return false; + + default: + /* Fallthru to general call handling. */; + } + /* Check if base is a global static variable that is not read by the function. */ if (TREE_CODE (base) == VAR_DECL && TREE_STATIC (base) && !TREE_PUBLIC (base)) { - tree callee = gimple_call_fndecl (call); bitmap not_read; if (callee != NULL_TREE @@ -901,6 +1023,7 @@ static bool call_may_clobber_ref_p_1 (gimple call, ao_ref *ref) { tree base; + tree callee; /* If the call is pure or const it cannot clobber anything. */ if (gimple_call_flags (call) @@ -926,18 +1049,99 @@ call_may_clobber_ref_p_1 (gimple call, ao_ref *ref) || !is_global_var (base))) return false; + callee = gimple_call_fndecl (call); + + /* Handle those builtin functions explicitly that do not act as + escape points. See tree-ssa-structalias.c:find_func_aliases + for the list of builtins we might need to handle here. */ + if (callee != NULL_TREE + && DECL_BUILT_IN_CLASS (callee) == BUILT_IN_NORMAL) + switch (DECL_FUNCTION_CODE (callee)) + { + /* All the following functions clobber memory pointed to by + their first argument. */ + case BUILT_IN_STRCPY: + case BUILT_IN_STRNCPY: + case BUILT_IN_BCOPY: + case BUILT_IN_MEMCPY: + case BUILT_IN_MEMMOVE: + case BUILT_IN_MEMPCPY: + case BUILT_IN_STPCPY: + case BUILT_IN_STPNCPY: + case BUILT_IN_STRCAT: + case BUILT_IN_STRNCAT: + { + tree dest = gimple_call_arg (call, 0); + return ptr_deref_may_alias_ref_p_1 (dest, ref); + } + /* Freeing memory kills the pointed-to memory. More importantly + the call has to serve as a barrier for moving loads and stores + across it. Same is true for memset. */ + case BUILT_IN_FREE: + case BUILT_IN_MEMSET: + { + tree ptr = gimple_call_arg (call, 0); + return ptr_deref_may_alias_ref_p_1 (ptr, ref); + } + case BUILT_IN_GAMMA_R: + case BUILT_IN_GAMMAF_R: + case BUILT_IN_GAMMAL_R: + case BUILT_IN_LGAMMA_R: + case BUILT_IN_LGAMMAF_R: + case BUILT_IN_LGAMMAL_R: + { + tree out = gimple_call_arg (call, 1); + if (ptr_deref_may_alias_ref_p_1 (out, ref)) + return true; + if (flag_errno_math) + break; + return false; + } + case BUILT_IN_FREXP: + case BUILT_IN_FREXPF: + case BUILT_IN_FREXPL: + case BUILT_IN_MODF: + case BUILT_IN_MODFF: + case BUILT_IN_MODFL: + { + tree out = gimple_call_arg (call, 1); + return ptr_deref_may_alias_ref_p_1 (out, ref); + } + case BUILT_IN_REMQUO: + case BUILT_IN_REMQUOF: + case BUILT_IN_REMQUOL: + { + tree out = gimple_call_arg (call, 2); + if (ptr_deref_may_alias_ref_p_1 (out, ref)) + return true; + if (flag_errno_math) + break; + return false; + } + case BUILT_IN_SINCOS: + case BUILT_IN_SINCOSF: + case BUILT_IN_SINCOSL: + { + tree sin = gimple_call_arg (call, 1); + tree cos = gimple_call_arg (call, 2); + return (ptr_deref_may_alias_ref_p_1 (sin, ref) + || ptr_deref_may_alias_ref_p_1 (cos, ref)); + } + default: + /* Fallthru to general call handling. */; + } + /* Check if base is a global static variable that is not written by the function. */ - if (TREE_CODE (base) == VAR_DECL + if (callee != NULL_TREE + && TREE_CODE (base) == VAR_DECL && TREE_STATIC (base) && !TREE_PUBLIC (base)) { - tree callee = gimple_call_fndecl (call); bitmap not_written; - if (callee != NULL_TREE - && (not_written - = ipa_reference_get_not_written_global (cgraph_node (callee))) + if ((not_written + = ipa_reference_get_not_written_global (cgraph_node (callee))) && bitmap_bit_p (not_written, DECL_UID (base))) return false; } diff --git a/gcc/tree-ssa-loop-niter.c b/gcc/tree-ssa-loop-niter.c index 18fd6b26e4a..48016c0b7f5 100644 --- a/gcc/tree-ssa-loop-niter.c +++ b/gcc/tree-ssa-loop-niter.c @@ -2254,6 +2254,12 @@ find_loop_niter_by_eval (struct loop *loop, edge *exit) tree niter = NULL_TREE, aniter; *exit = NULL; + + /* Loops with multiple exits are expensive to handle and less important. */ + if (!flag_expensive_optimizations + && VEC_length (edge, exits) > 1) + return chrec_dont_know; + for (i = 0; VEC_iterate (edge, exits, i, ex); i++) { if (!just_once_each_iteration_p (loop, ex->src)) diff --git a/gcc/tree-ssa-structalias.c b/gcc/tree-ssa-structalias.c index 60863d560f5..ac2c7dc04a8 100644 --- a/gcc/tree-ssa-structalias.c +++ b/gcc/tree-ssa-structalias.c @@ -2676,20 +2676,27 @@ get_vi_for_tree (tree t) return (varinfo_t) *slot; } -/* Get a constraint expression for a new temporary variable. */ +/* Get a scalar constraint expression for a new temporary variable. */ static struct constraint_expr -get_constraint_exp_for_temp (tree t) +new_scalar_tmp_constraint_exp (const char *name) { - struct constraint_expr cexpr; + struct constraint_expr tmp; + unsigned index = VEC_length (varinfo_t, varmap); + varinfo_t vi; - gcc_assert (SSA_VAR_P (t)); + vi = new_var_info (NULL_TREE, index, name); + vi->offset = 0; + vi->size = -1; + vi->fullsize = -1; + vi->is_full_var = 1; + VEC_safe_push (varinfo_t, heap, varmap, vi); - cexpr.type = SCALAR; - cexpr.var = get_vi_for_tree (t)->id; - cexpr.offset = 0; + tmp.var = vi->id; + tmp.type = SCALAR; + tmp.offset = 0; - return cexpr; + return tmp; } /* Get a constraint expression vector from an SSA_VAR_P node. @@ -2768,23 +2775,16 @@ process_constraint (constraint_t t) if (rhs.type == DEREF && lhs.type == DEREF && rhs.var != anything_id) { /* Split into tmp = *rhs, *lhs = tmp */ - tree rhsdecl = get_varinfo (rhs.var)->decl; - tree pointertype = TREE_TYPE (rhsdecl); - tree pointedtotype = TREE_TYPE (pointertype); - tree tmpvar = create_tmp_var_raw (pointedtotype, "doubledereftmp"); - struct constraint_expr tmplhs = get_constraint_exp_for_temp (tmpvar); - + struct constraint_expr tmplhs; + tmplhs = new_scalar_tmp_constraint_exp ("doubledereftmp"); process_constraint (new_constraint (tmplhs, rhs)); process_constraint (new_constraint (lhs, tmplhs)); } else if (rhs.type == ADDRESSOF && lhs.type == DEREF) { /* Split into tmp = &rhs, *lhs = tmp */ - tree rhsdecl = get_varinfo (rhs.var)->decl; - tree pointertype = TREE_TYPE (rhsdecl); - tree tmpvar = create_tmp_var_raw (pointertype, "derefaddrtmp"); - struct constraint_expr tmplhs = get_constraint_exp_for_temp (tmpvar); - + struct constraint_expr tmplhs; + tmplhs = new_scalar_tmp_constraint_exp ("derefaddrtmp"); process_constraint (new_constraint (tmplhs, rhs)); process_constraint (new_constraint (lhs, tmplhs)); } @@ -2857,7 +2857,8 @@ get_constraint_for_ptr_offset (tree ptr, tree offset, in a HOST_WIDE_INT, we have to fall back to a conservative solution which includes all sub-fields of all pointed-to variables of ptr. */ - if (!host_integerp (offset, 0)) + if (offset == NULL_TREE + || !host_integerp (offset, 0)) rhsoffset = UNKNOWN_OFFSET; else { @@ -2896,7 +2897,8 @@ get_constraint_for_ptr_offset (tree ptr, tree offset, c2.var = temp->id; c2.type = ADDRESSOF; c2.offset = 0; - VEC_safe_push (ce_s, heap, *results, &c2); + if (c2.var != c->var) + VEC_safe_push (ce_s, heap, *results, &c2); temp = temp->next; } while (temp); @@ -3089,8 +3091,8 @@ do_deref (VEC (ce_s, heap) **constraints) c->type = SCALAR; else if (c->type == DEREF) { - tree tmpvar = create_tmp_var_raw (ptr_type_node, "dereftmp"); - struct constraint_expr tmplhs = get_constraint_exp_for_temp (tmpvar); + struct constraint_expr tmplhs; + tmplhs = new_scalar_tmp_constraint_exp ("dereftmp"); process_constraint (new_constraint (tmplhs, *c)); c->var = tmplhs.var; } @@ -3239,6 +3241,34 @@ get_constraint_for (tree t, VEC (ce_s, heap) **results) get_constraint_for_1 (t, results, false); } + +/* Efficiently generates constraints from all entries in *RHSC to all + entries in *LHSC. */ + +static void +process_all_all_constraints (VEC (ce_s, heap) *lhsc, VEC (ce_s, heap) *rhsc) +{ + struct constraint_expr *lhsp, *rhsp; + unsigned i, j; + + if (VEC_length (ce_s, lhsc) <= 1 + || VEC_length (ce_s, rhsc) <= 1) + { + for (i = 0; VEC_iterate (ce_s, lhsc, i, lhsp); ++i) + for (j = 0; VEC_iterate (ce_s, rhsc, j, rhsp); ++j) + process_constraint (new_constraint (*lhsp, *rhsp)); + } + else + { + struct constraint_expr tmp; + tmp = new_scalar_tmp_constraint_exp ("allalltmp"); + for (i = 0; VEC_iterate (ce_s, rhsc, i, rhsp); ++i) + process_constraint (new_constraint (tmp, *rhsp)); + for (i = 0; VEC_iterate (ce_s, lhsc, i, lhsp); ++i) + process_constraint (new_constraint (*lhsp, tmp)); + } +} + /* Handle aggregate copies by expanding into copies of the respective fields of the structures. */ @@ -3256,18 +3286,7 @@ do_structure_copy (tree lhsop, tree rhsop) if (lhsp->type == DEREF || (lhsp->type == ADDRESSOF && lhsp->var == anything_id) || rhsp->type == DEREF) - { - struct constraint_expr tmp; - tree tmpvar = create_tmp_var_raw (ptr_type_node, - "structcopydereftmp"); - tmp.var = get_vi_for_tree (tmpvar)->id; - tmp.type = SCALAR; - tmp.offset = 0; - for (j = 0; VEC_iterate (ce_s, rhsc, j, rhsp); ++j) - process_constraint (new_constraint (tmp, *rhsp)); - for (j = 0; VEC_iterate (ce_s, lhsc, j, lhsp); ++j) - process_constraint (new_constraint (*lhsp, tmp)); - } + process_all_all_constraints (lhsc, rhsc); else if (lhsp->type == SCALAR && (rhsp->type == SCALAR || rhsp->type == ADDRESSOF)) @@ -3426,8 +3445,6 @@ handle_lhs_call (tree lhs, int flags, VEC(ce_s, heap) *rhsc) } else if (VEC_length (ce_s, rhsc) > 0) { - struct constraint_expr *lhsp, *rhsp; - unsigned int i, j; /* If the store is to a global decl make sure to add proper escape constraints. */ lhs = get_base_address (lhs); @@ -3441,9 +3458,7 @@ handle_lhs_call (tree lhs, int flags, VEC(ce_s, heap) *rhsc) tmpc.type = SCALAR; VEC_safe_push (ce_s, heap, lhsc, &tmpc); } - for (i = 0; VEC_iterate (ce_s, lhsc, i, lhsp); ++i) - for (j = 0; VEC_iterate (ce_s, rhsc, j, rhsp); ++j) - process_constraint (new_constraint (*lhsp, *rhsp)); + process_all_all_constraints (lhsc, rhsc); } VEC_free (ce_s, heap, lhsc); } @@ -3454,8 +3469,7 @@ handle_lhs_call (tree lhs, int flags, VEC(ce_s, heap) *rhsc) static void handle_const_call (gimple stmt, VEC(ce_s, heap) **results) { - struct constraint_expr rhsc, tmpc = {SCALAR, 0, 0}; - tree tmpvar = NULL_TREE; + struct constraint_expr rhsc; unsigned int k; /* Treat nested const functions the same as pure functions as far @@ -3477,27 +3491,14 @@ handle_const_call (gimple stmt, VEC(ce_s, heap) **results) if (could_have_pointers (arg)) { VEC(ce_s, heap) *argc = NULL; + unsigned i; struct constraint_expr *argp; - int i; - - /* We always use a temporary here, otherwise we end up with - a quadratic amount of constraints for - large_struct = const_call (large_struct); - with field-sensitive PTA. */ - if (tmpvar == NULL_TREE) - { - tmpvar = create_tmp_var_raw (ptr_type_node, "consttmp"); - tmpc = get_constraint_exp_for_temp (tmpvar); - } - get_constraint_for (arg, &argc); - for (i = 0; VEC_iterate (ce_s, argc, i, argp); i++) - process_constraint (new_constraint (tmpc, *argp)); - VEC_free (ce_s, heap, argc); + for (i = 0; VEC_iterate (ce_s, argc, i, argp); ++i) + VEC_safe_push (ce_s, heap, *results, argp); + VEC_free(ce_s, heap, argc); } } - if (tmpvar != NULL_TREE) - VEC_safe_push (ce_s, heap, *results, &tmpc); /* May return addresses of globals. */ rhsc.var = nonlocal_id; @@ -3608,6 +3609,117 @@ find_func_aliases (gimple origt) pointer passed by address. */ else if (is_gimple_call (t)) { + tree fndecl; + if ((fndecl = gimple_call_fndecl (t)) != NULL_TREE + && DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL) + /* ??? All builtins that are handled here need to be handled + in the alias-oracle query functions explicitly! */ + switch (DECL_FUNCTION_CODE (fndecl)) + { + /* All the following functions return a pointer to the same object + as their first argument points to. The functions do not add + to the ESCAPED solution. The functions make the first argument + pointed to memory point to what the second argument pointed to + memory points to. */ + case BUILT_IN_STRCPY: + case BUILT_IN_STRNCPY: + case BUILT_IN_BCOPY: + case BUILT_IN_MEMCPY: + case BUILT_IN_MEMMOVE: + case BUILT_IN_MEMPCPY: + case BUILT_IN_STPCPY: + case BUILT_IN_STPNCPY: + case BUILT_IN_STRCAT: + case BUILT_IN_STRNCAT: + { + tree res = gimple_call_lhs (t); + tree dest = gimple_call_arg (t, 0); + tree src = gimple_call_arg (t, 1); + if (res != NULL_TREE) + { + get_constraint_for (res, &lhsc); + if (DECL_FUNCTION_CODE (fndecl) == BUILT_IN_MEMPCPY + || DECL_FUNCTION_CODE (fndecl) == BUILT_IN_STPCPY + || DECL_FUNCTION_CODE (fndecl) == BUILT_IN_STPNCPY) + get_constraint_for_ptr_offset (dest, NULL_TREE, &rhsc); + else + get_constraint_for (dest, &rhsc); + process_all_all_constraints (lhsc, rhsc); + VEC_free (ce_s, heap, lhsc); + VEC_free (ce_s, heap, rhsc); + } + get_constraint_for_ptr_offset (dest, NULL_TREE, &lhsc); + get_constraint_for_ptr_offset (src, NULL_TREE, &rhsc); + do_deref (&lhsc); + do_deref (&rhsc); + process_all_all_constraints (lhsc, rhsc); + VEC_free (ce_s, heap, lhsc); + VEC_free (ce_s, heap, rhsc); + return; + } + case BUILT_IN_MEMSET: + { + tree res = gimple_call_lhs (t); + tree dest = gimple_call_arg (t, 0); + unsigned i; + ce_s *lhsp; + struct constraint_expr ac; + if (res != NULL_TREE) + { + get_constraint_for (res, &lhsc); + get_constraint_for (dest, &rhsc); + process_all_all_constraints (lhsc, rhsc); + VEC_free (ce_s, heap, lhsc); + VEC_free (ce_s, heap, rhsc); + } + get_constraint_for_ptr_offset (dest, NULL_TREE, &lhsc); + do_deref (&lhsc); + if (flag_delete_null_pointer_checks + && integer_zerop (gimple_call_arg (t, 1))) + { + ac.type = ADDRESSOF; + ac.var = nothing_id; + } + else + { + ac.type = SCALAR; + ac.var = integer_id; + } + ac.offset = 0; + for (i = 0; VEC_iterate (ce_s, lhsc, i, lhsp); ++i) + process_constraint (new_constraint (*lhsp, ac)); + VEC_free (ce_s, heap, lhsc); + return; + } + /* All the following functions do not return pointers, do not + modify the points-to sets of memory reachable from their + arguments and do not add to the ESCAPED solution. */ + case BUILT_IN_SINCOS: + case BUILT_IN_SINCOSF: + case BUILT_IN_SINCOSL: + case BUILT_IN_FREXP: + case BUILT_IN_FREXPF: + case BUILT_IN_FREXPL: + case BUILT_IN_GAMMA_R: + case BUILT_IN_GAMMAF_R: + case BUILT_IN_GAMMAL_R: + case BUILT_IN_LGAMMA_R: + case BUILT_IN_LGAMMAF_R: + case BUILT_IN_LGAMMAL_R: + case BUILT_IN_MODF: + case BUILT_IN_MODFF: + case BUILT_IN_MODFL: + case BUILT_IN_REMQUO: + case BUILT_IN_REMQUOF: + case BUILT_IN_REMQUOL: + case BUILT_IN_FREE: + return; + /* printf-style functions may have hooks to set pointers to + point to somewhere into the generated string. Leave them + for a later excercise... */ + default: + /* Fallthru to general call handling. */; + } if (!in_ipa_mode) { VEC(ce_s, heap) *rhsc = NULL; @@ -3724,7 +3836,6 @@ find_func_aliases (gimple origt) do_structure_copy (lhsop, rhsop); else { - unsigned int j; struct constraint_expr temp; get_constraint_for (lhsop, &lhsc); @@ -3743,14 +3854,7 @@ find_func_aliases (gimple origt) temp.offset = 0; VEC_safe_push (ce_s, heap, rhsc, &temp); } - for (j = 0; VEC_iterate (ce_s, lhsc, j, c); j++) - { - struct constraint_expr *c2; - unsigned int k; - - for (k = 0; VEC_iterate (ce_s, rhsc, k, c2); k++) - process_constraint (new_constraint (*c, *c2)); - } + process_all_all_constraints (lhsc, rhsc); } /* If there is a store to a global variable the rhs escapes. */ if ((lhsop = get_base_address (lhsop)) != NULL_TREE @@ -4168,7 +4272,6 @@ create_function_info_for (tree decl, const char *name) /* Create the variable info. */ vi = new_var_info (decl, index, name); - vi->decl = decl; vi->offset = 0; vi->size = 1; vi->fullsize = count_num_arguments (decl, &is_varargs) + 1; @@ -4208,7 +4311,6 @@ create_function_info_for (tree decl, const char *name) free (tempname); argvi = new_var_info (argdecl, newindex, newname); - argvi->decl = argdecl; VEC_safe_push (varinfo_t, heap, varmap, argvi); argvi->offset = i; argvi->size = 1; @@ -4244,7 +4346,6 @@ create_function_info_for (tree decl, const char *name) free (tempname); resultvi = new_var_info (resultdecl, newindex, newname); - resultvi->decl = resultdecl; VEC_safe_push (varinfo_t, heap, varmap, resultvi); resultvi->offset = i; resultvi->size = 1; @@ -4306,7 +4407,6 @@ create_variable_info_for (tree decl, const char *name) sort the field list and create fake variables for all the fields. */ vi = new_var_info (decl, index, name); - vi->decl = decl; vi->offset = 0; vi->may_have_pointers = could_have_pointers (decl); if (!declsize diff --git a/gcc/tree.c b/gcc/tree.c index f48512fceeb..139c1e55757 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -2473,6 +2473,36 @@ tree_node_structure (const_tree t) gcc_unreachable (); } } + +/* Set various status flags when building a CALL_EXPR object T. */ + +static void +process_call_operands (tree t) +{ + bool side_effects = TREE_SIDE_EFFECTS (t); + int i; + + if (!side_effects) + for (i = 1; i < TREE_OPERAND_LENGTH (t); i++) + { + tree op = TREE_OPERAND (t, i); + if (op && TREE_SIDE_EFFECTS (op)) + { + side_effects = true; + break; + } + } + + if (!side_effects) + { + /* Calls have side-effects, except those to const or pure functions. */ + i = call_expr_flags (t); + if ((i & ECF_LOOPING_CONST_OR_PURE) || !(i & (ECF_CONST | ECF_PURE))) + side_effects = true; + } + + TREE_SIDE_EFFECTS (t) = side_effects; +} /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size or offset that depends on a field within a record. */ @@ -2660,7 +2690,7 @@ substitute_in_expr (tree exp, tree f, tree r) { enum tree_code code = TREE_CODE (exp); tree op0, op1, op2, op3; - tree new_tree, inner; + tree new_tree; /* We handle TREE_LIST and COMPONENT_REF separately. */ if (code == TREE_LIST) @@ -2673,27 +2703,32 @@ substitute_in_expr (tree exp, tree f, tree r) return tree_cons (TREE_PURPOSE (exp), op1, op0); } else if (code == COMPONENT_REF) - { - /* If this expression is getting a value from a PLACEHOLDER_EXPR - and it is the right field, replace it with R. */ - for (inner = TREE_OPERAND (exp, 0); - REFERENCE_CLASS_P (inner); - inner = TREE_OPERAND (inner, 0)) - ; - if (TREE_CODE (inner) == PLACEHOLDER_EXPR - && TREE_OPERAND (exp, 1) == f) - return r; - - /* If this expression hasn't been completed let, leave it alone. */ - if (TREE_CODE (inner) == PLACEHOLDER_EXPR && TREE_TYPE (inner) == 0) - return exp; - - op0 = SUBSTITUTE_IN_EXPR (TREE_OPERAND (exp, 0), f, r); - if (op0 == TREE_OPERAND (exp, 0)) - return exp; - - new_tree = fold_build3 (COMPONENT_REF, TREE_TYPE (exp), - op0, TREE_OPERAND (exp, 1), NULL_TREE); + { + tree inner; + + /* If this expression is getting a value from a PLACEHOLDER_EXPR + and it is the right field, replace it with R. */ + for (inner = TREE_OPERAND (exp, 0); + REFERENCE_CLASS_P (inner); + inner = TREE_OPERAND (inner, 0)) + ; + + /* The field. */ + op1 = TREE_OPERAND (exp, 1); + + if (TREE_CODE (inner) == PLACEHOLDER_EXPR && op1 == f) + return r; + + /* If this expression hasn't been completed let, leave it alone. */ + if (TREE_CODE (inner) == PLACEHOLDER_EXPR && !TREE_TYPE (inner)) + return exp; + + op0 = SUBSTITUTE_IN_EXPR (TREE_OPERAND (exp, 0), f, r); + if (op0 == TREE_OPERAND (exp, 0)) + return exp; + + new_tree + = fold_build3 (COMPONENT_REF, TREE_TYPE (exp), op0, op1, NULL_TREE); } else switch (TREE_CODE_CLASS (code)) @@ -2754,7 +2789,8 @@ substitute_in_expr (tree exp, tree f, tree r) && op3 == TREE_OPERAND (exp, 3)) return exp; - new_tree = fold (build4 (code, TREE_TYPE (exp), op0, op1, op2, op3)); + new_tree + = fold (build4 (code, TREE_TYPE (exp), op0, op1, op2, op3)); break; default: @@ -2764,23 +2800,28 @@ substitute_in_expr (tree exp, tree f, tree r) case tcc_vl_exp: { - tree copy = NULL_TREE; int i; + new_tree = NULL_TREE; + for (i = 1; i < TREE_OPERAND_LENGTH (exp); i++) { tree op = TREE_OPERAND (exp, i); tree new_op = SUBSTITUTE_IN_EXPR (op, f, r); if (new_op != op) { - if (!copy) - copy = copy_node (exp); - TREE_OPERAND (copy, i) = new_op; + if (!new_tree) + new_tree = copy_node (exp); + TREE_OPERAND (new_tree, i) = new_op; } } - if (copy) - new_tree = fold (copy); + if (new_tree) + { + new_tree = fold (new_tree); + if (TREE_CODE (new_tree) == CALL_EXPR) + process_call_operands (new_tree); + } else return exp; } @@ -2790,7 +2831,7 @@ substitute_in_expr (tree exp, tree f, tree r) gcc_unreachable (); } - TREE_READONLY (new_tree) = TREE_READONLY (exp); + TREE_READONLY (new_tree) |= TREE_READONLY (exp); return new_tree; } @@ -2802,6 +2843,7 @@ substitute_placeholder_in_expr (tree exp, tree obj) { enum tree_code code = TREE_CODE (exp); tree op0, op1, op2, op3; + tree new_tree; /* If this is a PLACEHOLDER_EXPR, see if we find a corresponding type in the chain of OBJ. */ @@ -2877,8 +2919,9 @@ substitute_placeholder_in_expr (tree exp, tree obj) op0 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, 0), obj); if (op0 == TREE_OPERAND (exp, 0)) return exp; - else - return fold_build1 (code, TREE_TYPE (exp), op0); + + new_tree = fold_build1 (code, TREE_TYPE (exp), op0); + break; case 2: op0 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, 0), obj); @@ -2886,8 +2929,9 @@ substitute_placeholder_in_expr (tree exp, tree obj) if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)) return exp; - else - return fold_build2 (code, TREE_TYPE (exp), op0, op1); + + new_tree = fold_build2 (code, TREE_TYPE (exp), op0, op1); + break; case 3: op0 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, 0), obj); @@ -2897,8 +2941,9 @@ substitute_placeholder_in_expr (tree exp, tree obj) if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1) && op2 == TREE_OPERAND (exp, 2)) return exp; - else - return fold_build3 (code, TREE_TYPE (exp), op0, op1, op2); + + new_tree = fold_build3 (code, TREE_TYPE (exp), op0, op1, op2); + break; case 4: op0 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, 0), obj); @@ -2910,8 +2955,10 @@ substitute_placeholder_in_expr (tree exp, tree obj) && op2 == TREE_OPERAND (exp, 2) && op3 == TREE_OPERAND (exp, 3)) return exp; - else - return fold (build4 (code, TREE_TYPE (exp), op0, op1, op2, op3)); + + new_tree + = fold (build4 (code, TREE_TYPE (exp), op0, op1, op2, op3)); + break; default: gcc_unreachable (); @@ -2920,30 +2967,39 @@ substitute_placeholder_in_expr (tree exp, tree obj) case tcc_vl_exp: { - tree copy = NULL_TREE; int i; + new_tree = NULL_TREE; + for (i = 1; i < TREE_OPERAND_LENGTH (exp); i++) { tree op = TREE_OPERAND (exp, i); tree new_op = SUBSTITUTE_PLACEHOLDER_IN_EXPR (op, obj); if (new_op != op) { - if (!copy) - copy = copy_node (exp); - TREE_OPERAND (copy, i) = new_op; + if (!new_tree) + new_tree = copy_node (exp); + TREE_OPERAND (new_tree, i) = new_op; } } - if (copy) - return fold (copy); + if (new_tree) + { + new_tree = fold (new_tree); + if (TREE_CODE (new_tree) == CALL_EXPR) + process_call_operands (new_tree); + } else return exp; } + break; default: gcc_unreachable (); } + + TREE_READONLY (new_tree) |= TREE_READONLY (exp); + return new_tree; } /* Stabilize a reference so that we can use it any number of times @@ -8183,41 +8239,6 @@ build_omp_clause (location_t loc, enum omp_clause_code code) return t; } -/* Set various status flags when building a CALL_EXPR object T. */ - -static void -process_call_operands (tree t) -{ - bool side_effects; - - side_effects = TREE_SIDE_EFFECTS (t); - if (!side_effects) - { - int i, n; - n = TREE_OPERAND_LENGTH (t); - for (i = 1; i < n; i++) - { - tree op = TREE_OPERAND (t, i); - if (op && TREE_SIDE_EFFECTS (op)) - { - side_effects = 1; - break; - } - } - } - if (!side_effects) - { - int i; - - /* Calls have side-effects, except those to const or - pure functions. */ - i = call_expr_flags (t); - if ((i & ECF_LOOPING_CONST_OR_PURE) || !(i & (ECF_CONST | ECF_PURE))) - side_effects = 1; - } - TREE_SIDE_EFFECTS (t) = side_effects; -} - /* Build a tcc_vl_exp object with code CODE and room for LEN operands. LEN includes the implicit operand count in TREE_OPERAND 0, and so must be >= 1. Except for the CODE and operand count field, other storage for the diff --git a/gcc/var-tracking.c b/gcc/var-tracking.c index c4c3f3ec316..56e50c2c36d 100644 --- a/gcc/var-tracking.c +++ b/gcc/var-tracking.c @@ -182,6 +182,17 @@ typedef struct attrs_def HOST_WIDE_INT offset; } *attrs; +/* Structure holding a refcounted hash table. If refcount > 1, + it must be first unshared before modified. */ +typedef struct shared_hash_def +{ + /* Reference count. */ + int refcount; + + /* Actual hash table. */ + htab_t htab; +} *shared_hash; + /* Structure holding the IN or OUT set for a basic block. */ typedef struct dataflow_set_def { @@ -192,7 +203,7 @@ typedef struct dataflow_set_def attrs regs[FIRST_PSEUDO_REGISTER]; /* Variable locations. */ - htab_t vars; + shared_hash vars; } dataflow_set; /* The structure (one for each basic block) containing the information @@ -280,12 +291,18 @@ static alloc_pool var_pool; /* Alloc pool for struct location_chain_def. */ static alloc_pool loc_chain_pool; +/* Alloc pool for struct shared_hash_def. */ +static alloc_pool shared_hash_pool; + /* Changed variables, notes will be emitted for them. */ static htab_t changed_variables; /* Shall notes be emitted? */ static bool emit_notes; +/* Empty shared hashtable. */ +static shared_hash empty_shared_hash; + /* Local function prototypes. */ static void stack_adjust_offset_pre_post (rtx, HOST_WIDE_INT *, HOST_WIDE_INT *); @@ -305,7 +322,6 @@ static void attrs_list_insert (attrs *, tree, HOST_WIDE_INT, rtx); static void attrs_list_copy (attrs *, attrs); static void attrs_list_union (attrs *, attrs); -static void vars_clear (htab_t); static variable unshare_variable (dataflow_set *set, variable var, enum var_init_status); static int vars_copy_1 (void **, void *); @@ -321,11 +337,12 @@ static void var_mem_delete_and_set (dataflow_set *, rtx, bool, enum var_init_status, rtx); static void var_mem_delete (dataflow_set *, rtx, bool); -static void dataflow_set_init (dataflow_set *, int); +static void dataflow_set_init (dataflow_set *); static void dataflow_set_clear (dataflow_set *); static void dataflow_set_copy (dataflow_set *, dataflow_set *); static int variable_union_info_cmp_pos (const void *, const void *); static int variable_union (void **, void *); +static int variable_canonicalize (void **, void *); static void dataflow_set_union (dataflow_set *, dataflow_set *); static bool variable_part_different_p (variable_part *, variable_part *); static bool variable_different_p (variable, variable, bool); @@ -352,7 +369,7 @@ static void dump_vars (htab_t); static void dump_dataflow_set (dataflow_set *); static void dump_dataflow_sets (void); -static void variable_was_changed (variable, htab_t); +static void variable_was_changed (variable, dataflow_set *); static void set_variable_part (dataflow_set *, rtx, tree, HOST_WIDE_INT, enum var_init_status, rtx); static void clobber_variable_part (dataflow_set *, rtx, tree, HOST_WIDE_INT, @@ -742,12 +759,107 @@ attrs_list_union (attrs *dstp, attrs src) } } -/* Delete all variables from hash table VARS. */ +/* Shared hashtable support. */ + +/* Return true if VARS is shared. */ + +static inline bool +shared_hash_shared (shared_hash vars) +{ + return vars->refcount > 1; +} + +/* Return the hash table for VARS. */ + +static inline htab_t +shared_hash_htab (shared_hash vars) +{ + return vars->htab; +} + +/* Copy variables into a new hash table. */ + +static shared_hash +shared_hash_unshare (shared_hash vars) +{ + shared_hash new_vars = (shared_hash) pool_alloc (shared_hash_pool); + gcc_assert (vars->refcount > 1); + new_vars->refcount = 1; + new_vars->htab + = htab_create (htab_elements (vars->htab) + 3, variable_htab_hash, + variable_htab_eq, variable_htab_free); + vars_copy (new_vars->htab, vars->htab); + vars->refcount--; + return new_vars; +} + +/* Increment reference counter on VARS and return it. */ + +static inline shared_hash +shared_hash_copy (shared_hash vars) +{ + vars->refcount++; + return vars; +} + +/* Decrement reference counter and destroy hash table if not shared + anymore. */ static void -vars_clear (htab_t vars) +shared_hash_destroy (shared_hash vars) { - htab_empty (vars); + gcc_assert (vars->refcount > 0); + if (--vars->refcount == 0) + { + htab_delete (vars->htab); + pool_free (shared_hash_pool, vars); + } +} + +/* Unshare *PVARS if shared and return slot for DECL. If INS is + INSERT, insert it if not already present. */ + +static inline void ** +shared_hash_find_slot_unshare (shared_hash *pvars, tree decl, + enum insert_option ins) +{ + if (shared_hash_shared (*pvars)) + *pvars = shared_hash_unshare (*pvars); + return htab_find_slot_with_hash (shared_hash_htab (*pvars), decl, + VARIABLE_HASH_VAL (decl), ins); +} + +/* Return slot for DECL, if it is already present in the hash table. + If it is not present, insert it only VARS is not shared, otherwise + return NULL. */ + +static inline void ** +shared_hash_find_slot (shared_hash vars, tree decl) +{ + return htab_find_slot_with_hash (shared_hash_htab (vars), decl, + VARIABLE_HASH_VAL (decl), + shared_hash_shared (vars) + ? NO_INSERT : INSERT); +} + +/* Return slot for DECL only if it is already present in the hash table. */ + +static inline void ** +shared_hash_find_slot_noinsert (shared_hash vars, tree decl) +{ + return htab_find_slot_with_hash (shared_hash_htab (vars), decl, + VARIABLE_HASH_VAL (decl), NO_INSERT); +} + +/* Return variable for DECL or NULL if not already present in the hash + table. */ + +static inline variable +shared_hash_find (shared_hash vars, tree decl) +{ + return (variable) + htab_find_with_hash (shared_hash_htab (vars), decl, + VARIABLE_HASH_VAL (decl)); } /* Return a copy of a variable VAR and insert it to dataflow set SET. */ @@ -801,9 +913,7 @@ unshare_variable (dataflow_set *set, variable var, new_var->var_part[i].cur_loc = NULL; } - slot = htab_find_slot_with_hash (set->vars, new_var->decl, - VARIABLE_HASH_VAL (new_var->decl), - INSERT); + slot = shared_hash_find_slot_unshare (&set->vars, new_var->decl, INSERT); *slot = new_var; return new_var; } @@ -834,8 +944,7 @@ vars_copy_1 (void **slot, void *data) static void vars_copy (htab_t dst, htab_t src) { - vars_clear (dst); - htab_traverse (src, vars_copy_1, dst); + htab_traverse_noresize (src, vars_copy_1, dst); } /* Map a decl to its main debug decl. */ @@ -874,7 +983,6 @@ var_reg_set (dataflow_set *set, rtx loc, enum var_init_status initialized, static enum var_init_status get_init_value (dataflow_set *set, rtx loc, tree decl) { - void **slot; variable var; int i; enum var_init_status ret_val = VAR_INIT_STATUS_UNKNOWN; @@ -882,11 +990,9 @@ get_init_value (dataflow_set *set, rtx loc, tree decl) if (! flag_var_tracking_uninit) return VAR_INIT_STATUS_INITIALIZED; - slot = htab_find_slot_with_hash (set->vars, decl, VARIABLE_HASH_VAL (decl), - NO_INSERT); - if (slot) + var = shared_hash_find (set->vars, decl); + if (var) { - var = * (variable *) slot; for (i = 0; i < var->n_var_parts && ret_val == VAR_INIT_STATUS_UNKNOWN; i++) { location_chain nextp; @@ -1050,11 +1156,10 @@ var_mem_delete (dataflow_set *set, rtx loc, bool clobber) VARS_SIZE is the initial size of hash table VARS. */ static void -dataflow_set_init (dataflow_set *set, int vars_size) +dataflow_set_init (dataflow_set *set) { init_attrs_list_set (set->regs); - set->vars = htab_create (vars_size, variable_htab_hash, variable_htab_eq, - variable_htab_free); + set->vars = shared_hash_copy (empty_shared_hash); set->stack_adjust = 0; } @@ -1068,7 +1173,8 @@ dataflow_set_clear (dataflow_set *set) for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) attrs_list_clear (&set->regs[i]); - vars_clear (set->vars); + shared_hash_destroy (set->vars); + set->vars = shared_hash_copy (empty_shared_hash); } /* Copy the contents of dataflow set SRC to DST. */ @@ -1081,7 +1187,8 @@ dataflow_set_copy (dataflow_set *dst, dataflow_set *src) for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) attrs_list_copy (&dst->regs[i], src->regs[i]); - vars_copy (dst->vars, src->vars); + shared_hash_destroy (dst->vars); + dst->vars = shared_hash_copy (src->vars); dst->stack_adjust = src->stack_adjust; } @@ -1129,15 +1236,14 @@ variable_union_info_cmp_pos (const void *n1, const void *n2) static int variable_union (void **slot, void *data) { - variable src, dst, *dstp; + variable src, dst; + void **dstp; dataflow_set *set = (dataflow_set *) data; int i, j, k; src = *(variable *) slot; - dstp = (variable *) htab_find_slot_with_hash (set->vars, src->decl, - VARIABLE_HASH_VAL (src->decl), - INSERT); - if (!*dstp) + dstp = shared_hash_find_slot (set->vars, src->decl); + if (!dstp || !*dstp) { src->refcount++; @@ -1162,16 +1268,23 @@ variable_union (void **slot, void *data) if (! flag_var_tracking_uninit) status = VAR_INIT_STATUS_INITIALIZED; + if (dstp) + *dstp = (void *) src; unshare_variable (set, src, status); } else - *dstp = src; + { + if (!dstp) + dstp = shared_hash_find_slot_unshare (&set->vars, src->decl, + INSERT); + *dstp = (void *) src; + } /* Continue traversing the hash table. */ return 1; } else - dst = *dstp; + dst = (variable) *dstp; gcc_assert (src->n_var_parts); @@ -1196,7 +1309,8 @@ variable_union (void **slot, void *data) thus there are at most MAX_VAR_PARTS different offsets. */ gcc_assert (k <= MAX_VAR_PARTS); - if (dst->refcount > 1 && dst->n_var_parts != k) + if ((dst->refcount > 1 || shared_hash_shared (set->vars)) + && dst->n_var_parts != k) { enum var_init_status status = VAR_INIT_STATUS_UNKNOWN; @@ -1226,7 +1340,7 @@ variable_union (void **slot, void *data) /* If DST is shared compare the location chains. If they are different we will modify the chain in DST with high probability so make a copy of DST. */ - if (dst->refcount > 1) + if (dst->refcount > 1 || shared_hash_shared (set->vars)) { for (node = src->var_part[i].loc_chain, node2 = dst->var_part[j].loc_chain; node && node2; @@ -1379,6 +1493,46 @@ variable_union (void **slot, void *data) return 1; } +/* Like variable_union, but only used when doing dataflow_set_union + into an empty hashtab. To allow sharing, dst is initially shared + with src (so all variables are "copied" from src to dst hashtab), + so only unshare_variable for variables that need canonicalization + are needed. */ + +static int +variable_canonicalize (void **slot, void *data) +{ + variable src; + dataflow_set *set = (dataflow_set *) data; + int k; + + src = *(variable *) slot; + + /* If CUR_LOC of some variable part is not the first element of + the location chain we are going to change it so we have to make + a copy of the variable. */ + for (k = 0; k < src->n_var_parts; k++) + { + gcc_assert (!src->var_part[k].loc_chain == !src->var_part[k].cur_loc); + if (src->var_part[k].loc_chain) + { + gcc_assert (src->var_part[k].cur_loc); + if (src->var_part[k].cur_loc != src->var_part[k].loc_chain->loc) + break; + } + } + if (k < src->n_var_parts) + { + enum var_init_status status = VAR_INIT_STATUS_UNKNOWN; + + if (! flag_var_tracking_uninit) + status = VAR_INIT_STATUS_INITIALIZED; + + unshare_variable (set, src, status); + } + return 1; +} + /* Compute union of dataflow sets SRC and DST and store it to DST. */ static void @@ -1389,7 +1543,14 @@ dataflow_set_union (dataflow_set *dst, dataflow_set *src) for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) attrs_list_union (&dst->regs[i], src->regs[i]); - htab_traverse (src->vars, variable_union, dst); + if (dst->vars == empty_shared_hash) + { + shared_hash_destroy (dst->vars); + dst->vars = shared_hash_copy (src->vars); + htab_traverse (shared_hash_htab (src->vars), variable_canonicalize, dst); + } + else + htab_traverse (shared_hash_htab (src->vars), variable_union, dst); } /* Flag whether two dataflow sets being compared contain different data. */ @@ -1522,15 +1683,24 @@ dataflow_set_different_2 (void **slot, void *data) static bool dataflow_set_different (dataflow_set *old_set, dataflow_set *new_set) { + if (old_set->vars == new_set->vars) + return false; + + if (htab_elements (shared_hash_htab (old_set->vars)) + != htab_elements (shared_hash_htab (new_set->vars))) + return true; + dataflow_set_different_value = false; - htab_traverse (old_set->vars, dataflow_set_different_1, new_set->vars); + htab_traverse (shared_hash_htab (old_set->vars), dataflow_set_different_1, + shared_hash_htab (new_set->vars)); if (!dataflow_set_different_value) { /* We have compared the variables which are in both hash tables so now only check whether there are some variables in NEW_SET->VARS which are not in OLD_SET->VARS. */ - htab_traverse (new_set->vars, dataflow_set_different_2, old_set->vars); + htab_traverse (shared_hash_htab (new_set->vars), dataflow_set_different_2, + shared_hash_htab (old_set->vars)); } return dataflow_set_different_value; } @@ -1545,7 +1715,7 @@ dataflow_set_destroy (dataflow_set *set) for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) attrs_list_clear (&set->regs[i]); - htab_delete (set->vars); + shared_hash_destroy (set->vars); set->vars = NULL; } @@ -1985,7 +2155,6 @@ find_src_set_src (dataflow_set *set, rtx src) { tree decl = NULL_TREE; /* The variable being copied around. */ rtx set_src = NULL_RTX; /* The value for "decl" stored in "src". */ - void **slot; variable var; location_chain nextp; int i; @@ -1998,12 +2167,9 @@ find_src_set_src (dataflow_set *set, rtx src) if (src && decl) { - slot = htab_find_slot_with_hash (set->vars, decl, - VARIABLE_HASH_VAL (decl), NO_INSERT); - - if (slot) + var = shared_hash_find (set->vars, decl); + if (var) { - var = *(variable *) slot; found = false; for (i = 0; i < var->n_var_parts && !found; i++) for (nextp = var->var_part[i].loc_chain; nextp && !found; @@ -2031,7 +2197,7 @@ compute_bb_dataflow (basic_block bb) dataflow_set *in = &VTI (bb)->in; dataflow_set *out = &VTI (bb)->out; - dataflow_set_init (&old_out, htab_elements (VTI (bb)->out.vars) + 3); + dataflow_set_init (&old_out); dataflow_set_copy (&old_out, out); dataflow_set_copy (out, in); @@ -2323,7 +2489,7 @@ dump_dataflow_set (dataflow_set *set) dump_attrs_list (set->regs[i]); } } - dump_vars (set->vars); + dump_vars (shared_hash_htab (set->vars)); fprintf (dump_file, "\n"); } @@ -2345,10 +2511,10 @@ dump_dataflow_sets (void) } /* Add variable VAR to the hash table of changed variables and - if it has no locations delete it from hash table HTAB. */ + if it has no locations delete it from SET's hash table. */ static void -variable_was_changed (variable var, htab_t htab) +variable_was_changed (variable var, dataflow_set *set) { hashval_t hash = VARIABLE_HASH_VAL (var->decl); @@ -2359,36 +2525,39 @@ variable_was_changed (variable var, htab_t htab) slot = (variable *) htab_find_slot_with_hash (changed_variables, var->decl, hash, INSERT); - if (htab && var->n_var_parts == 0) + if (set && var->n_var_parts == 0) { variable empty_var; - void **old; empty_var = (variable) pool_alloc (var_pool); empty_var->decl = var->decl; empty_var->refcount = 1; empty_var->n_var_parts = 0; *slot = empty_var; - - old = htab_find_slot_with_hash (htab, var->decl, hash, - NO_INSERT); - if (old) - htab_clear_slot (htab, old); + goto drop_var; } else { + var->refcount++; *slot = var; } } else { - gcc_assert (htab); + gcc_assert (set); if (var->n_var_parts == 0) { - void **slot = htab_find_slot_with_hash (htab, var->decl, hash, - NO_INSERT); + void **slot; + + drop_var: + slot = shared_hash_find_slot_noinsert (set->vars, var->decl); if (slot) - htab_clear_slot (htab, slot); + { + if (shared_hash_shared (set->vars)) + slot = shared_hash_find_slot_unshare (&set->vars, var->decl, + NO_INSERT); + htab_clear_slot (shared_hash_htab (set->vars), slot); + } } } } @@ -2438,12 +2607,12 @@ set_variable_part (dataflow_set *set, rtx loc, tree decl, HOST_WIDE_INT offset, location_chain node, next; location_chain *nextp; variable var; - void **slot; - - slot = htab_find_slot_with_hash (set->vars, decl, - VARIABLE_HASH_VAL (decl), INSERT); - if (!*slot) + void **slot = shared_hash_find_slot (set->vars, decl); + + if (!slot || !*slot) { + if (!slot) + slot = shared_hash_find_slot_unshare (&set->vars, decl, INSERT); /* Create new variable information. */ var = (variable) pool_alloc (var_pool); var->decl = decl; @@ -2479,13 +2648,12 @@ set_variable_part (dataflow_set *set, rtx loc, tree decl, HOST_WIDE_INT offset, if (set_src != NULL) node->set_src = set_src; - *slot = var; return; } else { /* We have to make a copy of a shared variable. */ - if (var->refcount > 1) + if (var->refcount > 1 || shared_hash_shared (set->vars)) var = unshare_variable (set, var, initialized); } } @@ -2494,7 +2662,7 @@ set_variable_part (dataflow_set *set, rtx loc, tree decl, HOST_WIDE_INT offset, /* We have not found the location part, new one will be created. */ /* We have to make a copy of the shared variable. */ - if (var->refcount > 1) + if (var->refcount > 1 || shared_hash_shared (set->vars)) var = unshare_variable (set, var, initialized); /* We track only variables whose size is <= MAX_VAR_PARTS bytes @@ -2548,7 +2716,7 @@ set_variable_part (dataflow_set *set, rtx loc, tree decl, HOST_WIDE_INT offset, if (var->var_part[pos].cur_loc == NULL) { var->var_part[pos].cur_loc = loc; - variable_was_changed (var, set->vars); + variable_was_changed (var, set); } } @@ -2561,16 +2729,14 @@ static void clobber_variable_part (dataflow_set *set, rtx loc, tree decl, HOST_WIDE_INT offset, rtx set_src) { - void **slot; + variable var; if (! decl || ! DECL_P (decl)) return; - slot = htab_find_slot_with_hash (set->vars, decl, VARIABLE_HASH_VAL (decl), - NO_INSERT); - if (slot) + var = shared_hash_find (set->vars, decl); + if (var) { - variable var = (variable) *slot; int pos = find_variable_location_part (var, offset, NULL); if (pos >= 0) @@ -2627,13 +2793,9 @@ static void delete_variable_part (dataflow_set *set, rtx loc, tree decl, HOST_WIDE_INT offset) { - void **slot; - - slot = htab_find_slot_with_hash (set->vars, decl, VARIABLE_HASH_VAL (decl), - NO_INSERT); - if (slot) + variable var = shared_hash_find (set->vars, decl);; + if (var) { - variable var = (variable) *slot; int pos = find_variable_location_part (var, offset, NULL); if (pos >= 0) @@ -2642,7 +2804,7 @@ delete_variable_part (dataflow_set *set, rtx loc, tree decl, location_chain *nextp; bool changed; - if (var->refcount > 1) + if (var->refcount > 1 || shared_hash_shared (set->vars)) { /* If the variable contains the location part we have to make a copy of the variable. */ @@ -2705,7 +2867,7 @@ delete_variable_part (dataflow_set *set, rtx loc, tree decl, } } if (changed) - variable_was_changed (var, set->vars); + variable_was_changed (var, set); } } } @@ -2864,14 +3026,6 @@ emit_note_insn_var_location (void **varp, void *data) htab_clear_slot (changed_variables, varp); - /* When there are no location parts the variable has been already - removed from hash table and a new empty variable was created. - Free the empty variable. */ - if (var->n_var_parts == 0) - { - pool_free (var_pool, var); - } - /* Continue traversing the hash table. */ return 1; } @@ -2910,7 +3064,7 @@ emit_notes_for_differences_1 (void **slot, void *data) empty_var = (variable) pool_alloc (var_pool); empty_var->decl = old_var->decl; - empty_var->refcount = 1; + empty_var->refcount = 0; empty_var->n_var_parts = 0; variable_was_changed (empty_var, NULL); } @@ -2952,8 +3106,12 @@ static void emit_notes_for_differences (rtx insn, dataflow_set *old_set, dataflow_set *new_set) { - htab_traverse (old_set->vars, emit_notes_for_differences_1, new_set->vars); - htab_traverse (new_set->vars, emit_notes_for_differences_2, old_set->vars); + htab_traverse (shared_hash_htab (old_set->vars), + emit_notes_for_differences_1, + shared_hash_htab (new_set->vars)); + htab_traverse (shared_hash_htab (new_set->vars), + emit_notes_for_differences_2, + shared_hash_htab (old_set->vars)); emit_notes_for_changes (insn, EMIT_NOTE_BEFORE_INSN); } @@ -2965,7 +3123,7 @@ emit_notes_in_bb (basic_block bb) int i; dataflow_set set; - dataflow_set_init (&set, htab_elements (VTI (bb)->in.vars) + 3); + dataflow_set_init (&set); dataflow_set_copy (&set, &VTI (bb)->in); for (i = 0; i < VTI (bb)->n_mos; i++) @@ -3098,7 +3256,7 @@ vt_emit_notes (void) delete_variable_part). */ emit_notes = true; - dataflow_set_init (&empty, 7); + dataflow_set_init (&empty); last_out = ∅ FOR_EACH_BB (bb) @@ -3343,14 +3501,6 @@ vt_initialize (void) } } - /* Init the IN and OUT sets. */ - FOR_ALL_BB (bb) - { - VTI (bb)->visited = false; - dataflow_set_init (&VTI (bb)->in, 7); - dataflow_set_init (&VTI (bb)->out, 7); - } - attrs_pool = create_alloc_pool ("attrs_def pool", sizeof (struct attrs_def), 1024); var_pool = create_alloc_pool ("variable_def pool", @@ -3358,8 +3508,24 @@ vt_initialize (void) loc_chain_pool = create_alloc_pool ("location_chain_def pool", sizeof (struct location_chain_def), 1024); + shared_hash_pool = create_alloc_pool ("shared_hash_def pool", + sizeof (struct shared_hash_def), 256); + empty_shared_hash = (shared_hash) pool_alloc (shared_hash_pool); + empty_shared_hash->refcount = 1; + empty_shared_hash->htab + = htab_create (1, variable_htab_hash, variable_htab_eq, + variable_htab_free); changed_variables = htab_create (10, variable_htab_hash, variable_htab_eq, - NULL); + variable_htab_free); + + /* Init the IN and OUT sets. */ + FOR_ALL_BB (bb) + { + VTI (bb)->visited = false; + dataflow_set_init (&VTI (bb)->in); + dataflow_set_init (&VTI (bb)->out); + } + vt_add_function_parameters (); } @@ -3381,10 +3547,12 @@ vt_finalize (void) dataflow_set_destroy (&VTI (bb)->out); } free_aux_for_blocks (); + htab_delete (empty_shared_hash->htab); + htab_delete (changed_variables); free_alloc_pool (attrs_pool); free_alloc_pool (var_pool); free_alloc_pool (loc_chain_pool); - htab_delete (changed_variables); + free_alloc_pool (shared_hash_pool); } /* The entry point to variable tracking pass. */ diff --git a/gcc/varasm.c b/gcc/varasm.c index c749f959c78..f7d1d1871f9 100644 --- a/gcc/varasm.c +++ b/gcc/varasm.c @@ -3445,7 +3445,7 @@ const_rtx_hash_1 (rtx *xp, void *data) hwi = INTVAL (x); fold_hwi: { - const int shift = sizeof (hashval_t) * CHAR_BIT; + int shift = sizeof (hashval_t) * CHAR_BIT; const int n = sizeof (HOST_WIDE_INT) / sizeof (hashval_t); int i; diff --git a/libcpp/ChangeLog b/libcpp/ChangeLog index e6ef4c31b07..d7146588f09 100644 --- a/libcpp/ChangeLog +++ b/libcpp/ChangeLog @@ -1,3 +1,7 @@ +2009-06-18 Manuel López-Ibáñez <manu@gcc.gnu.org> + + * expr.c (num_div_op): Take explicit location. + 2009-06-17 Ian Lance Taylor <iant@google.com> * include/cpplib.h (progname): Don't declare. diff --git a/libcpp/expr.c b/libcpp/expr.c index 6887b165690..96dd2fde24c 100644 --- a/libcpp/expr.c +++ b/libcpp/expr.c @@ -52,7 +52,8 @@ static cpp_num num_inequality_op (cpp_reader *, cpp_num, cpp_num, static cpp_num num_equality_op (cpp_reader *, cpp_num, cpp_num, enum cpp_ttype); static cpp_num num_mul (cpp_reader *, cpp_num, cpp_num); -static cpp_num num_div_op (cpp_reader *, cpp_num, cpp_num, enum cpp_ttype); +static cpp_num num_div_op (cpp_reader *, cpp_num, cpp_num, enum cpp_ttype, + source_location); static cpp_num num_lshift (cpp_num, size_t, size_t); static cpp_num num_rshift (cpp_num, size_t, size_t); @@ -1123,7 +1124,7 @@ reduce (cpp_reader *pfile, struct op *top, enum cpp_ttype op) case CPP_DIV: case CPP_MOD: top[-1].value = num_div_op (pfile, top[-1].value, - top->value, top->op); + top->value, top->op, top->loc); top[-1].loc = top->loc; break; @@ -1668,10 +1669,13 @@ num_mul (cpp_reader *pfile, cpp_num lhs, cpp_num rhs) return result; } -/* Divide two preprocessing numbers, returning the answer or the - remainder depending upon OP. */ +/* Divide two preprocessing numbers, LHS and RHS, returning the answer + or the remainder depending upon OP. LOCATION is the source location + of this operator (for diagnostics). */ + static cpp_num -num_div_op (cpp_reader *pfile, cpp_num lhs, cpp_num rhs, enum cpp_ttype op) +num_div_op (cpp_reader *pfile, cpp_num lhs, cpp_num rhs, enum cpp_ttype op, + source_location location) { cpp_num result, sub; cpp_num_part mask; @@ -1711,7 +1715,8 @@ num_div_op (cpp_reader *pfile, cpp_num lhs, cpp_num rhs, enum cpp_ttype op) else { if (!pfile->state.skip_eval) - cpp_error (pfile, CPP_DL_ERROR, "division by zero in #if"); + cpp_error_with_line (pfile, CPP_DL_ERROR, location, 0, + "division by zero in #if"); return lhs; } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 51065aee4bb..4b4a3535d26 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,455 @@ +2009-06-21 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/37577 + Port from fortran-dev + * runtime/in_pack_generic (internal_pack): Remove unnecessary + test for stride == 0. + * runtime/in_unpack_generic.c (internal_unpack): Likewise. + * intrinsics/iso_c_binding.c (c_f_pointer_u0): Take care + of stride in "shape" argument. Use array access macros for + accessing array descriptors. + * libgfortran.h (struct descriptor_dimension): Change stride + to _stride, lbound to _lbound and ubound to _ubound. + (GFC_DIMENSION_LBOUND): Use new name(s) in struct + descriptor_dimension. + (GFC_DIMENSION_UBOUND): Likewise. + (GFC_DIMENSION_STRIDE): Likewise. + (GFC_DIMENSION_EXTENT): Likewise. + (GFC_DIMENSION_SET): Likewise. + (GFC_DESCRIPTOR_LBOUND): Likewise. + (GFC_DESCRIPTOR_UBOUND): Likewise. + (GFC_DESCRIPTOR_EXTENT): Likewise. + (GFC_DESCRIPTOR_STRIDE): Likewise. + * io/transfer.c (transfer_array): Use array access macros. + Use byte-sized strides. + * intrinsics/eoshift0.c (eoshift0): Use array access + macros everywhere. + * m4/in_pack.m4 (internal_pack_'rtype_ccode`): Use + array access macros for accessing array descriptors. + * m4/in_unpack.m4 (internal_unpack_'rtype_ccode`): + Likewise. + * m4/matmull.m4 (matmul_'rtype_code`): Likewise. + * m4/matmul.m4 (matmul_'rtype_code`): Likewise. + * m4/unpack.m4 (unpack0_'rtype_code`): Likewise. + (unpack1_'rtype_code`): Likewise. + * m4/ifunction_logical.m4 (name`'rtype_qual`_'atype_code): Likewise. + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Use array access + macros everywhere. + * intrinsics/dtime.c (dtime_sub): Use array access macros + for accessing array descriptors. + * intrinsics/cshift0 (cshift0): Likewise. + * intrinsics/etime.c: Likewise. Remove redundant calculation + of rdim. + * m4/cshift0.m4 (cshift0_'rtype_code`): Use array access macros + for accessing array descriptors. + * m4/pack.m4 (pack_'rtype_code`): Likewise. + * m4/spread.m4 (spread_'rtype_code`): Likewise. + (spread_scalar_'rtype_code`): Likewise. + * m4/transpose.m4 (transpose_'rtype_code`): Likewise. + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise. + * m4/eoshift1.m4 (eoshift1): Likewise. Remove size argument, + calculate within function. + (eoshift1_'atype_kind`): Remove size argument from call + to eoshift1. + (eoshift1_'atype_kind`_char): Likewise. + (eoshift1_'atype_kind`_char4): Likewise. + * m4/eoshift3.m4 (eoshift3): Remove size argument, calculate + within function. Use array access macros for accessing array + descriptors. + (eoshift3_'atype_kind`): Remove size argument from call + to eoshift1. + (eoshift3_'atype_kind`_char): Likewise. + (eoshift3_'atype_kind`_char4): Likewise. + * m4/shape.m4 (shape_'rtype_kind`): Use array access macros + for accessing array descriptors. + * m4/cshift1.m4 (cshift1): Remove size argument, calculate + within function. Use array access macros for accessing array + descriptors. + (cshift1_'atype_kind`): Remove size argument from call to + cshift1. + (cshift1_'atype_kind`_char): Remove size argument from call to + cshift1. + (cshift1_'atype_kind`_char4): Remove size argument from call to + cshift1. + * m4/reshape.m4 (reshape_'rtype_ccode`): Use array access macros + for accessing array descriptors. + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Likewise. + * intrinsics/pack_generic.c (pack_internal): Use array access + macros for accessing array descriptors. + (pack_s_internal): Likewise. + * intrinsics/transpose_generic.c (transpose_internal): Remove + size argument, calculate from array descriptor. Use array + access macros for accessing array descriptors. + (transpose): Remove size argument from call. + (transpoe_char): Likewise. + (transpose_char4): Likewise. + * intrinsics/move_alloc.c (move_alloc): Use array access macros + for accessing array descriptors. + * intrinsics/spread_generic.c (spread_internal): Remove size + argument, calculate from array descriptor. Use array access + macros for accessing array descriptors. + (spread_internal_scalar): Likewise. + (spread): Remove size argument from call to spread_internal. + (spread_char): Mark argument source_length as unused. + Remove size argument from call to spread_internal. + (spread_char4): Likewise. + (spread_char_scalar): Likewise. + (spread_char4_scalar): Likewise. + * intrinsics/unpack_generic.c (unpack_internal): Use array access + macros for accessing array descriptors. + * intrinsics/eoshift2.c (eoshift2): Remove size argument, calculate + from array descriptor instead. Use array access macros for + accessing array descriptors. + (eoshift2_##N): Remove size argument from call to eoshift2. + (eoshift2_##N_##char): Likewise. + (eoshift2_##N_##char4): Likewise. + * intrinsics/reshape_generic.c (reshape_internal): Use array + access macross for accessing array descriptors. + * libgfortran.h: Introduce new macros GFC_DIMENSION_LBOUND, + GFC_DIMENSION_UBOUND,GFC_DIMENSION_STRIDE, GFC_DIMENSION_EXTENT, + GFC_DIMENSION_SET, GFC_DESCRIPTOR_LBOUND, GFC_DESCRIPTOR_UBOUND, + GFC_DESCRIPTOR_EXTENT, GFC_DESCRIPTOR_EXTENT_BYTES, + GFC_DESCRIPTOR_STRIDE, GFC_DESCRIPTOR_STRIDE_BYTES + * runtime/in_pack_generic.c (internal_pack): Use new macros + for array descriptor access. + * runtime/in_unpack_generic.c (internal_unpack): Likewise. + * intrinsics/dtime.c (dtime_sub): Likewise. + * intrinsics/cshift0 (cshift0): Remove argument size, + calculate directly from the array descriptor. Use new macros + for array descriptor access. + * cshift0_##N: Remove shift argument in call to cshift0. + * cshift0_##N_char: Mark array_length as unused. Remove + array_length in call to cshift0. + * cshift0_##N_char4: Likewise. + * intrisics/etime.c: Use new macros for array descriptor access. + * intrinsics/stat.c (stat_i4_sub_0): Likewise. + (stat_i8_sub_0): Likewise. + (fstat_i4_sub): Likewise. + (fstat_i8_sub): Likewise. + * intrinsics/date_and_time.c (date_and_time): Likewise. + (secnds): Likewise. + (itime_i4): Likewise. + (itime_i8): Likewise. + (idate_i4): Likewise. + (idate_i8): Likewise. + (gmtime_i4): Likewise. + (gmtime_i8): Likewise. + (ltime_i4): Likewise. + (litme_i8): Likewise. + * intrinsics/associated.c (associated): Likewise. + * intrinsics/eoshift0.c (eoshift0): Likewise. + * intriniscs/size.c (size0): Likewise. + * intrinsics/random.c (arandom_r4): Likewise. + (arandom_r8): Likewise. + (arandom_r10): Likewise. + (arandom_r16): Likewise. + (random_seed_i4): Likewise. + (random_seed_i8): Likewise. + * io/list_read.c (nml_parse_qualifier): Likewise. + (nml_touch_nodes): Likewise. + (nml_read_obj): Likewise. + (get_name): Likewise. + * io/transfer.c (transfer_array): Likewise. + (init_loop_spec): Likewise. + (st_set_nml_var_dim): Likewise. + * io/write.c (nml_write_obj): Likewise. + (obj_loop): Likewise. + * generated/all_l1.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/cshift0_c10.c: Regenerated. + * generated/cshift0_c16.c: Regenerated. + * generated/cshift0_c4.c: Regenerated. + * generated/cshift0_c8.c: Regenerated. + * generated/cshift0_i1.c: Regenerated. + * generated/cshift0_i16.c: Regenerated. + * generated/cshift0_i2.c: Regenerated. + * generated/cshift0_i4.c: Regenerated. + * generated/cshift0_i8.c: Regenerated. + * generated/cshift0_r10.c: Regenerated. + * generated/cshift0_r16.c: Regenerated. + * generated/cshift0_r4.c: Regenerated. + * generated/cshift0_r8.c: Regenerated. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/in_pack_c10.c: Regenerated. + * generated/in_pack_c16.c: Regenerated. + * generated/in_pack_c4.c: Regenerated. + * generated/in_pack_c8.c: Regenerated. + * generated/in_pack_i1.c: Regenerated. + * generated/in_pack_i16.c: Regenerated. + * generated/in_pack_i2.c: Regenerated. + * generated/in_pack_i4.c: Regenerated. + * generated/in_pack_i8.c: Regenerated. + * generated/in_pack_r10.c: Regenerated. + * generated/in_pack_r16.c: Regenerated. + * generated/in_pack_r4.c: Regenerated. + * generated/in_pack_r8.c: Regenerated. + * generated/in_unpack_c10.c: Regenerated. + * generated/in_unpack_c16.c: Regenerated. + * generated/in_unpack_c4.c: Regenerated. + * generated/in_unpack_c8.c: Regenerated. + * generated/in_unpack_i1.c: Regenerated. + * generated/in_unpack_i16.c: Regenerated. + * generated/in_unpack_i2.c: Regenerated. + * generated/in_unpack_i4.c: Regenerated. + * generated/in_unpack_i8.c: Regenerated. + * generated/in_unpack_r10.c: Regenerated. + * generated/in_unpack_r16.c: Regenerated. + * generated/in_unpack_r4.c: Regenerated. + * generated/in_unpack_r8.c: Regenerated. + * generated/matmul_c10.c: Regenerated. + * generated/matmul_c16.c: Regenerated. + * generated/matmul_c4.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/matmul_i1.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/pack_c10.c: Regenerated. + * generated/pack_c16.c: Regenerated. + * generated/pack_c4.c: Regenerated. + * generated/pack_c8.c: Regenerated. + * generated/pack_i1.c: Regenerated. + * generated/pack_i16.c: Regenerated. + * generated/pack_i2.c: Regenerated. + * generated/pack_i4.c: Regenerated. + * generated/pack_i8.c: Regenerated. + * generated/pack_r10.c: Regenerated. + * generated/pack_r16.c: Regenerated. + * generated/pack_r4.c: Regenerated. + * generated/pack_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/shape_i16.c: Regenerated. + * generated/shape_i4.c: Regenerated. + * generated/shape_i8.c: Regenerated. + * generated/spread_c10.c: Regenerated. + * generated/spread_c16.c: Regenerated. + * generated/spread_c4.c: Regenerated. + * generated/spread_c8.c: Regenerated. + * generated/spread_i1.c: Regenerated. + * generated/spread_i16.c: Regenerated. + * generated/spread_i2.c: Regenerated. + * generated/spread_i4.c: Regenerated. + * generated/spread_i8.c: Regenerated. + * generated/spread_r10.c: Regenerated. + * generated/spread_r16.c: Regenerated. + * generated/spread_r4.c: Regenerated. + * generated/spread_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + * generated/transpose_c10.c: Regenerated. + * generated/transpose_c16.c: Regenerated. + * generated/transpose_c4.c: Regenerated. + * generated/transpose_c8.c: Regenerated. + * generated/transpose_i16.c: Regenerated. + * generated/transpose_i4.c: Regenerated. + * generated/transpose_i8.c: Regenerated. + * generated/transpose_r10.c: Regenerated. + * generated/transpose_r16.c: Regenerated. + * generated/transpose_r4.c: Regenerated. + * generated/transpose_r8.c: Regenerated. + * generated/unpack_c10.c: Regenerated. + * generated/unpack_c16.c: Regenerated. + * generated/unpack_c4.c: Regenerated. + * generated/unpack_c8.c: Regenerated. + * generated/unpack_i1.c: Regenerated. + * generated/unpack_i16.c: Regenerated. + * generated/unpack_i2.c: Regenerated. + * generated/unpack_i4.c: Regenerated. + * generated/unpack_i8.c: Regenerated. + * generated/unpack_r10.c: Regenerated. + * generated/unpack_r16.c: Regenerated. + * generated/unpack_r4.c: Regenerated. + * generated/unpack_r8.c: Regenerated. + 2009-06-14 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> * fmain.c (main): Don't PREFIX set_args. diff --git a/libgfortran/generated/all_l1.c b/libgfortran/generated/all_l1.c index afde913e73f..486bab2e436 100644 --- a/libgfortran/generated/all_l1.c +++ b/libgfortran/generated/all_l1.c @@ -60,25 +60,24 @@ all_l1 (gfc_array_l1 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ all_l1 (gfc_array_l1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ all_l1 (gfc_array_l1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" @@ -142,7 +140,7 @@ all_l1 (gfc_array_l1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/all_l16.c b/libgfortran/generated/all_l16.c index 422fb894dd5..35f8a9621b4 100644 --- a/libgfortran/generated/all_l16.c +++ b/libgfortran/generated/all_l16.c @@ -60,25 +60,24 @@ all_l16 (gfc_array_l16 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ all_l16 (gfc_array_l16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ all_l16 (gfc_array_l16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" @@ -142,7 +140,7 @@ all_l16 (gfc_array_l16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/all_l2.c b/libgfortran/generated/all_l2.c index 00f0886cb36..81532ea431b 100644 --- a/libgfortran/generated/all_l2.c +++ b/libgfortran/generated/all_l2.c @@ -60,25 +60,24 @@ all_l2 (gfc_array_l2 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ all_l2 (gfc_array_l2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ all_l2 (gfc_array_l2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" @@ -142,7 +140,7 @@ all_l2 (gfc_array_l2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/all_l4.c b/libgfortran/generated/all_l4.c index 500d4a52c11..6657e15cd89 100644 --- a/libgfortran/generated/all_l4.c +++ b/libgfortran/generated/all_l4.c @@ -60,25 +60,24 @@ all_l4 (gfc_array_l4 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ all_l4 (gfc_array_l4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ all_l4 (gfc_array_l4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" @@ -142,7 +140,7 @@ all_l4 (gfc_array_l4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/all_l8.c b/libgfortran/generated/all_l8.c index 90f287ccd34..4c3d5563f83 100644 --- a/libgfortran/generated/all_l8.c +++ b/libgfortran/generated/all_l8.c @@ -60,25 +60,24 @@ all_l8 (gfc_array_l8 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ all_l8 (gfc_array_l8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ all_l8 (gfc_array_l8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ALL intrinsic in dimension %d:" @@ -142,7 +140,7 @@ all_l8 (gfc_array_l8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/any_l1.c b/libgfortran/generated/any_l1.c index 0186730a80d..a69f22e6f82 100644 --- a/libgfortran/generated/any_l1.c +++ b/libgfortran/generated/any_l1.c @@ -60,25 +60,24 @@ any_l1 (gfc_array_l1 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ any_l1 (gfc_array_l1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ any_l1 (gfc_array_l1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" @@ -142,7 +140,7 @@ any_l1 (gfc_array_l1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/any_l16.c b/libgfortran/generated/any_l16.c index 13f78a0075e..b5ab5b214ac 100644 --- a/libgfortran/generated/any_l16.c +++ b/libgfortran/generated/any_l16.c @@ -60,25 +60,24 @@ any_l16 (gfc_array_l16 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ any_l16 (gfc_array_l16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ any_l16 (gfc_array_l16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" @@ -142,7 +140,7 @@ any_l16 (gfc_array_l16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/any_l2.c b/libgfortran/generated/any_l2.c index b37d9cb58b7..05673e8daba 100644 --- a/libgfortran/generated/any_l2.c +++ b/libgfortran/generated/any_l2.c @@ -60,25 +60,24 @@ any_l2 (gfc_array_l2 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ any_l2 (gfc_array_l2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ any_l2 (gfc_array_l2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" @@ -142,7 +140,7 @@ any_l2 (gfc_array_l2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/any_l4.c b/libgfortran/generated/any_l4.c index b157812964d..8f82741701f 100644 --- a/libgfortran/generated/any_l4.c +++ b/libgfortran/generated/any_l4.c @@ -60,25 +60,24 @@ any_l4 (gfc_array_l4 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ any_l4 (gfc_array_l4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ any_l4 (gfc_array_l4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" @@ -142,7 +140,7 @@ any_l4 (gfc_array_l4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/any_l8.c b/libgfortran/generated/any_l8.c index f66b00f41bf..2a094f0a5fe 100644 --- a/libgfortran/generated/any_l8.c +++ b/libgfortran/generated/any_l8.c @@ -60,25 +60,24 @@ any_l8 (gfc_array_l8 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ any_l8 (gfc_array_l8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_LOGICAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_LOGICAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ any_l8 (gfc_array_l8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " ANY intrinsic in dimension %d:" @@ -142,7 +140,7 @@ any_l8 (gfc_array_l8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/count_16_l.c b/libgfortran/generated/count_16_l.c index c0a488e478d..8c3fc7d9a16 100644 --- a/libgfortran/generated/count_16_l.c +++ b/libgfortran/generated/count_16_l.c @@ -60,25 +60,24 @@ count_16_l (gfc_array_i16 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ count_16_l (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ count_16_l (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" @@ -142,7 +140,7 @@ count_16_l (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/count_1_l.c b/libgfortran/generated/count_1_l.c index a2368975923..faf9176943c 100644 --- a/libgfortran/generated/count_1_l.c +++ b/libgfortran/generated/count_1_l.c @@ -60,25 +60,24 @@ count_1_l (gfc_array_i1 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ count_1_l (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ count_1_l (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" @@ -142,7 +140,7 @@ count_1_l (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/count_2_l.c b/libgfortran/generated/count_2_l.c index 7ae90f24d7f..0d1a22339e9 100644 --- a/libgfortran/generated/count_2_l.c +++ b/libgfortran/generated/count_2_l.c @@ -60,25 +60,24 @@ count_2_l (gfc_array_i2 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ count_2_l (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ count_2_l (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" @@ -142,7 +140,7 @@ count_2_l (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/count_4_l.c b/libgfortran/generated/count_4_l.c index 75f0f582dd5..d4bfbd47ef3 100644 --- a/libgfortran/generated/count_4_l.c +++ b/libgfortran/generated/count_4_l.c @@ -60,25 +60,24 @@ count_4_l (gfc_array_i4 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ count_4_l (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ count_4_l (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" @@ -142,7 +140,7 @@ count_4_l (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/count_8_l.c b/libgfortran/generated/count_8_l.c index da53d1cd240..2a62ea87bd4 100644 --- a/libgfortran/generated/count_8_l.c +++ b/libgfortran/generated/count_8_l.c @@ -60,25 +60,24 @@ count_8_l (gfc_array_i8 * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,29 +85,29 @@ count_8_l (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -128,8 +127,7 @@ count_8_l (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " COUNT intrinsic in dimension %d:" @@ -142,7 +140,7 @@ count_8_l (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/generated/cshift0_c10.c b/libgfortran/generated/cshift0_c10.c index 1f8078d2fad..16c113deb60 100644 --- a/libgfortran/generated/cshift0_c10.c +++ b/libgfortran/generated/cshift0_c10.c @@ -69,20 +69,20 @@ cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_c16.c b/libgfortran/generated/cshift0_c16.c index 83afa517c1b..df83ccb85f4 100644 --- a/libgfortran/generated/cshift0_c16.c +++ b/libgfortran/generated/cshift0_c16.c @@ -69,20 +69,20 @@ cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_c4.c b/libgfortran/generated/cshift0_c4.c index 32a60063aeb..52d277f1ce3 100644 --- a/libgfortran/generated/cshift0_c4.c +++ b/libgfortran/generated/cshift0_c4.c @@ -69,20 +69,20 @@ cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_c8.c b/libgfortran/generated/cshift0_c8.c index a9d152d6426..9b9c3b2acce 100644 --- a/libgfortran/generated/cshift0_c8.c +++ b/libgfortran/generated/cshift0_c8.c @@ -69,20 +69,20 @@ cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i1.c b/libgfortran/generated/cshift0_i1.c index 539af355b31..7ed44bddb78 100644 --- a/libgfortran/generated/cshift0_i1.c +++ b/libgfortran/generated/cshift0_i1.c @@ -69,20 +69,20 @@ cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i16.c b/libgfortran/generated/cshift0_i16.c index fa48d41b7dd..145724b6e81 100644 --- a/libgfortran/generated/cshift0_i16.c +++ b/libgfortran/generated/cshift0_i16.c @@ -69,20 +69,20 @@ cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i2.c b/libgfortran/generated/cshift0_i2.c index af07c01507c..df332817557 100644 --- a/libgfortran/generated/cshift0_i2.c +++ b/libgfortran/generated/cshift0_i2.c @@ -69,20 +69,20 @@ cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i4.c b/libgfortran/generated/cshift0_i4.c index 1997b1842f6..a1e118589c5 100644 --- a/libgfortran/generated/cshift0_i4.c +++ b/libgfortran/generated/cshift0_i4.c @@ -69,20 +69,20 @@ cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i8.c b/libgfortran/generated/cshift0_i8.c index 6144d61e034..cbe13f153f3 100644 --- a/libgfortran/generated/cshift0_i8.c +++ b/libgfortran/generated/cshift0_i8.c @@ -69,20 +69,20 @@ cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_r10.c b/libgfortran/generated/cshift0_r10.c index b3d5f8e4819..8ba544d2d8e 100644 --- a/libgfortran/generated/cshift0_r10.c +++ b/libgfortran/generated/cshift0_r10.c @@ -69,20 +69,20 @@ cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_r16.c b/libgfortran/generated/cshift0_r16.c index 3088da414da..0725048c2ab 100644 --- a/libgfortran/generated/cshift0_r16.c +++ b/libgfortran/generated/cshift0_r16.c @@ -69,20 +69,20 @@ cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_r4.c b/libgfortran/generated/cshift0_r4.c index 176be1fdda1..515c36b41fc 100644 --- a/libgfortran/generated/cshift0_r4.c +++ b/libgfortran/generated/cshift0_r4.c @@ -69,20 +69,20 @@ cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_r8.c b/libgfortran/generated/cshift0_r8.c index 7947ff9aaad..5a721e49589 100644 --- a/libgfortran/generated/cshift0_r8.c +++ b/libgfortran/generated/cshift0_r8.c @@ -69,20 +69,20 @@ cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/generated/cshift1_16.c b/libgfortran/generated/cshift1_16.c index 7a7d0db1dac..df97dfa6b76 100644 --- a/libgfortran/generated/cshift1_16.c +++ b/libgfortran/generated/cshift1_16.c @@ -35,8 +35,7 @@ static void cshift1 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i16 * const restrict h, - const GFC_INTEGER_16 * const restrict pwhich, - index_type size) + const GFC_INTEGER_16 * const restrict pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -63,6 +62,7 @@ cshift1 (gfc_array_char * const restrict ret, int which; GFC_INTEGER_16 sh; index_type arraysize; + index_type size; if (pwhich) which = *pwhich - 1; @@ -72,6 +72,8 @@ cshift1 (gfc_array_char * const restrict ret, 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(array); + arraysize = size0 ((array_t *)array); if (ret->data == NULL) @@ -83,13 +85,17 @@ cshift1 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } } @@ -109,22 +115,22 @@ cshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); n++; } } @@ -210,7 +216,7 @@ cshift1_16 (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const GFC_INTEGER_16 * const restrict pwhich) { - cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); + cshift1 (ret, array, h, pwhich); } @@ -228,9 +234,9 @@ cshift1_16_char (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i16 * const restrict h, const GFC_INTEGER_16 * const restrict pwhich, - GFC_INTEGER_4 array_length) + GFC_INTEGER_4 array_length __attribute__((unused))) { - cshift1 (ret, array, h, pwhich, array_length); + cshift1 (ret, array, h, pwhich); } @@ -248,9 +254,9 @@ cshift1_16_char4 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i16 * const restrict h, const GFC_INTEGER_16 * const restrict pwhich, - GFC_INTEGER_4 array_length) + GFC_INTEGER_4 array_length __attribute__((unused))) { - cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); + cshift1 (ret, array, h, pwhich); } #endif diff --git a/libgfortran/generated/cshift1_4.c b/libgfortran/generated/cshift1_4.c index c6f124fe1f7..f048e8e401f 100644 --- a/libgfortran/generated/cshift1_4.c +++ b/libgfortran/generated/cshift1_4.c @@ -35,8 +35,7 @@ static void cshift1 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i4 * const restrict h, - const GFC_INTEGER_4 * const restrict pwhich, - index_type size) + const GFC_INTEGER_4 * const restrict pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -63,6 +62,7 @@ cshift1 (gfc_array_char * const restrict ret, int which; GFC_INTEGER_4 sh; index_type arraysize; + index_type size; if (pwhich) which = *pwhich - 1; @@ -72,6 +72,8 @@ cshift1 (gfc_array_char * const restrict ret, 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(array); + arraysize = size0 ((array_t *)array); if (ret->data == NULL) @@ -83,13 +85,17 @@ cshift1 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } } @@ -109,22 +115,22 @@ cshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); n++; } } @@ -210,7 +216,7 @@ cshift1_4 (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const GFC_INTEGER_4 * const restrict pwhich) { - cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); + cshift1 (ret, array, h, pwhich); } @@ -228,9 +234,9 @@ cshift1_4_char (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i4 * const restrict h, const GFC_INTEGER_4 * const restrict pwhich, - GFC_INTEGER_4 array_length) + GFC_INTEGER_4 array_length __attribute__((unused))) { - cshift1 (ret, array, h, pwhich, array_length); + cshift1 (ret, array, h, pwhich); } @@ -248,9 +254,9 @@ cshift1_4_char4 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i4 * const restrict h, const GFC_INTEGER_4 * const restrict pwhich, - GFC_INTEGER_4 array_length) + GFC_INTEGER_4 array_length __attribute__((unused))) { - cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); + cshift1 (ret, array, h, pwhich); } #endif diff --git a/libgfortran/generated/cshift1_8.c b/libgfortran/generated/cshift1_8.c index 54e92dbcff8..9667728f392 100644 --- a/libgfortran/generated/cshift1_8.c +++ b/libgfortran/generated/cshift1_8.c @@ -35,8 +35,7 @@ static void cshift1 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i8 * const restrict h, - const GFC_INTEGER_8 * const restrict pwhich, - index_type size) + const GFC_INTEGER_8 * const restrict pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -63,6 +62,7 @@ cshift1 (gfc_array_char * const restrict ret, int which; GFC_INTEGER_8 sh; index_type arraysize; + index_type size; if (pwhich) which = *pwhich - 1; @@ -72,6 +72,8 @@ cshift1 (gfc_array_char * const restrict ret, 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(array); + arraysize = size0 ((array_t *)array); if (ret->data == NULL) @@ -83,13 +85,17 @@ cshift1 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } } @@ -109,22 +115,22 @@ cshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); n++; } } @@ -210,7 +216,7 @@ cshift1_8 (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const GFC_INTEGER_8 * const restrict pwhich) { - cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); + cshift1 (ret, array, h, pwhich); } @@ -228,9 +234,9 @@ cshift1_8_char (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i8 * const restrict h, const GFC_INTEGER_8 * const restrict pwhich, - GFC_INTEGER_4 array_length) + GFC_INTEGER_4 array_length __attribute__((unused))) { - cshift1 (ret, array, h, pwhich, array_length); + cshift1 (ret, array, h, pwhich); } @@ -248,9 +254,9 @@ cshift1_8_char4 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const gfc_array_i8 * const restrict h, const GFC_INTEGER_8 * const restrict pwhich, - GFC_INTEGER_4 array_length) + GFC_INTEGER_4 array_length __attribute__((unused))) { - cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); + cshift1 (ret, array, h, pwhich); } #endif diff --git a/libgfortran/generated/eoshift1_16.c b/libgfortran/generated/eoshift1_16.c index b9fe9c311fc..02365cc2375 100644 --- a/libgfortran/generated/eoshift1_16.c +++ b/libgfortran/generated/eoshift1_16.c @@ -37,7 +37,7 @@ eoshift1 (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich, - index_type size, const char * filler, index_type filler_len) + const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -61,6 +61,7 @@ eoshift1 (gfc_array_char * const restrict ret, index_type dim; index_type len; index_type n; + index_type size; int which; GFC_INTEGER_16 sh; GFC_INTEGER_16 delta; @@ -71,6 +72,8 @@ eoshift1 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE(array); + if (pwhich) which = *pwhich - 1; else @@ -88,13 +91,18 @@ eoshift1 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -108,22 +116,22 @@ eoshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); n++; } } @@ -241,8 +249,7 @@ eoshift1_16 (gfc_array_char * const restrict ret, const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich) { - eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), - "\0", 1); + eoshift1 (ret, array, h, pbound, pwhich, "\0", 1); } @@ -262,10 +269,10 @@ eoshift1_16_char (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); + eoshift1 (ret, array, h, pbound, pwhich, " ", 1); } @@ -285,11 +292,11 @@ eoshift1_16_char4 (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { static const gfc_char4_t space = (unsigned char) ' '; - eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), + eoshift1 (ret, array, h, pbound, pwhich, (const char *) &space, sizeof (gfc_char4_t)); } diff --git a/libgfortran/generated/eoshift1_4.c b/libgfortran/generated/eoshift1_4.c index 0510d2cd1e8..e703db47786 100644 --- a/libgfortran/generated/eoshift1_4.c +++ b/libgfortran/generated/eoshift1_4.c @@ -37,7 +37,7 @@ eoshift1 (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich, - index_type size, const char * filler, index_type filler_len) + const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -61,6 +61,7 @@ eoshift1 (gfc_array_char * const restrict ret, index_type dim; index_type len; index_type n; + index_type size; int which; GFC_INTEGER_4 sh; GFC_INTEGER_4 delta; @@ -71,6 +72,8 @@ eoshift1 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE(array); + if (pwhich) which = *pwhich - 1; else @@ -88,13 +91,18 @@ eoshift1 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -108,22 +116,22 @@ eoshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); n++; } } @@ -241,8 +249,7 @@ eoshift1_4 (gfc_array_char * const restrict ret, const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich) { - eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), - "\0", 1); + eoshift1 (ret, array, h, pbound, pwhich, "\0", 1); } @@ -262,10 +269,10 @@ eoshift1_4_char (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); + eoshift1 (ret, array, h, pbound, pwhich, " ", 1); } @@ -285,11 +292,11 @@ eoshift1_4_char4 (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { static const gfc_char4_t space = (unsigned char) ' '; - eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), + eoshift1 (ret, array, h, pbound, pwhich, (const char *) &space, sizeof (gfc_char4_t)); } diff --git a/libgfortran/generated/eoshift1_8.c b/libgfortran/generated/eoshift1_8.c index d61023e540f..f8922b344a5 100644 --- a/libgfortran/generated/eoshift1_8.c +++ b/libgfortran/generated/eoshift1_8.c @@ -37,7 +37,7 @@ eoshift1 (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich, - index_type size, const char * filler, index_type filler_len) + const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -61,6 +61,7 @@ eoshift1 (gfc_array_char * const restrict ret, index_type dim; index_type len; index_type n; + index_type size; int which; GFC_INTEGER_8 sh; GFC_INTEGER_8 delta; @@ -71,6 +72,8 @@ eoshift1 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE(array); + if (pwhich) which = *pwhich - 1; else @@ -88,13 +91,18 @@ eoshift1 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -108,22 +116,22 @@ eoshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); n++; } } @@ -241,8 +249,7 @@ eoshift1_8 (gfc_array_char * const restrict ret, const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich) { - eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), - "\0", 1); + eoshift1 (ret, array, h, pbound, pwhich, "\0", 1); } @@ -262,10 +269,10 @@ eoshift1_8_char (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); + eoshift1 (ret, array, h, pbound, pwhich, " ", 1); } @@ -285,11 +292,11 @@ eoshift1_8_char4 (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { static const gfc_char4_t space = (unsigned char) ' '; - eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), + eoshift1 (ret, array, h, pbound, pwhich, (const char *) &space, sizeof (gfc_char4_t)); } diff --git a/libgfortran/generated/eoshift3_16.c b/libgfortran/generated/eoshift3_16.c index 282409e2fe0..c3efae9acbf 100644 --- a/libgfortran/generated/eoshift3_16.c +++ b/libgfortran/generated/eoshift3_16.c @@ -37,7 +37,7 @@ eoshift3 (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich, - index_type size, const char * filler, index_type filler_len) + const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -65,6 +65,7 @@ eoshift3 (gfc_array_char * const restrict ret, index_type dim; index_type len; index_type n; + index_type size; int which; GFC_INTEGER_16 sh; GFC_INTEGER_16 delta; @@ -75,6 +76,8 @@ eoshift3 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE(array); + if (pwhich) which = *pwhich - 1; else @@ -89,13 +92,18 @@ eoshift3 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -112,24 +120,24 @@ eoshift3 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); if (bound) - bstride[n] = bound->dim[n].stride * size; + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); else bstride[n] = 0; n++; @@ -260,8 +268,7 @@ eoshift3_16 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich) { - eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), - "\0", 1); + eoshift3 (ret, array, h, bound, pwhich, "\0", 1); } @@ -281,10 +288,10 @@ eoshift3_16_char (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); + eoshift3 (ret, array, h, bound, pwhich, " ", 1); } @@ -304,11 +311,11 @@ eoshift3_16_char4 (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { static const gfc_char4_t space = (unsigned char) ' '; - eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), + eoshift3 (ret, array, h, bound, pwhich, (const char *) &space, sizeof (gfc_char4_t)); } diff --git a/libgfortran/generated/eoshift3_4.c b/libgfortran/generated/eoshift3_4.c index a16594506c8..5038c0916bd 100644 --- a/libgfortran/generated/eoshift3_4.c +++ b/libgfortran/generated/eoshift3_4.c @@ -37,7 +37,7 @@ eoshift3 (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich, - index_type size, const char * filler, index_type filler_len) + const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -65,6 +65,7 @@ eoshift3 (gfc_array_char * const restrict ret, index_type dim; index_type len; index_type n; + index_type size; int which; GFC_INTEGER_4 sh; GFC_INTEGER_4 delta; @@ -75,6 +76,8 @@ eoshift3 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE(array); + if (pwhich) which = *pwhich - 1; else @@ -89,13 +92,18 @@ eoshift3 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -112,24 +120,24 @@ eoshift3 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); if (bound) - bstride[n] = bound->dim[n].stride * size; + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); else bstride[n] = 0; n++; @@ -260,8 +268,7 @@ eoshift3_4 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich) { - eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), - "\0", 1); + eoshift3 (ret, array, h, bound, pwhich, "\0", 1); } @@ -281,10 +288,10 @@ eoshift3_4_char (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); + eoshift3 (ret, array, h, bound, pwhich, " ", 1); } @@ -304,11 +311,11 @@ eoshift3_4_char4 (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { static const gfc_char4_t space = (unsigned char) ' '; - eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), + eoshift3 (ret, array, h, bound, pwhich, (const char *) &space, sizeof (gfc_char4_t)); } diff --git a/libgfortran/generated/eoshift3_8.c b/libgfortran/generated/eoshift3_8.c index 5942de5ea06..f745a1d268f 100644 --- a/libgfortran/generated/eoshift3_8.c +++ b/libgfortran/generated/eoshift3_8.c @@ -37,7 +37,7 @@ eoshift3 (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich, - index_type size, const char * filler, index_type filler_len) + const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -65,6 +65,7 @@ eoshift3 (gfc_array_char * const restrict ret, index_type dim; index_type len; index_type n; + index_type size; int which; GFC_INTEGER_8 sh; GFC_INTEGER_8 delta; @@ -75,6 +76,8 @@ eoshift3 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE(array); + if (pwhich) which = *pwhich - 1; else @@ -89,13 +92,18 @@ eoshift3 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -112,24 +120,24 @@ eoshift3 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); if (bound) - bstride[n] = bound->dim[n].stride * size; + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); else bstride[n] = 0; n++; @@ -260,8 +268,7 @@ eoshift3_8 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich) { - eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), - "\0", 1); + eoshift3 (ret, array, h, bound, pwhich, "\0", 1); } @@ -281,10 +288,10 @@ eoshift3_8_char (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); + eoshift3 (ret, array, h, bound, pwhich, " ", 1); } @@ -304,11 +311,11 @@ eoshift3_8_char4 (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { static const gfc_char4_t space = (unsigned char) ' '; - eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), + eoshift3 (ret, array, h, bound, pwhich, (const char *) &space, sizeof (gfc_char4_t)); } diff --git a/libgfortran/generated/in_pack_c10.c b/libgfortran/generated/in_pack_c10.c index afe5ba1835a..97ce9d1eaad 100644 --- a/libgfortran/generated/in_pack_c10.c +++ b/libgfortran/generated/in_pack_c10.c @@ -57,8 +57,8 @@ internal_pack_c10 (gfc_array_c10 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_c16.c b/libgfortran/generated/in_pack_c16.c index c60c6870e72..74e3cb67d58 100644 --- a/libgfortran/generated/in_pack_c16.c +++ b/libgfortran/generated/in_pack_c16.c @@ -57,8 +57,8 @@ internal_pack_c16 (gfc_array_c16 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_c4.c b/libgfortran/generated/in_pack_c4.c index a117f7ac4ea..ae52bc68940 100644 --- a/libgfortran/generated/in_pack_c4.c +++ b/libgfortran/generated/in_pack_c4.c @@ -57,8 +57,8 @@ internal_pack_c4 (gfc_array_c4 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_c8.c b/libgfortran/generated/in_pack_c8.c index f57f2aae130..142ad99cdf7 100644 --- a/libgfortran/generated/in_pack_c8.c +++ b/libgfortran/generated/in_pack_c8.c @@ -57,8 +57,8 @@ internal_pack_c8 (gfc_array_c8 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_i1.c b/libgfortran/generated/in_pack_i1.c index 1378f89e73c..dc26c1af6df 100644 --- a/libgfortran/generated/in_pack_i1.c +++ b/libgfortran/generated/in_pack_i1.c @@ -57,8 +57,8 @@ internal_pack_1 (gfc_array_i1 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_i16.c b/libgfortran/generated/in_pack_i16.c index eced9242c66..32ce3a4ea3e 100644 --- a/libgfortran/generated/in_pack_i16.c +++ b/libgfortran/generated/in_pack_i16.c @@ -57,8 +57,8 @@ internal_pack_16 (gfc_array_i16 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_i2.c b/libgfortran/generated/in_pack_i2.c index 5cb89fc124b..3c39f8e610f 100644 --- a/libgfortran/generated/in_pack_i2.c +++ b/libgfortran/generated/in_pack_i2.c @@ -57,8 +57,8 @@ internal_pack_2 (gfc_array_i2 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_i4.c b/libgfortran/generated/in_pack_i4.c index 7b97b2061e1..4cd7dba479a 100644 --- a/libgfortran/generated/in_pack_i4.c +++ b/libgfortran/generated/in_pack_i4.c @@ -57,8 +57,8 @@ internal_pack_4 (gfc_array_i4 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_i8.c b/libgfortran/generated/in_pack_i8.c index 2a8f6d72e21..17acc684f1d 100644 --- a/libgfortran/generated/in_pack_i8.c +++ b/libgfortran/generated/in_pack_i8.c @@ -57,8 +57,8 @@ internal_pack_8 (gfc_array_i8 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_r10.c b/libgfortran/generated/in_pack_r10.c index 1f283f3d0cb..557ccc2aae7 100644 --- a/libgfortran/generated/in_pack_r10.c +++ b/libgfortran/generated/in_pack_r10.c @@ -57,8 +57,8 @@ internal_pack_r10 (gfc_array_r10 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_r16.c b/libgfortran/generated/in_pack_r16.c index 6c7c79e472c..b737cc7d22c 100644 --- a/libgfortran/generated/in_pack_r16.c +++ b/libgfortran/generated/in_pack_r16.c @@ -57,8 +57,8 @@ internal_pack_r16 (gfc_array_r16 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_r4.c b/libgfortran/generated/in_pack_r4.c index 372f0871957..68a7e5a0dca 100644 --- a/libgfortran/generated/in_pack_r4.c +++ b/libgfortran/generated/in_pack_r4.c @@ -57,8 +57,8 @@ internal_pack_r4 (gfc_array_r4 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_pack_r8.c b/libgfortran/generated/in_pack_r8.c index 09a25445f32..1453f86b582 100644 --- a/libgfortran/generated/in_pack_r8.c +++ b/libgfortran/generated/in_pack_r8.c @@ -57,8 +57,8 @@ internal_pack_r8 (gfc_array_r8 * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/generated/in_unpack_c10.c b/libgfortran/generated/in_unpack_c10.c index 46ce8d446fd..bcac6e7a5d4 100644 --- a/libgfortran/generated/in_unpack_c10.c +++ b/libgfortran/generated/in_unpack_c10.c @@ -52,8 +52,8 @@ internal_unpack_c10 (gfc_array_c10 * d, const GFC_COMPLEX_10 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_c16.c b/libgfortran/generated/in_unpack_c16.c index 1b783bd725a..1d09a800690 100644 --- a/libgfortran/generated/in_unpack_c16.c +++ b/libgfortran/generated/in_unpack_c16.c @@ -52,8 +52,8 @@ internal_unpack_c16 (gfc_array_c16 * d, const GFC_COMPLEX_16 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_c4.c b/libgfortran/generated/in_unpack_c4.c index fcf2abb7b79..9ad8a33102f 100644 --- a/libgfortran/generated/in_unpack_c4.c +++ b/libgfortran/generated/in_unpack_c4.c @@ -52,8 +52,8 @@ internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_c8.c b/libgfortran/generated/in_unpack_c8.c index 994b234a80e..6adae640e5e 100644 --- a/libgfortran/generated/in_unpack_c8.c +++ b/libgfortran/generated/in_unpack_c8.c @@ -52,8 +52,8 @@ internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i1.c b/libgfortran/generated/in_unpack_i1.c index 323b6847a8d..e632816c918 100644 --- a/libgfortran/generated/in_unpack_i1.c +++ b/libgfortran/generated/in_unpack_i1.c @@ -52,8 +52,8 @@ internal_unpack_1 (gfc_array_i1 * d, const GFC_INTEGER_1 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i16.c b/libgfortran/generated/in_unpack_i16.c index 04b2248876f..c7199207e2a 100644 --- a/libgfortran/generated/in_unpack_i16.c +++ b/libgfortran/generated/in_unpack_i16.c @@ -52,8 +52,8 @@ internal_unpack_16 (gfc_array_i16 * d, const GFC_INTEGER_16 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i2.c b/libgfortran/generated/in_unpack_i2.c index cdcd9eaa22c..ec0c1c3aca9 100644 --- a/libgfortran/generated/in_unpack_i2.c +++ b/libgfortran/generated/in_unpack_i2.c @@ -52,8 +52,8 @@ internal_unpack_2 (gfc_array_i2 * d, const GFC_INTEGER_2 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i4.c b/libgfortran/generated/in_unpack_i4.c index 837e35c146f..ce5d29df760 100644 --- a/libgfortran/generated/in_unpack_i4.c +++ b/libgfortran/generated/in_unpack_i4.c @@ -52,8 +52,8 @@ internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i8.c b/libgfortran/generated/in_unpack_i8.c index 7ea8b94c708..347f0116cfc 100644 --- a/libgfortran/generated/in_unpack_i8.c +++ b/libgfortran/generated/in_unpack_i8.c @@ -52,8 +52,8 @@ internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_r10.c b/libgfortran/generated/in_unpack_r10.c index 15c46b2d07d..aa5f08eb25b 100644 --- a/libgfortran/generated/in_unpack_r10.c +++ b/libgfortran/generated/in_unpack_r10.c @@ -52,8 +52,8 @@ internal_unpack_r10 (gfc_array_r10 * d, const GFC_REAL_10 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_r16.c b/libgfortran/generated/in_unpack_r16.c index af61dfe8e23..0b08228ce70 100644 --- a/libgfortran/generated/in_unpack_r16.c +++ b/libgfortran/generated/in_unpack_r16.c @@ -52,8 +52,8 @@ internal_unpack_r16 (gfc_array_r16 * d, const GFC_REAL_16 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_r4.c b/libgfortran/generated/in_unpack_r4.c index abf8aea6982..f436c8afa85 100644 --- a/libgfortran/generated/in_unpack_r4.c +++ b/libgfortran/generated/in_unpack_r4.c @@ -52,8 +52,8 @@ internal_unpack_r4 (gfc_array_r4 * d, const GFC_REAL_4 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_r8.c b/libgfortran/generated/in_unpack_r8.c index bba3fc6e815..76aff2e5925 100644 --- a/libgfortran/generated/in_unpack_r8.c +++ b/libgfortran/generated/in_unpack_r8.c @@ -52,8 +52,8 @@ internal_unpack_r8 (gfc_array_r8 * d, const GFC_REAL_8 * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/matmul_c10.c b/libgfortran/generated/matmul_c10.c index 7d4e47061e0..c54c78ed435 100644 --- a/libgfortran/generated/matmul_c10.c +++ b/libgfortran/generated/matmul_c10.c @@ -105,25 +105,22 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_c16.c b/libgfortran/generated/matmul_c16.c index 4665bcc9530..880c0e12782 100644 --- a/libgfortran/generated/matmul_c16.c +++ b/libgfortran/generated/matmul_c16.c @@ -105,25 +105,22 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_c4.c b/libgfortran/generated/matmul_c4.c index 6c7c723f7fe..020033a770c 100644 --- a/libgfortran/generated/matmul_c4.c +++ b/libgfortran/generated/matmul_c4.c @@ -105,25 +105,22 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_c8.c b/libgfortran/generated/matmul_c8.c index cf1142ba06a..1522dcd5a19 100644 --- a/libgfortran/generated/matmul_c8.c +++ b/libgfortran/generated/matmul_c8.c @@ -105,25 +105,22 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_i1.c b/libgfortran/generated/matmul_i1.c index 502676a42a6..db56678510c 100644 --- a/libgfortran/generated/matmul_i1.c +++ b/libgfortran/generated/matmul_i1.c @@ -105,25 +105,22 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_i16.c b/libgfortran/generated/matmul_i16.c index 5b2b05a7944..f607e27b81c 100644 --- a/libgfortran/generated/matmul_i16.c +++ b/libgfortran/generated/matmul_i16.c @@ -105,25 +105,22 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_i2.c b/libgfortran/generated/matmul_i2.c index bf04fce96dc..58e340b7722 100644 --- a/libgfortran/generated/matmul_i2.c +++ b/libgfortran/generated/matmul_i2.c @@ -105,25 +105,22 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_i4.c b/libgfortran/generated/matmul_i4.c index 7b3ba687151..46ed493d0e0 100644 --- a/libgfortran/generated/matmul_i4.c +++ b/libgfortran/generated/matmul_i4.c @@ -105,25 +105,22 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_i8.c b/libgfortran/generated/matmul_i8.c index 45b99c3a3b2..54ffe6248f4 100644 --- a/libgfortran/generated/matmul_i8.c +++ b/libgfortran/generated/matmul_i8.c @@ -105,25 +105,22 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_l16.c b/libgfortran/generated/matmul_l16.c index fc8e54834e0..5fbeeb7da1d 100644 --- a/libgfortran/generated/matmul_l16.c +++ b/libgfortran/generated/matmul_l16.c @@ -69,25 +69,22 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -100,8 +97,8 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -109,8 +106,8 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -118,16 +115,16 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -165,46 +162,46 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = retarray->dim[0].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); rystride = rxstride; } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } /* 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 * a_kind; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + count = GFC_DESCRIPTOR_EXTENT(a,0); xstride = 0; rxstride = 0; xcount = 1; } else { - astride = a->dim[1].stride * a_kind; - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xstride = a->dim[0].stride * a_kind; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + count = GFC_DESCRIPTOR_EXTENT(a,1); + xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } if (GFC_DESCRIPTOR_RANK (b) == 1) { - bstride = b->dim[0].stride * b_kind; - assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); ystride = 0; rystride = 0; ycount = 1; } else { - bstride = b->dim[0].stride * b_kind; - assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); - ystride = b->dim[1].stride * b_kind; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } for (y = 0; y < ycount; y++) diff --git a/libgfortran/generated/matmul_l4.c b/libgfortran/generated/matmul_l4.c index c7bb5844940..19ca9f1e577 100644 --- a/libgfortran/generated/matmul_l4.c +++ b/libgfortran/generated/matmul_l4.c @@ -69,25 +69,22 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -100,8 +97,8 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -109,8 +106,8 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -118,16 +115,16 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -165,46 +162,46 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = retarray->dim[0].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); rystride = rxstride; } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } /* 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 * a_kind; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + count = GFC_DESCRIPTOR_EXTENT(a,0); xstride = 0; rxstride = 0; xcount = 1; } else { - astride = a->dim[1].stride * a_kind; - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xstride = a->dim[0].stride * a_kind; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + count = GFC_DESCRIPTOR_EXTENT(a,1); + xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } if (GFC_DESCRIPTOR_RANK (b) == 1) { - bstride = b->dim[0].stride * b_kind; - assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); ystride = 0; rystride = 0; ycount = 1; } else { - bstride = b->dim[0].stride * b_kind; - assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); - ystride = b->dim[1].stride * b_kind; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } for (y = 0; y < ycount; y++) diff --git a/libgfortran/generated/matmul_l8.c b/libgfortran/generated/matmul_l8.c index 1d1541033b2..558ed252e26 100644 --- a/libgfortran/generated/matmul_l8.c +++ b/libgfortran/generated/matmul_l8.c @@ -69,25 +69,22 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -100,8 +97,8 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -109,8 +106,8 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -118,16 +115,16 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -165,46 +162,46 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = retarray->dim[0].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); rystride = rxstride; } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } /* 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 * a_kind; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + count = GFC_DESCRIPTOR_EXTENT(a,0); xstride = 0; rxstride = 0; xcount = 1; } else { - astride = a->dim[1].stride * a_kind; - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xstride = a->dim[0].stride * a_kind; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + count = GFC_DESCRIPTOR_EXTENT(a,1); + xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } if (GFC_DESCRIPTOR_RANK (b) == 1) { - bstride = b->dim[0].stride * b_kind; - assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); ystride = 0; rystride = 0; ycount = 1; } else { - bstride = b->dim[0].stride * b_kind; - assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); - ystride = b->dim[1].stride * b_kind; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } for (y = 0; y < ycount; y++) diff --git a/libgfortran/generated/matmul_r10.c b/libgfortran/generated/matmul_r10.c index 90338ac2807..8e325549ce5 100644 --- a/libgfortran/generated/matmul_r10.c +++ b/libgfortran/generated/matmul_r10.c @@ -105,25 +105,22 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_r16.c b/libgfortran/generated/matmul_r16.c index a8422b37a41..c11553180d2 100644 --- a/libgfortran/generated/matmul_r16.c +++ b/libgfortran/generated/matmul_r16.c @@ -105,25 +105,22 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_r4.c b/libgfortran/generated/matmul_r4.c index 0bb50350980..54208725dfb 100644 --- a/libgfortran/generated/matmul_r4.c +++ b/libgfortran/generated/matmul_r4.c @@ -105,25 +105,22 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/matmul_r8.c b/libgfortran/generated/matmul_r8.c index 0a07243d90e..72ad1fd58f0 100644 --- a/libgfortran/generated/matmul_r8.c +++ b/libgfortran/generated/matmul_r8.c @@ -105,25 +105,22 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -136,8 +133,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -145,8 +142,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -154,16 +151,16 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -178,43 +175,43 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -224,9 +221,9 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/generated/maxloc0_16_i1.c b/libgfortran/generated/maxloc0_16_i1.c index b5efcedef66..b43f08337c7 100644 --- a/libgfortran/generated/maxloc0_16_i1.c +++ b/libgfortran/generated/maxloc0_16_i1.c @@ -55,9 +55,7 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_i16.c b/libgfortran/generated/maxloc0_16_i16.c index 617813253b6..26941a741f9 100644 --- a/libgfortran/generated/maxloc0_16_i16.c +++ b/libgfortran/generated/maxloc0_16_i16.c @@ -55,9 +55,7 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_i2.c b/libgfortran/generated/maxloc0_16_i2.c index c7489a05b8f..e1d329c583c 100644 --- a/libgfortran/generated/maxloc0_16_i2.c +++ b/libgfortran/generated/maxloc0_16_i2.c @@ -55,9 +55,7 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_i4.c b/libgfortran/generated/maxloc0_16_i4.c index 17e93bdb0f5..4d1d0a11acd 100644 --- a/libgfortran/generated/maxloc0_16_i4.c +++ b/libgfortran/generated/maxloc0_16_i4.c @@ -55,9 +55,7 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_i8.c b/libgfortran/generated/maxloc0_16_i8.c index 6863d6f5c2e..12147a0e2fa 100644 --- a/libgfortran/generated/maxloc0_16_i8.c +++ b/libgfortran/generated/maxloc0_16_i8.c @@ -55,9 +55,7 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_r10.c b/libgfortran/generated/maxloc0_16_r10.c index 153fc2b183e..33c73083cc7 100644 --- a/libgfortran/generated/maxloc0_16_r10.c +++ b/libgfortran/generated/maxloc0_16_r10.c @@ -55,9 +55,7 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_r16.c b/libgfortran/generated/maxloc0_16_r16.c index 1596cdc616c..4f4f290fee9 100644 --- a/libgfortran/generated/maxloc0_16_r16.c +++ b/libgfortran/generated/maxloc0_16_r16.c @@ -55,9 +55,7 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_r4.c b/libgfortran/generated/maxloc0_16_r4.c index a5e33aaff76..86cedb3a420 100644 --- a/libgfortran/generated/maxloc0_16_r4.c +++ b/libgfortran/generated/maxloc0_16_r4.c @@ -55,9 +55,7 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_r8.c b/libgfortran/generated/maxloc0_16_r8.c index 6d645d0dc34..378024bff76 100644 --- a/libgfortran/generated/maxloc0_16_r8.c +++ b/libgfortran/generated/maxloc0_16_r8.c @@ -55,9 +55,7 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i1.c b/libgfortran/generated/maxloc0_4_i1.c index e219c9ff104..7475059164c 100644 --- a/libgfortran/generated/maxloc0_4_i1.c +++ b/libgfortran/generated/maxloc0_4_i1.c @@ -55,9 +55,7 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i16.c b/libgfortran/generated/maxloc0_4_i16.c index da1f6eabfb7..268f09af8de 100644 --- a/libgfortran/generated/maxloc0_4_i16.c +++ b/libgfortran/generated/maxloc0_4_i16.c @@ -55,9 +55,7 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i2.c b/libgfortran/generated/maxloc0_4_i2.c index c20b306f7cf..47fb135c50d 100644 --- a/libgfortran/generated/maxloc0_4_i2.c +++ b/libgfortran/generated/maxloc0_4_i2.c @@ -55,9 +55,7 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i4.c b/libgfortran/generated/maxloc0_4_i4.c index 2c08c7d5c04..55bc2752131 100644 --- a/libgfortran/generated/maxloc0_4_i4.c +++ b/libgfortran/generated/maxloc0_4_i4.c @@ -55,9 +55,7 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i8.c b/libgfortran/generated/maxloc0_4_i8.c index 1a43838ba34..f598f050fd4 100644 --- a/libgfortran/generated/maxloc0_4_i8.c +++ b/libgfortran/generated/maxloc0_4_i8.c @@ -55,9 +55,7 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_r10.c b/libgfortran/generated/maxloc0_4_r10.c index ca041d6dce5..5c99198b201 100644 --- a/libgfortran/generated/maxloc0_4_r10.c +++ b/libgfortran/generated/maxloc0_4_r10.c @@ -55,9 +55,7 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_r16.c b/libgfortran/generated/maxloc0_4_r16.c index dba5031e9a6..c7609c35dc3 100644 --- a/libgfortran/generated/maxloc0_4_r16.c +++ b/libgfortran/generated/maxloc0_4_r16.c @@ -55,9 +55,7 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_r4.c b/libgfortran/generated/maxloc0_4_r4.c index fe4b1408053..50f3c3b6d1a 100644 --- a/libgfortran/generated/maxloc0_4_r4.c +++ b/libgfortran/generated/maxloc0_4_r4.c @@ -55,9 +55,7 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_r8.c b/libgfortran/generated/maxloc0_4_r8.c index 5360b2f7ceb..30dc2976c3e 100644 --- a/libgfortran/generated/maxloc0_4_r8.c +++ b/libgfortran/generated/maxloc0_4_r8.c @@ -55,9 +55,7 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i1.c b/libgfortran/generated/maxloc0_8_i1.c index 061a8a63af4..eb1737d23e3 100644 --- a/libgfortran/generated/maxloc0_8_i1.c +++ b/libgfortran/generated/maxloc0_8_i1.c @@ -55,9 +55,7 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i16.c b/libgfortran/generated/maxloc0_8_i16.c index 6ef795d035e..6690c2da4b7 100644 --- a/libgfortran/generated/maxloc0_8_i16.c +++ b/libgfortran/generated/maxloc0_8_i16.c @@ -55,9 +55,7 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i2.c b/libgfortran/generated/maxloc0_8_i2.c index 2c8a376e65b..b9bb230589f 100644 --- a/libgfortran/generated/maxloc0_8_i2.c +++ b/libgfortran/generated/maxloc0_8_i2.c @@ -55,9 +55,7 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i4.c b/libgfortran/generated/maxloc0_8_i4.c index d602bb4902b..57781469089 100644 --- a/libgfortran/generated/maxloc0_8_i4.c +++ b/libgfortran/generated/maxloc0_8_i4.c @@ -55,9 +55,7 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i8.c b/libgfortran/generated/maxloc0_8_i8.c index a4d250c56dd..ef7dedeb984 100644 --- a/libgfortran/generated/maxloc0_8_i8.c +++ b/libgfortran/generated/maxloc0_8_i8.c @@ -55,9 +55,7 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_r10.c b/libgfortran/generated/maxloc0_8_r10.c index 01ffc9d316c..0c08d8e803a 100644 --- a/libgfortran/generated/maxloc0_8_r10.c +++ b/libgfortran/generated/maxloc0_8_r10.c @@ -55,9 +55,7 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_r16.c b/libgfortran/generated/maxloc0_8_r16.c index 448cd30e747..da61d2b6983 100644 --- a/libgfortran/generated/maxloc0_8_r16.c +++ b/libgfortran/generated/maxloc0_8_r16.c @@ -55,9 +55,7 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_r4.c b/libgfortran/generated/maxloc0_8_r4.c index 971e278abda..a26b110220d 100644 --- a/libgfortran/generated/maxloc0_8_r4.c +++ b/libgfortran/generated/maxloc0_8_r4.c @@ -55,9 +55,7 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_r8.c b/libgfortran/generated/maxloc0_8_r8.c index 160f774f3c4..1198d624c54 100644 --- a/libgfortran/generated/maxloc0_8_r8.c +++ b/libgfortran/generated/maxloc0_8_r8.c @@ -55,9 +55,7 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MAXLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MAXLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc1_16_i1.c b/libgfortran/generated/maxloc1_16_i1.c index 9e1c268e789..a776f4f1c7a 100644 --- a/libgfortran/generated/maxloc1_16_i1.c +++ b/libgfortran/generated/maxloc1_16_i1.c @@ -58,24 +58,23 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_i16.c b/libgfortran/generated/maxloc1_16_i16.c index 3a0a343c338..827b3e6708c 100644 --- a/libgfortran/generated/maxloc1_16_i16.c +++ b/libgfortran/generated/maxloc1_16_i16.c @@ -58,24 +58,23 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_i2.c b/libgfortran/generated/maxloc1_16_i2.c index 4d87d8e145b..24a34e3343f 100644 --- a/libgfortran/generated/maxloc1_16_i2.c +++ b/libgfortran/generated/maxloc1_16_i2.c @@ -58,24 +58,23 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_i4.c b/libgfortran/generated/maxloc1_16_i4.c index d1ae2f0cae9..0194f28fc27 100644 --- a/libgfortran/generated/maxloc1_16_i4.c +++ b/libgfortran/generated/maxloc1_16_i4.c @@ -58,24 +58,23 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_i8.c b/libgfortran/generated/maxloc1_16_i8.c index 1d60d10dbd4..bb1750028f1 100644 --- a/libgfortran/generated/maxloc1_16_i8.c +++ b/libgfortran/generated/maxloc1_16_i8.c @@ -58,24 +58,23 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_r10.c b/libgfortran/generated/maxloc1_16_r10.c index e0599714c40..dc8cd5dd425 100644 --- a/libgfortran/generated/maxloc1_16_r10.c +++ b/libgfortran/generated/maxloc1_16_r10.c @@ -58,24 +58,23 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_r16.c b/libgfortran/generated/maxloc1_16_r16.c index 3381560551c..1664edb4b35 100644 --- a/libgfortran/generated/maxloc1_16_r16.c +++ b/libgfortran/generated/maxloc1_16_r16.c @@ -58,24 +58,23 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_r4.c b/libgfortran/generated/maxloc1_16_r4.c index 2defdd1f750..58bfcc0f8ec 100644 --- a/libgfortran/generated/maxloc1_16_r4.c +++ b/libgfortran/generated/maxloc1_16_r4.c @@ -58,24 +58,23 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_r8.c b/libgfortran/generated/maxloc1_16_r8.c index a3293163dcb..d646d2547f8 100644 --- a/libgfortran/generated/maxloc1_16_r8.c +++ b/libgfortran/generated/maxloc1_16_r8.c @@ -58,24 +58,23 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i1.c b/libgfortran/generated/maxloc1_4_i1.c index 4281921b25f..39291ff4db3 100644 --- a/libgfortran/generated/maxloc1_4_i1.c +++ b/libgfortran/generated/maxloc1_4_i1.c @@ -58,24 +58,23 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i16.c b/libgfortran/generated/maxloc1_4_i16.c index 34fcb565d20..059cacb22e5 100644 --- a/libgfortran/generated/maxloc1_4_i16.c +++ b/libgfortran/generated/maxloc1_4_i16.c @@ -58,24 +58,23 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i2.c b/libgfortran/generated/maxloc1_4_i2.c index dbd7d2f56e4..64cee3e8725 100644 --- a/libgfortran/generated/maxloc1_4_i2.c +++ b/libgfortran/generated/maxloc1_4_i2.c @@ -58,24 +58,23 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c index 29d04de8eab..f8a843e5c5b 100644 --- a/libgfortran/generated/maxloc1_4_i4.c +++ b/libgfortran/generated/maxloc1_4_i4.c @@ -58,24 +58,23 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c index 823af365ff1..293c2a9cb2e 100644 --- a/libgfortran/generated/maxloc1_4_i8.c +++ b/libgfortran/generated/maxloc1_4_i8.c @@ -58,24 +58,23 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_r10.c b/libgfortran/generated/maxloc1_4_r10.c index a212e59b5dd..89982795e81 100644 --- a/libgfortran/generated/maxloc1_4_r10.c +++ b/libgfortran/generated/maxloc1_4_r10.c @@ -58,24 +58,23 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_r16.c b/libgfortran/generated/maxloc1_4_r16.c index db3301c2a82..191ba998242 100644 --- a/libgfortran/generated/maxloc1_4_r16.c +++ b/libgfortran/generated/maxloc1_4_r16.c @@ -58,24 +58,23 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c index a0099f695e9..1f445e7306a 100644 --- a/libgfortran/generated/maxloc1_4_r4.c +++ b/libgfortran/generated/maxloc1_4_r4.c @@ -58,24 +58,23 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c index bb7876f2241..170e3dfce1a 100644 --- a/libgfortran/generated/maxloc1_4_r8.c +++ b/libgfortran/generated/maxloc1_4_r8.c @@ -58,24 +58,23 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i1.c b/libgfortran/generated/maxloc1_8_i1.c index 899b4688c10..9924b718847 100644 --- a/libgfortran/generated/maxloc1_8_i1.c +++ b/libgfortran/generated/maxloc1_8_i1.c @@ -58,24 +58,23 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i16.c b/libgfortran/generated/maxloc1_8_i16.c index c5f7272a03f..97946f3dd52 100644 --- a/libgfortran/generated/maxloc1_8_i16.c +++ b/libgfortran/generated/maxloc1_8_i16.c @@ -58,24 +58,23 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i2.c b/libgfortran/generated/maxloc1_8_i2.c index f20435aec42..d343b0b36c3 100644 --- a/libgfortran/generated/maxloc1_8_i2.c +++ b/libgfortran/generated/maxloc1_8_i2.c @@ -58,24 +58,23 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c index ab17f22d967..682de41af38 100644 --- a/libgfortran/generated/maxloc1_8_i4.c +++ b/libgfortran/generated/maxloc1_8_i4.c @@ -58,24 +58,23 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c index eb72ab68514..e17ecc49915 100644 --- a/libgfortran/generated/maxloc1_8_i8.c +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -58,24 +58,23 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c index 8758d3129a8..cb4b69201ee 100644 --- a/libgfortran/generated/maxloc1_8_r10.c +++ b/libgfortran/generated/maxloc1_8_r10.c @@ -58,24 +58,23 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c index 290929c9538..5a99dafa388 100644 --- a/libgfortran/generated/maxloc1_8_r16.c +++ b/libgfortran/generated/maxloc1_8_r16.c @@ -58,24 +58,23 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c index a59051ecd26..ba88d8ee418 100644 --- a/libgfortran/generated/maxloc1_8_r4.c +++ b/libgfortran/generated/maxloc1_8_r4.c @@ -58,24 +58,23 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c index 88410eae640..6d05b43051d 100644 --- a/libgfortran/generated/maxloc1_8_r8.c +++ b/libgfortran/generated/maxloc1_8_r8.c @@ -58,24 +58,23 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_i1.c b/libgfortran/generated/maxval_i1.c index c190e067b06..10193fdf95d 100644 --- a/libgfortran/generated/maxval_i1.c +++ b/libgfortran/generated/maxval_i1.c @@ -57,24 +57,23 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_i16.c b/libgfortran/generated/maxval_i16.c index 6b872f98cad..884ed6678f2 100644 --- a/libgfortran/generated/maxval_i16.c +++ b/libgfortran/generated/maxval_i16.c @@ -57,24 +57,23 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_i2.c b/libgfortran/generated/maxval_i2.c index 67b8994cd32..3abe6579749 100644 --- a/libgfortran/generated/maxval_i2.c +++ b/libgfortran/generated/maxval_i2.c @@ -57,24 +57,23 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c index e7fb5bc5af7..57aea5fb429 100644 --- a/libgfortran/generated/maxval_i4.c +++ b/libgfortran/generated/maxval_i4.c @@ -57,24 +57,23 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c index b90e1105e56..9d7f57c1cba 100644 --- a/libgfortran/generated/maxval_i8.c +++ b/libgfortran/generated/maxval_i8.c @@ -57,24 +57,23 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_r10.c b/libgfortran/generated/maxval_r10.c index 85851904ff2..2259e8e2be5 100644 --- a/libgfortran/generated/maxval_r10.c +++ b/libgfortran/generated/maxval_r10.c @@ -57,24 +57,23 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_r16.c b/libgfortran/generated/maxval_r16.c index d9c456646af..7efdd65718c 100644 --- a/libgfortran/generated/maxval_r16.c +++ b/libgfortran/generated/maxval_r16.c @@ -57,24 +57,23 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c index 1102d4c7a82..623c25c7f8e 100644 --- a/libgfortran/generated/maxval_r4.c +++ b/libgfortran/generated/maxval_r4.c @@ -57,24 +57,23 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c index ee23df75dbe..bdbb26f06d0 100644 --- a/libgfortran/generated/maxval_r8.c +++ b/libgfortran/generated/maxval_r8.c @@ -57,24 +57,23 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MAXVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MAXVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc0_16_i1.c b/libgfortran/generated/minloc0_16_i1.c index e0c6345b12f..961beb924d3 100644 --- a/libgfortran/generated/minloc0_16_i1.c +++ b/libgfortran/generated/minloc0_16_i1.c @@ -55,9 +55,7 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_i1 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_i16.c b/libgfortran/generated/minloc0_16_i16.c index 1c168542524..7303592131c 100644 --- a/libgfortran/generated/minloc0_16_i16.c +++ b/libgfortran/generated/minloc0_16_i16.c @@ -55,9 +55,7 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_i2.c b/libgfortran/generated/minloc0_16_i2.c index d289cfcbf66..ee9f46c00b0 100644 --- a/libgfortran/generated/minloc0_16_i2.c +++ b/libgfortran/generated/minloc0_16_i2.c @@ -55,9 +55,7 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_i2 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_i4.c b/libgfortran/generated/minloc0_16_i4.c index 88a078e6a58..6d07bbe2669 100644 --- a/libgfortran/generated/minloc0_16_i4.c +++ b/libgfortran/generated/minloc0_16_i4.c @@ -55,9 +55,7 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_i4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_i8.c b/libgfortran/generated/minloc0_16_i8.c index b41b5913d0e..bbacc119ec1 100644 --- a/libgfortran/generated/minloc0_16_i8.c +++ b/libgfortran/generated/minloc0_16_i8.c @@ -55,9 +55,7 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_i8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_r10.c b/libgfortran/generated/minloc0_16_r10.c index c79f256bc20..a77efcdc5c7 100644 --- a/libgfortran/generated/minloc0_16_r10.c +++ b/libgfortran/generated/minloc0_16_r10.c @@ -55,9 +55,7 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_r10 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_r16.c b/libgfortran/generated/minloc0_16_r16.c index 75a9df5faa5..1d29e07f297 100644 --- a/libgfortran/generated/minloc0_16_r16.c +++ b/libgfortran/generated/minloc0_16_r16.c @@ -55,9 +55,7 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_r16 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_r4.c b/libgfortran/generated/minloc0_16_r4.c index 0fb2966adab..1c451e9f76b 100644 --- a/libgfortran/generated/minloc0_16_r4.c +++ b/libgfortran/generated/minloc0_16_r4.c @@ -55,9 +55,7 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_r4 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_r8.c b/libgfortran/generated/minloc0_16_r8.c index 317e8be3b1a..d6c70869584 100644 --- a/libgfortran/generated/minloc0_16_r8.c +++ b/libgfortran/generated/minloc0_16_r8.c @@ -55,9 +55,7 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -74,7 +72,7 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -200,7 +196,7 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); @@ -358,13 +352,13 @@ sminloc0_16_r8 (gfc_array_i16 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i1.c b/libgfortran/generated/minloc0_4_i1.c index 363d4a4ae9c..418eb30d240 100644 --- a/libgfortran/generated/minloc0_4_i1.c +++ b/libgfortran/generated/minloc0_4_i1.c @@ -55,9 +55,7 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_i1 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i16.c b/libgfortran/generated/minloc0_4_i16.c index cca045ab5d4..9a23b27e3d8 100644 --- a/libgfortran/generated/minloc0_4_i16.c +++ b/libgfortran/generated/minloc0_4_i16.c @@ -55,9 +55,7 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_i16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i2.c b/libgfortran/generated/minloc0_4_i2.c index 60e2350b6f2..df081acb814 100644 --- a/libgfortran/generated/minloc0_4_i2.c +++ b/libgfortran/generated/minloc0_4_i2.c @@ -55,9 +55,7 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_i2 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i4.c b/libgfortran/generated/minloc0_4_i4.c index 94a15e02652..b076dcf5955 100644 --- a/libgfortran/generated/minloc0_4_i4.c +++ b/libgfortran/generated/minloc0_4_i4.c @@ -55,9 +55,7 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_i4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i8.c b/libgfortran/generated/minloc0_4_i8.c index c556702f113..944694c5c9d 100644 --- a/libgfortran/generated/minloc0_4_i8.c +++ b/libgfortran/generated/minloc0_4_i8.c @@ -55,9 +55,7 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_i8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_r10.c b/libgfortran/generated/minloc0_4_r10.c index 62efe8358f6..03b8fd43afb 100644 --- a/libgfortran/generated/minloc0_4_r10.c +++ b/libgfortran/generated/minloc0_4_r10.c @@ -55,9 +55,7 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_r10 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_r16.c b/libgfortran/generated/minloc0_4_r16.c index 9146890c39c..88059c623fe 100644 --- a/libgfortran/generated/minloc0_4_r16.c +++ b/libgfortran/generated/minloc0_4_r16.c @@ -55,9 +55,7 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_r16 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_r4.c b/libgfortran/generated/minloc0_4_r4.c index 40d3c58ffe9..0b1e642ba23 100644 --- a/libgfortran/generated/minloc0_4_r4.c +++ b/libgfortran/generated/minloc0_4_r4.c @@ -55,9 +55,7 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_r4 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_r8.c b/libgfortran/generated/minloc0_4_r8.c index 904811b2521..a6843b1d804 100644 --- a/libgfortran/generated/minloc0_4_r8.c +++ b/libgfortran/generated/minloc0_4_r8.c @@ -55,9 +55,7 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -74,7 +72,7 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -200,7 +196,7 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); @@ -358,13 +352,13 @@ sminloc0_4_r8 (gfc_array_i4 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i1.c b/libgfortran/generated/minloc0_8_i1.c index 9e00f076a4c..5617affe49b 100644 --- a/libgfortran/generated/minloc0_8_i1.c +++ b/libgfortran/generated/minloc0_8_i1.c @@ -55,9 +55,7 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_i1 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i16.c b/libgfortran/generated/minloc0_8_i16.c index bec8fa0c348..bc2454a1367 100644 --- a/libgfortran/generated/minloc0_8_i16.c +++ b/libgfortran/generated/minloc0_8_i16.c @@ -55,9 +55,7 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_i16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i2.c b/libgfortran/generated/minloc0_8_i2.c index cc46e3f2751..198c9b90cb9 100644 --- a/libgfortran/generated/minloc0_8_i2.c +++ b/libgfortran/generated/minloc0_8_i2.c @@ -55,9 +55,7 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_i2 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i4.c b/libgfortran/generated/minloc0_8_i4.c index 9d9a3ba77eb..c62fbcb1166 100644 --- a/libgfortran/generated/minloc0_8_i4.c +++ b/libgfortran/generated/minloc0_8_i4.c @@ -55,9 +55,7 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_i4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i8.c b/libgfortran/generated/minloc0_8_i8.c index 4a57114c480..ffc790088f9 100644 --- a/libgfortran/generated/minloc0_8_i8.c +++ b/libgfortran/generated/minloc0_8_i8.c @@ -55,9 +55,7 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_i8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_r10.c b/libgfortran/generated/minloc0_8_r10.c index 6d74ee453a9..68eb7b6ecab 100644 --- a/libgfortran/generated/minloc0_8_r10.c +++ b/libgfortran/generated/minloc0_8_r10.c @@ -55,9 +55,7 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_r10 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_r16.c b/libgfortran/generated/minloc0_8_r16.c index 8a112f94a74..da7ae066704 100644 --- a/libgfortran/generated/minloc0_8_r16.c +++ b/libgfortran/generated/minloc0_8_r16.c @@ -55,9 +55,7 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_r16 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_r4.c b/libgfortran/generated/minloc0_8_r4.c index 2f81720b697..fbf5bab98af 100644 --- a/libgfortran/generated/minloc0_8_r4.c +++ b/libgfortran/generated/minloc0_8_r4.c @@ -55,9 +55,7 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_r4 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_r8.c b/libgfortran/generated/minloc0_8_r8.c index 0e1df47288e..2dd4cfdf406 100644 --- a/libgfortran/generated/minloc0_8_r8.c +++ b/libgfortran/generated/minloc0_8_r8.c @@ -55,9 +55,7 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -74,7 +72,7 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -82,12 +80,12 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -179,9 +177,7 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -200,7 +196,7 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " MINLOC intrnisic: is %ld, should be %ld", @@ -214,8 +210,8 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -238,13 +234,13 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -339,9 +335,7 @@ sminloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); @@ -358,13 +352,13 @@ sminloc0_8_r8 (gfc_array_i8 * const restrict retarray, runtime_error ("rank of return array in MINLOC intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc1_16_i1.c b/libgfortran/generated/minloc1_16_i1.c index 06127ce9e69..5a5ff5e39e2 100644 --- a/libgfortran/generated/minloc1_16_i1.c +++ b/libgfortran/generated/minloc1_16_i1.c @@ -58,24 +58,23 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_i16.c b/libgfortran/generated/minloc1_16_i16.c index fb0d027b410..25d4ceaae51 100644 --- a/libgfortran/generated/minloc1_16_i16.c +++ b/libgfortran/generated/minloc1_16_i16.c @@ -58,24 +58,23 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_i2.c b/libgfortran/generated/minloc1_16_i2.c index 4a58cc1d39e..228a582ed09 100644 --- a/libgfortran/generated/minloc1_16_i2.c +++ b/libgfortran/generated/minloc1_16_i2.c @@ -58,24 +58,23 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_i4.c b/libgfortran/generated/minloc1_16_i4.c index 549fd25037a..c8652722a86 100644 --- a/libgfortran/generated/minloc1_16_i4.c +++ b/libgfortran/generated/minloc1_16_i4.c @@ -58,24 +58,23 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_i8.c b/libgfortran/generated/minloc1_16_i8.c index ea4e8543651..fa124441dd6 100644 --- a/libgfortran/generated/minloc1_16_i8.c +++ b/libgfortran/generated/minloc1_16_i8.c @@ -58,24 +58,23 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_r10.c b/libgfortran/generated/minloc1_16_r10.c index 7696c16f1cc..15862a89cb5 100644 --- a/libgfortran/generated/minloc1_16_r10.c +++ b/libgfortran/generated/minloc1_16_r10.c @@ -58,24 +58,23 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_r16.c b/libgfortran/generated/minloc1_16_r16.c index 21cee9085a7..f0b452fa09d 100644 --- a/libgfortran/generated/minloc1_16_r16.c +++ b/libgfortran/generated/minloc1_16_r16.c @@ -58,24 +58,23 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_r4.c b/libgfortran/generated/minloc1_16_r4.c index b17faefcb54..692259db8c8 100644 --- a/libgfortran/generated/minloc1_16_r4.c +++ b/libgfortran/generated/minloc1_16_r4.c @@ -58,24 +58,23 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_r8.c b/libgfortran/generated/minloc1_16_r8.c index bdf917c6506..c0189da58f7 100644 --- a/libgfortran/generated/minloc1_16_r8.c +++ b/libgfortran/generated/minloc1_16_r8.c @@ -58,24 +58,23 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i1.c b/libgfortran/generated/minloc1_4_i1.c index 2a869229210..164f7ec31a2 100644 --- a/libgfortran/generated/minloc1_4_i1.c +++ b/libgfortran/generated/minloc1_4_i1.c @@ -58,24 +58,23 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i16.c b/libgfortran/generated/minloc1_4_i16.c index 93f7ca2ab7a..899f2029bd3 100644 --- a/libgfortran/generated/minloc1_4_i16.c +++ b/libgfortran/generated/minloc1_4_i16.c @@ -58,24 +58,23 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i2.c b/libgfortran/generated/minloc1_4_i2.c index 6bc8f5706d2..f900506de74 100644 --- a/libgfortran/generated/minloc1_4_i2.c +++ b/libgfortran/generated/minloc1_4_i2.c @@ -58,24 +58,23 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c index 685d242e582..7dedb8f1c5b 100644 --- a/libgfortran/generated/minloc1_4_i4.c +++ b/libgfortran/generated/minloc1_4_i4.c @@ -58,24 +58,23 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c index b3f506a238d..70eaefa8ed6 100644 --- a/libgfortran/generated/minloc1_4_i8.c +++ b/libgfortran/generated/minloc1_4_i8.c @@ -58,24 +58,23 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_r10.c b/libgfortran/generated/minloc1_4_r10.c index 8d93866a009..1a0bdfa7ac1 100644 --- a/libgfortran/generated/minloc1_4_r10.c +++ b/libgfortran/generated/minloc1_4_r10.c @@ -58,24 +58,23 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_r16.c b/libgfortran/generated/minloc1_4_r16.c index b2909ab97cd..b8849a56d35 100644 --- a/libgfortran/generated/minloc1_4_r16.c +++ b/libgfortran/generated/minloc1_4_r16.c @@ -58,24 +58,23 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c index 9741c2bdb6a..cc382dba224 100644 --- a/libgfortran/generated/minloc1_4_r4.c +++ b/libgfortran/generated/minloc1_4_r4.c @@ -58,24 +58,23 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c index 4b26710aad9..c36567ffee6 100644 --- a/libgfortran/generated/minloc1_4_r8.c +++ b/libgfortran/generated/minloc1_4_r8.c @@ -58,24 +58,23 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i1.c b/libgfortran/generated/minloc1_8_i1.c index b92faa76494..6e46c82b863 100644 --- a/libgfortran/generated/minloc1_8_i1.c +++ b/libgfortran/generated/minloc1_8_i1.c @@ -58,24 +58,23 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i16.c b/libgfortran/generated/minloc1_8_i16.c index d9283953c85..8e8410aa669 100644 --- a/libgfortran/generated/minloc1_8_i16.c +++ b/libgfortran/generated/minloc1_8_i16.c @@ -58,24 +58,23 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i2.c b/libgfortran/generated/minloc1_8_i2.c index b012f96b2db..2a33e3c1fb7 100644 --- a/libgfortran/generated/minloc1_8_i2.c +++ b/libgfortran/generated/minloc1_8_i2.c @@ -58,24 +58,23 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c index 107bf8f6e78..70cdef68bc6 100644 --- a/libgfortran/generated/minloc1_8_i4.c +++ b/libgfortran/generated/minloc1_8_i4.c @@ -58,24 +58,23 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c index 16073feb373..c1a01e9e436 100644 --- a/libgfortran/generated/minloc1_8_i8.c +++ b/libgfortran/generated/minloc1_8_i8.c @@ -58,24 +58,23 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_r10.c b/libgfortran/generated/minloc1_8_r10.c index 3acd9c3a8f5..b5a6c8d2d26 100644 --- a/libgfortran/generated/minloc1_8_r10.c +++ b/libgfortran/generated/minloc1_8_r10.c @@ -58,24 +58,23 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_r16.c b/libgfortran/generated/minloc1_8_r16.c index e194986d5d8..0f4b036461d 100644 --- a/libgfortran/generated/minloc1_8_r16.c +++ b/libgfortran/generated/minloc1_8_r16.c @@ -58,24 +58,23 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c index 1e32884c5c1..300b5bebf0d 100644 --- a/libgfortran/generated/minloc1_8_r4.c +++ b/libgfortran/generated/minloc1_8_r4.c @@ -58,24 +58,23 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c index 85ad5b73381..da498f661ac 100644 --- a/libgfortran/generated/minloc1_8_r8.c +++ b/libgfortran/generated/minloc1_8_r8.c @@ -58,24 +58,23 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -83,30 +82,31 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -125,8 +125,7 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -139,7 +138,7 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -236,7 +235,7 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -253,14 +252,14 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -268,10 +267,9 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -279,19 +277,20 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -300,8 +299,7 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -319,8 +317,7 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -331,8 +328,8 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINLOC intrinsic in dimension %ld:" @@ -345,7 +342,7 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -448,8 +445,8 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -457,9 +454,9 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -467,29 +464,29 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -509,8 +506,7 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINLOC intrinsic in dimension %ld:" @@ -523,7 +519,7 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_i1.c b/libgfortran/generated/minval_i1.c index f761faa8ad5..437232a89da 100644 --- a/libgfortran/generated/minval_i1.c +++ b/libgfortran/generated/minval_i1.c @@ -57,24 +57,23 @@ minval_i1 (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_i1 (gfc_array_i1 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_i16.c b/libgfortran/generated/minval_i16.c index e0bd7332316..f0bd16fe003 100644 --- a/libgfortran/generated/minval_i16.c +++ b/libgfortran/generated/minval_i16.c @@ -57,24 +57,23 @@ minval_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_i16 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_i2.c b/libgfortran/generated/minval_i2.c index bfa14b224c6..08fd3a60b77 100644 --- a/libgfortran/generated/minval_i2.c +++ b/libgfortran/generated/minval_i2.c @@ -57,24 +57,23 @@ minval_i2 (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_i2 (gfc_array_i2 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c index ba1e592fa06..d7e1ef93966 100644 --- a/libgfortran/generated/minval_i4.c +++ b/libgfortran/generated/minval_i4.c @@ -57,24 +57,23 @@ minval_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_i4 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c index 0287e054a78..7b6fdc5e5ae 100644 --- a/libgfortran/generated/minval_i8.c +++ b/libgfortran/generated/minval_i8.c @@ -57,24 +57,23 @@ minval_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_i8 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_r10.c b/libgfortran/generated/minval_r10.c index 202ae7fd384..1f6a75f0f6c 100644 --- a/libgfortran/generated/minval_r10.c +++ b/libgfortran/generated/minval_r10.c @@ -57,24 +57,23 @@ minval_r10 (gfc_array_r10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_r10 (gfc_array_r10 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_r16.c b/libgfortran/generated/minval_r16.c index fe4210fb7be..555d86fd66f 100644 --- a/libgfortran/generated/minval_r16.c +++ b/libgfortran/generated/minval_r16.c @@ -57,24 +57,23 @@ minval_r16 (gfc_array_r16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_r16 (gfc_array_r16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c index 7dcd5677d23..a7f729ee732 100644 --- a/libgfortran/generated/minval_r4.c +++ b/libgfortran/generated/minval_r4.c @@ -57,24 +57,23 @@ minval_r4 (gfc_array_r4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_r4 (gfc_array_r4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c index e92842f3a7f..69afca1bc50 100644 --- a/libgfortran/generated/minval_r8.c +++ b/libgfortran/generated/minval_r8.c @@ -57,24 +57,23 @@ minval_r8 (gfc_array_r8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ minval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ minval_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ minval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -230,7 +229,7 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -247,14 +246,14 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -262,10 +261,9 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -273,19 +271,20 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -294,8 +293,7 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -313,8 +311,7 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -325,8 +322,8 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " MINVAL intrinsic in dimension %ld:" @@ -339,7 +336,7 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -437,8 +434,8 @@ sminval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -446,9 +443,9 @@ sminval_r8 (gfc_array_r8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -456,29 +453,29 @@ sminval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -498,8 +495,7 @@ sminval_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " MINVAL intrinsic in dimension %ld:" @@ -512,7 +508,7 @@ sminval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/pack_c10.c b/libgfortran/generated/pack_c10.c index 29b1c5bae58..008fb5c9236 100644 --- a/libgfortran/generated/pack_c10.c +++ b/libgfortran/generated/pack_c10.c @@ -122,11 +122,11 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_c16.c b/libgfortran/generated/pack_c16.c index d8589413e7e..e7d039f5bec 100644 --- a/libgfortran/generated/pack_c16.c +++ b/libgfortran/generated/pack_c16.c @@ -122,11 +122,11 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_c4.c b/libgfortran/generated/pack_c4.c index 5b69c98c8f0..fe1f68d4225 100644 --- a/libgfortran/generated/pack_c4.c +++ b/libgfortran/generated/pack_c4.c @@ -122,11 +122,11 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_c8.c b/libgfortran/generated/pack_c8.c index 2d61cb19a8b..f5a27eca6f5 100644 --- a/libgfortran/generated/pack_c8.c +++ b/libgfortran/generated/pack_c8.c @@ -122,11 +122,11 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i1.c b/libgfortran/generated/pack_i1.c index 32b04c232c6..edc895082a4 100644 --- a/libgfortran/generated/pack_i1.c +++ b/libgfortran/generated/pack_i1.c @@ -122,11 +122,11 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i16.c b/libgfortran/generated/pack_i16.c index 36c92525317..8f38a2747ec 100644 --- a/libgfortran/generated/pack_i16.c +++ b/libgfortran/generated/pack_i16.c @@ -122,11 +122,11 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i2.c b/libgfortran/generated/pack_i2.c index b510231de6d..149e9f6f67d 100644 --- a/libgfortran/generated/pack_i2.c +++ b/libgfortran/generated/pack_i2.c @@ -122,11 +122,11 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i4.c b/libgfortran/generated/pack_i4.c index b350b895c05..dad10d62d46 100644 --- a/libgfortran/generated/pack_i4.c +++ b/libgfortran/generated/pack_i4.c @@ -122,11 +122,11 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i8.c b/libgfortran/generated/pack_i8.c index 25f088353e8..0a23aa5b72f 100644 --- a/libgfortran/generated/pack_i8.c +++ b/libgfortran/generated/pack_i8.c @@ -122,11 +122,11 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_r10.c b/libgfortran/generated/pack_r10.c index e1f3041d744..e4bbe6fabcf 100644 --- a/libgfortran/generated/pack_r10.c +++ b/libgfortran/generated/pack_r10.c @@ -122,11 +122,11 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_r16.c b/libgfortran/generated/pack_r16.c index 834ef55b84d..7dff30b7006 100644 --- a/libgfortran/generated/pack_r16.c +++ b/libgfortran/generated/pack_r16.c @@ -122,11 +122,11 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_r4.c b/libgfortran/generated/pack_r4.c index 859e216f568..51d46a27218 100644 --- a/libgfortran/generated/pack_r4.c +++ b/libgfortran/generated/pack_r4.c @@ -122,11 +122,11 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_r8.c b/libgfortran/generated/pack_r8.c index ba2e60d7519..582c2b9aeb1 100644 --- a/libgfortran/generated/pack_r8.c +++ b/libgfortran/generated/pack_r8.c @@ -122,11 +122,11 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -147,7 +147,7 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -215,9 +215,7 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -234,7 +232,7 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -242,7 +240,7 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -291,11 +289,11 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/product_c10.c b/libgfortran/generated/product_c10.c index 5fcba7993f4..69f7f8b7026 100644 --- a/libgfortran/generated/product_c10.c +++ b/libgfortran/generated/product_c10.c @@ -57,24 +57,23 @@ product_c10 (gfc_array_c10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_c10 (gfc_array_c10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_c10 (gfc_array_c10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_c16.c b/libgfortran/generated/product_c16.c index ffa58365150..efaed2cebdb 100644 --- a/libgfortran/generated/product_c16.c +++ b/libgfortran/generated/product_c16.c @@ -57,24 +57,23 @@ product_c16 (gfc_array_c16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_c16 (gfc_array_c16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_c16 (gfc_array_c16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c index c2301d6f491..505647ecd2e 100644 --- a/libgfortran/generated/product_c4.c +++ b/libgfortran/generated/product_c4.c @@ -57,24 +57,23 @@ product_c4 (gfc_array_c4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_c4 (gfc_array_c4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_c4 (gfc_array_c4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c index 3c36570280d..16c776ad839 100644 --- a/libgfortran/generated/product_c8.c +++ b/libgfortran/generated/product_c8.c @@ -57,24 +57,23 @@ product_c8 (gfc_array_c8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_c8 (gfc_array_c8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_c8 (gfc_array_c8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_i1.c b/libgfortran/generated/product_i1.c index ab177fae6d4..cbc1ab120af 100644 --- a/libgfortran/generated/product_i1.c +++ b/libgfortran/generated/product_i1.c @@ -57,24 +57,23 @@ product_i1 (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_i16.c b/libgfortran/generated/product_i16.c index 12b0fa4ee66..e3b8c2a07e0 100644 --- a/libgfortran/generated/product_i16.c +++ b/libgfortran/generated/product_i16.c @@ -57,24 +57,23 @@ product_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_i2.c b/libgfortran/generated/product_i2.c index b43e871c35d..507d956cb81 100644 --- a/libgfortran/generated/product_i2.c +++ b/libgfortran/generated/product_i2.c @@ -57,24 +57,23 @@ product_i2 (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c index 907fce89da9..d5af3679561 100644 --- a/libgfortran/generated/product_i4.c +++ b/libgfortran/generated/product_i4.c @@ -57,24 +57,23 @@ product_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c index 3d8869841e4..3308d91dff9 100644 --- a/libgfortran/generated/product_i8.c +++ b/libgfortran/generated/product_i8.c @@ -57,24 +57,23 @@ product_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_r10.c b/libgfortran/generated/product_r10.c index 9da47228823..7bae90414b6 100644 --- a/libgfortran/generated/product_r10.c +++ b/libgfortran/generated/product_r10.c @@ -57,24 +57,23 @@ product_r10 (gfc_array_r10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_r16.c b/libgfortran/generated/product_r16.c index 55c2303fa91..bb678725d7c 100644 --- a/libgfortran/generated/product_r16.c +++ b/libgfortran/generated/product_r16.c @@ -57,24 +57,23 @@ product_r16 (gfc_array_r16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c index 7a66bdc2ff3..333c13d2ffe 100644 --- a/libgfortran/generated/product_r4.c +++ b/libgfortran/generated/product_r4.c @@ -57,24 +57,23 @@ product_r4 (gfc_array_r4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c index d120369f7fd..46258c00bbc 100644 --- a/libgfortran/generated/product_r8.c +++ b/libgfortran/generated/product_r8.c @@ -57,24 +57,23 @@ product_r8 (gfc_array_r8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ product_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ product_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ product_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " PRODUCT intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " PRODUCT intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/reshape_c10.c b/libgfortran/generated/reshape_c10.c index 4a4094cc774..34eff9086a0 100644 --- a/libgfortran/generated/reshape_c10.c +++ b/libgfortran/generated/reshape_c10.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_c10 (gfc_array_c10 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_c10 (gfc_array_c10 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_c10 (gfc_array_c10 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_c16.c b/libgfortran/generated/reshape_c16.c index a2cec54d5da..569b76ce4a8 100644 --- a/libgfortran/generated/reshape_c16.c +++ b/libgfortran/generated/reshape_c16.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_c16 (gfc_array_c16 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_c16 (gfc_array_c16 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_c16 (gfc_array_c16 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_c4.c b/libgfortran/generated/reshape_c4.c index 95fbb791ff8..c8b7355de37 100644 --- a/libgfortran/generated/reshape_c4.c +++ b/libgfortran/generated/reshape_c4.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_c4 (gfc_array_c4 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_c4 (gfc_array_c4 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_c4 (gfc_array_c4 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_c8.c b/libgfortran/generated/reshape_c8.c index a34127c8f84..1a390b4509b 100644 --- a/libgfortran/generated/reshape_c8.c +++ b/libgfortran/generated/reshape_c8.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_c8 (gfc_array_c8 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_c8 (gfc_array_c8 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_c8 (gfc_array_c8 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_i16.c b/libgfortran/generated/reshape_i16.c index e40be6079f3..4f69ce0d287 100644 --- a/libgfortran/generated/reshape_i16.c +++ b/libgfortran/generated/reshape_i16.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_16 (gfc_array_i16 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_16 (gfc_array_i16 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_16 (gfc_array_i16 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_i4.c b/libgfortran/generated/reshape_i4.c index 4b76fdb30c3..53016bdf597 100644 --- a/libgfortran/generated/reshape_i4.c +++ b/libgfortran/generated/reshape_i4.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_4 (gfc_array_i4 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_4 (gfc_array_i4 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_4 (gfc_array_i4 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_i8.c b/libgfortran/generated/reshape_i8.c index 8856e81582a..34620cf6d40 100644 --- a/libgfortran/generated/reshape_i8.c +++ b/libgfortran/generated/reshape_i8.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_8 (gfc_array_i8 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_8 (gfc_array_i8 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_8 (gfc_array_i8 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_r10.c b/libgfortran/generated/reshape_r10.c index 3e08b7c6498..3bf319aa434 100644 --- a/libgfortran/generated/reshape_r10.c +++ b/libgfortran/generated/reshape_r10.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_r10 (gfc_array_r10 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_r10 (gfc_array_r10 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_r10 (gfc_array_r10 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_r16.c b/libgfortran/generated/reshape_r16.c index d78df1251e3..6794b506059 100644 --- a/libgfortran/generated/reshape_r16.c +++ b/libgfortran/generated/reshape_r16.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_r16 (gfc_array_r16 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_r16 (gfc_array_r16 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_r16 (gfc_array_r16 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_r4.c b/libgfortran/generated/reshape_r4.c index 1577058308e..e7bfbfbf538 100644 --- a/libgfortran/generated/reshape_r4.c +++ b/libgfortran/generated/reshape_r4.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_r4 (gfc_array_r4 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_r4 (gfc_array_r4 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_r4 (gfc_array_r4 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/reshape_r8.c b/libgfortran/generated/reshape_r8.c index dcbedb82d37..d0441c0fe5d 100644 --- a/libgfortran/generated/reshape_r8.c +++ b/libgfortran/generated/reshape_r8.c @@ -1,4 +1,4 @@ -/* Implementation of the RESHAPE +/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -79,7 +79,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -87,7 +87,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -100,10 +100,10 @@ reshape_r8 (gfc_array_r8 * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -122,8 +122,8 @@ reshape_r8 (gfc_array_r8 * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -153,7 +153,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -166,7 +166,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -185,7 +185,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -204,13 +204,13 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -231,8 +231,8 @@ reshape_r8 (gfc_array_r8 * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/generated/shape_i16.c b/libgfortran/generated/shape_i16.c index 249793d7db1..9ce28577baa 100644 --- a/libgfortran/generated/shape_i16.c +++ b/libgfortran/generated/shape_i16.c @@ -42,14 +42,14 @@ shape_16 (gfc_array_i16 * const restrict ret, index_type stride; index_type extent; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); - if (ret->dim[0].ubound < ret->dim[0].lbound) + if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) { - extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent = GFC_DESCRIPTOR_EXTENT(array,n); ret->data[n * stride] = extent > 0 ? extent : 0 ; } } diff --git a/libgfortran/generated/shape_i4.c b/libgfortran/generated/shape_i4.c index 386b84e1641..1b23335de56 100644 --- a/libgfortran/generated/shape_i4.c +++ b/libgfortran/generated/shape_i4.c @@ -42,14 +42,14 @@ shape_4 (gfc_array_i4 * const restrict ret, index_type stride; index_type extent; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); - if (ret->dim[0].ubound < ret->dim[0].lbound) + if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) { - extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent = GFC_DESCRIPTOR_EXTENT(array,n); ret->data[n * stride] = extent > 0 ? extent : 0 ; } } diff --git a/libgfortran/generated/shape_i8.c b/libgfortran/generated/shape_i8.c index f0498bc6d71..efe00a5dd33 100644 --- a/libgfortran/generated/shape_i8.c +++ b/libgfortran/generated/shape_i8.c @@ -42,14 +42,14 @@ shape_8 (gfc_array_i8 * const restrict ret, index_type stride; index_type extent; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); - if (ret->dim[0].ubound < ret->dim[0].lbound) + if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) { - extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent = GFC_DESCRIPTOR_EXTENT(array,n); ret->data[n * stride] = extent > 0 ? extent : 0 ; } } diff --git a/libgfortran/generated/spread_c10.c b/libgfortran/generated/spread_c10.c index d7e1ee11a45..77a838f01a4 100644 --- a/libgfortran/generated/spread_c10.c +++ b/libgfortran/generated/spread_c10.c @@ -69,6 +69,9 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_c10 (gfc_array_c10 *ret, const GFC_COMPLEX_10 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_10)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_c16.c b/libgfortran/generated/spread_c16.c index d57cdd9014d..1276e4dfb44 100644 --- a/libgfortran/generated/spread_c16.c +++ b/libgfortran/generated/spread_c16.c @@ -69,6 +69,9 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_c16 (gfc_array_c16 *ret, const GFC_COMPLEX_16 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_16)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_c4.c b/libgfortran/generated/spread_c4.c index ddd6305c1a0..5224e8477a9 100644 --- a/libgfortran/generated/spread_c4.c +++ b/libgfortran/generated/spread_c4.c @@ -69,6 +69,9 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_c4 (gfc_array_c4 *ret, const GFC_COMPLEX_4 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_4)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_c8.c b/libgfortran/generated/spread_c8.c index 8a32ee4c964..96ecb3afb87 100644 --- a/libgfortran/generated/spread_c8.c +++ b/libgfortran/generated/spread_c8.c @@ -69,6 +69,9 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_c8 (gfc_array_c8 *ret, const GFC_COMPLEX_8 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_8)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i1.c b/libgfortran/generated/spread_i1.c index e5a2c34f8be..e002c146262 100644 --- a/libgfortran/generated/spread_i1.c +++ b/libgfortran/generated/spread_i1.c @@ -69,6 +69,9 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_i1 (gfc_array_i1 *ret, const GFC_INTEGER_1 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_1)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i16.c b/libgfortran/generated/spread_i16.c index a4545576485..bdefdac3271 100644 --- a/libgfortran/generated/spread_i16.c +++ b/libgfortran/generated/spread_i16.c @@ -69,6 +69,9 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_i16 (gfc_array_i16 *ret, const GFC_INTEGER_16 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_16)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i2.c b/libgfortran/generated/spread_i2.c index 3bcccb190e2..8482cfde857 100644 --- a/libgfortran/generated/spread_i2.c +++ b/libgfortran/generated/spread_i2.c @@ -69,6 +69,9 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_i2 (gfc_array_i2 *ret, const GFC_INTEGER_2 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_2)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i4.c b/libgfortran/generated/spread_i4.c index 336ca7c958f..6eff6326b26 100644 --- a/libgfortran/generated/spread_i4.c +++ b/libgfortran/generated/spread_i4.c @@ -69,6 +69,9 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_i4 (gfc_array_i4 *ret, const GFC_INTEGER_4 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_4)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i8.c b/libgfortran/generated/spread_i8.c index 6b10a814199..29312636306 100644 --- a/libgfortran/generated/spread_i8.c +++ b/libgfortran/generated/spread_i8.c @@ -69,6 +69,9 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_i8 (gfc_array_i8 *ret, const GFC_INTEGER_8 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_8)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_r10.c b/libgfortran/generated/spread_r10.c index 9a3a356975b..3c3f197b4c2 100644 --- a/libgfortran/generated/spread_r10.c +++ b/libgfortran/generated/spread_r10.c @@ -69,6 +69,9 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_r10 (gfc_array_r10 *ret, const GFC_REAL_10 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_10)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_r16.c b/libgfortran/generated/spread_r16.c index 69ab4c65009..13162609696 100644 --- a/libgfortran/generated/spread_r16.c +++ b/libgfortran/generated/spread_r16.c @@ -69,6 +69,9 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_r16 (gfc_array_r16 *ret, const GFC_REAL_16 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_16)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_r4.c b/libgfortran/generated/spread_r4.c index 6f018de8fdf..cc0f1197b69 100644 --- a/libgfortran/generated/spread_r4.c +++ b/libgfortran/generated/spread_r4.c @@ -69,6 +69,9 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_r4 (gfc_array_r4 *ret, const GFC_REAL_4 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_4)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_r8.c b/libgfortran/generated/spread_r8.c index d05e31a92b8..f38ef3885fc 100644 --- a/libgfortran/generated/spread_r8.c +++ b/libgfortran/generated/spread_r8.c @@ -69,6 +69,9 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -76,26 +79,25 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -122,10 +124,10 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -136,8 +138,7 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -147,8 +148,8 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -159,17 +160,16 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -248,19 +248,17 @@ spread_scalar_r8 (gfc_array_r8 *ret, const GFC_REAL_8 *source, { ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_8)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/sum_c10.c b/libgfortran/generated/sum_c10.c index a1f658ed416..c63bc695266 100644 --- a/libgfortran/generated/sum_c10.c +++ b/libgfortran/generated/sum_c10.c @@ -57,24 +57,23 @@ sum_c10 (gfc_array_c10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_c10 (gfc_array_c10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_c10 (gfc_array_c10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_c10 (gfc_array_c10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_c10 (gfc_array_c10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_c10 (gfc_array_c10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_c10 (gfc_array_c10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_c10 (gfc_array_c10 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_c10 (gfc_array_c10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_c10 (gfc_array_c10 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_c10 (gfc_array_c10 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_c10 (gfc_array_c10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_c10 (gfc_array_c10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_c16.c b/libgfortran/generated/sum_c16.c index 8ec03a20f85..9871d2d5d6a 100644 --- a/libgfortran/generated/sum_c16.c +++ b/libgfortran/generated/sum_c16.c @@ -57,24 +57,23 @@ sum_c16 (gfc_array_c16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_c16 (gfc_array_c16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_c16 (gfc_array_c16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_c16 (gfc_array_c16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_c16 (gfc_array_c16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_c16 (gfc_array_c16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_c16 (gfc_array_c16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_c16 (gfc_array_c16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_c16 (gfc_array_c16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_c16 (gfc_array_c16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_c16 (gfc_array_c16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_c16 (gfc_array_c16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_c16 (gfc_array_c16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c index 158e3020fa9..920a6fb4920 100644 --- a/libgfortran/generated/sum_c4.c +++ b/libgfortran/generated/sum_c4.c @@ -57,24 +57,23 @@ sum_c4 (gfc_array_c4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_c4 (gfc_array_c4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_c4 (gfc_array_c4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_c4 (gfc_array_c4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_c4 (gfc_array_c4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_c4 (gfc_array_c4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_c4 (gfc_array_c4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_c4 (gfc_array_c4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_c4 (gfc_array_c4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_c4 (gfc_array_c4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_c4 (gfc_array_c4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_c4 (gfc_array_c4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_c4 (gfc_array_c4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c index bc9dc493d68..c3e79237fb3 100644 --- a/libgfortran/generated/sum_c8.c +++ b/libgfortran/generated/sum_c8.c @@ -57,24 +57,23 @@ sum_c8 (gfc_array_c8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_c8 (gfc_array_c8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_c8 (gfc_array_c8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_c8 (gfc_array_c8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_c8 (gfc_array_c8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_c8 (gfc_array_c8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_c8 (gfc_array_c8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_c8 (gfc_array_c8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_c8 (gfc_array_c8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_c8 (gfc_array_c8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_c8 (gfc_array_c8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_c8 (gfc_array_c8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_c8 (gfc_array_c8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_i1.c b/libgfortran/generated/sum_i1.c index 34bbde29955..913d732fa7f 100644 --- a/libgfortran/generated/sum_i1.c +++ b/libgfortran/generated/sum_i1.c @@ -57,24 +57,23 @@ sum_i1 (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_i1 (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_i1 (gfc_array_i1 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_i1 (gfc_array_i1 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_i1 (gfc_array_i1 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_i1 (gfc_array_i1 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_i1 (gfc_array_i1 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_i16.c b/libgfortran/generated/sum_i16.c index 1c7d6d94599..060d45aa9ce 100644 --- a/libgfortran/generated/sum_i16.c +++ b/libgfortran/generated/sum_i16.c @@ -57,24 +57,23 @@ sum_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_i16 (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_i16 (gfc_array_i16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_i16 (gfc_array_i16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_i16 (gfc_array_i16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_i16 (gfc_array_i16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_i16 (gfc_array_i16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_i2.c b/libgfortran/generated/sum_i2.c index ffa9846b1cc..5318283ccb8 100644 --- a/libgfortran/generated/sum_i2.c +++ b/libgfortran/generated/sum_i2.c @@ -57,24 +57,23 @@ sum_i2 (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_i2 (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_i2 (gfc_array_i2 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_i2 (gfc_array_i2 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_i2 (gfc_array_i2 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_i2 (gfc_array_i2 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_i2 (gfc_array_i2 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c index c91cad0c67e..e8c60c3870e 100644 --- a/libgfortran/generated/sum_i4.c +++ b/libgfortran/generated/sum_i4.c @@ -57,24 +57,23 @@ sum_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_i4 (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_i4 (gfc_array_i4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_i4 (gfc_array_i4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_i4 (gfc_array_i4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_i4 (gfc_array_i4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_i4 (gfc_array_i4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c index de800b266b3..9ee3e934bc7 100644 --- a/libgfortran/generated/sum_i8.c +++ b/libgfortran/generated/sum_i8.c @@ -57,24 +57,23 @@ sum_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_i8 (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_i8 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_i8 (gfc_array_i8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_i8 (gfc_array_i8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_i8 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_i8 (gfc_array_i8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_r10.c b/libgfortran/generated/sum_r10.c index 5039e62a9ba..6a283049bfa 100644 --- a/libgfortran/generated/sum_r10.c +++ b/libgfortran/generated/sum_r10.c @@ -57,24 +57,23 @@ sum_r10 (gfc_array_r10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_r10 (gfc_array_r10 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_r10 (gfc_array_r10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_r10 (gfc_array_r10 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_r10 (gfc_array_r10 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_r10 (gfc_array_r10 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_r10 (gfc_array_r10 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_r10 (gfc_array_r10 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_r16.c b/libgfortran/generated/sum_r16.c index 070e0958a9d..35296c1d0d8 100644 --- a/libgfortran/generated/sum_r16.c +++ b/libgfortran/generated/sum_r16.c @@ -57,24 +57,23 @@ sum_r16 (gfc_array_r16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_r16 (gfc_array_r16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_r16 (gfc_array_r16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_r16 (gfc_array_r16 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_r16 (gfc_array_r16 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_r16 (gfc_array_r16 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_r16 (gfc_array_r16 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_r16 (gfc_array_r16 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c index 24e427a2678..e7e2fe31b3a 100644 --- a/libgfortran/generated/sum_r4.c +++ b/libgfortran/generated/sum_r4.c @@ -57,24 +57,23 @@ sum_r4 (gfc_array_r4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_r4 (gfc_array_r4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_r4 (gfc_array_r4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_r4 (gfc_array_r4 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_r4 (gfc_array_r4 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_r4 (gfc_array_r4 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_r4 (gfc_array_r4 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_r4 (gfc_array_r4 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c index cb86155fb2d..86ae1092420 100644 --- a/libgfortran/generated/sum_r8.c +++ b/libgfortran/generated/sum_r8.c @@ -57,24 +57,23 @@ sum_r8 (gfc_array_r8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -82,30 +81,31 @@ sum_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -124,8 +124,7 @@ sum_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -138,7 +137,7 @@ sum_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -229,7 +228,7 @@ msum_r8 (gfc_array_r8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -246,14 +245,14 @@ msum_r8 (gfc_array_r8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -261,10 +260,9 @@ msum_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -272,19 +270,20 @@ msum_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -293,8 +292,7 @@ msum_r8 (gfc_array_r8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -312,8 +310,7 @@ msum_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -324,8 +321,8 @@ msum_r8 (gfc_array_r8 * const restrict retarray, { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " SUM intrinsic in dimension %ld:" @@ -338,7 +335,7 @@ msum_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -436,8 +433,8 @@ ssum_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -445,9 +442,9 @@ ssum_r8 (gfc_array_r8 * const restrict retarray, for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -455,29 +452,29 @@ ssum_r8 (gfc_array_r8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -497,8 +494,7 @@ ssum_r8 (gfc_array_r8 * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " SUM intrinsic in dimension %ld:" @@ -511,7 +507,7 @@ ssum_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/generated/transpose_c10.c b/libgfortran/generated/transpose_c10.c index 338998b3c4e..e740d12a7e7 100644 --- a/libgfortran/generated/transpose_c10.c +++ b/libgfortran/generated/transpose_c10.c @@ -54,13 +54,11 @@ transpose_c10 (gfc_array_c10 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_c10 (gfc_array_c10 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_c10 (gfc_array_c10 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_c10 (gfc_array_c10 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_c16.c b/libgfortran/generated/transpose_c16.c index 2ce91c75d04..31115bdfdde 100644 --- a/libgfortran/generated/transpose_c16.c +++ b/libgfortran/generated/transpose_c16.c @@ -54,13 +54,11 @@ transpose_c16 (gfc_array_c16 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_c16 (gfc_array_c16 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_c16 (gfc_array_c16 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_c16 (gfc_array_c16 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_c4.c b/libgfortran/generated/transpose_c4.c index 1aa980325a0..a63f62c95ff 100644 --- a/libgfortran/generated/transpose_c4.c +++ b/libgfortran/generated/transpose_c4.c @@ -54,13 +54,11 @@ transpose_c4 (gfc_array_c4 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_c4 (gfc_array_c4 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_c4 (gfc_array_c4 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_c4 (gfc_array_c4 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_c8.c b/libgfortran/generated/transpose_c8.c index e901fcb2407..83223940330 100644 --- a/libgfortran/generated/transpose_c8.c +++ b/libgfortran/generated/transpose_c8.c @@ -54,13 +54,11 @@ transpose_c8 (gfc_array_c8 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_c8 (gfc_array_c8 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_c8 (gfc_array_c8 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_c8 (gfc_array_c8 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_i16.c b/libgfortran/generated/transpose_i16.c index d61155dde27..f8cfd823f95 100644 --- a/libgfortran/generated/transpose_i16.c +++ b/libgfortran/generated/transpose_i16.c @@ -54,13 +54,11 @@ transpose_i16 (gfc_array_i16 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_i16 (gfc_array_i16 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_i16 (gfc_array_i16 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_i16 (gfc_array_i16 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_i4.c b/libgfortran/generated/transpose_i4.c index f835a39aa4d..9b15e470269 100644 --- a/libgfortran/generated/transpose_i4.c +++ b/libgfortran/generated/transpose_i4.c @@ -54,13 +54,11 @@ transpose_i4 (gfc_array_i4 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_i4 (gfc_array_i4 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_i4 (gfc_array_i4 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_i4 (gfc_array_i4 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_i8.c b/libgfortran/generated/transpose_i8.c index a6b6333dae3..ddf772b0e42 100644 --- a/libgfortran/generated/transpose_i8.c +++ b/libgfortran/generated/transpose_i8.c @@ -54,13 +54,11 @@ transpose_i8 (gfc_array_i8 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_i8 (gfc_array_i8 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_i8 (gfc_array_i8 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_i8 (gfc_array_i8 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_r10.c b/libgfortran/generated/transpose_r10.c index c58ffa20dca..2b2e02d1c98 100644 --- a/libgfortran/generated/transpose_r10.c +++ b/libgfortran/generated/transpose_r10.c @@ -54,13 +54,11 @@ transpose_r10 (gfc_array_r10 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_r10 (gfc_array_r10 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_r10 (gfc_array_r10 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_r10 (gfc_array_r10 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_r16.c b/libgfortran/generated/transpose_r16.c index 5b5915e9768..4d2e40660fb 100644 --- a/libgfortran/generated/transpose_r16.c +++ b/libgfortran/generated/transpose_r16.c @@ -54,13 +54,11 @@ transpose_r16 (gfc_array_r16 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_r16 (gfc_array_r16 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_r16 (gfc_array_r16 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_r16 (gfc_array_r16 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_r4.c b/libgfortran/generated/transpose_r4.c index 6cff0097903..1748c1d0561 100644 --- a/libgfortran/generated/transpose_r4.c +++ b/libgfortran/generated/transpose_r4.c @@ -54,13 +54,11 @@ transpose_r4 (gfc_array_r4 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_r4 (gfc_array_r4 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_r4 (gfc_array_r4 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_r4 (gfc_array_r4 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/transpose_r8.c b/libgfortran/generated/transpose_r8.c index e66a32c7369..09054b6138e 100644 --- a/libgfortran/generated/transpose_r8.c +++ b/libgfortran/generated/transpose_r8.c @@ -54,13 +54,11 @@ transpose_r8 (gfc_array_r8 * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) ret)); ret->offset = 0; @@ -68,8 +66,8 @@ transpose_r8 (gfc_array_r8 * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -77,8 +75,8 @@ transpose_r8 (gfc_array_r8 * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -88,13 +86,13 @@ transpose_r8 (gfc_array_r8 * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/generated/unpack_c10.c b/libgfortran/generated/unpack_c10.c index 91ba77269d7..9b89a5bea79 100644 --- a/libgfortran/generated/unpack_c10.c +++ b/libgfortran/generated/unpack_c10.c @@ -90,13 +90,12 @@ unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_c16.c b/libgfortran/generated/unpack_c16.c index 0df76e41b1e..2d9931f02ac 100644 --- a/libgfortran/generated/unpack_c16.c +++ b/libgfortran/generated/unpack_c16.c @@ -90,13 +90,12 @@ unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_c4.c b/libgfortran/generated/unpack_c4.c index f112388328e..116f213f9fc 100644 --- a/libgfortran/generated/unpack_c4.c +++ b/libgfortran/generated/unpack_c4.c @@ -90,13 +90,12 @@ unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_c8.c b/libgfortran/generated/unpack_c8.c index 118f2b6a1a3..7298eeceedb 100644 --- a/libgfortran/generated/unpack_c8.c +++ b/libgfortran/generated/unpack_c8.c @@ -90,13 +90,12 @@ unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i1.c b/libgfortran/generated/unpack_i1.c index 974fc319729..f5dcb93df81 100644 --- a/libgfortran/generated/unpack_i1.c +++ b/libgfortran/generated/unpack_i1.c @@ -90,13 +90,12 @@ unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i16.c b/libgfortran/generated/unpack_i16.c index fb1ee8f0487..77920ea60d8 100644 --- a/libgfortran/generated/unpack_i16.c +++ b/libgfortran/generated/unpack_i16.c @@ -90,13 +90,12 @@ unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i2.c b/libgfortran/generated/unpack_i2.c index ecb4672441f..c7257bb2f01 100644 --- a/libgfortran/generated/unpack_i2.c +++ b/libgfortran/generated/unpack_i2.c @@ -90,13 +90,12 @@ unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i4.c b/libgfortran/generated/unpack_i4.c index cd16e579fb0..e3cdde67790 100644 --- a/libgfortran/generated/unpack_i4.c +++ b/libgfortran/generated/unpack_i4.c @@ -90,13 +90,12 @@ unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i8.c b/libgfortran/generated/unpack_i8.c index 422a11c147b..2f720640370 100644 --- a/libgfortran/generated/unpack_i8.c +++ b/libgfortran/generated/unpack_i8.c @@ -90,13 +90,12 @@ unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_r10.c b/libgfortran/generated/unpack_r10.c index 7903a3c94ad..796df2edd45 100644 --- a/libgfortran/generated/unpack_r10.c +++ b/libgfortran/generated/unpack_r10.c @@ -90,13 +90,12 @@ unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_r16.c b/libgfortran/generated/unpack_r16.c index d84ccca7a15..b25d2869ac9 100644 --- a/libgfortran/generated/unpack_r16.c +++ b/libgfortran/generated/unpack_r16.c @@ -90,13 +90,12 @@ unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_r4.c b/libgfortran/generated/unpack_r4.c index 130acbf53ac..f4b763fc1c5 100644 --- a/libgfortran/generated/unpack_r4.c +++ b/libgfortran/generated/unpack_r4.c @@ -90,13 +90,12 @@ unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_r8.c b/libgfortran/generated/unpack_r8.c index fa809555b04..dc9b4d398ce 100644 --- a/libgfortran/generated/unpack_r8.c +++ b/libgfortran/generated/unpack_r8.c @@ -90,13 +90,12 @@ unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -108,10 +107,10 @@ unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -123,7 +122,7 @@ unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -235,14 +234,13 @@ unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -254,11 +252,11 @@ unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -272,7 +270,7 @@ unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c index 87b449edb4d..0aade1d95b7 100644 --- a/libgfortran/intrinsics/associated.c +++ b/libgfortran/intrinsics/associated.c @@ -43,14 +43,14 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target) rank = GFC_DESCRIPTOR_RANK (pointer); for (n = 0; n < rank; n++) { - long diff; - diff = pointer->dim[n].ubound - pointer->dim[n].lbound; + long extent; + extent = GFC_DESCRIPTOR_EXTENT(pointer,n); - if (diff != (target->dim[n].ubound - target->dim[n].lbound)) + if (extent != GFC_DESCRIPTOR_EXTENT(target,n)) return 0; - if (pointer->dim[n].stride != target->dim[n].stride && diff != 0) + if (GFC_DESCRIPTOR_STRIDE(pointer,n) != GFC_DESCRIPTOR_STRIDE(target,n) && extent != 1) return 0; - if (pointer->dim[n].ubound < pointer->dim[n].lbound) + if (extent <= 0) return 0; } diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index be0444a4807..1b7dbc1cec9 100644 --- a/libgfortran/intrinsics/cshift0.c +++ b/libgfortran/intrinsics/cshift0.c @@ -1,5 +1,5 @@ /* Generic implementation of the CSHIFT intrinsic - Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. + Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Feng Wang <wf_cs@yahoo.com> This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -7,21 +7,26 @@ 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 3 of the License, or (at your option) any later version. +version 2 of the License, or (at your option) any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public 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. -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ +You should have received a copy of the GNU General Public +License along with libgfortran; see the file COPYING. If not, +write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include <stdlib.h> @@ -30,7 +35,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see static void cshift0 (gfc_array_char * ret, const gfc_array_char * array, - index_type shift, int which, index_type size) + ssize_t shift, int which, index_type size) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -66,14 +71,17 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) - * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } if (arraysize > 0) @@ -278,20 +286,20 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); n++; } } @@ -306,7 +314,7 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, rptr = ret->data; sptr = array->data; - shift = len == 0 ? 0 : shift % len; + shift = len == 0 ? 0 : shift % (ssize_t)len; if (shift < 0) shift += len; diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c index be64626637c..4bc6e6928c0 100644 --- a/libgfortran/intrinsics/date_and_time.c +++ b/libgfortran/intrinsics/date_and_time.c @@ -265,8 +265,8 @@ date_and_time (char *__date, char *__time, char *__zone, index_type len, delta, elt_size; elt_size = GFC_DESCRIPTOR_SIZE (__values); - len = __values->dim[0].ubound + 1 - __values->dim[0].lbound; - delta = __values->dim[0].stride; + len = GFC_DESCRIPTOR_EXTENT(__values,0); + delta = GFC_DESCRIPTOR_STRIDE(__values,0); if (delta == 0) delta = 1; @@ -351,9 +351,7 @@ secnds (GFC_REAL_4 *x) & GFC_DTYPE_TYPE_MASK) + (4 << GFC_DTYPE_SIZE_SHIFT); - avalues->dim[0].ubound = 7; - avalues->dim[0].lbound = 0; - avalues->dim[0].stride = 1; + GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1); date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0); @@ -411,9 +409,9 @@ itime_i4 (gfc_array_i4 *__values) itime0(x); /* Copy the value into the array. */ - len = __values->dim[0].ubound + 1 - __values->dim[0].lbound; + len = GFC_DESCRIPTOR_EXTENT(__values,0); assert (len >= 3); - delta = __values->dim[0].stride; + delta = GFC_DESCRIPTOR_STRIDE(__values,0); if (delta == 0) delta = 1; @@ -437,9 +435,9 @@ itime_i8 (gfc_array_i8 *__values) itime0(x); /* Copy the value into the array. */ - len = __values->dim[0].ubound + 1 - __values->dim[0].lbound; + len = GFC_DESCRIPTOR_EXTENT(__values,0); assert (len >= 3); - delta = __values->dim[0].stride; + delta = GFC_DESCRIPTOR_STRIDE(__values,0); if (delta == 0) delta = 1; @@ -493,9 +491,9 @@ idate_i4 (gfc_array_i4 *__values) idate0(x); /* Copy the value into the array. */ - len = __values->dim[0].ubound + 1 - __values->dim[0].lbound; + len = GFC_DESCRIPTOR_EXTENT(__values,0); assert (len >= 3); - delta = __values->dim[0].stride; + delta = GFC_DESCRIPTOR_STRIDE(__values,0); if (delta == 0) delta = 1; @@ -519,9 +517,9 @@ idate_i8 (gfc_array_i8 *__values) idate0(x); /* Copy the value into the array. */ - len = __values->dim[0].ubound + 1 - __values->dim[0].lbound; + len = GFC_DESCRIPTOR_EXTENT(__values,0); assert (len >= 3); - delta = __values->dim[0].stride; + delta = GFC_DESCRIPTOR_STRIDE(__values,0); if (delta == 0) delta = 1; @@ -583,9 +581,9 @@ gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) gmtime_0(&tt, x); /* Copy the values into the array. */ - len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound; + len = GFC_DESCRIPTOR_EXTENT(tarray,0); assert (len >= 9); - delta = tarray->dim[0].stride; + delta = GFC_DESCRIPTOR_STRIDE(tarray,0); if (delta == 0) delta = 1; @@ -610,9 +608,9 @@ gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) gmtime_0(&tt, x); /* Copy the values into the array. */ - len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound; + len = GFC_DESCRIPTOR_EXTENT(tarray,0); assert (len >= 9); - delta = tarray->dim[0].stride; + delta = GFC_DESCRIPTOR_STRIDE(tarray,0); if (delta == 0) delta = 1; @@ -675,9 +673,9 @@ ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) ltime_0(&tt, x); /* Copy the values into the array. */ - len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound; + len = GFC_DESCRIPTOR_EXTENT(tarray,0); assert (len >= 9); - delta = tarray->dim[0].stride; + delta = GFC_DESCRIPTOR_STRIDE(tarray,0); if (delta == 0) delta = 1; @@ -702,9 +700,9 @@ ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) ltime_0(&tt, x); /* Copy the values into the array. */ - len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound; + len = GFC_DESCRIPTOR_EXTENT(tarray,0); assert (len >= 9); - delta = tarray->dim[0].stride; + delta = GFC_DESCRIPTOR_STRIDE(tarray,0); if (delta == 0) delta = 1; diff --git a/libgfortran/intrinsics/dtime.c b/libgfortran/intrinsics/dtime.c index 40028a689c2..4b7000b4466 100644 --- a/libgfortran/intrinsics/dtime.c +++ b/libgfortran/intrinsics/dtime.c @@ -42,7 +42,7 @@ dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) GFC_REAL_4 *tp; long user_sec, user_usec, system_sec, system_usec; - if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2) + if (((GFC_DESCRIPTOR_EXTENT(t,0))) < 2) runtime_error ("Insufficient number of elements in TARRAY."); __gthread_mutex_lock (&dtime_update_lock); @@ -62,7 +62,7 @@ dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) tp = t->data; *tp = tu; - tp += t->dim[0].stride; + tp += GFC_DESCRIPTOR_STRIDE(t,0); *tp = ts; *result = tt; __gthread_mutex_unlock (&dtime_update_lock); diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index 6ac7c94a75b..4b8082fdeca 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -70,13 +70,18 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -96,20 +101,20 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); n++; } } diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c index 763545a6389..aa5ef5ad90f 100644 --- a/libgfortran/intrinsics/eoshift2.c +++ b/libgfortran/intrinsics/eoshift2.c @@ -34,7 +34,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see static void eoshift2 (gfc_array_char *ret, const gfc_array_char *array, int shift, const gfc_array_char *bound, int which, - index_type size, const char *filler, index_type filler_len) + const char *filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -59,6 +59,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, index_type len; index_type n; index_type arraysize; + index_type size; /* The compiler cannot figure out that these are set, initialize them to avoid warnings. */ @@ -66,6 +67,8 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE (array); + arraysize = size0 ((array_t *) array); if (ret->data == NULL) @@ -77,13 +80,18 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -107,22 +115,22 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (bound) - bstride[n] = bound->dim[n].stride * size; + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); else bstride[n] = 0; n++; @@ -256,7 +264,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, const GFC_INTEGER_##N *pdim) \ { \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ - GFC_DESCRIPTOR_SIZE (array), "\0", 1); \ + "\0", 1); \ } \ \ extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ @@ -274,11 +282,11 @@ eoshift2 (gfc_array_char *ret, 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 array_length __attribute__((unused)), \ GFC_INTEGER_4 bound_length __attribute__((unused))) \ { \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ - array_length, " ", 1); \ + " ", 1); \ } \ \ extern void eoshift2_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ @@ -296,12 +304,12 @@ eoshift2 (gfc_array_char *ret, 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 array_length __attribute__((unused)), \ GFC_INTEGER_4 bound_length __attribute__((unused))) \ { \ static const gfc_char4_t space = (unsigned char) ' '; \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ - array_length * sizeof (gfc_char4_t), (const char *) &space, \ + (const char *) &space, \ sizeof (gfc_char4_t)); \ } diff --git a/libgfortran/intrinsics/etime.c b/libgfortran/intrinsics/etime.c index 1ae357ed56e..b0fd742ea96 100644 --- a/libgfortran/intrinsics/etime.c +++ b/libgfortran/intrinsics/etime.c @@ -35,7 +35,7 @@ etime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) GFC_REAL_4 tu, ts, tt, *tp; long user_sec, user_usec, system_sec, system_usec; - if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2) + if (((GFC_DESCRIPTOR_EXTENT(t,0))) < 2) runtime_error ("Insufficient number of elements in TARRAY."); if (__time_1 (&user_sec, &user_usec, &system_sec, &system_usec) == 0) @@ -54,7 +54,7 @@ etime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) tp = t->data; *tp = tu; - tp += t->dim[0].stride; + tp += GFC_DESCRIPTOR_STRIDE(t,0); *tp = ts; *result = tt; } diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c index 38f07753c72..bb25e3e2d4f 100644 --- a/libgfortran/intrinsics/iso_c_binding.c +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -75,9 +75,8 @@ ISO_C_BINDING_PREFIX (c_f_pointer) (void *c_ptr_in, /* A generic function to set the common fields of all descriptors, no - matter whether it's to a scalar or an array. Fields set are: data, - and if appropriate, rank, offset, dim[*].lbound, dim[*].ubound, and - dim[*].stride. Parameter shape is a rank 1 array of integers + matter whether it's to a scalar or an array. Access is via the array + descrptor macros. Parameter shape is a rank 1 array of integers containing the upper bound of each dimension of what f_ptr_out points to. The length of this array must be EXACTLY the rank of what f_ptr_out points to, as required by the draft (J3/04-007). If @@ -104,51 +103,51 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in, p = shape->data; size = GFC_DESCRIPTOR_SIZE(shape); - source_stride = shape->dim[0].stride * size; + source_stride = GFC_DESCRIPTOR_STRIDE_BYTES(shape,0); /* shape's length (rank of the output array) */ - shapeSize = shape->dim[0].ubound + 1 - shape->dim[0].lbound; + shapeSize = GFC_DESCRIPTOR_EXTENT(shape,0); for (i = 0; i < shapeSize; i++) { - /* Lower bound is 1, as specified by the draft. */ - f_ptr_out->dim[i].lbound = 1; + index_type str, ub; + /* Have to allow for the SHAPE array to be any valid kind for an INTEGER type. */ #ifdef HAVE_GFC_INTEGER_1 if (size == 1) - f_ptr_out->dim[i].ubound = *((GFC_INTEGER_1 *) p); + ub = *((GFC_INTEGER_1 *) p); #endif #ifdef HAVE_GFC_INTEGER_2 if (size == 2) - f_ptr_out->dim[i].ubound = *((GFC_INTEGER_2 *) p); + ub = *((GFC_INTEGER_2 *) p); #endif #ifdef HAVE_GFC_INTEGER_4 if (size == 4) - f_ptr_out->dim[i].ubound = *((GFC_INTEGER_4 *) p); + ub = *((GFC_INTEGER_4 *) p); #endif #ifdef HAVE_GFC_INTEGER_8 if (size == 8) - f_ptr_out->dim[i].ubound = *((GFC_INTEGER_8 *) p); + ub = *((GFC_INTEGER_8 *) p); #endif #ifdef HAVE_GFC_INTEGER_16 if (size == 16) - f_ptr_out->dim[i].ubound = *((GFC_INTEGER_16 *) p); + ub = *((GFC_INTEGER_16 *) p); #endif p += source_stride; if (i == 0) { - f_ptr_out->dim[0].stride = 1; - f_ptr_out->offset = f_ptr_out->dim[0].lbound - * f_ptr_out->dim[0].stride; + str = 1; + f_ptr_out->offset = str; } else { - f_ptr_out->dim[i].stride = (f_ptr_out->dim[i-1].ubound + 1) - - f_ptr_out->dim[i-1].lbound; - f_ptr_out->offset += f_ptr_out->dim[i].lbound - * f_ptr_out->dim[i].stride; + str = GFC_DESCRIPTOR_EXTENT(f_ptr_out,i-1); + f_ptr_out->offset += str; } + + /* Lower bound is 1, as specified by the draft. */ + GFC_DIMENSION_SET(f_ptr_out->dim[i], 1, ub, str); } f_ptr_out->offset *= -1; diff --git a/libgfortran/intrinsics/move_alloc.c b/libgfortran/intrinsics/move_alloc.c index 527aa6f250d..9b5497c9bc7 100644 --- a/libgfortran/intrinsics/move_alloc.c +++ b/libgfortran/intrinsics/move_alloc.c @@ -42,11 +42,11 @@ move_alloc (gfc_array_char * from, gfc_array_char * to) for (i = 0; i < GFC_DESCRIPTOR_RANK (from); i++) { - to->dim[i].lbound = from->dim[i].lbound; - to->dim[i].ubound = from->dim[i].ubound; - to->dim[i].stride = from->dim[i].stride; - from->dim[i].stride = 0; - from->dim[i].ubound = from->dim[i].lbound; + GFC_DIMENSION_SET(to->dim[i],GFC_DESCRIPTOR_LBOUND(from,i), + GFC_DESCRIPTOR_UBOUND(from,i), + GFC_DESCRIPTOR_STRIDE(from,i)); + GFC_DIMENSION_SET(from->dim[i],GFC_DESCRIPTOR_LBOUND(from,i), + GFC_DESCRIPTOR_LBOUND(from,i), 0); } to->offset = from->offset; diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c index 4c89dad31f8..b611d777101 100644 --- a/libgfortran/intrinsics/pack_generic.c +++ b/libgfortran/intrinsics/pack_generic.c @@ -121,11 +121,11 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride * size; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = size; @@ -141,7 +141,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); } else { @@ -204,9 +204,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -223,7 +221,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -231,7 +229,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, } } - rstride0 = ret->dim[0].stride * size; + rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); if (rstride0 == 0) rstride0 = size; sstride0 = sstride[0]; @@ -280,11 +278,11 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride * size; + sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); if (sstride0 == 0) sstride0 = size; @@ -511,11 +509,11 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; - sstride[n] = array->dim[n].stride * size; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); ssize *= extent[n]; } if (sstride[0] == 0) @@ -536,7 +534,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, { /* The return array will have as many elements as there are in vector. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total <= 0) { total = 0; @@ -559,9 +557,8 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, } /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0],0,total-1,1); + ret->offset = 0; if (total == 0) @@ -573,7 +570,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, ret->data = internal_malloc_size (size * total); } - rstride0 = ret->dim[0].stride * size; + rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); if (rstride0 == 0) rstride0 = size; rptr = ret->data; @@ -623,11 +620,11 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride * size; + sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); if (sstride0 == 0) sstride0 = size; diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c index 0d1f25f7041..803049b065f 100644 --- a/libgfortran/intrinsics/random.c +++ b/libgfortran/intrinsics/random.c @@ -374,8 +374,8 @@ arandom_r4 (gfc_array_r4 *x) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = x->dim[n].stride; - extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); if (extent[n] <= 0) return; } @@ -441,8 +441,8 @@ arandom_r8 (gfc_array_r8 *x) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = x->dim[n].stride; - extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); if (extent[n] <= 0) return; } @@ -511,8 +511,8 @@ arandom_r10 (gfc_array_r10 *x) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = x->dim[n].stride; - extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); if (extent[n] <= 0) return; } @@ -583,8 +583,8 @@ arandom_r16 (gfc_array_r16 *x) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = x->dim[n].stride; - extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); if (extent[n] <= 0) return; } @@ -690,13 +690,13 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) runtime_error ("Array rank of PUT is not 1."); /* If the array is too small, abort. */ - if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size) + if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size) runtime_error ("Array size of PUT is too small."); /* We copy the seed given by the user. */ for (i = 0; i < kiss_size; i++) memcpy (seed + i * sizeof(GFC_UINTEGER_4), - &(put->data[(kiss_size - 1 - i) * put->dim[0].stride]), + &(put->data[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(put,0)]), sizeof(GFC_UINTEGER_4)); /* We put it after scrambling the bytes, to paper around users who @@ -712,7 +712,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) runtime_error ("Array rank of GET is not 1."); /* If the array is too small, abort. */ - if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size) + if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size) runtime_error ("Array size of GET is too small."); /* Unscramble the seed. */ @@ -720,7 +720,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) /* Then copy it back to the user variable. */ for (i = 0; i < kiss_size; i++) - memcpy (&(get->data[(kiss_size - 1 - i) * get->dim[0].stride]), + memcpy (&(get->data[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(get,0)]), seed + i * sizeof(GFC_UINTEGER_4), sizeof(GFC_UINTEGER_4)); } @@ -757,12 +757,12 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get) runtime_error ("Array rank of PUT is not 1."); /* If the array is too small, abort. */ - if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size / 2) + if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size / 2) runtime_error ("Array size of PUT is too small."); /* This code now should do correct strides. */ for (i = 0; i < kiss_size / 2; i++) - memcpy (&kiss_seed[2*i], &(put->data[i * put->dim[0].stride]), + memcpy (&kiss_seed[2*i], &(put->data[i * GFC_DESCRIPTOR_STRIDE(put,0)]), sizeof (GFC_UINTEGER_8)); } @@ -774,12 +774,12 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get) runtime_error ("Array rank of GET is not 1."); /* If the array is too small, abort. */ - if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size / 2) + if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size / 2) runtime_error ("Array size of GET is too small."); /* This code now should do correct strides. */ for (i = 0; i < kiss_size / 2; i++) - memcpy (&(get->data[i * get->dim[0].stride]), &kiss_seed[2*i], + memcpy (&(get->data[i * GFC_DESCRIPTOR_STRIDE(get,0)]), &kiss_seed[2*i], sizeof (GFC_UINTEGER_8)); } diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c index 0f3022701c4..bb1552aa433 100644 --- a/libgfortran/intrinsics/reshape_generic.c +++ b/libgfortran/intrinsics/reshape_generic.c @@ -67,7 +67,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -75,7 +75,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -85,14 +85,13 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n],0,rex - 1,rs); + rs *= rex; } ret->offset = 0; @@ -111,8 +110,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -142,7 +141,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -155,7 +154,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -174,7 +173,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -193,13 +192,13 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); @@ -218,8 +217,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/intrinsics/size.c b/libgfortran/intrinsics/size.c index 9aa4cd93374..6127c4ef301 100644 --- a/libgfortran/intrinsics/size.c +++ b/libgfortran/intrinsics/size.c @@ -35,7 +35,7 @@ size0 (const array_t * array) size = 1; for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) { - len = array->dim[n].ubound + 1 - array->dim[n].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,n); if (len < 0) len = 0; size *= len; @@ -54,7 +54,7 @@ size1 (const array_t * array, index_type dim) dim--; - size = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + size = GFC_DESCRIPTOR_EXTENT(array,dim); if (size < 0) size = 0; return size; diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c index 9fb4b11b265..9e20b8584c2 100644 --- a/libgfortran/intrinsics/spread_generic.c +++ b/libgfortran/intrinsics/spread_generic.c @@ -30,8 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see static void spread_internal (gfc_array_char *ret, const gfc_array_char *source, - const index_type *along, const index_type *pncopies, - index_type size) + const index_type *along, const index_type *pncopies) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -52,6 +51,9 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, index_type n; index_type dim; index_type ncopies; + index_type size; + + size = GFC_DESCRIPTOR_SIZE(source); srank = GFC_DESCRIPTOR_RANK(source); @@ -68,31 +70,34 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, { /* The front end has signalled that we need to populate the return array descriptor. */ + + size_t ub, stride; + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; dim = 0; rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == *along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs * size; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride * size; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); rstride[dim] = rs * size; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim]-1; rs *= extent[dim]; dim++; } + + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -119,10 +124,10 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == *along - 1) { - rdelta = ret->dim[n].stride * size; + rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -133,8 +138,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -144,8 +148,8 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride * size; - rstride[dim] = ret->dim[n].stride * size; + sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); dim++; } } @@ -156,17 +160,16 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, { if (n == *along - 1) { - rdelta = ret->dim[n].stride * size; + rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride * size; - rstride[dim] = ret->dim[n].stride * size; + sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); dim++; } } @@ -228,12 +231,14 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, static void spread_internal_scalar (gfc_array_char *ret, const char *source, - const index_type *along, const index_type *pncopies, - index_type size) + const index_type *along, const index_type *pncopies) { int n; int ncopies = *pncopies; char * dest; + size_t size; + + size = GFC_DESCRIPTOR_SIZE(ret); if (GFC_DESCRIPTOR_RANK (ret) != 1) runtime_error ("incorrect destination rank in spread()"); @@ -245,20 +250,18 @@ spread_internal_scalar (gfc_array_char *ret, const char *source, { 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; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } for (n = 0; n < ncopies; n++) { - dest = (char*)(ret->data + n*size*ret->dim[0].stride); + dest = (char*)(ret->data + n * GFC_DESCRIPTOR_STRIDE_BYTES(ret,0)); memcpy (dest , source, size); } } @@ -400,7 +403,7 @@ spread (gfc_array_char *ret, const gfc_array_char *source, #endif } - spread_internal (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (source)); + spread_internal (ret, source, along, pncopies); } @@ -413,9 +416,10 @@ 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) + const index_type *pncopies, + GFC_INTEGER_4 source_length __attribute__((unused))) { - spread_internal (ret, source, along, pncopies, source_length); + spread_internal (ret, source, along, pncopies); } @@ -428,10 +432,10 @@ void spread_char4 (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) + const index_type *pncopies, + GFC_INTEGER_4 source_length __attribute__((unused))) { - spread_internal (ret, source, along, pncopies, - source_length * sizeof (gfc_char4_t)); + spread_internal (ret, source, along, pncopies); } @@ -577,7 +581,7 @@ spread_scalar (gfc_array_char *ret, const char *source, #endif } - spread_internal_scalar (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (ret)); + spread_internal_scalar (ret, source, along, pncopies); } @@ -590,11 +594,12 @@ 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) + const index_type *pncopies, + GFC_INTEGER_4 source_length __attribute__((unused))) { if (!ret->dtype) runtime_error ("return array missing descriptor in spread()"); - spread_internal_scalar (ret, source, along, pncopies, source_length); + spread_internal_scalar (ret, source, along, pncopies); } @@ -607,11 +612,12 @@ void spread_char4_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) + const index_type *pncopies, + GFC_INTEGER_4 source_length __attribute__((unused))) { if (!ret->dtype) runtime_error ("return array missing descriptor in spread()"); - spread_internal_scalar (ret, source, along, pncopies, - source_length * sizeof (gfc_char4_t)); + spread_internal_scalar (ret, source, along, pncopies); + } diff --git a/libgfortran/intrinsics/stat.c b/libgfortran/intrinsics/stat.c index 5d0f3b63bdd..22d4f79796c 100644 --- a/libgfortran/intrinsics/stat.c +++ b/libgfortran/intrinsics/stat.c @@ -66,7 +66,7 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, runtime_error ("Array rank of SARRAY is not 1."); /* If the array is too small, abort. */ - if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13) + if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13) runtime_error ("Array size of SARRAY is too small."); /* Trim trailing spaces from name. */ @@ -88,55 +88,57 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, if (val == 0) { + index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0); + /* Device ID */ - sarray->data[0 * sarray->dim[0].stride] = sb.st_dev; + sarray->data[0 * stride] = sb.st_dev; /* Inode number */ - sarray->data[1 * sarray->dim[0].stride] = sb.st_ino; + sarray->data[1 * stride] = sb.st_ino; /* File mode */ - sarray->data[2 * sarray->dim[0].stride] = sb.st_mode; + sarray->data[2 * stride] = sb.st_mode; /* Number of (hard) links */ - sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink; + sarray->data[3 * stride] = sb.st_nlink; /* Owner's uid */ - sarray->data[4 * sarray->dim[0].stride] = sb.st_uid; + sarray->data[4 * stride] = sb.st_uid; /* Owner's gid */ - sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; + sarray->data[5 * 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; + sarray->data[6 * stride] = sb.st_rdev; #else - sarray->data[6 * sarray->dim[0].stride] = 0; + sarray->data[6 * stride] = 0; #endif /* File size (bytes) */ - sarray->data[7 * sarray->dim[0].stride] = sb.st_size; + sarray->data[7 * stride] = sb.st_size; /* Last access time */ - sarray->data[8 * sarray->dim[0].stride] = sb.st_atime; + sarray->data[8 * stride] = sb.st_atime; /* Last modification time */ - sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime; + sarray->data[9 * stride] = sb.st_mtime; /* Last file status change time */ - sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime; + sarray->data[10 * stride] = sb.st_ctime; /* Preferred I/O block size (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLKSIZE - sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize; + sarray->data[11 * stride] = sb.st_blksize; #else - sarray->data[11 * sarray->dim[0].stride] = -1; + sarray->data[11 * stride] = -1; #endif /* Number of blocks allocated (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLOCKS - sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks; + sarray->data[12 * stride] = sb.st_blocks; #else - sarray->data[12 * sarray->dim[0].stride] = -1; + sarray->data[12 * stride] = -1; #endif } @@ -185,7 +187,7 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, runtime_error ("Array rank of SARRAY is not 1."); /* If the array is too small, abort. */ - if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13) + if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13) runtime_error ("Array size of SARRAY is too small."); /* Trim trailing spaces from name. */ @@ -207,55 +209,57 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, if (val == 0) { + index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0); + /* Device ID */ sarray->data[0] = sb.st_dev; /* Inode number */ - sarray->data[sarray->dim[0].stride] = sb.st_ino; + sarray->data[stride] = sb.st_ino; /* File mode */ - sarray->data[2 * sarray->dim[0].stride] = sb.st_mode; + sarray->data[2 * stride] = sb.st_mode; /* Number of (hard) links */ - sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink; + sarray->data[3 * stride] = sb.st_nlink; /* Owner's uid */ - sarray->data[4 * sarray->dim[0].stride] = sb.st_uid; + sarray->data[4 * stride] = sb.st_uid; /* Owner's gid */ - sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; + sarray->data[5 * 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; + sarray->data[6 * stride] = sb.st_rdev; #else - sarray->data[6 * sarray->dim[0].stride] = 0; + sarray->data[6 * stride] = 0; #endif /* File size (bytes) */ - sarray->data[7 * sarray->dim[0].stride] = sb.st_size; + sarray->data[7 * stride] = sb.st_size; /* Last access time */ - sarray->data[8 * sarray->dim[0].stride] = sb.st_atime; + sarray->data[8 * stride] = sb.st_atime; /* Last modification time */ - sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime; + sarray->data[9 * stride] = sb.st_mtime; /* Last file status change time */ - sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime; + sarray->data[10 * stride] = sb.st_ctime; /* Preferred I/O block size (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLKSIZE - sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize; + sarray->data[11 * stride] = sb.st_blksize; #else - sarray->data[11 * sarray->dim[0].stride] = -1; + sarray->data[11 * stride] = -1; #endif /* Number of blocks allocated (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLOCKS - sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks; + sarray->data[12 * stride] = sb.st_blocks; #else - sarray->data[12 * sarray->dim[0].stride] = -1; + sarray->data[12 * stride] = -1; #endif } @@ -376,7 +380,7 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray, GFC_INTEGER_4 *status) runtime_error ("Array rank of SARRAY is not 1."); /* If the array is too small, abort. */ - if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13) + if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13) runtime_error ("Array size of SARRAY is too small."); /* Convert Fortran unit number to C file descriptor. */ @@ -386,55 +390,57 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray, GFC_INTEGER_4 *status) if (val == 0) { + index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0); + /* Device ID */ - sarray->data[0 * sarray->dim[0].stride] = sb.st_dev; + sarray->data[0 * stride] = sb.st_dev; /* Inode number */ - sarray->data[1 * sarray->dim[0].stride] = sb.st_ino; + sarray->data[1 * stride] = sb.st_ino; /* File mode */ - sarray->data[2 * sarray->dim[0].stride] = sb.st_mode; + sarray->data[2 * stride] = sb.st_mode; /* Number of (hard) links */ - sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink; + sarray->data[3 * stride] = sb.st_nlink; /* Owner's uid */ - sarray->data[4 * sarray->dim[0].stride] = sb.st_uid; + sarray->data[4 * stride] = sb.st_uid; /* Owner's gid */ - sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; + sarray->data[5 * 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; + sarray->data[6 * stride] = sb.st_rdev; #else - sarray->data[6 * sarray->dim[0].stride] = 0; + sarray->data[6 * stride] = 0; #endif /* File size (bytes) */ - sarray->data[7 * sarray->dim[0].stride] = sb.st_size; + sarray->data[7 * stride] = sb.st_size; /* Last access time */ - sarray->data[8 * sarray->dim[0].stride] = sb.st_atime; + sarray->data[8 * stride] = sb.st_atime; /* Last modification time */ - sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime; + sarray->data[9 * stride] = sb.st_mtime; /* Last file status change time */ - sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime; + sarray->data[10 * stride] = sb.st_ctime; /* Preferred I/O block size (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLKSIZE - sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize; + sarray->data[11 * stride] = sb.st_blksize; #else - sarray->data[11 * sarray->dim[0].stride] = -1; + sarray->data[11 * stride] = -1; #endif /* Number of blocks allocated (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLOCKS - sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks; + sarray->data[12 * stride] = sb.st_blocks; #else - sarray->data[12 * sarray->dim[0].stride] = -1; + sarray->data[12 * stride] = -1; #endif } @@ -457,7 +463,7 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray, GFC_INTEGER_8 *status) runtime_error ("Array rank of SARRAY is not 1."); /* If the array is too small, abort. */ - if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13) + if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13) runtime_error ("Array size of SARRAY is too small."); /* Convert Fortran unit number to C file descriptor. */ @@ -467,55 +473,57 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray, GFC_INTEGER_8 *status) if (val == 0) { + index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0); + /* Device ID */ sarray->data[0] = sb.st_dev; /* Inode number */ - sarray->data[sarray->dim[0].stride] = sb.st_ino; + sarray->data[stride] = sb.st_ino; /* File mode */ - sarray->data[2 * sarray->dim[0].stride] = sb.st_mode; + sarray->data[2 * stride] = sb.st_mode; /* Number of (hard) links */ - sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink; + sarray->data[3 * stride] = sb.st_nlink; /* Owner's uid */ - sarray->data[4 * sarray->dim[0].stride] = sb.st_uid; + sarray->data[4 * stride] = sb.st_uid; /* Owner's gid */ - sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; + sarray->data[5 * 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; + sarray->data[6 * stride] = sb.st_rdev; #else - sarray->data[6 * sarray->dim[0].stride] = 0; + sarray->data[6 * stride] = 0; #endif /* File size (bytes) */ - sarray->data[7 * sarray->dim[0].stride] = sb.st_size; + sarray->data[7 * stride] = sb.st_size; /* Last access time */ - sarray->data[8 * sarray->dim[0].stride] = sb.st_atime; + sarray->data[8 * stride] = sb.st_atime; /* Last modification time */ - sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime; + sarray->data[9 * stride] = sb.st_mtime; /* Last file status change time */ - sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime; + sarray->data[10 * stride] = sb.st_ctime; /* Preferred I/O block size (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLKSIZE - sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize; + sarray->data[11 * stride] = sb.st_blksize; #else - sarray->data[11 * sarray->dim[0].stride] = -1; + sarray->data[11 * stride] = -1; #endif /* Number of blocks allocated (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLOCKS - sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks; + sarray->data[12 * stride] = sb.st_blocks; #else - sarray->data[12 * sarray->dim[0].stride] = -1; + sarray->data[12 * stride] = -1; #endif } diff --git a/libgfortran/intrinsics/transpose_generic.c b/libgfortran/intrinsics/transpose_generic.c index 25856192a6c..b0c2fff5719 100644 --- a/libgfortran/intrinsics/transpose_generic.c +++ b/libgfortran/intrinsics/transpose_generic.c @@ -32,8 +32,7 @@ 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) +transpose_internal (gfc_array_char *ret, gfc_array_char *source) { /* r.* indicates the return array. */ index_type rxstride, rystride; @@ -44,21 +43,22 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source, 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(ret); + if (ret->data == NULL) { 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (size * size0 ((array_t*)ret)); ret->offset = 0; @@ -67,8 +67,8 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -76,8 +76,8 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -87,13 +87,13 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source, } - sxstride = source->dim[0].stride * size; - systride = source->dim[1].stride * size; - xcount = source->dim[0].ubound + 1 - source->dim[0].lbound; - ycount = source->dim[1].ubound + 1 - source->dim[1].lbound; + sxstride = GFC_DESCRIPTOR_STRIDE_BYTES(source,0); + systride = GFC_DESCRIPTOR_STRIDE_BYTES(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride * size; - rystride = ret->dim[1].stride * size; + rxstride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,1); rptr = ret->data; sptr = source->data; @@ -119,7 +119,7 @@ export_proto(transpose); void transpose (gfc_array_char *ret, gfc_array_char *source) { - transpose_internal (ret, source, GFC_DESCRIPTOR_SIZE (source)); + transpose_internal (ret, source); } @@ -130,9 +130,10 @@ 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) + gfc_array_char *source, + GFC_INTEGER_4 source_length __attribute__((unused))) { - transpose_internal (ret, source, source_length); + transpose_internal (ret, source); } @@ -143,7 +144,8 @@ export_proto(transpose_char4); void transpose_char4 (gfc_array_char *ret, GFC_INTEGER_4 ret_length __attribute__((unused)), - gfc_array_char *source, GFC_INTEGER_4 source_length) + gfc_array_char *source, + GFC_INTEGER_4 source_length __attribute__((unused))) { - transpose_internal (ret, source, source_length * sizeof (gfc_char4_t)); + transpose_internal (ret, source); } diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c index a27e37c7272..47d4a6dddef 100644 --- a/libgfortran/intrinsics/unpack_generic.c +++ b/libgfortran/intrinsics/unpack_generic.c @@ -89,14 +89,13 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride * size; - fstride[n] = field->dim[n].stride * fsize; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n); rs *= extent[n]; } ret->offset = 0; @@ -108,11 +107,11 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride * size; - fstride[n] = field->dim[n].stride * fsize; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n); } if (rstride[0] == 0) rstride[0] = size; @@ -126,7 +125,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride * size; + vstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); if (vstride0 == 0) vstride0 = size; rstride0 = rstride[0]; diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index f6d5687ba8e..c39a51d34e2 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2093,10 +2093,10 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, } /* 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)) + if ((ls[dim].start > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim])) + || (ls[dim].start < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim])) + || (ls[dim].end > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim])) + || (ls[dim].end < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim]))) { if (is_char) sprintf (parse_err_msg, "Substring out of range"); @@ -2160,8 +2160,8 @@ nml_touch_nodes (namelist_info * nl) for (dim=0; dim < nl->var_rank; dim++) { nl->ls[dim].step = 1; - nl->ls[dim].end = nl->dim[dim].ubound; - nl->ls[dim].start = nl->dim[dim].lbound; + nl->ls[dim].end = GFC_DESCRIPTOR_UBOUND(nl,dim); + nl->ls[dim].start = GFC_DESCRIPTOR_LBOUND(nl,dim); nl->ls[dim].idx = nl->ls[dim].start; } } @@ -2356,8 +2356,9 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, pdata = (void*)(nl->mem_pos + offset); for (dim = 0; dim < nl->var_rank; dim++) - pdata = (void*)(pdata + (nl->ls[dim].idx - nl->dim[dim].lbound) * - nl->dim[dim].stride * nl->size); + pdata = (void*)(pdata + (nl->ls[dim].idx + - GFC_DESCRIPTOR_LBOUND(nl,dim)) + * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size); /* Reset the error flag and try to read next value, if dtp->u.p.repeat_count=0 */ @@ -2679,8 +2680,8 @@ get_name: for (dim=0; dim < nl->var_rank; dim++) { nl->ls[dim].step = 1; - nl->ls[dim].end = nl->dim[dim].ubound; - nl->ls[dim].start = nl->dim[dim].lbound; + nl->ls[dim].end = GFC_DESCRIPTOR_UBOUND(nl,dim); + nl->ls[dim].start = GFC_DESCRIPTOR_LBOUND(nl,dim); nl->ls[dim].idx = nl->ls[dim].start; } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 08ba7f56f59..585ae43acbf 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1778,10 +1778,8 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, for (n = 0; n < rank; n++) { count[n] = 0; - stride[n] = iotype == BT_CHARACTER ? - desc->dim[n].stride * GFC_SIZE_OF_CHAR_KIND(kind) : - desc->dim[n].stride; - extent[n] = desc->dim[n].ubound + 1 - desc->dim[n].lbound; + stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(desc,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(desc,n); /* If the extent of even one dimension is zero, then the entire array section contains zero elements, so we return after writing @@ -1797,9 +1795,9 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, stride0 = stride[0]; - /* If the innermost dimension has stride 1, we can do the transfer + /* If the innermost dimension has a stride of 1, we can do the transfer in contiguous chunks. */ - if (stride0 == 1) + if (stride0 == size) tsize = extent[0]; else tsize = 1; @@ -1809,13 +1807,13 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, while (data) { dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize); - data += stride0 * size * tsize; + data += stride0 * tsize; count[0] += tsize; n = 0; while (count[n] == extent[n]) { count[n] = 0; - data -= stride[n] * extent[n] * size; + data -= stride[n] * extent[n]; n++; if (n == rank) { @@ -1825,7 +1823,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, else { count[n]++; - data += stride[n] * size; + data += stride[n]; } } } @@ -2490,23 +2488,24 @@ init_loop_spec (gfc_array_char *desc, array_loop_spec *ls, for (i=0; i<rank; i++) { - ls[i].idx = desc->dim[i].lbound; - ls[i].start = desc->dim[i].lbound; - ls[i].end = desc->dim[i].ubound; - ls[i].step = desc->dim[i].stride; - empty = empty || (desc->dim[i].ubound < desc->dim[i].lbound); + ls[i].idx = GFC_DESCRIPTOR_LBOUND(desc,i); + ls[i].start = GFC_DESCRIPTOR_LBOUND(desc,i); + ls[i].end = GFC_DESCRIPTOR_UBOUND(desc,i); + ls[i].step = GFC_DESCRIPTOR_STRIDE(desc,i); + empty = empty || (GFC_DESCRIPTOR_UBOUND(desc,i) + < GFC_DESCRIPTOR_LBOUND(desc,i)); - if (desc->dim[i].stride > 0) + if (GFC_DESCRIPTOR_STRIDE(desc,i) > 0) { - index += (desc->dim[i].ubound - desc->dim[i].lbound) - * desc->dim[i].stride; + index += (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) + * GFC_DESCRIPTOR_STRIDE(desc,i); } else { - index -= (desc->dim[i].ubound - desc->dim[i].lbound) - * desc->dim[i].stride; - *start_record -= (desc->dim[i].ubound - desc->dim[i].lbound) - * desc->dim[i].stride; + index -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) + * GFC_DESCRIPTOR_STRIDE(desc,i); + *start_record -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) + * GFC_DESCRIPTOR_STRIDE(desc,i); } } @@ -3400,9 +3399,7 @@ st_set_nml_var_dim (st_parameter_dt *dtp, GFC_INTEGER_4 n_dim, for (nml = dtp->u.p.ionml; nml->next; nml = nml->next); - nml->dim[n].stride = stride; - nml->dim[n].lbound = lbound; - nml->dim[n].ubound = ubound; + GFC_DIMENSION_SET(nml->dim[n],lbound,ubound,stride); } /* Reverse memcpy - used for byte swapping. */ diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index b6d6e687736..4956da8cf80 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1316,8 +1316,8 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, nelem = 1; for (dim_i = 0; dim_i < (size_t) obj->var_rank; dim_i++) { - obj->ls[dim_i].idx = obj->dim[dim_i].lbound; - nelem = nelem * (obj->dim[dim_i].ubound + 1 - obj->dim[dim_i].lbound); + obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj, dim_i); + nelem = nelem * GFC_DESCRIPTOR_EXTENT (obj, dim_i); } /* Main loop to output the data held in the object. */ @@ -1484,9 +1484,9 @@ obj_loop: { obj->ls[dim_i].idx += nml_carry ; nml_carry = 0; - if (obj->ls[dim_i].idx > (index_type) obj->dim[dim_i].ubound) + if (obj->ls[dim_i].idx > (ssize_t) GFC_DESCRIPTOR_UBOUND(obj,dim_i)) { - obj->ls[dim_i].idx = obj->dim[dim_i].lbound; + obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i); nml_carry = 1; } } diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index fcf736a3f1d..517ee76d91d 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -297,10 +297,11 @@ internal_proto(big_endian); typedef struct descriptor_dimension { - index_type stride; - index_type lbound; - index_type ubound; + index_type _stride; + index_type _lbound; + index_type _ubound; } + descriptor_dimension; #define GFC_ARRAY_DESCRIPTOR(r, type) \ @@ -353,6 +354,30 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16; #define GFC_DESCRIPTOR_DATA(desc) ((desc)->data) #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype) +#define GFC_DIMENSION_LBOUND(dim) ((dim)._lbound) +#define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound) +#define GFC_DIMENSION_STRIDE(dim) ((dim)._stride) +#define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim)._lbound) +#define GFC_DIMENSION_SET(dim,lb,ub,str) \ + do \ + { \ + (dim)._lbound = lb; \ + (dim)._ubound = ub; \ + (dim)._stride = str; \ + } while (0) + + +#define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i]._lbound) +#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound) +#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \ + - (desc)->dim[i]._lbound) +#define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \ + (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) + +#define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride) +#define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \ + (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) + /* Macros to get both the size and the type with a single masking operation */ #define GFC_DTYPE_SIZE_MASK \ diff --git a/libgfortran/m4/cshift0.m4 b/libgfortran/m4/cshift0.m4 index da385cbfbfe..0c5e0158eec 100644 --- a/libgfortran/m4/cshift0.m4 +++ b/libgfortran/m4/cshift0.m4 @@ -70,20 +70,20 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ssize_t shift, { if (dim == which) { - roffset = ret->dim[dim].stride; + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); if (roffset == 0) roffset = 1; - soffset = array->dim[dim].stride; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); if (soffset == 0) soffset = 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } else { count[n] = 0; - extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - rstride[n] = ret->dim[dim].stride; - sstride[n] = array->dim[dim].stride; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); n++; } } diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4 index 3c5ff5e6618..22b61854ffe 100644 --- a/libgfortran/m4/cshift1.m4 +++ b/libgfortran/m4/cshift1.m4 @@ -36,8 +36,7 @@ static void cshift1 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const 'atype` * const restrict h, - const 'atype_name` * const restrict pwhich, - index_type size) + const 'atype_name` * const restrict pwhich) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -64,6 +63,7 @@ cshift1 (gfc_array_char * const restrict ret, int which; 'atype_name` sh; index_type arraysize; + index_type size; if (pwhich) which = *pwhich - 1; @@ -73,6 +73,8 @@ cshift1 (gfc_array_char * const restrict ret, 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(array); + arraysize = size0 ((array_t *)array); if (ret->data == NULL) @@ -84,13 +86,17 @@ cshift1 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } } @@ -110,22 +116,22 @@ cshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); n++; } } @@ -211,7 +217,7 @@ cshift1_'atype_kind` (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const 'atype_name` * const restrict pwhich) { - cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); + cshift1 (ret, array, h, pwhich); } @@ -229,9 +235,9 @@ cshift1_'atype_kind`_char (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const 'atype` * const restrict h, const 'atype_name` * const restrict pwhich, - GFC_INTEGER_4 array_length) + GFC_INTEGER_4 array_length __attribute__((unused))) { - cshift1 (ret, array, h, pwhich, array_length); + cshift1 (ret, array, h, pwhich); } @@ -249,9 +255,9 @@ cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict array, const 'atype` * const restrict h, const 'atype_name` * const restrict pwhich, - GFC_INTEGER_4 array_length) + GFC_INTEGER_4 array_length __attribute__((unused))) { - cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); + cshift1 (ret, array, h, pwhich); } #endif' diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4 index 1ecf0a95421..831277cf413 100644 --- a/libgfortran/m4/eoshift1.m4 +++ b/libgfortran/m4/eoshift1.m4 @@ -38,7 +38,7 @@ eoshift1 (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const char * const restrict pbound, const 'atype_name` * const restrict pwhich, - index_type size, const char * filler, index_type filler_len) + const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -62,6 +62,7 @@ eoshift1 (gfc_array_char * const restrict ret, index_type dim; index_type len; index_type n; + index_type size; int which; 'atype_name` sh; 'atype_name` delta; @@ -72,6 +73,8 @@ eoshift1 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE(array); + if (pwhich) which = *pwhich - 1; else @@ -89,13 +92,18 @@ eoshift1 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -109,22 +117,22 @@ eoshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); n++; } } @@ -242,8 +250,7 @@ eoshift1_'atype_kind` (gfc_array_char * const restrict ret, const char * const restrict pbound, const 'atype_name` * const restrict pwhich) { - eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), - "\0", 1); + eoshift1 (ret, array, h, pbound, pwhich, "\0", 1); } @@ -263,10 +270,10 @@ eoshift1_'atype_kind`_char (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const char * const restrict pbound, const 'atype_name` * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); + eoshift1 (ret, array, h, pbound, pwhich, " ", 1); } @@ -286,11 +293,11 @@ eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const char * const restrict pbound, const 'atype_name` * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { static const gfc_char4_t space = (unsigned char) ''` ''`; - eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), + eoshift1 (ret, array, h, pbound, pwhich, (const char *) &space, sizeof (gfc_char4_t)); } diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4 index 902c3cdbffa..e6b29599ef0 100644 --- a/libgfortran/m4/eoshift3.m4 +++ b/libgfortran/m4/eoshift3.m4 @@ -38,7 +38,7 @@ eoshift3 (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich, - index_type size, const char * filler, index_type filler_len) + const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -66,6 +66,7 @@ eoshift3 (gfc_array_char * const restrict ret, index_type dim; index_type len; index_type n; + index_type size; int which; 'atype_name` sh; 'atype_name` delta; @@ -76,6 +77,8 @@ eoshift3 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE(array); + if (pwhich) which = *pwhich - 1; else @@ -90,13 +93,18 @@ eoshift3 (gfc_array_char * const restrict ret, 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; + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - ret->dim[i].stride = 1; + str = 1; else - ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride; + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } } else @@ -113,24 +121,24 @@ eoshift3 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = ret->dim[dim].stride * size; + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); if (roffset == 0) roffset = size; - soffset = array->dim[dim].stride * size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); if (soffset == 0) soffset = size; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); } 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; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - hstride[n] = h->dim[n].stride; + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); if (bound) - bstride[n] = bound->dim[n].stride * size; + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); else bstride[n] = 0; n++; @@ -261,8 +269,7 @@ eoshift3_'atype_kind` (gfc_array_char * const restrict ret, const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich) { - eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), - "\0", 1); + eoshift3 (ret, array, h, bound, pwhich, "\0", 1); } @@ -282,10 +289,10 @@ eoshift3_'atype_kind`_char (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); + eoshift3 (ret, array, h, bound, pwhich, " ", 1); } @@ -305,11 +312,11 @@ eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich, - GFC_INTEGER_4 array_length, + GFC_INTEGER_4 array_length __attribute__((unused)), GFC_INTEGER_4 bound_length __attribute__((unused))) { static const gfc_char4_t space = (unsigned char) ''` ''`; - eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), + eoshift3 (ret, array, h, bound, pwhich, (const char *) &space, sizeof (gfc_char4_t)); } diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 index b620c653f1a..0960d22aeb4 100644 --- a/libgfortran/m4/iforeach.m4 +++ b/libgfortran/m4/iforeach.m4 @@ -27,9 +27,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); @@ -46,7 +44,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, runtime_error ("rank of return array in u_name intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " u_name intrnisic: is %ld, should be %ld", @@ -54,12 +52,12 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -143,9 +141,7 @@ void if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); @@ -164,7 +160,7 @@ void runtime_error ("rank of return array in u_name intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("Incorrect extent in return value of" " u_name intrnisic: is %ld, should be %ld", @@ -178,8 +174,8 @@ void for (n=0; n<rank; n++) { - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " u_name intrinsic in dimension %ld:" @@ -202,13 +198,13 @@ void else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -302,9 +298,7 @@ void if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); @@ -321,13 +315,13 @@ void runtime_error ("rank of return array in u_name intrinsic" " should be 1, is %ld", (long int) ret_rank); - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (ret_extent != rank) runtime_error ("dimension of return array incorrect"); } } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n<rank; n++) dest[n * dstride] = $1 ; diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4 index e0c168e2e48..6785eb3c43f 100644 --- a/libgfortran/m4/ifunction.m4 +++ b/libgfortran/m4/ifunction.m4 @@ -45,24 +45,23 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -70,30 +69,31 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride + alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -112,8 +112,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " u_name intrinsic in dimension %ld:" @@ -126,7 +125,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -217,7 +216,7 @@ void dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; @@ -234,14 +233,14 @@ void else runtime_error ("Funny sized logical array"); - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride * mask_kind; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; @@ -249,10 +248,9 @@ void } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride * mask_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -260,19 +258,20 @@ void if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } - alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride + alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -281,8 +280,7 @@ void if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -300,8 +298,7 @@ void { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " u_name intrinsic in dimension %ld:" @@ -312,8 +309,8 @@ void { index_type mask_extent, array_extent; - array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); if (array_extent != mask_extent) runtime_error ("Incorrect extent in MASK argument of" " u_name intrinsic in dimension %ld:" @@ -326,7 +323,7 @@ void for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } @@ -423,8 +420,8 @@ void for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) extent[n] = 0; @@ -432,9 +429,9 @@ void for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] <= 0) extent[n] = 0; @@ -442,29 +439,29 @@ void if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride + alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -484,8 +481,7 @@ void { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " u_name intrinsic in dimension %ld:" @@ -498,7 +494,7 @@ void for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } dest = retarray->data; diff --git a/libgfortran/m4/ifunction_logical.m4 b/libgfortran/m4/ifunction_logical.m4 index da6b4ae2640..d1d2dd09c44 100644 --- a/libgfortran/m4/ifunction_logical.m4 +++ b/libgfortran/m4/ifunction_logical.m4 @@ -48,25 +48,24 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, src_kind = GFC_DESCRIPTOR_SIZE (array); - len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = array->dim[dim].stride * src_kind; + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = array->dim[n].stride * src_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride * src_kind; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) extent[n] = 0; @@ -74,29 +73,29 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; 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; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } retarray->offset = 0; retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride + alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -116,8 +115,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, { index_type ret_extent; - ret_extent = retarray->dim[n].ubound + 1 - - retarray->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); if (extent[n] != ret_extent) runtime_error ("Incorrect extent in return value of" " u_name intrinsic in dimension %d:" @@ -130,7 +128,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } diff --git a/libgfortran/m4/in_pack.m4 b/libgfortran/m4/in_pack.m4 index b54ea04d723..a4337aad8f7 100644 --- a/libgfortran/m4/in_pack.m4 +++ b/libgfortran/m4/in_pack.m4 @@ -60,8 +60,8 @@ internal_pack_'rtype_ccode` ('rtype` * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/m4/in_unpack.m4 b/libgfortran/m4/in_unpack.m4 index af7114501a2..661c54e1da5 100644 --- a/libgfortran/m4/in_unpack.m4 +++ b/libgfortran/m4/in_unpack.m4 @@ -55,8 +55,8 @@ internal_unpack_'rtype_ccode` ('rtype` * d, const 'rtype_name` * src) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/m4/matmul.m4 b/libgfortran/m4/matmul.m4 index 8ad1bd117c2..bb42f2a6c47 100644 --- a/libgfortran/m4/matmul.m4 +++ b/libgfortran/m4/matmul.m4 @@ -106,25 +106,22 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); } else { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound; - retarray->dim[0].stride = 1; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -137,8 +134,8 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -146,8 +143,8 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -155,16 +152,16 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -180,43 +177,43 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl /* 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; + rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = a->dim[0].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); aystride = 1; xcount = 1; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,0); } else { - axstride = a->dim[0].stride; - aystride = a->dim[1].stride; + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } - if (count != b->dim[0].ubound + 1 - b->dim[0].lbound) + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) { - if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0) + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); } if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = b->dim[0].stride; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -226,9 +223,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl } else { - bxstride = b->dim[0].stride; - bystride = b->dim[1].stride; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } abase = a->data; diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4 index d971d3da7b4..c5bad25f78a 100644 --- a/libgfortran/m4/matmull.m4 +++ b/libgfortran/m4/matmull.m4 @@ -70,25 +70,22 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, { 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 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; + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); } retarray->data @@ -101,8 +98,8 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -110,8 +107,8 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic: is %ld, should be %ld", @@ -119,16 +116,16 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, } else { - arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound; - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 1:" " is %ld, should be %ld", (long int) ret_extent, (long int) arg_extent); - arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound; - ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound; + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); if (arg_extent != ret_extent) runtime_error ("Incorrect extent in return array in" " MATMUL intrinsic for dimension 2:" @@ -167,46 +164,46 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ` if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = retarray->dim[0].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); rystride = rxstride; } else { - rxstride = retarray->dim[0].stride; - rystride = retarray->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); } /* 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 * a_kind; - count = a->dim[0].ubound + 1 - a->dim[0].lbound; + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + count = GFC_DESCRIPTOR_EXTENT(a,0); xstride = 0; rxstride = 0; xcount = 1; } else { - astride = a->dim[1].stride * a_kind; - count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xstride = a->dim[0].stride * a_kind; - xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + count = GFC_DESCRIPTOR_EXTENT(a,1); + xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); } if (GFC_DESCRIPTOR_RANK (b) == 1) { - bstride = b->dim[0].stride * b_kind; - assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); ystride = 0; rystride = 0; ycount = 1; } else { - bstride = b->dim[0].stride * b_kind; - assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); - ystride = b->dim[1].stride * b_kind; - ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); } for (y = 0; y < ycount; y++) diff --git a/libgfortran/m4/pack.m4 b/libgfortran/m4/pack.m4 index 16b80731f76..910ffdcaac1 100644 --- a/libgfortran/m4/pack.m4 +++ b/libgfortran/m4/pack.m4 @@ -123,11 +123,11 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -148,7 +148,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, { /* The return array will have as many elements as there are in VECTOR. */ - total = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + total = GFC_DESCRIPTOR_EXTENT(vector,0); if (total < 0) { total = 0; @@ -216,9 +216,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, if (ret->data == NULL) { /* Setup the array descriptor. */ - ret->dim[0].lbound = 0; - ret->dim[0].ubound = total - 1; - ret->dim[0].stride = 1; + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); ret->offset = 0; if (total == 0) @@ -235,7 +233,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, /* We come here because of range checking. */ index_type ret_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); if (total != ret_extent) runtime_error ("Incorrect extent in return value of PACK intrinsic;" " is %ld, should be %ld", (long int) total, @@ -243,7 +241,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, } } - rstride0 = ret->dim[0].stride; + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -292,11 +290,11 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, /* Add any remaining elements from VECTOR. */ if (vector) { - n = vector->dim[0].ubound + 1 - vector->dim[0].lbound; + n = GFC_DESCRIPTOR_EXTENT(vector,0); nelem = ((rptr - ret->data) / rstride0); if (n > nelem) { - sstride0 = vector->dim[0].stride; + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 index 5240e386636..4052a5ecc15 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/m4/reshape.m4 @@ -1,4 +1,4 @@ -`/* Implementation of the RESHAPE +`/* Implementation of the RESHAPE intrinsic Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> @@ -83,7 +83,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, int sempty, pempty, shape_empty; index_type shape_data[GFC_MAX_DIMENSIONS]; - rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) runtime_error("rank of return array incorrect in RESHAPE intrinsic"); @@ -91,7 +91,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->data[n * shape->dim[0].stride]; + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -104,10 +104,10 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, rs = 1; for (n = 0; n < rdim; n++) { - ret->dim[n].lbound = 0; rex = shape_data[n]; - ret->dim[n].ubound = rex - 1; - ret->dim[n].stride = rs; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + rs *= rex; } ret->offset = 0; @@ -126,8 +126,8 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, 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; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { pempty = 1; @@ -157,7 +157,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < rdim; n++) { rs *= shape_data[n]; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (ret_extent != shape_data[n]) runtime_error("Incorrect extent in return value of RESHAPE" " intrinsic in dimension %ld: is %ld," @@ -170,7 +170,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < sdim; n++) { index_type se; - se = source->dim[n].ubound + 1 - source->dim[0].lbound; + se = GFC_DESCRIPTOR_EXTENT(source,n); source_extent *= se > 0 ? se : 0; } @@ -189,7 +189,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->data[n * order->dim[0].stride] - 1; + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -208,13 +208,13 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->data[n * order->dim[0].stride] - 1; + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = ret->dim[dim].stride; - rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -235,8 +235,8 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, 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; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { sempty = 1; diff --git a/libgfortran/m4/shape.m4 b/libgfortran/m4/shape.m4 index b189f804e55..eadd3b9b945 100644 --- a/libgfortran/m4/shape.m4 +++ b/libgfortran/m4/shape.m4 @@ -43,14 +43,14 @@ shape_'rtype_kind` ('rtype` * const restrict ret, index_type stride; index_type extent; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); - if (ret->dim[0].ubound < ret->dim[0].lbound) + if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) { - extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + extent = GFC_DESCRIPTOR_EXTENT(array,n); ret->data[n * stride] = extent > 0 ? extent : 0 ; } } diff --git a/libgfortran/m4/spread.m4 b/libgfortran/m4/spread.m4 index 84ea00c3301..5e73d97423a 100644 --- a/libgfortran/m4/spread.m4 +++ b/libgfortran/m4/spread.m4 @@ -70,6 +70,9 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, if (ret->data == NULL) { + + size_t ub, stride; + /* The front end has signalled that we need to populate the return array descriptor. */ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; @@ -77,26 +80,25 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, rs = 1; for (n = 0; n < rrank; n++) { - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; + stride = rs; if (n == along - 1) { - ret->dim[n].ubound = ncopies - 1; + ub = ncopies - 1; rdelta = rs; rs *= ncopies; } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); rstride[dim] = rs; - ret->dim[n].ubound = extent[dim]-1; + ub = extent[dim] - 1; rs *= extent[dim]; dim++; } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); } ret->offset = 0; if (rs > 0) @@ -123,10 +125,10 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, { index_type ret_extent; - ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -137,8 +139,7 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (ret_extent != extent[dim]) runtime_error("Incorrect extent in return value of SPREAD" " intrinsic in dimension %ld: is %ld," @@ -148,8 +149,8 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -160,17 +161,16 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, { if (n == along - 1) { - rdelta = ret->dim[n].stride; + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); } else { count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = source->dim[dim].stride; - rstride[dim] = ret->dim[n].stride; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); dim++; } } @@ -249,19 +249,17 @@ spread_scalar_'rtype_code` ('rtype` *ret, const 'rtype_name` *source, { ret->data = internal_malloc_size (ncopies * sizeof ('rtype_name`)); ret->offset = 0; - ret->dim[0].stride = 1; - ret->dim[0].lbound = 0; - ret->dim[0].ubound = ncopies - 1; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); } else { - if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound) - / ret->dim[0].stride) + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->data; - stride = ret->dim[0].stride; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/m4/transpose.m4 b/libgfortran/m4/transpose.m4 index 8c50767fc9e..34c2d6c06aa 100644 --- a/libgfortran/m4/transpose.m4 +++ b/libgfortran/m4/transpose.m4 @@ -55,13 +55,11 @@ transpose_'rtype_code` ('rtype` * const restrict ret, 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; + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 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; + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); ret->data = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) ret)); ret->offset = 0; @@ -69,8 +67,8 @@ transpose_'rtype_code` ('rtype` * const restrict ret, { index_type ret_extent, src_extent; - ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound; - src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -78,8 +76,8 @@ transpose_'rtype_code` ('rtype` * const restrict ret, " should be %ld", (long int) src_extent, (long int) ret_extent); - ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound; - src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); if (src_extent != ret_extent) runtime_error ("Incorrect extent in return value of TRANSPOSE" @@ -89,13 +87,13 @@ transpose_'rtype_code` ('rtype` * const restrict ret, } - 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; + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = ret->dim[0].stride; - rystride = ret->dim[1].stride; + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); rptr = ret->data; sptr = source->data; diff --git a/libgfortran/m4/unpack.m4 b/libgfortran/m4/unpack.m4 index a26128c7835..bf348aebe1f 100644 --- a/libgfortran/m4/unpack.m4 +++ b/libgfortran/m4/unpack.m4 @@ -91,13 +91,12 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -109,10 +108,10 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +123,7 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -236,14 +235,13 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, for (n = 0; n < dim; n++) { count[n] = 0; - ret->dim[n].stride = rs; - ret->dim[n].lbound = 0; - ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; - extent[n] = ret->dim[n].ubound + 1; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -255,11 +253,11 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, for (n = 0; n < dim; n++) { count[n] = 0; - extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = ret->dim[n].stride; - fstride[n] = field->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -273,7 +271,7 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = vector->dim[0].stride; + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/runtime/in_pack_generic.c b/libgfortran/runtime/in_pack_generic.c index 28e8d8e3663..33ce0310cd1 100644 --- a/libgfortran/runtime/in_pack_generic.c +++ b/libgfortran/runtime/in_pack_generic.c @@ -48,12 +48,6 @@ internal_pack (gfc_array_char * source) index_type size; index_type type_size; - if (source->dim[0].stride == 0) - { - source->dim[0].stride = 1; - return source->data; - } - type_size = GFC_DTYPE_TYPE_SIZE(source); size = GFC_DESCRIPTOR_SIZE (source); switch (type_size) @@ -147,8 +141,8 @@ internal_pack (gfc_array_char * source) 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { /* Do nothing. */ diff --git a/libgfortran/runtime/in_unpack_generic.c b/libgfortran/runtime/in_unpack_generic.c index 66b5c84b854..3c290cd7ebd 100644 --- a/libgfortran/runtime/in_unpack_generic.c +++ b/libgfortran/runtime/in_unpack_generic.c @@ -162,16 +162,13 @@ internal_unpack (gfc_array_char * d, const void * s) size = GFC_DESCRIPTOR_SIZE (d); - 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; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libiberty/ChangeLog b/libiberty/ChangeLog index f5ac7832942..eb7c913b838 100644 --- a/libiberty/ChangeLog +++ b/libiberty/ChangeLog @@ -1,3 +1,8 @@ +2009-06-21 Jakub Jelinek <jakub@redhat.com> + + * hashtab.c (htab_traverse): Don't call htab_expand for + nearly empty hashtabs with sizes 7, 13 or 31. + 2009-06-16 Nick Clifton <nickc@redhat.com> PR 10197 diff --git a/libiberty/hashtab.c b/libiberty/hashtab.c index bf34a6d297e..3e649215f42 100644 --- a/libiberty/hashtab.c +++ b/libiberty/hashtab.c @@ -1,5 +1,5 @@ /* An expandable hash tables datatype. - Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 + Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2009 Free Software Foundation, Inc. Contributed by Vladimir Makarov (vmakarov@cygnus.com). @@ -759,7 +759,8 @@ htab_traverse_noresize (htab_t htab, htab_trav callback, PTR info) void htab_traverse (htab_t htab, htab_trav callback, PTR info) { - if (htab_elements (htab) * 8 < htab_size (htab)) + size_t size = htab_size (htab); + if (htab_elements (htab) * 8 < size && size > 32) htab_expand (htab); htab_traverse_noresize (htab, callback, info); diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 29747b18c8e..cefde03746f 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,142 @@ +2009-06-21 Jonathan Wakely <jwakely.gcc@gmail.com> + + * include/std/future: New. + * include/Makefile.am: Add. + * include/Makefile.in: Regenerate. + * src/future.cc: New. + * src/Makefile.am: Add. + * src/Makefile.in: Regenerate. + * config/abi/pre/gnu.ver: Add export. + * testsuite/30_threads/headers/future/std_c++0x_neg.cc: New. + * testsuite/30_threads/headers/future/types_std_c++0x.cc: New. + * testsuite/30_threads/packaged_task/cons/1.cc: New. + * testsuite/30_threads/packaged_task/cons/2.cc: New. + * testsuite/30_threads/packaged_task/cons/assign_neg.cc: New. + * testsuite/30_threads/packaged_task/cons/copy_neg.cc: New. + * testsuite/30_threads/packaged_task/cons/move_assign.cc: New. + * testsuite/30_threads/packaged_task/cons/move.cc: New. + * testsuite/30_threads/packaged_task/members/boolconv.cc: New. + * testsuite/30_threads/packaged_task/members/get_future.cc: New. + * testsuite/30_threads/packaged_task/members/get_future2.cc: New. + * testsuite/30_threads/packaged_task/members/invoke.cc: New. + * testsuite/30_threads/packaged_task/members/invoke2.cc: New. + * testsuite/30_threads/packaged_task/members/invoke3.cc: New. + * testsuite/30_threads/packaged_task/members/invoke4.cc: New. + * testsuite/30_threads/packaged_task/members/invoke5.cc: New. + * testsuite/30_threads/packaged_task/members/reset.cc: New. + * testsuite/30_threads/packaged_task/members/reset2.cc: New. + * testsuite/30_threads/packaged_task/members/swap.cc: New. + * testsuite/30_threads/packaged_task/requirements/ + explicit_instantiation.cc: New. + * testsuite/30_threads/promise/cons/1.cc: New. + * testsuite/30_threads/promise/cons/assign_neg.cc: New. + * testsuite/30_threads/promise/cons/copy_neg.cc: New. + * testsuite/30_threads/promise/cons/move_assign.cc: New. + * testsuite/30_threads/promise/cons/move.cc: New. + * testsuite/30_threads/promise/members/get_future.cc: New. + * testsuite/30_threads/promise/members/get_future2.cc: New. + * testsuite/30_threads/promise/members/set_exception.cc: New. + * testsuite/30_threads/promise/members/set_exception2.cc: New. + * testsuite/30_threads/promise/members/set_value.cc: New. + * testsuite/30_threads/promise/members/set_value2.cc: New. + * testsuite/30_threads/promise/members/set_value3.cc: New. + * testsuite/30_threads/promise/members/swap.cc: New. + * testsuite/30_threads/promise/requirements/ + explicit_instantiation.cc: New. + * testsuite/30_threads/shared_future/cons/assign_neg.cc: New. + * testsuite/30_threads/shared_future/cons/copy.cc: New. + * testsuite/30_threads/shared_future/cons/default_neg.cc: New. + * testsuite/30_threads/shared_future/cons/move.cc: New. + * testsuite/30_threads/shared_future/members/get.cc: New. + * testsuite/30_threads/shared_future/members/get2.cc: New. + * testsuite/30_threads/shared_future/members/has_exception.cc: New. + * testsuite/30_threads/shared_future/members/has_value.cc: New. + * testsuite/30_threads/shared_future/members/is_ready.cc: New. + * testsuite/30_threads/shared_future/members/wait.cc: New. + * testsuite/30_threads/shared_future/members/wait_for.cc: New. + * testsuite/30_threads/shared_future/members/wait_until.cc: New. + * testsuite/30_threads/shared_future/requirements/ + explicit_instantiation.cc: New. + * testsuite/30_threads/unique_future/cons/assign_neg.cc: New. + * testsuite/30_threads/unique_future/cons/copy_neg.cc: New. + * testsuite/30_threads/unique_future/cons/default_neg.cc: New. + * testsuite/30_threads/unique_future/cons/move.cc: New. + * testsuite/30_threads/unique_future/members/get.cc: New. + * testsuite/30_threads/unique_future/members/get2.cc: New. + * testsuite/30_threads/unique_future/members/has_exception.cc: New. + * testsuite/30_threads/unique_future/members/has_value.cc: New. + * testsuite/30_threads/unique_future/members/is_ready.cc: New. + * testsuite/30_threads/unique_future/members/wait.cc: New. + * testsuite/30_threads/unique_future/members/wait_for.cc: New. + * testsuite/30_threads/unique_future/members/wait_until.cc: New. + * testsuite/30_threads/unique_future/requirements/ + explicit_instantiation.cc: New. + * testsuite/performance/30_threads/future/polling.cc: New. + +2009-06-20 Paolo Carlini <paolo.carlini@oracle.com> + + * Revert last Change. + +2009-06-20 Paolo Carlini <paolo.carlini@oracle.com> + + PR libstdc++/40497 + * include/bits/stl_iterator_base_funcs.h (next, prev): Fix the + signature per the current C++1x draft (N2857). + * testsuite/24_iterators/operations/40497.cc: Add. + +2009-06-19 Paolo Carlini <paolo.carlini@oracle.com> + + * include/bits/random.h (_Adaptor): Simplify for _DInputType always + a floating point type. + (uniform_int_distribution<>::uniform_int_distribution(_IntType, + _IntType)): Fix second default argument. + (uniform_int_distribution<>::_M_call): Remove. + (uniform_int_distribution<>::operator()(_UniformRandomNumberGenerator&, + const param_type&)): Only declare. + * include/bits/random.tcc (uniform_int_distribution<>::_M_call( + _UniformRandomNumberGenerator&, result_type, result_type, true_type): + Remove. + uniform_int_distribution<>::operator()(_UniformRandomNumberGenerator&, + const param_type&): Define here. + (geometric_distribution<>::operator()(_UniformRandomNumberGenerator&, + const param_type&), discrete_distribution<>::operator() + (_UniformRandomNumberGenerator&, const param_type&), + piecewise_constant_distribution<>::operator() + (_UniformRandomNumberGenerator&, const param_type&), + piecewise_linear_distribution<>::operator() + (_UniformRandomNumberGenerator&, const param_type&)): Use double as + the second template argument of _Adaptor. + * testsuite/26_numerics/random/uniform_int_distribution/cons/ + default.cc: Adjust. + +2009-06-19 Paolo Carlini <paolo.carlini@oracle.com> + + * include/bits/random.tcc (discrete_distribution<>::param_type:: + param_type(size_t, double, double, _Func), + discrete_distribution<>::operator()(_UniformRandomNumberGenerator&, + const param_type&)): Tidy. + (piecewise_constant_distribution<>::param_type::_M_initialize): + Use reserve, fix. + (piecewise_constant_distribution<>::param_type:: + param_type(initializer_list<>, _Func), + piecewise_constant_distribution<>::param_type:: + param_type(size_t, _RealType, _RealType, _Func), + piecewise_linear_distribution<>::param_type:: + param_type(initializer_list<>, _Func), + piecewise_linear_distribution<>::param_type:: + param_type(size_t, _RealType, _RealType, _Func)): Use reserve, tidy. + (piecewise_constant_distribution<>::param_type:: + param_type(_InputIteratorB, _InputIteratorB, _InputIteratorW), + piecewise_constant_distribution<>:: + operator()(_UniformRandomNumberGenerator&, const param_type&), + piecewise_linear_distribution<>:: + operator()(_UniformRandomNumberGenerator&, const param_type&)): Fix. + (operator>>(std::basic_istream<>&, + piecewise_constant_distribution<>&), + operator>>(std::basic_istream<>&, piecewise_linear_distribution<>&)): + Use reserve. + * include/bits/random.h: Minor cosmetic changes. + 2009-06-17 Benjamin Kosnik <bkoz@redhat.com> * testsuite/23_containers/list/check_construct_destroy.h: New. diff --git a/libstdc++-v3/config/abi/pre/gnu.ver b/libstdc++-v3/config/abi/pre/gnu.ver index 240e7bcf09b..3a24dc9fb16 100644 --- a/libstdc++-v3/config/abi/pre/gnu.ver +++ b/libstdc++-v3/config/abi/pre/gnu.ver @@ -964,6 +964,9 @@ GLIBCXX_3.4.12 { _ZSt27__set_once_functor_lock_ptrPSt11unique_lockISt5mutexE; _ZSt16__get_once_mutexv; + # future + _ZSt15future_category; + } GLIBCXX_3.4.11; # Symbols in the support library (libsupc++) have their own tag. diff --git a/libstdc++-v3/include/Makefile.am b/libstdc++-v3/include/Makefile.am index 6a9c4f09ed4..b0fc483f20b 100644 --- a/libstdc++-v3/include/Makefile.am +++ b/libstdc++-v3/include/Makefile.am @@ -38,6 +38,7 @@ std_headers = \ ${std_srcdir}/forward_list \ ${std_srcdir}/fstream \ ${std_srcdir}/functional \ + ${std_srcdir}/future \ ${std_srcdir}/iomanip \ ${std_srcdir}/ios \ ${std_srcdir}/iosfwd \ diff --git a/libstdc++-v3/include/Makefile.in b/libstdc++-v3/include/Makefile.in index 0a0eeadc649..35fd0c26a33 100644 --- a/libstdc++-v3/include/Makefile.in +++ b/libstdc++-v3/include/Makefile.in @@ -295,6 +295,7 @@ std_headers = \ ${std_srcdir}/forward_list \ ${std_srcdir}/fstream \ ${std_srcdir}/functional \ + ${std_srcdir}/future \ ${std_srcdir}/iomanip \ ${std_srcdir}/ios \ ${std_srcdir}/iosfwd \ diff --git a/libstdc++-v3/include/bits/random.h b/libstdc++-v3/include/bits/random.h index e8edbf05dd4..099c5fae1a9 100644 --- a/libstdc++-v3/include/bits/random.h +++ b/libstdc++-v3/include/bits/random.h @@ -95,40 +95,23 @@ namespace std _DInputType min() const - { - if (is_integral<_DInputType>::value) - return _M_g.min(); - else - return _DInputType(0); - } + { return _DInputType(0); } _DInputType max() const - { - if (is_integral<_DInputType>::value) - return _M_g.max(); - else - return _DInputType(1); - } + { return _DInputType(1); } /* * Converts a value generated by the adapted random number generator * into a value in the input domain for the dependent random number * distribution. - * - * Because the type traits are compile time constants only the - * appropriate clause of the if statements will actually be emitted - * by the compiler. */ _DInputType operator()() { - if (is_integral<_DInputType>::value) - return _M_g(); - else - return generate_canonical<_DInputType, - numeric_limits<_DInputType>::digits, - _Engine>(_M_g); + return std::generate_canonical<_DInputType, + std::numeric_limits<_DInputType>::digits, + _Engine>(_M_g); } private: @@ -380,7 +363,7 @@ namespace std static_assert(__w >= __l, "mersenne_twister_engine template arguments out of bounds"); static_assert(__w <= - static_cast<size_t>(numeric_limits<_UIntType>::digits), + static_cast<size_t>(std::numeric_limits<_UIntType>::digits), "mersenne_twister_engine template arguments out of bounds"); static_assert(__a <= (__detail::_Shift<_UIntType, __w>::__value - 1), "mersenne_twister_engine template arguments out of bounds"); @@ -558,8 +541,9 @@ namespace std { __glibcxx_class_requires(_UIntType, _UnsignedIntegerConcept) static_assert(__s > 0U && __r > __s - && __w > 0U - && __w <= static_cast<size_t>(numeric_limits<_UIntType>::digits), + && __w > 0U + && __w <= static_cast<size_t> + (std::numeric_limits<_UIntType>::digits), "template arguments out of bounds" " in subtract_with_carry_engine"); @@ -922,7 +906,8 @@ namespace std { static_assert(__w > 0U && __w <= - static_cast<size_t>(numeric_limits<_UIntType>::digits), + static_cast<size_t> + (std::numeric_limits<_UIntType>::digits), "template arguments out of bounds " "in independent_bits_engine"); @@ -1507,7 +1492,8 @@ namespace std typedef uniform_int_distribution<_IntType> distribution_type; explicit - param_type(_IntType __a = 0, _IntType __b = 9) + param_type(_IntType __a = 0, + _IntType __b = std::numeric_limits<_IntType>::max()) : _M_a(__a), _M_b(__b) { _GLIBCXX_DEBUG_ASSERT(_M_a <= _M_b); @@ -1531,7 +1517,8 @@ namespace std * @brief Constructs a uniform distribution object. */ explicit - uniform_int_distribution(_IntType __a = 0, _IntType __b = 9) + uniform_int_distribution(_IntType __a = 0, + _IntType __b = std::numeric_limits<_IntType>::max()) : _M_param(__a, __b) { } @@ -1602,29 +1589,7 @@ namespace std template<typename _UniformRandomNumberGenerator> result_type operator()(_UniformRandomNumberGenerator& __urng, - const param_type& __p) - { - typedef typename _UniformRandomNumberGenerator::result_type - _UResult_type; - return _M_call(__urng, __p.a(), __p.b(), - typename is_integral<_UResult_type>::type()); - } - - private: - template<typename _UniformRandomNumberGenerator> - result_type - _M_call(_UniformRandomNumberGenerator& __urng, - result_type __min, result_type __max, true_type); - - template<typename _UniformRandomNumberGenerator> - result_type - _M_call(_UniformRandomNumberGenerator& __urng, - result_type __min, result_type __max, false_type) - { - return result_type((__urng() - __urng.min()) - / (__urng.max() - __urng.min()) - * (__max - __min + 1)) + __min; - } + const param_type& __p); param_type _M_param; }; @@ -4108,8 +4073,8 @@ namespace std : _M_param(__wbegin, __wend) { } - discrete_distribution(initializer_list<double> __wil) - : _M_param(__wil) + discrete_distribution(initializer_list<double> __wl) + : _M_param(__wl) { } template<typename _Func> @@ -4240,7 +4205,7 @@ namespace std _InputIteratorW __wbegin); template<typename _Func> - param_type(initializer_list<_RealType> __bil, _Func __fw); + param_type(initializer_list<_RealType> __bi, _Func __fw); template<typename _Func> param_type(size_t __nw, _RealType __xmin, _RealType __xmax, @@ -4276,9 +4241,9 @@ namespace std { } template<typename _Func> - piecewise_constant_distribution(initializer_list<_RealType> __bil, + piecewise_constant_distribution(initializer_list<_RealType> __bl, _Func __fw) - : _M_param(__bil, __fw) + : _M_param(__bl, __fw) { } template<typename _Func> @@ -4408,7 +4373,9 @@ namespace std typedef piecewise_linear_distribution<_RealType> distribution_type; friend class piecewise_linear_distribution<_RealType>; - param_type(); + param_type() + : _M_int(), _M_den(), _M_cp(), _M_m() + { _M_initialize(); } template<typename _InputIteratorB, typename _InputIteratorW> param_type(_InputIteratorB __bfirst, @@ -4416,7 +4383,7 @@ namespace std _InputIteratorW __wbegin); template<typename _Func> - param_type(initializer_list<_RealType> __bil, _Func __fw); + param_type(initializer_list<_RealType> __bl, _Func __fw); template<typename _Func> param_type(size_t __nw, _RealType __xmin, _RealType __xmax, @@ -4453,9 +4420,9 @@ namespace std { } template<typename _Func> - piecewise_linear_distribution(initializer_list<_RealType> __bil, + piecewise_linear_distribution(initializer_list<_RealType> __bl, _Func __fw) - : _M_param(__bil, __fw) + : _M_param(__bl, __fw) { } template<typename _Func> diff --git a/libstdc++-v3/include/bits/random.tcc b/libstdc++-v3/include/bits/random.tcc index eb2ce4a4500..87c46186b57 100644 --- a/libstdc++-v3/include/bits/random.tcc +++ b/libstdc++-v3/include/bits/random.tcc @@ -644,13 +644,13 @@ namespace std template<typename _UniformRandomNumberGenerator> typename uniform_int_distribution<_IntType>::result_type uniform_int_distribution<_IntType>:: - _M_call(_UniformRandomNumberGenerator& __urng, - result_type __min, result_type __max, true_type) + operator()(_UniformRandomNumberGenerator& __urng, + const param_type& __param) { // XXX Must be fixed to work well for *arbitrary* __urng.max(), - // __urng.min(), __max, __min. Currently works fine only in the - // most common case __urng.max() - __urng.min() >= __max - __min, - // with __urng.max() > __urng.min() >= 0. + // __urng.min(), __param.b(), __param.a(). Currently works fine only + // in the most common case __urng.max() - __urng.min() >= + // __param.b() - __param.a(), with __urng.max() > __urng.min() >= 0. typedef typename __gnu_cxx::__add_unsigned<typename _UniformRandomNumberGenerator::result_type>::__type __urntype; typedef typename __gnu_cxx::__add_unsigned<result_type>::__type @@ -664,14 +664,14 @@ namespace std const __urntype __urnmin = __urng.min(); const __urntype __urnmax = __urng.max(); const __urntype __urnrange = __urnmax - __urnmin; - const __uctype __urange = __max - __min; + const __uctype __urange = __param.b() - __param.a(); const __uctype __udenom = (__urnrange <= __urange ? 1 : __urnrange / (__urange + 1)); do __ret = (__urntype(__urng()) - __urnmin) / __udenom; - while (__ret > __max - __min); + while (__ret > __param.b() - __param.a()); - return __ret + __min; + return __ret + __param.a(); } template<typename _IntType, typename _CharT, typename _Traits> @@ -799,7 +799,7 @@ namespace std // The largest _RealType convertible to _IntType. const double __thr = std::numeric_limits<_IntType>::max() + __naf; - __detail::_Adaptor<_UniformRandomNumberGenerator, result_type> + __detail::_Adaptor<_UniformRandomNumberGenerator, double> __aurng(__urng); double __cand; @@ -1985,30 +1985,31 @@ namespace std return; } - double __sum = std::accumulate(_M_prob.begin(), _M_prob.end(), 0.0); - // Now normalize the densities. + const double __sum = std::accumulate(_M_prob.begin(), + _M_prob.end(), 0.0); + // Now normalize the probabilites. std::transform(_M_prob.begin(), _M_prob.end(), _M_prob.begin(), std::bind2nd(std::divides<double>(), __sum)); - // Accumulate partial sums. + // Accumulate partial sums. + _M_cp.reserve(_M_prob.size()); std::partial_sum(_M_prob.begin(), _M_prob.end(), std::back_inserter(_M_cp)); - // Make sure the last cumulative probablility is one. + // Make sure the last cumulative probability is one. _M_cp[_M_cp.size() - 1] = 1.0; } template<typename _IntType> template<typename _Func> discrete_distribution<_IntType>::param_type:: - param_type(size_t __nw, double __xmin, double __xmax, - _Func __fw) + param_type(size_t __nw, double __xmin, double __xmax, _Func __fw) : _M_prob(), _M_cp() { - for (size_t __i = 0; __i < __nw; ++__i) - { - const double __x = ((__nw - __i - 0.5) * __xmin - + (__i + 0.5) * __xmax) / __nw; - _M_prob.push_back(__fw(__x)); - } + const size_t __n = __nw == 0 ? 1 : __nw; + const double __delta = (__xmax - __xmin) / __n; + + _M_prob.reserve(__n); + for (size_t __k = 0; __k < __nw; ++__k) + _M_prob.push_back(__fw(__xmin + __k * __delta + 0.5 * __delta)); _M_initialize(); } @@ -2020,17 +2021,14 @@ namespace std operator()(_UniformRandomNumberGenerator& __urng, const param_type& __param) { - __detail::_Adaptor<_UniformRandomNumberGenerator, result_type> + __detail::_Adaptor<_UniformRandomNumberGenerator, double> __aurng(__urng); const double __p = __aurng(); auto __pos = std::lower_bound(__param._M_cp.begin(), __param._M_cp.end(), __p); - if (__pos == __param._M_cp.end()) - return 0; - const size_t __i = __pos - __param._M_cp.begin(); - return __i; + return __pos - __param._M_cp.begin(); } template<typename _IntType, typename _CharT, typename _Traits> @@ -2075,6 +2073,7 @@ namespace std __is >> __n; std::vector<double> __prob_vec; + __prob_vec.reserve(__n); for (; __n != 0; --__n) { double __prob; @@ -2098,6 +2097,7 @@ namespace std if (_M_int.size() < 2) { _M_int.clear(); + _M_int.reserve(2); _M_int.push_back(_RealType(0)); _M_int.push_back(_RealType(1)); @@ -2107,21 +2107,21 @@ namespace std return; } - double __sum = 0.0; - for (size_t __i = 0; __i < _M_den.size(); ++__i) - { - __sum += _M_den[__i] * (_M_int[__i + 1] - _M_int[__i]); - _M_cp.push_back(__sum); - } + const double __sum = std::accumulate(_M_den.begin(), + _M_den.end(), 0.0); - // Now normalize the densities... std::transform(_M_den.begin(), _M_den.end(), _M_den.begin(), std::bind2nd(std::divides<double>(), __sum)); - // ... and partial sums. - std::transform(_M_cp.begin(), _M_cp.end(), _M_cp.begin(), - std::bind2nd(std::divides<double>(), __sum)); - // Make sure the last cumulative probablility is one. + + _M_cp.reserve(_M_den.size()); + std::partial_sum(_M_den.begin(), _M_den.end(), + std::back_inserter(_M_cp)); + + // Make sure the last cumulative probability is one. _M_cp[_M_cp.size() - 1] = 1.0; + + for (size_t __k = 0; __k < _M_den.size(); ++__k) + _M_den[__k] /= _M_int[__k + 1] - _M_int[__k]; } template<typename _RealType> @@ -2132,17 +2132,19 @@ namespace std _InputIteratorW __wbegin) : _M_int(), _M_den(), _M_cp() { - do + if (__bbegin != __bend) { - _M_int.push_back(*__bbegin); - ++__bbegin; - if (__bbegin != __bend) + for (;;) { + _M_int.push_back(*__bbegin); + ++__bbegin; + if (__bbegin == __bend) + break; + _M_den.push_back(*__wbegin); ++__wbegin; } } - while (__bbegin != __bend); _M_initialize(); } @@ -2150,17 +2152,16 @@ namespace std template<typename _RealType> template<typename _Func> piecewise_constant_distribution<_RealType>::param_type:: - param_type(initializer_list<_RealType> __bil, _Func __fw) + param_type(initializer_list<_RealType> __bl, _Func __fw) : _M_int(), _M_den(), _M_cp() { - for (auto __biter = __bil.begin(); __biter != __bil.end(); ++__biter) + _M_int.reserve(__bl.size()); + for (auto __biter = __bl.begin(); __biter != __bl.end(); ++__biter) _M_int.push_back(*__biter); - for (size_t __i = 0; __i < _M_int.size() - 1; ++__i) - { - _RealType __x = 0.5 * (_M_int[__i] + _M_int[__i + 1]); - _M_den.push_back(__fw(__x)); - } + _M_den.reserve(_M_int.size() - 1); + for (size_t __k = 0; __k < _M_int.size() - 1; ++__k) + _M_den.push_back(__fw(0.5 * (_M_int[__k + 1] + _M_int[__k]))); _M_initialize(); } @@ -2171,18 +2172,16 @@ namespace std param_type(size_t __nw, _RealType __xmin, _RealType __xmax, _Func __fw) : _M_int(), _M_den(), _M_cp() { - for (size_t __i = 0; __i <= __nw; ++__i) - { - const _RealType __x = ((__nw - __i) * __xmin - + __i * __xmax) / __nw; - _M_int.push_back(__x); - } - for (size_t __i = 0; __i < __nw; ++__i) - { - const _RealType __x = ((__nw - __i - 0.5) * __xmin - + (__i + 0.5) * __xmax) / __nw; - _M_den.push_back(__fw(__x)); - } + const size_t __n = __nw == 0 ? 1 : __nw; + const _RealType __delta = (__xmax - __xmin) / __n; + + _M_int.reserve(__n + 1); + for (size_t __k = 0; __k <= __nw; ++__k) + _M_int.push_back(__xmin + __k * __delta); + + _M_den.reserve(__n); + for (size_t __k = 0; __k < __nw; ++__k) + _M_den.push_back(__fw(_M_int[__k] + 0.5 * __delta)); _M_initialize(); } @@ -2194,7 +2193,7 @@ namespace std operator()(_UniformRandomNumberGenerator& __urng, const param_type& __param) { - __detail::_Adaptor<_UniformRandomNumberGenerator, result_type> + __detail::_Adaptor<_UniformRandomNumberGenerator, double> __aurng(__urng); const double __p = __aurng(); @@ -2202,8 +2201,9 @@ namespace std __param._M_cp.end(), __p); const size_t __i = __pos - __param._M_cp.begin(); - return __param._M_int[__i] - + (__p - __param._M_cp[__i]) / __param._M_den[__i]; + const double __pref = __i > 0 ? __param._M_cp[__i - 1] : 0.0; + + return __param._M_int[__i] + (__p - __pref) / __param._M_den[__i]; } template<typename _RealType, typename _CharT, typename _Traits> @@ -2253,6 +2253,7 @@ namespace std __is >> __n; std::vector<_RealType> __int_vec; + __int_vec.reserve(__n + 1); for (size_t __i = 0; __i <= __n; ++__i) { _RealType __int; @@ -2261,6 +2262,7 @@ namespace std } std::vector<double> __den_vec; + __den_vec.reserve(__n); for (size_t __i = 0; __i < __n; ++__i) { double __den; @@ -2284,10 +2286,12 @@ namespace std if (_M_int.size() < 2) { _M_int.clear(); + _M_int.reserve(2); _M_int.push_back(_RealType(0)); _M_int.push_back(_RealType(1)); _M_den.clear(); + _M_den.reserve(2); _M_den.push_back(1.0); _M_den.push_back(1.0); @@ -2295,17 +2299,19 @@ namespace std } double __sum = 0.0; - for (size_t __i = 0; __i < _M_int.size() - 1; ++__i) + _M_cp.reserve(_M_int.size() - 1); + _M_m.reserve(_M_int.size() - 1); + for (size_t __k = 0; __k < _M_int.size() - 1; ++__k) { - const _RealType __delta = _M_int[__i + 1] - _M_int[__i]; - __sum += 0.5 * (_M_den[__i + 1] + _M_den[__i]) * __delta; + const _RealType __delta = _M_int[__k + 1] - _M_int[__k]; + __sum += 0.5 * (_M_den[__k + 1] + _M_den[__k]) * __delta; _M_cp.push_back(__sum); - _M_m.push_back((_M_den[__i + 1] - _M_den[__i]) / __delta); + _M_m.push_back((_M_den[__k + 1] - _M_den[__k]) / __delta); } // Now normalize the densities... std::transform(_M_den.begin(), _M_den.end(), _M_den.begin(), - std::bind2nd(std::divides<double>(),__sum)); + std::bind2nd(std::divides<double>(), __sum)); // ... and partial sums... std::transform(_M_cp.begin(), _M_cp.end(), _M_cp.begin(), std::bind2nd(std::divides<double>(), __sum)); @@ -2314,13 +2320,7 @@ namespace std std::bind2nd(std::divides<double>(), __sum)); // Make sure the last cumulative probablility is one. _M_cp[_M_cp.size() - 1] = 1.0; - } - - template<typename _RealType> - piecewise_linear_distribution<_RealType>::param_type:: - param_type() - : _M_int(), _M_den(), _M_cp(), _M_m() - { _M_initialize(); } + } template<typename _RealType> template<typename _InputIteratorB, typename _InputIteratorW> @@ -2342,10 +2342,12 @@ namespace std template<typename _RealType> template<typename _Func> piecewise_linear_distribution<_RealType>::param_type:: - param_type(initializer_list<_RealType> __bil, _Func __fw) + param_type(initializer_list<_RealType> __bl, _Func __fw) : _M_int(), _M_den(), _M_cp(), _M_m() { - for (auto __biter = __bil.begin(); __biter != __bil.end(); ++__biter) + _M_int.reserve(__bl.size()); + _M_den.reserve(__bl.size()); + for (auto __biter = __bl.begin(); __biter != __bl.end(); ++__biter) { _M_int.push_back(*__biter); _M_den.push_back(__fw(*__biter)); @@ -2357,16 +2359,18 @@ namespace std template<typename _RealType> template<typename _Func> piecewise_linear_distribution<_RealType>::param_type:: - param_type(size_t __nw, _RealType __xmin, _RealType __xmax, - _Func __fw) + param_type(size_t __nw, _RealType __xmin, _RealType __xmax, _Func __fw) : _M_int(), _M_den(), _M_cp(), _M_m() { - for (size_t __i = 0; __i <= __nw; ++__i) + const size_t __n = __nw == 0 ? 1 : __nw; + const _RealType __delta = (__xmax - __xmin) / __n; + + _M_int.reserve(__n + 1); + _M_den.reserve(__n + 1); + for (size_t __k = 0; __k <= __nw; ++__k) { - const _RealType __x = ((__nw - __i) * __xmin - + __i * __xmax) / __nw; - _M_int.push_back(__x); - _M_den.push_back(__fw(__x)); + _M_int.push_back(__xmin + __k * __delta); + _M_den.push_back(__fw(_M_int[__k] + __delta)); } _M_initialize(); @@ -2379,31 +2383,30 @@ namespace std operator()(_UniformRandomNumberGenerator& __urng, const param_type& __param) { - result_type __x; - __detail::_Adaptor<_UniformRandomNumberGenerator, result_type> + __detail::_Adaptor<_UniformRandomNumberGenerator, double> __aurng(__urng); const double __p = __aurng(); auto __pos = std::lower_bound(__param._M_cp.begin(), __param._M_cp.end(), __p); const size_t __i = __pos - __param._M_cp.begin(); + + const double __pref = __i > 0 ? __param._M_cp[__i - 1] : 0.0; + const double __a = 0.5 * __param._M_m[__i]; const double __b = __param._M_den[__i]; - const double __c = __param._M_cp[__i]; - const double __q = -0.5 * (__b -#if _GLIBCXX_USE_C99_MATH_TR1 - + std::copysign(std::sqrt(__b * __b - - 4.0 * __a * __c), __b)); -#else - + (__b < 0.0 ? -1.0 : 1.0) - * std::sqrt(__b * __b - 4.0 * __a * __c)); -#endif - const double __x0 = __param._M_int[__i]; - const double __x1 = __q / __a; - const double __x2 = __c / __q; - __x = std::max(__x0 + __x1, __x0 + __x2); + const double __cm = __p - __pref; + + _RealType __x = __param._M_int[__i]; + if (__a == 0) + __x += __cm / __b; + else + { + const double __d = __b * __b + 4.0 * __a * __cm; + __x += 0.5 * (std::sqrt(__d) - __b) / __a; + } - return __x; + return __x; } template<typename _RealType, typename _CharT, typename _Traits> @@ -2453,6 +2456,7 @@ namespace std __is >> __n; std::vector<_RealType> __int_vec; + __int_vec.reserve(__n + 1); for (size_t __i = 0; __i <= __n; ++__i) { _RealType __int; @@ -2461,6 +2465,7 @@ namespace std } std::vector<double> __den_vec; + __den_vec.reserve(__n + 1); for (size_t __i = 0; __i <= __n; ++__i) { double __den; diff --git a/libstdc++-v3/include/std/future b/libstdc++-v3/include/std/future new file mode 100644 index 00000000000..c485b9614a1 --- /dev/null +++ b/libstdc++-v3/include/std/future @@ -0,0 +1,925 @@ +// <future> -*- C++ -*- + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// Under Section 7 of GPL version 3, you are granted additional +// permissions described in the GCC Runtime Library Exception, version +// 3.1, as published by the Free Software Foundation. + +// You should have received a copy of the GNU General Public License and +// a copy of the GCC Runtime Library Exception along with this program; +// see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +// <http://www.gnu.org/licenses/>. + +/** @file future + * This is a Standard C++ Library header. + */ + +#ifndef _GLIBCXX_FUTURE +#define _GLIBCXX_FUTURE 1 + +#pragma GCC system_header + +#ifndef __GXX_EXPERIMENTAL_CXX0X__ +# include <c++0x_warning.h> +#else + +#include <functional> +#include <memory> +#include <mutex> +#include <condition_variable> +#include <system_error> +#include <exception> +#include <cstdatomic> + +#if defined(_GLIBCXX_HAS_GTHREADS) && defined(_GLIBCXX_USE_C99_STDINT_TR1) \ + && defined(_GLIBCXX_ATOMIC_BUILTINS_4) + +namespace std +{ + /** + * @defgroup futures Futures + * @ingroup concurrency + * + * Classes for futures support. + * @{ + */ + + /// Error code for futures + enum class future_errc + { broken_promise, future_already_retrieved, promise_already_satisfied }; + + // TODO: requires concepts + // concept_map ErrorCodeEnum<future_errc> { } + template<> + struct is_error_code_enum<future_errc> : public true_type { }; + + /// Points to a statically-allocated object derived from error_category. + extern const error_category* const future_category; + + // TODO: requires constexpr + inline error_code make_error_code(future_errc __errc) + { return error_code(static_cast<int>(__errc), *future_category); } + + // TODO: requires constexpr + inline error_condition make_error_condition(future_errc __errc) + { return error_condition(static_cast<int>(__errc), *future_category); } + + /// Exception type thrown by futures. + class future_error : public logic_error + { + public: + explicit future_error(future_errc __ec) + : logic_error("std::future_error"), _M_code(make_error_code(__ec)) + { } + + const error_code& code() const throw() { return _M_code; } + + const char* what() const throw() { return _M_code.message().c_str(); } + + private: + error_code _M_code; + }; + + // Holds the result of a future + struct _Future_result_base + { + _Future_result_base() = default; + _Future_result_base(const _Future_result_base&) = delete; + _Future_result_base& operator=(const _Future_result_base&) = delete; + + exception_ptr _M_error; + + // _M_destroy() allows derived classes to control deallocation, + // which will be needed when allocator support is added to promise. + // See http://gcc.gnu.org/ml/libstdc++/2009-06/msg00032.html + virtual void _M_destroy() = 0; + struct _Deleter + { + void operator()(_Future_result_base* __fr) const { __fr->_M_destroy(); } + }; + + protected: + ~_Future_result_base() = default; + }; + + // TODO: use template alias when available + /* + template<typename _Res> + using _Future_ptr = unique_ptr<_Res, _Future_result_base::_Deleter>; + */ + template<typename _Res> + struct _Future_ptr + { + typedef unique_ptr<_Res, _Future_result_base::_Deleter> type; + }; + + // State shared between a promise and one or more associated futures. + class _Future_state + { + typedef _Future_ptr<_Future_result_base>::type _Future_ptr_type; + + public: + _Future_state() : _M_result(), _M_retrieved(false) { } + + _Future_state(const _Future_state&) = delete; + _Future_state& operator=(const _Future_state&) = delete; + + bool + is_ready() + { return _M_get() != 0; } + + bool + has_exception() + { + _Future_result_base* const __res = _M_get(); + return __res && !(__res->_M_error == 0); + } + + bool + has_value() + { + _Future_result_base* const __res = _M_get(); + return __res && (__res->_M_error == 0); + } + + _Future_result_base& + wait() + { + unique_lock<mutex> __lock(_M_mutex); + if (!_M_ready()) + _M_cond.wait(__lock, std::bind(&_Future_state::_M_ready, this)); + return *_M_result; + } + + template<typename _Rep, typename _Period> + bool + wait_for(const chrono::duration<_Rep, _Period>& __rel) + { + unique_lock<mutex> __lock(_M_mutex); + return _M_ready() || _M_cond.wait_for(__lock, __rel, + std::bind(&_Future_state::_M_ready, this)); + } + + template<typename _Clock, typename _Duration> + bool + wait_until(const chrono::time_point<_Clock, _Duration>& __abs) + { + unique_lock<mutex> __lock(_M_mutex); + return _M_ready() || _M_cond.wait_until(__lock, __abs, + std::bind(&_Future_state::_M_ready, this)); + } + + void + _M_set_result(_Future_ptr_type __res) + { + { + lock_guard<mutex> __lock(_M_mutex); + if (_M_ready()) + throw future_error(future_errc::promise_already_satisfied); + _M_result.swap(__res); + } + _M_cond.notify_all(); + } + + void + _M_break_promise(_Future_ptr_type __res) + { + if (static_cast<bool>(__res)) + { + __res->_M_error + = std::copy_exception(future_error(future_errc::broken_promise)); + { + lock_guard<mutex> __lock(_M_mutex); + _M_result.swap(__res); + } + _M_cond.notify_all(); + } + } + + // called when this object is passed to a unique_future + void + _M_set_retrieved_flag() + { + if (_M_retrieved.test_and_set()) + throw future_error(future_errc::future_already_retrieved); + } + + private: + _Future_result_base* + _M_get() + { + lock_guard<mutex> __lock(_M_mutex); + return _M_result.get(); + } + + bool _M_ready() const { return static_cast<bool>(_M_result); } + + _Future_ptr_type _M_result; + mutex _M_mutex; + condition_variable _M_cond; + atomic_flag _M_retrieved; + }; + + // workaround for CWG issue 664 and c++/34022 + template<typename _Result, bool = is_scalar<_Result>::value> + struct _Move_future_result + { + typedef _Result&& __rval_type; + static _Result&& _S_move(_Result& __res) { return std::move(__res); } + }; + + // specialization for scalar types returns rvalue not rvalue-reference + template<typename _Result> + struct _Move_future_result<_Result, true> + { + typedef _Result __rval_type; + static _Result _S_move(_Result __res) { return __res; } + }; + + template<typename _Result> + struct _Future_result : _Future_result_base + { + _Future_result() : _M_initialized() { } + + ~_Future_result() + { + if (_M_initialized) + _M_value().~_Result(); + } + + // return lvalue, future will add const or rvalue-reference + _Result& _M_value() + { return *static_cast<_Result*>(_M_addr()); } + + void + _M_set(const _Result& __res) + { + ::new (_M_addr()) _Result(__res); + _M_initialized = true; + } + + void + _M_set(_Result&& __res) + { + typedef _Move_future_result<_Result> _Mover; + ::new (_M_addr()) _Result(_Mover::_S_move(__res)); + _M_initialized = true; + } + + private: + void _M_destroy() { delete this; } + + void* _M_addr() { return static_cast<void*>(&_M_storage); } + + typename aligned_storage<sizeof(_Result), + alignment_of<_Result>::value>::type _M_storage; + bool _M_initialized; + }; + + template<typename _Result> + struct _Future_result<_Result&> : _Future_result_base + { + _Future_result() : _M_value_ptr() { } + + _Result* _M_value_ptr; + + void _M_destroy() { delete this; } + }; + + template<> + struct _Future_result<void> : _Future_result_base + { + void _M_destroy() { delete this; } + }; + + /// unique_future + template<typename _Result> + class unique_future; + + /// shared_future + template<typename _Result> + class shared_future; + + // common implementation for unique_future and shared_future + template<typename _Result> + class _Future_impl + { + public: + // disable copying + _Future_impl(const _Future_impl&) = delete; + _Future_impl& operator=(const _Future_impl&) = delete; + + // functions to check state and wait for ready + bool is_ready() const { return this->_M_state->is_ready(); } + + bool has_exception() const { return this->_M_state->has_exception(); } + + bool has_value() const { return this->_M_state->has_value(); } + + void wait() const { this->_M_state->wait(); } + + template<typename _Rep, typename _Period> + bool + wait_for(const chrono::duration<_Rep, _Period>& __rel) const + { return this->_M_state->wait_for(__rel); } + + template<typename _Clock, typename _Duration> + bool + wait_until(const chrono::time_point<_Clock, _Duration>& __abs) const + { return this->_M_state->wait_until(__abs); } + + protected: + // wait for the state to be ready and rethrow any stored exception + _Future_result<_Result>& + _M_get_result() + { + _Future_result_base& __res = this->_M_state->wait(); + if (!(__res._M_error == 0)) + rethrow_exception(__res._M_error); + return static_cast<_Future_result<_Result>&>(__res); + } + + typedef shared_ptr<_Future_state> _State_ptr; + + // construction of a unique_future by promise::get_future() + explicit + _Future_impl(const _State_ptr& __state) + : _M_state(__state) + { + if (static_cast<bool>(this->_M_state)) + this->_M_state->_M_set_retrieved_flag(); + else + throw future_error(future_errc::future_already_retrieved); + } + + // copy construction from a shared_future + explicit + _Future_impl(const shared_future<_Result>&); + + // move construction from a unique_future + explicit + _Future_impl(unique_future<_Result>&&); + + _State_ptr _M_state; + }; + + /// promise + template<typename _Result> + class promise; + + // primary template for unique_future + template<typename _Result> + class unique_future : public _Future_impl<_Result> + { + typedef _Move_future_result<_Result> _Mover; + + public: + /// Move constructor + unique_future(unique_future&& __uf) : _Base_type(std::move(__uf)) { } + + // disable copying + unique_future(const unique_future&) = delete; + unique_future& operator=(const unique_future&) = delete; + + // retrieving the value + typename _Mover::__rval_type + get() + { return _Mover::_S_move(this->_M_get_result()._M_value()); } + + private: + typedef _Future_impl<_Result> _Base_type; + typedef typename _Base_type::_State_ptr _State_ptr; + + friend class promise<_Result>; + + explicit + unique_future(const _State_ptr& __state) : _Base_type(__state) { } + }; + + // partial specialization for unique_future<R&> + template<typename _Result> + class unique_future<_Result&> : public _Future_impl<_Result&> + { + public: + /// Move constructor + unique_future(unique_future&& __uf) : _Base_type(std::move(__uf)) { } + + // disable copying + unique_future(const unique_future&) = delete; + unique_future& operator=(const unique_future&) = delete; + + // retrieving the value + _Result& get() { return *this->_M_get_result()._M_value_ptr; } + + private: + typedef _Future_impl<_Result&> _Base_type; + typedef typename _Base_type::_State_ptr _State_ptr; + + friend class promise<_Result&>; + + explicit + unique_future(const _State_ptr& __state) : _Base_type(__state) { } + }; + + // specialization for unique_future<void> + template<> + class unique_future<void> : public _Future_impl<void> + { + public: + /// Move constructor + unique_future(unique_future&& __uf) : _Base_type(std::move(__uf)) { } + + // disable copying + unique_future(const unique_future&) = delete; + unique_future& operator=(const unique_future&) = delete; + + // retrieving the value + void get() { this->_M_get_result(); } + + private: + typedef _Future_impl<void> _Base_type; + typedef _Base_type::_State_ptr _State_ptr; + + friend class promise<void>; + + explicit + unique_future(const _State_ptr& __state) : _Base_type(__state) { } + }; + + // primary template for unique_future + template<typename _Result> + class shared_future : public _Future_impl<_Result> + { + public: + /// Copy constructor + shared_future(const shared_future& __sf) : _Base_type(__sf) { } + + /// Construct from a unique_future rvalue + shared_future(unique_future<_Result>&& __uf) + : _Base_type(std::move(__uf)) + { } + + shared_future& operator=(const shared_future&) = delete; + + // retrieving the value + const _Result& + get() + { return this->_M_get_result()._M_value(); } + + private: + typedef _Future_impl<_Result> _Base_type; + }; + + // partial specialization for shared_future<R&> + template<typename _Result> + class shared_future<_Result&> : public _Future_impl<_Result&> + { + public: + /// Copy constructor + shared_future(const shared_future& __sf) : _Base_type(__sf) { } + + /// Construct from a unique_future rvalue + shared_future(unique_future<_Result&>&& __uf) + : _Base_type(std::move(__uf)) + { } + + shared_future& operator=(const shared_future&) = delete; + + // retrieving the value + _Result& get() { return *this->_M_get_result()._M_value_ptr; } + + private: + typedef _Future_impl<_Result&> _Base_type; + }; + + // specialization for shared_future<void> + template<> + class shared_future<void> : public _Future_impl<void> + { + public: + /// Copy constructor + shared_future(const shared_future& __sf) : _Base_type(__sf) { } + + /// Construct from a unique_future rvalue + shared_future(unique_future<void>&& __uf) + : _Base_type(std::move(__uf)) + { } + + shared_future& operator=(const shared_future&) = delete; + + // retrieving the value + void get() { this->_M_get_result(); } + + private: + typedef _Future_impl<void> _Base_type; + }; + + // now we can define the protected _Future_impl constructors + + template<typename _Result> + _Future_impl<_Result>::_Future_impl(const shared_future<_Result>& __sf) + : _M_state(__sf._M_state) + { } + + template<typename _Result> + _Future_impl<_Result>::_Future_impl(unique_future<_Result>&& __uf) + : _M_state(std::move(__uf._M_state)) + { } + + template<typename> class packaged_task; // undefined + + // primary template for promise + template<typename _Result> + class promise + { + public: + promise() + : _M_future(std::make_shared<_Future_state>()), + _M_storage(new _Future_result<_Result>()) + { } + + promise(promise&& __rhs) + : _M_future(std::move(__rhs._M_future)), + _M_storage(std::move(__rhs._M_storage)) + { } + + // TODO: requires allocator concepts + /* + template<typename _Allocator> + promise(allocator_arg_t, const _Allocator& __a); + + template<typename _Allocator> + promise(allocator_arg_t, const _Allocator&, promise&& __rhs); + */ + + promise(const promise&) = delete; + + ~promise() + { + if (static_cast<bool>(_M_future) && !_M_future.unique()) + _M_future->_M_break_promise(std::move(_M_storage)); + } + + // assignment + promise& + operator=(promise&& __rhs) + { + promise(std::move(__rhs)).swap(*this); + return *this; + } + + promise& operator=(const promise&) = delete; + + void + swap(promise& __rhs) + { + _M_future.swap(__rhs._M_future); + _M_storage.swap(__rhs._M_storage); + } + + // retrieving the result + unique_future<_Result> + get_future() + { return unique_future<_Result>(_M_future); } + + // setting the result + void + set_value(const _Result& __r) + { + if (!_M_satisfied()) + _M_storage->_M_set(__r); + _M_future->_M_set_result(std::move(_M_storage)); + } + + void + set_value(_Result&& __r) + { + if (!_M_satisfied()) + _M_storage->_M_set(_Mover::_S_move(__r)); + _M_future->_M_set_result(std::move(_M_storage)); + } + + void + set_exception(exception_ptr __p) + { + if (!_M_satisfied()) + _M_storage->_M_error = __p; + _M_future->_M_set_result(std::move(_M_storage)); + } + + private: + template<typename> friend class packaged_task; + typedef _Move_future_result<_Result> _Mover; + bool _M_satisfied() { return !static_cast<bool>(_M_storage); } + shared_ptr<_Future_state> _M_future; + typename _Future_ptr<_Future_result<_Result>>::type _M_storage; + }; + + // partial specialization for promise<R&> + template<typename _Result> + class promise<_Result&> + { + public: + promise() + : _M_future(std::make_shared<_Future_state>()), + _M_storage(new _Future_result<_Result&>()) + { } + + promise(promise&& __rhs) + : _M_future(std::move(__rhs._M_future)), + _M_storage(std::move(__rhs._M_storage)) + { } + + // TODO: requires allocator concepts + /* + template<typename _Allocator> + promise(allocator_arg_t, const _Allocator& __a); + + template<typename _Allocator> + promise(allocator_arg_t, const _Allocator&, promise&& __rhs); + */ + + promise(const promise&) = delete; + + ~promise() + { + if (static_cast<bool>(_M_future) && !_M_future.unique()) + _M_future->_M_break_promise(std::move(_M_storage)); + } + + // assignment + promise& + operator=(promise&& __rhs) + { + promise(std::move(__rhs)).swap(*this); + return *this; + } + + promise& operator=(const promise&) = delete; + + void + swap(promise& __rhs) + { + _M_future.swap(__rhs._M_future); + _M_storage.swap(__rhs._M_storage); + } + + // retrieving the result + unique_future<_Result&> + get_future() + { return unique_future<_Result&>(_M_future); } + + // setting the result + void + set_value(_Result& __r) + { + if (!_M_satisfied()) + _M_storage->_M_value_ptr = &__r; + _M_future->_M_set_result(std::move(_M_storage)); + } + + void + set_exception(exception_ptr __p) + { + if (!_M_satisfied()) + _M_storage->_M_error = __p; + _M_future->_M_set_result(std::move(_M_storage)); + } + + private: + template<typename> friend class packaged_task; + bool _M_satisfied() { return !static_cast<bool>(_M_storage); } + shared_ptr<_Future_state> _M_future; + typename _Future_ptr<_Future_result<_Result&>>::type _M_storage; + }; + + // specialization for promise<void> + template<> + class promise<void> + { + public: + promise() + : _M_future(std::make_shared<_Future_state>()), + _M_storage(new _Future_result<void>()) + { } + + promise(promise&& __rhs) + : _M_future(std::move(__rhs._M_future)), + _M_storage(std::move(__rhs._M_storage)) + { } + + // TODO: requires allocator concepts + /* + template<typename _Allocator> + promise(allocator_arg_t, const _Allocator& __a); + + template<typename _Allocator> + promise(allocator_arg_t, const _Allocator&, promise&& __rhs); + */ + + promise(const promise&) = delete; + + ~promise() + { + if (static_cast<bool>(_M_future) && !_M_future.unique()) + _M_future->_M_break_promise(std::move(_M_storage)); + } + + // assignment + promise& + operator=(promise&& __rhs) + { + promise(std::move(__rhs)).swap(*this); + return *this; + } + + promise& operator=(const promise&) = delete; + + void + swap(promise& __rhs) + { + _M_future.swap(__rhs._M_future); + _M_storage.swap(__rhs._M_storage); + } + + // retrieving the result + unique_future<void> + get_future() + { return unique_future<void>(_M_future); } + + // setting the result + void + set_value() + { + _M_future->_M_set_result(std::move(_M_storage)); + } + + void + set_exception(exception_ptr __p) + { + if (!_M_satisfied()) + _M_storage->_M_error = __p; + _M_future->_M_set_result(std::move(_M_storage)); + } + + private: + template<typename> friend class packaged_task; + bool _M_satisfied() { return !static_cast<bool>(_M_storage); } + shared_ptr<_Future_state> _M_future; + _Future_ptr<_Future_result<void>>::type _M_storage; + }; + + // TODO: requires allocator concepts + /* + template<typename _Result, class Alloc> + concept_map UsesAllocator<promise<_Result>, Alloc> + { + typedef Alloc allocator_type; + } + */ + + template<typename _Result, typename... _ArgTypes> + struct _Run_task + { + static void + _S_run(promise<_Result>& __p, function<_Result(_ArgTypes...)>& __f, + _ArgTypes... __args) + { + __p.set_value(__f(std::forward<_ArgTypes>(__args)...)); + } + }; + + // specialization used by packaged_task<void(...)> + template<typename... _ArgTypes> + struct _Run_task<void, _ArgTypes...> + { + static void + _S_run(promise<void>& __p, function<void(_ArgTypes...)>& __f, + _ArgTypes... __args) + { + __f(std::forward<_ArgTypes>(__args)...); + __p.set_value(); + } + }; + + template<typename _Result, typename... _ArgTypes> + class packaged_task<_Result(_ArgTypes...)> + { + public: + typedef _Result result_type; + + // construction and destruction + packaged_task() { } + + template<typename _Fn> + explicit + packaged_task(const _Fn& __fn) : _M_task(__fn) { } + + template<typename _Fn> + explicit + packaged_task(_Fn&& __fn) : _M_task(std::move(__fn)) { } + + explicit + packaged_task(_Result(*__fn)(_ArgTypes...)) : _M_task(__fn) { } + + // TODO: requires allocator concepts + /* + template<typename _Fn, typename _Allocator> + explicit + packaged_task(allocator_arg_t __tag, const _Allocator& __a, _Fn __fn) + : _M_task(__tag, __a, __fn), _M_promise(__tag, __a) + { } + + template<typename _Fn, typename _Allocator> + explicit + packaged_task(allocator_arg_t __tag, const _Allocator& __a, _Fn&& __fn) + : _M_task(__tag, __a, std::move(__fn)), _M_promise(__tag, __a) + { } + */ + + ~packaged_task() = default; + + // no copy + packaged_task(packaged_task&) = delete; + packaged_task& operator=(packaged_task&) = delete; + + // move support + packaged_task(packaged_task&& __other) + { this->swap(__other); } + + packaged_task& operator=(packaged_task&& __other) + { + packaged_task(std::move(__other)).swap(*this); + return *this; + } + + void + swap(packaged_task& __other) + { + _M_task.swap(__other._M_task); + _M_promise.swap(__other._M_promise); + } + + explicit operator bool() const { return static_cast<bool>(_M_task); } + + // result retrieval + unique_future<_Result> + get_future() + { + try + { + return _M_promise.get_future(); + } + catch (const future_error& __e) + { + if (__e.code() == future_errc::future_already_retrieved) + throw std::bad_function_call(); + throw; + } + } + + // execution + void + operator()(_ArgTypes... __args) + { + if (!static_cast<bool>(_M_task) || _M_promise._M_satisfied()) + throw std::bad_function_call(); + try + { + _Run_task<_Result, _ArgTypes...>::_S_run(_M_promise, _M_task, + std::forward<_ArgTypes>(__args)...); + } + catch (...) + { + _M_promise.set_exception(current_exception()); + } + } + + void reset() { promise<_Result>().swap(_M_promise); } + + private: + function<_Result(_ArgTypes...)> _M_task; + promise<_Result> _M_promise; + }; + + // @} group futures +} + +#endif // _GLIBCXX_HAS_GTHREADS && _GLIBCXX_USE_C99_STDINT_TR1 + // && _GLIBCXX_ATOMIC_BUILTINS_4 + +#endif // __GXX_EXPERIMENTAL_CXX0X__ + +#endif // _GLIBCXX_FUTURE diff --git a/libstdc++-v3/src/Makefile.am b/libstdc++-v3/src/Makefile.am index d218ceaa9ca..4295d4dda66 100644 --- a/libstdc++-v3/src/Makefile.am +++ b/libstdc++-v3/src/Makefile.am @@ -189,6 +189,7 @@ sources = \ condition_variable.cc \ chrono.cc \ thread.cc \ + future.cc \ ${host_sources} \ ${host_sources_extra} @@ -297,6 +298,11 @@ thread.lo: thread.cc thread.o: thread.cc $(CXXCOMPILE) -std=gnu++0x -c $< +future.lo: future.cc + $(LTCXXCOMPILE) -std=gnu++0x -c $< +future.o: future.cc + $(CXXCOMPILE) -std=gnu++0x -c $< + if GLIBCXX_LDBL_COMPAT # Use special rules for compatibility-ldbl.cc compilation, as we need to # pass -mlong-double-64. diff --git a/libstdc++-v3/src/Makefile.in b/libstdc++-v3/src/Makefile.in index 2da69a5d030..e9d5824dc4b 100644 --- a/libstdc++-v3/src/Makefile.in +++ b/libstdc++-v3/src/Makefile.in @@ -87,10 +87,11 @@ am__libstdc___la_SOURCES_DIST = atomic.cc bitmap_allocator.cc \ ostream-inst.cc sstream-inst.cc streambuf-inst.cc streambuf.cc \ string-inst.cc valarray-inst.cc wlocale-inst.cc \ wstring-inst.cc mutex.cc condition_variable.cc chrono.cc \ - thread.cc atomicity.cc codecvt_members.cc collate_members.cc \ - ctype_members.cc messages_members.cc monetary_members.cc \ - numeric_members.cc time_members.cc basic_file.cc c++locale.cc \ - compatibility-ldbl.cc parallel_list.cc parallel_settings.cc + thread.cc future.cc atomicity.cc codecvt_members.cc \ + collate_members.cc ctype_members.cc messages_members.cc \ + monetary_members.cc numeric_members.cc time_members.cc \ + basic_file.cc c++locale.cc compatibility-ldbl.cc \ + parallel_list.cc parallel_settings.cc am__objects_1 = atomicity.lo codecvt_members.lo collate_members.lo \ ctype_members.lo messages_members.lo monetary_members.lo \ numeric_members.lo time_members.lo @@ -113,7 +114,7 @@ am__objects_5 = atomic.lo bitmap_allocator.lo pool_allocator.lo \ ostream-inst.lo sstream-inst.lo streambuf-inst.lo streambuf.lo \ string-inst.lo valarray-inst.lo wlocale-inst.lo \ wstring-inst.lo mutex.lo condition_variable.lo chrono.lo \ - thread.lo $(am__objects_1) $(am__objects_4) + thread.lo future.lo $(am__objects_1) $(am__objects_4) am_libstdc___la_OBJECTS = $(am__objects_5) libstdc___la_OBJECTS = $(am_libstdc___la_OBJECTS) DEFAULT_INCLUDES = -I. -I$(srcdir) -I$(top_builddir) @@ -432,6 +433,7 @@ sources = \ condition_variable.cc \ chrono.cc \ thread.cc \ + future.cc \ ${host_sources} \ ${host_sources_extra} @@ -899,6 +901,11 @@ thread.lo: thread.cc thread.o: thread.cc $(CXXCOMPILE) -std=gnu++0x -c $< +future.lo: future.cc + $(LTCXXCOMPILE) -std=gnu++0x -c $< +future.o: future.cc + $(CXXCOMPILE) -std=gnu++0x -c $< + # Use special rules for compatibility-ldbl.cc compilation, as we need to # pass -mlong-double-64. @GLIBCXX_LDBL_COMPAT_TRUE@compatibility-ldbl.lo: compatibility-ldbl.cc diff --git a/libstdc++-v3/src/future.cc b/libstdc++-v3/src/future.cc new file mode 100644 index 00000000000..ab9d5dbcc69 --- /dev/null +++ b/libstdc++-v3/src/future.cc @@ -0,0 +1,73 @@ +// future -*- C++ -*- + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// Under Section 7 of GPL version 3, you are granted additional +// permissions described in the GCC Runtime Library Exception, version +// 3.1, as published by the Free Software Foundation. + +// You should have received a copy of the GNU General Public License and +// a copy of the GCC Runtime Library Exception along with this program; +// see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +// <http://www.gnu.org/licenses/>. + +#include <future> + +#if defined(_GLIBCXX_HAS_GTHREADS) && defined(_GLIBCXX_USE_C99_STDINT_TR1) \ + && defined(_GLIBCXX_ATOMIC_BUILTINS_4) +namespace +{ + struct future_error_category : public std::error_category + { + virtual const char* + name() const + { return "future"; } + + virtual std::string message(int __ec) const + { + std::string __msg; + switch (std::future_errc(__ec)) + { + case std::future_errc::broken_promise: + __msg = "Broken promise"; + break; + case std::future_errc::future_already_retrieved: + __msg = "Future already retrieved"; + break; + case std::future_errc::promise_already_satisfied: + __msg = "Promise already satisfied"; + break; + default: + __msg = "Unknown error"; + break; + } + return __msg; + } + }; + + const future_error_category& + __future_category_instance() + { + static const future_error_category __fec; + return __fec; + } +} + +namespace std +{ + const error_category* const future_category = &__future_category_instance(); +} + +#endif // _GLIBCXX_HAS_GTHREADS && _GLIBCXX_USE_C99_STDINT_TR1 + // && _GLIBCXX_ATOMIC_BUILTINS_4 diff --git a/libstdc++-v3/testsuite/26_numerics/random/uniform_int_distribution/cons/default.cc b/libstdc++-v3/testsuite/26_numerics/random/uniform_int_distribution/cons/default.cc index c1bfc04b0e1..0e83565e0de 100644 --- a/libstdc++-v3/testsuite/26_numerics/random/uniform_int_distribution/cons/default.cc +++ b/libstdc++-v3/testsuite/26_numerics/random/uniform_int_distribution/cons/default.cc @@ -23,6 +23,7 @@ // 26.4.2.4 Concept RandomNumberDistribution [rand.concept.dist] #include <random> +#include <limits> #include <testsuite_hooks.h> void @@ -32,9 +33,9 @@ test01() std::uniform_int_distribution<int> u; VERIFY( u.a() == 0 ); - VERIFY( u.b() == 9 ); + VERIFY( u.b() == std::numeric_limits<int>::max() ); VERIFY( u.min() == 0 ); - VERIFY( u.max() == 9 ); + VERIFY( u.max() == std::numeric_limits<int>::max() ); } int main() diff --git a/libstdc++-v3/testsuite/30_threads/headers/future/std_c++0x_neg.cc b/libstdc++-v3/testsuite/30_threads/headers/future/std_c++0x_neg.cc new file mode 100644 index 00000000000..5f021b8e5ac --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/headers/future/std_c++0x_neg.cc @@ -0,0 +1,26 @@ +// { dg-do compile } +// { dg-options "-std=gnu++98" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +#include <future> // { dg-excess-errors "In file included from" } + +// { dg-error "upcoming ISO" "" { target *-*-* } 31 } + + + diff --git a/libstdc++-v3/testsuite/30_threads/headers/future/types_std_c++0x.cc b/libstdc++-v3/testsuite/30_threads/headers/future/types_std_c++0x.cc new file mode 100644 index 00000000000..16a54b4147a --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/headers/future/types_std_c++0x.cc @@ -0,0 +1,49 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. +// +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + +#include <future> + +void test01() +{ + typedef std::future_errc errc_t; + + using std::future_category; + + typedef std::future_error error_t; + + typedef std::unique_future<int> uniq_t; + typedef std::unique_future<int&> uniqr_t; + typedef std::unique_future<void> uniqv_t; + + typedef std::shared_future<int> shar_t; + typedef std::shared_future<int&> sharr_t; + typedef std::shared_future<void> sharv_t; + + typedef std::promise<int> promise_t; + typedef std::promise<int&> promiser_t; + typedef std::promise<void> promisev_t; + + typedef std::packaged_task<int> ptask_t; + typedef std::packaged_task<int&> ptaskr_t; + typedef std::packaged_task<void> ptaskv_t; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/cons/1.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/1.cc new file mode 100644 index 00000000000..a2414333e22 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/1.cc @@ -0,0 +1,53 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> +#include <testsuite_tr1.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + using std::packaged_task; + using namespace __gnu_test; + + packaged_task<int ()> p1; + VERIFY( !static_cast<bool>(p1) ); + packaged_task<int& ()> p2; + VERIFY( !static_cast<bool>(p2) ); + packaged_task<void ()> p3; + VERIFY( !static_cast<bool>(p3) ); + packaged_task<ClassType ()> p4; + VERIFY( !static_cast<bool>(p4) ); + packaged_task<AbstractClass& (int)> p5; + VERIFY( !static_cast<bool>(p5) ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/cons/2.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/2.cc new file mode 100644 index 00000000000..98f5de73c4d --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/2.cc @@ -0,0 +1,64 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> +#include <testsuite_tr1.h> + +using namespace __gnu_test; + +int f1() { return 0; } +int& f2() { static int i; return i; } +void f3() { } +ClassType f4() { return ClassType(); } + +struct Derived : AbstractClass { + void rotate(int) { } + Derived& operator()(int i) { rotate(i); return *this; } +} f5; + +void test01() +{ + bool test __attribute__((unused)) = true; + using std::packaged_task; + + packaged_task<int ()> p1(f1); + VERIFY( static_cast<bool>(p1) ); + packaged_task<int& ()> p2(f2); + VERIFY( static_cast<bool>(p2) ); + packaged_task<void ()> p3(f3); + VERIFY( static_cast<bool>(p3) ); + packaged_task<ClassType ()> p4(f4); + VERIFY( static_cast<bool>(p4) ); + packaged_task<AbstractClass& (int)> p5(f5); + VERIFY( static_cast<bool>(p5) ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/cons/assign_neg.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/assign_neg.cc new file mode 100644 index 00000000000..5f02dea0156 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/assign_neg.cc @@ -0,0 +1,36 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +void test01() +{ + // assign + std::packaged_task<int()> p1; + std::packaged_task<int()> p2; + p1 = p2; +} + +// { dg-error "used here" "" { target *-*-* } 32 } +// { dg-error "deleted function" "" { target *-*-* } 856 } diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/cons/copy_neg.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/copy_neg.cc new file mode 100644 index 00000000000..6a50d7802aa --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/copy_neg.cc @@ -0,0 +1,35 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +void test01() +{ + // copy + std::packaged_task<int()> p1; + std::packaged_task<int()> p2(p1); +} + +// { dg-error "used here" "" { target *-*-* } 31 } +// { dg-error "deleted function" "" { target *-*-* } 855 } diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/cons/move.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/move.cc new file mode 100644 index 00000000000..5335db39949 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/move.cc @@ -0,0 +1,49 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int f1() { return 0; } + +void test01() +{ + bool test __attribute__((unused)) = true; + using namespace std; + + // move + packaged_task<int()> p1(f1); + packaged_task<int()> p2(std::move(p1)); + VERIFY( !static_cast<bool>(p1) ); + VERIFY( static_cast<bool>(p2) ); +} + +int main() +{ + test01(); + return 0; +} + diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/cons/move_assign.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/move_assign.cc new file mode 100644 index 00000000000..c23e5e3b72b --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/cons/move_assign.cc @@ -0,0 +1,49 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int gen() { return 0; } + +void test01() +{ + bool test __attribute__((unused)) = true; + + // move assign + std::packaged_task<int()> p1; + std::packaged_task<int()> p2(gen); + p1 = std::move(p2); + VERIFY( static_cast<bool>(p1) ); + VERIFY( !static_cast<bool>(p2) ); +} + +int main() +{ + test01(); + return 0; +} + diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/boolconv.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/boolconv.cc new file mode 100644 index 00000000000..c332b85741d --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/boolconv.cc @@ -0,0 +1,47 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int zero() { return 0; } + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::packaged_task<int()> p1; + VERIFY( !static_cast<bool>(p1) ); + + std::packaged_task<int()> p2(zero); + VERIFY( static_cast<bool>(p2) ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/get_future.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/get_future.cc new file mode 100644 index 00000000000..c1bc129e26f --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/get_future.cc @@ -0,0 +1,55 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int& inc(int& i) { return ++i; } + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::packaged_task<int&(int&)> p1(inc); + std::unique_future<int&> f1 = p1.get_future(); + + VERIFY( !f1.is_ready() ); + + int i1 = 0; + + p1(i1); + + int& i2 = f1.get(); + + VERIFY( &i1 == &i2 ); + VERIFY( i1 == 1 ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/get_future2.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/get_future2.cc new file mode 100644 index 00000000000..a6c9c61e5c8 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/get_future2.cc @@ -0,0 +1,57 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <system_error> +#include <testsuite_hooks.h> + +int& inc(int& i) { return ++i; } + +void test01() +{ + bool test = false; + + std::packaged_task<int&(int&)> p1(inc); + p1.get_future(); + + try + { + p1.get_future(); + VERIFY( false ); + } + catch (std::bad_function_call&) + { + test = true; + } + + VERIFY( test ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke.cc new file mode 100644 index 00000000000..2797b0606bd --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke.cc @@ -0,0 +1,49 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int zero() { return 0; } + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::packaged_task<int()> p1(zero); + std::unique_future<int> f1 = p1.get_future(); + + p1(); + + VERIFY( static_cast<bool>(p1) ); + VERIFY( f1.has_value() ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke2.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke2.cc new file mode 100644 index 00000000000..fae15dcac65 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke2.cc @@ -0,0 +1,56 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +bool odd(unsigned i) { return i%2; } + +void test01() +{ + bool test = false; + + std::packaged_task<bool(unsigned)> p1(odd); + + p1(5); + + try + { + p1(4); + } + catch (std::bad_function_call&) + { + test = true; + } + + VERIFY( test ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke3.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke3.cc new file mode 100644 index 00000000000..91d43413d35 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke3.cc @@ -0,0 +1,60 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int& inc(int& i) { ++i; return i; } + +void test01() +{ + bool test = false; + + std::packaged_task<void(int&)> p1(inc); + + int i1 = 0; + p1(i1); + + VERIFY( i1 == 1 ); + + try + { + p1(i1); + } + catch (std::bad_function_call&) + { + test = true; + } + + VERIFY( i1 == 1 ); + VERIFY( test ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke4.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke4.cc new file mode 100644 index 00000000000..eefb313b7a4 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke4.cc @@ -0,0 +1,48 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void thrower() { throw 0; } + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::packaged_task<void()> p1(thrower); + std::unique_future<void> f1 = p1.get_future(); + + p1(); + + VERIFY( f1.has_exception() ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke5.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke5.cc new file mode 100644 index 00000000000..925dc108fe9 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/invoke5.cc @@ -0,0 +1,51 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <thread> +#include <testsuite_hooks.h> + +void noop() { } +void waiter(std::shared_future<void> f) { f.wait(); } + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::packaged_task<void()> p1(noop); + std::shared_future<void> f1(p1.get_future()); + std::thread t1(waiter, f1); + + p1(); + + t1.join(); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/reset.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/reset.cc new file mode 100644 index 00000000000..66b9f3da669 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/reset.cc @@ -0,0 +1,65 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <system_error> +#include <testsuite_hooks.h> + +int zero() { return 0; } + +void test01() +{ + bool test = false; + using namespace std; + + packaged_task<int()> p1(zero); + unique_future<int> f1 = p1.get_future(); + + p1.reset(); + VERIFY( static_cast<bool>(p1) ); + + unique_future<int> f2 = p1.get_future(); + VERIFY( !f2.is_ready() ); + + VERIFY( f1.has_exception() ); + try + { + f1.get(); + } + catch (future_error& e) + { + VERIFY( e.code() == make_error_code(future_errc::broken_promise) ); + test = true; + } + + VERIFY( test ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/reset2.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/reset2.cc new file mode 100644 index 00000000000..69ee9a99213 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/reset2.cc @@ -0,0 +1,53 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int zero() { return 0; } + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::packaged_task<int()> p1(zero); + std::unique_future<int> f1 = p1.get_future(); + + p1(); + p1.reset(); + + VERIFY( static_cast<bool>(p1) ); + VERIFY( f1.has_value() ); + + std::unique_future<int> f2 = p1.get_future(); + VERIFY( !f2.is_ready() ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/members/swap.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/members/swap.cc new file mode 100644 index 00000000000..ced2a00529a --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/members/swap.cc @@ -0,0 +1,49 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int zero() { return 0; } + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::packaged_task<int()> p1(zero); + std::packaged_task<int()> p2; + VERIFY( static_cast<bool>(p1) ); + VERIFY( !static_cast<bool>(p2) ); + p1.swap(p2); + VERIFY( !static_cast<bool>(p1) ); + VERIFY( static_cast<bool>(p2) ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/packaged_task/requirements/explicit_instantiation.cc b/libstdc++-v3/testsuite/30_threads/packaged_task/requirements/explicit_instantiation.cc new file mode 100644 index 00000000000..4d55603c83e --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/packaged_task/requirements/explicit_instantiation.cc @@ -0,0 +1,34 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_tr1.h> + +using namespace __gnu_test; +using std::packaged_task; +template class packaged_task<int()>; +template class packaged_task<int&()>; +template class packaged_task<void()>; +template class packaged_task<ClassType(int)>; +template class packaged_task<AbstractClass&(int)>; diff --git a/libstdc++-v3/testsuite/30_threads/promise/cons/1.cc b/libstdc++-v3/testsuite/30_threads/promise/cons/1.cc new file mode 100644 index 00000000000..79120b7cd2b --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/cons/1.cc @@ -0,0 +1,46 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_tr1.h> + +void test01() +{ + using std::promise; + using namespace __gnu_test; + + promise<int> p1; + promise<int&> p2; + promise<void> p3; + promise<ClassType> p4; + promise<AbstractClass&> p5; +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/cons/assign_neg.cc b/libstdc++-v3/testsuite/30_threads/promise/cons/assign_neg.cc new file mode 100644 index 00000000000..0c77173d0bd --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/cons/assign_neg.cc @@ -0,0 +1,36 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +void test01() +{ + // assign + std::promise<int> p1; + std::promise<int> p2; + p1 = p2; +} + +// { dg-error "used here" "" { target *-*-* } 32 } +// { dg-error "deleted function" "" { target *-*-* } 583 } diff --git a/libstdc++-v3/testsuite/30_threads/promise/cons/copy_neg.cc b/libstdc++-v3/testsuite/30_threads/promise/cons/copy_neg.cc new file mode 100644 index 00000000000..867c4be3133 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/cons/copy_neg.cc @@ -0,0 +1,35 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +void test01() +{ + // copy + std::promise<int> p1; + std::promise<int> p2(p1); +} + +// { dg-error "used here" "" { target *-*-* } 31 } +// { dg-error "deleted function" "" { target *-*-* } 567 } diff --git a/libstdc++-v3/testsuite/30_threads/promise/cons/move.cc b/libstdc++-v3/testsuite/30_threads/promise/cons/move.cc new file mode 100644 index 00000000000..8b1e1399801 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/cons/move.cc @@ -0,0 +1,55 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + using namespace std; + + // move assign + promise<int> p1; + p1.set_value(3); + promise<int> p2(std::move(p1)); + VERIFY( p2.get_future().get() == 3 ); + try + { + p1.get_future(); + VERIFY( false ); + } + catch (std::future_error& e) + { + VERIFY(e.code() == make_error_code(future_errc::future_already_retrieved)); + } +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/cons/move_assign.cc b/libstdc++-v3/testsuite/30_threads/promise/cons/move_assign.cc new file mode 100644 index 00000000000..c5bda4d3560 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/cons/move_assign.cc @@ -0,0 +1,56 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + using namespace std; + + // move assign + promise<int> p1; + p1.set_value(3); + promise<int> p2; + p2 = move(p1); + VERIFY( p2.get_future().get() == 3 ); + try + { + p1.get_future(); + VERIFY( false ); + } + catch (future_error& e) + { + VERIFY(e.code() == make_error_code(future_errc::future_already_retrieved)); + } +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/members/get_future.cc b/libstdc++-v3/testsuite/30_threads/promise/members/get_future.cc new file mode 100644 index 00000000000..7e969908a99 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/members/get_future.cc @@ -0,0 +1,52 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int&> p1; + std::unique_future<int&> f1 = p1.get_future(); + + VERIFY( !f1.is_ready() ); + + int i1 = 0; + + p1.set_value(i1); + + int& i2 = f1.get(); + + VERIFY( &i1 == &i2 ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/members/get_future2.cc b/libstdc++-v3/testsuite/30_threads/promise/members/get_future2.cc new file mode 100644 index 00000000000..cc44fc47919 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/members/get_future2.cc @@ -0,0 +1,57 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <system_error> +#include <testsuite_hooks.h> + +void test01() +{ + bool test = false; + using namespace std; + + promise<int&> p1; + p1.get_future(); + + try + { + p1.get_future(); + VERIFY( false ); + } + catch (future_error& e) + { + VERIFY(e.code() == make_error_code(future_errc::future_already_retrieved)); + test = true; + } + + VERIFY( test ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/members/set_exception.cc b/libstdc++-v3/testsuite/30_threads/promise/members/set_exception.cc new file mode 100644 index 00000000000..e5b8f60aa3a --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/members/set_exception.cc @@ -0,0 +1,49 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1 = p1.get_future(); + + VERIFY( !f1.is_ready() ); + + p1.set_exception(std::copy_exception(0)); + + VERIFY( f1.has_exception() ); + VERIFY( !f1.has_value() ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/members/set_exception2.cc b/libstdc++-v3/testsuite/30_threads/promise/members/set_exception2.cc new file mode 100644 index 00000000000..3bbe28d48da --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/members/set_exception2.cc @@ -0,0 +1,95 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test = false; + + std::promise<int> p1; + std::unique_future<int> f1 = p1.get_future(); + + p1.set_exception(std::copy_exception(0)); + + try + { + p1.set_exception(std::copy_exception(1)); + VERIFY( false ); + } + catch (std::future_error& e) + { + VERIFY(e.code() == + std::make_error_code(std::future_errc::promise_already_satisfied)); + test = true; + } + + try + { + f1.get(); + test = false; + } + catch(int i) + { + VERIFY( i == 0 ); + } + + VERIFY( test ); +} + +void test02() +{ + bool test = false; + + std::promise<int> p1; + std::unique_future<int> f1 = p1.get_future(); + + p1.set_value(2); + + try + { + p1.set_exception(std::copy_exception(0)); + VERIFY( false ); + } + catch (std::future_error& e) + { + VERIFY(e.code() == + std::make_error_code(std::future_errc::promise_already_satisfied)); + test = true; + } + + VERIFY( f1.has_value() ); + VERIFY( !f1.has_exception() ); + VERIFY( test ); +} + +int main() +{ + test01(); + test02(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/members/set_value.cc b/libstdc++-v3/testsuite/30_threads/promise/members/set_value.cc new file mode 100644 index 00000000000..978ef1914b0 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/members/set_value.cc @@ -0,0 +1,105 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> +#include <testsuite_rvalref.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1 = p1.get_future(); + + VERIFY( !f1.is_ready() ); + + p1.set_value(0); + + int&& i1 = f1.get(); + + VERIFY( i1 == 0 ); +} + +void test02() +{ + bool test __attribute__((unused)) = true; + using __gnu_test::rvalstruct; + + std::promise<rvalstruct> p1; + std::unique_future<rvalstruct> f1 = p1.get_future(); + + VERIFY( !f1.is_ready() ); + + p1.set_value(rvalstruct(1)); + + rvalstruct r1(f1.get()); + + VERIFY( r1.valid ); + VERIFY( r1.val == 1 ); +} + + +void test03() +{ + bool test __attribute__((unused)) = true; + + std::promise<int&> p1; + std::unique_future<int&> f1 = p1.get_future(); + + VERIFY( !f1.is_ready() ); + + int i1 = 0; + p1.set_value(i1); + int& i2 = f1.get(); + + VERIFY( &i1 == &i2 ); +} + +void test04() +{ + bool test __attribute__((unused)) = true; + + std::promise<void> p1; + std::unique_future<void> f1 = p1.get_future(); + + VERIFY( !f1.is_ready() ); + + p1.set_value(); + f1.get(); + + VERIFY( f1.is_ready() ); +} + +int main() +{ + test01(); + test02(); + test03(); + test04(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/members/set_value2.cc b/libstdc++-v3/testsuite/30_threads/promise/members/set_value2.cc new file mode 100644 index 00000000000..58e2fe813e4 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/members/set_value2.cc @@ -0,0 +1,88 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test = false; + + std::promise<int> p1; + std::unique_future<int> f1 = p1.get_future(); + + p1.set_value(1); + + try + { + p1.set_value(2); + VERIFY( false ); + } + catch (std::future_error& e) + { + VERIFY(e.code() == + std::make_error_code(std::future_errc::promise_already_satisfied)); + test = true; + } + + VERIFY( f1.has_value() ); + VERIFY( f1.get() == 1 ); + VERIFY( test ); +} + +void test02() +{ + bool test = false; + + std::promise<int> p1; + std::unique_future<int> f1 = p1.get_future(); + + p1.set_value(3); + + try + { + p1.set_exception(std::copy_exception(4)); + VERIFY( false ); + } + catch (std::future_error& e) + { + VERIFY(e.code() == + std::make_error_code(std::future_errc::promise_already_satisfied)); + test = true; + } + + VERIFY( f1.has_value() ); + VERIFY( !f1.has_exception() ); + VERIFY( f1.get() == 3 ); + VERIFY( test ); +} + +int main() +{ + test01(); + test02(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/members/set_value3.cc b/libstdc++-v3/testsuite/30_threads/promise/members/set_value3.cc new file mode 100644 index 00000000000..92581964e3c --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/members/set_value3.cc @@ -0,0 +1,87 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + + +// Test promise::set_value() for deadlock by checking if the state is ready +// during construction and destruction of the associated state. + +struct tester +{ + tester(int); + tester(const tester&); + tester() = delete; + ~tester(); + tester& operator=(const tester&); +}; + +std::promise<tester> pglobal; +std::unique_future<tester> fglobal = pglobal.get_future(); + +tester::tester(int) +{ + bool test __attribute__((unused)) = true; + VERIFY (!fglobal.is_ready()); +} + +tester::tester(const tester&) +{ + bool test __attribute__((unused)) = true; + // if this copy happens while a mutex is locked next line could deadlock: + VERIFY (!fglobal.is_ready()); +} + +tester& tester::operator=(const tester&) +{ + bool test __attribute__((unused)) = true; + // if this copy happens while a mutex is locked next line could deadlock: + VERIFY (!fglobal.is_ready()); + return *this; +} + +tester::~tester() +{ + bool test __attribute__((unused)) = true; + VERIFY (fglobal.is_ready()); +} + +void test01() +{ + bool test __attribute__((unused)) = true; + + pglobal.set_value( tester(1) ); + + VERIFY( fglobal.is_ready() ); +} + +int main() +{ + test01(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/members/swap.cc b/libstdc++-v3/testsuite/30_threads/promise/members/swap.cc new file mode 100644 index 00000000000..8bfbdfd6c8f --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/members/swap.cc @@ -0,0 +1,46 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::promise<int> p2; + p1.set_value(1); + p1.swap(p2); + VERIFY( !p1.get_future().is_ready() ); + VERIFY( p2.get_future().is_ready() ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/promise/requirements/explicit_instantiation.cc b/libstdc++-v3/testsuite/30_threads/promise/requirements/explicit_instantiation.cc new file mode 100644 index 00000000000..903b3ab146e --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/promise/requirements/explicit_instantiation.cc @@ -0,0 +1,34 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_tr1.h> + +using namespace __gnu_test; +using std::promise; +template class promise<int>; +template class promise<int&>; +template class promise<void>; +template class promise<ClassType>; +template class promise<ClassType&>; diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/cons/assign_neg.cc b/libstdc++-v3/testsuite/30_threads/shared_future/cons/assign_neg.cc new file mode 100644 index 00000000000..7e3c96ffc1e --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/cons/assign_neg.cc @@ -0,0 +1,38 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +extern std::shared_future<int>& get(); + +void test01() +{ + // assign + std::shared_future<int>& p1 = get(); + std::shared_future<int>& p2 = get(); + p1 = p2; +} + +// { dg-error "used here" "" { target *-*-* } 34 } +// { dg-error "deleted function" "" { target *-*-* } 474 } diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/cons/copy.cc b/libstdc++-v3/testsuite/30_threads/shared_future/cons/copy.cc new file mode 100644 index 00000000000..16954a1d4c1 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/cons/copy.cc @@ -0,0 +1,42 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +extern std::unique_future<int>& get(); + +void test01() +{ + using std::shared_future; + + shared_future<int> p1 = get(); + shared_future<int> p2(p1); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/cons/default_neg.cc b/libstdc++-v3/testsuite/30_threads/shared_future/cons/default_neg.cc new file mode 100644 index 00000000000..cc4aadfce6f --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/cons/default_neg.cc @@ -0,0 +1,45 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_tr1.h> + +void test01() +{ + using std::shared_future; + using namespace __gnu_test; + + shared_future<int> p1; // { dg-error "22: error: no match" } + shared_future<int&> p2; // { dg-error "23: error: no match" } + shared_future<void> p3; // { dg-error "23: error: no match" } + shared_future<ClassType> p4; // { dg-error "28: error: no match" } + shared_future<AbstractClass&> p5; // { dg-error "33: error: no match" } +} + +int main() +{ + test01(); + return 0; +} +// { dg-excess-errors "note" } diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/cons/move.cc b/libstdc++-v3/testsuite/30_threads/shared_future/cons/move.cc new file mode 100644 index 00000000000..3494a10463f --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/cons/move.cc @@ -0,0 +1,41 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +void test01() +{ + // construct from rvalue unique_future + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + std::shared_future<int> f2(std::move(f1)); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/members/get.cc b/libstdc++-v3/testsuite/30_threads/shared_future/members/get.cc new file mode 100644 index 00000000000..bf773c31d52 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/members/get.cc @@ -0,0 +1,78 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int value = 99; + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + p1.set_value(value); + VERIFY( f1.get() == value ); + VERIFY( f2.get() == value ); +} + +void test02() +{ + bool test __attribute__((unused)) = true; + + std::promise<int&> p1; + std::shared_future<int&> f1(p1.get_future()); + std::shared_future<int&> f2(f1); + + p1.set_value(value); + VERIFY( &f1.get() == &value ); + VERIFY( &f2.get() == &value ); +} + +void test03() +{ + bool test __attribute__((unused)) = true; + + std::promise<void> p1; + std::shared_future<void> f1(p1.get_future()); + std::shared_future<void> f2(f1); + + p1.set_value(); + f1.get(); + f2.get(); +} + +int main() +{ + test01(); + test02(); + test03(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/members/get2.cc b/libstdc++-v3/testsuite/30_threads/shared_future/members/get2.cc new file mode 100644 index 00000000000..80dd368a973 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/members/get2.cc @@ -0,0 +1,127 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <exception> +#include <testsuite_hooks.h> + +int value = 99; + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + p1.set_exception(std::copy_exception(value)); + try + { + (void) f1.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } + try + { + (void) f2.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } +} + +void test02() +{ + bool test __attribute__((unused)) = true; + + std::promise<int&> p1; + std::shared_future<int&> f1(p1.get_future()); + std::shared_future<int&> f2(f1); + + p1.set_exception(std::copy_exception(value)); + try + { + (void) f1.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } + try + { + (void) f2.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } +} + +void test03() +{ + bool test __attribute__((unused)) = true; + + std::promise<void> p1; + std::shared_future<void> f1(p1.get_future()); + std::shared_future<void> f2(f1); + + p1.set_exception(std::copy_exception(value)); + try + { + f1.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } + try + { + f2.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } +} + +int main() +{ + test01(); + test02(); + test03(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/members/has_exception.cc b/libstdc++-v3/testsuite/30_threads/shared_future/members/has_exception.cc new file mode 100644 index 00000000000..97d398025e5 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/members/has_exception.cc @@ -0,0 +1,70 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + VERIFY( !f1.has_exception() ); + VERIFY( !f2.has_exception() ); + + p1.set_exception(std::copy_exception(1)); + + VERIFY( f1.has_exception() ); + VERIFY( f2.has_exception() ); +} + +void test02() +{ + std::promise<int> p1; + bool test __attribute__((unused)) = true; + + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + VERIFY( !f1.has_exception() ); + VERIFY( !f2.has_exception() ); + + p1.set_value(1); + + VERIFY( !f1.has_exception() ); + VERIFY( !f2.has_exception() ); +} + +int main() +{ + test01(); + test02(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/members/has_value.cc b/libstdc++-v3/testsuite/30_threads/shared_future/members/has_value.cc new file mode 100644 index 00000000000..8903c825f88 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/members/has_value.cc @@ -0,0 +1,70 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + VERIFY( !f1.has_value() ); + VERIFY( !f2.has_value() ); + + p1.set_value(1); + + VERIFY( f1.has_value() ); + VERIFY( f2.has_value() ); +} + +void test02() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + VERIFY( !f1.has_value() ); + VERIFY( !f2.has_value() ); + + p1.set_exception(std::copy_exception(1)); + + VERIFY( !f1.has_value() ); + VERIFY( !f2.has_value() ); +} + +int main() +{ + test01(); + test02(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/members/is_ready.cc b/libstdc++-v3/testsuite/30_threads/shared_future/members/is_ready.cc new file mode 100644 index 00000000000..eb2252a664b --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/members/is_ready.cc @@ -0,0 +1,51 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + VERIFY( !f1.is_ready() ); + VERIFY( !f2.is_ready() ); + + p1.set_value(1); + + VERIFY( f1.is_ready() ); + VERIFY( f2.is_ready() ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/members/wait.cc b/libstdc++-v3/testsuite/30_threads/shared_future/members/wait.cc new file mode 100644 index 00000000000..a4e325b0d96 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/members/wait.cc @@ -0,0 +1,56 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <thread> +#include <mutex> +#include <testsuite_hooks.h> + +void wait(std::shared_future<void> f) +{ + f.wait(); +} + +void test01() +{ + std::promise<void> p1; + std::shared_future<void> f1(p1.get_future()); + + std::thread t1(wait, f1); + std::thread t2(wait, f1); + std::thread t3(wait, f1); + + p1.set_value(); + t1.join(); + t2.join(); + t3.join(); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/members/wait_for.cc b/libstdc++-v3/testsuite/30_threads/shared_future/members/wait_for.cc new file mode 100644 index 00000000000..408b6460225 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/members/wait_for.cc @@ -0,0 +1,56 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <chrono> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + std::chrono::milliseconds delay(100); + + VERIFY( !f1.wait_for(delay) ); + VERIFY( !f2.wait_for(delay) ); + + p1.set_value(1); + + auto before = std::chrono::system_clock::now(); + VERIFY( f1.wait_for(delay) ); + VERIFY( f2.wait_for(delay) ); + VERIFY( std::chrono::system_clock::now() < (before + 2*delay) ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/members/wait_until.cc b/libstdc++-v3/testsuite/30_threads/shared_future/members/wait_until.cc new file mode 100644 index 00000000000..561fb20952d --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/members/wait_until.cc @@ -0,0 +1,64 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <chrono> +#include <testsuite_hooks.h> + +std::chrono::system_clock::time_point make_time(int i) +{ + return std::chrono::system_clock::now() + std::chrono::milliseconds(i); +} + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::shared_future<int> f1(p1.get_future()); + std::shared_future<int> f2(f1); + + auto when = make_time(10); + VERIFY( !f1.wait_until(make_time(10)) ); + VERIFY( std::chrono::system_clock::now() >= when ); + + when = make_time(10); + VERIFY( !f2.wait_until(make_time(10)) ); + VERIFY( std::chrono::system_clock::now() >= when ); + + p1.set_value(1); + + when = make_time(100); + VERIFY( f1.wait_until(when) ); + VERIFY( f2.wait_until(when) ); + VERIFY( std::chrono::system_clock::now() < when ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/shared_future/requirements/explicit_instantiation.cc b/libstdc++-v3/testsuite/30_threads/shared_future/requirements/explicit_instantiation.cc new file mode 100644 index 00000000000..4c1b3b276bd --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/shared_future/requirements/explicit_instantiation.cc @@ -0,0 +1,34 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_tr1.h> + +using namespace __gnu_test; +using std::shared_future; +template class shared_future<int>; +template class shared_future<int&>; +template class shared_future<void>; +template class shared_future<ClassType>; +template class shared_future<ClassType&>; diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/cons/assign_neg.cc b/libstdc++-v3/testsuite/30_threads/unique_future/cons/assign_neg.cc new file mode 100644 index 00000000000..e9525e4da7a --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/cons/assign_neg.cc @@ -0,0 +1,38 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +extern std::unique_future<int>& get(); + +void test01() +{ + // assign + std::unique_future<int>& p1 = get(); + std::unique_future<int>& p2 = get(); + p1 = p2; +} + +// { dg-error "used here" "" { target *-*-* } 34 } +// { dg-error "deleted function" "" { target *-*-* } 394 } diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/cons/copy_neg.cc b/libstdc++-v3/testsuite/30_threads/unique_future/cons/copy_neg.cc new file mode 100644 index 00000000000..bf40e054af0 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/cons/copy_neg.cc @@ -0,0 +1,37 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +extern std::unique_future<int>& get(); + +void test01() +{ + // copy + std::unique_future<int>& p1 = get(); + std::unique_future<int> p2(p1); +} + +// { dg-error "used here" "" { target *-*-* } 33 } +// { dg-error "deleted function" "" { target *-*-* } 393 } diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/cons/default_neg.cc b/libstdc++-v3/testsuite/30_threads/unique_future/cons/default_neg.cc new file mode 100644 index 00000000000..ba5066bfcab --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/cons/default_neg.cc @@ -0,0 +1,45 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_tr1.h> + +void test01() +{ + using std::unique_future; + using namespace __gnu_test; + + unique_future<int> p1; // { dg-error "22: error: no match" } + unique_future<int&> p2; // { dg-error "23: error: no match" } + unique_future<void> p3; // { dg-error "23: error: no match" } + unique_future<ClassType> p4; // { dg-error "28: error: no match" } + unique_future<AbstractClass&> p5; // { dg-error "33: error: no match" } +} + +int main() +{ + test01(); + return 0; +} +// { dg-excess-errors "note" } diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/cons/move.cc b/libstdc++-v3/testsuite/30_threads/unique_future/cons/move.cc new file mode 100644 index 00000000000..17eaa914e4e --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/cons/move.cc @@ -0,0 +1,41 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> + +void test01() +{ + // move + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + std::unique_future<int> f2(std::move(f1)); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/members/get.cc b/libstdc++-v3/testsuite/30_threads/unique_future/members/get.cc new file mode 100644 index 00000000000..5c9a4548491 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/members/get.cc @@ -0,0 +1,70 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +int value = 99; + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + p1.set_value(value); + VERIFY( f1.get() == value ); +} + +void test02() +{ + bool test __attribute__((unused)) = true; + + std::promise<int&> p1; + std::unique_future<int&> f1(p1.get_future()); + + p1.set_value(value); + VERIFY( &f1.get() == &value ); +} + +void test03() +{ + std::promise<void> p1; + std::unique_future<void> f1(p1.get_future()); + + p1.set_value(); + f1.get(); +} + +int main() +{ + test01(); + test02(); + test03(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/members/get2.cc b/libstdc++-v3/testsuite/30_threads/unique_future/members/get2.cc new file mode 100644 index 00000000000..e6317fed838 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/members/get2.cc @@ -0,0 +1,97 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <exception> +#include <testsuite_hooks.h> + +int value = 99; + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + p1.set_exception(std::copy_exception(value)); + try + { + (void) f1.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } +} + +void test02() +{ + bool test __attribute__((unused)) = true; + + std::promise<int&> p1; + std::unique_future<int&> f1(p1.get_future()); + + p1.set_exception(std::copy_exception(value)); + try + { + (void) f1.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } +} + +void test03() +{ + bool test __attribute__((unused)) = true; + + std::promise<void> p1; + std::unique_future<void> f1(p1.get_future()); + + p1.set_exception(std::copy_exception(value)); + try + { + f1.get(); + VERIFY( false ); + } + catch (int& e) + { + VERIFY( e == value ); + } +} + +int main() +{ + test01(); + test02(); + test03(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/members/has_exception.cc b/libstdc++-v3/testsuite/30_threads/unique_future/members/has_exception.cc new file mode 100644 index 00000000000..1d5baf88393 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/members/has_exception.cc @@ -0,0 +1,64 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + VERIFY( !f1.has_exception() ); + + p1.set_exception(std::copy_exception(1)); + + VERIFY( f1.has_exception() ); +} + +void test02() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + VERIFY( !f1.has_exception() ); + + p1.set_value(1); + + VERIFY( !f1.has_exception() ); +} + +int main() +{ + test01(); + test02(); + + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/members/has_value.cc b/libstdc++-v3/testsuite/30_threads/unique_future/members/has_value.cc new file mode 100644 index 00000000000..f1f96f21ddc --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/members/has_value.cc @@ -0,0 +1,65 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + VERIFY( !f1.has_value() ); + + p1.set_value(1); + + VERIFY( f1.has_value() ); +} + +void test02() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + VERIFY( !f1.has_value() ); + + p1.set_exception(std::copy_exception(1)); + + VERIFY( !f1.has_value() ); +} + +int main() +{ + test01(); + test02(); + + return 0; +} + diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/members/is_ready.cc b/libstdc++-v3/testsuite/30_threads/unique_future/members/is_ready.cc new file mode 100644 index 00000000000..6f2b6885595 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/members/is_ready.cc @@ -0,0 +1,48 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + VERIFY( !f1.is_ready() ); + + p1.set_value(1); + + VERIFY( f1.is_ready() ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/members/wait.cc b/libstdc++-v3/testsuite/30_threads/unique_future/members/wait.cc new file mode 100644 index 00000000000..b9c9402cf31 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/members/wait.cc @@ -0,0 +1,54 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <chrono> +#include <thread> +#include <mutex> +#include <testsuite_hooks.h> + + +void wait(std::unique_future<void>& f) +{ + f.wait(); +} + +void test01() +{ + std::promise<void> p1; + std::unique_future<void> f1(p1.get_future()); + + std::thread t1(wait, std::ref(f1)); + + p1.set_value(); + t1.join(); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/members/wait_for.cc b/libstdc++-v3/testsuite/30_threads/unique_future/members/wait_for.cc new file mode 100644 index 00000000000..065240097b1 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/members/wait_for.cc @@ -0,0 +1,53 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <chrono> +#include <testsuite_hooks.h> + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + std::chrono::milliseconds delay(100); + + VERIFY( !f1.wait_for(delay) ); + + p1.set_value(1); + + auto before = std::chrono::system_clock::now(); + VERIFY( f1.wait_for(delay) ); + VERIFY( std::chrono::system_clock::now() < (before + delay) ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/members/wait_until.cc b/libstdc++-v3/testsuite/30_threads/unique_future/members/wait_until.cc new file mode 100644 index 00000000000..55bdcbcc76c --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/members/wait_until.cc @@ -0,0 +1,58 @@ +// { dg-do run { target *-*-freebsd* *-*-netbsd* *-*-linux* *-*-solaris* *-*-cygwin *-*-darwin* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthread" { target *-*-freebsd* *-*-netbsd* *-*-linux* alpha*-*-osf* mips-sgi-irix6* } } +// { dg-options " -std=gnu++0x -pthreads" { target *-*-solaris* } } +// { dg-options " -std=gnu++0x " { target *-*-cygwin *-*-darwin* } } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <chrono> +#include <testsuite_hooks.h> + +std::chrono::system_clock::time_point make_time(int i) +{ + return std::chrono::system_clock::now() + std::chrono::milliseconds(i); +} + +void test01() +{ + bool test __attribute__((unused)) = true; + + std::promise<int> p1; + std::unique_future<int> f1(p1.get_future()); + + auto when = make_time(10); + VERIFY( !f1.wait_until(when) ); + VERIFY( std::chrono::system_clock::now() >= when ); + + p1.set_value(1); + + when = make_time(100); + VERIFY( f1.wait_until(when) ); + VERIFY( std::chrono::system_clock::now() < when ); +} + +int main() +{ + test01(); + return 0; +} diff --git a/libstdc++-v3/testsuite/30_threads/unique_future/requirements/explicit_instantiation.cc b/libstdc++-v3/testsuite/30_threads/unique_future/requirements/explicit_instantiation.cc new file mode 100644 index 00000000000..01e5c5924b2 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/unique_future/requirements/explicit_instantiation.cc @@ -0,0 +1,34 @@ +// { dg-do compile } +// { dg-options "-std=gnu++0x" } +// { dg-require-cstdint "" } +// { dg-require-gthreads "" } +// { dg-require-atomic-builtins "" } + +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <testsuite_tr1.h> + +using namespace __gnu_test; +using std::unique_future; +template class unique_future<int>; +template class unique_future<int&>; +template class unique_future<void>; +template class unique_future<ClassType>; +template class unique_future<ClassType&>; diff --git a/libstdc++-v3/testsuite/performance/30_threads/future/polling.cc b/libstdc++-v3/testsuite/performance/30_threads/future/polling.cc new file mode 100644 index 00000000000..21405e18ad4 --- /dev/null +++ b/libstdc++-v3/testsuite/performance/30_threads/future/polling.cc @@ -0,0 +1,55 @@ +// Copyright (C) 2009 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 library; see the file COPYING3. If not see +// <http://www.gnu.org/licenses/>. + + +#include <future> +#include <thread> +#include <testsuite_performance.h> + +void poll(std::shared_future<void> f) +{ + while (!f.is_ready()) + { } +} + +int main() +{ + using namespace __gnu_test; + time_counter time; + resource_counter resource; + + const int n = 20; + std::promise<void> p; + std::shared_future<void> f = p.get_future(); + std::thread pollers[n]; + for (int i=0; i < n; ++i) + pollers[i] = std::thread(poll, f); + + start_counters(time, resource); + + for (int i = 0; i < 1000000; ++i) + (void)f.is_ready(); + p.set_value(); + + for (int i=0; i < n; ++i) + pollers[i].join(); + + stop_counters(time, resource); + report_performance(__FILE__, "", time, resource); + + return 0; +} |