X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e8fcef166ae70cf67e42f1eda262b271a3daca03..f120105df5a639f1ff2bfd3294f7ac263449621f:/bytecode.pl diff --git a/bytecode.pl b/bytecode.pl index f847298..c3c3dc7 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -1,12 +1,13 @@ BEGIN { push @INC, './lib'; + require 'regen_lib.pl'; } use strict; my %alias_to = ( - U32 => [qw(PADOFFSET STRLEN)], - I32 => [qw(SSize_t long)], - U16 => [qw(OPCODE line_t short)], - U8 => [qw(char)], + U32 => [qw(line_t)], + PADOFFSET => [qw(STRLEN SSize_t)], + U16 => [qw(OPCODE short)], + U8 => [qw(char)], ); my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); @@ -36,7 +37,7 @@ EOT my $perl_header; ($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g; -unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/Asmdata.pm"; +safer_unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/Asmdata.pm"; # # Start with boilerplate for Asmdata.pm @@ -44,6 +45,9 @@ unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/Asmdata. open(ASMDATA_PM, ">ext/B/B/Asmdata.pm") or die "ext/B/B/Asmdata.pm: $!"; print ASMDATA_PM $perl_header, <<'EOT'; package B::Asmdata; + +our $VERSION = '1.01'; + use Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name); @@ -71,13 +75,6 @@ print BYTERUN_C $c_header, <<'EOT'; #define NO_XSLOCKS #include "XSUB.h" -#ifdef PERL_OBJECT -#undef CALL_FPTR -#define CALL_FPTR(fptr) (pPerl->*fptr) -#undef PL_ppaddr -#define PL_ppaddr (*get_ppaddr()) -#endif - #include "byterun.h" #include "bytecode.h" @@ -92,42 +89,33 @@ printf BYTERUN_C " sizeof(%s)\n", $optype[$i], $i; print BYTERUN_C <<'EOT'; }; -static int bytecode_iv_overflows = 0; -static void **bytecode_obj_list = Null(void**); -static I32 bytecode_obj_list_fill = -1; - void * -bset_obj_store(pTHXo_ void *obj, I32 ix) +bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix) { - if (ix > bytecode_obj_list_fill) { - if (bytecode_obj_list_fill == -1) - New(666, bytecode_obj_list, ix + 32, void*); - else - Renew(bytecode_obj_list, ix + 32, void*); - bytecode_obj_list_fill = ix; + if (ix > bstate->bs_obj_list_fill) { + Renew(bstate->bs_obj_list, ix + 32, void*); + bstate->bs_obj_list_fill = ix + 31; } - bytecode_obj_list[ix] = obj; + bstate->bs_obj_list[ix] = obj; return obj; } -void -byterun(pTHXo) +int +byterun(pTHX_ register struct byteloader_state *bstate) { - dTHR; - int insn; - SV *bytecode_sv; - XPV bytecode_pv; + register int insn; + U32 ix; SV *specialsv_list[6]; - ENTER; - SAVEVPTR(bytecode_obj_list); - SAVEI32(bytecode_obj_list_fill); - bytecode_obj_list = Null(void**); - bytecode_obj_list_fill = -1; BYTECODE_HEADER_CHECK; /* croak if incorrect platform */ + New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */ + bstate->bs_obj_list_fill = 31; + bstate->bs_obj_list[0] = NULL; /* first is always Null */ + bstate->bs_ix = 1; + EOT -for (my $i = 0; $i < @specialsv; $i++) { +for my $i ( 0 .. $#specialsv ) { print BYTERUN_C " specialsv_list[$i] = $specialsv[$i];\n"; } @@ -141,8 +129,11 @@ EOT my (@insn_name, $insn_num, $insn, $lvalue, $argtype, $flags, $fundtype); while () { + if (/^\s*#/) { + print BYTERUN_C if /^\s*#\s*(?:if|endif|el)/; + next; + } chop; - s/#.*//; # remove comments next unless length; if (/^%number\s+(.*)/) { $insn_num = $1; @@ -152,6 +143,10 @@ while () { next; } ($insn, $lvalue, $argtype, $flags) = split; + my $rvalcast = ''; + if ($argtype =~ m:(.+)/(.+):) { + ($rvalcast, $argtype) = ("($1)", $2); + } $insn_name[$insn_num] = $insn; $fundtype = $alias_from{$argtype} || $argtype; @@ -171,7 +166,7 @@ while () { print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n"; } elsif ($optarg && $lvalue ne "none") { - print BYTERUN_C "\t\t$lvalue = arg;\n"; + print BYTERUN_C "\t\t$lvalue = ${rvalcast}arg;\n"; } print BYTERUN_C "\t\tbreak;\n\t }\n"; @@ -195,6 +190,7 @@ print BYTERUN_C <<'EOT'; /* NOTREACHED */ } } + return 0; } EOT @@ -203,19 +199,32 @@ EOT # open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!"; print BYTERUN_H $c_header, <<'EOT'; -struct bytestream { /* XXX: not currently used - too slow */ - void *data; - int (*pfgetc)(void *); - int (*pfread)(char *, size_t, size_t, void *); - void (*pfreadpv)(U32, void *, XPV *); +struct byteloader_fdata { + SV *datasv; + int next_out; + int idx; +}; + +struct byteloader_state { + struct byteloader_fdata *bs_fdata; + SV *bs_sv; + void **bs_obj_list; + int bs_obj_list_fill; + int bs_ix; + XPV bs_pv; + int bs_iv_overflows; }; +int bl_getc(struct byteloader_fdata *); +int bl_read(struct byteloader_fdata *, char *, size_t, size_t); +extern int byterun(pTHX_ struct byteloader_state *); + enum { EOT my $add_enum_value = 0; my $max_insn; -for ($i = 0; $i < @insn_name; $i++) { +for $i ( 0 .. $#insn_name ) { $insn = uc($insn_name[$i]); if (defined($insn)) { $max_insn = $i; @@ -238,10 +247,6 @@ for ($i = 0; $i < @optype - 1; $i++) { } printf BYTERUN_H " OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i; -print BYTERUN_H <<'EOT'; -extern void byterun(pTHXo); -EOT - # # Finish off insn_data and create array initialisers in Asmdata.pm # @@ -264,11 +269,53 @@ B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode =head1 SYNOPSIS - use Asmdata; + use B::Asmdata qw(%insn_data @insn_name @optype @specialsv_name); =head1 DESCRIPTION -See F. +Provides information about Perl ops in order to generate bytecode via +a bunch of exported variables. Its mostly used by B::Assembler and +B::Disassembler. + +=over 4 + +=item %insn_data + + my($bytecode_num, $put_sub, $get_meth) = @$insn_data{$op_name}; + +For a given $op_name (for example, 'cop_label', 'sv_flags', etc...) +you get an array ref containing the bytecode number of the op, a +reference to the subroutine used to 'PUT', and the name of the method +used to 'GET'. + +=for _private +Add more detail about what $put_sub and $get_meth are and how to use them. + +=item @insn_name + + my $op_name = $insn_name[$bytecode_num]; + +A simple mapping of the bytecode number to the name of the op. +Suitable for using with %insn_data like so: + + my $op_info = $insn_data{$insn_name[$bytecode_num]}; + +=item @optype + + my $op_type = $optype[$op_type_num]; + +A simple mapping of the op type number to its type (like 'COP' or 'BINOP'). + +=item @specialsv_name + + my $sv_name = $specialsv_name[$sv_index]; + +Certain SV types are considered 'special'. They're represented by +B::SPECIAL and are refered to by a number from the specialsv_list. +This array maps that number back to the name of the SV (like 'Nullsv' +or '&PL_sv_undef'). + +=back =head1 AUTHOR @@ -277,6 +324,11 @@ Malcolm Beattie, C =cut EOT + +close ASMDATA_PM or die "Error closing ASMDATA_PM: $!"; +close BYTERUN_H or die "Error closing BYTERUN_H: $!"; +close BYTERUN_C or die "Error closing BYTERUN_C: $!"; + __END__ # First set instruction ord("#") to read comment to end-of-line (sneaky) %number 35 @@ -284,92 +336,107 @@ comment arg comment_t # Then make ord("\n") into a no-op %number 10 nop none none + # Now for the rest of the ordinary ones, beginning with \0 which is # ret so that \0-terminated strings can be read properly as bytecode. %number 0 # +# The argtype is either a single type or "rightvaluecast/argtype". +# #opcode lvalue argtype flags # ret none none x -ldsv bytecode_sv svindex +ldsv bstate->bs_sv svindex ldop PL_op opindex -stsv bytecode_sv U32 s +stsv bstate->bs_sv U32 s stop PL_op U32 s -ldspecsv bytecode_sv U8 x -newsv bytecode_sv U8 x +stpv bstate->bs_pv.xpv_pv U32 x +ldspecsv bstate->bs_sv U8 x +ldspecsvx bstate->bs_sv U8 x +newsv bstate->bs_sv U8 x +newsvx bstate->bs_sv U32 x newop PL_op U8 x +newopx PL_op U16 x newopn PL_op U8 x newpv none PV -pv_cur bytecode_pv.xpv_cur STRLEN -pv_free bytecode_pv none x -sv_upgrade bytecode_sv char x -sv_refcnt SvREFCNT(bytecode_sv) U32 -sv_refcnt_add SvREFCNT(bytecode_sv) I32 x -sv_flags SvFLAGS(bytecode_sv) U32 -xrv SvRV(bytecode_sv) svindex -xpv bytecode_sv none x -xiv32 SvIVX(bytecode_sv) I32 -xiv64 SvIVX(bytecode_sv) IV64 -xnv SvNVX(bytecode_sv) NV -xlv_targoff LvTARGOFF(bytecode_sv) STRLEN -xlv_targlen LvTARGLEN(bytecode_sv) STRLEN -xlv_targ LvTARG(bytecode_sv) svindex -xlv_type LvTYPE(bytecode_sv) char -xbm_useful BmUSEFUL(bytecode_sv) I32 -xbm_previous BmPREVIOUS(bytecode_sv) U16 -xbm_rare BmRARE(bytecode_sv) U8 -xfm_lines FmLINES(bytecode_sv) I32 -xio_lines IoLINES(bytecode_sv) long -xio_page IoPAGE(bytecode_sv) long -xio_page_len IoPAGE_LEN(bytecode_sv) long -xio_lines_left IoLINES_LEFT(bytecode_sv) long -xio_top_name IoTOP_NAME(bytecode_sv) pvcontents -xio_top_gv *(SV**)&IoTOP_GV(bytecode_sv) svindex -xio_fmt_name IoFMT_NAME(bytecode_sv) pvcontents -xio_fmt_gv *(SV**)&IoFMT_GV(bytecode_sv) svindex -xio_bottom_name IoBOTTOM_NAME(bytecode_sv) pvcontents -xio_bottom_gv *(SV**)&IoBOTTOM_GV(bytecode_sv) svindex -xio_subprocess IoSUBPROCESS(bytecode_sv) short -xio_type IoTYPE(bytecode_sv) char -xio_flags IoFLAGS(bytecode_sv) char -xcv_stash *(SV**)&CvSTASH(bytecode_sv) svindex -xcv_start CvSTART(bytecode_sv) opindex -xcv_root CvROOT(bytecode_sv) opindex -xcv_gv *(SV**)&CvGV(bytecode_sv) svindex -xcv_file CvFILE(bytecode_sv) pvcontents -xcv_depth CvDEPTH(bytecode_sv) long -xcv_padlist *(SV**)&CvPADLIST(bytecode_sv) svindex -xcv_outside *(SV**)&CvOUTSIDE(bytecode_sv) svindex -xcv_flags CvFLAGS(bytecode_sv) U16 -av_extend bytecode_sv SSize_t x -av_push bytecode_sv svindex x -xav_fill AvFILLp(bytecode_sv) SSize_t -xav_max AvMAX(bytecode_sv) SSize_t -xav_flags AvFLAGS(bytecode_sv) U8 -xhv_riter HvRITER(bytecode_sv) I32 -xhv_name HvNAME(bytecode_sv) pvcontents -hv_store bytecode_sv svindex x -sv_magic bytecode_sv char x -mg_obj SvMAGIC(bytecode_sv)->mg_obj svindex -mg_private SvMAGIC(bytecode_sv)->mg_private U16 -mg_flags SvMAGIC(bytecode_sv)->mg_flags U8 -mg_pv SvMAGIC(bytecode_sv) pvcontents x -xmg_stash *(SV**)&SvSTASH(bytecode_sv) svindex -gv_fetchpv bytecode_sv strconst x -gv_stashpv bytecode_sv strconst x -gp_sv GvSV(bytecode_sv) svindex -gp_refcnt GvREFCNT(bytecode_sv) U32 -gp_refcnt_add GvREFCNT(bytecode_sv) I32 x -gp_av *(SV**)&GvAV(bytecode_sv) svindex -gp_hv *(SV**)&GvHV(bytecode_sv) svindex -gp_cv *(SV**)&GvCV(bytecode_sv) svindex -gp_file GvFILE(bytecode_sv) pvcontents -gp_io *(SV**)&GvIOp(bytecode_sv) svindex -gp_form *(SV**)&GvFORM(bytecode_sv) svindex -gp_cvgen GvCVGEN(bytecode_sv) U32 -gp_line GvLINE(bytecode_sv) line_t -gp_share bytecode_sv svindex x -xgv_flags GvFLAGS(bytecode_sv) U8 +pv_cur bstate->bs_pv.xpv_cur STRLEN +pv_free bstate->bs_pv none x +sv_upgrade bstate->bs_sv U8 x +sv_refcnt SvREFCNT(bstate->bs_sv) U32 +sv_refcnt_add SvREFCNT(bstate->bs_sv) I32 x +sv_flags SvFLAGS(bstate->bs_sv) U32 +xrv SvRV(bstate->bs_sv) svindex +xpv bstate->bs_sv none x +xpv_cur SvCUR(bstate->bs_sv) STRLEN +xpv_len SvLEN(bstate->bs_sv) STRLEN +xiv SvIVX(bstate->bs_sv) IV +xnv SvNVX(bstate->bs_sv) NV +xlv_targoff LvTARGOFF(bstate->bs_sv) STRLEN +xlv_targlen LvTARGLEN(bstate->bs_sv) STRLEN +xlv_targ LvTARG(bstate->bs_sv) svindex +xlv_type LvTYPE(bstate->bs_sv) char +xbm_useful BmUSEFUL(bstate->bs_sv) I32 +xbm_previous BmPREVIOUS(bstate->bs_sv) U16 +xbm_rare BmRARE(bstate->bs_sv) U8 +xfm_lines FmLINES(bstate->bs_sv) IV +xio_lines IoLINES(bstate->bs_sv) IV +xio_page IoPAGE(bstate->bs_sv) IV +xio_page_len IoPAGE_LEN(bstate->bs_sv) IV +xio_lines_left IoLINES_LEFT(bstate->bs_sv) IV +xio_top_name IoTOP_NAME(bstate->bs_sv) pvindex +xio_top_gv *(SV**)&IoTOP_GV(bstate->bs_sv) svindex +xio_fmt_name IoFMT_NAME(bstate->bs_sv) pvindex +xio_fmt_gv *(SV**)&IoFMT_GV(bstate->bs_sv) svindex +xio_bottom_name IoBOTTOM_NAME(bstate->bs_sv) pvindex +xio_bottom_gv *(SV**)&IoBOTTOM_GV(bstate->bs_sv) svindex +xio_subprocess IoSUBPROCESS(bstate->bs_sv) short +xio_type IoTYPE(bstate->bs_sv) char +xio_flags IoFLAGS(bstate->bs_sv) char +xcv_xsubany *(SV**)&CvXSUBANY(bstate->bs_sv).any_ptr svindex +xcv_stash *(SV**)&CvSTASH(bstate->bs_sv) svindex +xcv_start CvSTART(bstate->bs_sv) opindex +xcv_root CvROOT(bstate->bs_sv) opindex +xcv_gv *(SV**)&CvGV(bstate->bs_sv) svindex +xcv_file CvFILE(bstate->bs_sv) pvindex +xcv_depth CvDEPTH(bstate->bs_sv) long +xcv_padlist *(SV**)&CvPADLIST(bstate->bs_sv) svindex +xcv_outside *(SV**)&CvOUTSIDE(bstate->bs_sv) svindex +xcv_outside_seq CvOUTSIDE_SEQ(bstate->bs_sv) U32 +xcv_flags CvFLAGS(bstate->bs_sv) U16 +av_extend bstate->bs_sv SSize_t x +av_pushx bstate->bs_sv svindex x +av_push bstate->bs_sv svindex x +xav_fill AvFILLp(bstate->bs_sv) SSize_t +xav_max AvMAX(bstate->bs_sv) SSize_t +xav_flags AvFLAGS(bstate->bs_sv) U8 +xhv_riter HvRITER(bstate->bs_sv) I32 +xhv_name HvNAME(bstate->bs_sv) pvindex +xhv_pmroot *(OP**)&HvPMROOT(bstate->bs_sv) opindex +hv_store bstate->bs_sv svindex x +sv_magic bstate->bs_sv char x +mg_obj SvMAGIC(bstate->bs_sv)->mg_obj svindex +mg_private SvMAGIC(bstate->bs_sv)->mg_private U16 +mg_flags SvMAGIC(bstate->bs_sv)->mg_flags U8 +mg_name SvMAGIC(bstate->bs_sv) pvcontents x +mg_namex SvMAGIC(bstate->bs_sv) svindex x +xmg_stash *(SV**)&SvSTASH(bstate->bs_sv) svindex +gv_fetchpv bstate->bs_sv strconst x +gv_fetchpvx bstate->bs_sv strconst x +gv_stashpv bstate->bs_sv strconst x +gv_stashpvx bstate->bs_sv strconst x +gp_sv GvSV(bstate->bs_sv) svindex +gp_refcnt GvREFCNT(bstate->bs_sv) U32 +gp_refcnt_add GvREFCNT(bstate->bs_sv) I32 x +gp_av *(SV**)&GvAV(bstate->bs_sv) svindex +gp_hv *(SV**)&GvHV(bstate->bs_sv) svindex +gp_cv *(SV**)&GvCV(bstate->bs_sv) svindex +gp_file GvFILE(bstate->bs_sv) pvindex +gp_io *(SV**)&GvIOp(bstate->bs_sv) svindex +gp_form *(SV**)&GvFORM(bstate->bs_sv) svindex +gp_cvgen GvCVGEN(bstate->bs_sv) U32 +gp_line GvLINE(bstate->bs_sv) line_t +gp_share bstate->bs_sv svindex x +xgv_flags GvFLAGS(bstate->bs_sv) U8 op_next PL_op->op_next opindex op_sibling PL_op->op_sibling opindex op_ppaddr PL_op->op_ppaddr strconst x @@ -381,14 +448,20 @@ op_private PL_op->op_private U8 op_first cUNOP->op_first opindex op_last cBINOP->op_last opindex op_other cLOGOP->op_other opindex -op_children cLISTOP->op_children U32 op_pmreplroot cPMOP->op_pmreplroot opindex -op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot svindex op_pmreplstart cPMOP->op_pmreplstart opindex op_pmnext *(OP**)&cPMOP->op_pmnext opindex +#ifdef USE_ITHREADS +op_pmstashpv cPMOP pvindex x +op_pmreplrootpo cPMOP->op_pmreplroot OP*/PADOFFSET +#else +op_pmstash *(SV**)&cPMOP->op_pmstash svindex +op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot svindex +#endif pregcomp PL_op pvcontents x op_pmflags cPMOP->op_pmflags U16 op_pmpermflags cPMOP->op_pmpermflags U16 +op_pmdynflags cPMOP->op_pmdynflags U8 op_sv cSVOP->op_sv svindex op_padix cPADOP->op_padix PADOFFSET op_pv cPVOP->op_pv pvcontents @@ -396,16 +469,37 @@ op_pv_tr cPVOP->op_pv op_tr_array op_redoop cLOOP->op_redoop opindex op_nextop cLOOP->op_nextop opindex op_lastop cLOOP->op_lastop opindex -cop_label cCOP->cop_label pvcontents -cop_stashpv cCOP pvcontents x -cop_file cCOP pvcontents x +cop_label cCOP->cop_label pvindex +#ifdef USE_ITHREADS +cop_stashpv cCOP pvindex x +cop_file cCOP pvindex x +#else +cop_stash cCOP svindex x +cop_filegv cCOP svindex x +#endif cop_seq cCOP->cop_seq U32 cop_arybase cCOP->cop_arybase I32 -cop_line cCOP line_t x +cop_line cCOP->cop_line line_t +cop_io cCOP->cop_io svindex cop_warnings cCOP->cop_warnings svindex main_start PL_main_start opindex main_root PL_main_root opindex +main_cv *(SV**)&PL_main_cv svindex curpad PL_curpad svindex x push_begin PL_beginav svindex x push_init PL_initav svindex x push_end PL_endav svindex x +curstash *(SV**)&PL_curstash svindex +defstash *(SV**)&PL_defstash svindex +data none U8 x +incav *(SV**)&GvAV(PL_incgv) svindex +load_glob none svindex x +#ifdef USE_ITHREADS +regex_padav *(SV**)&PL_regex_padav svindex +#endif +dowarn PL_dowarn U8 +comppad_name *(SV**)&PL_comppad_name svindex +xgv_stash *(SV**)&GvSTASH(bstate->bs_sv) svindex +signal bstate->bs_sv strconst x +# to be removed +formfeed PL_formfeed svindex