diff --git a/embed.fnc b/embed.fnc index 5ddab55acec8..c7cc0375daa7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -447,8 +447,7 @@ : created that #defines 'foo' as 'Perl_foo'. This can be used to make : any macro have a long name, perhaps to avoid name collisions. If : instead you define the macro as 'PERL_FOO' (all uppercase), the -: embed.h entry will use all uppercase. Without the T flag the behavior -: is subject to change when both 'm' and 'p are specified. +: embed.h entry will use all uppercase. : : suppress proto.h entry (actually, not suppressed, but commented out) : suppress entry in the list of exported symbols available on all @@ -3841,7 +3840,7 @@ Adip |U8 * |uv_to_utf8_flags \ |NN U8 *d \ |UV uv \ |UV flags -Adip |U8 * |uv_to_utf8_msgs|NN U8 *d \ +Admp |U8 * |uv_to_utf8_msgs|NN U8 *d \ |UV uv \ |UV flags \ |NULLOK HV **msgs diff --git a/embed.h b/embed.h index 9c5c2a8acf04..ca7a782babe1 100644 --- a/embed.h +++ b/embed.h @@ -160,7 +160,7 @@ # define bytes_to_utf8(a,b) Perl_bytes_to_utf8(aTHX_ a,b) # define bytes_to_utf8_free_me(a,b,c) Perl_bytes_to_utf8_free_me(aTHX_ a,b,c) # define bytes_to_utf8_temp_pv(a,b) Perl_bytes_to_utf8_temp_pv(aTHX_ a,b) -# define c9strict_utf8_to_uv Perl_c9strict_utf8_to_uv +# define Perl_c9strict_utf8_to_uv c9strict_utf8_to_uv # define call_argv(a,b,c) Perl_call_argv(aTHX_ a,b,c) # define call_atexit(a,b) Perl_call_atexit(aTHX_ a,b) # define call_list(a,b) Perl_call_list(aTHX_ a,b) @@ -225,7 +225,7 @@ # define dump_vindent(a,b,c,d) Perl_dump_vindent(aTHX_ a,b,c,d) # define eval_pv(a,b) Perl_eval_pv(aTHX_ a,b) # define eval_sv(a,b) Perl_eval_sv(aTHX_ a,b) -# define extended_utf8_to_uv Perl_extended_utf8_to_uv +# define Perl_extended_utf8_to_uv extended_utf8_to_uv # define fbm_compile(a,b) Perl_fbm_compile(aTHX_ a,b) # define fbm_instr(a,b,c,d) Perl_fbm_instr(aTHX_ a,b,c,d) # define filter_add(a,b) Perl_filter_add(aTHX_ a,b) @@ -312,7 +312,7 @@ # define init_i18nl10n(a) Perl_init_i18nl10n(aTHX_ a) # define init_stacks() Perl_init_stacks(aTHX) # define init_tm(a) Perl_init_tm(aTHX_ a) -# define instr Perl_instr +# define Perl_instr instr # define intro_my() Perl_intro_my(aTHX) # define isC9_STRICT_UTF8_CHAR Perl_isC9_STRICT_UTF8_CHAR # define isSTRICT_UTF8_CHAR Perl_isSTRICT_UTF8_CHAR @@ -328,7 +328,7 @@ # define is_utf8_fixed_width_buf_loclen_flags Perl_is_utf8_fixed_width_buf_loclen_flags # define is_utf8_invariant_string_loc Perl_is_utf8_invariant_string_loc # define is_utf8_string_flags Perl_is_utf8_string_flags -# define is_utf8_string_loc Perl_is_utf8_string_loc +# define Perl_is_utf8_string_loc is_utf8_string_loc # define is_utf8_string_loclen Perl_is_utf8_string_loclen # define is_utf8_string_loclen_flags Perl_is_utf8_string_loclen_flags # define is_utf8_valid_partial_char_flags Perl_is_utf8_valid_partial_char_flags @@ -651,7 +651,7 @@ # define stack_grow(a,b,c) Perl_stack_grow(aTHX_ a,b,c) # define start_subparse(a,b) Perl_start_subparse(aTHX_ a,b) # define str_to_version(a) Perl_str_to_version(aTHX_ a) -# define strict_utf8_to_uv Perl_strict_utf8_to_uv +# define Perl_strict_utf8_to_uv strict_utf8_to_uv # define suspend_compcv(a) Perl_suspend_compcv(aTHX_ a) # define sv_2bool_flags(a,b) Perl_sv_2bool_flags(aTHX_ a,b) # define sv_2cv(a,b,c,d) Perl_sv_2cv(aTHX_ a,b,c,d) @@ -802,30 +802,29 @@ # define upg_version(a,b) Perl_upg_version(aTHX_ a,b) # define utf8_distance(a,b) Perl_utf8_distance(aTHX_ a,b) # define utf8_hop Perl_utf8_hop -# define utf8_hop_back Perl_utf8_hop_back +# define Perl_utf8_hop_back utf8_hop_back # define utf8_hop_back_overshoot Perl_utf8_hop_back_overshoot -# define utf8_hop_forward Perl_utf8_hop_forward +# define Perl_utf8_hop_forward utf8_hop_forward # define utf8_hop_forward_overshoot Perl_utf8_hop_forward_overshoot # define utf8_hop_overshoot Perl_utf8_hop_overshoot -# define utf8_hop_safe Perl_utf8_hop_safe +# define Perl_utf8_hop_safe utf8_hop_safe # define utf8_length(a,b) Perl_utf8_length(aTHX_ a,b) # define utf8_to_bytes(a,b) Perl_utf8_to_bytes(aTHX_ a,b) # define utf8_to_bytes_(a,b,c,d) Perl_utf8_to_bytes_(aTHX_ a,b,c,d) # define utf8_to_bytes_new_pv(a,b,c) Perl_utf8_to_bytes_new_pv(aTHX_ a,b,c) # define utf8_to_bytes_overwrite(a,b) Perl_utf8_to_bytes_overwrite(aTHX_ a,b) # define utf8_to_bytes_temp_pv(a,b) Perl_utf8_to_bytes_temp_pv(aTHX_ a,b) -# define utf8_to_uv Perl_utf8_to_uv -# define utf8_to_uv_errors Perl_utf8_to_uv_errors -# define utf8_to_uv_flags Perl_utf8_to_uv_flags +# define Perl_utf8_to_uv utf8_to_uv +# define Perl_utf8_to_uv_errors utf8_to_uv_errors +# define Perl_utf8_to_uv_flags utf8_to_uv_flags # define utf8_to_uv_msgs Perl_utf8_to_uv_msgs # define utf8_to_uv_msgs_helper_ Perl_utf8_to_uv_msgs_helper_ # define utf8_to_uv_or_die Perl_utf8_to_uv_or_die -# define utf8n_to_uvchr Perl_utf8n_to_uvchr -# define utf8n_to_uvchr_error Perl_utf8n_to_uvchr_error +# define Perl_utf8n_to_uvchr utf8n_to_uvchr +# define Perl_utf8n_to_uvchr_error utf8n_to_uvchr_error # define utf8n_to_uvchr_msgs Perl_utf8n_to_uvchr_msgs # define uv_to_utf8(a,b) Perl_uv_to_utf8(aTHX_ a,b) # define uv_to_utf8_flags(a,b,c) Perl_uv_to_utf8_flags(aTHX_ a,b,c) -# define uv_to_utf8_msgs(a,b,c,d) Perl_uv_to_utf8_msgs(aTHX_ a,b,c,d) # define uvoffuni_to_utf8_flags_msgs(a,b,c,d) Perl_uvoffuni_to_utf8_flags_msgs(aTHX_ a,b,c,d) # define valid_identifier_pve(a,b,c) Perl_valid_identifier_pve(aTHX_ a,b,c) # define valid_identifier_pvn(a,b,c) Perl_valid_identifier_pvn(aTHX_ a,b,c) @@ -2259,8 +2258,11 @@ # define PerlIO_write(a,b,c) Perl_PerlIO_write(aTHX_ a,b,c) # endif /* defined(USE_PERLIO) */ # if defined(USE_THREADS) +# define Perl_uv_to_utf8_msgs(mTHX,a,b,c,d) uv_to_utf8_msgs(a,b,c,d) # define thread_locale_init() Perl_thread_locale_init(aTHX) # define thread_locale_term() Perl_thread_locale_term(aTHX) +# else +# define Perl_uv_to_utf8_msgs uv_to_utf8_msgs # endif # if defined(VMS) || defined(WIN32) # define do_aspawn(a,b,c) Perl_do_aspawn(aTHX_ a,b,c) diff --git a/inline.h b/inline.h index 44128c624d07..370346aea8c7 100644 --- a/inline.h +++ b/inline.h @@ -2180,8 +2180,8 @@ Perl_is_utf8_string_flags(const U8 *s, STRLEN len, const U32 flags) return TRUE; } -#define Perl_is_utf8_string_loc(s, len, ep) \ - Perl_is_utf8_string_loclen(s, len, ep, 0) +#define is_utf8_string_loc(s, len, ep) \ + is_utf8_string_loclen(s, len, ep, 0) PERL_STATIC_INLINE bool Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el) @@ -2759,8 +2759,8 @@ unchanged. =cut */ -# define Perl_utf8_hop_forward( s, off, end) \ - Perl_utf8_hop_forward_overshoot(s, off, end, NULL) +# define utf8_hop_forward( s, off, end) \ + utf8_hop_forward_overshoot(s, off, end, NULL) PERL_STATIC_INLINE U8 * Perl_utf8_hop_forward_overshoot(const U8 * s, SSize_t off, @@ -2845,8 +2845,8 @@ displaced. =cut */ -# define Perl_utf8_hop_back( s, off, start) \ - Perl_utf8_hop_back_overshoot(s, off, start, NULL) +# define utf8_hop_back( s, off, start) \ + utf8_hop_back_overshoot(s, off, start, NULL) PERL_STATIC_INLINE U8 * Perl_utf8_hop_back_overshoot(const U8 *s, SSize_t off, @@ -2912,7 +2912,7 @@ the excess count is the absolute value of C. =cut */ -#define Perl_utf8_hop_safe(s, o, b, e) Perl_utf8_hop_overshoot(s, o, b, e, 0) +#define utf8_hop_safe(s, o, b, e) utf8_hop_overshoot(s, o, b, e, 0) PERL_STATIC_INLINE U8 * Perl_utf8_hop_overshoot(const U8 *s, SSize_t off, @@ -3284,12 +3284,6 @@ Perl_uv_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) return uv_to_utf8_msgs(d, uv, flags, 0); } -PERL_STATIC_INLINE U8 * -Perl_uv_to_utf8_msgs(pTHX_ U8 *d, UV uv, UV flags , HV **msgs) -{ - return uvoffuni_to_utf8_flags_msgs(d, NATIVE_TO_UNI(uv), flags, msgs); -} - /* ------------------------------- perl.h ----------------------------- */ /* diff --git a/proto.h b/proto.h index a7e81e069149..da3fd83efa7b 100644 --- a/proto.h +++ b/proto.h @@ -5262,6 +5262,9 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) #define PERL_ARGS_ASSERT_UTILIZE \ assert(idop) +/* PERL_CALLCONV U8 * +Perl_uv_to_utf8_msgs(pTHX_ U8 *d, UV uv, UV flags, HV **msgs); */ + /* PERL_CALLCONV U8 * uvchr_to_utf8(pTHX_ U8 *d, UV uv); */ @@ -10296,11 +10299,6 @@ Perl_uv_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags); # define PERL_ARGS_ASSERT_UV_TO_UTF8_FLAGS \ assert(d) -PERL_STATIC_INLINE U8 * -Perl_uv_to_utf8_msgs(pTHX_ U8 *d, UV uv, UV flags, HV **msgs); -# define PERL_ARGS_ASSERT_UV_TO_UTF8_MSGS \ - assert(d) - PERL_STATIC_INLINE UV Perl_valid_utf8_to_uvchr(const U8 *s, STRLEN *retlen) __attribute__warn_unused_result__; diff --git a/regen/embed.pl b/regen/embed.pl index abbee02401fe..30da2438a031 100755 --- a/regen/embed.pl +++ b/regen/embed.pl @@ -51,10 +51,10 @@ ($$) if ($flags =~ /[ps]/) { - # An all uppercase macro name gets an uppercase prefix. - return ($flags =~ /m/ && $flags =~ /p/ && $func !~ /[[:lower:]]/) - ? "PERL_$func" - : "Perl_$func"; + # An all uppercase macro name gets an uppercase prefix. + return ($flags =~ /m/ && $flags =~ /p/ && $func !~ /[[:lower:]]/) + ? "PERL_$func" + : "Perl_$func"; } return "S_$func" if $flags =~ /[SIi]/; @@ -144,14 +144,14 @@ sub generate_proto_h { die_at_end "$plain_func: S and p flags are mutually exclusive" if $flags =~ /S/ && $flags =~ /p/; - if ($has_mflag) { - if ($flags =~ /S/) { - die_at_end "$plain_func: m and S flags are mutually exclusive"; - } - } - else { - die_at_end "$plain_func: u flag only usable with m" if $flags =~ /u/; - } + if ($has_mflag) { + if ($flags =~ /S/) { + die_at_end "$plain_func: m and S flags are mutually exclusive"; + } + } + else { + die_at_end "$plain_func: u flag only usable with m" if $flags =~ /u/; + } my ($static_flag, @extra_static_flags)= $flags =~/([SsIi])/g; @@ -244,7 +244,7 @@ sub generate_proto_h { $arg = "const char * const $name"; die_at_end 'm flag required for "literal" argument' - unless $has_mflag; + unless $has_mflag; } elsif ( $args_assert_line && $arg =~ /\*/ @@ -510,7 +510,46 @@ sub embed_h { my $ind= $level ? " " : ""; $ind .= " " x ($level-1) if $level>1; my $inner_ind= $ind ? " " : " "; - if ($flags !~ /[omM]/ or ($flags =~ /m/ && $flags =~ /p/)) { + + if ($flags =~ /m/ && $flags =~ /p/) { + my $full_name = full_name($func, $flags); + next if $full_name eq $func; # Don't output a no-op. + + # Yields + # #define Perl_func func + # which works when there is no thread context. + $ret = indent_define($full_name, $func, $ind); + + if ($flags !~ /[T]/) { + + # But when there is the possibility of a thread context + # parameter, $ret works only on non-threaded builds + my $no_thread_full_define = $ret; + + # And we have to do more when there are threads. First, + # convert the input argument list to 'a', 'b' .... This keeps + # us from having to worry about all the extra stuff in the + # input list; stuff like the type declarations, things like + # NULLOK, and pointers '*'. + my $argname = 'a'; + my @stripped_args; + push @stripped_args, $argname++ for $args->@*; + my $arglist = join ",", @stripped_args; + + # In the threaded case, the Perl_ form is expecting an aTHX + # first argument. Use mTHX to match that, which isn't passed + # on to the short form name, as that is expecting an implicit + # aTHX. The non-threaded case just uses what we generated + # above for the /T/ flag case. + $ret = "#${ind}ifdef USE_THREADS\n" + . "#${ind} define $full_name(mTHX,$arglist)" + . " $func($arglist)\n" + . "#${ind}else\n" + . "$ind $no_thread_full_define" # No \n because no chomp + . "#${ind}endif\n"; + } + } + elsif ($flags !~ /[omM]/) { my $argc = scalar @$args; if ($flags =~ /[T]/) { my $full_name = full_name($func, $flags); @@ -535,7 +574,7 @@ sub embed_h { $use_va_list ? ("__VA_ARGS__") : ()); $ret = "#${ind}define $func($paramlist) "; add_indent($ret,full_name($func, $flags) . "(aTHX"); - if ($replacelist) { + if ($replacelist) { $ret .= ($flags =~ /m/) ? "," : "_ "; $ret .= $replacelist; } @@ -720,4 +759,4 @@ sub update_headers { update_headers() unless caller; -# ex: set ts=8 sts=4 sw=4 noet: +# ex: set ts=8 sts=4 sw=4 et: diff --git a/utf8.h b/utf8.h index 7e9fa216a0f4..a9bb14bf5410 100644 --- a/utf8.h +++ b/utf8.h @@ -145,34 +145,37 @@ typedef enum { #define uvchr_to_utf8 uv_to_utf8 #define uvchr_to_utf8_flags uv_to_utf8_flags #define uvchr_to_utf8_flags_msgs uv_to_utf8_msgs -#define Perl_uvchr_to_utf8 Perl_uv_to_utf8 -#define Perl_uvchr_to_utf8_flags Perl_uv_to_utf8_flags -#define Perl_uvchr_to_utf8_flags_msgs Perl_uv_to_utf8_msgs +#define uvchr_to_utf8 uv_to_utf8 +#define uvchr_to_utf8_flags uv_to_utf8_flags +#define uvchr_to_utf8_flags_msgs uv_to_utf8_msgs + +#define uv_to_utf8_msgs(d, uv, flags, msgs) \ + uvoffuni_to_utf8_flags_msgs(d, NATIVE_TO_UNI(uv), flags, msgs) /* This is needed to cast the parameters for all those calls that had them * improperly as chars */ -#define utf8_to_uvchr_buf(s, e, lenp) \ +#define utf8_to_uvchr_buf(s, e, lenp) \ Perl_utf8_to_uvchr_buf(aTHX_ (const U8 *) (s), (const U8 *) e, lenp) -#define Perl_utf8n_to_uvchr(s, len, lenp, flags) \ - Perl_utf8n_to_uvchr_error(s, len, lenp, flags, 0) -#define Perl_utf8n_to_uvchr_error(s, len, lenp, flags, errors) \ - Perl_utf8n_to_uvchr_msgs(s, len, lenp, flags, errors, 0) - -#define Perl_utf8_to_uv( s, e, cp_p, advance_p) \ - Perl_utf8_to_uv_flags( s, e, cp_p, advance_p, 0) -#define Perl_utf8_to_uv_flags( s, e, cp_p, advance_p, flags) \ - Perl_utf8_to_uv_errors( s, e, cp_p, advance_p, flags, 0) -#define Perl_utf8_to_uv_errors( s, e, cp_p, advance_p, flags, errors) \ - Perl_utf8_to_uv_msgs( s, e, cp_p, advance_p, flags, errors, 0) -#define Perl_extended_utf8_to_uv(s, e, cp_p, advance_p) \ - Perl_utf8_to_uv(s, e, cp_p, advance_p) -#define Perl_strict_utf8_to_uv( s, e, cp_p, advance_p) \ - Perl_utf8_to_uv_flags( s, e, cp_p, advance_p, \ - UTF8_DISALLOW_ILLEGAL_INTERCHANGE) -#define Perl_c9strict_utf8_to_uv(s, e, cp_p, advance_p) \ - Perl_utf8_to_uv_flags( s, e, cp_p, advance_p, \ - UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE) +#define utf8n_to_uvchr(s, len, lenp, flags) \ + utf8n_to_uvchr_error(s, len, lenp, flags, 0) +#define utf8n_to_uvchr_error(s, len, lenp, flags, errors) \ + utf8n_to_uvchr_msgs(s, len, lenp, flags, errors, 0) + +#define utf8_to_uv( s, e, cp_p, advance_p) \ + utf8_to_uv_flags( s, e, cp_p, advance_p, 0) +#define utf8_to_uv_flags( s, e, cp_p, advance_p, flags) \ + utf8_to_uv_errors( s, e, cp_p, advance_p, flags, 0) +#define utf8_to_uv_errors( s, e, cp_p, advance_p, flags, errors) \ + utf8_to_uv_msgs( s, e, cp_p, advance_p, flags, errors, 0) +#define extended_utf8_to_uv(s, e, cp_p, advance_p) \ + utf8_to_uv(s, e, cp_p, advance_p) +#define strict_utf8_to_uv( s, e, cp_p, advance_p) \ + utf8_to_uv_flags( s, e, cp_p, advance_p, \ + UTF8_DISALLOW_ILLEGAL_INTERCHANGE) +#define c9strict_utf8_to_uv(s, e, cp_p, advance_p) \ + utf8_to_uv_flags( s, e, cp_p, advance_p, \ + UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE) #define utf16_to_utf8(p, d, bytelen, newlen) \ utf16_to_utf8_base(p, d, bytelen, newlen, 0, 1) diff --git a/util.h b/util.h index 0b3acabaf1e5..e9b3d6b1c002 100644 --- a/util.h +++ b/util.h @@ -241,7 +241,7 @@ returning NULL if not found. The terminating NUL bytes are not compared. */ -#define Perl_instr(haystack, needle) strstr(haystack, needle) +#define instr(haystack, needle) strstr(haystack, needle) #ifdef HAS_MEMMEM # define ninstr(big, bigend, little, lend) \