From: Malcolm Beattie Date: Tue, 17 Feb 1998 17:50:50 +0000 (+0000) Subject: [perlext] Assorted changes to the compiler X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1853469bd7bc4f59baf47a0eb2f44b3553f0a805;p=p5sagit%2Fp5-mst-13.2.git [perlext] Assorted changes to the compiler p4raw-id: //depot/perlext/Compiler@531 --- diff --git a/B.pm b/B.pm index 3878712..8545c5c 100644 --- a/B.pm +++ b/B.pm @@ -61,6 +61,7 @@ my @parents = (); sub debug { my ($class, $value) = @_; $debug = $value; + walkoptree_debug($value); } # sub OPf_KIDS; diff --git a/B.xs b/B.xs index b73464a..7291522 100644 --- a/B.xs +++ b/B.xs @@ -67,9 +67,10 @@ static char *opclassnames[] = { "B::COP" }; +static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */ + static opclass -cc_opclass(o) -OP * o; +cc_opclass(OP *o) { if (!o) return OPc_NULL; @@ -163,16 +164,13 @@ OP * o; } static char * -cc_opclassname(o) -OP * o; +cc_opclassname(OP *o) { return opclassnames[cc_opclass(o)]; } static SV * -make_sv_object(arg, sv) -SV *arg; -SV *sv; +make_sv_object(SV *arg, SV *sv) { char *type = 0; IV iv; @@ -192,17 +190,14 @@ SV *sv; } static SV * -make_mg_object(arg, mg) -SV *arg; -MAGIC *mg; +make_mg_object(SV *arg, MAGIC *mg) { sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg); return arg; } static SV * -cstring(sv) -SV *sv; +cstring(SV *sv) { SV *sstr = newSVpv("", 0); STRLEN len; @@ -255,8 +250,7 @@ SV *sv; } static SV * -cchar(sv) -SV *sv; +cchar(SV *sv) { SV *sstr = newSVpv("'", 0); char *s = SvPV(sv, na); @@ -295,9 +289,7 @@ SV *sv; } void * -bset_obj_store(obj, ix) -void *obj; -I32 ix; +bset_obj_store(void *obj, I32 ix) { if (ix > obj_list_fill) { if (obj_list_fill == -1) @@ -311,9 +303,7 @@ I32 ix; } #ifdef INDIRECT_BGET_MACROS -void freadpv(len, data) -U32 len; -void *data; +void freadpv(U32 len, void *data) { New(666, pv.xpv_pv, len, char); fread(pv.xpv_pv, 1, len, (FILE*)data); @@ -321,8 +311,7 @@ void *data; pv.xpv_cur = len - 1; } -void byteload_fh(fp) -FILE *fp; +void byteload_fh(FILE *fp) { struct bytestream bs; bs.data = fp; @@ -332,18 +321,14 @@ FILE *fp; byterun(bs); } -static int fgetc_fromstring(data) -void *data; +static int fgetc_fromstring(void *data) { char **strp = (char **)data; return *(*strp)++; } -static int fread_fromstring(argp, elemsize, nelem, data) -char *argp; -size_t elemsize; -size_t nelem; -void *data; +static int fread_fromstring(char *argp, size_t elemsize, size_t nelem, + void *data) { char **strp = (char **)data; size_t len = elemsize * nelem; @@ -353,9 +338,7 @@ void *data; return (int)len; } -static void freadpv_fromstring(len, data) -U32 len; -void *data; +static void freadpv_fromstring(U32 len, void *data) { char **strp = (char **)data; @@ -366,8 +349,7 @@ void *data; *strp += len; } -void byteload_string(str) -char *str; +void byteload_string(char *str) { struct bytestream bs; bs.data = &str; @@ -377,23 +359,19 @@ char *str; byterun(bs); } #else -void byteload_fh(fp) -FILE *fp; +void byteload_fh(FILE *fp) { byterun(fp); } -void byteload_string(str) -char *str; +void byteload_string(char *str) { croak("Must compile with -DINDIRECT_BGET_MACROS for byteload_string"); } #endif /* INDIRECT_BGET_MACROS */ void -walkoptree(opsv, method) -SV *opsv; -char *method; +walkoptree(SV *opsv, char *method) { dSP; OP *o; @@ -402,6 +380,12 @@ char *method; croak("opsv is not a reference"); opsv = sv_mortalcopy(opsv); o = (OP*)SvIV((SV*)SvRV(opsv)); + if (walkoptree_debug) { + PUSHMARK(sp); + XPUSHs(opsv); + PUTBACK; + perl_call_method("walkoptree_debug", G_DISCARD); + } PUSHMARK(sp); XPUSHs(opsv); PUTBACK; @@ -487,6 +471,15 @@ walkoptree(opsv, method) char * method int +walkoptree_debug(...) + CODE: + RETVAL = walkoptree_debug; + if (items > 0 && SvTRUE(ST(1))) + walkoptree_debug = 1; + OUTPUT: + RETVAL + +int byteload_fh(fp) FILE * fp CODE: diff --git a/B/Bytecode.pm b/B/Bytecode.pm index 81d00b3..4fb42ac 100644 --- a/B/Bytecode.pm +++ b/B/Bytecode.pm @@ -1,6 +1,6 @@ # Bytecode.pm # -# Copyright (c) 1996 Malcolm Beattie +# Copyright (c) 1996-1998 Malcolm Beattie # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the README file. @@ -8,6 +8,7 @@ package B::Bytecode; use strict; use Carp; +use IO::File; use B qw(minus_c main_cv main_root main_start comppadlist class peekop walkoptree svref_2object cstring walksymtable); @@ -28,7 +29,7 @@ sub POK () { 0x04040000 } # XXX Shouldn't be hardwired sub IOK () { 0x01010000 } -my ($verbose, $module_only, $no_assemble, $debug_cv); +my ($verbose, $module_only, $no_assemble, $debug_bc, $debug_cv); my $assembler_pid; # Optimisation options. On the command line, use hyphens instead of @@ -101,8 +102,7 @@ sub saved { $saved{${$_[0]}} } sub mark_saved { $saved{${$_[0]}} = 1 } sub unmark_saved { $saved{${$_[0]}} = 0 } -my $debug = 0; -sub debug { $debug = shift } +sub debug { $debug_bc = shift } sub B::OBJECT::nyi { my $obj = shift; @@ -169,6 +169,11 @@ sub B::OP::newix { stop($ix); } +sub B::OP::walkoptree_debug { + my $op = shift; + warn(sprintf("walkoptree: %s\n", peekop($op))); +} + sub B::OP::bytecode { my $op = shift; my $next = $op->next; @@ -182,7 +187,7 @@ sub B::OP::bytecode { } $nextix = $next->objix; - printf "# %s\n", peekop($op) if $debug; + printf "# %s\n", peekop($op) if $debug_bc; ldop($ix); print "op_next $nextix\n"; print "op_sibling $sibix\n" unless $strip_syntree; @@ -286,7 +291,7 @@ sub B::COP::bytecode { my $filegv = $op->filegv; my $filegvix = $filegv->objix; my $line = $op->line; - if ($debug) { + if ($debug_bc) { printf "# line %s:%d\n", $filegv->SV->PV, $line; } $op->B::OP::bytecode; @@ -305,8 +310,6 @@ EOT sub B::PMOP::bytecode { my $op = shift; - my $short = $op->pmshort; - my $shortix = $short->objix; my $replroot = $op->pmreplroot; my $replrootix = $replroot->objix; my $replstartix = $op->pmreplstart->objix; @@ -314,7 +317,6 @@ sub B::PMOP::bytecode { # pmnext is corrupt in some PMOPs (see misc.t for example) #my $pmnextix = $op->pmnext->objix; - $short->bytecode; if ($$replroot) { # OP_PUSHRE (a mutated version of OP_MATCH for the regexp # argument to a split) stores a GV in op_pmreplroot instead @@ -333,11 +335,9 @@ sub B::PMOP::bytecode { } my $re = pvstring($op->precomp); # op_pmnext omitted since a perl bug means it's sometime corrupt - printf <<"EOT", $op->pmflags, $op->pmpermflags, $op->pmslen; -op_pmshort $shortix + printf <<"EOT", $op->pmflags, $op->pmpermflags; op_pmflags 0x%x op_pmpermflags 0x%x -op_pmslen %d newpv $re pregcomp EOT @@ -651,13 +651,19 @@ sub bytecompile_main { my $curpadix = $curpad->objix; $curpad->bytecode; walkoptree(main_root, "bytecode"); + warn "done main program, now walking symbol table\n" if $debug_bc; my ($pack, %exclude); - foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS - strict vars FileHandle Exporter Carp)) { + foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS strict vars + FileHandle Exporter Carp UNIVERSAL IO Fcntl Symbol + SelectSaver blib Cwd)) + { $exclude{$pack."::"} = 1; } no strict qw(vars refs); - walksymtable(\%{"main::"}, "bytecodecv",sub { !defined($exclude{$_[0]}) }); + walksymtable(\%{"main::"}, "bytecodecv", sub { + warn "considering $_[0]\n" if $debug_bc; + return !defined($exclude{$_[0]}); + }); if (!$module_only) { printf "main_root %d\n", main_root->objix; printf "main_start %d\n", main_start->objix; @@ -666,28 +672,23 @@ sub bytecompile_main { } } -sub prepare_output { - # Plumbing for output - if (!$no_assemble) { - pipe(READER, WRITER) or die "pipe: $!\n"; - $assembler_pid = fork(); - die "fork: $!\n" unless defined($assembler_pid); - if ($assembler_pid) { - # parent - close WRITER; - assemble_fh(\*READER, sub { print @_ }); - exit(0); - } else { - # child - close READER; - open(STDOUT, ">&WRITER") or die "dup: $!\n"; - } - } +sub prepare_assemble { + my $newfh = IO::File->new_tmpfile; + select($newfh); + return $newfh; +} + +sub do_assemble { + my $fh = shift; + seek($fh, 0, 0); # rewind the temporary file + assemble_fh($fh, sub { print OUT @_ }); } sub compile { my @options = @_; my ($option, $opt, $arg); + open(OUT, ">&STDOUT"); + select(OUT); OPTION: while ($option = shift @options) { if ($option =~ /^-(.)(.*)/) { @@ -702,11 +703,14 @@ sub compile { last OPTION; } elsif ($opt eq "o") { $arg ||= shift @options; - open(STDOUT, ">$arg") or return "$arg: $!\n"; + open(OUT, ">$arg") or return "$arg: $!\n"; } elsif ($opt eq "D") { $arg ||= shift @options; foreach $arg (split(//, $arg)) { - if ($arg eq "o") { + if ($arg eq "b") { + $| = 1; + debug(1); + } elsif ($arg eq "o") { B->debug(1); } elsif ($arg eq "a") { B::Assembler::debug(1); @@ -751,17 +755,19 @@ sub compile { if (@options) { return sub { my $objname; - prepare_output(); + my $newfh; + $newfh = prepare_assemble() unless $no_assemble; foreach $objname (@options) { eval "bytecompile_object(\\$objname)"; } - waitpid($assembler_pid, 0) if defined($assembler_pid); + do_assemble($newfh) unless $no_assemble; } } else { return sub { - prepare_output(); + my $newfh; + $newfh = prepare_assemble() unless $no_assemble; bytecompile_main(); - waitpid($assembler_pid, 0) if defined($assembler_pid); + do_assemble($newfh) unless $no_assemble; } } } diff --git a/B/C.pm b/B/C.pm index 6443893..e0186ef 100644 --- a/B/C.pm +++ b/B/C.pm @@ -746,7 +746,7 @@ sub B::AV::save { "\tav_extend(av, $fill);", "\tsvp = AvARRAY(av);", map("\t*svp++ = (SV*)$_;", @names), - "\tAvFILL(av) = $fill;", + "\tAvFILLp(av) = $fill;", "}"); } else { my $max = $av->MAX; diff --git a/B/Debug.pm b/B/Debug.pm index 1a78f39..d88cef3 100644 --- a/B/Debug.pm +++ b/B/Debug.pm @@ -59,9 +59,7 @@ sub B::PMOP::debug { printf "\top_pmreplstart\t0x%x\n", ${$op->pmreplstart}; printf "\top_pmnext\t0x%x\n", ${$op->pmnext}; printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp); - printf "\top_pmshort\t0x%x\n", ${$op->pmshort}; printf "\top_pmflags\t0x%x\n", $op->pmflags; - printf "\top_pmslen\t%d\n", $op->pmslen; $op->pmshort->debug; $op->pmreplroot->debug; } diff --git a/NOTES b/NOTES index 7640e54..ee10ba0 100644 --- a/NOTES +++ b/NOTES @@ -126,6 +126,7 @@ Bytecode backend invocation -O6 adds -fstrip-syntax-tree. -D Debug options (concat or separate flags like perl -D) o OPs, prints each OP as it's processed. + b print debugging information about bytecompiler progress a tells the assembler to include source assembler lines in its output as bytecode comments. C prints each CV taken from the final symbol tree walk. diff --git a/O.pm b/O.pm index cc9f7f9..40d336e 100644 --- a/O.pm +++ b/O.pm @@ -2,15 +2,13 @@ package O; use B qw(minus_c); use Carp; -my $compilesub; - sub import { my ($class, $backend, @options) = @_; eval "use B::$backend ()"; if ($@) { croak "use of backend $backend failed: $@"; } - $compilesub = &{"B::${backend}::compile"}(@options); + my $compilesub = &{"B::${backend}::compile"}(@options); if (ref($compilesub) eq "CODE") { minus_c; eval 'END { &$compilesub() }'; diff --git a/bytecode.pl b/bytecode.pl index 0dd7c1e..d753213 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -310,7 +310,7 @@ xcv_outside *(SV**)&CvOUTSIDE(sv) svindex xcv_flags CvFLAGS(sv) U8 av_extend sv SSize_t x av_push sv svindex x -xav_fill AvFILL(sv) SSize_t +xav_fill AvFILLp(sv) SSize_t xav_max AvMAX(sv) SSize_t xav_flags AvFLAGS(sv) U8 xhv_riter HvRITER(sv) I32 diff --git a/byterun.c b/byterun.c index 6b242e5..3d4b64f 100644 --- a/byterun.c +++ b/byterun.c @@ -405,7 +405,7 @@ FILE *fp; { SSize_t arg; BGET_I32(arg); - AvFILL(sv) = arg; + AvFILLp(sv) = arg; break; } case INSN_XAV_MAX: /* 56 */ diff --git a/typemap b/typemap index ed4aecc..7206a6a 100644 --- a/typemap +++ b/typemap @@ -62,7 +62,7 @@ T_OP_OBJ sv_setiv(newSVrv($arg, cc_opclassname((OP*)$var)), (IV)$var); T_SV_OBJ - make_sv_object(($arg), ($var)); + make_sv_object(($arg), (SV*)($var)); T_MG_OBJ