# CC.pm
#
-# Copyright (c) 1996, 1997 Malcolm Beattie
+# Copyright (c) 1996, 1997, 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.
package B::CC;
use strict;
use B qw(main_start main_root class comppadlist peekop svref_2object
- timing_info);
-use B::C qw(save_unused_subs objsym init_sections
+ timing_info init_av
+ OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL
+ OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV
+ OPpDEREF OPpFLIP_LINENUM G_ARRAY
+ CXt_NULL CXt_SUB CXt_EVAL CXt_LOOP CXt_SUBST CXt_BLOCK
+ );
+use B::C qw(save_unused_subs objsym init_sections mark_unused
output_all output_boilerplate output_main);
use B::Bblock qw(find_leaders);
use B::Stackobj qw(:types :flags);
# These should probably be elsewhere
# Flags for $op->flags
-sub OPf_LIST () { 1 }
-sub OPf_KNOW () { 2 }
-sub OPf_MOD () { 32 }
-sub OPf_STACKED () { 64 }
-sub OPf_SPECIAL () { 128 }
-# op-specific flags for $op->private
-sub OPpASSIGN_BACKWARDS () { 64 }
-sub OPpLVAL_INTRO () { 128 }
-sub OPpDEREF_AV () { 32 }
-sub OPpDEREF_HV () { 64 }
-sub OPpDEREF () { OPpDEREF_AV|OPpDEREF_HV }
-sub OPpFLIP_LINENUM () { 64 }
-sub G_ARRAY () { 1 }
-# cop.h
-sub CXt_NULL () { 0 }
-sub CXt_SUB () { 1 }
-sub CXt_EVAL () { 2 }
-sub CXt_LOOP () { 3 }
-sub CXt_SUBST () { 4 }
-sub CXt_BLOCK () { 5 }
my $module; # module name (when compiled with -m)
my %done; # hash keyed by $$op of leaders of basic blocks
my %skip_lexicals; # Hash of PP names which don't need write_back_lexicals
my %skip_invalidate; # Hash of PP names which don't need invalidate_lexicals
my %ignore_op; # Hash of ops which do nothing except returning op_next
+my %need_curcop; # Hash of ops which need PL_curcop
BEGIN {
foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) {
}
}
-my @unused_sub_packages; # list of packages (given by -u options) to search
- # explicitly and save every sub we find there, even
- # if apparently unused (could be only referenced from
- # an eval "" or from a $SIG{FOO} = "bar").
-
my ($module_name);
my ($debug_op, $debug_stack, $debug_cxstack, $debug_pad, $debug_runtime,
$debug_shadow, $debug_queue, $debug_lineno, $debug_timings);
#
%skip_lexicals = init_hash qw(pp_enter pp_enterloop);
%skip_invalidate = init_hash qw(pp_enter pp_enterloop);
+%need_curcop = init_hash qw(pp_rv2gv pp_bless pp_repeat pp_sort pp_caller pp_reset pp_rv2cv pp_entereval pp_require pp_dofile pp_entertry pp_enterloop pp_enteriter );
sub debug {
if ($debug_runtime) {
sub top_double { @stack ? $stack[-1]->as_double : "TOPn" }
sub top_numeric { @stack ? $stack[-1]->as_numeric : "TOPn" }
sub top_sv { @stack ? $stack[-1]->as_sv : "TOPs" }
-sub top_bool { @stack ? $stack[-1]->as_numeric : "SvTRUE(TOPs)" }
+sub top_bool { @stack ? $stack[-1]->as_bool : "SvTRUE(TOPs)" }
sub pop_int { @stack ? (pop @stack)->as_int : "POPi" }
sub pop_double { @stack ? (pop @stack)->as_double : "POPn" }
sub pop_sv { @stack ? (pop @stack)->as_sv : "POPs" }
sub pop_bool {
if (@stack) {
- return ((pop @stack)->as_numeric);
+ return ((pop @stack)->as_bool);
} else {
# Careful: POPs has an auto-decrement and SvTRUE evaluates
# its argument more than once.
}
my $curcop = new B::Shadow (sub {
my $opsym = shift->save;
- runtime("curcop = (COP*)$opsym;");
+ runtime("PL_curcop = (COP*)$opsym;");
});
#
sub dopoptolabel {
my $label = shift;
my $cxix = $#cxstack;
- while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP
- && $cxstack[$cxix]->{label} ne $label) {
+ while ($cxix >= 0 &&
+ ($cxstack[$cxix]->{type} != CXt_LOOP ||
+ $cxstack[$cxix]->{label} ne $label)) {
$cxix--;
}
debug "dopoptolabel: returning $cxix" if $debug_cxstack;
my $name = "tmp$ix";
my $class = class($namesv);
if (!defined($namesv) || $class eq "SPECIAL") {
- # temporaries have &sv_undef instead of a PVNV for a name
+ # temporaries have &PL_sv_undef instead of a PVNV for a name
$flags = VALID_SV|TEMPORARY|REGISTER;
} else {
if ($namesv->PV =~ /^\$(.*)_([di])(r?)$/) {
"i_$name", "d_$name");
declare("IV", $type == T_INT ? "i_$name = 0" : "i_$name");
declare("double", $type == T_DOUBLE ? "d_$name = 0" : "d_$name");
- debug sprintf("curpad[$ix] = %s\n", $pad[$ix]->peek) if $debug_pad;
+ debug sprintf("PL_curpad[$ix] = %s\n", $pad[$ix]->peek) if $debug_pad;
}
}
sub loadop {
my $op = shift;
my $opsym = $op->save;
- runtime("op = $opsym;") unless $know_op;
+ runtime("PL_op = $opsym;") unless $know_op;
return $opsym;
}
sub gimme {
my $op = shift;
my $flags = $op->flags;
- return (($flags & OPf_KNOW) ? ($flags & OPf_LIST) : "dowantarray()");
+ return (($flags & OPf_WANT) ? ($flags & OPf_WANT_LIST) : "dowantarray()");
}
#
if ($gimme != 1) {
# XXX Change to push a constant sv_undef Stackobj onto @stack
write_back_stack();
- runtime("if ($gimme != G_ARRAY) XPUSHs(&sv_undef);");
+ runtime("if ($gimme != G_ARRAY) XPUSHs(&PL_sv_undef);");
}
return $op->next;
}
if (@stack >= 1) {
my $bool = pop_bool();
write_back_stack();
- runtime(sprintf("if (!$bool) goto %s;", label($next)));
+ runtime(sprintf("if (!$bool) {XPUSHs(&PL_sv_no); goto %s;}", label($next)));
} else {
runtime(sprintf("if (!%s) goto %s;", top_bool(), label($next)),
"*sp--;");
reload_lexicals();
unshift(@bblock_todo, $next);
if (@stack >= 1) {
- my $obj = pop @stack;
+ my $bool = pop_bool @stack;
write_back_stack();
- runtime(sprintf("if (%s) { XPUSHs(%s); goto %s; }",
- $obj->as_numeric, $obj->as_sv, label($next)));
+ runtime(sprintf("if (%s) { XPUSHs(&PL_sv_yes); goto %s; }",
+ $bool, label($next)));
} else {
runtime(sprintf("if (%s) goto %s;", top_bool(), label($next)),
"*sp--;");
if ($op->flags & OPf_MOD) {
my $private = $op->private;
if ($private & OPpLVAL_INTRO) {
- runtime("SAVECLEARSV(curpad[$ix]);");
+ runtime("SAVECLEARSV(PL_curpad[$ix]);");
} elsif ($private & OPpDEREF) {
- runtime(sprintf("vivify_ref(curpad[%d], %d);",
+ runtime(sprintf("vivify_ref(PL_curpad[%d], %d);",
$ix, $private & OPpDEREF));
$pad[$ix]->invalidate;
}
@stack = ();
debug(sprintf("%s:%d\n", $op->filegv->SV->PV, $op->line)) if $debug_lineno;
runtime("TAINT_NOT;") unless $omit_taint;
- runtime("sp = stack_base + cxstack[cxstack_ix].blk_oldsp;");
+ runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;");
if ($freetmps_each_bblock || $freetmps_each_loop) {
$need_freetmps = 1;
} else {
return default_pp($op);
}
-sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
-sub pp_bless { $curcop->write_back; default_pp(@_) }
-sub pp_repeat { $curcop->write_back; default_pp(@_) }
+#default_pp will handle this:
+#sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
+#sub pp_bless { $curcop->write_back; default_pp(@_) }
+#sub pp_repeat { $curcop->write_back; default_pp(@_) }
# The following subs need $curcop->write_back if we decide to support arybase:
# pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
-sub pp_sort { $curcop->write_back; default_pp(@_) }
-sub pp_caller { $curcop->write_back; default_pp(@_) }
-sub pp_reset { $curcop->write_back; default_pp(@_) }
+#sub pp_sort { $curcop->write_back; default_pp(@_) }
+#sub pp_caller { $curcop->write_back; default_pp(@_) }
+#sub pp_reset { $curcop->write_back; default_pp(@_) }
sub pp_gv {
my $op = shift;
my $flag = $op->flags & OPf_MOD;
write_back_stack();
runtime("svp = av_fetch(GvAV($gvsym), $ix, $flag);",
- "PUSHs(svp ? *svp : &sv_undef);");
+ "PUSHs(svp ? *svp : &PL_sv_undef);");
return $op->next;
}
}
} else {
if ($force_int) {
+ my $rightruntime = new B::Pseudoreg ("IV", "riv");
+ runtime(sprintf("$$rightruntime = %s;",$right));
runtime(sprintf("sv_setiv(TOPs, %s);",
- &$operator("TOPi", $right)));
+ &$operator("TOPi", $$rightruntime)));
} else {
+ my $rightruntime = new B::Pseudoreg ("double", "rnv");
+ runtime(sprintf("$$rightruntime = %s;",$right));
runtime(sprintf("sv_setnv(TOPs, %s);",
- &$operator("TOPn", $right)));
+ &$operator("TOPn",$$rightruntime)));
}
}
} else {
if ($backwards) {
my $src = pop @stack;
my $type = $src->{type};
- runtime("if (tainting && tainted) TAINT_NOT;");
+ runtime("if (PL_tainting && PL_tainted) TAINT_NOT;");
if ($type == T_INT) {
runtime sprintf("sv_setiv(TOPs, %s);", $src->as_int);
} elsif ($type == T_DOUBLE) {
}
runtime("SvSETMAGIC(TOPs);");
} else {
- my $dst = pop @stack;
+ my $dst = $stack[-1];
my $type = $dst->{type};
runtime("sv = POPs;");
runtime("MAYBE_TAINT_SASSIGN_SRC(sv);");
write_back_lexicals(REGISTER|TEMPORARY);
write_back_stack();
my $sym = doop($op);
- runtime("if (op != ($sym)->op_next) op = (*op->op_ppaddr)(ARGS);");
- runtime("SPAGAIN;");
+ runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
+ runtime("PL_op = (*PL_op->op_ppaddr)(ARGS);");
+ runtime("SPAGAIN;}");
$know_op = 0;
invalidate_lexicals(REGISTER|TEMPORARY);
return $op->next;
}
+sub pp_goto{
+
+ my $op = shift;
+ my $ppname = $op->ppaddr;
+ write_back_lexicals() unless $skip_lexicals{$ppname};
+ write_back_stack() unless $skip_stack{$ppname};
+ my $sym=doop($op);
+ runtime("if (PL_op != ($sym)->op_next && PL_op != (OP*)0){return PL_op;}");
+ invalidate_lexicals() unless $skip_invalidate{$ppname};
+ return $op->next;
+}
sub pp_enterwrite {
my $op = shift;
pp_entersub($op);
my $sym = doop($op);
# XXX Is this the right way to distinguish between it returning
# CvSTART(cv) (via doform) and pop_return()?
- runtime("if (op) op = (*op->op_ppaddr)(ARGS);");
+ runtime("if (PL_op) PL_op = (*PL_op->op_ppaddr)(ARGS);");
runtime("SPAGAIN;");
$know_op = 0;
invalidate_lexicals(REGISTER|TEMPORARY);
# around that, we hack op_next to be our own op (purely because we
# know it's a non-NULL pointer and can't be the same as op_other).
$init->add("((LOGOP*)$sym)->op_next = $sym;");
- runtime(sprintf("if (op == ($sym)->op_next) goto %s;", label($next)));
+ runtime(sprintf("if (PL_op == ($sym)->op_next) goto %s;", label($next)));
$know_op = 0;
return $op->other;
}
write_back_lexicals(REGISTER|TEMPORARY);
write_back_stack();
doop($op);
- runtime("PUTBACK;", "return 0;");
+ runtime("PUTBACK;", "return PL_op;");
$know_op = 0;
return $op->next;
}
sub pp_range {
my $op = shift;
my $flags = $op->flags;
- if (!($flags & OPf_KNOW)) {
+ if (!($flags & OPf_WANT)) {
error("context of range unknown at compile-time");
}
write_back_lexicals();
write_back_stack();
- if (!($flags & OPf_LIST)) {
+ if (!($flags & OPf_WANT_LIST)) {
# We need to save our UNOP structure since pp_flop uses
# it to find and adjust out targ. We don't need it ourselves.
$op->save;
- runtime sprintf("if (SvTRUE(curpad[%d])) goto %s;",
+ runtime sprintf("if (SvTRUE(PL_curpad[%d])) goto %s;",
$op->targ, label($op->false));
unshift(@bblock_todo, $op->false);
}
sub pp_flip {
my $op = shift;
my $flags = $op->flags;
- if (!($flags & OPf_KNOW)) {
+ if (!($flags & OPf_WANT)) {
error("context of flip unknown at compile-time");
}
- if ($flags & OPf_LIST) {
+ if ($flags & OPf_WANT_LIST) {
return $op->first->false;
}
write_back_lexicals();
my $ix = $op->targ;
my $rangeix = $op->first->targ;
runtime(($op->private & OPpFLIP_LINENUM) ?
- "if (last_in_gv && SvIV(TOPs) == IoLINES(GvIOp(last_in_gv))) {"
+ "if (PL_last_in_gv && SvIV(TOPs) == IoLINES(GvIOp(PL_last_in_gv))) {"
: "if (SvTRUE(TOPs)) {");
- runtime("\tsv_setiv(curpad[$rangeix], 1);");
+ runtime("\tsv_setiv(PL_curpad[$rangeix], 1);");
if ($op->flags & OPf_SPECIAL) {
- runtime("sv_setiv(curpad[$ix], 1);");
+ runtime("sv_setiv(PL_curpad[$ix], 1);");
} else {
- runtime("\tsv_setiv(curpad[$ix], 0);",
+ runtime("\tsv_setiv(PL_curpad[$ix], 0);",
"\tsp--;",
sprintf("\tgoto %s;", label($op->first->false)));
}
runtime("}",
- qq{sv_setpv(curpad[$ix], "");},
- "SETs(curpad[$ix]);");
+ qq{sv_setpv(PL_curpad[$ix], "");},
+ "SETs(PL_curpad[$ix]);");
$know_op = 0;
return $op->next;
}
my $sym = doop($op);
my $replroot = $op->pmreplroot;
if ($$replroot) {
- runtime sprintf("if (op == ((PMOP*)(%s))->op_pmreplroot) goto %s;",
+ runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplroot) goto %s;",
$sym, label($replroot));
$op->pmreplstart->save;
push(@bblock_todo, $replroot);
write_back_stack();
doop($op);
my $pmop = $op->other;
- warn sprintf("substcont: op = %s, pmop = %s\n",
- peekop($op), peekop($pmop));#debug
-# my $pmopsym = objsym($pmop);
+ # warn sprintf("substcont: op = %s, pmop = %s\n",
+ # peekop($op), peekop($pmop));#debug
+# my $pmopsym = objsym($pmop);
my $pmopsym = $pmop->save; # XXX can this recurse?
- warn "pmopsym = $pmopsym\n";#debug
- runtime sprintf("if (op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
+# warn "pmopsym = $pmopsym\n";#debug
+ runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
$pmopsym, label($pmop->pmreplstart));
invalidate_lexicals();
return $pmop->next;
sub default_pp {
my $op = shift;
my $ppname = $op->ppaddr;
+ if ($curcop and $need_curcop{$ppname}){
+ $curcop->write_back;
+ }
write_back_lexicals() unless $skip_lexicals{$ppname};
write_back_stack() unless $skip_stack{$ppname};
doop($op);
$need_freetmps = 0;
}
if (!$$op) {
- runtime("PUTBACK;", "return 0;");
+ runtime("PUTBACK;","return PL_op;");
} elsif ($done{$$op}) {
runtime(sprintf("goto %s;", label($op)));
}
sub cc_main {
my @comppadlist = comppadlist->ARRAY;
- my $curpad_sym = $comppadlist[1]->save;
+ my $curpad_nam = $comppadlist[0]->save;
+ my $curpad_sym = $comppadlist[1]->save;
+ my $init_av = init_av->save;
+ my $inc_hv = svref_2object(\%INC)->save;
+ my $inc_av = svref_2object(\@INC)->save;
my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
- save_unused_subs(@unused_sub_packages);
+ save_unused_subs();
cc_recurse();
return if $errors;
if (!defined($module)) {
- $init->add(sprintf("main_root = s\\_%x;", ${main_root()}),
- "main_start = $start;",
- "curpad = AvARRAY($curpad_sym);");
+ $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
+ "PL_main_start = $start;",
+ "PL_curpad = AvARRAY($curpad_sym);",
+ "PL_initav = $init_av;",
+ "GvHV(PL_incgv) = $inc_hv;",
+ "GvAV(PL_incgv) = $inc_av;",
+ "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
+ "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
+ );
+
}
+ seek(STDOUT,0,0); #prevent print statements from BEGIN{} into the output
output_boilerplate();
print "\n";
output_all("perl_init");
perl_init();
ENTER;
SAVETMPS;
- SAVESPTR(curpad);
- SAVESPTR(op);
- curpad = AvARRAY($curpad_sym);
- op = $start;
+ SAVESPTR(PL_curpad);
+ SAVESPTR(PL_op);
+ PL_curpad = AvARRAY($curpad_sym);
+ PL_op = $start;
pp_main(ARGS);
FREETMPS;
LEAVE;
- ST(0) = &sv_yes;
+ ST(0) = &PL_sv_yes;
XSRETURN(1);
}
EOT
$module_name = $arg;
} elsif ($opt eq "u") {
$arg ||= shift @options;
- push(@unused_sub_packages, $arg);
+ mark_unused($arg,undef);
} elsif ($opt eq "f") {
$arg ||= shift @options;
my $value = $arg !~ s/^no-//;
} elsif ($opt eq "m") {
$arg ||= shift @options;
$module = $arg;
- push(@unused_sub_packages, $arg);
+ mark_unused($arg,undef);
} elsif ($opt eq "p") {
$arg ||= shift @options;
$patchlevel = $arg;
}
1;
+
+__END__
+
+=head1 NAME
+
+B::CC - Perl compiler's optimized C translation backend
+
+=head1 SYNOPSIS
+
+ perl -MO=CC[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend takes Perl source and generates C source code
+corresponding to the flow of your program. In other words, this
+backend is somewhat a "real" compiler in the sense that many people
+think about compilers. Note however that, currently, it is a very
+poor compiler in that although it generates (mostly, or at least
+sometimes) correct code, it performs relatively few optimisations.
+This will change as the compiler develops. The result is that
+running an executable compiled with this backend may start up more
+quickly than running the original Perl program (a feature shared
+by the B<C> compiler backend--see F<B::C>) and may also execute
+slightly faster. This is by no means a good optimising compiler--yet.
+
+=head1 OPTIONS
+
+If there are any non-option arguments, they are taken to be
+names of objects to be saved (probably doesn't work properly yet).
+Without extra arguments, it saves the main program.
+
+=over 4
+
+=item B<-ofilename>
+
+Output to filename instead of STDOUT
+
+=item B<-v>
+
+Verbose compilation (currently gives a few compilation statistics).
+
+=item B<-->
+
+Force end of options
+
+=item B<-uPackname>
+
+Force apparently unused subs from package Packname to be compiled.
+This allows programs to use eval "foo()" even when sub foo is never
+seen to be used at compile time. The down side is that any subs which
+really are never used also have code generated. This option is
+necessary, for example, if you have a signal handler foo which you
+initialise with C<$SIG{BAR} = "foo">. A better fix, though, is just
+to change it to C<$SIG{BAR} = \&foo>. You can have multiple B<-u>
+options. The compiler tries to figure out which packages may possibly
+have subs in which need compiling but the current version doesn't do
+it very well. In particular, it is confused by nested packages (i.e.
+of the form C<A::B>) where package C<A> does not contain any subs.
+
+=item B<-mModulename>
+
+Instead of generating source for a runnable executable, generate
+source for an XSUB module. The boot_Modulename function (which
+DynaLoader can look for) does the appropriate initialisation and runs
+the main part of the Perl source that is being compiled.
+
+
+=item B<-D>
+
+Debug options (concatenated or separate flags like C<perl -D>).
+
+=item B<-Dr>
+
+Writes debugging output to STDERR just as it's about to write to the
+program's runtime (otherwise writes debugging info as comments in
+its C output).
+
+=item B<-DO>
+
+Outputs each OP as it's compiled
+
+=item B<-Ds>
+
+Outputs the contents of the shadow stack at each OP
+
+=item B<-Dp>
+
+Outputs the contents of the shadow pad of lexicals as it's loaded for
+each sub or the main program.
+
+=item B<-Dq>
+
+Outputs the name of each fake PP function in the queue as it's about
+to process it.
+
+=item B<-Dl>
+
+Output the filename and line number of each original line of Perl
+code as it's processed (C<pp_nextstate>).
+
+=item B<-Dt>
+
+Outputs timing information of compilation stages.
+
+=item B<-f>
+
+Force optimisations on or off one at a time.
+
+=item B<-ffreetmps-each-bblock>
+
+Delays FREETMPS from the end of each statement to the end of the each
+basic block.
+
+=item B<-ffreetmps-each-loop>
+
+Delays FREETMPS from the end of each statement to the end of the group
+of basic blocks forming a loop. At most one of the freetmps-each-*
+options can be used.
+
+=item B<-fomit-taint>
+
+Omits generating code for handling perl's tainting mechanism.
+
+=item B<-On>
+
+Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
+Currently, B<-O1> sets B<-ffreetmps-each-bblock> and B<-O2>
+sets B<-ffreetmps-each-loop>.
+
+=back
+
+=head1 EXAMPLES
+
+ perl -MO=CC,-O2,-ofoo.c foo.pl
+ perl cc_harness -o foo foo.c
+
+Note that C<cc_harness> lives in the C<B> subdirectory of your perl
+library directory. The utility called C<perlcc> may also be used to
+help make use of this compiler.
+
+ perl -MO=CC,-mFoo,-oFoo.c Foo.pm
+ perl cc_harness -shared -c -o Foo.so Foo.c
+
+=head1 BUGS
+
+Plenty. Current status: experimental.
+
+=head1 DIFFERENCES
+
+These aren't really bugs but they are constructs which are heavily
+tied to perl's compile-and-go implementation and with which this
+compiler backend cannot cope.
+
+=head2 Loops
+
+Standard perl calculates the target of "next", "last", and "redo"
+at run-time. The compiler calculates the targets at compile-time.
+For example, the program
+
+ sub skip_on_odd { next NUMBER if $_[0] % 2 }
+ NUMBER: for ($i = 0; $i < 5; $i++) {
+ skip_on_odd($i);
+ print $i;
+ }
+
+produces the output
+
+ 024
+
+with standard perl but gives a compile-time error with the compiler.
+
+=head2 Context of ".."
+
+The context (scalar or array) of the ".." operator determines whether
+it behaves as a range or a flip/flop. Standard perl delays until
+runtime the decision of which context it is in but the compiler needs
+to know the context at compile-time. For example,
+
+ @a = (4,6,1,0,0,1);
+ sub range { (shift @a)..(shift @a) }
+ print range();
+ while (@a) { print scalar(range()) }
+
+generates the output
+
+ 456123E0
+
+with standard Perl but gives a compile-time error with compiled Perl.
+
+=head2 Arithmetic
+
+Compiled Perl programs use native C arithemtic much more frequently
+than standard perl. Operations on large numbers or on boundary
+cases may produce different behaviour.
+
+=head2 Deprecated features
+
+Features of standard perl such as C<$[> which have been deprecated
+in standard perl since Perl5 was released have not been implemented
+in the compiler.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff