X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=bytecode.pl;h=cad64bc24fe7c2ac6ddd31b84b105238e818f03a;hb=4ccfbf6061307d91135312f945a81488f8437689;hp=68167e10508257258d4b193297fde1572087ad49;hpb=b97332e79eae50b3e7d901d7d7afe7197bed99ac;p=p5sagit%2Fp5-mst-13.2.git diff --git a/bytecode.pl b/bytecode.pl index 68167e1..cad64bc 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -4,8 +4,8 @@ BEGIN { } use strict; my %alias_to = ( - U32 => [qw(PADOFFSET STRLEN line_t)], - I32 => [qw(SSize_t long)], + U32 => [qw(line_t)], + PADOFFSET => [qw(STRLEN SSize_t)], U16 => [qw(OPCODE short)], U8 => [qw(char)], ); @@ -14,7 +14,8 @@ my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); # Nullsv *must* come first in the following so that the condition # ($$sv == 0) can continue to be used to test (sv == Nullsv). -my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE); +my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no + (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD); my (%alias_from, $from, $tos); while (($from, $tos) = each %alias_to) { @@ -22,7 +23,8 @@ while (($from, $tos) = each %alias_to) { } my $c_header = <<'EOT'; -/* +/* -*- buffer-read-only: t -*- + * * Copyright (c) 1996-1999 Malcolm Beattie * * You may distribute under the terms of either the GNU General Public @@ -43,10 +45,11 @@ safer_unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/As # Start with boilerplate for Asmdata.pm # open(ASMDATA_PM, ">ext/B/B/Asmdata.pm") or die "ext/B/B/Asmdata.pm: $!"; +binmode ASMDATA_PM; print ASMDATA_PM $perl_header, <<'EOT'; package B::Asmdata; -our $VERSION = '1.00'; +our $VERSION = '1.01'; use Exporter; @ISA = qw(Exporter); @@ -67,6 +70,7 @@ EOT # Boilerplate for byterun.c # open(BYTERUN_C, ">ext/ByteLoader/byterun.c") or die "ext/ByteLoader/byterun.c: $!"; +binmode BYTERUN_C; print BYTERUN_C $c_header, <<'EOT'; #define PERL_NO_GET_CONTEXT @@ -86,7 +90,10 @@ for ($i = 0; $i < @optype - 1; $i++) { printf BYTERUN_C " sizeof(%s),\n", $optype[$i], $i; } printf BYTERUN_C " sizeof(%s)\n", $optype[$i], $i; -print BYTERUN_C <<'EOT'; + +my $size = @specialsv; + +print BYTERUN_C <<"EOT"; }; void * @@ -103,12 +110,13 @@ bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix) int byterun(pTHX_ register struct byteloader_state *bstate) { + dVAR; register int insn; U32 ix; - SV *specialsv_list[6]; + SV *specialsv_list[$size]; BYTECODE_HEADER_CHECK; /* croak if incorrect platform */ - New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */ + Newx(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; @@ -192,12 +200,15 @@ print BYTERUN_C <<'EOT'; } return 0; } + +/* ex: set ro: */ EOT # # Write the instruction and optype enum constants into byterun.h # open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!"; +binmode BYTERUN_H; print BYTERUN_H $c_header, <<'EOT'; struct byteloader_fdata { SV *datasv; @@ -205,13 +216,18 @@ struct byteloader_fdata { int idx; }; +struct byteloader_pv_state { + char *pvx; + XPV xpv; +}; + 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; + struct byteloader_pv_state bs_pv; int bs_iv_overflows; }; @@ -247,6 +263,8 @@ for ($i = 0; $i < @optype - 1; $i++) { } printf BYTERUN_H " OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i; +print BYTERUN_H "/* ex: set ro: */\n"; + # # Finish off insn_data and create array initialisers in Asmdata.pm # @@ -311,7 +329,7 @@ A simple mapping of the op type number to its type (like 'COP' or 'BINOP'). 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. +B::SPECIAL and are referred 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'). @@ -322,6 +340,8 @@ or '&PL_sv_undef'). Malcolm Beattie, C =cut + +# ex: set ro: EOT @@ -350,7 +370,7 @@ ldsv bstate->bs_sv svindex ldop PL_op opindex stsv bstate->bs_sv U32 s stop PL_op U32 s -stpv bstate->bs_pv.xpv_pv U32 x +stpv bstate->bs_pv.pvx U32 x ldspecsv bstate->bs_sv U8 x ldspecsvx bstate->bs_sv U8 x newsv bstate->bs_sv U8 x @@ -359,18 +379,18 @@ newop PL_op U8 x newopx PL_op U16 x newopn PL_op U8 x newpv none PV -pv_cur bstate->bs_pv.xpv_cur STRLEN -pv_free bstate->bs_pv none x +pv_cur bstate->bs_pv.xpv.xpv_cur STRLEN +pv_free bstate->bs_pv.pvx 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 +xrv bstate->bs_sv svindex x 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 +xpv_cur bstate->bs_sv STRLEN x +xpv_len bstate->bs_sv STRLEN x +xiv bstate->bs_sv IV x +xnv bstate->bs_sv NV x xlv_targoff LvTARGOFF(bstate->bs_sv) STRLEN xlv_targlen LvTARGLEN(bstate->bs_sv) STRLEN xlv_targ LvTARG(bstate->bs_sv) svindex @@ -408,10 +428,8 @@ 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 +xhv_name bstate->bs_sv pvindex x hv_store bstate->bs_sv svindex x sv_magic bstate->bs_sv char x mg_obj SvMAGIC(bstate->bs_sv)->mg_obj svindex @@ -419,7 +437,7 @@ 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 +xmg_stash bstate->bs_sv svindex x gv_fetchpv bstate->bs_sv strconst x gv_fetchpvx bstate->bs_sv strconst x gv_stashpv bstate->bs_sv strconst x @@ -430,7 +448,7 @@ 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_file bstate->bs_sv pvindex x gp_io *(SV**)&GvIOp(bstate->bs_sv) svindex gp_form *(SV**)&GvFORM(bstate->bs_sv) svindex gp_cvgen GvCVGEN(bstate->bs_sv) U32 @@ -442,7 +460,8 @@ op_sibling PL_op->op_sibling opindex op_ppaddr PL_op->op_ppaddr strconst x op_targ PL_op->op_targ PADOFFSET op_type PL_op OPCODE x -op_seq PL_op->op_seq U16 +op_opt PL_op->op_opt U8 +op_static PL_op->op_static U8 op_flags PL_op->op_flags U8 op_private PL_op->op_private U8 op_first cUNOP->op_first opindex @@ -452,7 +471,7 @@ op_pmreplroot cPMOP->op_pmreplroot opindex op_pmreplstart cPMOP->op_pmreplstart opindex op_pmnext *(OP**)&cPMOP->op_pmnext opindex #ifdef USE_ITHREADS -op_pmstashpv cPMOP->op_pmstashpv pvindex +op_pmstashpv cPMOP pvindex x op_pmreplrootpo cPMOP->op_pmreplroot OP*/PADOFFSET #else op_pmstash *(SV**)&cPMOP->op_pmstash svindex @@ -478,10 +497,9 @@ cop_stash cCOP svindex x cop_filegv cCOP svindex x #endif cop_seq cCOP->cop_seq U32 -cop_arybase cCOP->cop_arybase I32 +cop_arybase cCOP I32 x cop_line cCOP->cop_line line_t -cop_io cCOP->cop_io svindex -cop_warnings cCOP->cop_warnings svindex +cop_warnings cCOP svindex x main_start PL_main_start opindex main_root PL_main_root opindex main_cv *(SV**)&PL_main_cv svindex