Permalink
Browse files

B-C-1.04_04

git-svn-id: http://perl-compiler.googlecode.com/svn/trunk@5 ed534f1a-1453-0410-ab30-dfc593a8b23c
  • Loading branch information...
Reini Urban
Reini Urban committed Jul 28, 2008
1 parent 90aad85 commit 67b941c74941744c4cabfb00ccca4947f1aa4112
Showing with 1,800 additions and 121 deletions.
  1. +1 −0 B/Asm/i386.pm
  2. +36 −0 B/Asm/test.pl
  3. +1 −1 B/Asmdata.pm
  4. +35 −20 B/C.pm
  5. +1 −1 ByteLoader/ByteLoader.pm
  6. +11 −1 ByteLoader/ByteLoader.xs
  7. +6 −2 ByteLoader/Makefile.PL
  8. +6 −2 ByteLoader/bytecode.h
  9. +24 −24 ByteLoader/byterun.c
  10. +2 −1 ByteLoader/byterun.h
  11. +32 −11 ByteLoader/jitrun.c
  12. +769 −1 ByteLoader/jitrun.h
  13. +14 −7 Changes
  14. +19 −4 MANIFEST
  15. +1 −1 META.yml
  16. +12 −3 Makefile.PL
  17. +5 −2 Todo
  18. +22 −21 bytecode.pl
  19. +2 −0 i386.xs
  20. +799 −17 jitcompiler.pl
  21. +2 −2 script/perlcc
