-
Notifications
You must be signed in to change notification settings - Fork 589
Create new OP_MULTIPARAM
to implement subroutine signatures
#23574
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Changes from all commits
af33570
c40e7ff
2bc615d
907ada1
5d78994
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -1393,6 +1393,20 @@ aux_list(o, cv) | |
XSRETURN(len); | ||
|
||
} /* OP_MULTIDEREF */ | ||
|
||
case OP_MULTIPARAM: | ||
{ | ||
struct op_multiparam_aux *p = (struct op_multiparam_aux *)aux; | ||
UV nparams = p->n_positional; | ||
EXTEND(SP, (IV)(3 + nparams + 1)); | ||
mPUSHu(p->min_args); | ||
mPUSHu(p->n_positional); | ||
PUSHs(sv_2mortal(p->slurpy ? newSVpvf("%c", p->slurpy) : &PL_sv_no)); | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Why run a 1 byte long string through a printf engine? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Because offhand I don't believe we have a There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more.
Also, why are we mortalizing PUSHs(p->slurpy ? newSVpvn_flags(&p->slurpy, 1, SVs_TEMP) : &PL_sv_no); There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Very true, there is missing Perl in C infrastructure in this area. I've seen various builds from various decades of Spidermonkey/V8 having all 1 char long string objects, fo all of low 7 bit printable ASCII or 0x00-0x7F ,pre-generated burned into HW RO memory as C structs. Perl 5 calls it a SvIMMORTAL. Its funny because demerphq very quietly added something similar for all of 1 char long, 0x00-0xff, to Perl 5, like 8 years ago, but its always # define off by default and nobody has paid attention to the feature ever since. And Configure/config.h doesn't know about it. So currently in perl 5, there are 2 normalish ways to do this. and maybe 1 @bulk88 high-speed way to do this, I'd have to research if the cpan visible exported constant array I'm thinking could be inside libperl actually exists. I'd say option 1 is see 60% of the time, option 2 is 40% in core. normal option 1
normal option 2
bulk option that probably doesn't exist inside libperl, lack of infrastructure
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. For better infrastructure, most or all src code instance of
See what I did? All LE CPU will need a secret byte order flipper macro inside the The real
isn't ISO C and way too rare as a vendor extension to pretend that (a
is possible, day code we have such rapid short string comparison/parsing macros.
and on x64
https://www.altium.com/ 's ISO C99 compliant compiler for ARM32/64 has https://valhalla.altium.com/Learning-Guides/GU0122%20C-to-Hardware%20Compiler%20User%20Manual.pdf I want to crack a joke after reading its entire manual, if Perl 5 was compiled with that C compiler, the output will binary describing transistor gates. There is now a Perl CPU executing the Perl ISA. The Perl CPU's socket pins are an RS-232 serial port called I'm not sure after reading that C compiler's manual and IDE, if Altium can generate an ELF/EFI binary of ARM machine code or not or it only generates transistor gates for random unmodified desktop POSIX software, and that transistor gate language can only execute in Altium's C99 compiler has USA and EU govt certificates to generate GUI-aware binaries that draw automobile digital speedometers and aircraft pilot LCD GUIs. Enough said who their customers are. The last time I rented a Nissan, I found out the radio was a 5 year old no-Google Android 6.0 OS, on a "this year" 4 month old car. Nissan bought the cheapest android SOC chips they could find, that were heading to be melted or burned anyway, because they were obsolete, and nobody, not at any cost, will solder them into a phone, not even a $40 phone. The Nissans's dashboard has a 1 way serial port that pushes data to Android 6 (tire pressure icon, etc), the radio has absolutely no electrical way to talk back to the GUI on the instrument console. Proper design IMO. |
||
for(UV parami = 0; parami < nparams; parami++) | ||
mPUSHu(p->param_padix[parami]); | ||
mPUSHu(p->slurpy_padix); | ||
XSRETURN(3 + nparams + 1); | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. replace with PUTBACK; return; There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Again, just following similarity with the other cases. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This is dangerous C code.
You"ve never read I wouldn't blame anyone for saying those 2 sections are unreadable, because the first time I read them a long time ago they were unreadable to me. In 2025 they are still unreadable for me. They confuse new people more than they help new people. So if after reading the official API docs, you still don't understand, go watch my videos on how to use the Perl Stack https://www.youtube.com/results?search_query=%22Writing+XS+in+Plain+C%22 I included graphics explaining it. |
||
} | ||
} /* switch */ | ||
|
||
|
||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -4,7 +4,7 @@ use strict; | |
use warnings; | ||
use Carp; | ||
|
||
our $VERSION = '1.44'; | ||
our $VERSION = '1.45'; | ||
|
||
require XSLoader; | ||
|
||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -1200,6 +1200,29 @@ static OP *THX_parse_keyword_subsignature(pTHX) | |
newSVpvf(kid->op_flags & OPf_KIDS ? "argelem:%s:d" : "argelem:%s", namepv))); | ||
break; | ||
} | ||
case OP_MULTIPARAM: { | ||
struct op_multiparam_aux *p = | ||
(struct op_multiparam_aux *)(cUNOP_AUXx(kid)->op_aux); | ||
PADNAMELIST *names = PadlistNAMES(CvPADLIST(find_runcv(0))); | ||
SV *retsv = newSVpvf("multiparam:%" UVuf "..%" UVuf ":%c", | ||
p->min_args, p->n_positional, p->slurpy ? p->slurpy : '-'); | ||
for (UV paramidx = 0; paramidx < p->n_positional; paramidx++) { | ||
char *namepv = PadnamePV(padnamelist_fetch(names, p->param_padix[paramidx])); | ||
if(namepv) | ||
sv_catpvf(retsv, ":%s=%" UVf, namepv, paramidx); | ||
else | ||
sv_catpvf(retsv, ":(anon)=%" UVf, paramidx); | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more.
in theory IDK and IDC enough, and probably its impossible to write a bug ticket with a failure/defect demo, about it, but I see UTF8 flag is perma-on in the data source API, but we arent propagating it to the higher level. And this is XS::APItest anyways, so perfection isnt critical. but someone might look at this in the future for "best practices" ideas, and then copy paste quicky hacky code into a more visible API. |
||
if(paramidx >= p->min_args) | ||
sv_catpvs(retsv, "?"); | ||
} | ||
if (p->slurpy_padix) | ||
sv_catpvf(retsv, ":%s=*", | ||
PadnamePV(padnamelist_fetch(names, p->slurpy_padix))); | ||
retop = op_append_list(OP_LIST, retop, newSVOP(OP_CONST, 0, retsv)); | ||
break; | ||
} | ||
case OP_PARAMTEST: | ||
break; | ||
default: | ||
fprintf(stderr, "TODO: examine kid %p (optype=%s)\n", kid, PL_op_name[kid->op_type]); | ||
break; | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -7,7 +7,7 @@ | |
# This is based on the module of the same name by Malcolm Beattie, | ||
# but essentially none of his code remains. | ||
|
||
package B::Deparse 1.86; | ||
package B::Deparse 1.87; | ||
use strict; | ||
use Carp; | ||
use B qw(class main_root main_start main_cv svref_2object opnumber perlstring | ||
|
@@ -26,6 +26,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring | |
OPpMULTICONCAT_APPEND OPpMULTICONCAT_STRINGIFY OPpMULTICONCAT_FAKE | ||
OPpTRUEBOOL OPpINDEX_BOOLNEG OPpDEFER_FINALLY | ||
OPpARG_IF_UNDEF OPpARG_IF_FALSE | ||
OPpPARAM_IF_UNDEF OPpPARAM_IF_FALSE | ||
SVf_IOK SVf_NOK SVf_ROK SVf_POK SVf_FAKE SVs_RMG SVs_SMG | ||
SVs_PADTMP | ||
CVf_NOWARN_AMBIGUOUS CVf_LVALUE CVf_IsMETHOD | ||
|
@@ -1180,6 +1181,94 @@ sub pad_subs { | |
} | ||
|
||
|
||
# deparse_multiparam(): deparse, if possible, a sequence of ops into a | ||
# subroutine signature. If possible, returns a string representing the | ||
# signature syntax, minus the surrounding parentheses. | ||
|
||
sub deparse_multiparam { | ||
my ($self, $topop, $cv) = @_; | ||
|
||
$topop = $topop->first; | ||
return unless $$topop and $topop->name eq 'lineseq'; | ||
|
||
# last op should be nextstate | ||
my $last = $topop->last; | ||
return unless $$last | ||
and ( _op_is_or_was($last, OP_NEXTSTATE) | ||
or _op_is_or_was($last, OP_DBSTATE)); | ||
|
||
# first OP_NEXTSTATE | ||
|
||
my $o = $topop->first; | ||
return unless $$o; | ||
return if $o->label; | ||
|
||
# OP_MULTIPARAM | ||
|
||
$o = $o->sibling; | ||
return unless $$o and $o->name eq 'multiparam'; | ||
|
||
my ($min_args, $max_args, $slurpy, @rest) = $o->aux_list($cv); | ||
my $nparams = $max_args; | ||
my @param_padix = splice @rest, 0, $nparams, (); | ||
my ($slurpy_padix) = @rest; | ||
|
||
my @sig; | ||
my %parami_for_padix; | ||
|
||
# Initial scalars | ||
foreach my $parami ( 0 .. $max_args-1 ) { | ||
my $padix = $param_padix[$parami]; | ||
$sig[$parami] = $self->padname($padix) || '$'; | ||
$parami_for_padix{$padix} = $parami; | ||
} | ||
|
||
$o = $o->sibling; | ||
for (; $o and !null $o; $o = $o->sibling) { | ||
# Look for OP_NULL[OP_PARAMTEST[OP_PARAMSTORE]] | ||
my $ofirst; | ||
if ($o->name eq 'null' and $o->flags & OPf_KIDS and | ||
($ofirst = $o->first)->name eq 'paramtest' and | ||
$ofirst->first->name eq 'paramstore') { | ||
# A defaulting expression | ||
|
||
my $parami = $parami_for_padix{$ofirst->targ}; | ||
|
||
my $assign = "="; | ||
$assign = "//=" if $ofirst->private == OPpPARAM_IF_UNDEF; | ||
$assign = "||=" if $ofirst->private == OPpPARAM_IF_FALSE; | ||
|
||
length $sig[$parami] > 1 ? | ||
( $sig[$parami] .= ' ' ) : | ||
( $sig[$parami] = '$' ); # intentionally no trailing space | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. dont look up same thing over and over in an array, do a There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. The performance improvement of that indirection will be absolutely miniscule given this is deparse of a signatured sub; hardly a hot path. I prefer the clarity of the code as written. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. ok, you can click close / hide on your side for this bubble. |
||
|
||
my $defop = $ofirst->first->first; | ||
if ($defop->name eq "stub") { | ||
$sig[$parami] .= "$assign"; | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. y the ""s? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Symmetry with the other case below. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Quoting poorly written old doesn't make it right. You don't need I have no idea how If |
||
} | ||
else { | ||
my $def = $self->deparse($defop, 7); | ||
$def = "($def)" if $defop->flags & OPf_PARENS; | ||
|
||
$sig[$parami] .= "$assign $def"; | ||
} | ||
} | ||
} | ||
|
||
if ($cv->CvFLAGS & CVf_IsMETHOD) { | ||
# Remove the implied `$self` argument | ||
warn "Expected first signature argument to be named \$self" | ||
unless @sig and $sig[0] eq '$self'; | ||
shift @sig; | ||
} | ||
|
||
if ($slurpy) { | ||
push @sig, $slurpy_padix ? $self->padname($slurpy_padix) : $slurpy; | ||
} | ||
|
||
return join(", ", @sig); | ||
} | ||
|
||
# deparse_argops(): deparse, if possible, a sequence of argcheck + argelem | ||
# ops into a subroutine signature. If successful, return the first op | ||
# following the signature ops plus the signature string; else return the | ||
|
@@ -1377,7 +1466,8 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); | |
and $firstop->name eq 'null' | ||
and $firstop->targ == OP_ARGCHECK | ||
) { | ||
my ($mysig) = $self->deparse_argops($firstop, $cv); | ||
my ($mysig) = $self->deparse_multiparam($firstop, $cv) // | ||
$self->deparse_argops($firstop, $cv); | ||
if (defined $mysig) { | ||
$sig = $mysig; | ||
$firstop = $is_list ? $firstop->sibling : undef; | ||
|
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Add the MEXTEND mortal stack stretcher macro here too.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
The other cases (
OP_MULTIDEREF
,OP_MULTICONCAT
) don't do those either; I was following similar structure. Perhaps in a separate commit we could add that later. Though this is only duringB
's inspection, it's not a hot performance path. I think the slight performance cost is fine for the simpler code.There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Just because bad code exists elsewhere in core already, is not a reason to copy the bad code to new code in new places and cite the bad code as proof your new code is correct because nobody had to time to refactor the bad code over the years.
Write new code correctly to the Perl C API the first time so nobody has to clean it up after you.
nparams
is a fixed known ahead length.realloc()
the mortal stack ONCE withMEXTEND()
and don't bounds check and then possibly grow the stack in units of 1SV*
at a time, on every iteration through the loop.Its as silly as writing this in C.