File manager - Edit - /usr/local/cpanel/3rdparty/perl/542/cpanel-lib/x86_64-linux/B/C/File.pm
Back
package B::C::File; =head1 NAME B::C::File - Responsible for rendering the C file from a provided stash and locally tracked sections for use with perlcc =head1 SYNOPSIS # In B::C use B::C::File (); B::C::File::new(); # Singleton. ... B::C::File::write( 'file.c' ) # C File to generate. =head1 DESCRIPTION B<B::C::File> B::C::File is B::C's view. It uses Template Toolkit to render the C file using a passed in stash, combined with B::C::Section objects which it initializes and tree walkers update as they go. =cut use B::C::Std; use warnings; use Exporter (); use B::C::Debug qw/debug WARN INFO verbose/; use B::C::Helpers::Symtable qw(get_symtable_ref); use B::C::Helpers qw/gv_fetchpv_to_fetchpvn_flags/; use B::C::Section (); use B::C::Section::Meta (); use B::C::InitSection (); use B::C::Section::Assign (); use B::C::Hooks (); use B qw(cstring comppadlist); our @ISA = qw(Exporter); # singleton my $self; sub singleton ($self) { $self or die "Singleton not initialized"; return $self; } sub re_initialize { # only for unit tests purpose my $outfile = $self->{'c_file_name'}; $self = undef; return new($outfile); } # The objects in quotes do not have any special logic. sub code_section_names { return qw{cowpv const typedef decl init0 free sym hek lazyregex sharedhe sharedhestructs invlistarray}, struct_names(), op_sections(); } # These objects will end up in an array of structs in the template and be auto-declared. sub struct_names { return qw( malloc xpv xpvav xpvhv xpvcv padlist padname padnamelist magic xpviv xpvuv xpvnv xpvmg xpvlv xrv xpvbm xpvio xpvhv_with_aux sv gv gp xpvgv lexwarn refcounted_he xinvlist xsaccessor ), assign_sections(); } sub assign_sections { return qw{assign_bodyless_iv}; } # Each of these sections can generate multiple regular section sub meta_sections { return qw{meta_unopaux_item}; } # These populate the init sections and have a special header. sub init_section_names { return qw{ init0 init init_regexp init_xops init1 init2 init_stash init_vtables init_static_assignments init_bootstraplink init_COREbootstraplink init_xsaccessor }; } sub op_sections { return qw{ binop condop cop padop loop listop logop op pmop pmopaux pvop svop unop unopaux methop}; } BEGIN { our @EXPORT_OK = map { ( $_, "${_}sect" ) } code_section_names(); push @EXPORT_OK, init_section_names(); push @EXPORT_OK, meta_sections(); } sub new ( $class, $outfile = undef ) { $self and die "Singleton: should only be called once !"; debug( 'file' => "Write to c file: '" . ( $outfile // 'undef' ) . "'" ); $self = bless { 'c_file_name' => $outfile }; foreach my $section_name ( code_section_names() ) { $self->{$section_name} = B::C::Section->new( $section_name, get_symtable_ref(), 0 ); } foreach my $section_name ( assign_sections() ) { # overwrite the previous section $self->{$section_name} = B::C::Section::Assign->new( $section_name, get_symtable_ref(), 0 ); } foreach my $section_name ( init_section_names() ) { $self->{$section_name} = B::C::InitSection->CREATE( $section_name, get_symtable_ref(), 0 ); } # our meta sections foreach my $section_name ( meta_sections() ) { $self->{$section_name} = B::C::Section::Meta->new( $section_name, get_symtable_ref(), 0 ); } return $self; } sub get_sect ($section) { return $self->{$section}; } # Devel::NYTProf gives bad data when AUTOLOAD is in place. Just the same, we have no evidence that run times change when you replace it. # But in the interests of accurate data, you can replace the output of the below one liner and remove AUTOLOAD so you can get a useful # NYTProf report back. # perl -MB::C::File -E'foreach my $s ("", "sect") { foreach my $sect (B::C::File::code_section_names(), B::C::File::init_section_names()) {print "sub $sect$s { return \$self->{'\''$sect'\''} }\n"}; print "\n"}' sub DESTROY { } # Because we're doing autoload. our $AUTOLOAD; # Avoids warnings. sub AUTOLOAD { my $sect = $AUTOLOAD; $sect =~ s/.*:://; $sect =~ s/sect$//; # Strip sect off the call so we can just access the key. exists $self->{$sect} or die("Tried to call undefined subroutine '$sect'"); # do something there with the meta sections if ( ref $self->{$sect} eq 'B::C::Section::Meta' ) { return $self->{$sect}->get_section(@_); } return $self->{$sect}; } my $cfh; my %static_ext; sub replace_xs_bootstrap_to_init { # play with global sections to alter them before rendering my @structs = struct_names(); foreach my $section ( sort @structs ) { next if $section eq 'gp'; # or $section eq 'gv'; # gv are replaced when loading bootstrap (we do not want to replace them) #next unless $section eq 'magic'; my $field = $section eq 'magic' ? q{mg_obj} : q{sv_u.svu_rv}; # move to section ? my $bs_rows = $self->{$section}->get_bootstrapsub_rows(); # [ 42 => q{json::xs::encode}, ] foreach my $subname ( sort keys %$bs_rows ) { foreach my $ix ( @{ $bs_rows->{$subname} } ) { my $init = B::C::get_bootstrap_section($subname); # replace the cv to the one freshly loaded by XS $init->sadd( '%s_list[%d].%s = (SV*) GvCV( %s );', $section, $ix, $field, # uses gv_fetchpvn_flags instead of gv_fetchpv to save one strlen gv_fetchpv_to_fetchpvn_flags( $subname, 0, 'SVt_PVCV' ), ); } } } #foreach my $section ( sort ) { #$self->{init}->fixup_assignments; #} return; } sub hooks ($self) { return $self->{hooks} //= B::C::Hooks->new(); } sub write ( $c_file_stash, $template_name_short = undef ) { die unless $c_file_stash; $template_name_short ||= 'base.c.tt2'; $self->hooks->pre_write(); # can alter sections before setting c_file_stash # TODO: refactor move section group logic outside of the 'write' which is the main purpose of File # Controls the rendering order of the sections. $c_file_stash->{init_section_list} = [ init_section_names() ]; $c_file_stash->{section_list} = [ struct_names(), op_sections(), ]; # perl -e 'use Cpanel::Internals; BEGIN { B::C::setup_all_ops() }' # perl -e 'BEGIN { *B::C::SETUP_ALL_OPS = sub { 1 } }' $c_file_stash->{SETUP_ALL_OPS} = 0; if ( my $f = B::C->can('SETUP_ALL_OPS') ) { # define in Cpanel/Internals.pm $c_file_stash->{SETUP_ALL_OPS} = $f->() // 0; } # Prep COWPV strings B::C::Save::cowpv_setup(); #$c_file_stash->{SETUP_ALL_OPS} = 1; # testing... $c_file_stash->{op_section_list} = [ op_sections() ]; $c_file_stash->{meta_section_list} = [ meta_sections() ]; $self->{'sharedhestructs'}->sort(); # sort them for human readability foreach my $section ( code_section_names(), init_section_names() ) { $c_file_stash->{'section'}->{$section} = $self->{$section}; } # add the Meta sections to the section_list */ my @meta_sections; foreach my $section_name ( meta_sections() ) { my @list = $self->{$section_name}->get_all_sections(); next unless scalar @list; push @meta_sections, @list; } foreach my $section (@meta_sections) { push @{ $c_file_stash->{section_list} }, $section->name; $c_file_stash->{'section'}->{ $section->name } = $section; } replace_xs_bootstrap_to_init(); $self->{'verbose'} = $c_file_stash->{'verbose'}; # So verbose() will work. TODO: Remove me when all verbose() are gone. my $template_dir = $B::C::settings->{'template_dir'}; my $template_file = "$template_dir/$template_name_short"; -e $template_file or die("Can't find or read $template_file for generating B::C C code."); # problems. Ideally this code should be removed in favor of a better solution. # op/magic-27839.t sets SIG{WARN} in a begin block and then never releases it. eval q{local $SIG{__WARN__} = 'IGNORE'; require Config; require Exporter::Heavy; require Template}; $INC{'Template.pm'} or die("Can't load Template Toolkit at run time to render the C file."); { no warnings; *Template::DESTROY = sub { }; # disabled } # some useful options (see below for full list) my $config = { INCLUDE_PATH => $template_dir, INTERPOLATE => 0, # expand "$var" in plain text POST_CHOMP => 0, # Don't cleanup whitespace EVAL_PERL => 1, # evaluate Perl code blocks }; if ( verbose() ) { INFO $c_file_stash->{'compile_stats'}; INFO "NULLOP count: $c_file_stash->{nullop_count}"; } # Used to be buried in output_main_rest(); if ( verbose() ) { foreach my $stashname ( sort keys %static_ext ) { verbose("bootstrapping static $stashname added to xs_init"); } } # create Template object my $template = Template->new($config); open( my $fh, '>:utf8', $self->{'c_file_name'} ) or die; $self->hooks->pre_process( stash => $c_file_stash ); # process input template, substituting variables $template->process( $template_name_short, $c_file_stash, $fh ) or die $template->error(); { # clear Template::Provider, Template::Context, ... local $@; my $context = $template->context; if ( ref $context && ref $context->{LOAD_TEMPLATES} ) { foreach my $provider ( @{ $context->{LOAD_TEMPLATES} } ) { next unless ref $provider; $provider->DESTROY; } } $context->DESTROY if ref $context; $template->DESTROY; } close $fh; $self->hooks->post_process( c_file_name => $self->{'c_file_name'} ); return; } 1;
| ver. 1.4 |
Github
|
.
| PHP 8.1.34 | Generation time: 0.02 |
proxy
|
phpinfo
|
Settings