Skip to content

Commit

Permalink
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
feature.*: allow cop_feature to expand
Browse files Browse the repository at this point in the history
The initial implementation of feature bits for faster access to
feature flags used a single U32 member in COP to store the bits, but
we're now up to 24 features, so rather than leaving this to the last
minute I've re-worked regen/feature.pl to allow multiple U32 fields.
tonycoz committed Dec 5, 2024
1 parent fcc9d7e commit db0f1e5
Showing 4 changed files with 283 additions and 109 deletions.
14 changes: 11 additions & 3 deletions cop.h
Original file line number Diff line number Diff line change
@@ -434,6 +434,15 @@ the octets.

#include "mydtrace.h"

/* keep in sync with feature.h (which will complain if this is out of sync)
*/
#define COP_FEATURE_SIZE 1

/* make this a struct so we can copy the feature bits with assignment */
struct cop_feature_t {
U32 bits[COP_FEATURE_SIZE];
};

struct cop {
BASEOP
/* On LP64 putting this here takes advantage of the fact that BASEOP isn't
@@ -460,12 +469,11 @@ 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;
struct cop_feature_t cop_features;
};

/*
8 changes: 6 additions & 2 deletions dump.c
Original file line number Diff line number Diff line change
@@ -28,6 +28,7 @@
#define PERL_IN_DUMP_C
#include "perl.h"
#include "regcomp.h"
#include "feature.h"

static const char* const svtypenames[SVt_LAST] = {
"NULL",
@@ -1414,8 +1415,11 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o)
/* add hints and features if set */
if (cCOPo->cop_hints)
S_opdump_indent(aTHX_ o, level, bar, file, "HINTS = %08x\n",cCOPo->cop_hints);
if (cCOPo->cop_features)
S_opdump_indent(aTHX_ o, level, bar, file, "FEATS = %08x\n",cCOPo->cop_features);
if (ANY_FEATURE_BITS_SET(cCOPo)) {
S_opdump_indent(aTHX_ o, level, bar, file, "FEATS = ");
DUMP_FEATURE_BITS(file, cCOPo);
PerlIO_puts(file, "\n");
}

S_opdump_indent(aTHX_ o, level, bar, file, "SEQ = %u\n",
(unsigned int)cCOPo->cop_seq);
265 changes: 183 additions & 82 deletions feature.h

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

105 changes: 83 additions & 22 deletions regen/feature.pl
Original file line number Diff line number Diff line change
@@ -116,16 +116,22 @@ BEGIN
###########################################################################
# More data generated from the above

if (keys %feature > 32) {
die "cop_features only has room for 32 features";
}

my %feature_bits;
my %feature_indices;
my $mask = 1;
my $index = 0;
for my $feature (sort keys %feature) {
$feature_bits{$feature} = $mask;
$mask <<= 1;
$feature_indices{$feature} = $index;
if ($mask == 0x8000_0000) {
$mask = 1;
++$index;
}
else {
$mask <<= 1;
}
}
my $cop_feature_size = $mask == 1 ? $index : $index + 1;

for (keys %feature_bundle) {
next unless /^5\.(\d*[13579])\z/;
@@ -302,15 +308,34 @@ sub longest {
#if defined(PERL_CORE) || defined (PERL_EXT)
#define HINT_FEATURE_SHIFT $HintShift
EOH

for (sort keys %feature_bits) {
printf $h "#define FEATURE_%s_BIT%*s %#06x\n", uc($feature{$_}),
if ($feature_bits{$_} == 1) {
print $h "\n/* Index $feature_indices{$_} */\n";
}
printf $h "#define FEATURE_%s_BIT%*s %#010x\n", uc($feature{$_}),
$width-length($feature{$_}), "", $feature_bits{$_};
}
print $h "\n";

for (sort keys %feature_indices) {
printf $h "#define FEATURE_%s_INDEX%*s %d\n", uc($feature{$_}),
$width-length($feature{$_}), "", $feature_indices{$_};
}
print $h "\n";

# we don't require that every source #includes <feature.h>
print $h <<EOH;
#define REAL_COP_FEATURE_SIZE $cop_feature_size
/* If the following errors, update COP_FEATURE_SIZE in cop.h */
#if defined(COP_FEATURE_SIZE) && COP_FEATURE_SIZE != REAL_COP_FEATURE_SIZE
# error "COP_FEATURE_SIZE and REAL_COP_FEATURE_SIZE don't match"
#endif
EOH

my $count;
for (@HintedBundles) {
(my $key = uc) =~ y/.//d;
@@ -330,9 +355,9 @@ sub longest {
#define CURRENT_FEATURE_BUNDLE \
((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
#define FEATURE_IS_ENABLED_MASK(mask) \
#define FEATURE_IS_ENABLED_MASK(index, mask) \
((CURRENT_HINTS & HINT_LOCALIZE_HH) \
? (PL_curcop->cop_features & (mask)) : FALSE)
? (PL_curcop->cop_features.bits[index] & (mask)) : FALSE)
/* The longest string we pass in. */
EOH
@@ -356,7 +381,7 @@ sub longest {
( \\
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
FEATURE_IS_ENABLED_MASK(FEATURE_${NAME}_BIT)) \\
FEATURE_IS_ENABLED_MASK(FEATURE_${NAME}_INDEX, FEATURE_${NAME}_BIT)) \\
)
EOI
@@ -368,7 +393,7 @@ sub longest {
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
FEATURE_IS_ENABLED_MASK(FEATURE_${NAME}_BIT)) \\
FEATURE_IS_ENABLED_MASK(FEATURE_${NAME}_INDEX, FEATURE_${NAME}_BIT)) \\
)
EOH3
@@ -379,7 +404,7 @@ sub longest {
( \\
CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
|| (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
FEATURE_IS_ENABLED_MASK(FEATURE_${NAME}_BIT)) \\
FEATURE_IS_ENABLED_MASK(FEATURE_${NAME}_INDEX, FEATURE_${NAME}_BIT)) \\
)
EOH4
@@ -389,18 +414,27 @@ sub longest {
#define FEATURE_${NAME}_IS_ENABLED \\
( \\
CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
FEATURE_IS_ENABLED_MASK(FEATURE_${NAME}_BIT) \\
FEATURE_IS_ENABLED_MASK(FEATURE_${NAME}_INDEX, FEATURE_${NAME}_BIT) \\
)
EOH5
}
}

my $save_bits = "STMT_START { \\\n "
. join("\\\n ", map { "SAVEI32(PL_compiling.cop_features.bits[$_]); " } 0 .. $cop_feature_size-1)
. " \\\n } STMT_END";

my $clear_bits = "("
. join(" \\\n ", map "PL_compiling.cop_features.bits[$_] = ", 0 .. $cop_feature_size-1) . "0)";

print $h <<EOH;
#define SAVEFEATUREBITS() SAVEI32(PL_compiling.cop_features)
#define SAVEFEATUREBITS() \\
$save_bits
#define CLEARFEATUREBITS() (PL_compiling.cop_features = 0)
#define CLEARFEATUREBITS() \\
$clear_bits
#define FETCHFEATUREBITSHH(hh) S_fetch_feature_bits_hh(aTHX_ (hh))
@@ -450,6 +484,7 @@ sub longest {
if (memBEGINs(keypv, keylen, "feature_")) {
const char *subf = keypv + (sizeof("feature_")-1);
U32 mask = 0;
int index = 0;
switch (*subf) {
EOJ

@@ -470,6 +505,7 @@ sub longest {
$if (keylen == sizeof("feature_$subkey")-1
&& memcmp(subf+1, "$rest", keylen - sizeof("feature_")) == 0) {
mask = FEATURE_\U${subkey}\E_BIT;
index = FEATURE_\U${subkey}\E_INDEX;
break;
}
EOJ
@@ -487,9 +523,9 @@ sub longest {
return;
}
if (valsv ? SvTRUE(valsv) : valbool)
PL_compiling.cop_features |= mask;
PL_compiling.cop_features.bits[index] |= mask;
else
PL_compiling.cop_features &= ~mask;
PL_compiling.cop_features.bits[index] &= ~mask;
}
}
#endif /* PERL_IN_MG_C */
@@ -499,6 +535,7 @@ sub longest {
const char *name;
STRLEN namelen;
U32 mask;
int index;
};
#ifdef PERL_IN_PP_CTL_C
@@ -513,29 +550,53 @@ sub longest {
/* feature $key */
"feature_$val",
STRLENs("feature_$val"),
FEATURE_\U$val\E_BIT
FEATURE_\U$val\E_BIT,
FEATURE_\U$val\E_INDEX
},
EOJ
}

print $h <<EOJ;
{ NULL, 0, 0U }
{ NULL, 0, 0U, 0 }
};
PERL_STATIC_INLINE void
S_fetch_feature_bits_hh(pTHX_ HV *hh) {
PL_compiling.cop_features = 0;
CLEARFEATUREBITS();
const struct perl_feature_bit *fb = PL_feature_bits;
while (fb->name) {
SV **svp = hv_fetch(hh, fb->name, (I32)fb->namelen, 0);
if (svp && SvTRUE(*svp))
PL_compiling.cop_features |= fb->mask;
PL_compiling.cop_features.bits[fb->index] |= fb->mask;
++fb;
}
}
#endif
#endif /* PERL_IN_PP_CTL_C */
#ifdef PERL_IN_DUMP_C
EOJ

my $any_bits_set = "( \\\n " .
join(" || \\\n ", map "cop->cop_features.bits[$_]", 0 .. $cop_feature_size-1) .
" \\\n )";

my $dump_bits = "STMT_START { \\\n " .
join(qq( \\\n PerlIO_putc(file, ','); \\\n ),
map { qq(PerlIO_printf(file, "0x%08x", cop->cop_features.bits[$_]);) }
0 .. $cop_feature_size-1) .
" \\\n } STMT_END";

print $h <<EOJ;
#define ANY_FEATURE_BITS_SET(cop) \\
$any_bits_set
#define DUMP_FEATURE_BITS(file, cop) \\
$dump_bits
#endif /* PERL_IN_DUMP_C */
#endif /* PERL_FEATURE_H_ */
EOJ

0 comments on commit db0f1e5

Please sign in to comment.