View
@@ -1,3 +1,4 @@
+# Author: John Tobey, 2000 <jtobey@john-edwin-tobey.org>
package B::Asm::i386;
use Carp ();
View
@@ -0,0 +1,36 @@
+use Test;
+BEGIN { $^W = 1; $| = 1; plan tests => 9; }
+
+use strict;
+use B::Asm::i386;
+
+my ($cpu);
+
+$cpu = B::Asm::i386->new;
+
+$cpu->eax(0x123);
+ok($cpu->eax, 0x123);
+
+$cpu->ah(0x87);
+ok($cpu->eax, 0x8723);
+
+# 0: b8 01 02 03 04 mov $0x4030201,%eax
+$cpu->do(pack("H*", "b801020304"));
+ok($cpu->eax, 0x04030201);
+
+# 0: 89 c3 mov %eax,%ebx
+# 2: 31 c0 xor %eax,%eax
+# 4: 90 nop
+# 5: 90 nop
+# 6: a3 00 00 00 00 mov %eax,0x0
+$cpu->do(pack("H*", "89c331c09090a300000000"));
+ok($cpu->eax, 0);
+ok($cpu->ebx, 0x04030201);
+ok($cpu->sig eq 'SEGV');
+ok($cpu->died_where, 6);
+
+# 0: 6a 00 push $0x0
+# 2: c3 ret
+$cpu->do(pack("H*", "6a00c3"));
+ok($cpu->sig eq 'SEGV');
+ok(not defined $cpu->died_where);
View
@@ -237,7 +237,7 @@ or '&PL_sv_undef').
=head1 AUTHOR
Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-Reini Urban added the version logic and 5.10 support.
+Reini Urban added the version logic, 5.10 and jit support.
=cut
View
55 B/C.pm
@@ -8,7 +8,7 @@
package B::C;
-our $VERSION = '1.04_02';
+our $VERSION = '1.04_04';
package B::C::Section;
@@ -202,6 +202,7 @@ my ($debug_cops, $debug_av, $debug_cv, $debug_mg);
my $max_string_len;
my $ithreads = $Config{useithreads} eq 'define';
+my $perl510 = ($] >= 5.009005);
my @threadsv_names;
BEGIN {
@@ -584,11 +585,19 @@ sub B::PMOP::save {
# pmnext handling is broken in perl itself, I think. Bad op_pmnext
# fields aren't noticed in perl's runtime (unless you try reset) but we
# segfault when trying to dereference it to find op->op_pmnext->op_type
- $pmopsect->add(sprintf("%s, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x, 0x%x, 0x%x",
- $op->_save_common, ${$op->first}, ${$op->last},
- $replrootfield, $replstartfield,
- ( $ithreads ? $op->pmoffset : 0 ),
- $op->pmflags, $op->pmpermflags, $op->pmdynflags ));
+ if ($perl510) {
+ $pmopsect->add(sprintf("%s, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x",
+ $op->_save_common, ${$op->first}, ${$op->last},
+ $replrootfield, $replstartfield,
+ ( $ithreads ? $op->pmoffset : 0 ),
+ $op->pmflags ));
+ } else {
+ $pmopsect->add(sprintf("%s, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x, 0x%x, 0x%x",
+ $op->_save_common, ${$op->first}, ${$op->last},
+ $replrootfield, $replstartfield,
+ ( $ithreads ? $op->pmoffset : 0 ),
+ $op->pmflags, $op->pmpermflags, $op->pmdynflags ));
+ }
my $pm = sprintf("pmop_list[%d]", $pmopsect->index);
$init->add(sprintf("$pm.op_ppaddr = %s;", $ppaddr))
unless $optimize_ppaddr;
@@ -690,8 +699,8 @@ sub B::PVLV::save {
$svsect->add(sprintf("&xpvlv_list[%d], %lu, 0x%x",
$xpvlvsect->index, $sv->REFCNT , $sv->FLAGS));
if (!$pv_copy_on_grow) {
- $init->add(savepvn(sprintf("xpvlv_list[%d].xpv_pv",
- $xpvlvsect->index), $pv));
+ my $pvx = $] < 5.009 ? "xpvlv_list[%d].xpv_pv" : "xpv_list[%d]->sv_u.svu_pv";
+ $init->add(savepvn(sprintf($pvx, $xpvlvsect->index), $pv));
}
$sv->save_magic;
return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
@@ -706,8 +715,8 @@ sub B::PVIV::save {
$svsect->add(sprintf("&xpviv_list[%d], %u, 0x%x",
$xpvivsect->index, $sv->REFCNT , $sv->FLAGS));
if (defined($pv) && !$pv_copy_on_grow) {
- $init->add(savepvn(sprintf("xpviv_list[%d].xpv_pv",
- $xpvivsect->index), $pv));
+ my $pvx = $] < 5.009 ? "xpviv_list[%d].xpv_pv" : "((sv)xpviv_list[%d])->sv_u.svu_pv";
+ $init->add(savepvn(sprintf($pvx, $xpvivsect->index), $pv));
}
return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
}
@@ -724,8 +733,8 @@ sub B::PVNV::save {
$svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
$xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
if (defined($pv) && !$pv_copy_on_grow) {
- $init->add(savepvn(sprintf("xpvnv_list[%d].xpv_pv",
- $xpvnvsect->index), $pv));
+ my $pvx = $] < 5.009 ? "xpvnv_list[%d].xpv_pv" : "((sv)xpvnv_list[%d])->sv_u.svu_pv";
+ $init->add(savepvn(sprintf($pvx, $xpvnvsect->index), $pv));
}
return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
}
@@ -742,8 +751,8 @@ sub B::BM::save {
$svsect->add(sprintf("&xpvbm_list[%d], %lu, 0x%x",
$xpvbmsect->index, $sv->REFCNT , $sv->FLAGS));
$sv->save_magic;
- $init->add(savepvn(sprintf("xpvbm_list[%d].xpv_pv",
- $xpvbmsect->index), $pv),
+ my $pvx = $] < 5.009 ? "xpvbm_list[%d].xpv_pv" : "((sv)xpvbm_list[%d])->sv_u.svu_pv";
+ $init->add(savepvn(sprintf($pvx, $xpvbmsect->index), $pv),
sprintf("xpvbm_list[%d].xpv_cur = %u;",
$xpvbmsect->index, $len - 257));
return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
@@ -758,8 +767,8 @@ sub B::PV::save {
$svsect->add(sprintf("&xpv_list[%d], %lu, 0x%x",
$xpvsect->index, $sv->REFCNT , $sv->FLAGS));
if (defined($pv) && !$pv_copy_on_grow) {
- $init->add(savepvn(sprintf("xpv_list[%d].xpv_pv",
- $xpvsect->index), $pv));
+ my $pvx = $] < 5.009 ? "xpv_list[%d].xpv_pv" : "((sv)xpv_list[%d])->sv_u.svu_pv";
+ $init->add(savepvn(sprintf($pvx, $xpvsect->index), $pv));
}
return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
}
@@ -776,8 +785,8 @@ sub B::PVMG::save {
$svsect->add(sprintf("&xpvmg_list[%d], %lu, 0x%x",
$xpvmgsect->index, $sv->REFCNT , $sv->FLAGS));
if (defined($pv) && !$pv_copy_on_grow) {
- $init->add(savepvn(sprintf("xpvmg_list[%d].xpv_pv",
- $xpvmgsect->index), $pv));
+ my $pvx = $] < 5.009 ? "xpvmg_list[%d].xpv_pv" : "((sv)xpvmg_list[%d])->sv_u.svu_pv";
+ $init->add(savepvn(sprintf($pvx, $xpvmgsect->index), $pv));
}
$sym = savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
$sv->save_magic;
@@ -943,7 +952,7 @@ sub B::CV::save {
# are defined in IO.xs, so let's bootstrap it
svref_2object( \&IO::bootstrap )->save
if grep { $stashname eq $_ } qw(IO::File IO::Handle IO::Socket
- IO::Seekable IO::Poll);
+ IO::Seekable IO::Poll);
}
warn sprintf("stub for XSUB $cvstashname\:\:$cvname CV 0x%x\n", $$cv) if $debug_cv;
return qq/(perl_get_cv("$stashname\:\:$cvname",TRUE))/;
@@ -1010,7 +1019,7 @@ sub B::CV::save {
else {
warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
$cvstashname, $cvname); # debug
- }
+ }
$pv = '' unless defined $pv; # Avoid use of undef warnings
$symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, \"\", %d, s\\_%x, (CV*)s\\_%x, 0x%x, 0x%x",
$xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
@@ -1381,6 +1390,9 @@ sub output_all {
if ($lines) {
my $name = $section->name;
my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
+ if ($typename eq 'XPV' and $] >= 5.009) {
+ $typename = "SV";
+ }
print "Static $typename ${name}_list[$lines];\n";
}
}
@@ -1394,6 +1406,9 @@ sub output_all {
if ($lines) {
my $name = $section->name;
my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
+ if ($typename eq 'XPV' and $] >= 5.009) {
+ $typename = "SV";
+ }
printf "static %s %s_list[%u] = {\n", $typename, $name, $lines;
$section->output(\*STDOUT, "\t{ %s }, /* %d */\n");
print "};\n\n";
View
@@ -2,7 +2,7 @@ package ByteLoader;
use XSLoader ();
-our $VERSION = '0.07';
+our $VERSION = '0.06_01';
XSLoader::load 'ByteLoader', $VERSION;
View
@@ -1,6 +1,14 @@
+/* This loads bytecode in .plc files starting with PLBC.
+ Produce by the B::Bytecode compiler.
+ It might also be useful to use it for JIT or Asm compiled
+ PLJC .plc files where a full PE/COFF or elf format is not
+ supported nor wanted, or a full executable dump is not possible.
+*/
+
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#include "jitrun.h"
#include "byterun.h"
/* Something arbitary for a buffer size */
@@ -94,6 +102,8 @@ byteloader_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
bstate.bs_iv_overflows = 0;
/* KLUDGE */
+ /* byterun loads incrementally from DATA, jitrun might require the whole buffer at once.
+ best via mmap */
if (byterun(aTHX_ &bstate)
&& (len = SvCUR(data.datasv) - (STRLEN)data.next_out))
{
@@ -112,7 +122,7 @@ byteloader_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
PL_main_root->op_next = o;
PL_eval_root = newUNOP(OP_LEAVEEVAL, 0, PL_eval_root);
o->op_next = PL_eval_root;
-
+
PL_main_root = saveroot;
PL_main_start = savestart;
}
View
@@ -4,20 +4,24 @@ WriteMakefile(
NAME => 'ByteLoader',
VERSION_FROM => 'ByteLoader.pm',
XSPROTOARG => '-noprototypes',
- OBJECT => 'byterun$(OBJ_EXT) ByteLoader$(OBJ_EXT)',
+ OBJECT => 'byterun$(OBJ_EXT) jitrun$(OBJ_EXT) ByteLoader$(OBJ_EXT)',
);
sub MY::depend {
my $up = File::Spec->updir;
my $bytecode_pl = File::Spec->catdir( '..', 'bytecode.pl' );
+ my $jitcompiler_pl = File::Spec->catdir( '..', 'jitcompiler.pl' );
"
byterun.c : $bytecode_pl
cd $up && \$(PERL) bytecode.pl && cd ByteLoader
+jitrun.c : $bytecode_pl $jitcompiler_pl
+ cd $up && \$(PERL) jitcompiler.pl && cd ByteLoader
+
byterun.h : $bytecode_pl
cd $up && \$(PERL) bytecode.pl && cd ByteLoader
-ByteLoader\$(OBJ_EXT) : byterun.h byterun.c bytecode.h
+ByteLoader\$(OBJ_EXT) : byterun.h byterun.c jitrun.c bytecode.h
"
}
View
@@ -454,9 +454,13 @@ typedef HEK *hekindex;
U32 sz = 0; \
strconst str; \
\
- BGET_U32(sz); /* Magic: 'PLBC' */ \
+ BGET_U32(sz); /* Magic: 'PLBC' or 'PLJC' */ \
if (sz != 0x43424c50) { \
- HEADER_FAIL1("bad magic (want 0x43424c50, got %#x)", (int)sz); \
+ if (sz != 0x434a4c50) { \
+ HEADER_FAIL1("bad magic (want 0x43424c50 PLBC or 0x434a4c50 PLJC, got %#x)", (int)sz); \
+ } else { \
+ isjit = 1; \
+ } \
} \
BGET_strconst(str); /* archname */ \
if (strNE(str, ARCHNAME)) { \
View
@@ -50,28 +50,32 @@ bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
}
int
-byterun(pTHX_ register struct byteloader_state *bstate)
+byterun(pTHX_ struct byteloader_state *bstate)
{
register int insn;
+ U32 isjit = 0;
U32 ix;
SV *specialsv_list[6];
- BYTECODE_HEADER_CHECK; /* croak if incorrect platform */
- 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;
+ BYTECODE_HEADER_CHECK; /* croak if incorrect platform, set isjit if PLJC magic header */
+ if (isjit) {
+ return jitrun(aTHX_ &bstate);
+ } else {
+ 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;
- specialsv_list[0] = Nullsv;
- specialsv_list[1] = &PL_sv_undef;
- specialsv_list[2] = &PL_sv_yes;
- specialsv_list[3] = &PL_sv_no;
- specialsv_list[4] = (SV*)pWARN_ALL;
- specialsv_list[5] = (SV*)pWARN_NONE;
- specialsv_list[6] = (SV*)pWARN_STD;
+ specialsv_list[0] = Nullsv;
+ specialsv_list[1] = &PL_sv_undef;
+ specialsv_list[2] = &PL_sv_yes;
+ specialsv_list[3] = &PL_sv_no;
+ specialsv_list[4] = (SV*)pWARN_ALL;
+ specialsv_list[5] = (SV*)pWARN_NONE;
+ specialsv_list[6] = (SV*)pWARN_STD;
- while ((insn = BGET_FGETC()) != EOF) {
- switch (insn) {
+ while ((insn = BGET_FGETC()) != EOF) {
+ switch (insn) {
case INSN_COMMENT: /* 35 */
{
comment_t arg;
@@ -384,8 +388,6 @@ byterun(pTHX_ register struct byteloader_state *bstate)
*(SV**)&IoBOTTOM_GV(bstate->bs_sv) = arg;
break;
}
-#if PERL_VERSION < 10
-#endif
case INSN_XIO_TYPE: /* 46 */
{
char arg;
@@ -512,16 +514,13 @@ byterun(pTHX_ register struct byteloader_state *bstate)
AvMAX(bstate->bs_sv) = arg;
break;
}
-#if PERL_VERSION < 10
-#else
case INSN_XAV_FLAGS: /* 64 */
{
I32 arg;
BGET_I32(arg);
((XPVAV*)(SvANY(bstate->bs_sv)))->xiv_u.xivu_i32 = arg;
break;
}
-#endif
#if PERL_VERSION < 10
#endif
case INSN_XHV_NAME: /* 65 */
@@ -1104,10 +1103,11 @@ byterun(pTHX_ register struct byteloader_state *bstate)
PL_formfeed = arg;
break;
}
- default:
- Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
- /* NOTREACHED */
- }
+ default:
+ Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
+ /* NOTREACHED */
+ }
+ }
}
return 0;
}
View
@@ -39,7 +39,8 @@ struct byteloader_state {
int bl_getc(struct byteloader_fdata *);
int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
-extern int byterun(pTHX_ struct byteloader_state *);
+extern int byterun(pTHX_ register struct byteloader_state *);
+/*extern int jitrun(pTHX_ register struct byteloader_state *);*/
enum {
INSN_RET, /* 0 */
Oops, something went wrong.

0 comments on commit 67b941c

Please sign in to comment.