ExtUtils-ParseXS
view release on metacpan or search on metacpan
lib/ExtUtils/ParseXS/Node.pm view on Meta::CPAN
all subclasses. First, C<parse()> consumes lines from the source to
satisfy the construct being parsed. It may itself create objects of
lower-level constructs and call parse on them. For example,
C<Node::xbody::parse()> may create a C<Node::input_part> node and call
C<parse()> on it, which will create C<Node::INPUT> or C<Node::PREINIT>
nodes as appropriate, and so on.
Secondly, C<as_code()> descends its sub-tree, outputting the tree as C
code.
The C<as_concise()> method returns a line-per-node string representation
of the node and any children. Most node classes just inherit this method
from the base C<Node> class. It is intended mainly for debugging.
Some nodes also have an C<as_boot_code()> method for adding any code to
the boot XSUB. This returns two array refs, one containing a list of code
lines to be inserted early into the boot XSUB, and a second for later
lines.
Finally, in the IO_Param subclass, C<as_code()> is replaced with
C<as_input_code> and C<as_output_code()>, since that node may need to
generate I<two> sets of C code; one to assign a Perl argument to a C
variable, and the other to return the value of a variable to Perl.
Note that parsing and code-generation are done as two separate phases;
C<parse()> should only build a tree and never emit code.
In addition to C<$self>, methods may commonly have some of these
parameters:
=over
=item C<$pxs>
An C<ExtUtils::ParseXS> object which contains the overall processing
state. In particular, it has warning and croaking methods, and holds the
lines read in from the source file for the current paragraph.
=item C<$xsub>
For nodes related to parsing an XSUB, the current
C<ExtUtils::ParseXS::xsub> node being processed.
=item C<$xbody>
For nodes related to parsing an XSUB, the current
C<ExtUtils::ParseXS::xbody> node being processed. Note that in the
presence of a C<CASE> keyword, an XSUB can have multiple bodies.
=back
The C<parse()> and C<as_code()> methods for some subclasses may have
parameters in addition to those.
Some subclasses may also have additional helper methods.
=head2 Class Hierachy
C<Node> and its sub-classes form the following inheritance hierarchy.
Various abstract classes are used by concrete subclasses where the
processing and/or fields are similar: for example, C<CODE>, C<PPCODE> etc
all consume a block of uninterpreted lines from the source file until the
next keyword, and emit that code, possibly wrapped in C<#line> directives.
This common behaviour is provided by the C<codeblock> class.
Node
XS_file
preamble
C_part
C_part_POD
C_part_code
C_part_postamble
cpp_scope
global_cpp_line
BOOT
TYPEMAP
pre_boot
boot_xsub
xsub
xsub_decl
ReturnType
Param
IO_Param
Params
xbody
input_part
init_part
code_part
output_part
cleanup_part
autocall
oneline
MODULE
REQUIRE
FALLBACK
include
INCLUDE
INCLUDE_COMMAND
NOT_IMPLEMENTED_YET
CASE
enable
EXPORT_XSUB_SYMBOLS
PROTOTYPES
SCOPE
VERSIONCHECK
multiline
multiline_merged
C_ARGS
INTERFACE
INTERFACE_MACRO
OVERLOAD
ATTRS
PROTOTYPE
codeblock
CODE
CLEANUP
INIT
POSTCALL
PPCODE
PREINIT
keylines
ALIAS
INPUT
OUTPUT
keyline
ALIAS_line
INPUT_line
OUTPUT_line
=head2 Abstract Syntax Tree structure
A typical XS file might compile to a tree with a node structure similar to
the following. Note that this is unrelated to the inheritance hierarchy
shown above. In this example, the XS file includes another file, and has a
couple of XSUBs within a C<#if/#else/#endif>. Note that a C<cpp_scope>
node is the parent of all the nodes within the same branch of an C<#if>,
or in the absence of C<#if>, within the same file.
XS_file
preamble
C_part
C_part_POD
C_part_code
C_part_postamble
cpp_scope: type="main"
MODULE
PROTOTYPES
BOOT
TYPEMAP
INCLUDE
cpp_scope: type="include"
xsub
...
global_cpp_line: directive="ifdef"
cpp_scope: type="if"
xsub
...
global_cpp_line: directive="else"
cpp_scope: type="if"
xsub
...
global_cpp_line: directive="endif"
xsub
...
pre_boot
boot_xsub
A typical XSUB might compile to a tree with a structure similar to the
following.
xsub
xsub_decl
ReturnType
Params
Param
Param
...
CASE # for when a CASE keyword being present implies multiple
lib/ExtUtils/ParseXS/Node.pm view on Meta::CPAN
EOF
}
# Emit any lines derived from BOOT: sections
if (@$later) {
print $self->Q(<<"EOF");
|
| /* Initialisation Section */
|
EOF
print @$later;
print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n"
if $pxs->{config_WantLineNumbers};
print $self->Q(<<"EOF");
|
| /* End of Initialisation Section */
|
EOF
}
# Emit code to call any UNITCHECK blocks and return true.
# Since 5.22, this is been put into a separate function.
print $self->Q(<<"EOF");
|#if PERL_VERSION_LE(5, 21, 5)
|# if PERL_VERSION_GE(5, 9, 0)
| if (PL_unitcheckav)
| call_list(PL_scopestack_ix, PL_unitcheckav);
|# endif
| XSRETURN_YES;
|#else
| Perl_xs_boot_epilog(aTHX_ ax);
|#endif
|$close_brace
|
|#ifdef __cplusplus
|$close_brace
|#endif
EOF
}
# ======================================================================
package ExtUtils::ParseXS::Node::xsub;
# Process an entire XSUB definition
BEGIN { $build_subclass->(
'decl', # Node::xsub_decl object holding this XSUB's declaration
# Boolean flags: they indicate that at least one of each specified
# keyword has been seen in this XSUB
'seen_ALIAS',
'seen_INTERFACE',
'seen_INTERFACE_MACRO',
'seen_PPCODE',
'seen_PROTOTYPE',
'seen_SCOPE',
# These three fields indicate how many SVs are returned to the caller,
# and so influence the emitting of 'EXTEND(n)', 'XSRETURN(n)', and
# potentially, the value of n in 'ST(n) = ...'.
#
# XSRETURN_count_basic is 0 or 1 and indicates whether a basic return
# value is pushed onto the stack. It is usually directly related to
# whether the XSUB is declared void, but NO_RETURN and CODE_sets_ST0
# can alter that.
#
# XSRETURN_count_extra indicates how many SVs will be returned in
# addition the basic 0 or 1. These will be params declared as OUTLIST.
#
# CODE_sets_ST0 is a flag indicating that something within a CODE
# block is doing 'ST(0) = ..' or similar. This is a workaround for
# a bug: see the code comments "Horrible 'void' return arg count hack"
# in Node::CODE::parse() for more details.
'CODE_sets_ST0', # Bool
'XSRETURN_count_basic', # Int
'XSRETURN_count_extra', # Int
# These maintain the alias parsing state across potentially multiple
# ALIAS keywords and or lines:
'map_alias_name_to_value', # Hash: maps seen alias names to their value
'map_alias_value_to_name_seen_hash', # Hash of Hash of Bools:
# indicates which alias names have been
# used for each value.
'alias_clash_hinted', # Bool: an ALIAS warn-hint has been emitted.
# Maintain the INTERFACE parsing state across potentially multiple
# INTERFACE keywords and/or lines:
'map_interface_name_short_to_original', # Hash: for each INTERFACE
# name, map the short (PREFIX removed) name
# to the original name.
# Maintain the OVERLOAD parsing state across potentially multiple
# OVERLOAD keywords and/or lines:
'overload_name_seen', # Hash of Bools: indicates overload method
# names (such as '<=>') which have been
# listed by OVERLOAD (for newXS boot code
# emitting).
# Maintain the ATTRS parsing state across potentially multiple
# ATTRS keywords and or lines:
'attributes', # Array of Strs: all ATTRIBUTE keywords
# (possibly multiple space-separated
# keywords per string).
# INTERFACE_MACRO state
'interface_macro', # Str: value of interface extraction macro.
'interface_macro_set', # Str: value of interface setting macro.
lib/ExtUtils/ParseXS/Node.pm view on Meta::CPAN
my $extern = $self->{decl}{return_type}{extern_C}
? qq[extern "C"] : "";
my $cname = $self->{decl}{full_C_name};
# Emit function header
print $self->Q(<<"EOF");
|$extern
|XS_EUPXS(XS_$cname); /* prototype to pass -Wmissing-prototypes */
|XS_EUPXS(XS_$cname)
|$open_brace
| dVAR; dXSARGS;
EOF
}
print $self->Q(<<"EOF") if $self->{seen_ALIAS};
| dXSI32;
EOF
if ($self->{seen_INTERFACE}) {
my $type = $self->{decl}{return_type}{type};
$type =~ tr/:/_/
unless $pxs->{config_RetainCplusplusHierarchicalTypes};
print $self->Q(<<"EOF") if $self->{seen_INTERFACE};
| dXSFUNCTION($type);
EOF
}
{
my $params = $self->{decl}{params};
# the code to emit to determine whether the correct number of argument
# have been passed
my $condition_code =
ExtUtils::ParseXS::set_cond($params->{seen_ellipsis},
$params->{min_args},
$params->{nargs});
# "-except" cmd line switch
print $self->Q(<<"EOF") if $pxs->{config_allow_exceptions};
| char errbuf[1024];
| *errbuf = '\\0';
EOF
if ($condition_code) {
my $p = $params->usage_string();
$p =~ s/"/\\"/g;
print $self->Q(<<"EOF");
| if ($condition_code)
| croak_xs_usage(cv, "$p");
EOF
}
else {
# cv and items likely to be unused
print $self->Q(<<"EOF");
| PERL_UNUSED_VAR(cv); /* -W */
| PERL_UNUSED_VAR(items); /* -W */
EOF
}
}
# gcc -Wall: if an XSUB has PPCODE, it is possible that none of ST,
# XSRETURN or XSprePUSH macros are used. Hence 'ax' (setup by
# dXSARGS) is unused.
# XXX: could breakup the dXSARGS; into dSP;dMARK;dITEMS
# but such a move could break third-party extensions
print $self->Q(<<"EOF") if $self->{seen_PPCODE};
| PERL_UNUSED_VAR(ax); /* -Wall */
EOF
print $self->Q(<<"EOF") if $self->{seen_PPCODE};
| SP -= items;
EOF
# ----------------------------------------------------------------
# Emit the main body of the XSUB (all the CASE statements + bodies
# or a single body)
# ----------------------------------------------------------------
$_->as_code($pxs, $self) for @{$self->{kids}};
# ----------------------------------------------------------------
# All of the body of the XSUB (including all CASE variants) has now
# been processed. Now emit any XSRETURN or similar, plus any closing
# bracket.
# ----------------------------------------------------------------
print $self->Q(<<"EOF") if $pxs->{config_allow_exceptions};
| if (errbuf[0])
| Perl_croak(aTHX_ errbuf);
EOF
# Emit XSRETURN(N) or XSRETURN_EMPTY. It's possible that the user's
# CODE section rolled its own return, so this code may be
# unreachable. So suppress any compiler warnings.
# XXX Currently this is just for HP. Make more generic??
# Suppress "statement is unreachable" warning on HPUX
print "#if defined(__HP_cc) || defined(__HP_aCC)\n",
"#pragma diag_suppress 2128\n",
"#endif\n"
if $^O eq "hpux";
unless ($self->{seen_PPCODE}) {
my $nret = $self->{XSRETURN_count_basic}
+ $self->{XSRETURN_count_extra};
print $nret ? " XSRETURN($nret);\n"
: " XSRETURN_EMPTY;\n";
}
# Suppress "statement is unreachable" warning on HPUX
print "#if defined(__HP_cc) || defined(__HP_aCC)\n",
"#pragma diag_default 2128\n",
"#endif\n"
if $^O eq "hpux";
# Emit final closing bracket for the XSUB.
print "$close_brace\n\n";
}
# Return a list of boot code strings for the XSUB, including newXS()
# call(s) plus any additional boot stuff like handling attributes or
# storing an alias index in the XSUB's CV.
sub as_boot_code {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
# Depending on whether the XSUB has a prototype, work out how to
# invoke one of the newXS() function variants. Set these:
#
my $newXS; # the newXS() variant to be called in the boot section
my $file_arg; # an extra ', file' arg to be passed to newXS call
my $proto_arg; # an extra e.g. ', "$@"' arg to be passed to newXS call
my @code; # boot code for each alias etc
$proto_arg = "";
unless($self->{prototype}) {
# no prototype
$newXS = "newXS_deffile";
$file_arg = "";
}
else {
# needs prototype
$newXS = "newXSproto_portable";
$file_arg = ", file";
if ($self->{prototype} eq 2) {
# User has specified an empty prototype
}
elsif ($self->{prototype} eq 1) {
# Protoype enabled, but to be auto-generated by us
$proto_arg = $self->{decl}{params}->proto_string();
$proto_arg =~ s{\\}{\\\\}g; # escape backslashes
}
else {
# User has manually specified a prototype
$proto_arg = $self->{prototype};
}
lib/ExtUtils/ParseXS/Node.pm view on Meta::CPAN
# sections.
my $orig = $xsub->{decl}{params};
# make a shallow copy
my $ioparams = ExtUtils::ParseXS::Node::Params->new($orig);
# now duplicate (deep copy) any Param objects and regenerate a new
# names-mapping hash
$ioparams->{kids} = [];
$ioparams->{names} = {};
for my $op (@{$orig->{kids}}) {
my $p = ExtUtils::ParseXS::Node::IO_Param->new($op);
# don't copy the current proto state (from the most recent
# CASE) into the new CASE.
undef $p->{proto};
push @{$ioparams->{kids}}, $p;
$ioparams->{names}{$p->{var}} = $p;
}
$self->{ioparams} = $ioparams;
}
# by default, OUTPUT entries have SETMAGIC: ENABLE
$self->{OUTPUT_SETMAGIC_state} = 1;
for my $part (qw(input_part init_part code_part output_part cleanup_part)) {
my $kid = "ExtUtils::ParseXS::Node::$part"->new();
if ($kid->parse($pxs, $xsub, $self)) {
push @{$self->{kids}}, $kid;
$self->{$part} = $kid;
}
}
1;
}
sub as_code {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
# Emit opening brace. With cmd-line switch "-except", prefix it with 'TRY'
print +($pxs->{config_allow_exceptions} ? ' TRY' : '')
. " $open_brace\n";
if ($self->{kids}) {
$_->as_code($pxs, $xsub, $self) for @{$self->{kids}};
}
# ----------------------------------------------------------------
# Emit trailers for the body of the XSUB
# ----------------------------------------------------------------
if ($xsub->{SCOPE_enabled}) {
# the matching opens were emitted in input_part->as_code()
print " $close_brace\n";
# PPCODE->as_code emits its own LEAVE and return, so this
# line would never be reached.
print " LEAVE;\n" unless $xsub->{seen_PPCODE};
}
# matches the $open_brace at the start of this function
print " $close_brace\n";
print $self->Q(<<"EOF") if $pxs->{config_allow_exceptions};
| BEGHANDLERS
| CATCHALL
| sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
| ENDHANDLERS
EOF
}
# ======================================================================
package ExtUtils::ParseXS::Node::input_part;
BEGIN { $build_subclass->(
# Str: used during code generation:
# a multi-line string containing lines of code to be emitted *after*
# all INPUT and PREINIT keywords have been processed.
'deferred_code_lines',
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
$self->SUPER::parse($pxs); # set file/line_no
# Process any implicit INPUT section.
{
my $input = ExtUtils::ParseXS::Node::INPUT->new();
if ( $input->parse($pxs, $xsub, $xbody)
&& $input->{kids}
&& @{$input->{kids}})
{
$input->{implicit} = 1;
push @{$self->{kids}}, $input;
}
}
# Repeatedly look for INPUT or similar or generic keywords,
# parse the text following them, and add any resultant nodes
# as kids to the current node.
$self->parse_keywords(
$pxs, $xsub, $xbody,
undef, # implies process as many keywords as possible
"C_ARGS|INPUT|INTERFACE_MACRO|PREINIT|SCOPE|"
. $ExtUtils::ParseXS::Constants::generic_xsub_keywords_alt,
);
# For each param, look up its INPUT typemap information now (at parse
lib/ExtUtils/ParseXS/Node.pm view on Meta::CPAN
# ======================================================================
package ExtUtils::ParseXS::Node::init_part;
BEGIN { $build_subclass->(
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
$self->SUPER::parse($pxs); # set file/line_no
# Repeatedly look for INIT or generic keywords,
# parse the text following them, and add any resultant nodes
# as kids to the current node.
$self->parse_keywords(
$pxs, $xsub, $xbody,
undef, # implies process as many keywords as possible
"C_ARGS|INIT|INTERFACE|INTERFACE_MACRO|"
. $ExtUtils::ParseXS::Constants::generic_xsub_keywords_alt,
);
1;
}
sub as_code {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
if ($self->{kids}) {
$_->as_code($pxs, $xsub, $xbody) for @{$self->{kids}};
}
}
# ======================================================================
package ExtUtils::ParseXS::Node::code_part;
BEGIN { $build_subclass->(
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
$self->SUPER::parse($pxs); # set file/line_no
# Look for a CODE/PPCODE/NOT_IMPLEMENTED_YET keyword; if found, add
# the kid to the current node.
return 1 if $self->parse_keywords(
$pxs, $xsub, $xbody,
1, # match at most one keyword
"CODE|PPCODE",
$keywords_flag_NOT_IMPLEMENTED_YET,
);
# Didn't find a CODE keyword or similar, so auto-generate a call
# to the same-named C library function.
my $autocall = ExtUtils::ParseXS::Node::autocall->new();
# mainly a NOOP, but sets line number etc and flags that autocall seen
$autocall->parse($pxs, $xsub, $xbody)
or return;
push @{$self->{kids}}, $autocall;
1;
}
sub as_code {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
if ($self->{kids}) {
$_->as_code($pxs, $xsub, $xbody) for @{$self->{kids}};
}
}
# ======================================================================
package ExtUtils::ParseXS::Node::output_part;
BEGIN { $build_subclass->(
# State during code emitting
'targ_used', # Bool: the TARG has been allocated for this body,
# so is no longer available for use.
'stack_was_reset', # Bool: An XSprePUSH was emitted, so return values
# should be PUSHed rather than just set.
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
$self->SUPER::parse($pxs); # set file/line_no
# Repeatedly look for POSTCALL, OUTPUT or generic keywords,
# parse the text following them, and add any resultant nodes
# as kids to the current node.
# XXX POSTCALL is documented to precede OUTPUT, but here we allow
# them in any order and multiplicity.
$self->parse_keywords(
$pxs, $xsub, $xbody,
undef, # implies process as many keywords as possible
lib/ExtUtils/ParseXS/Node.pm view on Meta::CPAN
# ======================================================================
package ExtUtils::ParseXS::Node::NOT_IMPLEMENTED_YET;
# Handle NOT_IMPLEMENTED_YET pseudo-keyword
BEGIN { $build_subclass->(-parent => 'oneline',
)};
sub as_code {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
print "\n"
. "\tPerl_croak(aTHX_ \"$xsub->{decl}{full_perl_name}: "
. "not implemented yet\");\n";
}
# ======================================================================
package ExtUtils::ParseXS::Node::CASE;
# Process the 'CASE:' keyword
BEGIN { $build_subclass->(-parent => 'oneline',
'cond', # Str: the C code of the condition for the CASE, or ''
'num', # Int: which CASE number this is (starting at 1)
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
$self->SUPER::parse($pxs); # set file/line_no/text
$self->{cond} = $self->{text};
# Note that setting num, and consistency checking (like "else"
# without "if") is done by the caller, Node::xsub.
1;
}
sub as_code {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my $cond = $self->{cond};
$cond = " if ($cond)" if length $cond;
print " ", ($self->{num} > 1 ? " else" : ""), $cond, "\n";
$_->as_code($pxs, $xsub) for @{$self->{kids}};
}
# ======================================================================
package ExtUtils::ParseXS::Node::autocall;
# Handle an empty XSUB body (i.e. no CODE or PPCODE)
# by auto-generating a call to a C library function of the same
# name
BEGIN { $build_subclass->(
'args', # Str: text to use for auto function call arguments
'types', # Str: text to use for auto function type declaration
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
$self->SUPER::parse($pxs); # set file/line_no
$xbody->{seen_autocall} = 1;
my $ioparams = $xbody->{ioparams};
my ($args, $types);
$args = $ioparams->{auto_function_sig_override}; # C_ARGS
if (defined $args) {
# Try to determine the C_ARGS types; for example, with
#
# foo(short s, int i, long l)
# C_ARGS: s, l
#
# set $types to ['short', 'long']. May give the wrong results if
# C_ARGS isn't just a simple list of parameter names
for my $var (split /,/, $args) {
$var =~ s/^\s+//;
$var =~ s/\s+$//;
my $param = $ioparams->{names}{$var};
# 'void*' is a desperate guess if no such parameter
push @$types, ($param && defined $param->{type})
? $param->{type} : 'void*';
}
$self->{args} = $args;
}
else {
($args, $types) = $ioparams->C_func_signature($pxs);
$self->{args} = join ', ', @$args;
}
unless ($pxs->{config_RetainCplusplusHierarchicalTypes}) {
s/:/_/g for @$types;
}
$self->{types} = join ', ', @$types;
1;
}
sub as_code {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
lib/ExtUtils/ParseXS/Node.pm view on Meta::CPAN
# Handle SCOPE keyword
#
# Note that this keyword can appear both inside of and outside of an XSUB.
BEGIN { $build_subclass->(-parent => 'enable',
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
$self->SUPER::parse($pxs); # set file/line_no, self->{enable}
# $xsub not defined for file-scoped SCOPE
if ($xsub) {
$pxs->blurt("Error: only one SCOPE declaration allowed per XSUB")
if $xsub->{seen_SCOPE};
$xsub->{seen_SCOPE} = 1;
}
# Note that currently this parse method can be called either while
# parsing an XSUB, or while processing file-scoped keywords
# just before an XSUB declaration. So potentially set both types of
# state.
$xsub->{SCOPE_enabled} = $self->{enable} if $xsub;
$pxs->{file_SCOPE_enabled} = $self->{enable};
1;
}
# ======================================================================
package ExtUtils::ParseXS::Node::VERSIONCHECK;
# Handle VERSIONCHECK keyword
#
# Note that this keyword can appear both inside of and outside of an XSUB.
BEGIN { $build_subclass->(-parent => 'enable',
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
$self->SUPER::parse($pxs); # set file/line_no, self->{enable}
$pxs->{VERSIONCHECK_value} = $self->{enable};
1;
}
# ======================================================================
package ExtUtils::ParseXS::Node::multiline;
# Generic base class for keyword Nodes which can contain multiple lines,
# e.g. C code or other data: so anything from ALIAS to PPCODE.
# On entry, $self->lines[0] will be any text (on the same line) which
# follows the keyword.
BEGIN { $build_subclass->(
'lines', # Array ref of all lines until the next keyword
)};
# Consume all the lines up until the next directive and store in @$lines.
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
$self->SUPER::parse($pxs); # set file/line_no
my @lines;
# Consume lines until the next directive
while( @{$pxs->{line}}
&& $pxs->{line}[0] !~ /^$ExtUtils::ParseXS::BLOCK_regexp/o)
{
push @lines, shift @{$pxs->{line}};
}
$self->{lines} = \@lines;
1;
}
# No as_code() method - we rely on the sub-classes for that
# ======================================================================
package ExtUtils::ParseXS::Node::multiline_merged;
# Generic base class for keyword Nodes which can contain multiple lines.
# It's the same is is parent class, :Node::multiline, except that in
# addition, leading blank lines are skipped and the remainder concatenated
# into a single line, 'text'.
BEGIN { $build_subclass->(-parent => 'multiline',
'text', # Str: singe string containing all concatenated lines
)};
# Consume all the lines up until the next directive and store in
# @$lines, and in addition, concatenate and store in $text
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
$self->SUPER::parse($pxs); # set file/line_no, read lines
my @lines = @{$self->{lines}};
shift @lines while @lines && $lines[0] !~ /\S/;
# XXX ParseXS originally didn't include a trailing \n,
# so we carry on doing the same.
$self->{text} = join "\n", @lines;
lib/ExtUtils/ParseXS/Node.pm view on Meta::CPAN
# this hack specifically looks for: void XSUBs with a CODE block that
# appears to put stuff on the stack via 'ST(n)=' or 'XST_m()', and if
# so, emits 'XSRETURN(1)' rather than the 'XSRETURN_EMPTY' implied by
# the 'void' return type.
#
# So set a flag which indicates that a CODE block sets ST(0). This
# will be used later when deciding how/whether to emit EXTEND(n) and
# XSRETURN(n).
my $st0 =
$code =~ m{ ( \b ST \s* \( [^;]* = )
| ( \b XST_m\w+\s* \( ) }x;
$pxs->Warn("Warning: ST(0) isn't consistently set in every CASE's CODE block")
if defined $xsub->{CODE_sets_ST0}
&& $xsub->{CODE_sets_ST0} ne $st0;
$xsub->{CODE_sets_ST0} = $st0;
1;
}
# ======================================================================
package ExtUtils::ParseXS::Node::CLEANUP;
# Store the code lines associated with the CLEANUP: keyword
BEGIN { $build_subclass->(-parent => 'codeblock',
)};
# Currently all methods are just inherited.
# ======================================================================
package ExtUtils::ParseXS::Node::INIT;
# Store the code lines associated with the INIT: keyword
BEGIN { $build_subclass->(-parent => 'codeblock',
)};
# Currently all methods are just inherited.
# ======================================================================
package ExtUtils::ParseXS::Node::POSTCALL;
# Store the code lines associated with the POSTCALL: keyword
BEGIN { $build_subclass->(-parent => 'codeblock',
)};
# Currently all methods are just inherited.
# ======================================================================
package ExtUtils::ParseXS::Node::PPCODE;
# Store the code lines associated with the PPCODE keyword
BEGIN { $build_subclass->(-parent => 'codeblock',
)};
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
$self->SUPER::parse($pxs); # set file/line_no/lines
$xsub->{seen_PPCODE} = 1;
$pxs->death("Error: PPCODE must be the last thing") if @{$pxs->{line}};
1;
}
sub as_code {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
# Just emit the code block and then code to do PUTBACK and return.
# The # user of PPCODE is supposed to have done all the return stack
# manipulation themselves.
# Note that PPCODE blocks often include a XSRETURN(1) or
# similar, so any final code we emit after that is in danger of
# triggering a "statement is unreachable" warning.
$self->SUPER::as_code($pxs, $xsub, $xbody); # emit code block
print "\tLEAVE;\n" if $xsub->{SCOPE_enabled};
# Suppress "statement is unreachable" warning on HPUX
print "#if defined(__HP_cc) || defined(__HP_aCC)\n",
"#pragma diag_suppress 2111\n",
"#endif\n"
if $^O eq "hpux";
print "\tPUTBACK;\n\treturn;\n";
# Suppress "statement is unreachable" warning on HPUX
print "#if defined(__HP_cc) || defined(__HP_aCC)\n",
"#pragma diag_default 2111\n",
"#endif\n"
if $^O eq "hpux";
}
# ======================================================================
package ExtUtils::ParseXS::Node::PREINIT;
# Store the code lines associated with the PREINIT: keyword
BEGIN { $build_subclass->(-parent => 'codeblock',
)};
# Currently all methods are just inherited.
# ======================================================================
package ExtUtils::ParseXS::Node::keylines;
# Base class for keyword FOO nodes which have a FOO_line kid node for
# each line making up the keyword - such as OUTPUT etc.
BEGIN { $build_subclass->(
'lines', # Array ref of all lines until the next keyword
)};
# Process each line on and following the keyword line.
# For each line, create a FOO_line kid and call its parse() method.
sub parse {
my __PACKAGE__ $self = shift;
my ExtUtils::ParseXS $pxs = shift;
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
my ExtUtils::ParseXS::Node::xbody $xbody = shift;
my $do_notimplemented = shift;
$self->SUPER::parse($pxs); # set file/line_no
# Consume and process lines until the next directive.
( run in 0.533 second using v1.01-cache-2.11-cpan-5511b514fd6 )