diff options
| -rw-r--r-- | cop.h | 6 | ||||
| -rw-r--r-- | feature.h | 58 | ||||
| -rw-r--r-- | gv.c | 4 | ||||
| -rw-r--r-- | lib/feature.pm | 27 | ||||
| -rw-r--r-- | mg.c | 14 | ||||
| -rw-r--r-- | op.c | 6 | ||||
| -rw-r--r-- | pp_ctl.c | 3 | ||||
| -rwxr-xr-x | regen/feature.pl | 63 | ||||
| -rw-r--r-- | scope.c | 2 |
9 files changed, 156 insertions, 27 deletions
@@ -413,6 +413,12 @@ struct cop { /* compile time state of %^H. See the comment in op.c for how this is used to recreate a hash to return from caller. */ COPHH * cop_hints_hash; + /* for now just a bitmask stored here. + If we get sufficient features this may become a pointer. + How these flags are stored is subject to change without + notice. Use the macros to test for features. + */ + U32 cop_features; }; #ifdef USE_ITHREADS @@ -12,6 +12,20 @@ #define HINT_FEATURE_SHIFT 26 +#define FEATURE_BITWISE_BIT 0x0001 +#define FEATURE___SUB___BIT 0x0002 +#define FEATURE_MYREF_BIT 0x0004 +#define FEATURE_EVALBYTES_BIT 0x0008 +#define FEATURE_FC_BIT 0x0010 +#define FEATURE_POSTDEREF_QQ_BIT 0x0020 +#define FEATURE_REFALIASING_BIT 0x0040 +#define FEATURE_SAY_BIT 0x0080 +#define FEATURE_SIGNATURES_BIT 0x0100 +#define FEATURE_STATE_BIT 0x0200 +#define FEATURE_SWITCH_BIT 0x0400 +#define FEATURE_UNIEVAL_BIT 0x0800 +#define FEATURE_UNICODE_BIT 0x1000 + #define FEATURE_BUNDLE_DEFAULT 0 #define FEATURE_BUNDLE_510 1 #define FEATURE_BUNDLE_511 2 @@ -31,6 +45,11 @@ ((CURRENT_HINTS \ & HINT_LOCALIZE_HH) \ ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE) + +#define FEATURE_IS_ENABLED_MASK(mask) \ + ((CURRENT_HINTS & HINT_LOCALIZE_HH) \ + ? (PL_curcop->cop_features & (mask)) : FALSE) + /* The longest string we pass in. */ #define MAX_FEATURE_LEN (sizeof("postderef_qq")-1) @@ -39,7 +58,7 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_515 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("fc")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_FC_BIT)) \ ) #define FEATURE_SAY_IS_ENABLED \ @@ -47,7 +66,7 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("say")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_SAY_BIT)) \ ) #define FEATURE_STATE_IS_ENABLED \ @@ -55,7 +74,7 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("state")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_STATE_BIT)) \ ) #define FEATURE_SWITCH_IS_ENABLED \ @@ -63,14 +82,14 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("switch")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_SWITCH_BIT)) \ ) #define FEATURE_BITWISE_IS_ENABLED \ ( \ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_527 \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("bitwise")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_BITWISE_BIT)) \ ) #define FEATURE_EVALBYTES_IS_ENABLED \ @@ -78,13 +97,13 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_515 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("evalbytes")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_EVALBYTES_BIT)) \ ) #define FEATURE_SIGNATURES_IS_ENABLED \ ( \ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("signatures") \ + FEATURE_IS_ENABLED_MASK(FEATURE_SIGNATURES_BIT) \ ) #define FEATURE___SUB___IS_ENABLED \ @@ -92,13 +111,13 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_515 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("__SUB__")) \ + FEATURE_IS_ENABLED_MASK(FEATURE___SUB___BIT)) \ ) #define FEATURE_REFALIASING_IS_ENABLED \ ( \ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("refaliasing") \ + FEATURE_IS_ENABLED_MASK(FEATURE_REFALIASING_BIT) \ ) #define FEATURE_POSTDEREF_QQ_IS_ENABLED \ @@ -106,7 +125,7 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_523 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("postderef_qq")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_POSTDEREF_QQ_BIT)) \ ) #define FEATURE_UNIEVAL_IS_ENABLED \ @@ -114,13 +133,13 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_515 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("unieval")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_UNIEVAL_BIT)) \ ) #define FEATURE_MYREF_IS_ENABLED \ ( \ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("myref") \ + FEATURE_IS_ENABLED_MASK(FEATURE_MYREF_BIT) \ ) #define FEATURE_UNICODE_IS_ENABLED \ @@ -128,10 +147,23 @@ (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_511 && \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527) \ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("unicode")) \ + FEATURE_IS_ENABLED_MASK(FEATURE_UNICODE_BIT)) \ ) +#define SAVEFEATUREBITS() SAVEI32(PL_compiling.cop_features) + +#define CLEARFEATUREBITS() (PL_compiling.cop_features = 0) + +#define STOREFEATUREBITSHH(hh) \ + (hv_stores((hh), "feature/bits", newSVuv(PL_compiling.cop_features))) + +#define FETCHFEATUREBITSHH(hh) \ + STMT_START { \ + SV **fbsv = hv_fetchs((hh), "feature/bits", FALSE); \ + PL_compiling.cop_features = fbsv ? SvUV(*fbsv) : 0; \ + } STMT_END + #endif /* PERL_CORE or PERL_EXT */ #ifdef PERL_IN_OP_C @@ -2047,6 +2047,10 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, if (memEQs(name, len, "\005NCODING")) goto magicalize; break; + case '\006': + if (memEQs(name, len, "\006EATURE_BITS")) + goto magicalize; + break; case '\007': /* $^GLOBAL_PHASE */ if (memEQs(name, len, "\007LOBAL_PHASE")) goto ro_magicalize; diff --git a/lib/feature.pm b/lib/feature.pm index 5965d361a9..607ec11002 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -5,7 +5,7 @@ package feature; -our $VERSION = '1.55'; +our $VERSION = '1.56'; our %feature = ( fc => 'feature_fc', @@ -23,6 +23,23 @@ our %feature = ( unicode_strings => 'feature_unicode', ); + +my %feature_bits = ( + bitwise => 0x0001, + current_sub => 0x0002, + declared_refs => 0x0004, + evalbytes => 0x0008, + fc => 0x0010, + postderef_qq => 0x0020, + refaliasing => 0x0040, + say => 0x0080, + signatures => 0x0100, + state => 0x0200, + switch => 0x0400, + unicode_eval => 0x0800, + unicode_strings => 0x1000, +); + our %feature_bundle = ( "5.10" => [qw(say state switch)], "5.11" => [qw(say state switch unicode_strings)], @@ -485,14 +502,17 @@ sub __common { my $import = shift; my $bundle_number = $^H & $hint_mask; my $features = $bundle_number != $hint_mask - && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; + && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; + my $bits = ${^FEATURE_BITS}; if ($features) { # Features are enabled implicitly via bundle hints. # Delete any keys that may be left over from last time. delete @^H{ values(%feature) }; + $bits = 0; $^H |= $hint_mask; for (@$features) { $^H{$feature{$_}} = 1; + $bits |= $feature_bits{$_}; $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; } } @@ -520,12 +540,15 @@ sub __common { } if ($import) { $^H{$feature{$name}} = 1; + $bits |= $feature_bits{$name}; $^H |= $hint_uni8bit if $name eq 'unicode_strings'; } else { delete $^H{$feature{$name}}; + $bits &= ~$feature_bits{$name}; $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings'; } } + ${^FEATURE_BITS} = $bits; } sub unknown_feature { @@ -1032,7 +1032,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) break; case '\006': /* ^F */ - sv_setiv(sv, (IV)PL_maxsysfd); + if (nextchar == '\0') { + sv_setiv(sv, (IV)PL_maxsysfd); + } + else if (strEQ(remaining, "EATURE_BITS")) { + sv_setuv(sv, PL_compiling.cop_features); + } break; case '\007': /* ^GLOBAL_PHASE */ if (strEQ(remaining, "LOBAL_PHASE")) { @@ -2840,7 +2845,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) Perl_croak(aTHX_ "${^ENCODING} is no longer supported"); break; case '\006': /* ^F */ - PL_maxsysfd = SvIV(sv); + if (mg->mg_ptr[1] == '\0') { + PL_maxsysfd = SvIV(sv); + } + else if (strEQ(mg->mg_ptr + 1, "EATURE_BITS")) { + PL_compiling.cop_features = SvUV(sv); + } break; case '\010': /* ^H */ { @@ -11851,8 +11851,10 @@ Perl_ck_eval(pTHX_ OP *o) if ((PL_hints & HINT_LOCALIZE_HH) != 0 && !(o->op_private & OPpEVAL_COPHH) && GvHV(PL_hintgv)) { /* Store a copy of %^H that pp_entereval can pick up. */ - OP *hhop = newSVOP(OP_HINTSEVAL, 0, - MUTABLE_SV(hv_copy_hints_hv(GvHV(PL_hintgv)))); + HV *hh = hv_copy_hints_hv(GvHV(PL_hintgv)); + OP *hhop; + STOREFEATUREBITSHH(hh); + hhop = newSVOP(OP_HINTSEVAL, 0, MUTABLE_SV(hh)); /* append hhop to only child */ op_sibling_splice(o, cUNOPo->op_first, 0, hhop); @@ -33,6 +33,7 @@ #include "EXTERN.h" #define PERL_IN_PP_CTL_C #include "perl.h" +#include "feature.h" #define RUN_PP_CATCHABLY(thispp) \ STMT_START { if (CATCH_GET) return docatch(thispp); } STMT_END @@ -3485,6 +3486,7 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) if (clear_hints) { PL_hints = 0; hv_clear(GvHV(PL_hintgv)); + CLEARFEATUREBITS(); } else { PL_hints = saveop->op_private & OPpEVAL_COPHH @@ -3502,6 +3504,7 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) /* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */ SvREFCNT_dec(GvHV(PL_hintgv)); GvHV(PL_hintgv) = hh; + FETCHFEATUREBITSHH(hh); } } SAVECOMPILEWARNINGS(); diff --git a/regen/feature.pl b/regen/feature.pl index db713ae7b3..c7919daed0 100755 --- a/regen/feature.pl +++ b/regen/feature.pl @@ -76,6 +76,17 @@ my @removed = qw( array_base ); ########################################################################### # More data generated from the above +if (keys %feature > 32) { + die "cop_features only has room for 32 features"; +} + +my %feature_bits; +my $mask = 1; +for my $feature (sort keys %feature) { + $feature_bits{$feature} = $mask; + $mask <<= 1; +} + for (keys %feature_bundle) { next unless /^5\.(\d*[13579])\z/; $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_}; @@ -178,12 +189,18 @@ for(sort { length $a <=> length $b || $a cmp $b } keys %feature) { } print $pm ");\n\n"; +print $pm "\nmy %feature_bits = (\n"; +for (sort keys %feature_bits) { + printf $pm " %-*s => %#06x,\n", $width, $_, $feature_bits{$_}; +} +print $pm ");\n\n"; + print $pm "our %feature_bundle = (\n"; -$width = length longest values %UniqueBundles; +my $bund_width = length longest values %UniqueBundles; for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} } keys %UniqueBundles ) { my $bund = $UniqueBundles{$_}; - print $pm qq' "$bund"' . " "x($width-length $bund) + print $pm qq' "$bund"' . " "x($bund_width-length $bund) . qq' => [qw($_)],\n'; } print $pm ");\n\n"; @@ -253,6 +270,12 @@ print $h <<EOH; EOH +for (sort keys %feature_bits) { + printf $h "#define FEATURE_%s_BIT%*s %#06x\n", uc($feature{$_}), + $width-length($feature{$_}), "", $feature_bits{$_}; +} +print $h "\n"; + my $count; for (@HintedBundles) { (my $key = uc) =~ y/.//d; @@ -273,6 +296,11 @@ print $h <<'EOH'; ((CURRENT_HINTS \ & HINT_LOCALIZE_HH) \ ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE) + +#define FEATURE_IS_ENABLED_MASK(mask) \ + ((CURRENT_HINTS & HINT_LOCALIZE_HH) \ + ? (PL_curcop->cop_features & (mask)) : FALSE) + /* The longest string we pass in. */ EOH @@ -295,7 +323,7 @@ for ( ( \\ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\ - FEATURE_IS_ENABLED("$name")) \\ + FEATURE_ENABLED_MASK(FEATURE_\L$name\E_BIT)) \\ ) EOI @@ -307,7 +335,7 @@ EOI (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\ - FEATURE_IS_ENABLED("$name")) \\ + FEATURE_IS_ENABLED_MASK(FEATURE_\U$name\E_BIT)) \\ ) EOH3 @@ -318,7 +346,7 @@ EOH3 ( \\ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\ || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\ - FEATURE_IS_ENABLED("$name")) \\ + FEATURE_IS_ENABLED_MASK(FEATURE_\U$name\E_BIT)) \\ ) EOH4 @@ -328,7 +356,7 @@ EOH4 #define FEATURE_$NAME\_IS_ENABLED \\ ( \\ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\ - FEATURE_IS_ENABLED("$name") \\ + FEATURE_IS_ENABLED_MASK(FEATURE_\U$name\E_BIT) \\ ) EOH5 @@ -337,6 +365,19 @@ EOH5 print $h <<EOH; +#define SAVEFEATUREBITS() SAVEI32(PL_compiling.cop_features) + +#define CLEARFEATUREBITS() (PL_compiling.cop_features = 0) + +#define STOREFEATUREBITSHH(hh) \\ + (hv_stores((hh), "feature/bits", newSVuv(PL_compiling.cop_features))) + +#define FETCHFEATUREBITSHH(hh) \\ + STMT_START { \\ + SV **fbsv = hv_fetchs((hh), "feature/bits", FALSE); \\ + PL_compiling.cop_features = fbsv ? SvUV(*fbsv) : 0; \\ + } STMT_END + #endif /* PERL_CORE or PERL_EXT */ #ifdef PERL_IN_OP_C @@ -382,7 +423,7 @@ read_only_bottom_close_and_rename($h); __END__ package feature; -our $VERSION = '1.55'; +our $VERSION = '1.56'; FEATURES @@ -763,14 +804,17 @@ sub __common { my $import = shift; my $bundle_number = $^H & $hint_mask; my $features = $bundle_number != $hint_mask - && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; + && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; + my $bits = ${^FEATURE_BITS}; if ($features) { # Features are enabled implicitly via bundle hints. # Delete any keys that may be left over from last time. delete @^H{ values(%feature) }; + $bits = 0; $^H |= $hint_mask; for (@$features) { $^H{$feature{$_}} = 1; + $bits |= $feature_bits{$_}; $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; } } @@ -798,12 +842,15 @@ sub __common { } if ($import) { $^H{$feature{$name}} = 1; + $bits |= $feature_bits{$name}; $^H |= $hint_uni8bit if $name eq 'unicode_strings'; } else { delete $^H{$feature{$name}}; + $bits &= ~$feature_bits{$name}; $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings'; } } + ${^FEATURE_BITS} = $bits; } sub unknown_feature { @@ -25,6 +25,7 @@ #include "EXTERN.h" #define PERL_IN_SCOPE_C #include "perl.h" +#include "feature.h" SV** Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n) @@ -688,6 +689,7 @@ Perl_save_hints(pTHX) save_pushptri32ptr(oldhh, PL_hints, save_cophh, SAVEt_HINTS); GvHV(PL_hintgv) = NULL; /* in case copying dies */ GvHV(PL_hintgv) = hv_copy_hints_hv(oldhh); + SAVEFEATUREBITS(); } else { save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS); } |