1# -*- cperl-indent-level:4 -*- 2BEGIN { 3 push @INC, '.', 'lib'; 4 push @INC, '../../lib', '../../regen' if $ENV{PERL_CORE}; 5 require 'regen_lib.pl'; 6} 7use strict; 8use Config; 9my $CPERL = $Config{usecperl}; 10my $DEBUGGING = $Config{ccflags} =~ /-DDEBUGGING/; 11my %alias_to = ( 12 U32 => [qw(line_t)], 13 PADOFFSET => [qw(STRLEN SSize_t)], 14 U16 => [qw(OPCODE short)], 15 U8 => [qw(char)], 16 ); 17%alias_to = ( 18 U32 => [qw(PADOFFSET STRLEN)], 19 I32 => [qw(SSize_t long)], 20 U16 => [qw(OPCODE line_t short)], 21 U8 => [qw(char)], 22 ) if $] < 5.008001; 23 24my (%alias_from, $from, $tos); 25while (($from, $tos) = each %alias_to) { 26 map { $alias_from{$_} = $from } @$tos; 27} 28my (@optype, @specialsv_name); 29# @optype was in B::Asmdata, and is since 5.10 in B. 30# With cperl in CORE we are back to our bootstrapping problem 31# so define it twice. 32if ($CPERL and $ENV{PERL_CORE}) { 33 @optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP 34 METHOP UNOP_AUX); 35 @specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no 36 (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD); 37} elsif ($] < 5.009) { 38 require B::Asmdata; 39 @optype = @{*B::Asmdata::optype{ARRAY}}; 40 @specialsv_name = @{*B::Asmdata::specialsv_name{ARRAY}}; 41} else { 42 require B; 43 @optype = @{*B::optype{ARRAY}}; 44 @specialsv_name = @{*B::specialsv_name{ARRAY}}; 45} 46 47 48my $perlversion = sprintf("%1.6f%s", $], ($Config{useithreads} ? '' : '-nt')); 49my $perl = $CPERL ? 'cperl' : 'Perl'; 50my $c_header = <<"EOT"; 51/* -*- buffer-read-only: t -*- 52 * 53 * Copyright (c) 1996-1999 Malcolm Beattie 54 * Copyright (c) 2008,2009,2010,2011,2012 Reini Urban 55 * Copyright (c) 2011-2016 cPanel Inc 56 * 57 * You may distribute under the terms of either the GNU General Public 58 * License or the Artistic License, as specified in the README file. 59 * 60 */ 61/* 62 * This file is autogenerated from bytecode.pl. Changes made here will be lost. 63 * It is specific for $perl $perlversion only. 64 */ 65EOT 66 67my $perl_header; 68($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g; 69my @targets = ("lib/B/Asmdata.pm", "ByteLoader/byterun.c", "ByteLoader/byterun.h"); 70 71safer_unlink @targets; 72 73# 74# Start with boilerplate for Asmdata.pm 75# 76open(ASMDATA_PM, "> $targets[0]") or die "$targets[0]: $!"; 77binmode ASMDATA_PM; 78print ASMDATA_PM $perl_header, <<'EOT'; 79package B::Asmdata; 80 81our $VERSION = '1.04'; 82 83use Exporter; 84@ISA = qw(Exporter); 85@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name); 86EOT 87 88if ($ENV{PERL_CORE} && $CPERL) { 89 print ASMDATA_PM 'our(%insn_data, @insn_name, @optype, @specialsv_name); 90 91@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP 92 METHOP UNOP_AUX); 93# Nullsv *must* come first in the following so that the condition 94# ($$sv == 0) can continue to be used to test (sv == Nullsv). 95@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no 96 (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD); 97'; 98} elsif ($] > 5.009 && !$CPERL) { 99 print ASMDATA_PM 'our(%insn_data, @insn_name); 100 101use B qw(@optype @specialsv_name); 102'; 103} elsif ($] > 5.008) { 104 print ASMDATA_PM 'our(%insn_data, @insn_name, @optype, @specialsv_name); 105 106@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); 107@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE); 108'; 109} else { 110 print ASMDATA_PM 'my(%insn_data, @insn_name, @optype, @specialsv_name); 111 112@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); 113@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE); 114'; 115} 116 117print ASMDATA_PM <<"EOT"; 118 119# XXX insn_data is initialised this way because with a large 120# %insn_data = (foo => [...], bar => [...], ...) initialiser 121# I get a hard-to-track-down stack underflow and segfault. 122EOT 123 124# 125# Boilerplate for byterun.c 126# 127open(BYTERUN_C, "> $targets[1]") or die "$targets[1]: $!"; 128binmode BYTERUN_C; 129print BYTERUN_C $c_header, <<'EOT'; 130 131#define PERL_NO_GET_CONTEXT 132#include "EXTERN.h" 133#include "perl.h" 134#define NO_XSLOCKS 135#include "XSUB.h" 136#if PERL_VERSION < 8 137 #define NEED_sv_2pv_flags 138 #include "ppport.h" 139#endif 140 141/* Change 31252: move PL_tokenbuf into the PL_parser struct */ 142#if (PERL_VERSION > 8) && (!defined(PL_tokenbuf)) 143 #define PL_tokenbuf (PL_parser->tokenbuf) 144#endif 145#if (PERL_VERSION < 8) && (!defined(DEBUG_v)) 146 #define DEBUG_v(a) DEBUG_f(a) 147#endif 148 149#include "byterun.h" 150#include "bytecode.h" 151 152struct byteloader_header bl_header; 153 154#if 0 155static const int optype_size[] = { 156EOT 157my $i = 0; 158for ($i = 0; $i < @optype - 1; $i++) { 159 printf BYTERUN_C " sizeof(%s),\n", $optype[$i], $i; 160} 161printf BYTERUN_C " sizeof(%s)\n", $optype[$i], $i; 162print BYTERUN_C <<'EOT'; 163}; 164#endif 165 166void * 167bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix) 168{ 169 if (ix > bstate->bs_obj_list_fill) { 170 Renew(bstate->bs_obj_list, ix + 32, void*); 171 bstate->bs_obj_list_fill = ix + 31; 172 } 173 bstate->bs_obj_list[ix] = obj; 174 return obj; 175} 176 177int bytecode_header_check(pTHX_ struct byteloader_state *bstate, U32 *isjit) { 178 U32 sz = 0; 179 strconst str; 180 181 BGET_U32(sz); /* Magic: 'PLBC' or 'PLJC' */ 182 if (sz != 0x43424c50) { 183 if (sz != 0x434a4c50) { 184 HEADER_FAIL1("bad magic (want 0x43424c50 PLBC or 0x434a4c50 PLJC, got %#x)", 185 (int)sz); 186 } else { 187 *isjit = 1; 188 } 189 } 190 BGET_strconst(str,80); /* archname */ 191 my_strlcpy(bl_header.archname, str, 80); 192 /* just warn. relaxed strictness, only check for ithread in archflag */ 193 if (strNEc(str, ARCHNAME)) { 194 HEADER_WARN2("Different architecture %s, you have %s", str, ARCHNAME); 195 } 196 197 /* ByteLoader version strategy: Strict for 0.06_ development releases and 0.03-0.04. 198 0.07 should be able to load 0.5 (5.8.1 CORE) */ 199 BGET_strconst(str,16); 200 my_strlcpy(bl_header.version, str, 16); 201 if (strNEc(str, VERSION)) { 202 if ((strGT(str, "0.06") && strLT(str, "0.06_06")) /*|| strLT(str, "0.05")*/) { 203 HEADER_FAIL2("Incompatible bytecode version %s, you have %s", 204 str, VERSION); 205 } 206 } 207 208 BGET_U32(sz); /* ivsize */ 209 bl_header.ivsize = sz; 210 211 BGET_U32(sz); /* ptrsize */ 212 bl_header.ptrsize = sz; 213 214 /* new since 0.06_03 */ 215 if (strGE(bl_header.version, "0.06_03")) { 216 BGET_U32(sz); /* longsize */ 217 bl_header.longsize = sz; 218 } else { 219 bl_header.longsize = LONGSIZE; 220 } 221 222 if (strGT(bl_header.version, "0.06") || strEQc(bl_header.version, "0.04")) 223 { /* added again with 0.06_01 */ 224 /* config.h BYTEORDER: 0x1234 of length longsize, not ivsize */ 225 char supported[16]; 226 /* Note: perl's $Config{byteorder} is wrong with 64int. 227 Bug in Config.pm:921 my $s = $Config{ivsize}; => my $s = $Config{longsize}; 228 */ 229 sprintf(supported, "%x", BYTEORDER); 230 BGET_strconst(str, 16); /* optional 0x prefix, 12345678 or 1234 */ 231 if (str[0] == 0x30 && str[1] == 0x78) { /* skip '0x' */ 232 str++; str++; 233 } 234 my_strlcpy(bl_header.byteorder, str, 16); 235 if (strNE(str, supported)) { 236 /* swab only if same length. 1234 => 4321, 12345678 => 87654321 */ 237 if (strlen(str) == strlen(supported)) { 238 bget_swab = 1; 239 HEADER_WARN2("EXPERIMENTAL byteorder conversion: .plc=%s, perl=%s", 240 str, supported); 241 } else { 242 HEADER_FAIL2("Unsupported byteorder conversion: .plc=%s, perl=%s", 243 str, supported); 244 } 245 } 246 } 247 248 /* swab byteorder */ 249 if (bget_swab) { 250 bl_header.ivsize = _swab_32_(bl_header.ivsize); 251 bl_header.ptrsize = _swab_32_(bl_header.ptrsize); 252 if (bl_header.longsize != LONGSIZE) { 253 bl_header.longsize = _swab_32_(bl_header.longsize); 254 } 255 } 256 257#ifdef USE_ITHREADS 258# define HAVE_ITHREADS_I 1 259#else 260# define HAVE_ITHREADS_I 0 261#endif 262#ifdef MULTIPLICITY 263# define HAVE_MULTIPLICITY_I 2 264#else 265# define HAVE_MULTIPLICITY_I 0 266#endif 267 if (strGE(bl_header.version, "0.06_05")) { 268 BGET_U16(sz); /* archflag */ 269 bl_header.archflag = sz; 270 if ((sz & 1) != HAVE_ITHREADS_I) { 271 HEADER_FAIL2("Wrong USE_ITHREADS. Bytecode: %s, System: %s)", 272 bl_header.archflag & 1 ? "yes" : "no", 273 HAVE_ITHREADS_I ? "yes" : "no"); 274 } 275 if (strGE(bl_header.version, "0.08")) { 276 if ((sz & 2) != HAVE_MULTIPLICITY_I) { 277 HEADER_FAIL2("Wrong MULTIPLICITY. Bytecode: %s, System: %s)", 278 bl_header.archflag & 2 ? "yes" : "no", 279 HAVE_MULTIPLICITY_I ? "yes" : "no"); 280 } 281 } 282 } 283 284 if (bl_header.ivsize != IVSIZE) { 285 HEADER_WARN("different IVSIZE"); 286 if ((bl_header.ivsize != 4) && (bl_header.ivsize != 8)) 287 HEADER_FAIL1("unsupported IVSIZE %d", bl_header.ivsize); 288 } 289 if (bl_header.ptrsize != PTRSIZE) { 290 HEADER_WARN("different PTRSIZE"); 291 if ((bl_header.ptrsize != 4) && (bl_header.ptrsize != 8)) 292 HEADER_FAIL1("unsupported PTRSIZE %d", bl_header.ptrsize); 293 } 294 if (strGE(bl_header.version, "0.06_03")) { 295 if (bl_header.longsize != LONGSIZE) { 296 HEADER_WARN("different LONGSIZE"); 297 if ((bl_header.longsize != 4) && (bl_header.longsize != 8)) 298 HEADER_FAIL1("unsupported LONGSIZE %d", bl_header.longsize); 299 } 300 } 301 if (strGE(bl_header.version, "0.06_06")) { 302 BGET_strconst(str, 16); 303 my_strlcpy(bl_header.perlversion, str, 16); 304 } else { 305 *bl_header.perlversion = 0; 306 } 307 308 return 1; 309} 310 311int 312byterun(pTHX_ struct byteloader_state *bstate) 313{ 314 register int insn; 315 U32 isjit = 0; 316 U32 ix; 317EOT 318printf BYTERUN_C " SV *specialsv_list[%d];\n", scalar @specialsv_name; 319print BYTERUN_C <<'EOT'; 320 321 bytecode_header_check(aTHX_ bstate, &isjit); /* croak if incorrect platform, 322 set isjit on PLJC magic header */ 323 if (isjit) { 324 Perl_croak(aTHX_ "PLJC-magic: No JIT support yet\n"); 325 return 0; /*jitrun(aTHX_ &bstate);*/ 326 } else { 327 New(0, bstate->bs_obj_list, 32, void*); /* set op objlist */ 328 bstate->bs_obj_list_fill = 31; 329 bstate->bs_obj_list[0] = NULL; /* first is always Null */ 330 bstate->bs_ix = 1; 331 CopLINE(PL_curcop) = bstate->bs_fdata->next_out; 332 DEBUG_l( Perl_deb(aTHX_ "(bstate.bs_fdata.idx %d)\n", bstate->bs_fdata->idx)); 333 DEBUG_l( Perl_deb(aTHX_ "(bstate.bs_fdata.next_out %d)\n", bstate->bs_fdata->next_out)); 334 DEBUG_l( Perl_deb(aTHX_ "(bstate.bs_fdata.datasv %p:\"%s\")\n", bstate->bs_fdata->datasv, 335 SvPV_nolen(bstate->bs_fdata->datasv))); 336 337EOT 338 339for my $i ( 0 .. $#specialsv_name ) { 340 print BYTERUN_C " specialsv_list[$i] = $specialsv_name[$i];\n"; 341} 342 343print BYTERUN_C <<'EOT'; 344 345 while ((insn = BGET_FGETC()) != EOF) { 346 CopLINE(PL_curcop) = bstate->bs_fdata->next_out; 347 switch (insn) { 348EOT 349 350 351my ($idx, @insn_name, $insn_num, $ver, $insn, $lvalue, $argtype, $flags, $fundtype, $unsupp); 352my $ITHREADS = $Config{useithreads} eq 'define'; 353my $MULTI = $Config{useithreads} eq 'define'; 354 355$insn_num = 0; 356my @data = <DATA>; 357my @insndata = (); 358for (@data) { 359 if (/^\s*#/) { 360 print BYTERUN_C if /^\s*#\s*(?:if|endif|el)/; 361 next; 362 } 363 chop; 364 next unless length; 365 ($idx, $ver, $insn, $lvalue, $argtype, $flags) = split; 366 # bc numbering policy: <=5.6: leave out (squeeze), >=5.8 leave holes 367 if ($] > 5.007) { 368 $insn_num = $idx ? $idx : $insn_num; 369 $insn_num = 0 if !$idx and $insn eq 'ret'; 370 } else { # ignore the idx and count through. just fixup comment and nop 371 $insn_num = 35 if $insn eq "comment"; 372 $insn_num = 10 if $insn eq "nop"; 373 $insn_num = 0 if $insn eq "ret"; # start from 0 374 } 375 my $rvalcast = ''; 376 $unsupp = 0; 377 if ($argtype =~ m:(.+)/(.+):) { 378 ($rvalcast, $argtype) = ("($1)", $2); 379 } 380 if ($ver) { 381 if ($ver =~ /^\!?i/) { 382 $unsupp++ if ($ver =~ /^i/ and !$ITHREADS) or ($ver =~ /\!i/ and $ITHREADS); 383 $ver =~ s/^\!?i//; 384 } 385 if ($ver =~ /^\!?m/) { 386 $unsupp++ if ($ver =~ /^m/ and !$MULTI) or ($ver =~ /\!m/ and $MULTI); 387 $ver =~ s/^\!?m//; 388 } 389 # perl version 5.010000 => 10.000, 5.009003 => 9.003 390 # Have to round the float: 5.010 - 5 = 0.00999999999999979 391 my $pver = 0.0+(substr($],2,3).".".substr($],5)); 392 if ($ver =~ /^<?8\-?/) { 393 $ver =~ s/8/8.001/; # as convenience for a shorter table. 394 } 395 if ($ver eq '10-25.005' and $Config{usecperl}) { 396 $ver = '10-25.003'; # fixup for cperl cop_seq_low 397 } 398 # Add these misses to ASMDATA. TODO: To BYTERUN maybe with a translator, as the 399 # perl fields to write to are gone. Reading for the disassembler should be possible. 400 if ($ver =~ /^\>[\d\.]+$/) { 401 $unsupp++ if $pver < substr($ver,1);# ver >10: skip if pvar lowereq 10 402 } elsif ($ver =~ /^\<[\d\.]+$/) { 403 $unsupp++ if $pver >= substr($ver,1); # ver <10: skip if pvar higher than 10; 404 } elsif ($ver =~ /^([\d\.]+)-([\d\.]+)$/) { 405 $unsupp++ if $pver >= $2 or $pver < $1; # ver 8-10 (both inclusive): skip if pvar 406 # lower than 8 or higher than 10; 407 } elsif ($ver =~ /^[\d\.]*$/) { 408 $unsupp++ if $pver < $ver; # ver 10: skip if pvar lower than 10; 409 } 410 } 411 # warn "unsupported $idx\t$ver\t$insn\n" if $unsupp; 412 if (!$unsupp or ($] >= 5.007 and $insn !~ /pad|cop_seq|xcv_name_hek|unop_aux/)) { 413 $insn_name[$insn_num] = $insn; 414 push @insndata, [$insn_num, $unsupp, $insn, $lvalue, $rvalcast, $argtype, $flags]; 415 # Find the next unused instruction number 416 do { $insn_num++ } while $insn_name[$insn_num]; 417 } 418} 419 420# calculate holes and insn_nums (number of instructions per bytecode) 421my %holes = (); 422my $insn_max = $insndata[$#insndata]->[0]; 423# %holes = (46=>1,66=>1,68=>1,107=>1,108=>1,115=>1,126=>1,127=>1,129=>1,131=>1) if $] > 5.007; 424my %insn_nums; 425if ($] > 5.007) { 426 my %unsupps; 427 for (@insndata) { $insn_nums{$_->[0]}++; } # all 428 for (@insndata) { $holes{$_->[0]}++ if $_->[1] and $insn_nums{$_->[0]} == 1; } 429} 430 431my $UVxf = substr($Config{uvxformat},1,-1); 432$UVxf =~ s/[\0"]//g; 433$UVxf = "lx" unless $UVxf; 434 435for (@insndata) { 436 my ($unsupp, $rvalcast); 437 ($insn_num, $unsupp, $insn, $lvalue, $rvalcast, $argtype, $flags) = @$_; 438 $fundtype = $alias_from{$argtype} || $argtype; 439 # 440 # Add the initialiser line for %insn_data in Asmdata.pm 441 # 442 if ($unsupp) { 443 print ASMDATA_PM <<"EOT" if $insn_nums{$insn_num} == 1; # singletons only 444\$insn_data{$insn} = [$insn_num, 0, "GET_$fundtype"]; 445EOT 446 } else { 447 print ASMDATA_PM <<"EOT"; 448\$insn_data{$insn} = [$insn_num, \\&PUT_$fundtype, "GET_$fundtype"]; 449EOT 450 } 451 452 # 453 # Add the case statement and code for the bytecode interpreter in byterun.c 454 # 455 # On unsupported codes add to BYTERUN CASE only for certain nums: holes. 456 if (!$unsupp or $holes{$insn_num}) { 457 printf BYTERUN_C "\t case %s:\t\t/* %d */\n\t {\n", 458 $unsupp ? $insn_num : "INSN_".uc($insn), $insn_num; 459 } else { 460 next; 461 } 462 my $optarg = $argtype eq "none" ? "" : ", arg"; 463 my ($argfmt, $rvaldcast, $printarg); 464 if ($fundtype =~ /(strconst|pvcontents|op_tr_array)/) { 465 $argfmt = '\"%s\"'; 466 $rvaldcast = '(char*)'; 467 $printarg = "${rvaldcast}arg"; 468 } elsif ($argtype =~ /index$/) { 469 $argfmt = '0x%'.$UVxf.', ix:%d'; 470 $rvaldcast = "($argtype)"; 471 $printarg = "PTR2UV(arg)"; 472 } else { 473 $argfmt = $fundtype =~ /^U/ ? '%u' : '%d'; 474 $rvaldcast = '(int)'; 475 $printarg = "${rvaldcast}arg"; 476 } 477 if ($optarg) { 478 print BYTERUN_C "\t\t$argtype arg;\n"; 479 if ($rvalcast) { 480 $argtype = $rvalcast . $argtype; 481 } 482 if ($unsupp and !$DEBUGGING) { 483 printf BYTERUN_C "\t\tPERL_UNUSED_VAR(arg);\n"; 484 } 485 if ($unsupp and $holes{$insn_num}) { 486 printf BYTERUN_C "\t\tPerlIO_printf(Perl_error_log, \"Unsupported bytecode instruction %%d (%s) at stream offset %%d.\\n\", 487 insn, bstate->bs_fdata->next_out);\n", uc($insn); 488 } 489 print BYTERUN_C "\t\tif (force)\n\t" if $unsupp; 490 if ($fundtype eq 'strconst') { 491 my $maxsize = ($flags =~ /(\d+$)/) ? $1 : 0; 492 printf BYTERUN_C "\t\tBGET_%s(arg, %d);\n", $fundtype, $maxsize; 493 } else { 494 printf BYTERUN_C "\t\tBGET_%s(arg);\n", $fundtype; 495 } 496 printf BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"(insn %%3d) $insn $argtype:%s\\n\",\n\t\t\t\tinsn, $printarg%s));\n", 497 $argfmt, ($argtype =~ /index$/ ? ', (int)ix' : ''); 498 if ($insn eq 'newopx' or $insn eq 'newop') { 499 print BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t [%s %d]\\n\", PL_op_name[arg>>7], bstate->bs_ix));\n"; 500 } 501 if ($fundtype eq 'PV') { 502 print BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t BGET_PV(arg) => \\\"%s\\\"\\n\", bstate->bs_pv.pv));\n"; 503 } 504 } else { 505 if ($unsupp and $holes{$insn_num}) { 506 printf BYTERUN_C "\t\tPerlIO_printf(Perl_error_log, \"Unsupported bytecode instruction %%d (%s) at stream offset %%d.\\n\", 507 insn, bstate->bs_fdata->next_out);\n", uc($insn); 508 } 509 print BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"(insn %3d) $insn\\n\", insn));\n"; 510 } 511 if ($flags =~ /x/) { 512 # Special setter method named after insn 513 print BYTERUN_C "\t\tif (force)\n\t" if $unsupp; 514 print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n"; 515 my $optargcast = $optarg eq ", arg" ? ",\n\t\t\t\t$printarg" : ''; 516 $optargcast .= ($insn =~ /x$/ and $optarg eq ", arg" ? ", bstate->bs_ix-1" : ''); 517 printf BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t BSET_$insn($lvalue%s)\\n\"$optargcast));\n", 518 $optarg eq ", arg" 519 ? ($fundtype =~ /(strconst|pvcontents)/ 520 ? ($insn =~ /x$/ ? ', \"%s\" ix:%d' : ', \"%s\"') 521 : (", " .($argtype =~ /index$/ ? '0x%'.$UVxf : $argfmt) 522 .($insn =~ /x$/ ? ' ix:%d' : '')) 523 ) 524 : ''; 525 } elsif ($flags =~ /s/) { 526 # Store instructions to bytecode_obj_list[arg]. "lvalue" field is rvalue. 527 print BYTERUN_C "\t\tif (force)\n\t" if $unsupp; 528 print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n"; 529 print BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t BSET_OBJ_STORE($lvalue$optarg)\\n\"));\n"; 530 } 531 elsif ($optarg && $lvalue ne "none") { 532 if ($insn eq 'comment') { 533 printf BYTERUN_C "\t\tPERL_UNUSED_VAR(arg);\n"; 534 } else { 535 print BYTERUN_C "\t\t$lvalue = ${rvalcast}arg;\n" unless $unsupp; 536 } 537 printf BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t $lvalue = ${rvalcast}%s;\\n\", $printarg%s));\n", 538 $fundtype =~ /(strconst|pvcontents)/ ? '\"%s\"' : ($argtype =~ /index$/ ? '0x%'.$UVxf : $argfmt); 539 } 540 print BYTERUN_C "\t\tbreak;\n\t }\n"; 541} 542 543# 544# Finish off byterun.c 545# 546print BYTERUN_C <<'EOT'; 547 default: 548 Perl_croak(aTHX_ "Illegal bytecode instruction %d at stream offset %d.\n", 549 insn, bstate->bs_fdata->next_out); 550 /* NOTREACHED */ 551 } 552 /* debop is not public in 5.10.0 on strict platforms like mingw and MSVC, cygwin is fine. */ 553#if defined(DEBUG_t_TEST_) && !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(AIX) 554 if (PL_op && DEBUG_t_TEST_) 555 /* GV without the cGVOPo_gv initialized asserts. We need to skip newopx */ 556 if ((insn != INSN_NEWOPX) && (insn != INSN_NEWOP) && (PL_op->op_type != OP_GV)) debop(PL_op); 557#endif 558 } 559 } 560 return 0; 561} 562 563/* ex: set ro: */ 564EOT 565 566# 567# Write the instruction and optype enum constants into byterun.h 568# 569open(BYTERUN_H, "> $targets[2]") or die "$targets[2]: $!"; 570binmode BYTERUN_H; 571print BYTERUN_H $c_header, <<'EOT'; 572#if PERL_VERSION < 10 573# define PL_RSFP PL_rsfp 574#else 575# define PL_RSFP PL_parser->rsfp 576#endif 577 578#if (PERL_VERSION <= 8) && (PERL_SUBVERSION < 8) 579# define NEED_sv_2pv_flags 580# include "ppport.h" 581#endif 582 583/* macros for correct constant construction */ 584# if INTSIZE >= 2 585# define U16_CONST(x) ((U16)x##U) 586# else 587# define U16_CONST(x) ((U16)x##UL) 588# endif 589 590# if INTSIZE >= 4 591# define U32_CONST(x) ((U32)x##U) 592# else 593# define U32_CONST(x) ((U32)x##UL) 594# endif 595 596# ifdef HAS_QUAD 597# if PERL_VERSION < 24 598typedef I64TYPE I64; 599typedef U64TYPE U64; 600# endif 601# if INTSIZE >= 8 602# define U64_CONST(x) ((U64)x##U) 603# elif LONGSIZE >= 8 604# define U64_CONST(x) ((U64)x##UL) 605# elif QUADKIND == QUAD_IS_LONG_LONG 606# define U64_CONST(x) ((U64)x##ULL) 607# else /* best guess we can make */ 608# define U64_CONST(x) ((U64)x##UL) 609# endif 610# endif 611 612/* byte-swapping functions for big-/little-endian conversion */ 613# define _swab_16_(x) ((U16)( \ 614 (((U16)(x) & U16_CONST(0x00ff)) << 8) | \ 615 (((U16)(x) & U16_CONST(0xff00)) >> 8) )) 616 617# define _swab_32_(x) ((U32)( \ 618 (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \ 619 (((U32)(x) & U32_CONST(0x0000ff00)) << 8) | \ 620 (((U32)(x) & U32_CONST(0x00ff0000)) >> 8) | \ 621 (((U32)(x) & U32_CONST(0xff000000)) >> 24) )) 622 623# ifdef HAS_QUAD 624# define _swab_64_(x) ((U64)( \ 625 (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \ 626 (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \ 627 (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \ 628 (((U64)(x) & U64_CONST(0x00000000ff000000)) << 8) | \ 629 (((U64)(x) & U64_CONST(0x000000ff00000000)) >> 8) | \ 630 (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \ 631 (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \ 632 (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) )) 633# else 634# define _swab_64_(x) _swab_32_((U32)(x) & U32_CONST(0xffffffff)) 635# endif 636 637# define _swab_iv_(x,size) ((size==4) ? _swab_32_(x) : ((size==8) ? _swab_64_(x) : _swab_16_(x))) 638 639struct byteloader_fdata { 640 SV *datasv; 641 int next_out; 642 int idx; 643}; 644 645struct byteloader_xpv { 646 char *pv; 647 STRLEN cur; 648 STRLEN len; 649}; 650 651struct byteloader_header { 652 char archname[80]; 653 char version[16]; 654 int ivsize; 655 int ptrsize; 656 int longsize; 657 char byteorder[16]; 658 int archflag; 659 char perlversion[16]; 660}; 661 662struct byteloader_state { 663 struct byteloader_fdata *bs_fdata; 664 union { 665 SV *bs_sv; 666 PADLIST *bs_padl; 667#if PERL_VERSION >= 21 668 PADNAME *bs_padn; 669#endif 670#if PERL_VERSION >= 17 671 PADNAMELIST *bs_padnl; 672#endif 673 } u; 674 void **bs_obj_list; 675 int bs_obj_list_fill; 676 int bs_ix; 677 struct byteloader_xpv bs_pv; 678 int bs_iv_overflows; 679}; 680 681/* 682 #define bstate->bs_sv (bstate->u.bs_sv) 683 #define bstate->bs_padn bstate->u.bs_padn 684 #define bstate->bs_padnl bstate->u.bs_padnl 685 #define bstate->bs_padl bstate->u.bs_padl 686*/ 687 688int bl_getc(struct byteloader_fdata *); 689int bl_read(struct byteloader_fdata *, char *, size_t, size_t); 690extern int byterun(pTHX_ register struct byteloader_state *); 691 692enum { 693EOT 694 695my $add_enum_value = 0; 696my ($old, $max_insn) = (-1); 697enum: 698for (sort {$a->[0] <=> $b->[0] } @insndata) { 699 ($i, $unsupp, $insn) = @$_; 700 # 701 # Add ENUMS to the header 702 # 703 $add_enum_value = 1 if $i != $old + 1; 704 if (!$unsupp) { 705 $insn = uc($insn); 706 $max_insn = $i; 707 if ($add_enum_value) { 708 my $tabs = "\t" x (4-((9+length($insn)))/8); 709 printf BYTERUN_H " INSN_$insn = %3d,$tabs/* $i */\n", $i; 710 $add_enum_value = 0; 711 } else { 712 my $tabs = "\t" x (4-((3+length($insn))/8)); 713 print BYTERUN_H " INSN_$insn,$tabs/* $i */\n"; 714 } 715 } else { 716 $add_enum_value = 1; 717 } 718 $old = $i; 719} 720 721print BYTERUN_H " MAX_INSN = $max_insn\n};\n"; 722 723print BYTERUN_H "\nenum {\n"; 724for ($i = 0; $i < @optype - 1; $i++) { 725 printf BYTERUN_H " OPt_%s,\t\t/* %d */\n", $optype[$i], $i; 726} 727printf BYTERUN_H " OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i; 728 729print BYTERUN_H "/* ex: set ro: */\n"; 730 731# 732# Finish off insn_data and create array initialisers in Asmdata.pm 733# 734print ASMDATA_PM <<'EOT'; 735 736my ($insn_name, $insn_data); 737while (($insn_name, $insn_data) = each %insn_data) { 738 $insn_name[$insn_data->[0]] = $insn_name; 739} 740# Fill in any gaps 741@insn_name = map($_ || "unused", @insn_name); 742 7431; 744 745__END__ 746 747=head1 NAME 748 749B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode 750 751=head1 SYNOPSIS 752 753 use B::Asmdata qw(%insn_data @insn_name @optype @specialsv_name); 754 755=head1 DESCRIPTION 756 757Provides information about Perl ops in order to generate bytecode via 758a bunch of exported variables. Its mostly used by B::Assembler and 759B::Disassembler. 760 761=over 4 762 763=item %insn_data 764 765 my($bytecode_num, $put_sub, $get_meth) = @$insn_data{$op_name}; 766 767For a given $op_name (for example, 'cop_label', 'sv_flags', etc...) 768you get an array ref containing the bytecode number of the op, a 769reference to the subroutine used to 'PUT' the op argument to the bytecode stream, 770and the name of the method used to 'GET' op argument from the bytecode stream. 771 772Most ops require one arg, in fact all ops without the PUT/GET_none methods, 773and the GET and PUT methods are used to en-/decode the arg to binary bytecode. 774The names are constructed from the GET/PUT prefix and the argument type, 775such as U8, U16, U32, svindex, opindex, pvindex, ... 776 777The PUT method is used in the L<B::Bytecode> compiler within L<B::Assembler>, 778the GET method just for the L<B::Disassembler>. 779The GET method is not used by the binary L<ByteLoader> module. 780 781A full C<insn> table with version, opcode, name, lvalue, argtype and flags 782is located as DATA in F<bytecode.pl>. 783 784An empty PUT method, the number 0, denotes an unsupported bytecode for this perl. 785It is there to support disassembling older perl bytecode. This was added with 1.02_02. 786 787=item @insn_name 788 789 my $op_name = $insn_name[$bytecode_num]; 790 791A simple mapping of the bytecode number to the name of the op. 792Suitable for using with %insn_data like so: 793 794 my $op_info = $insn_data{$insn_name[$bytecode_num]}; 795 796=item @optype 797 798 my $op_type = $optype[$op_type_num]; 799 800A simple mapping of the op type number to its type (like 'COP' or 'BINOP'). 801 802Since Perl version 5.10 defined in L<B>. 803 804=item @specialsv_name 805 806 my $sv_name = $specialsv_name[$sv_index]; 807 808Certain SV types are considered 'special'. They're represented by 809B::SPECIAL and are referred to by a number from the specialsv_list. 810This array maps that number back to the name of the SV (like 'Nullsv' 811or '&PL_sv_undef'). 812 813Since Perl version 5.10 defined in L<B>. 814 815=back 816 817=head1 PORTABILITY 818 819All bytecode values are already portable. 820Cross-platform portability is implemented, cross-version not yet. 821 822Cross-version portability will be very limited, cross-platform only 823for the same threading model. 824 825=head2 CROSS-PLATFORM PORTABILITY 826 827For different endian-ness there are ByteLoader converters in effect. 828Header entry: byteorder. 829 83064int - 64all - 32int is portable. Header entry: ivsize 831 832ITHREADS are unportable; header entry: archflag - bitflag 1. 833MULTIPLICITY is also unportable; header entry: archflag - bitflag 2 834 835TODO For cross-version portability we will try to translate older 836bytecode ops to the current perl op via L<ByteLoader::Translate>. 837Asmdata already contains the old ops, all with the PUT method 0. 838Header entry: perlversion 839 840=head2 CROSS-VERSION PORTABILITY (TODO - HARD) 841 842Bytecode ops: 843We can only reliably load bytecode from previous versions and promise 844that from 5.10.0 on future versions will only add new op numbers at 845the end, but will never replace old opcodes with incompatible arguments. 846Unsupported insn's are supported by disassemble, and if C<force> in the 847ByteLoader is set, it is tried to load/set them also, with probably fatal 848consequences. 849On the first unknown bytecode op from a future version - added to the end 850- we will die. 851 852L<ByteLoader::BcVersions> contains logic to translate previous errors 853from this bytecode policy. E.g. 5.8 violated the 5.6 bytecode order policy 854and began to juggle it around (similar to parrot), in detail removed 855various bytecodes, like ldspecsvx:7, xpv_cur, xpv_len, xiv64:26. 856So in theory it would have been possible to load 5.6 into 5.8 bytecode 857as the underlying perl pp_code ops didn't change that much, but it is risky. 858 859We have unused tables of all bytecode ops for all version-specific changes 860to the bytecode table. This only changed with 861the ByteLoader version, ithreads and major Perl versions. 862 863Also special replacements in the byteloader for all the unsupported 864ops, like xiv64, cop_arybase. 865 866=head1 AUTHOR 867 868Malcolm Beattie C<MICB at cpan.org> I<(retired)>, 869Reini Urban added the version logic, support >= 5.10, portability. 870 871=cut 872 873# ex: set ro: 874EOT 875 876close ASMDATA_PM or die "Error closing $targets[0]: $!"; 877close BYTERUN_C or die "Error closing $targets[1]: $!"; 878close BYTERUN_H or die "Error closing $targets[2]: $!"; 879chmod 0444, @targets; 880 881# TODO 5.10: 882# stpv (?) 883# pv_free: free the bs_pv and the SvPVX? (?) 884 885__END__ 886# First set instruction ord("#") to read comment to end-of-line (sneaky) 88735 0 comment arg comment_t 888# Then make ord("\n") into a no-op 88910 0 nop none none 890 891# Now for the rest of the ordinary ones, beginning with \0 which is 892# ret so that \0-terminated strings can be read properly as bytecode. 893# 894# The argtype is either a single type or "rightvaluecast/argtype". 895# The version is either "i" or "!i" for ITHREADS or not, 896# "m" or "!m" for MULTI or not, 897# or num, num-num, >num or <num. 898# "0" is for all, "<10" requires PERL_VERSION<10, "10" requires 899# PERL_VERSION>=10, ">10" requires PERL_VERSION>10, "10-10" 900# requires PERL_VERSION>==10 only. 901# lvalue is the (statemachine) value to read or write. 902# argtype specifies the reader or writer method. 903# flags x specifies a special writer method BSET_$insn in bytecode.h 904# flags s store instructions to bytecode_obj_list[arg]. "lvalue" field is rvalue. 905# flags \d+ specifies the maximal length. 906# 907# bc numbering policy: <=5.6: leave out, >=5.8 leave holes 908# Note: ver 8 is really 8.001. 5.008000 had the same bytecodes as 5.006002. 909 910#idx version opcode lvalue argtype flags 911# 9120 0 ret none none x 9131 0 ldsv bstate->u.bs_sv svindex 9142 0 ldop PL_op opindex 9153 0 stsv bstate->u.bs_sv U32 s 9164 0 stop PL_op U32 s 9175 6.001 stpv bstate->bs_pv.pv U32 x 9186 0 ldspecsv bstate->u.bs_sv U8 x 9197 8 ldspecsvx bstate->u.bs_sv U8 x 9208 0 newsv bstate->u.bs_sv U8 x 9219 8 newsvx bstate->u.bs_sv U32 x 922#10 0 nop none none 92311 0 newop PL_op U8 x 92412 8 newopx PL_op U16 x 92513 0 newopn PL_op U8 x 92614 0 newpv none U32/PV 92715 0 pv_cur bstate->bs_pv.cur STRLEN 92816 0 pv_free bstate->bs_pv none x 92917 0 sv_upgrade bstate->u.bs_sv U8 x 93018 0 sv_refcnt SvREFCNT(bstate->u.bs_sv) U32 93119 0 sv_refcnt_add SvREFCNT(bstate->u.bs_sv) I32 x 93220 0 sv_flags SvFLAGS(bstate->u.bs_sv) U32 93321 0 xrv bstate->u.bs_sv svindex x 93422 0 xpv bstate->u.bs_sv none x 93523 8 xpv_cur bstate->u.bs_sv STRLEN x 93624 8 xpv_len bstate->u.bs_sv STRLEN x 93725 8 xiv bstate->u.bs_sv IV x 93825 <8 xiv32 SvIVX(bstate->u.bs_sv) I32 9390 <8 xiv64 SvIVX(bstate->u.bs_sv) IV64 94026 0 xnv bstate->u.bs_sv NV x 94127 0 xlv_targoff LvTARGOFF(bstate->u.bs_sv) STRLEN 94228 0 xlv_targlen LvTARGLEN(bstate->u.bs_sv) STRLEN 94329 0 xlv_targ LvTARG(bstate->u.bs_sv) svindex 94430 0 xlv_type LvTYPE(bstate->u.bs_sv) char 94531 0 xbm_useful BmUSEFUL(bstate->u.bs_sv) I32 94632 <19 xbm_previous BmPREVIOUS(bstate->u.bs_sv) U16 94733 <19 xbm_rare BmRARE(bstate->u.bs_sv) U8 94834 0 xfm_lines FmLINES(bstate->u.bs_sv) IV 949#35 0 comment arg comment_t 95036 0 xio_lines IoLINES(bstate->u.bs_sv) IV 95137 0 xio_page IoPAGE(bstate->u.bs_sv) IV 95238 0 xio_page_len IoPAGE_LEN(bstate->u.bs_sv) IV 95339 0 xio_lines_left IoLINES_LEFT(bstate->u.bs_sv) IV 95440 0 xio_top_name IoTOP_NAME(bstate->u.bs_sv) pvindex 95541 0 xio_top_gv *(SV**)&IoTOP_GV(bstate->u.bs_sv) svindex 95642 0 xio_fmt_name IoFMT_NAME(bstate->u.bs_sv) pvindex 95743 0 xio_fmt_gv *(SV**)&IoFMT_GV(bstate->u.bs_sv) svindex 95844 0 xio_bottom_name IoBOTTOM_NAME(bstate->u.bs_sv) pvindex 95945 0 xio_bottom_gv *(SV**)&IoBOTTOM_GV(bstate->u.bs_sv) svindex 96046 <10 xio_subprocess IoSUBPROCESS(bstate->u.bs_sv) short 96147 0 xio_type IoTYPE(bstate->u.bs_sv) char 96248 0 xio_flags IoFLAGS(bstate->u.bs_sv) char 96349 8 xcv_xsubany *(SV**)&CvXSUBANY(bstate->u.bs_sv).any_ptr svindex 96450 <13 xcv_stash CvSTASH(bstate->u.bs_sv) svindex 96550 13 xcv_stash bstate->u.bs_sv svindex x 96651 0 xcv_start CvSTART(bstate->u.bs_sv) opindex 96752 0 xcv_root CvROOT(bstate->u.bs_sv) opindex 96853 0 xcv_gv bstate->u.bs_sv svindex x 969# <8 xcv_filegv *(SV**)&CvFILEGV(bstate->u.bs_sv) svindex 97054 0 xcv_file CvFILE(bstate->u.bs_sv) pvindex 97155 0 xcv_depth CvDEPTH(bstate->u.bs_sv) long 97256 0 xcv_padlist *(SV**)&CvPADLIST(bstate->u.bs_sv) svindex 97357 0 xcv_outside *(SV**)&CvOUTSIDE(bstate->u.bs_sv) svindex 97458 8 xcv_outside_seq CvOUTSIDE_SEQ(bstate->u.bs_sv) U32 97559 <20 xcv_flags CvFLAGS(bstate->u.bs_sv) U16 97659 20 xcv_flags CvFLAGS(bstate->u.bs_sv) U32 97760 0 av_extend bstate->u.bs_sv SSize_t x 97861 8 av_pushx bstate->u.bs_sv svindex x 97962 <8 av_push bstate->u.bs_sv svindex x 98063 <8 xav_fill AvFILLp(bstate->u.bs_sv) SSize_t 98164 <8 xav_max AvMAX(bstate->u.bs_sv) SSize_t 98265 <10 xav_flags AvFLAGS(bstate->u.bs_sv) U8 98365 10-12 xav_flags ((XPVAV*)(SvANY(bstate->u.bs_sv)))->xiv_u.xivu_i32 I32 98466 <10 xhv_riter HvRITER(bstate->u.bs_sv) I32 98567 0 xhv_name bstate->u.bs_sv pvindex x 98668 8-9 xhv_pmroot *(OP**)&HvPMROOT(bstate->u.bs_sv) opindex 98769 0 hv_store bstate->u.bs_sv svindex x 98870 0 sv_magic bstate->u.bs_sv char x 98971 0 mg_obj SvMAGIC(bstate->u.bs_sv)->mg_obj svindex 99072 0 mg_private SvMAGIC(bstate->u.bs_sv)->mg_private U16 99173 0 mg_flags SvMAGIC(bstate->u.bs_sv)->mg_flags U8 992# mg_name <5.8001 called mg_pv 99374 0 mg_name SvMAGIC(bstate->u.bs_sv) pvcontents x 99475 8 mg_namex SvMAGIC(bstate->u.bs_sv) svindex x 99576 0 xmg_stash bstate->u.bs_sv svindex x 99677 0 gv_fetchpv bstate->u.bs_sv strconst 128x 99778 8 gv_fetchpvx bstate->u.bs_sv strconst 128x 99879 0 gv_stashpv bstate->u.bs_sv strconst 128x 99980 8 gv_stashpvx bstate->u.bs_sv strconst 128x 100081 0 gp_sv bstate->u.bs_sv svindex x 100182 0 gp_refcnt GvREFCNT(bstate->u.bs_sv) U32 100283 0 gp_refcnt_add GvREFCNT(bstate->u.bs_sv) I32 x 100384 0 gp_av *(SV**)&GvAV(bstate->u.bs_sv) svindex 100485 0 gp_hv *(SV**)&GvHV(bstate->u.bs_sv) svindex 100586 0 gp_cv *(SV**)&GvCV(bstate->u.bs_sv) svindex x 100687 <9 gp_file GvFILE(bstate->u.bs_sv) pvindex 100787 9 gp_file bstate->u.bs_sv pvindex x 100888 0 gp_io *(SV**)&GvIOp(bstate->u.bs_sv) svindex 100989 0 gp_form *(SV**)&GvFORM(bstate->u.bs_sv) svindex 101090 0 gp_cvgen GvCVGEN(bstate->u.bs_sv) U32 101191 0 gp_line GvLINE(bstate->u.bs_sv) line_t 101292 0 gp_share bstate->u.bs_sv svindex x 101393 <10 xgv_flags GvFLAGS(bstate->u.bs_sv) U8 101493 10 xgv_flags GvFLAGS(bstate->u.bs_sv) SSize_t 101594 0 op_next PL_op->op_next opindex 101695 0 op_sibling PL_op opindex x 101796 0 op_ppaddr PL_op->op_ppaddr strconst 24x 101897 0 op_targ PL_op->op_targ PADOFFSET 101998 0 op_type PL_op OPCODE x 102099 <9 op_seq PL_op->op_seq U16 102199 9 op_opt PL_op->op_opt U8 1022100 0 op_flags PL_op->op_flags U8 1023101 0 op_private PL_op->op_private U8 1024102 0 op_first cUNOP->op_first opindex 1025103 0 op_last cBINOP->op_last opindex 1026104 0 op_other cLOGOP->op_other opindex 1027# found in 5.5.5, not on 5.5.8. I found 5.5.6 and 5.5.7 nowhere 10280 <5.008 op_true cCONDOP->op_true opindex 10290 <5.008 op_false cCONDOP->op_false opindex 10300 <6.001 op_children cLISTOP->op_children U32 1031105 <10 op_pmreplroot cPMOP->op_pmreplroot opindex 1032111 !i<10 op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot svindex 1033106 <10 op_pmreplstart cPMOP->op_pmreplstart opindex 1034105 10 op_pmreplroot (cPMOP->op_pmreplrootu).op_pmreplroot opindex 1035106 10 op_pmreplstart (cPMOP->op_pmstashstartu).op_pmreplstart opindex 1036107 <10 op_pmnext *(OP**)&cPMOP->op_pmnext opindex 1037108 i8 op_pmstashpv cPMOP pvindex x 1038109 i<10 op_pmreplrootpo cPMOP->op_pmreplroot OP*/PADOFFSET 1039109 i10 op_pmreplrootpo (cPMOP->op_pmreplrootu).op_pmreplroot OP*/PADOFFSET 1040110 !i8-10 op_pmstash *(SV**)&cPMOP->op_pmstash svindex 1041110 !i10 op_pmstash *(SV**)&(cPMOP->op_pmstashstartu).op_pmreplstart svindex 1042111 !i10 op_pmreplrootgv *(SV**)&(cPMOP->op_pmreplrootu).op_pmreplroot svindex 1043112 0 pregcomp PL_op pvcontents x 1044113 0 op_pmflags cPMOP->op_pmflags pmflags x 1045114 <10 op_pmpermflags cPMOP->op_pmpermflags U16 1046115 8-10 op_pmdynflags cPMOP->op_pmdynflags U8 1047116 0 op_sv cSVOP->op_sv svindex 10480 <6 op_gv *(SV**)&cGVOP->op_gv svindex 1049117 0 op_padix cPADOP->op_padix PADOFFSET 1050118 0 op_pv cPVOP->op_pv pvcontents 1051119 0 op_pv_tr cPVOP->op_pv op_tr_array 1052120 0 op_redoop cLOOP->op_redoop opindex 1053121 0 op_nextop cLOOP->op_nextop opindex 1054122 0 op_lastop cLOOP->op_lastop opindex 1055123 0 cop_label cCOP pvindex x 1056124 i0 cop_stashpv cCOP pvindex x 1057125 i0 cop_file cCOP pvindex x 1058126 !i0 cop_stash cCOP svindex x 1059127 !i0 cop_filegv cCOP svindex x 1060128 0 cop_seq cCOP->cop_seq U32 1061129 <10 cop_arybase cCOP->cop_arybase I32 1062130 0 cop_line cCOP->cop_line line_t 1063131 8-10 cop_io cCOP->cop_io svindex 1064132 0 cop_warnings cCOP svindex x 1065133 0 main_start PL_main_start opindex 1066134 0 main_root PL_main_root opindex 1067135 8 main_cv *(SV**)&PL_main_cv svindex 1068136 0 curpad PL_curpad svindex x 1069137 0 push_begin PL_beginav svindex x 1070138 0 push_init PL_initav svindex x 1071139 0 push_end PL_endav svindex x 1072140 8 curstash *(SV**)&PL_curstash svindex 1073141 8 defstash *(SV**)&PL_defstash svindex 1074142 8 data none U8 x 1075143 8 incav *(SV**)&GvAV(PL_incgv) svindex 1076144 8 load_glob none svindex x 1077145 i8 regex_padav *(SV**)&PL_regex_padav svindex 1078146 8 dowarn PL_dowarn U8 1079147 8 comppad_name *(SV**)&PL_comppad_name svindex 1080148 8 xgv_stash *(SV**)&GvSTASH(bstate->u.bs_sv) svindex 1081149 8 signal bstate->u.bs_sv strconst 24x 1082150 8-17 formfeed PL_formfeed svindex 1083151 9-17 op_latefree PL_op->op_latefree U8 1084152 9-17 op_latefreed PL_op->op_latefreed U8 1085153 9-17 op_attached PL_op->op_attached U8 1086# 5.10.0 misses the RX_EXTFLAGS macro 1087154 10-10.5 op_reflags PM_GETRE(cPMOP)->extflags U32 1088154 11 op_reflags RX_EXTFLAGS(PM_GETRE(cPMOP)) U32 1089155 10-25.005 cop_seq_low ((XPVNV*)(SvANY(bstate->u.bs_sv)))->xnv_u.xpad_cop_seq.xlow U32 1090156 10-25.005 cop_seq_high ((XPVNV*)(SvANY(bstate->u.bs_sv)))->xnv_u.xpad_cop_seq.xhigh U32 1091157 8 gv_fetchpvn_flags bstate->u.bs_sv U32 x 1092# restore dup to stdio handles 0-2 1093158 0 xio_ifp bstate->u.bs_sv char x 1094159 10 xpvshared bstate->u.bs_sv none x 1095160 18 newpadlx bstate->u.bs_padl U8 x 1096161 18 padl_name bstate->u.bs_padl svindex x 1097162 18 padl_sym bstate->u.bs_padl svindex x 1098163 18 xcv_name_hek bstate->u.bs_sv pvindex x 1099164 18 op_slabbed PL_op->op_slabbed U8 1100165 18 op_savefree PL_op->op_savefree U8 1101166 18 op_static PL_op->op_static U8 1102167 19.003 op_folded PL_op->op_folded U8 1103168 21.002-22 op_lastsib PL_op->op_lastsib U8 1104168 22 op_moresib PL_op->op_moresib U8 1105169 18 newpadnlx bstate->u.bs_padnl U8 x 1106170 22 padl_outid ((PADLIST*)bstate->u.bs_padl)->xpadl_outid U32 11070 22 padl_id ((PADLIST*)bstate->u.bs_padl)->xpadl_id U32 11080 22 padnl_push bstate->u.bs_padnl svindex x 11090 22 padnl_maxnamed PadnamelistMAXNAMED(bstate->u.bs_padnl) U32 11100 22 padnl_refcnt PadnamelistREFCNT(bstate->u.bs_padnl) U32 11110 22 newpadnx bstate->u.bs_padn strconst x 11120 22 padn_stash *(SV**)PadnameOURSTASH(bstate->u.bs_padn) svindex 11130 22 padn_type *(SV**)PadnameTYPE(bstate->u.bs_padn) svindex 11140 22 padn_seq_low COP_SEQ_RANGE_LOW(bstate->u.bs_padn) U32 11150 22 padn_seq_high COP_SEQ_RANGE_HIGH(bstate->u.bs_padn) U32 11160 22 padn_refcnt PadnameREFCNT(bstate->u.bs_padn) U32 11170 22 padn_pv bstate->u.bs_padn strconst x 11180 22 padn_flags PadnameFLAGS(bstate->u.bs_padn) U8 11190 22 unop_aux cUNOP_AUX->op_aux strconst x 11200 22 methop_methsv cMETHOPx(PL_op)->op_u.op_meth_sv svindex 11210 !i22 methop_rclass cMETHOPx(PL_op)->op_rclass_sv svindex 11220 i22 methop_rclass cMETHOPx(PL_op)->op_rclass_targ PADOFFSET 1123 1124