Minor updates of the charnames documentation.

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index f726ab7..55ec3c3 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -22,7 +22,7 @@
 #include "perl.h"
 
 #ifndef WORD_ALIGN
-#define WORD_ALIGN sizeof(U16)
+#define WORD_ALIGN sizeof(U32)
 #endif
 
 #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
@@ -349,7 +349,7 @@ PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;
     register SV *tmpForm = *++MARK;
-    register U16 *fpc;
+    register U32 *fpc;
     register char *t;
     register char *f;
     register char *s;
@@ -389,7 +389,7 @@ PP(pp_formline)
     /* need to jump to the next word */
     s = f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN;
 
-    fpc = (U16*)s;
+    fpc = (U32*)s;
 
     for (;;) {
        DEBUG_f( {
@@ -1329,8 +1329,6 @@ OP *
 Perl_die_where(pTHX_ char *message, STRLEN msglen)
 {
     STRLEN n_a;
-    IO *io;
-    MAGIC *mg;
 
     if (PL_in_eval) {
        I32 cxix;
@@ -1365,8 +1363,6 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
                sv_setpvn(ERRSV, message, msglen);
            }
        }
-       else
-           message = SvPVx(ERRSV, msglen);
 
        while ((cxix = dopoptoeval(cxstack_ix)) < 0
               && PL_curstackinfo->si_prev)
@@ -1383,6 +1379,8 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 
            POPBLOCK(cx,PL_curpm);
            if (CxTYPE(cx) != CXt_EVAL) {
+               if (!message)
+                   message = SvPVx(ERRSV, msglen);
                PerlIO_write(Perl_error_log, "panic: die ", 11);
                PerlIO_write(Perl_error_log, message, msglen);
                my_exit(1);
@@ -1412,30 +1410,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
     if (!message)
        message = SvPVx(ERRSV, msglen);
 
-    /* if STDERR is tied, print to it instead */
-    if (PL_stderrgv && (io = GvIOp(PL_stderrgv))
-       && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
-       dSP; ENTER;
-       PUSHMARK(SP);
-       XPUSHs(SvTIED_obj((SV*)io, mg));
-       XPUSHs(sv_2mortal(newSVpvn(message, msglen)));
-       PUTBACK;
-       call_method("PRINT", G_SCALAR);
-       LEAVE;
-    }
-    else {
-#ifdef USE_SFIO
-       /* SFIO can really mess with your errno */
-       int e = errno;
-#endif
-       PerlIO *serr = Perl_error_log;
-
-       PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
-       (void)PerlIO_flush(serr);
-#ifdef USE_SFIO
-       errno = e;
-#endif
-    }
+    write_to_stderr(message, msglen);
     my_failure_exit();
     /* NOTREACHED */
     return 0;
@@ -2359,7 +2334,10 @@ PP(pp_goto)
                    CV *gotocv;
                
                    if (PERLDB_SUB_NN) {
-                       SvIVX(sv) = PTR2IV(cv); /* Already upgraded, saved */
+                       (void)SvUPGRADE(sv, SVt_PVIV);
+                       (void)SvIOK_on(sv);
+                       SAVEIV(SvIVX(sv));
+                       SvIVX(sv) = PTR2IV(cv); /* Do it the quickest way */
                    } else {
                        save_item(sv);
                        gv_efullname3(sv, CvGV(cv), Nullch);
@@ -2853,8 +2831,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     else
        sv_setpv(ERRSV,"");
     if (yyparse() || PL_error_count || !PL_eval_root) {
-       SV **newsp;
-       I32 gimme;
+       SV **newsp;                     /* Used by POPBLOCK. */
        PERL_CONTEXT *cx;
        I32 optype = 0;                 /* Might be reset by POPEVAL. */
        STRLEN n_a;
@@ -2898,13 +2875,16 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        *startop = PL_eval_root;
     } else
        SAVEFREEOP(PL_eval_root);
-    if (gimme & G_VOID && ! PL_in_eval & EVAL_INREQUIRE)
-       /*
-        * EVAL_INREQUIRE (the code is being required) is special-cased :
-        * in this case we want scalar context to be forced, instead
-        * of void context, so a proper return value is returned from
-        * C<require> via this leaveeval op.
-        */
+
+    /* Set the context for this new optree.
+     * If the last op is an OP_REQUIRE, force scalar context.
+     * Otherwise, propagate the context from the eval(). */
+    if (PL_eval_root->op_type == OP_LEAVEEVAL
+           && cUNOPx(PL_eval_root)->op_first->op_type == OP_LINESEQ
+           && cLISTOPx(cUNOPx(PL_eval_root)->op_first)->op_last->op_type
+           == OP_REQUIRE)
+       scalar(PL_eval_root);
+    else if (gimme & G_VOID)
        scalarvoid(PL_eval_root);
     else if (gimme & G_ARRAY)
        list(PL_eval_root);
@@ -3572,9 +3552,9 @@ S_doparseform(pTHX_ SV *sv)
     bool noblank   = FALSE;
     bool repeat    = FALSE;
     bool postspace = FALSE;
-    U16 *fops;
-    register U16 *fpc;
-    U16 *linepc = 0;
+    U32 *fops;
+    register U32 *fpc;
+    U32 *linepc = 0;
     register I32 arg;
     bool ischop;
     int maxops = 2; /* FF_LINEMARK + FF_END) */
@@ -3590,7 +3570,7 @@ S_doparseform(pTHX_ SV *sv)
     s = base;
     base = Nullch;
 
-    New(804, fops, maxops, U16);
+    New(804, fops, maxops, U32);
     fpc = fops;
 
     if (s < send) {
@@ -3758,10 +3738,10 @@ S_doparseform(pTHX_ SV *sv)
     { /* need to jump to the next word */
         int z;
        z = WORD_ALIGN - SvCUR(sv) % WORD_ALIGN;
-       SvGROW(sv, SvCUR(sv) + z + arg * sizeof(U16) + 4);
+       SvGROW(sv, SvCUR(sv) + z + arg * sizeof(U32) + 4);
        s = SvPVX(sv) + SvCUR(sv) + z;
     }
-    Copy(fops, s, arg, U16);
+    Copy(fops, s, arg, U32);
     Safefree(fops);
     sv_magic(sv, Nullsv, PERL_MAGIC_fm, Nullch, 0);
     SvCOMPILED_on(sv);