diff options
Diffstat (limited to 'gcc')
57 files changed, 2130 insertions, 281 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index dd930d6..59534a0 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,76 @@ +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/114025 + * gimple-range-fold.cc (fold_using_range::condexpr_adjust): Handle + the same ssa_name in the condition and the COND_EXPR better. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + * range-op.cc (operator_bitwise_and::wi_fold): Split signed + operations crossing zero into 2 operations. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/118254 + PR tree-optimization/114331 + * range-op.cc (operator_cast::fold_range): When VARYING is + reached, update the bitmask if we reach VARYING. + (operator_cast::op1_range): For truncating casts, create a + bitmask bit in LHS. + +2025-10-24 Takayuki 'January June' Suwa <jjsuwa_sys3175@yahoo.co.jp> + + * config/xtensa/xtensa.md (call_internal, call_value_internal, + sibcall_internal, sibcall_value_internal): Remove 'n'-constraint. + +2025-10-24 Takayuki 'January June' Suwa <jjsuwa_sys3175@yahoo.co.jp> + + * config/xtensa/xtensa.md (*addsubx, *subsi3_from_const, + *xtensa_clamps, *andsi3_const_pow2_minus_one, + *andsi3_const_negative_pow2, *andsi3_const_shifted_mask, + *splice_bits, extvsi_internal, extzvsi_internal, + *extzvsi-1bit_ashlsi3, *extzvsi-1bit_addsubx, insvsi, *lsiu, *ssiu, + *lsip, *ssip, *shift_per_byte_omit_AND_0, *shift_per_byte_omit_AND_1, + *shlrd_const, *shlrd_per_byte_omit_AND, *masktrue_const_bitcmpl, + *masktrue_const_pow2_minus_one, *masktrue_const_negative_pow2, + *masktrue_const_shifted_mask, call_internal, call_value_internal, + sibcall_internal, sibcall_value_internal, entry, + *eqne_zero_masked_bits, *eqne_in_range): Remove 'i'-constraint. + +2025-10-24 Josef Melcr <jmelcr02@gmail.com> + + PR middle-end/122392 + * attr-callback.cc (callback_build_attr): Remove erroneous + annotation. + +2025-10-24 Richard Biener <rguenther@suse.de> + + * tree-vect-loop.cc (vectorizable_reduction): SLP-ify reduction + operation processing a bit more. + +2025-10-24 Richard Biener <rguenther@suse.de> + + PR tree-optimization/122406 + * tree-vect-slp.cc (vect_analyze_slp_reduc_chain): Create + the SLP nodes for the conversions around the reduction + operation if required. + +2025-10-24 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/121452 + * omp-low.cc (check_omp_nesting_restrictions): Accept an + OMP_STRUCTURED_BLOCK in a collapsed simd region and in an ordered loop. + +2025-10-24 Pengfei Li <Pengfei.Li2@arm.com> + + * match.pd: Fold VEC_PERM_EXPR chains implementing vector + concat-and-extract. + +2025-10-24 Olivier Hainque <hainque@adacore.com> + + * config/rs6000/vxworks.h (SET_CMODEL): Undefine before + (re)defining. + 2025-10-23 Andrew Pinski <andrew.pinski@oss.qualcomm.com> * match.pd (`(type1)x CMP CST1 ? (type2)x : CST2`): Better handling diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index a234d9f..8135eec 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251024 +20251025 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 806a2ca..a732e94 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,44 @@ +2025-10-24 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/80033 + * gcc-interface/Makefile.in (force): Restore. + +2025-10-24 Nicolas Boulenguez <nicolas@debian.org> + + PR ada/80033 + * gcc-interface/Makefile.in (deftarg.o): Delete. + (init-vxsim.o): Likewise. + (force): Likewise. + +2025-10-24 Mivirl <octoberstargazer7405@mivirl.dev> + + PR ada/122367 + * rtinit.c (__gnat_runtime_initialize) [__MINGW32__]: Fix detection + of quoted arguments. + +2025-10-24 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/118782 + * styleg.adb (Is_Box_Comment): Also stop the loop at EOF. + +2025-10-24 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/113516 + * s-oscons-tmplt.c [_WIN32]: Undefine POLLPRI before redefining it. + +2025-10-24 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/98879 + * terminals.c (__gnat_setup_child_communication) [_WIN32]: Add else + blocks in the processing of the data returned by ReadFile. + +2025-10-24 Nicolas Boulenguez <nicolas@debian.org> + + PR ada/81087 + * gnatlink.adb (Is_Prefix): Move around, streamline and return false + when the prefix is not strict. + (Gnatlink): Fix other instances of incorrect lower bound assumption. + 2025-10-20 Eric Botcazou <ebotcazou@adacore.com> PR ada/102078 diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index d456ac1..964a4d1 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -905,7 +905,6 @@ adadecode.o : adadecode.c adadecode.h aux-io.o : aux-io.c argv.o : argv.c cal.o : cal.c -deftarg.o : deftarg.c errno.o : errno.c exit.o : adaint.h exit.c expect.o : expect.c @@ -938,10 +937,6 @@ init.o : init.c adaint.h raise.h $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) -init-vxsim.o : init-vxsim.c - $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ - $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) - initialize.o : initialize.c raise.h $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \ $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 527aa7f..406147b 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -266,6 +266,9 @@ procedure Gnatlink is function Index (S, Pattern : String) return Natural; -- Return the last occurrence of Pattern in S, or 0 if none + function Is_Prefix (S, Prefix : String) return Boolean; + -- Return whether Prefix is a strict prefix of S + procedure Search_Library_Path (Next_Line : String; Nfirst : Integer; @@ -395,6 +398,16 @@ procedure Gnatlink is return 0; end Index; + --------------- + -- Is_Prefix -- + --------------- + + function Is_Prefix (S, Prefix : String) return Boolean is + begin + return Prefix'Length < S'Length + and then S (S'First .. S'First + Prefix'Length - 1) = Prefix; + end Is_Prefix; + ------------------ -- Process_Args -- ------------------ @@ -1292,13 +1305,8 @@ procedure Gnatlink is else for J in reverse 1 .. Linker_Options.Last loop if Linker_Options.Table (J) /= null - and then - Linker_Options.Table (J)'Length - > Run_Path_Opt'Length - and then - Linker_Options.Table (J) - (1 .. Run_Path_Opt'Length) = - Run_Path_Opt + and then Is_Prefix + (Linker_Options.Table (J).all, Run_Path_Opt) then -- We have found an already specified -- run_path_option: we will add to this switch, @@ -1887,31 +1895,12 @@ begin Shared_Libgcc_Seen : Boolean := False; Static_Libgcc_Seen : Boolean := False; - function Is_Prefix - (Complete_String : String; Prefix : String) return Boolean; - -- Returns whether Prefix is a prefix of Complete_String - - --------------- - -- Is_Prefix -- - --------------- - - function Is_Prefix - (Complete_String : String; Prefix : String) return Boolean - is - S : String renames Complete_String; - P : String renames Prefix; - begin - return P'Length <= S'Length - and then S (S'First .. S'First + P'Length - 1) = P; - end Is_Prefix; - begin J := Linker_Options.First; while J <= Linker_Options.Last loop if Linker_Options.Table (J).all = "-Xlinker" and then J < Linker_Options.Last - and then Linker_Options.Table (J + 1)'Length > 8 - and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack=" + and then Is_Prefix (Linker_Options.Table (J + 1).all, "--stack=") then if Stack_Op then Linker_Options.Table (J .. Linker_Options.Last - 2) := @@ -1956,12 +1945,8 @@ begin -- Here we just check for a canonical form that matches the -- pragma Linker_Options set in the NT runtime. - if Is_Prefix - (Complete_String => Linker_Options.Table (J).all, - Prefix => "-Xlinker --stack=") - or else Is_Prefix - (Complete_String => Linker_Options.Table (J).all, - Prefix => "-Wl,--stack=") + if Is_Prefix (Linker_Options.Table (J).all, "-Xlinker --stack=") + or else Is_Prefix (Linker_Options.Table (J).all, "-Wl,--stack=") then if Stack_Op then Linker_Options.Table (J .. Linker_Options.Last - 1) := diff --git a/gcc/ada/rtinit.c b/gcc/ada/rtinit.c index 6a13552..598550c 100644 --- a/gcc/ada/rtinit.c +++ b/gcc/ada/rtinit.c @@ -419,6 +419,7 @@ __gnat_runtime_initialize (int install_handler) int last; int argc_expanded = 0; TCHAR result [MAX_PATH]; + int arglen; int quoted; __gnat_get_argw (GetCommandLineW (), &wargv, &wargc); @@ -436,7 +437,10 @@ __gnat_runtime_initialize (int install_handler) for (k=1; k<wargc; k++) { - quoted = (wargv[k][0] == _T('\'')); + arglen = _tcslen (wargv[k]); + quoted = wargv[k][0] == _T('\'') + && arglen > 1 + && wargv[k][arglen - 1] == _T('\''); /* Check for wildcard expansion if the argument is not quoted. */ if (!quoted && __gnat_do_argv_expansion diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 6b21905..8391f1f 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -1882,6 +1882,7 @@ CND(IF_NAMESIZE, "Max size of interface name with 0 terminator"); #endif #elif defined(_WIN32) +#undef POLLPRI #define POLLPRI 0 /* If the POLLPRI flag is set on a socket for the Microsoft Winsock provider, * the WSAPoll function will fail. */ diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb index 20945fb..46499ff 100644 --- a/gcc/ada/styleg.adb +++ b/gcc/ada/styleg.adb @@ -330,7 +330,7 @@ package body Styleg is -- Do we need to worry about UTF_32 line terminators here ??? S := Scan_Ptr + 3; - while Source (S) not in Line_Terminator loop + while Source (S) not in EOF | Line_Terminator loop S := S + 1; end loop; diff --git a/gcc/ada/terminals.c b/gcc/ada/terminals.c index 89f8875..85a5c0d 100644 --- a/gcc/ada/terminals.c +++ b/gcc/ada/terminals.c @@ -724,13 +724,16 @@ __gnat_setup_child_communication if (bRet == FALSE) { cpid = -1; } - - dwRet = buf[0] | (buf[1] << 8) | (buf[2] << 16) | (buf[3] << 24); - if (dwRet != 0) { - cpid = -1; + else { + dwRet = buf[0] | (buf[1] << 8) | (buf[2] << 16) | (buf[3] << 24); + if (dwRet != 0) { + cpid = -1; + } + else { + cpid = buf[4] | (buf[5] << 8) | (buf[6] << 16) | (buf[7] << 24); + } } - cpid = buf[4] | (buf[5] << 8) | (buf[6] << 16) | (buf[7] << 24); process->pid = cpid; } diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index 6f51dd9..89a1bbe 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,18 @@ +2025-10-24 Joseph Myers <josmyers@redhat.com> + + * c-parser.cc (c_parser_next_tokens_start_typename) + (c_parser_next_tokens_start_declaration): Add argument for token + to start from + (c_parser_next_tokens_start_declaration): Check for whether static + assertion followed by semicolon. + (c_parser_check_balanced_raw_token_sequence): Declare earlier. + (c_parser_compound_statement_nostart, c_parser_for_statement): Use + c_parser_next_tokens_start_declaration not + c_token_starts_declaration on second token. + (c_parser_unary_expression): Handle static assertions. + * c-parser.h (c_parser_next_tokens_start_declaration): Add + argument. + 2025-10-21 Martin Uecker <uecker@tugraz.at> * c-decl.cc (build_array_declarator): Remove error. diff --git a/gcc/config/loongarch/lasx.md b/gcc/config/loongarch/lasx.md index 3d71f30..eed4d2b 100644 --- a/gcc/config/loongarch/lasx.md +++ b/gcc/config/loongarch/lasx.md @@ -633,6 +633,48 @@ [(set_attr "move_type" "fmove") (set_attr "mode" "<UNITMODE>")]) +(define_expand "vec_extract<mode><lasxhalf>" + [(match_operand:<VHMODE256_ALL> 0 "register_operand") + (match_operand:LASX 1 "register_operand") + (match_operand 2 "const_0_or_1_operand")] + "ISA_HAS_LASX" +{ + if (INTVAL (operands[2])) + { + operands[2] = loongarch_lsx_vec_parallel_const_half (<MODE>mode, true); + emit_insn (gen_vec_extract_hi_<mode> (operands[0], operands[1], + operands[2])); + } + else + { + operands[2] = loongarch_lsx_vec_parallel_const_half (<MODE>mode, false); + emit_insn (gen_vec_extract_lo_<mode> (operands[0], operands[1], + operands[2])); + } + DONE; +}) + +(define_insn_and_split "vec_extract_lo_<mode>" + [(set (match_operand:<VHMODE256_ALL> 0 "register_operand" "=f") + (vec_select:<VHMODE256_ALL> + (match_operand:LASX 1 "register_operand" "f") + (match_operand:LASX 2 "vect_par_cnst_low_half")))] + "ISA_HAS_LASX" + "#" + "&& reload_completed" + [(set (match_dup 0) (match_dup 1))] + "operands[1] = gen_lowpart (<VHMODE256_ALL>mode, operands[1]);") + +(define_insn "vec_extract_hi_<mode>" + [(set (match_operand:<VHMODE256_ALL> 0 "register_operand" "=f") + (vec_select:<VHMODE256_ALL> + (match_operand:LASX 1 "register_operand" "f") + (match_operand:LASX 2 "vect_par_cnst_high_half")))] + "ISA_HAS_LASX" + "xvpermi.d\t%u0,%u1,0xe" + [(set_attr "move_type" "fmove") + (set_attr "mode" "<MODE>")]) + (define_expand "vec_perm<mode>" [(match_operand:LASX 0 "register_operand") (match_operand:LASX 1 "register_operand") diff --git a/gcc/config/loongarch/loongarch-protos.h b/gcc/config/loongarch/loongarch-protos.h index 6139af4..6ecbe27 100644 --- a/gcc/config/loongarch/loongarch-protos.h +++ b/gcc/config/loongarch/loongarch-protos.h @@ -121,6 +121,7 @@ extern bool loongarch_const_vector_same_int_p (rtx, machine_mode, extern bool loongarch_const_vector_shuffle_set_p (rtx, machine_mode); extern bool loongarch_const_vector_bitimm_set_p (rtx, machine_mode); extern bool loongarch_const_vector_bitimm_clr_p (rtx, machine_mode); +extern bool loongarch_check_vect_par_cnst_half (rtx, machine_mode, bool); extern rtx loongarch_const_vector_vrepli (rtx, machine_mode); extern rtx loongarch_lsx_vec_parallel_const_half (machine_mode, bool); extern rtx loongarch_gen_const_int_vector (machine_mode, HOST_WIDE_INT); diff --git a/gcc/config/loongarch/loongarch.cc b/gcc/config/loongarch/loongarch.cc index 3fe8c76..c782cac 100644 --- a/gcc/config/loongarch/loongarch.cc +++ b/gcc/config/loongarch/loongarch.cc @@ -1846,6 +1846,37 @@ loongarch_const_vector_shuffle_set_p (rtx op, machine_mode mode) return true; } +/* Check if OP is a PARALLEL RTX with CONST_INT elements representing + the HIGH (high_p == TRUE) or LOW (high_p == FALSE) half of a vector + for mode MODE. Returns true if the pattern matches, false otherwise. */ + +bool +loongarch_check_vect_par_cnst_half (rtx op, machine_mode mode, bool high_p) +{ + int nunits = XVECLEN (op, 0); + int nelts = GET_MODE_NUNITS (mode); + + if (!known_eq (nelts, nunits * 2)) + return false; + + rtx first = XVECEXP (op, 0, 0); + if (!CONST_INT_P (first)) + return false; + + int base = high_p ? nelts / 2 : 0; + if (INTVAL (first) != base) + return false; + + for (int i = 1; i < nunits; i++) + { + rtx elem = XVECEXP (op, 0, i); + if (!CONST_INT_P (elem) || INTVAL (elem) != INTVAL (first) + i) + return false; + } + + return true; +} + rtx loongarch_const_vector_vrepli (rtx x, machine_mode mode) { @@ -4143,6 +4174,19 @@ loongarch_rtx_costs (rtx x, machine_mode mode, int outer_code, } } +/* All CPUs prefer to avoid cross-lane operations so perform reductions + upper against lower halves up to LSX reg size. */ + +machine_mode +loongarch_split_reduction (machine_mode mode) +{ + if (LSX_SUPPORTED_MODE_P (mode)) + return mode; + + return mode_for_vector (as_a <scalar_mode> (GET_MODE_INNER (mode)), + GET_MODE_NUNITS (mode) / 2).require (); +} + /* Implement targetm.vectorize.builtin_vectorization_cost. */ static int @@ -11397,6 +11441,10 @@ loongarch_can_inline_p (tree caller, tree callee) #define TARGET_VECTORIZE_AUTOVECTORIZE_VECTOR_MODES \ loongarch_autovectorize_vector_modes +#undef TARGET_VECTORIZE_SPLIT_REDUCTION +#define TARGET_VECTORIZE_SPLIT_REDUCTION \ + loongarch_split_reduction + #undef TARGET_OPTAB_SUPPORTED_P #define TARGET_OPTAB_SUPPORTED_P loongarch_optab_supported_p diff --git a/gcc/config/loongarch/predicates.md b/gcc/config/loongarch/predicates.md index fd2d7b9..34cf74d 100644 --- a/gcc/config/loongarch/predicates.md +++ b/gcc/config/loongarch/predicates.md @@ -699,3 +699,19 @@ return true; }) + +;; PARALLEL for a vec_select that selects the low half +;; elements of a vector of MODE. +(define_special_predicate "vect_par_cnst_low_half" + (match_code "parallel") +{ + return loongarch_check_vect_par_cnst_half (op, mode, false); +}) + +;; PARALLEL for a vec_select that selects the high half +;; elements of a vector of MODE. +(define_special_predicate "vect_par_cnst_high_half" + (match_code "parallel") +{ + return loongarch_check_vect_par_cnst_half (op, mode, true);; +}) diff --git a/gcc/config/xtensa/xtensa.md b/gcc/config/xtensa/xtensa.md index aa64808..374288d 100644 --- a/gcc/config/xtensa/xtensa.md +++ b/gcc/config/xtensa/xtensa.md @@ -190,7 +190,7 @@ [(set (match_operand:SI 0 "register_operand" "=a") (match_operator:SI 4 "addsub_operator" [(ashift:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 3 "addsubx_operand" "i")) + (match_operand:SI 3 "addsubx_operand" "")) (match_operand:SI 2 "register_operand" "r")]))] "TARGET_ADDX" { @@ -270,7 +270,7 @@ (define_insn_and_split "*subsi3_from_const" [(set (match_operand:SI 0 "register_operand" "=a") - (minus:SI (match_operand:SI 1 "const_int_operand" "i") + (minus:SI (match_operand:SI 1 "const_int_operand" "") (match_operand:SI 2 "register_operand" "r")))] "xtensa_simm8 (-INTVAL (operands[1])) || xtensa_simm8x256 (-INTVAL (operands[1]))" @@ -545,8 +545,8 @@ (match_operator:SI 5 "xtensa_sminmax_operator" [(match_operator:SI 4 "xtensa_sminmax_operator" [(match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")]) - (match_operand:SI 3 "const_int_operand" "i")]))] + (match_operand:SI 2 "const_int_operand" "")]) + (match_operand:SI 3 "const_int_operand" "")]))] "TARGET_MINMAX && TARGET_CLAMPS && INTVAL (operands[2]) + INTVAL (operands[3]) == -1 && ((GET_CODE (operands[5]) == SMIN && GET_CODE (operands[4]) == SMAX @@ -747,7 +747,7 @@ (define_insn_and_split "*andsi3_const_pow2_minus_one" [(set (match_operand:SI 0 "register_operand" "=a") (and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")))] + (match_operand:SI 2 "const_int_operand" "")))] "IN_RANGE (exact_log2 (INTVAL (operands[2]) + 1), 17, 31)" "#" "&& 1" @@ -771,7 +771,7 @@ (define_insn_and_split "*andsi3_const_negative_pow2" [(set (match_operand:SI 0 "register_operand" "=a") (and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")))] + (match_operand:SI 2 "const_int_operand" "")))] "IN_RANGE (exact_log2 (-INTVAL (operands[2])), 12, 31)" "#" "&& 1" @@ -791,7 +791,7 @@ (define_insn_and_split "*andsi3_const_shifted_mask" [(set (match_operand:SI 0 "register_operand" "=a") (and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "shifted_mask_operand" "i")))] + (match_operand:SI 2 "shifted_mask_operand" "")))] "! xtensa_simm12b (INTVAL (operands[2]))" "#" "&& 1" @@ -868,9 +868,9 @@ (define_insn_and_split "*splice_bits" [(set (match_operand:SI 0 "register_operand" "=a") (ior:SI (and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 3 "const_int_operand" "i")) + (match_operand:SI 3 "const_int_operand" "")) (and:SI (match_operand:SI 2 "register_operand" "r") - (match_operand:SI 4 "const_int_operand" "i"))))] + (match_operand:SI 4 "const_int_operand" ""))))] "!optimize_debug && optimize && INTVAL (operands[3]) + INTVAL (operands[4]) == -1 @@ -997,8 +997,8 @@ (define_insn "extvsi_internal" [(set (match_operand:SI 0 "register_operand" "=a") (sign_extract:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "sext_fldsz_operand" "i") - (match_operand:SI 3 "lsbitnum_operand" "i")))] + (match_operand:SI 2 "sext_fldsz_operand" "") + (match_operand:SI 3 "lsbitnum_operand" "")))] "TARGET_SEXT" { int fldsz = INTVAL (operands[2]); @@ -1026,8 +1026,8 @@ (define_insn "extzvsi_internal" [(set (match_operand:SI 0 "register_operand" "=a") (zero_extract:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "extui_fldsz_operand" "i") - (match_operand:SI 3 "const_int_operand" "i")))] + (match_operand:SI 2 "extui_fldsz_operand" "") + (match_operand:SI 3 "const_int_operand" "")))] "" { int shift; @@ -1046,8 +1046,8 @@ [(set (match_operand:SI 0 "register_operand" "=a") (and:SI (match_operator:SI 4 "logical_shift_operator" [(match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")]) - (match_operand:SI 3 "const_int_operand" "i")))] + (match_operand:SI 2 "const_int_operand" "")]) + (match_operand:SI 3 "const_int_operand" "")))] "exact_log2 (INTVAL (operands[3])) > 0" "#" "&& 1" @@ -1078,8 +1078,8 @@ (match_operator:SI 5 "addsub_operator" [(and:SI (match_operator:SI 6 "logical_shift_operator" [(match_operand:SI 1 "register_operand" "r0") - (match_operand:SI 3 "const_int_operand" "i")]) - (match_operand:SI 4 "const_int_operand" "i")) + (match_operand:SI 3 "const_int_operand" "")]) + (match_operand:SI 4 "const_int_operand" "")) (match_operand:SI 2 "register_operand" "r")]))] "TARGET_ADDX && IN_RANGE (exact_log2 (INTVAL (operands[4])), 1, 3)" @@ -1108,8 +1108,8 @@ (define_insn "insvsi" [(set (zero_extract:SI (match_operand:SI 0 "register_operand" "+a") - (match_operand:SI 1 "extui_fldsz_operand" "i") - (match_operand:SI 2 "const_int_operand" "i")) + (match_operand:SI 1 "extui_fldsz_operand" "") + (match_operand:SI 2 "const_int_operand" "")) (match_operand:SI 3 "register_operand" "r"))] "TARGET_DEPBITS" { @@ -1430,7 +1430,7 @@ (define_insn "*lsiu" [(set (match_operand:SF 0 "register_operand" "=f") (mem:SF (plus:SI (match_operand:SI 1 "register_operand" "+a") - (match_operand:SI 2 "fpmem_offset_operand" "i")))) + (match_operand:SI 2 "fpmem_offset_operand" "")))) (set (match_dup 1) (plus:SI (match_dup 1) (match_dup 2)))] "TARGET_HARD_FLOAT && !TARGET_HARD_FLOAT_POSTINC" @@ -1445,7 +1445,7 @@ (define_insn "*ssiu" [(set (mem:SF (plus:SI (match_operand:SI 0 "register_operand" "+a") - (match_operand:SI 1 "fpmem_offset_operand" "i"))) + (match_operand:SI 1 "fpmem_offset_operand" ""))) (match_operand:SF 2 "register_operand" "f")) (set (match_dup 0) (plus:SI (match_dup 0) (match_dup 1)))] @@ -1464,7 +1464,7 @@ (mem:SF (match_operand:SI 1 "register_operand" "+a"))) (set (match_dup 1) (plus:SI (match_dup 1) - (match_operand:SI 2 "fpmem_offset_operand" "i")))] + (match_operand:SI 2 "fpmem_offset_operand" "")))] "TARGET_HARD_FLOAT && TARGET_HARD_FLOAT_POSTINC" { if (TARGET_SERIALIZE_VOLATILE && volatile_refs_p (PATTERN (insn))) @@ -1480,7 +1480,7 @@ (match_operand:SF 1 "register_operand" "f")) (set (match_dup 0) (plus:SI (match_dup 0) - (match_operand:SI 2 "fpmem_offset_operand" "i")))] + (match_operand:SI 2 "fpmem_offset_operand" "")))] "TARGET_HARD_FLOAT && TARGET_HARD_FLOAT_POSTINC" { if (TARGET_SERIALIZE_VOLATILE && volatile_refs_p (PATTERN (insn))) @@ -1637,7 +1637,7 @@ [(match_operand:SI 1 "register_operand" "r") (and:SI (ashift:SI (match_operand:SI 2 "register_operand" "r") (const_int 3)) - (match_operand:SI 3 "const_int_operand" "i"))]))] + (match_operand:SI 3 "const_int_operand" ""))]))] "!optimize_debug && optimize && (INTVAL (operands[3]) & 0x1f) == 3 << 3" "#" @@ -1658,7 +1658,7 @@ [(match_operand:SI 1 "register_operand" "r") (neg:SI (and:SI (ashift:SI (match_operand:SI 2 "register_operand" "r") (const_int 3)) - (match_operand:SI 3 "const_int_operand" "i")))]))] + (match_operand:SI 3 "const_int_operand" "")))]))] "!optimize_debug && optimize && (INTVAL (operands[3]) & 0x1f) == 3 << 3" "#" @@ -1732,10 +1732,10 @@ (match_operator:SI 7 "xtensa_bit_join_operator" [(match_operator:SI 5 "logical_shift_operator" [(match_operand:SI 1 "register_operand" "r") - (match_operand:SI 3 "const_int_operand" "i")]) + (match_operand:SI 3 "const_int_operand" "")]) (match_operator:SI 6 "logical_shift_operator" [(match_operand:SI 2 "register_operand" "r") - (match_operand:SI 4 "const_int_operand" "i")])]))] + (match_operand:SI 4 "const_int_operand" "")])]))] "!optimize_debug && optimize && xtensa_shlrd_which_direction (operands[5], operands[6]) != UNKNOWN && IN_RANGE (INTVAL (operands[3]), 1, 31) @@ -1785,7 +1785,7 @@ [(match_operand:SI 1 "register_operand" "r") (and:SI (ashift:SI (match_operand:SI 2 "register_operand" "r") (const_int 3)) - (match_operand:SI 4 "const_int_operand" "i"))]) + (match_operand:SI 4 "const_int_operand" ""))]) (match_operator:SI 6 "logical_shift_operator" [(match_operand:SI 3 "register_operand" "r") (neg:SI (and:SI (ashift:SI (match_dup 2) @@ -2007,7 +2007,7 @@ [(set (pc) (if_then_else (match_operator 3 "boolean_operator" [(and:SI (not:SI (match_operand:SI 0 "register_operand" "r")) - (match_operand:SI 1 "const_int_operand" "i")) + (match_operand:SI 1 "const_int_operand" "")) (const_int 0)]) (label_ref (match_operand 2 "" "")) (pc)))] @@ -2060,8 +2060,8 @@ [(set (pc) (if_then_else (match_operator 4 "boolean_operator" [(and:SI (match_operand:SI 0 "register_operand" "r") - (match_operand:SI 1 "const_int_operand" "i")) - (match_operand:SI 2 "const_int_operand" "i")]) + (match_operand:SI 1 "const_int_operand" "")) + (match_operand:SI 2 "const_int_operand" "")]) (label_ref (match_operand 3 "" "")) (pc)))] "IN_RANGE (exact_log2 (INTVAL (operands[1]) + 1), 17, 31) @@ -2100,8 +2100,8 @@ [(set (pc) (if_then_else (match_operator 4 "boolean_operator" [(and:SI (match_operand:SI 0 "register_operand" "r") - (match_operand:SI 1 "const_int_operand" "i")) - (match_operand:SI 2 "const_int_operand" "i")]) + (match_operand:SI 1 "const_int_operand" "")) + (match_operand:SI 2 "const_int_operand" "")]) (label_ref (match_operand 3 "" "")) (pc)))] "IN_RANGE (exact_log2 (-INTVAL (operands[1])), 1, 30) @@ -2135,8 +2135,8 @@ [(set (pc) (if_then_else (match_operator 4 "boolean_operator" [(and:SI (match_operand:SI 0 "register_operand" "r") - (match_operand:SI 1 "shifted_mask_operand" "i")) - (match_operand:SI 2 "const_int_operand" "i")]) + (match_operand:SI 1 "shifted_mask_operand" "")) + (match_operand:SI 2 "const_int_operand" "")]) (label_ref (match_operand 3 "" "")) (pc)))] "/* (INTVAL (operands[2]) & ((1 << ctz_hwi (INTVAL (operands[1]))) - 1)) == 0 // can be omitted @@ -2516,8 +2516,8 @@ }) (define_insn "call_internal" - [(call (mem (match_operand:SI 0 "call_insn_operand" "nir")) - (match_operand 1 "" "i"))] + [(call (mem (match_operand:SI 0 "call_insn_operand" "ir")) + (match_operand 1 "" ""))] "!SIBLING_CALL_P (insn)" { return xtensa_emit_call (0, operands); @@ -2538,8 +2538,8 @@ (define_insn "call_value_internal" [(set (match_operand 0 "register_operand" "=a") - (call (mem (match_operand:SI 1 "call_insn_operand" "nir")) - (match_operand 2 "" "i")))] + (call (mem (match_operand:SI 1 "call_insn_operand" "ir")) + (match_operand 2 "" "")))] "!SIBLING_CALL_P (insn)" { return xtensa_emit_call (1, operands); @@ -2558,8 +2558,8 @@ }) (define_insn "sibcall_internal" - [(call (mem:SI (match_operand:SI 0 "call_insn_operand" "nic")) - (match_operand 1 "" "i"))] + [(call (mem:SI (match_operand:SI 0 "call_insn_operand" "ic")) + (match_operand 1 "" ""))] "!TARGET_WINDOWED_ABI && SIBLING_CALL_P (insn)" { return xtensa_emit_sibcall (0, operands); @@ -2580,8 +2580,8 @@ (define_insn "sibcall_value_internal" [(set (match_operand 0 "register_operand" "=a") - (call (mem:SI (match_operand:SI 1 "call_insn_operand" "nic")) - (match_operand 2 "" "i")))] + (call (mem:SI (match_operand:SI 1 "call_insn_operand" "ic")) + (match_operand 2 "" "")))] "!TARGET_WINDOWED_ABI && SIBLING_CALL_P (insn)" { return xtensa_emit_sibcall (1, operands); @@ -2613,7 +2613,7 @@ (define_insn "entry" [(set (reg:SI A1_REG) - (unspec_volatile:SI [(match_operand:SI 0 "const_int_operand" "i")] + (unspec_volatile:SI [(match_operand:SI 0 "const_int_operand" "")] UNSPECV_ENTRY))] "" "entry\tsp, %0" @@ -3179,7 +3179,7 @@ [(set (match_operand:SI 0 "register_operand" "=a") (match_operator:SI 3 "boolean_operator" [(and:SI (match_operand:SI 1 "register_operand" "r") - (match_operand:SI 2 "const_int_operand" "i")) + (match_operand:SI 2 "const_int_operand" "")) (const_int 0)]))] "IN_RANGE (exact_log2 (INTVAL (operands[2]) + 1), 17, 31) || IN_RANGE (exact_log2 (-INTVAL (operands[2])), 1, 30)" @@ -3237,8 +3237,8 @@ [(set (pc) (if_then_else (match_operator 4 "alt_ubranch_operator" [(plus:SI (match_operand:SI 0 "register_operand" "r") - (match_operand:SI 1 "const_int_operand" "i")) - (match_operand:SI 2 "const_int_operand" "i")]) + (match_operand:SI 1 "const_int_operand" "")) + (match_operand:SI 2 "const_int_operand" "")]) (label_ref (match_operand 3 "")) (pc))) (clobber (match_scratch:SI 5 "=&a"))] diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index fb117f5..882c082 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -6896,15 +6896,14 @@ compiler checks for @code{nocf_check} attribute mismatch and reports a warning in case of mismatch. @smallexample -@{ -int foo (void) __attribute__(nocf_check); -void (*foo1)(void) __attribute__(nocf_check); +int foo (void) __attribute__((nocf_check)); +void (*foo1)(void) __attribute__((nocf_check)); void (*foo2)(void); /* foo's address is assumed to be valid. */ int foo (void) - +@{ /* This call site is not checked for control-flow validity. */ (*foo1)(); diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 792f3c7..7ca0cb0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2025-10-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/122386 + * dependency.cc (gfc_ref_needs_temporary_p): Revert r16-518. + * trans-intrinsic.cc (gfc_conv_intrinsic_transfer): Force temporary + for SOURCE not being a simply-contiguous array. + +2025-10-24 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/121452 + * openmp.cc (resolve_omp_do): Allow CONTINUE as end statement of a + perfectly nested loop. + 2025-10-21 Paul-Antoine Arras <parras@baylibre.com> PR c/120180 diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc index aa8a57a..57c0c49 100644 --- a/gcc/fortran/dependency.cc +++ b/gcc/fortran/dependency.cc @@ -944,12 +944,8 @@ gfc_ref_needs_temporary_p (gfc_ref *ref) types), not in characters. */ return subarray_p; - case REF_INQUIRY: - /* Within an array reference, inquiry references of complex - variables generally need a temporary. */ - return subarray_p; - case REF_COMPONENT: + case REF_INQUIRY: break; } diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 21f256b..67b60c7 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11344,21 +11344,33 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) int dim; gcc_assert (remap->u.ar.dimen == expr1->rank); + /* Always set dtype. */ + tree dtype = gfc_conv_descriptor_dtype (desc); + tmp = gfc_get_dtype (TREE_TYPE (desc)); + gfc_add_modify (&block, dtype, tmp); + + /* For unlimited polymorphic LHS use elem_len from RHS. */ + if (UNLIMITED_POLY (expr1) && expr2->ts.type != BT_CLASS) + { + tree elem_len; + tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr2->ts)); + elem_len = fold_convert (gfc_array_index_type, tmp); + elem_len = gfc_evaluate_now (elem_len, &block); + tmp = gfc_conv_descriptor_elem_len (desc); + gfc_add_modify (&block, tmp, + fold_convert (TREE_TYPE (tmp), elem_len)); + } + if (rank_remap) { /* Do rank remapping. We already have the RHS's descriptor converted in rse and now have to build the correct LHS descriptor for it. */ - tree dtype, data, span; + tree data, span; tree offs, stride; tree lbound, ubound; - /* Set dtype. */ - dtype = gfc_conv_descriptor_dtype (desc); - tmp = gfc_get_dtype (TREE_TYPE (desc)); - gfc_add_modify (&block, dtype, tmp); - /* Copy data pointer. */ data = gfc_conv_descriptor_data_get (rse.expr); gfc_conv_descriptor_data_set (&block, desc, data); diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index d1c2a80..89a03d8 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -2316,10 +2316,14 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) int i; tree fncall0; gfc_array_spec *as; + gfc_symbol *sym = NULL; if (arg->ts.type == BT_CLASS) gfc_add_class_array_ref (arg); + if (arg->expr_type == EXPR_VARIABLE) + sym = arg->symtree->n.sym; + ss = gfc_walk_expr (arg); gcc_assert (ss != gfc_ss_terminator); gfc_init_se (&argse, NULL); @@ -2342,7 +2346,7 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) fncall0 = build_call_expr_loc (input_location, gfor_fndecl_is_contiguous0, 1, desc); se->expr = fncall0; - se->expr = convert (logical_type_node, se->expr); + se->expr = convert (boolean_type_node, se->expr); } else { @@ -2374,6 +2378,22 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) } se->expr = cond; } + + /* A pointer that does not have the CONTIGUOUS attribute needs to be checked + if it points to an array whose span differs from the element size. */ + if (as && sym && IS_POINTER(sym) && !sym->attr.contiguous) + { + tree span = gfc_conv_descriptor_span_get (desc); + tmp = fold_convert (TREE_TYPE (span), + gfc_conv_descriptor_elem_len (desc)); + cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + span, tmp); + se->expr = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, + boolean_type_node, cond, + convert (boolean_type_node, se->expr)); + } + + gfc_free_ss_chain (ss); } @@ -8728,13 +8748,18 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) } else { + bool simply_contiguous = gfc_is_simply_contiguous (arg->expr, + false, true); argse.want_pointer = 0; + /* A non-contiguous SOURCE needs packing. */ + if (!simply_contiguous) + argse.force_tmp = 1; gfc_conv_expr_descriptor (&argse, arg->expr); source = gfc_conv_descriptor_data_get (argse.expr); source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); /* Repack the source if not simply contiguous. */ - if (!gfc_is_simply_contiguous (arg->expr, false, true)) + if (!simply_contiguous) { tmp = gfc_build_addr_expr (NULL_TREE, argse.expr); diff --git a/gcc/gimple-range-fold.cc b/gcc/gimple-range-fold.cc index d18b37b..06c645f 100644 --- a/gcc/gimple-range-fold.cc +++ b/gcc/gimple-range-fold.cc @@ -1187,6 +1187,17 @@ fold_using_range::condexpr_adjust (vrange &r1, vrange &r2, gimple *, tree cond, ssa2, src)) r2.intersect (tmp2); } + // If the same name is specified in the condition and COND_EXPR, + // combine the calculated condition range and the other one provided. ie: + // c_1 = b_2 < 10 + // f_3 = c_1 ? 0 : b_2 + // With b_2 providing the false value, the value of f_3 will be + // either 0 UNION (0 = b_2 < 10), which is [-INF, 9]. + // COND_EXPR is + if (ssa1 && cond_name == ssa1) + r1 = cond_true; + else if (ssa2 && cond_name == ssa2) + r2 = cond_false; return true; } diff --git a/gcc/m2/ChangeLog b/gcc/m2/ChangeLog index b605bf2..155c082 100644 --- a/gcc/m2/ChangeLog +++ b/gcc/m2/ChangeLog @@ -1,3 +1,79 @@ +2025-10-24 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/122407 + * gm2-compiler/FilterError.def (Copyright): Use correct + licence. + * gm2-compiler/FilterError.mod (Copyright): Ditto. + * gm2-compiler/M2Quads.mod (BuildNewProcedure): Rewrite. + (BuildIncProcedure): Ditto. + (BuildDecProcedure): Ditto. + (BuildInclProcedure): Ditto. + (BuildExclProcedure): Ditto. + (BuildAbsFunction): Ditto. + (BuildCapFunction): Ditto. + (BuildChrFunction): Ditto. + (BuildOrdFunction): Ditto. + (BuildIntFunction): Ditto. + (BuildMinFunction): Ditto. + (BuildMaxFunction): Ditto. + (BuildTruncFunction): Ditto. + (BuildTBitSizeFunction): Ditto. + (BuildTSizeFunction): Ditto. + (BuildSizeFunction): Ditto. + +2025-10-24 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/122407 + * Make-lang.in (GM2-LIBS-BOOT-DEFS): Add BinDict.def. + (GM2-LIBS-BOOT-MODS): Add BinDict.mod. + (GM2-COMP-BOOT-DEFS): Add FilterError.def. + (GM2-COMP-BOOT-MODS): Add FilterError.mod. + (GM2-LIBS-DEFS): Add BinDict.def. + (GM2-LIBS-MODS): Add BinDict.mod. + * gm2-compiler/M2Error.def (KillError): New procedure. + * gm2-compiler/M2Error.mod (WriteFormat3): Reformat. + (NewError): Rewrite and call AddToList. + (AddToList): New procedure. + (SubFromList): Ditto. + (WipeReferences): Ditto. + (KillError): Ditto. + * gm2-compiler/M2LexBuf.mod (MakeVirtualTok): Return + caret if all token positions are identical. + * gm2-compiler/M2MetaError.mod (KillError): Import. + (FilterError): Import. + (FilterUnknown): New global. + (initErrorBlock): Initialize symcause and token. + (push): Capitalize comments. + (pop): Copy symcause to toblock if discovered. + (doError): Add parameter sym. + (defaultError): Assign token if discovered. + Pass NulSym to doError. + (updateTokSym): New procedure. + (chooseError): Call updateTokSym. + (doErrorScopeModule): Pass sym to doError. + (doErrorScopeForward): Ditto. + (doErrorScopeMod): Ditto. + (doErrorScopeFor): Ditto. + (doErrorScopeDefinition): Ditto. + (doErrorScopeDef): Ditto. + (doErrorScopeProc): Ditto. + (used): Pass sym[bol] to doError. + (op): Assign symcause when encountering + an error, warning or note. + (MetaErrorStringT1): Rewrite. + (MetaErrorStringT2): Ditto. + (MetaErrorStringT3): Ditto. + (MetaErrorStringT4): Ditto. + (isUniqueError): New procedure function. + (wrapErrors): Rewrite. + (FilterUnknown): Initialize. + * gm2-compiler/M2Quads.mod (BuildTSizeFunction): Add spell check + hint specifier. + * gm2-compiler/FilterError.def: New file. + * gm2-compiler/FilterError.mod: New file. + * gm2-libs/BinDict.def: New file. + * gm2-libs/BinDict.mod: New file. + 2025-10-19 Gaius Mulley <gaiusmod2@gmail.com> PR modula2/122333 diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in index cd4dc9f..110a8a1 100644 --- a/gcc/m2/Make-lang.in +++ b/gcc/m2/Make-lang.in @@ -671,6 +671,7 @@ GM2-LIBS-BOOT-DEFS = \ ASCII.def \ Args.def \ Assertion.def \ + BinDict.def \ Break.def \ CmdArgs.def \ Debug.def \ @@ -718,6 +719,7 @@ GM2-LIBS-BOOT-MODS = \ ASCII.mod \ Args.mod \ Assertion.mod \ + BinDict.mod \ Break.mod \ CmdArgs.mod \ Debug.mod \ @@ -769,6 +771,7 @@ GM2-LIBS-BOOT-CC = \ # Definition modules for the front end found in gm2-compiler. GM2-COMP-BOOT-DEFS = \ + FilterError.def \ FifoQueue.def \ Lists.def \ M2ALU.def \ @@ -845,6 +848,7 @@ GM2-COMP-BOOT-DEFS = \ # Implementation modules for the front end found in gm2-compiler. GM2-COMP-BOOT-MODS = \ + FilterError.mod \ FifoQueue.mod \ Lists.mod \ Lists.mod \ @@ -946,6 +950,7 @@ GM2-LIBS-DEFS = \ ASCII.def \ Args.def \ Assertion.def \ + BinDict.def \ Break.def \ Builtins.def \ COROUTINES.def \ @@ -1000,6 +1005,7 @@ GM2-LIBS-MODS = \ ASCII.mod \ Args.mod \ Assertion.mod \ + BinDict.mod \ Break.mod \ Builtins.mod \ COROUTINES.mod \ @@ -1062,6 +1068,7 @@ GM2-LIBS-CC = \ # cc1gm2$(exeext) uses these definition modules found in the gm2-compiler directory. GM2-COMP-DEFS = \ + FilterError.def \ FifoQueue.def \ Lists.def \ M2ALU.def \ @@ -1135,6 +1142,7 @@ GM2-COMP-DEFS = \ # cc1gm2$(exeext) uses these implementation modules found in the gm2-compiler directory. GM2-COMP-MODS = \ + FilterError.mod \ FifoQueue.mod \ Lists.mod \ M2ALU.mod \ diff --git a/gcc/m2/gm2-compiler/FilterError.def b/gcc/m2/gm2-compiler/FilterError.def new file mode 100644 index 0000000..2a8e96c --- /dev/null +++ b/gcc/m2/gm2-compiler/FilterError.def @@ -0,0 +1,56 @@ +(* FilterError.def provides a filter for token and symbol. + +Copyright (C) 2025 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaiusmod2@gmail.com>. + +This file is part of GNU Modula-2. + +GNU Modula-2 is free software; you can 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. + +GNU Modula-2 is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Modula-2; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. *) + +DEFINITION MODULE FilterError ; + +TYPE + Filter ; + + +(* + Init - return a new empty Filter. +*) + +PROCEDURE Init () : Filter ; + + +(* + AddSymError - adds the pair sym token to the filter. +*) + +PROCEDURE AddSymError (filter: Filter; + sym: CARDINAL; token: CARDINAL) ; + +(* + IsSymError - return TRUE if the pair sym token have been entered in the filter. +*) + +PROCEDURE IsSymError (filter: Filter; sym: CARDINAL; token: CARDINAL) : BOOLEAN ; + + +(* + Kill - deletes the entire filter tree. +*) + +PROCEDURE Kill (VAR filter: Filter) ; + + +END FilterError. diff --git a/gcc/m2/gm2-compiler/FilterError.mod b/gcc/m2/gm2-compiler/FilterError.mod new file mode 100644 index 0000000..6f2b2f3 --- /dev/null +++ b/gcc/m2/gm2-compiler/FilterError.mod @@ -0,0 +1,224 @@ +(* FilterError.mod implements a filter for token and symbol. + +Copyright (C) 2025 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaiusmod2@gmail.com>. + +This file is part of GNU Modula-2. + +GNU Modula-2 is free software; you can 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. + +GNU Modula-2 is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Modula-2; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. *) + +IMPLEMENTATION MODULE FilterError ; + +(* The purpose of this module is to be able to filter out multiple error + reports refering to the same symbol and token. This is achieved by + maintaining a dictionary of symbols each pointing to a dictionary of + tokens. *) + +FROM SYSTEM IMPORT ADDRESS, ADR ; +FROM Storage IMPORT DEALLOCATE, ALLOCATE ; +FROM BinDict IMPORT Node ; +FROM Assertion IMPORT Assert ; +FROM libc IMPORT printf ; + +IMPORT BinDict ; + +CONST + Debugging = FALSE ; + +TYPE + Filter = POINTER TO RECORD + Sym2Dict: BinDict.Dictionary ; + END ; + + PtrToCardinal = POINTER TO CARDINAL ; + PtrToBoolean = POINTER TO BOOLEAN ; + + +(* + Init - return a new empty Filter. +*) + +PROCEDURE Init () : Filter ; +VAR + filter: Filter ; +BEGIN + NEW (filter) ; + WITH filter^ DO + Sym2Dict := BinDict.Init (CompareCardinal, DeleteCardinal, DeleteTree) ; + END ; + RETURN filter +END Init ; + + +(* + Kill - deletes the entire filter tree and all contents. +*) + +PROCEDURE Kill (VAR filter: Filter) ; +BEGIN + BinDict.Kill (filter^.Sym2Dict) ; + DISPOSE (filter) +END Kill ; + + +(* + CompareCardinal - return an INTEGER representing the comparison + between left and right. + 0 if left == right, -1 if left < right, + +1 if left > right. +*) + +PROCEDURE CompareCardinal (left, right: PtrToCardinal) : INTEGER ; +BEGIN + IF left^ = right^ + THEN + RETURN 0 + ELSIF left^ < right^ + THEN + RETURN -1 + ELSE + RETURN 1 + END +END CompareCardinal ; + + +(* + DeleteCardinal - deallocate the cardinal key. +*) + +PROCEDURE DeleteCardinal (card: PtrToCardinal) ; +BEGIN + DISPOSE (card) +END DeleteCardinal ; + + +(* + DeleteBoolean - deallocate the boolean value. +*) + +PROCEDURE DeleteBoolean (boolean: PtrToBoolean) ; +BEGIN + DISPOSE (boolean) +END DeleteBoolean ; + + +(* + DeleteTree - delete tree and all its contents. +*) + +PROCEDURE DeleteTree (ErrorTree: BinDict.Dictionary) ; +BEGIN + BinDict.Kill (ErrorTree) +END DeleteTree ; + + +(* + AddSymError - adds the pair sym token to the filter. +*) + +PROCEDURE AddSymError (filter: Filter; + sym: CARDINAL; token: CARDINAL) ; +BEGIN + IF NOT IsSymError (filter, sym, token) + THEN + AddNewEntry (filter, sym, token, TRUE) + END +END AddSymError ; + + +(* + AddNewEntry - adds a new value to the sym token pair. +*) + +PROCEDURE AddNewEntry (filter: Filter; sym: CARDINAL; + token: CARDINAL; value: BOOLEAN) ; +VAR + TokenTree : BinDict.Dictionary ; + ptrToToken, + ptrToCard : PtrToCardinal ; + ptrToBool : PtrToBoolean ; +BEGIN + TokenTree := BinDict.Get (filter^.Sym2Dict, ADR (sym)) ; + IF TokenTree = NIL + THEN + TokenTree := BinDict.Init (CompareCardinal, DeleteCardinal, DeleteBoolean) ; + NEW (ptrToCard) ; + ptrToCard^ := sym ; + BinDict.Insert (filter^.Sym2Dict, ptrToCard, TokenTree) ; + Assert (BinDict.Get (filter^.Sym2Dict, ptrToCard) = TokenTree) + END ; + NEW (ptrToBool) ; + ptrToBool^ := value ; + NEW (ptrToToken) ; + ptrToToken^ := token ; + IF Debugging + THEN + printf ("adding sym %d: key = 0x%x, value = 0x%x (%d, %d)\n", + sym, ptrToToken, ptrToBool, ptrToToken^, ptrToBool^) + END ; + BinDict.Insert (TokenTree, ptrToToken, ptrToBool) ; + Assert (BinDict.Get (TokenTree, ptrToToken) = ptrToBool) ; + IF Debugging + THEN + BinDict.PostOrder (TokenTree, PrintNode) + END +END AddNewEntry ; + + +(* + PrintNode - +*) + +PROCEDURE PrintNode (node: Node) ; +VAR + ptrToCard : PtrToCardinal ; + ptrToBool : PtrToBoolean ; +BEGIN + ptrToCard := BinDict.Key (node) ; + ptrToBool := BinDict.Value (node) ; + printf ("key = 0x%x, value = 0x%x (%d, %d)\n", + ptrToCard, ptrToBool, ptrToCard^, ptrToBool^) +END PrintNode ; + + +(* + IsSymError - return TRUE if the pair sym token have been + entered in the filter. +*) + +PROCEDURE IsSymError (filter: Filter; sym: CARDINAL; token: CARDINAL) : BOOLEAN ; +VAR + ptb : PtrToBoolean ; + TokenTree: BinDict.Dictionary ; +BEGIN + TokenTree := BinDict.Get (filter^.Sym2Dict, ADR (sym)) ; + (* RETURN (TokenTree # NIL) ; *) + IF TokenTree = NIL + THEN + (* No symbol registered, therefore FALSE. *) + RETURN FALSE + END ; + ptb := BinDict.Get (TokenTree, ADR (token)) ; + IF ptb = NIL + THEN + (* The symbol was registered, but no entry for token, therefore FALSE. *) + RETURN FALSE + END ; + (* Found symbol and token so we return the result. *) + RETURN ptb^ +END IsSymError ; + + +END FilterError. diff --git a/gcc/m2/gm2-compiler/M2Error.def b/gcc/m2/gm2-compiler/M2Error.def index 427bd08..7f945e4 100644 --- a/gcc/m2/gm2-compiler/M2Error.def +++ b/gcc/m2/gm2-compiler/M2Error.def @@ -130,6 +130,14 @@ PROCEDURE MoveError (e: Error; AtTokenNo: CARDINAL) : Error ; (* + KillError - remove error e from the error list and deallocate + memory associated with e. +*) + +PROCEDURE KillError (VAR e: Error) ; + + +(* SetColor - informs the error module that this error will have had colors assigned to it. If an error is issued without colors assigned then the default colors will be assigned to the legacy error diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod index 561f42c..095e732 100644 --- a/gcc/m2/gm2-compiler/M2Error.mod +++ b/gcc/m2/gm2-compiler/M2Error.mod @@ -369,8 +369,8 @@ PROCEDURE WriteFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ; VAR e: Error ; BEGIN - e := NewError(GetTokenNo()) ; - e^.s := DoFormat3(a, w1, w2, w3) + e := NewError (GetTokenNo ()) ; + e^.s := DoFormat3 (a, w1, w2, w3) END WriteFormat3 ; @@ -394,7 +394,7 @@ END MoveError ; PROCEDURE NewError (AtTokenNo: CARDINAL) : Error ; VAR - e, f: Error ; + e: Error ; BEGIN IF AtTokenNo = UnknownTokenNo THEN @@ -414,18 +414,7 @@ BEGIN END ; (* Assert (scopeKind # noscope) ; *) e^.scope := currentScope ; - IF (head=NIL) OR (head^.token>AtTokenNo) - THEN - e^.next := head ; - head := e - ELSE - f := head ; - WHILE (f^.next#NIL) AND (f^.next^.token<AtTokenNo) DO - f := f^.next - END ; - e^.next := f^.next ; - f^.next := e - END ; + AddToList (e) ; RETURN( e ) END NewError ; @@ -463,6 +452,95 @@ END NewNote ; (* + AddToList - adds error e to the list of errors in token order. +*) + +PROCEDURE AddToList (e: Error) ; +VAR + f: Error ; +BEGIN + IF (head=NIL) OR (head^.token > e^.token) + THEN + e^.next := head ; + head := e + ELSE + f := head ; + WHILE (f^.next # NIL) AND (f^.next^.token < e^.token) DO + f := f^.next + END ; + e^.next := f^.next ; + f^.next := e + END ; +END AddToList ; + + +(* + SubFromList - remove e from the global list. +*) + +PROCEDURE SubFromList (e: Error) ; +VAR + f: Error ; +BEGIN + IF head = e + THEN + head := head^.next + ELSE + f := head ; + WHILE (f # NIL) AND (f^.next # e) DO + f := f^.next + END ; + IF (f # NIL) AND (f^.next = e) + THEN + f^.next := e^.next + ELSE + InternalError ('expecting e to be on the global list') + END + END ; + DISPOSE (e) +END SubFromList ; + + +(* + WipeReferences - remove any reference to e from the global list. +*) + +PROCEDURE WipeReferences (e: Error) ; +VAR + f: Error ; +BEGIN + f := head ; + WHILE f # NIL DO + IF f^.parent = e + THEN + f^.parent := NIL + END ; + IF f^.child = e + THEN + f^.child := NIL + END ; + f := f^.next + END +END WipeReferences ; + + +(* + KillError - remove error e from the error list and deallocate + memory associated with e. +*) + +PROCEDURE KillError (VAR e: Error) ; +BEGIN + IF head # NIL + THEN + SubFromList (e) ; + WipeReferences (e) ; + e := NIL + END +END KillError ; + + +(* ChainError - creates and returns a new error handle, this new error is associated with, e, and is chained onto the end of, e. If, e, is NIL then the result to NewError is returned. diff --git a/gcc/m2/gm2-compiler/M2LexBuf.mod b/gcc/m2/gm2-compiler/M2LexBuf.mod index 143190e0..5198243 100644 --- a/gcc/m2/gm2-compiler/M2LexBuf.mod +++ b/gcc/m2/gm2-compiler/M2LexBuf.mod @@ -1078,6 +1078,10 @@ BEGIN THEN caret := right END ; + IF (caret = left) AND (left = right) + THEN + RETURN caret + END ; IF isSrcToken (caret) AND isSrcToken (left) AND isSrcToken (right) THEN lc := TokenToLocation (caret) ; diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod index dc14e6b..aae0f02 100644 --- a/gcc/m2/gm2-compiler/M2MetaError.mod +++ b/gcc/m2/gm2-compiler/M2MetaError.mod @@ -26,7 +26,11 @@ FROM M2Base IMPORT ZType, RType, IsPseudoBaseFunction, IsPseudoBaseProcedure ; FROM NameKey IMPORT Name, KeyToCharStar, NulName ; FROM StrLib IMPORT StrLen ; FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ; -FROM M2Error IMPORT Error, NewError, NewWarning, NewNote, ErrorString, InternalError, ChainError, SetColor, FlushErrors, FlushWarnings ; + +FROM M2Error IMPORT Error, NewError, KillError, + NewWarning, NewNote, ErrorString, InternalError, + ChainError, SetColor, FlushErrors, FlushWarnings ; + FROM FIO IMPORT StdOut, WriteLine ; FROM SFIO IMPORT WriteS ; FROM StringConvert IMPORT ctos ; @@ -67,6 +71,9 @@ FROM SymbolTable IMPORT NulSym, IMPORT M2ColorString ; IMPORT M2Error ; +IMPORT FilterError ; + +FROM FilterError IMPORT Filter, AddSymError, IsSymError ; CONST @@ -85,6 +92,8 @@ TYPE errorBlock = RECORD useError : BOOLEAN ; e : Error ; + symcause : CARDINAL ; (* The symbol (or NulSym) associated with the token no. *) + token : CARDINAL ; type : errorType ; out, in : String ; highplus1 : CARDINAL ; @@ -115,12 +124,13 @@ TYPE VAR - lastRoot : Error ; - lastColor : colorType ; - seenAbort : BOOLEAN ; - dictionary : Index ; - outputStack: Index ; - freeEntry : dictionaryEntry ; + lastRoot : Error ; + lastColor : colorType ; + seenAbort : BOOLEAN ; + dictionary : Index ; + outputStack : Index ; + freeEntry : dictionaryEntry ; + FilterUnknown: Filter ; (* @@ -513,6 +523,8 @@ BEGIN WITH eb DO useError := TRUE ; e := NIL ; + symcause := NulSym ; + token := UnknownTokenNo ; type := error ; (* Default to the error color. *) out := InitString ('') ; in := input ; @@ -543,9 +555,9 @@ END initErrorBlock ; PROCEDURE push (VAR newblock: errorBlock; oldblock: errorBlock) ; BEGIN - pushColor (oldblock) ; (* save the current color. *) - newblock := oldblock ; (* copy all the fields. *) - newblock.out := NIL ; (* must do this before a clear as we have copied the address. *) + pushColor (oldblock) ; (* Save the current color. *) + newblock := oldblock ; (* Now copy all the fields. *) + newblock.out := NIL ; (* We must do this before a clear as we have copied the address. *) clear (newblock) ; newblock.quotes := TRUE END push ; @@ -604,6 +616,10 @@ BEGIN THEN toblock.e := fromblock.e END ; + IF toblock.symcause = NulSym + THEN + toblock.symcause := fromblock.symcause + END ; toblock.chain := fromblock.chain ; toblock.root := fromblock.root ; toblock.ini := fromblock.ini ; @@ -1173,35 +1189,54 @@ END doChain ; doError - creates and returns an error note. *) -PROCEDURE doError (VAR eb: errorBlock; tok: CARDINAL) ; +PROCEDURE doError (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ; BEGIN IF eb.useError THEN - chooseError (eb, tok) + chooseError (eb, tok, sym) END END doError ; (* - defaultError - adds the default error location to, tok, if one has not already been - assigned. + defaultError - adds the default error location to, tok, + if one has not already been assigned. *) PROCEDURE defaultError (VAR eb: errorBlock; tok: CARDINAL) ; BEGIN IF eb.e = NIL THEN - doError (eb, tok) + doError (eb, tok, NulSym) + END ; + IF eb.token = UnknownTokenNo + THEN + eb.token := tok END END defaultError ; (* + updateTokSym - assign symcause to sym if not NulSym. + Update token. +*) + +PROCEDURE updateTokSym (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ; +BEGIN + IF sym # NulSym + THEN + eb.symcause := sym + END ; + eb.token := tok +END updateTokSym ; + + +(* chooseError - choose the error kind dependant upon type. Either an error, warning or note will be generated. *) -PROCEDURE chooseError (VAR eb: errorBlock; tok: CARDINAL) ; +PROCEDURE chooseError (VAR eb: errorBlock; tok: CARDINAL; sym: CARDINAL) ; BEGIN IF eb.chain THEN @@ -1217,19 +1252,22 @@ BEGIN eb.e := NewError (tok) ELSE eb.e := MoveError (eb.e, tok) - END | + END ; + updateTokSym (eb, tok, sym) | warning: IF eb.e=NIL THEN eb.e := NewWarning (tok) ELSE eb.e := MoveError (eb.e, tok) - END | + END ; + updateTokSym (eb, tok, sym) | note : IF eb.e=NIL THEN eb.e := NewNote (tok) ELSE eb.e := MoveError (eb.e, tok) - END + END ; + updateTokSym (eb, tok, sym) ELSE InternalError ('unexpected enumeration value') @@ -1257,9 +1295,9 @@ BEGIN THEN IF IsInnerModule (scope) THEN - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) END ELSE Assert (IsDefImp (scope)) ; @@ -1269,9 +1307,9 @@ BEGIN UNTIL GetScope(OuterModule)=NulSym. *) IF GetDeclaredModule (sym) = UnknownTokenNo THEN - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSE - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) END END END doErrorScopeModule ; @@ -1290,9 +1328,9 @@ BEGIN THEN IF IsInnerModule (scope) THEN - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) ELSE - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) END ELSE Assert (IsDefImp (scope)) ; @@ -1302,9 +1340,9 @@ BEGIN UNTIL GetScope(OuterModule)=NulSym. *) IF GetDeclaredModule (sym) = UnknownTokenNo THEN - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSE - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) END END END doErrorScopeForward ; @@ -1324,12 +1362,12 @@ BEGIN IF scope = NulSym THEN M2Error.EnterErrorScope (NIL) ; - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE M2Error.EnterErrorScope (GetErrorScope (scope)) ; IF IsProcedure (scope) THEN - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE doErrorScopeModule (eb, sym) END @@ -1353,12 +1391,12 @@ BEGIN IF scope = NulSym THEN M2Error.EnterErrorScope (NIL) ; - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) ELSE M2Error.EnterErrorScope (GetErrorScope (scope)) ; IF IsProcedure (scope) THEN - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) ELSE doErrorScopeForward (eb, sym) END @@ -1392,16 +1430,16 @@ BEGIN IF IsModule (scope) THEN (* No definition module for a program module. *) - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE Assert (IsDefImp (scope)) ; IF GetDeclaredDefinition (sym) = UnknownTokenNo THEN (* Fall back to the implementation module if no declaration exists in the definition module. *) - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) END END END doErrorScopeDefinition ; @@ -1421,12 +1459,12 @@ BEGIN IF scope = NulSym THEN M2Error.EnterErrorScope (NIL) ; - doError (eb, GetDeclaredFor (sym)) + doError (eb, GetDeclaredFor (sym), sym) ELSE M2Error.EnterErrorScope (GetErrorScope (scope)) ; IF IsProcedure (scope) THEN - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSE doErrorScopeDefinition (eb, sym) END @@ -1477,25 +1515,25 @@ BEGIN IF scope = NulSym THEN M2Error.EnterErrorScope (NIL) ; - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSE M2Error.EnterErrorScope (GetErrorScope (scope)) ; IF IsVar (sym) OR IsParameter (sym) THEN - doError (eb, GetVarParamTok (sym)) + doError (eb, GetVarParamTok (sym), sym) ELSIF IsProcedure (scope) THEN - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) ELSIF IsModule (scope) THEN - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE Assert (IsDefImp (scope)) ; IF GetDeclaredDefinition (sym) = UnknownTokenNo THEN - doError (eb, GetDeclaredMod (sym)) + doError (eb, GetDeclaredMod (sym), sym) ELSE - doError (eb, GetDeclaredDef (sym)) + doError (eb, GetDeclaredDef (sym), sym) END END END ; @@ -1550,7 +1588,7 @@ PROCEDURE used (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ; BEGIN IF bol <= HIGH (sym) THEN - doError (eb, GetFirstUsed (sym[bol])) + doError (eb, GetFirstUsed (sym[bol]), sym[bol]) END END used ; @@ -1755,7 +1793,8 @@ BEGIN 'B': declaredType (eb, sym, bol) | 'C': eb.chain := TRUE | 'D': declaredDef (eb, sym, bol) | - 'E': eb.type := error | + 'E': eb.type := error ; + eb.symcause := sym[bol] | 'F': filename (eb) ; DEC (eb.ini) | 'G': declaredFor (eb, sym, bol) | @@ -1764,7 +1803,8 @@ BEGIN DEC (eb.ini) | 'M': declaredMod (eb, sym, bol) | 'N': doCount (eb, sym, bol) | - 'O': eb.type := note | + 'O': eb.type := note ; + eb.symcause := sym[bol] | 'P': pushColor (eb) | 'Q': resetDictionary | 'R': eb.root := TRUE | @@ -1772,7 +1812,8 @@ BEGIN 'T': doGetType (eb, sym, bol) | 'U': used (eb, sym, bol) | 'V': declaredVar (eb, sym, bol) | - 'W': eb.type := warning | + 'W': eb.type := warning ; + eb.symcause := sym[bol] | 'X': pushOutput (eb) | 'Y': processDefine (eb) | 'Z': popOutput (eb) | @@ -2402,7 +2443,12 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + ErrorString (eb.e, Dup (eb.out)) ; + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) ; checkAbort END MetaErrorStringT1 ; @@ -2425,7 +2471,12 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + ErrorString (eb.e, Dup (eb.out)) + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) ; checkAbort END MetaErrorStringT2 ; @@ -2450,7 +2501,12 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + ErrorString (eb.e, Dup (eb.out)) + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) ; checkAbort END MetaErrorStringT3 ; @@ -2475,7 +2531,12 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + ErrorString (eb.e, Dup (eb.out)) + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) ; checkAbort END MetaErrorStringT4 ; @@ -2518,6 +2579,31 @@ END MetaError4 ; (* + isUniqueError - return TRUE if the symbol associated with the + error block is unknown and we have seen the same + token before. +*) + +PROCEDURE isUniqueError (VAR eb: errorBlock) : BOOLEAN ; +BEGIN + IF (eb.symcause # NulSym) AND IsUnknown (eb.symcause) + THEN + (* A candidate for filtering. *) + IF IsSymError (FilterUnknown, eb.symcause, eb.token) + THEN + (* Seen and reported about this unknown and token + location before. *) + RETURN FALSE + ELSE + (* Remember this combination. *) + AddSymError (FilterUnknown, eb.symcause, eb.token) + END + END ; + RETURN TRUE +END isUniqueError ; + + +(* wrapErrors - *) @@ -2531,15 +2617,20 @@ BEGIN ebnf (eb, sym) ; flushColor (eb) ; defaultError (eb, tok) ; - lastRoot := eb.e ; - ErrorString (eb.e, Dup (eb.out)) ; - killErrorBlock (eb) ; - initErrorBlock (eb, InitString (m2), sym) ; - eb.type := chained ; - ebnf (eb, sym) ; - flushColor (eb) ; - defaultError (eb, tok) ; - ErrorString (eb.e, Dup (eb.out)) ; + IF isUniqueError (eb) + THEN + lastRoot := eb.e ; + ErrorString (eb.e, Dup (eb.out)) ; + killErrorBlock (eb) ; + initErrorBlock (eb, InitString (m2), sym) ; + eb.type := chained ; + ebnf (eb, sym) ; + flushColor (eb) ; + defaultError (eb, tok) ; + ErrorString (eb.e, Dup (eb.out)) + ELSE + KillError (eb.e) + END ; killErrorBlock (eb) END wrapErrors ; @@ -2871,5 +2962,6 @@ BEGIN seenAbort := FALSE ; outputStack := InitIndex (1) ; dictionary := InitIndex (1) ; - freeEntry := NIL + freeEntry := NIL ; + FilterUnknown := FilterError.Init () END M2MetaError. diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 3bdf8c5..5ceeb4f 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -7244,7 +7244,8 @@ BEGIN PushT (2) ; (* Two parameters *) BuildProcedureCall (combinedtok) ELSE - MetaErrorT0 (paramtok, 'parameter to {%EkNEW} must be a pointer') + MetaErrorT1 (paramtok, 'parameter to {%EkNEW} must be a pointer,' + + ' seen {%1Ed} {%1&s}', PtrSym) END ELSE MetaErrorT0 (functok, '{%E}ALLOCATE procedure not found for NEW substitution') @@ -7333,7 +7334,8 @@ BEGIN PushT (2) ; (* Two parameters *) BuildProcedureCall (combinedtok) ELSE - MetaErrorT0 (paramtok, 'argument to {%EkDISPOSE} must be a pointer') + MetaErrorT1 (paramtok, 'argument to {%EkDISPOSE} must be a pointer,' + + ' seen {%1Ed} {%1&s}', PtrSym) END ELSE MetaErrorT0 (functok, '{%E}DEALLOCATE procedure not found for DISPOSE substitution') @@ -7442,6 +7444,7 @@ END CheckRangeIncDec ; PROCEDURE BuildIncProcedure (proctok: CARDINAL) ; VAR + vartok : CARDINAL ; NoOfParam, dtype, OperandSym, @@ -7452,6 +7455,7 @@ BEGIN IF (NoOfParam = 1) OR (NoOfParam = 2) THEN VarSym := OperandT (NoOfParam) ; (* Bottom/first parameter. *) + vartok := OperandTok (NoOfParam) ; IF IsVar (VarSym) THEN dtype := GetDType (VarSym) ; @@ -7464,13 +7468,13 @@ BEGIN PopT (OperandSym) END ; - PushTtok (VarSym, proctok) ; - TempSym := DereferenceLValue (proctok, VarSym) ; + PushTtok (VarSym, vartok) ; + TempSym := DereferenceLValue (vartok, VarSym) ; CheckRangeIncDec (proctok, TempSym, OperandSym, PlusTok) ; (* TempSym + OperandSym. *) BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym := TempSym + OperandSym. *) ELSE - MetaErrorT1 (proctok, - 'base procedure {%EkINC} expects a variable as a parameter but was given {%1Ed}', + MetaErrorT1 (vartok, + 'base procedure {%EkINC} expects a variable as a parameter but was given {%1Ed} {%1&s}', VarSym) END ELSE @@ -7513,6 +7517,7 @@ END BuildIncProcedure ; PROCEDURE BuildDecProcedure (proctok: CARDINAL) ; VAR + vartok : CARDINAL ; NoOfParam, dtype, OperandSym, @@ -7523,6 +7528,7 @@ BEGIN IF (NoOfParam = 1) OR (NoOfParam = 2) THEN VarSym := OperandT (NoOfParam) ; (* Bottom/first parameter. *) + vartok := OperandTok (NoOfParam) ; IF IsVar (VarSym) THEN dtype := GetDType (VarSym) ; @@ -7535,13 +7541,13 @@ BEGIN PopT (OperandSym) END ; - PushTtok (VarSym, proctok) ; - TempSym := DereferenceLValue (OperandTok (NoOfParam), VarSym) ; + PushTtok (VarSym, vartok) ; + TempSym := DereferenceLValue (vartok, VarSym) ; CheckRangeIncDec (proctok, TempSym, OperandSym, MinusTok) ; (* TempSym - OperandSym. *) BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym := TempSym - OperandSym. *) ELSE - MetaErrorT1 (proctok, - 'base procedure {%EkDEC} expects a variable as a parameter but was given {%1Ed}', + MetaErrorT1 (vartok, + 'base procedure {%EkDEC} expects a variable as a parameter but was given {%1Ed} {%1&s}', VarSym) END ELSE @@ -7604,6 +7610,7 @@ END DereferenceLValue ; PROCEDURE BuildInclProcedure (proctok: CARDINAL) ; VAR + vartok, optok : CARDINAL ; NoOfParam, DerefSym, @@ -7614,6 +7621,7 @@ BEGIN IF NoOfParam = 2 THEN VarSym := OperandT (2) ; + vartok := OperandTok (2) ; MarkArrayWritten (OperandA (2)) ; OperandSym := OperandT (1) ; optok := OperandTok (1) ; @@ -7625,14 +7633,14 @@ BEGIN BuildRange (InitInclCheck (VarSym, DerefSym)) ; GenQuadO (proctok, InclOp, VarSym, NulSym, DerefSym, FALSE) ELSE - MetaErrorT1 (proctok, - 'the first parameter to {%EkINCL} must be a set variable but is {%1Ed}', - VarSym) + MetaErrorT1 (vartok, + 'the first parameter to {%EkINCL} must be a set variable,' + + ' seen {%1Ed} {%1&s}', VarSym) END ELSE - MetaErrorT1 (proctok, - 'base procedure {%EkINCL} expects a variable as a parameter but is {%1Ed}', - VarSym) + MetaErrorT1 (vartok, + 'base procedure {%EkINCL} expects a variable as a parameter,' + + ' seen {%1Ed} {%1&s}', VarSym) END ELSE MetaErrorT0 (proctok, 'the base procedure {%EkINCL} expects 1 or 2 parameters') @@ -7668,6 +7676,7 @@ END BuildInclProcedure ; PROCEDURE BuildExclProcedure (proctok: CARDINAL) ; VAR + vartok, optok : CARDINAL ; NoOfParam, DerefSym, @@ -7678,6 +7687,7 @@ BEGIN IF NoOfParam=2 THEN VarSym := OperandT (2) ; + vartok := OperandTok (2) ; MarkArrayWritten (OperandA(2)) ; OperandSym := OperandT (1) ; optok := OperandTok (1) ; @@ -7689,14 +7699,14 @@ BEGIN BuildRange (InitExclCheck (VarSym, DerefSym)) ; GenQuadO (proctok, ExclOp, VarSym, NulSym, DerefSym, FALSE) ELSE - MetaErrorT1 (proctok, - 'the first parameter to {%EkEXCL} must be a set variable but is {%1Ed}', - VarSym) + MetaErrorT1 (vartok, + 'the first parameter to {%EkEXCL} must be a set variable,' + + ' seen {%1Ed} {%1&s}', VarSym) END ELSE - MetaErrorT1 (proctok, - 'base procedure {%EkEXCL} expects a variable as a parameter but is {%1Ed}', - VarSym) + MetaErrorT1 (vartok, + 'base procedure {%EkEXCL} expects a variable as a parameter,' + + ' seen {%1Ed} {%1&s}', VarSym) END ELSE MetaErrorT0 (proctok, @@ -7986,7 +7996,7 @@ BEGIN proctok := OperandTok (NoOfParam+1) ; IF NOT IsAModula2Type (ProcSym) THEN - MetaError1 ('coersion expecting a type, seen {%1Ea} which is {%1Ed}', ProcSym) + MetaError1 ('coersion expecting a type, seen {%1Ea} which is {%1Ed} {%1&s}', ProcSym) END ; IF NoOfParam = 1 THEN @@ -8674,7 +8684,7 @@ BEGIN IF ConstExpr AND IsVar (Var) THEN MetaErrorT2 (optok, - 'the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2dav}', + 'the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2dav} {%2&s}', Func, Var) ; RETURN TRUE ELSE @@ -8884,7 +8894,7 @@ BEGIN PushTtok (Res, combinedtok) ELSE MetaErrorT1 (optok, - 'the parameter to {%1EkODD} must be a variable or constant, seen {%1ad}', + 'the parameter to {%1EkODD} must be a variable or constant, seen {%1ad} {%1&s}', Var) ; PushTtok (False, combinedtok) END @@ -8963,13 +8973,13 @@ BEGIN PushTFtok (Res, GetSType (Var), combinedtok) ELSE MetaErrorT1 (vartok, - 'the parameter to {%AkABS} must be a variable or constant, seen {%1ad}', - Var) + 'the parameter to {%AkABS} must be a variable or constant,' + + ' seen {%1ad} {%1&s}', Var) END ELSE MetaErrorT1 (functok, - 'the pseudo procedure {%AkABS} only has one parameter, seen {%1n} parameters', - NoOfParam) + 'the pseudo procedure {%AkABS} only has one parameter,' + + ' seen {%1n} parameters', NoOfParam) END END BuildAbsFunction ; @@ -9027,13 +9037,13 @@ BEGIN PushTFtok (Res, Char, combinedtok) ELSE MetaErrorT1 (optok, - 'the parameter to {%AkCAP} must be a variable or constant, seen {%1ad}', - Var) + 'the parameter to {%AkCAP} must be a variable or constant,' + + ' seen {%1ad} {%1&s}', Var) END ELSE MetaErrorT1 (functok, - 'the pseudo procedure {%AkCAP} only has one parameter, seen {%1n} parameters', - NoOfParam) + 'the pseudo procedure {%AkCAP} only has one parameter,' + + ' seen {%1n} parameters', NoOfParam) END END BuildCapFunction ; @@ -9106,13 +9116,13 @@ BEGIN BuildConvertFunction (Convert, ConstExpr) ELSE MetaErrorT1 (optok, - 'the parameter to {%AkCHR} must be a variable or constant, seen {%1ad}', - Var) + 'the parameter to {%AkCHR} must be a variable or constant,' + + ' seen {%1ad} {%1&s}', Var) END ELSE MetaErrorT1 (functok, - 'the pseudo procedure {%AkCHR} only has one parameter, seen {%1n} parameters', - NoOfParam) + 'the pseudo procedure {%AkCHR} only has one parameter,' + + ' seen {%1n} parameters', NoOfParam) END END BuildChrFunction ; @@ -9186,13 +9196,14 @@ BEGIN BuildConvertFunction (Convert, ConstExpr) ELSE MetaErrorT2 (optok, - 'the parameter to {%1Aa} must be a variable or constant, seen {%2ad}', + 'the parameter to {%1Aa} must be a variable or constant,' + + ' seen {%2ad} {%2&s}', Sym, Var) END ELSE MetaErrorT2 (functok, - 'the pseudo procedure {%1Aa} only has one parameter, seen {%2n} parameters', - Sym, NoOfParam) + 'the pseudo procedure {%1Aa} only has one parameter,' + + ' seen {%2n} parameters', Sym, NoOfParam) END END BuildOrdFunction ; @@ -9265,14 +9276,14 @@ BEGIN ELSE combinedtok := MakeVirtualTok (functok, optok, optok) ; MetaErrorT2 (optok, - 'the parameter to {%1Ea} must be a variable or constant, seen {%2ad}', - Sym, Var) ; + 'the parameter to {%1Ea} must be a variable or constant,' + + ' seen {%2ad} {%2&s}', Sym, Var) ; PushTtok (combinedtok, MakeConstLit (combinedtok, MakeKey ('0'), ZType)) END ELSE MetaErrorT2 (functok, - 'the pseudo procedure {%1Ea} only has one parameter, seen {%2n} parameters', - Sym, NoOfParam) ; + 'the pseudo procedure {%1Ea} only has one parameter,' + + ' seen {%2n} parameters', Sym, NoOfParam) ; PushTtok (functok, MakeConstLit (functok, MakeKey ('0'), ZType)) END END BuildIntFunction ; @@ -9338,7 +9349,8 @@ BEGIN AreConst := FALSE ; ELSIF NOT IsConst (OperandT (i)) THEN - MetaError1 ('problem in the {%1EN} argument for {%kMAKEADR}, all arguments to {%kMAKEADR} must be either variables or constants', i) + MetaError1 ('problem in the {%1EN} argument for {%kMAKEADR},' + + ' all arguments to {%kMAKEADR} must be either variables or constants', i) END ; INC (i) END ; @@ -9350,7 +9362,8 @@ BEGIN PopN (NoOfParameters+1) ; PushTFtok (ReturnVar, GetSType (MakeAdr), resulttok) ELSE - MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one parameter, seen {%1n}', NoOfParameters) ; + MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one parameter,' + + ' seen {%1n}', NoOfParameters) ; PopN (1) ; PushTFtok (Nil, GetSType (MakeAdr), functok) END @@ -9422,15 +9435,16 @@ BEGIN PushTFtok (returnVar, GetSType (varSet), combinedtok) ELSE MetaErrorT1 (vartok, - 'SYSTEM procedure {%1EkSHIFT} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad}', + 'SYSTEM procedure {%1EkSHIFT} expects a constant or variable which has a type of SET as its first parameter,' + + ' seen {%1ad} {%1&s}', varSet) ; PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), Cardinal, combinedtok) END ELSE combinedtok := MakeVirtualTok (functok, functok, paramtok) ; MetaErrorT1 (functok, - 'the pseudo procedure {%kSHIFT} requires at least two parameters, seen {%1En}', - NoOfParam) ; + 'the pseudo procedure {%kSHIFT} requires at least two parameters,' + + ' seen {%1En}', NoOfParam) ; PopN (NoOfParam + 1) ; PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), Cardinal, combinedtok) END @@ -9499,8 +9513,8 @@ BEGIN PushTFtok (returnVar, GetSType (varSet), combinedtok) ELSE MetaErrorT1 (vartok, - 'SYSTEM procedure {%EkROTATE} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad}', - varSet) ; + 'SYSTEM procedure {%EkROTATE} expects a constant or variable which has a type of SET as its first parameter,' + + ' seen {%1ad} {%1&s}', varSet) ; PushTFtok (MakeConstLit (functok, MakeKey('0'), Cardinal), Cardinal, functok) END ELSE @@ -9570,8 +9584,8 @@ BEGIN (* Spellcheck. *) (* It is sensible not to try and recover when we dont know the return type. *) MetaErrorT1 (typetok, - 'undeclared type found in builtin procedure function {%AkVAL} {%1ad} {%1&s}', - Type) ; + 'undeclared type found in builtin procedure function' + + ' {%AkVAL} {%1ad} {%1&s}', Type) ; (* Non recoverable error. *) UnknownReported (Type) ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr) @@ -10001,15 +10015,15 @@ BEGIN ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (vartok, - 'parameter to {%AkMIN} must be a type or a variable, seen {%1ad}', - Var) + 'parameter to {%AkMIN} must be a type or a variable,' + + ' seen {%1ad} {%1&s}', Var) (* non recoverable error. *) END ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (functok, - 'the pseudo builtin procedure function {%AkMIN} only has one parameter, seen {%1n}', - NoOfParam) + 'the pseudo builtin procedure function {%AkMIN} only has one parameter,' + + ' seen {%1n}', NoOfParam) (* non recoverable error. *) END END BuildMinFunction ; @@ -10062,15 +10076,15 @@ BEGIN ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (vartok, - 'parameter to {%AkMAX} must be a type or a variable, seen {%1ad}', - Var) + 'parameter to {%AkMAX} must be a type or a variable,' + + ' seen {%1ad} {%1&s}', Var) (* non recoverable error. *) ; END ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (functok, - 'the pseudo builtin procedure function {%AkMAX} only has one parameter, seen {%1n}', - NoOfParam) + 'the pseudo builtin procedure function {%AkMAX} only has one parameter,' + + ' seen {%1n}', NoOfParam) (* non recoverable error. *) END END BuildMaxFunction ; @@ -10156,8 +10170,8 @@ BEGIN END ELSE MetaErrorT2 (vartok, - 'argument to {%1Ead} must be a variable or constant, seen {%2ad}', - Sym, Var) ; + 'argument to {%1Ead} must be a variable or constant,' + + ' seen {%2ad} {%2&s}', Sym, Var) ; PushTFtok (MakeConstLit (functok, MakeKey('0'), Type), Type, functok) END ELSE @@ -10166,7 +10180,8 @@ BEGIN ELSE (* we dont know the type therefore cannot fake a return. *) MetaErrorT1 (functok, - 'the pseudo builtin procedure function {%AkTRUNC} only has one parameter, seen {%1n}', NoOfParam) + 'the pseudo builtin procedure function {%AkTRUNC} only has one parameter,' + + ' seen {%1n}', NoOfParam) (* non recoverable error. *) END END BuildTruncFunction ; @@ -10323,8 +10338,8 @@ BEGIN ELSE PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ; MetaErrorT2 (vartok, - 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}', - func, Var) + 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable,' + + ' seen {%2ad} {%2&s}', func, Var) END ELSE PopN (NoOfParam+1) ; (* destroy arguments to this function *) @@ -10399,8 +10414,8 @@ BEGIN ELSE PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ; MetaErrorT2 (vartok, - 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}', - func, Var) + 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable,' + + ' seen {%2ad} {%2&s}', func, Var) END ELSE PopN (NoOfParam+1) ; (* destroy arguments to this function *) @@ -10489,11 +10504,13 @@ BEGIN IF IsVar (l) OR IsConst (l) THEN MetaErrorT2 (functok, - 'the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the second parameter is {%2d}', + 'the builtin procedure {%1Ead} requires two parameters,' + + ' both must be variables or constants but the second parameter is {%2d}', func, r) ELSE MetaErrorT2 (functok, - 'the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the first parameter is {%2d}', + 'the builtin procedure {%1Ead} requires two parameters,' + + ' both must be variables or constants but the first parameter is {%2d}', func, l) END ; PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), CType), CType, combinedtok) @@ -10536,7 +10553,8 @@ END BuildCmplxFunction ; PROCEDURE BuildAdrFunction ; VAR - endtok, + param, + paramTok, combinedTok, procTok, t, @@ -10552,7 +10570,8 @@ BEGIN PopT (noOfParameters) ; procSym := OperandT (noOfParameters + 1) ; procTok := OperandTok (noOfParameters + 1) ; (* token of procedure ADR. *) - endtok := OperandTok (1) ; (* last parameter. *) + paramTok := OperandTok (1) ; (* last parameter. *) + param := OperandT (1) ; combinedTok := MakeVirtualTok (procTok, procTok, endtok) ; IF noOfParameters # 1 THEN @@ -10560,28 +10579,29 @@ BEGIN 'SYSTEM procedure ADR expects 1 parameter') ; PopN (noOfParameters + 1) ; (* destroy the arguments and function *) PushTF (Nil, Address) - ELSIF IsConstString (OperandT (1)) + ELSIF IsConstString (param) THEN - returnVar := MakeLeftValue (combinedTok, OperandT (1), RightValue, + returnVar := MakeLeftValue (combinedTok, param, RightValue, GetSType (procSym)) ; PopN (noOfParameters + 1) ; (* destroy the arguments and function *) PushTFtok (returnVar, GetSType (returnVar), combinedTok) - ELSIF (NOT IsVar(OperandT(1))) AND (NOT IsProcedure(OperandT(1))) + ELSIF (NOT IsVar (param)) AND (NOT IsProcedure (param)) THEN - MetaErrorNT0 (combinedTok, - 'SYSTEM procedure ADR expects a variable, procedure or a constant string as its parameter') ; + MetaErrorT1 (paramTok, + 'SYSTEM procedure ADR expects a variable, procedure or a constant string as its parameter,' + + ' seen {%1Ed} {%1&s}', param) ; PopN (noOfParameters + 1) ; (* destroy the arguments and function *) PushTFtok (Nil, Address, combinedTok) - ELSIF IsProcedure (OperandT (1)) + ELSIF IsProcedure (param) THEN - returnVar := MakeLeftValue (combinedTok, OperandT (1), RightValue, + returnVar := MakeLeftValue (combinedTok, param, RightValue, GetSType (procSym)) ; PopN (noOfParameters + 1) ; (* destroy the arguments and function *) PushTFtok (returnVar, GetSType (returnVar), combinedTok) ELSE - Type := GetSType (OperandT (1)) ; + Type := GetSType (param) ; Dim := OperandD (1) ; - MarkArrayWritten (OperandT (1)) ; + MarkArrayWritten (param) ; MarkArrayWritten (OperandA (1)) ; (* if the operand is an unbounded which has not been indexed then we will lookup its address from the unbounded record. @@ -10590,7 +10610,7 @@ BEGIN IF IsUnbounded (Type) AND (Dim = 0) THEN (* we will reference the address field of the unbounded structure *) - UnboundedSym := OperandT (1) ; + UnboundedSym := param ; rw := OperandRW (1) ; PushTFrw (UnboundedSym, GetSType (UnboundedSym), rw) ; Field := GetUnboundedAddressOffset (GetSType (UnboundedSym)) ; @@ -10614,14 +10634,14 @@ BEGIN ELSE returnVar := MakeTemporary (combinedTok, RightValue) ; PutVar (returnVar, GetSType (procSym)) ; - IF GetMode (OperandT (1)) = LeftValue + IF GetMode (param) = LeftValue THEN PutVar (returnVar, GetSType (procSym)) ; - GenQuadO (combinedTok, ConvertOp, returnVar, GetSType (procSym), OperandT (1), FALSE) + GenQuadO (combinedTok, ConvertOp, returnVar, GetSType (procSym), param, FALSE) ELSE - GenQuadO (combinedTok, AddrOp, returnVar, NulSym, OperandT (1), FALSE) + GenQuadO (combinedTok, AddrOp, returnVar, NulSym, param, FALSE) END ; - PutWriteQuad (OperandT (1), GetMode (OperandT (1)), NextQuad-1) ; + PutWriteQuad (param, GetMode (param), NextQuad-1) ; rw := OperandMergeRW (1) ; Assert (IsLegal (rw)) END ; @@ -10710,9 +10730,9 @@ BEGIN GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, Type, TRUE) END ELSE - resulttok := functok ; - MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure {%kSIZE} expects a variable or type as its parameter, seen {%1Ed}', + paramtok := OperandTok (1) ; + MetaErrorT1 (paramtok, + '{%E}SYSTEM procedure {%kSIZE} expects a variable or type as its parameter, seen {%1Ed} {%1&s}', OperandT (1)) ; ReturnVar := MakeConstLit (resulttok, MakeKey('0'), Cardinal) END ; @@ -10776,8 +10796,9 @@ BEGIN PutVar (ReturnVar, Cardinal) ; GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, GetSType (OperandT (1)), FALSE) ELSE + (* Spellcheck. *) MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure function {%kTSIZE} expects a variable or type as its first parameter, seen {%1Ed}', + '{%E}SYSTEM procedure function {%kTSIZE} expects a variable or type as its first parameter, seen {%1Ed} {%1&s}', OperandT (1)) ; ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal) END @@ -10801,7 +10822,7 @@ BEGIN ELSE resulttok := MakeVirtualTok (functok, functok, paramtok) ; MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure function {%kTSIZE} expects the first parameter to be a record type, seen {%1d}', + '{%E}SYSTEM procedure function {%kTSIZE} expects the first parameter to be a record type, seen {%1d} {%1&s}', Record) ; ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal) END @@ -10865,7 +10886,7 @@ BEGIN GenQuadO (resulttok, StandardFunctionOp, ReturnVar, ProcSym, OperandT(1), FALSE) ELSE MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure function {%kTBITSIZE} expects a variable as its first parameter, seen {%1d}', + '{%E}SYSTEM procedure function {%kTBITSIZE} expects a variable as its first parameter, seen {%1d} {%1&s}', OperandT (1)) ; ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal) END @@ -10888,7 +10909,7 @@ BEGIN ELSE resulttok := MakeVirtualTok (functok, functok, paramtok) ; MetaErrorT1 (resulttok, - '{%E}SYSTEM procedure function {%kTBITSIZE} expects the first parameter to be a record type, seen {%1d}', + '{%E}SYSTEM procedure function {%kTBITSIZE} expects the first parameter to be a record type, seen {%1d} {%1&s}', Record) ; ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal) END diff --git a/gcc/m2/gm2-libs/BinDict.def b/gcc/m2/gm2-libs/BinDict.def new file mode 100644 index 0000000..16272fd --- /dev/null +++ b/gcc/m2/gm2-libs/BinDict.def @@ -0,0 +1,92 @@ +(* BinDict.def provides a generic binary dictionary. + +Copyright (C) 2025 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaiusmod2@gmail.com>. + +This file is part of GNU Modula-2. + +GNU Modula-2 is free software; you can 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. + +GNU Modula-2 is distributed in the hope that it will be useful, but +WITHOUT 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/>. *) + +DEFINITION MODULE BinDict ; + +FROM SYSTEM IMPORT ADDRESS ; + +TYPE + Dictionary ; + Node ; + Compare = PROCEDURE (ADDRESS, ADDRESS) : INTEGER ; + Delete = PROCEDURE (ADDRESS) ; + VisitNode = PROCEDURE (Node) ; + + +(* + Init - create and return a new binary dictionary which will use + the compare procedure to order the contents as they are added. +*) + +PROCEDURE Init (KeyCompare: Compare; + KeyDelete, ValueDelete: Delete) : Dictionary ; + + +(* + Kill - delete the dictionary and its contents. + dict is assigned to NIL. +*) + +PROCEDURE Kill (VAR dict: Dictionary) ; + + +(* + PostOrder - visit each dictionary entry in post order. +*) + +PROCEDURE PostOrder (dict: Dictionary; visit: VisitNode) ; + + +(* + Insert - insert key value pair into the dictionary. +*) + +PROCEDURE Insert (dict: Dictionary; key, value: ADDRESS) ; + + +(* + Get - return the value associated with the key or NIL + if it does not exist. +*) + +PROCEDURE Get (dict: Dictionary; key: ADDRESS) : ADDRESS ; + + +(* + Value - return the value from node. +*) + +PROCEDURE Value (node: Node) : ADDRESS ; + + +(* + Key - return the key from node. +*) + +PROCEDURE Key (node: Node) : ADDRESS ; + + +END BinDict. diff --git a/gcc/m2/gm2-libs/BinDict.mod b/gcc/m2/gm2-libs/BinDict.mod new file mode 100644 index 0000000..f8bb873 --- /dev/null +++ b/gcc/m2/gm2-libs/BinDict.mod @@ -0,0 +1,272 @@ +(* BinDict.mod provides a generic binary dictionary. + +Copyright (C) 2025 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaiusmod2@gmail.com>. + +This file is part of GNU Modula-2. + +GNU Modula-2 is free software; you can 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. + +GNU Modula-2 is distributed in the hope that it will be useful, but +WITHOUT 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/>. *) + +IMPLEMENTATION MODULE BinDict ; + +FROM Storage IMPORT ALLOCATE, DEALLOCATE ; + + +TYPE + Dictionary = POINTER TO RECORD + content : Node ; + compare : Compare ; + deleteKey, + deleteValue: Delete + END ; + + Node = POINTER TO RECORD + dict : Dictionary ; + left, + right: Node ; + key, + value: ADDRESS ; + END ; + + +(* + Init - create and return a new binary dictionary which will use + the compare procedure to order the contents as they are + added. +*) + +PROCEDURE Init (KeyCompare: Compare; KeyDelete, + ValueDelete: Delete) : Dictionary ; +VAR + dict: Dictionary ; +BEGIN + NEW (dict) ; + WITH dict^ DO + content := NIL ; + compare := KeyCompare ; + deleteKey := KeyDelete ; + deleteValue := ValueDelete + END ; + RETURN dict +END Init ; + + +(* + Kill - delete the dictionary and its contents. + dict is assigned to NIL. +*) + +PROCEDURE Kill (VAR dict: Dictionary) ; +BEGIN + PostOrder (dict, DeleteNode) ; + DISPOSE (dict) ; + dict := NIL +END Kill ; + + +(* + DeleteNode - deletes node dict, key and value. +*) + +PROCEDURE DeleteNode (node: Node) ; +BEGIN + IF node # NIL + THEN + WITH node^ DO + dict^.deleteKey (key) ; + dict^.deleteValue (value) + END ; + DISPOSE (node) + END +END DeleteNode ; + + +(* + Insert - insert key value pair into the dictionary. +*) + +PROCEDURE Insert (dict: Dictionary; key, value: ADDRESS) ; +BEGIN + dict^.content := InsertNode (dict, dict^.content, key, value) +END Insert ; + + +(* + InsertNode - insert the key value pair as a new node in the + binary tree within dict. +*) + +PROCEDURE InsertNode (dict: Dictionary; + node: Node; + key, value: ADDRESS) : Node ; +BEGIN + IF node = NIL + THEN + RETURN ConsNode (dict, key, value, NIL, NIL) + ELSE + CASE dict^.compare (key, node^.key) OF + + 0: HALT | (* Not expecting to replace a key value. *) + -1: RETURN ConsNode (dict, node^.key, node^.value, + InsertNode (dict, node^.left, + key, value), node^.right) | + +1: RETURN ConsNode (dict, node^.key, node^.value, + node^.left, + InsertNode (dict, node^.right, + key, value)) + END + END +END InsertNode ; + + +(* + ConsNode - return a new node containing the pairing key and value. + The new node fields are assigned left, right and dict. +*) + +PROCEDURE ConsNode (dict: Dictionary; + key, value: ADDRESS; + left, right: Node) : Node ; +VAR + node: Node ; +BEGIN + NEW (node) ; + node^.key := key ; + node^.value := value ; + node^.left := left ; + node^.right := right ; + node^.dict := dict ; + RETURN node +END ConsNode ; + + +(* + KeyExist - return TRUE if dictionary contains an entry key. + It compares the content and not the address pointer. +*) + +PROCEDURE KeyExist (dict: Dictionary; key: ADDRESS) : BOOLEAN ; +BEGIN + RETURN KeyExistNode (dict^.content, key) +END KeyExist ; + + +(* + KeyExistNode - return TRUE if the binary tree under node contains + key. +*) + +PROCEDURE KeyExistNode (node: Node; key: ADDRESS) : BOOLEAN ; +BEGIN + IF node # NIL + THEN + CASE node^.dict^.compare (key, node^.key) OF + + 0: RETURN TRUE | + -1: RETURN KeyExistNode (node^.left, key) | + +1: RETURN KeyExistNode (node^.right, key) + + END + END ; + RETURN FALSE +END KeyExistNode ; + + +(* + Value - return the value from node. +*) + +PROCEDURE Value (node: Node) : ADDRESS ; +BEGIN + RETURN node^.value +END Value ; + + +(* + Key - return the key from node. +*) + +PROCEDURE Key (node: Node) : ADDRESS ; +BEGIN + RETURN node^.value +END Key ; + + +(* + Get - return the value associated with the key or NIL + if it does not exist. +*) + +PROCEDURE Get (dict: Dictionary; key: ADDRESS) : ADDRESS ; +BEGIN + RETURN GetNode (dict^.content, key) +END Get ; + + +(* + GetNode - return the value in binary node tree which + is associated with key. +*) + +PROCEDURE GetNode (node: Node; key: ADDRESS) : ADDRESS ; +BEGIN + IF node # NIL + THEN + CASE node^.dict^.compare (key, node^.key) OF + + 0: RETURN node^.value | + +1: RETURN GetNode (node^.right, key) | + -1: RETURN GetNode (node^.left, key) + + END + END ; + RETURN NIL +END GetNode ; + + +(* + PostOrder - visit each dictionary entry in post order. +*) + +PROCEDURE PostOrder (dict: Dictionary; visit: VisitNode) ; +BEGIN + IF dict # NIL + THEN + PostOrderNode (dict^.content, visit) + END +END PostOrder ; + + +(* + PostOrderNode - visit the tree node in post order. +*) + +PROCEDURE PostOrderNode (node: Node; visit: VisitNode) ; +BEGIN + IF node # NIL + THEN + PostOrderNode (node^.left, visit) ; + PostOrderNode (node^.right, visit) ; + visit (node) + END +END PostOrderNode ; + + +END BinDict. diff --git a/gcc/range-op.cc b/gcc/range-op.cc index 1f91066..6b6bf78 100644 --- a/gcc/range-op.cc +++ b/gcc/range-op.cc @@ -3103,8 +3103,9 @@ operator_cast::fold_range (irange &r, tree type ATTRIBUTE_UNUSED, int_range_max tmp; fold_pair (tmp, x, inner, outer); r.union_ (tmp); + // If we hit varying, go update the bitmask. if (r.varying_p ()) - return true; + break; } update_bitmask (r, inner, outer); @@ -3204,6 +3205,25 @@ operator_cast::op1_range (irange &r, tree type, } // And intersect with any known value passed in the extra operand. r.intersect (op2); + if (r.undefined_p ()) + return true; + + // Now create a bitmask indicating that the lower bit must match the + // bits in the LHS. Zero-extend LHS bitmask to precision of op1. + irange_bitmask bm = lhs.get_bitmask (); + wide_int mask = wide_int::from (bm.mask (), TYPE_PRECISION (type), + UNSIGNED); + wide_int value = wide_int::from (bm.value (), TYPE_PRECISION (type), + UNSIGNED); + + // Set then additonal unknown bits in mask. + wide_int lim = wi::mask (TYPE_PRECISION (lhs_type), true, + TYPE_PRECISION (type)); + mask = mask | lim; + + // Now set the new bitmask for the range. + irange_bitmask new_bm (value, mask); + r.update_bitmask (new_bm); return true; } @@ -3502,6 +3522,22 @@ operator_bitwise_and::wi_fold (irange &r, tree type, const wide_int &rh_lb, const wide_int &rh_ub) const { + // The AND algorithm does not handle complex signed operations well. + // If a signed range crosses the boundry between signed and unsigned + // proces sit as 2 ranges and union the results. + if (TYPE_SIGN (type) == SIGNED + && wi::neg_p (lh_lb, SIGNED) != wi::neg_p (lh_ub, SIGNED)) + { + int prec = TYPE_PRECISION (type); + int_range_max tmp; + // Process [lh_lb, -1] + wi_fold (tmp, type, lh_lb, wi::minus_one (prec), rh_lb, rh_ub); + // Now Process [0, rh_ub] + wi_fold (r, type, wi::zero (prec), lh_ub, rh_lb, rh_ub); + r.union_ (tmp); + return; + } + if (wi_optimize_and_or (r, BIT_AND_EXPR, type, lh_lb, lh_ub, rh_lb, rh_ub)) return; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 65fa7fa..4b9bd57 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,96 @@ +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + * gcc.dg/pr110405.c: New. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/114025 + * g++.dg/pr114025.C: New. + +2025-10-24 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/122407 + * gm2.dg/spell/iso/fail/badspellabs.mod: New test. + * gm2.dg/spell/iso/fail/badspelladr.mod: New test. + * gm2.dg/spell/iso/fail/badspellcap.mod: New test. + * gm2.dg/spell/iso/fail/badspellchr.mod: New test. + * gm2.dg/spell/iso/fail/badspellchr2.mod: New test. + * gm2.dg/spell/iso/fail/badspelldec.mod: New test. + * gm2.dg/spell/iso/fail/badspellexcl.mod: New test. + * gm2.dg/spell/iso/fail/badspellinc.mod: New test. + * gm2.dg/spell/iso/fail/badspellincl.mod: New test. + * gm2.dg/spell/iso/fail/badspellnew.mod: New test. + * gm2.dg/spell/iso/fail/badspellsize.mod: New test. + * gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp: New test. + +2025-10-24 Andrew Pinski <andrew.pinski@oss.qualcomm.com> + + PR target/122402 + * gcc.target/aarch64/auto-init-padding-2.c: Turn off SRA. + * gcc.target/aarch64/auto-init-padding-4.c: Likewise. + +2025-10-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/122386 + * gfortran.dg/transfer_array_subref_2.f90: New test. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + * gcc.dg/pr114725.c: New. + +2025-10-24 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/118254 + PR tree-optimization/114331 + * gcc.dg/pr114331.c: New. + * gcc.dg/pr118254.c: New. + +2025-10-24 Alex Coplan <alex.coplan@arm.com> + + * gcc.dg/torture/vect-permute-ice.c: New test. + +2025-10-24 Richard Biener <rguenther@suse.de> + + * gcc.dg/vect/vect-pr122406-1.c: Adjust to expect reduction + chain vectorization. + * gcc.dg/vect/vect-pr122406-2.c: Likewise. + +2025-10-24 Richard Biener <rguenther@suse.de> + + PR tree-optimization/122406 + * gcc.dg/vect/vect-pr122406-1.c: New testcase. + * gcc.dg/vect/vect-pr122406-2.c: Likewise. + +2025-10-24 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/121452 + * c-c++-common/gomp/pr121452-1.c: New test. + * c-c++-common/gomp/pr121452-2.c: New test. + * gfortran.dg/gomp/pr121452-1.f90: New test. + * gfortran.dg/gomp/pr121452-2.f90: New test. + * gfortran.dg/gomp/pr121452-3.f90: New test. + +2025-10-24 H.J. Lu <hjl.tools@gmail.com> + + PR target/122323 + * gcc.target/i386/builtin-fabs-2.c: Also scan (%edi)for x32. + +2025-10-24 Pengfei Li <Pengfei.Li2@arm.com> + + * gcc.dg/fold-vecperm-1.c: New test. + +2025-10-24 Olivier Hainque <hainque@adacore.com> + + * lib/target-supports.exp (check_weak_available): + Return 1 for VxWorks7. + +2025-10-24 Joseph Myers <josmyers@redhat.com> + + * gcc.dg/c23-static-assert-5.c, gcc.dg/c23-static-assert-6.c, + gcc.dg/c23-static-assert-7.c, gcc.dg/c23-static-assert-8.c, + gcc.dg/c2y-static-assert-2.c, gcc.dg/c2y-static-assert-3.c, + gcc.dg/c2y-static-assert-4.c: New tests. + 2025-10-23 Robert Dubner <rdubner@symas.com> * cobol.dg/group2/Length_overflow__2_.out: Updated test result. diff --git a/gcc/testsuite/g++.dg/pr114025.C b/gcc/testsuite/g++.dg/pr114025.C new file mode 100644 index 0000000..61bb8f1 --- /dev/null +++ b/gcc/testsuite/g++.dg/pr114025.C @@ -0,0 +1,39 @@ +/* { dg-do compile } */ +/* { dg-options " -O3 -std=gnu++17 -ffinite-math-only -fdump-tree-optimized" } */ + +#include <algorithm> +#include <stdexcept> + +#define AINLINE + +class TestClass +{ +public: + AINLINE void SetValue(float value); + +private: + float m_Value; +}; + +AINLINE +void TestClass::SetValue(float value) +{ + if (value >= 0.0f && value <= 100.0f) { + m_Value = value; + } + else { + throw std::out_of_range("Value must be [0, 100]."); + } +} + +void TestFunc(TestClass& t, float value) +{ + value = std::clamp(value, 30.0f, 50.0f); + // When TestClass::SetValue is inlined, the exception throwing code is not eliminated. + // Given that at this point we can prove that 'value' lies in the range [30.0f, 50.0f] well within the range required by the setter function, we can rid the not taken paths of code. + t.SetValue(value); +} + + +/* { dg-final { scan-tree-dump-times "std::out_of_range::out_of_range" 1 "optimized" } } */ + diff --git a/gcc/testsuite/gcc.dg/pr110405.c b/gcc/testsuite/gcc.dg/pr110405.c new file mode 100644 index 0000000..549cc7b --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr110405.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +void foo (unsigned long); +void +f (unsigned long i) +{ + if ((i & 7) == 6) + if(i & 1) + foo (0); +} + +/* { dg-final { scan-tree-dump-not "foo" "optimized" } } */ + diff --git a/gcc/testsuite/gcc.dg/pr114331.c b/gcc/testsuite/gcc.dg/pr114331.c new file mode 100644 index 0000000..e93289e --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr114331.c @@ -0,0 +1,20 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +int src(int num) { + switch((short)num){ + case 111: + /* Should fold to 110. */ + return num & 0xfffe; + case 267: + case 204: + case 263: + return 0; + default: + return 0; + } +} + + +/* { dg-final { scan-tree-dump "110" "optimized" } } */ + diff --git a/gcc/testsuite/gcc.dg/pr114725.c b/gcc/testsuite/gcc.dg/pr114725.c new file mode 100644 index 0000000..01c3139 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr114725.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +//* This should fold to return 0 +bool +src(int offset) +{ + if (offset > 128) + return 0; + else + return (offset & -9) == 258; +} + +/* { dg-final { scan-tree-dump "return 0" "optimized" } } */ +/* { dg-final { scan-tree-dump-not "PHI" "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/pr118254.c b/gcc/testsuite/gcc.dg/pr118254.c new file mode 100644 index 0000000..5a0553b --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr118254.c @@ -0,0 +1,34 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-evrp" } */ + +void foo(void); +int il=1000; + +int m1(void) +{ + short t = il; + unsigned t1 = t; + if (t1 == 0) { + char b = t1; + if (b != 1) + return 0; + foo(); + } + return 0; +} + +int m2(void) +{ + short t = il; + unsigned t1 = t; + if (t1 == 0) { + char b = il; + if (b != 1) + return 0; + foo(); + } + return 0; +} + +/* { dg-final { scan-tree-dump-not "foo" "evrp" } } */ + diff --git a/gcc/testsuite/gcc.dg/torture/vect-permute-ice.c b/gcc/testsuite/gcc.dg/torture/vect-permute-ice.c new file mode 100644 index 0000000..05a1da5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/vect-permute-ice.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* This testcase triggered an ICE that was fixed by + g:1ceda79ca5fe1a1a296624a98de8fd04958fbe55. */ +char *a; +char c, e; +_Bool f() { + int g, d = 0; + for (int h = 0; h < 128; h += 8) { + char *b = &a[h]; + g = e * b[0] + c * b[1] + 2 * b[2] + 3 * b[3] + 4 * b[4] + 5 * b[5] + + 6 * b[6] + 7 * b[7]; + d += g; + } + return d; +} diff --git a/gcc/testsuite/gcc.target/aarch64/auto-init-padding-2.c b/gcc/testsuite/gcc.target/aarch64/auto-init-padding-2.c index d3b6591..25d06d7 100644 --- a/gcc/testsuite/gcc.target/aarch64/auto-init-padding-2.c +++ b/gcc/testsuite/gcc.target/aarch64/auto-init-padding-2.c @@ -1,7 +1,8 @@ /* Verify pattern initialization for structure type automatic variables with padding. */ /* { dg-do compile } */ -/* { dg-options "-O -ftrivial-auto-var-init=pattern" } */ +/* SRA should be turned off as it can fully scalarize var as the padding is not touched. */ +/* { dg-options "-O -ftrivial-auto-var-init=pattern -fno-tree-sra" } */ struct test_aligned { int internal1; diff --git a/gcc/testsuite/gcc.target/aarch64/auto-init-padding-4.c b/gcc/testsuite/gcc.target/aarch64/auto-init-padding-4.c index efd310f..fa9def7 100644 --- a/gcc/testsuite/gcc.target/aarch64/auto-init-padding-4.c +++ b/gcc/testsuite/gcc.target/aarch64/auto-init-padding-4.c @@ -1,7 +1,8 @@ /* Verify pattern initialization for nested structure type automatic variables with padding. */ /* { dg-do compile } */ -/* { dg-options "-O -ftrivial-auto-var-init=pattern" } */ +/* SRA should be turned off as it can fully scalarize var as the padding is not touched. */ +/* { dg-options "-O -ftrivial-auto-var-init=pattern -fno-tree-sra" } */ struct test_aligned { unsigned internal1; diff --git a/gcc/testsuite/gcc.target/loongarch/lasx-reduc-1.c b/gcc/testsuite/gcc.target/loongarch/lasx-reduc-1.c new file mode 100644 index 0000000..e449259 --- /dev/null +++ b/gcc/testsuite/gcc.target/loongarch/lasx-reduc-1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -funsafe-math-optimizations -mlasx -fno-unroll-loops -fdump-tree-optimized" } */ +/* { dg-final { scan-tree-dump-times "\.REDUC_PLUS" 4 "optimized" } } */ + +#define DEFINE_SUM_FUNCTION(T, FUNC_NAME, SIZE) \ +T FUNC_NAME(const T arr[]) { \ + arr = __builtin_assume_aligned(arr, 64); \ + T sum = 0; \ + for (int i = 0; i < SIZE; i++) \ + sum += arr[i]; \ + return sum; \ +} + +DEFINE_SUM_FUNCTION (int, sum_int_1040, 1028) +DEFINE_SUM_FUNCTION (float, sum_float_1040, 1028) +DEFINE_SUM_FUNCTION (long, sum_long_1040, 1026) +DEFINE_SUM_FUNCTION (double, sum_double_1040, 1026) diff --git a/gcc/testsuite/gfortran.dg/is_contiguous_5.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_5.f90 new file mode 100644 index 0000000..091e43b5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/is_contiguous_5.f90 @@ -0,0 +1,126 @@ +! { dg-do run } +! PR fortran/114023 - IS_CONTIGUOUS and pointers to non-contiguous targets +! +! Based on testcase by Federico Perini + +program main + implicit none + complex, parameter :: cvals(*) = [(1,-1),(2,-2),(3,-3)] + complex , target :: cref(size(cvals)) = cvals ! Reference + complex, allocatable, target :: carr(:) ! Test + + type cx + real :: re, im + end type cx + type(cx), parameter :: tvals(*) = [cx(1,-1),cx(2,-2),cx(3,-3)] + real, parameter :: expect(*) = tvals% re + type(cx) , target :: tref(size(cvals)) = tvals ! Reference + type(cx), allocatable, target :: tarr(:) + + real, pointer :: rr1(:), rr2(:), rr3(:), rr4(:) + class(*), pointer :: cp1(:), cp2(:), cp3(:), cp4(:) + + carr = cvals + tarr = tvals + + if (any (expect /= [1,2,3])) error stop 90 + + ! REAL pointer to non-contiguous effective target + rr1(1:3) => cref%re + rr2 => cref%re + rr3(1:3) => carr%re + rr4 => carr%re + + if (is_contiguous (rr1)) stop 1 + if (my_contiguous_real (rr1)) stop 2 + if (is_contiguous (cref(1:3)%re)) stop 3 +! if (my_contiguous_real (cref(1:3)%re)) stop 4 ! pr122397 + + if (is_contiguous (rr3)) stop 6 + if (my_contiguous_real (rr3)) stop 7 + if (is_contiguous (carr(1:3)%re)) stop 8 +! if (my_contiguous_real (carr(1:3)%re)) stop 9 + + if (is_contiguous (rr2)) stop 11 + if (my_contiguous_real (rr2)) stop 12 + if (is_contiguous (cref%re)) stop 13 +! if (my_contiguous_real (cref%re)) stop 14 + + if (is_contiguous (rr4)) stop 16 + if (my_contiguous_real (rr4)) stop 17 + if (is_contiguous (carr%re)) stop 18 +! if (my_contiguous_real (carr%re)) stop 19 + + rr1(1:3) => tref%re + rr2 => tref%re + rr3(1:3) => tarr%re + rr4 => tarr%re + + if (is_contiguous (rr1)) stop 21 + if (my_contiguous_real (rr1)) stop 22 + if (is_contiguous (tref(1:3)%re)) stop 23 +! if (my_contiguous_real (tref(1:3)%re)) stop 24 + + if (is_contiguous (rr3)) stop 26 + if (my_contiguous_real (rr3)) stop 27 + if (is_contiguous (tarr(1:3)%re)) stop 28 +! if (my_contiguous_real (tarr(1:3)%re)) stop 29 + + if (is_contiguous (rr2)) stop 31 + if (my_contiguous_real (rr2)) stop 32 + if (is_contiguous (tref%re)) stop 33 +! if (my_contiguous_real (tref%re)) stop 34 + + if (is_contiguous (rr4)) stop 36 + if (my_contiguous_real (rr4)) stop 37 + if (is_contiguous (tarr%re)) stop 38 +! if (my_contiguous_real (tarr%re)) stop 39 + + ! Unlimited polymorphic pointer to non-contiguous effective target + cp1(1:3) => cref%re + cp2 => cref%re + cp3(1:3) => carr%re + cp4 => carr%re + + if (is_contiguous (cp1)) stop 41 + if (my_contiguous_poly (cp1)) stop 42 + if (is_contiguous (cp2)) stop 43 + if (my_contiguous_poly (cp2)) stop 44 + if (is_contiguous (cp3)) stop 45 + if (my_contiguous_poly (cp3)) stop 46 + if (is_contiguous (cp4)) stop 47 + if (my_contiguous_poly (cp4)) stop 48 + + cp1(1:3) => tref%re + cp2 => tref%re + cp3(1:3) => tarr%re + cp4 => tarr%re + + if (is_contiguous (cp1)) stop 51 + if (my_contiguous_poly (cp1)) stop 52 + if (is_contiguous (cp2)) stop 53 + if (my_contiguous_poly (cp2)) stop 54 + if (is_contiguous (cp3)) stop 55 + if (my_contiguous_poly (cp3)) stop 56 + if (is_contiguous (cp4)) stop 57 + if (my_contiguous_poly (cp4)) stop 58 + + deallocate (carr, tarr) +contains + pure logical function my_contiguous_real (x) result (res) + real, pointer, intent(in) :: x(:) + res = is_contiguous (x) + if (any (x /= expect)) error stop 97 + end function my_contiguous_real + + pure logical function my_contiguous_poly (x) result (res) + class(*), pointer, intent(in) :: x(:) + res = is_contiguous (x) + select type (x) + type is (real) + if (any (x /= expect)) error stop 98 + class default + error stop 99 + end select + end function my_contiguous_poly +end diff --git a/gcc/testsuite/gfortran.dg/transfer_array_subref_2.f90 b/gcc/testsuite/gfortran.dg/transfer_array_subref_2.f90 new file mode 100644 index 0000000..9ff5198 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_array_subref_2.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! { dg-additional-options "-O2 -fdump-tree-optimized" } +! +! PR fortran/122386 - passing of component ref of nested DT array to TRANSFER + +program main + implicit none + integer, parameter :: dp = 4 + + type cx + real(dp) :: re, im + end type cx + + type complex_wrap1 + type(cx) :: z(2) + end type complex_wrap1 + + type complex_wrap2 + type(cx), dimension(:), allocatable :: z + end type complex_wrap2 + + type(complex_wrap1) :: x = complex_wrap1([cx(1,2), cx(3,4)]) + type(complex_wrap2) :: w + + w%z = x%z + + ! The following statements should get optimized away... + if (size (transfer ( x%z%re ,[1.0_dp])) /= 2) error stop 1 + if (size (transfer ((x%z%re),[1.0_dp])) /= 2) error stop 2 + if (size (transfer ([x%z%re],[1.0_dp])) /= 2) error stop 3 + if (size (transfer ( x%z%im ,[1.0_dp])) /= 2) error stop 4 + if (size (transfer ((x%z%im),[1.0_dp])) /= 2) error stop 5 + if (size (transfer ([x%z%im],[1.0_dp])) /= 2) error stop 6 + + ! ... while the following may not: + if (any (transfer ( x%z%re ,[1.0_dp]) /= x%z%re)) stop 7 + if (any (transfer ( x%z%im ,[1.0_dp]) /= x%z%im)) stop 8 + + if (size (transfer ( w%z%re ,[1.0_dp])) /= 2) stop 11 + if (size (transfer ((w%z%re),[1.0_dp])) /= 2) stop 12 + if (size (transfer ([w%z%re],[1.0_dp])) /= 2) stop 13 + if (size (transfer ( w%z%im ,[1.0_dp])) /= 2) stop 14 + if (size (transfer ((w%z%im),[1.0_dp])) /= 2) stop 15 + if (size (transfer ([w%z%im],[1.0_dp])) /= 2) stop 16 + + if (any (transfer ( w%z%re ,[1.0_dp]) /= x%z%re)) stop 17 + if (any (transfer ( w%z%im ,[1.0_dp]) /= x%z%im)) stop 18 + + deallocate (w%z) +end program main + +! { dg-final { scan-tree-dump-not "_gfortran_error_stop_numeric" "optimized" } } diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod new file mode 100644 index 0000000..508d93a --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod @@ -0,0 +1,14 @@ + +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellabs ; + +VAR + foo: INTEGER ; +BEGIN + IF ABS (Foo) = 1 + (* { dg-error "the parameter to ABS must be a variable or constant, seen 'Foo', did you mean foo?" "Foo" { target *-*-* } 10 } *) + THEN + END +END badspellabs. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod new file mode 100644 index 0000000..7bad815 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod @@ -0,0 +1,16 @@ + +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspelladr ; + +FROM SYSTEM IMPORT ADR ; + +VAR + foo: INTEGER ; +BEGIN + IF ADR (Foo) = NIL + (* { dg-error "SYSTEM procedure ADR expects a variable, procedure or a constant string as its parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 12 } *) + THEN + END +END badspelladr. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod new file mode 100644 index 0000000..8fc004c --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod @@ -0,0 +1,13 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellcap ; + +VAR + foo: CHAR ; +BEGIN + IF CAP (Foo) = 'A' + (* { dg-error "the parameter to CAP must be a variable or constant, seen 'Foo', did you mean foo?" "Foo" { target *-*-* } 9 } *) + THEN + END +END badspellcap. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod new file mode 100644 index 0000000..1f5beaa --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod @@ -0,0 +1,13 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellchr ; + +VAR + foo: CARDINAL ; +BEGIN + IF CHR (Foo) = 'A' + (* { dg-error "the parameter to CHR must be a variable or constant, seen 'Foo', did you mean foo?" "Foo" { target *-*-* } 9 } *) + THEN + END +END badspellchr. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod new file mode 100644 index 0000000..9808a4f --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod @@ -0,0 +1,13 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellchr2 ; + +VAR + foo: CARDINAL ; +BEGIN + IF CHR (Foo+1) = 'A' + (* { dg-error "unknown symbol 'Foo', did you mean foo?" "Foo" { target *-*-* } 9 } *) + THEN + END +END badspellchr2. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod new file mode 100644 index 0000000..0c01fef --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod @@ -0,0 +1,11 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspelldec ; + +VAR + foo: CARDINAL ; +BEGIN + DEC (Foo) + (* { dg-error "base procedure DEC expects a variable as a parameter but was given unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *) +END badspelldec. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod new file mode 100644 index 0000000..92cb932 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod @@ -0,0 +1,11 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellexcl ; + +VAR + foo: BITSET ; +BEGIN + EXCL (Foo, 1) + (* { dg-error "base procedure EXCL expects a variable as a parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *) +END badspellexcl. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod new file mode 100644 index 0000000..1d913ec --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod @@ -0,0 +1,12 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellinc ; + +VAR + foo: CARDINAL ; +BEGIN + INC (Foo) + (* { dg-error "base procedure INC expects a variable as a parameter but was given unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *) + +END badspellinc. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod new file mode 100644 index 0000000..ddaa727 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod @@ -0,0 +1,11 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellincl ; + +VAR + foo: BITSET ; +BEGIN + INCL (Foo, 1) + (* { dg-error "base procedure INCL expects a variable as a parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *) +END badspellincl. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod new file mode 100644 index 0000000..4007867 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod @@ -0,0 +1,13 @@ +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellnew ; + +FROM Storage IMPORT ALLOCATE ; + +VAR + foo: POINTER TO CARDINAL ; +BEGIN + NEW (Foo) + (* { dg-error "parameter to NEW must be a pointer, seen unknown, did you mean foo?" "Foo" { target *-*-* } 11 } *) +END badspellnew. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod new file mode 100644 index 0000000..6ae35a5 --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod @@ -0,0 +1,14 @@ + +(* { dg-do compile } *) +(* { dg-options "-g" } *) + +MODULE badspellsize ; + +VAR + foo: INTEGER ; +BEGIN + IF SIZE (Foo) = NIL + (* { dg-error "SYSTEM procedure SIZE expects a variable or type as its parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 10 } *) + THEN + END +END badspellsize. diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp b/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp new file mode 100644 index 0000000..145d7eb --- /dev/null +++ b/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp @@ -0,0 +1,34 @@ +# Copyright (C) 2025 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# Compile tests, no torture testing. +# +# These tests raise errors in the front end; torture testing doesn't apply. + +# Load support procs. +load_lib gm2-dg.exp + +gm2_init_iso $srcdir/$subdir + +# Initialize `dg'. +dg-init + +# Main loop. + +dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] "" "" + +# All done. +dg-finish |