From 658f070cf8e345b26dbc2261db12595a22cae030 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 8 Jun 2025 12:10:45 -0600 Subject: [PATCH 1/3] Add additional check for custom array/hash access checking PL_check[] can have customized checks for array/hash elements in the OP_AELEM, OP_EXISTS, and OP_DELETE elements. When these are set, the multideref optimization is turned off. It turns out that checking for this always shows that they are not the standard values on z/OS, because that platform's function pointers may point to a "function descriptor" and not the actual function, or it may not. It's not clear to me if this implementation conforms to the C Standard or not, but it is what it is. As a result our test suite fails some tests that are expecting non-custom entries in those slots. This commit builds upon some ideas from Dave Mitchell and Richard Leach to add 3 entries to the array of function pointers. These entries are initialized the same way the others are, so that a comparison against them when no customization has been done should succeed. The current comparisons are retained, so that it's likely on z/OS one or the other will succeed when no customization is currently in place. --- opcode.h | 18 ++++++++++++++++++ peep.c | 12 ++++++++---- regen/opcode.pl | 26 ++++++++++++++++++++++++++ 3 files changed, 52 insertions(+), 4 deletions(-) diff --git a/opcode.h b/opcode.h index 8f040e1813c9..d824e17db15c 100644 --- a/opcode.h +++ b/opcode.h @@ -1869,8 +1869,26 @@ INIT({ Perl_ck_null, /* methstart */ Perl_ck_null, /* initfield */ Perl_ck_classname, /* classname */ + +/* The final entries are function pointers not attached to an opcode. + * These are used to compare with function pointers in the earlier part of + * the array, since in some platforms (notably z/OS), it is undefined + * behavior to compare function pointers for equality, even though calling + * them will invoke the same function. This minimizes the risk of them + * being different by initializing them to the same values in the same + * array. */ + Perl_ck_null, + Perl_ck_exists, + Perl_ck_delete, }); +/* Indexes into PL_check for the comparison function pointers */ +#ifdef PERL_IN_PEEP_C + #define PERL_CK_NULL 426 + #define PERL_CK_EXISTS 427 + #define PERL_CK_DELETE 428 +#endif + EXTCONST U32 PL_opargs[] INIT({ 0x00000000, /* null */ 0x00000000, /* stub */ diff --git a/peep.c b/peep.c index 5980ea1c2fca..bf4224158086 100644 --- a/peep.c +++ b/peep.c @@ -2203,16 +2203,20 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints) * OP_EXISTS or OP_DELETE */ /* if a custom array/hash access checker is in scope, - * abandon optimisation attempt */ + * abandon optimisation attempt. Check two different ways because + * of z/OS (see comments in opcode.h) */ if ( (o->op_type == OP_AELEM || o->op_type == OP_HELEM) - && PL_check[o->op_type] != Perl_ck_null) + && PL_check[o->op_type] != Perl_ck_null + && PL_check[o->op_type] != PL_check[PERL_CK_NULL]) return; /* similarly for customised exists and delete */ if ( (o->op_type == OP_EXISTS) - && PL_check[o->op_type] != Perl_ck_exists) + && PL_check[o->op_type] != Perl_ck_exists + && PL_check[o->op_type] != PL_check[PERL_CK_EXISTS]) return; if ( (o->op_type == OP_DELETE) - && PL_check[o->op_type] != Perl_ck_delete) + && PL_check[o->op_type] != Perl_ck_delete + && PL_check[o->op_type] != PL_check[PERL_CK_DELETE]) return; if ( o->op_type != OP_AELEM diff --git a/regen/opcode.pl b/regen/opcode.pl index d59ed7c7d73f..e0301a3cc062 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -1114,13 +1114,39 @@ sub generate_opcode_h_pl_check { INIT({ END + for (@ops) { print "\t", tab(3, "Perl_$check{$_},"), "\t/* $_ */\n"; } + print <<~'END'; + + /* The final entries are function pointers not attached to an opcode. + * These are used to compare with function pointers in the earlier part of + * the array, since in some platforms (notably z/OS), it is undefined + * behavior to compare function pointers for equality, even though calling + * them will invoke the same function. This minimizes the risk of them + * being different by initializing them to the same values in the same + * array. */ + END + my @perl_internal_extras = qw(ck_null ck_exists ck_delete); + for (@perl_internal_extras) { + print "\t", tab(3, "Perl_$_,\n"); + } + print <<~'END'; }); + + /* Indexes into PL_check for the comparison function pointers */ + #ifdef PERL_IN_PEEP_C END + + for (my $i = 0; $i < @perl_internal_extras; $i++) { + my $index = @ops + $i; + my $define = uc $perl_internal_extras[$i]; + print " #define PERL_$define $index\n"; + } + print "#endif\n"; } sub generate_opcode_h_pl_opargs { From 30b299bd851a725a1bfbb88f94eb912dd8b3f169 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 3 Jul 2025 14:46:27 -0600 Subject: [PATCH 2/3] peep.c: Use constant when known over runtime I imagine most compilers would know to optimize the reference away when the first conditional has ruled out all but one possibility, but I think it is clearer anyway to use that single value. --- peep.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/peep.c b/peep.c index bf4224158086..d02f97c32856 100644 --- a/peep.c +++ b/peep.c @@ -2211,12 +2211,12 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints) return; /* similarly for customised exists and delete */ if ( (o->op_type == OP_EXISTS) - && PL_check[o->op_type] != Perl_ck_exists - && PL_check[o->op_type] != PL_check[PERL_CK_EXISTS]) + && PL_check[OP_EXISTS] != Perl_ck_exists + && PL_check[OP_EXISTS] != PL_check[PERL_CK_EXISTS]) return; if ( (o->op_type == OP_DELETE) - && PL_check[o->op_type] != Perl_ck_delete - && PL_check[o->op_type] != PL_check[PERL_CK_DELETE]) + && PL_check[OP_DELETE] != Perl_ck_delete + && PL_check[OP_DELETE] != PL_check[PERL_CK_DELETE]) return; if ( o->op_type != OP_AELEM From 7c1bc8f69abc2a83eb5013b12930910d1a6bb60c Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 3 Jul 2025 14:49:32 -0600 Subject: [PATCH 3/3] peep.c: Add some UNLIKELY() It's also unlikely that the op_type will be any given value, but I expect the compiler and libc know that. This stresses that it is unlikely some module will customize the handling of these checkers. --- peep.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/peep.c b/peep.c index d02f97c32856..a73deff1cf76 100644 --- a/peep.c +++ b/peep.c @@ -2206,17 +2206,17 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints) * abandon optimisation attempt. Check two different ways because * of z/OS (see comments in opcode.h) */ if ( (o->op_type == OP_AELEM || o->op_type == OP_HELEM) - && PL_check[o->op_type] != Perl_ck_null - && PL_check[o->op_type] != PL_check[PERL_CK_NULL]) + && UNLIKELY(PL_check[o->op_type] != Perl_ck_null) + && UNLIKELY(PL_check[o->op_type] != PL_check[PERL_CK_NULL])) return; /* similarly for customised exists and delete */ if ( (o->op_type == OP_EXISTS) - && PL_check[OP_EXISTS] != Perl_ck_exists - && PL_check[OP_EXISTS] != PL_check[PERL_CK_EXISTS]) + && UNLIKELY(PL_check[OP_EXISTS] != Perl_ck_exists) + && UNLIKELY(PL_check[OP_EXISTS] != PL_check[PERL_CK_EXISTS])) return; if ( (o->op_type == OP_DELETE) - && PL_check[OP_DELETE] != Perl_ck_delete - && PL_check[OP_DELETE] != PL_check[PERL_CK_DELETE]) + && UNLIKELY(PL_check[OP_DELETE] != Perl_ck_delete) + && UNLIKELY(PL_check[OP_DELETE] != PL_check[PERL_CK_DELETE])) return; if ( o->op_type != OP_AELEM