[perl #948] [PATCH] Allow tied $,
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 11f21be..3876a78 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -9,7 +9,11 @@
  */
 
 /*
- * "A ship then new they built for him/of mithril and of elven glass" --Bilbo
+ *      A ship then new they built for him
+ *      of mithril and of elven-glass
+ *              --from Bilbo's song of EƤrendil
+ *
+ *     [p.236 of _The Lord of the Rings_, II/i: "Many Meetings"]
  */
 
 /* This file contains the top-level functions that are used to create, use
@@ -157,7 +161,7 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 
 #define CALL_LIST_BODY(cv) \
     PUSHMARK(PL_stack_sp); \
-    call_sv((SV*)(cv), G_EVAL|G_DISCARD);
+    call_sv(MUTABLE_SV((cv)), G_EVAL|G_DISCARD);
 
 static void
 S_init_tls_and_interp(PerlInterpreter *my_perl)
@@ -367,9 +371,9 @@ perl_construct(pTHXx)
     PL_fdpid = newAV();                        /* for remembering popen pids by fd */
     PL_modglobal = newHV();            /* pointers to per-interpreter module globals */
     PL_errors = newSVpvs("");
-    sv_setpvn(PERL_DEBUG_PAD(0), "", 0);       /* For regex debugging. */
-    sv_setpvn(PERL_DEBUG_PAD(1), "", 0);       /* ext/re needs these */
-    sv_setpvn(PERL_DEBUG_PAD(2), "", 0);       /* even without DEBUGGING. */
+    sv_setpvs(PERL_DEBUG_PAD(0), "");  /* For regex debugging. */
+    sv_setpvs(PERL_DEBUG_PAD(1), "");  /* ext/re needs these */
+    sv_setpvs(PERL_DEBUG_PAD(2), "");  /* even without DEBUGGING. */
 #ifdef USE_ITHREADS
     /* First entry is a list of empty elements. It needs to be initialised
        else all hell breaks loose in S_find_uninit_var().  */
@@ -901,7 +905,7 @@ perl_destruct(pTHXx)
     PL_regex_pad = NULL;
 #endif
 
-    SvREFCNT_dec((SV*) PL_stashcache);
+    SvREFCNT_dec(MUTABLE_SV(PL_stashcache));
     PL_stashcache = NULL;
 
     /* loosen bonds of global variables */
@@ -942,8 +946,8 @@ perl_destruct(pTHXx)
 
     /* magical thingies */
 
-    SvREFCNT_dec(PL_ofs_sv);   /* $, */
-    PL_ofs_sv = NULL;
+    SvREFCNT_dec(PL_ofsgv);    /* *, */
+    PL_ofsgv = NULL;
 
     SvREFCNT_dec(PL_ors_sv);   /* $\ */
     PL_ors_sv = NULL;
@@ -1213,7 +1217,7 @@ perl_destruct(pTHXx)
        SV* sv;
        register SV* svend;
 
-       for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+       for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
            svend = &sva[SvREFCNT(sva)];
            for (sv = sva + 1; sv < svend; ++sv) {
                if (SvTYPE(sv) != SVTYPEMASK) {
@@ -1712,7 +1716,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     bool add_read_e_script = FALSE;
 
     SvGROW(linestr_sv, 80);
-    sv_setpvn(linestr_sv,"",0);
+    sv_setpvs(linestr_sv,"");
 
     sv = newSVpvs("");         /* first used for -I flags */
     SAVEFREESV(sv);
@@ -2100,7 +2104,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        }
     }
 
-    PL_main_cv = PL_compcv = (CV*)newSV_type(SVt_PVCV);
+    PL_main_cv = PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
     CvUNIQUE_on(PL_compcv);
 
     CvPADLIST(PL_compcv) = pad_new(0);
@@ -2170,12 +2174,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                   U32 out = PL_unicode & PERL_UNICODE_OUT_FLAG;
                   if (in) {
                        if (out)
-                            sv_setpvn(sv, ":utf8\0:utf8", 11);
+                            sv_setpvs(sv, ":utf8\0:utf8");
                        else
-                            sv_setpvn(sv, ":utf8\0", 6);
+                            sv_setpvs(sv, ":utf8\0");
                   }
                   else if (out)
-                       sv_setpvn(sv, "\0:utf8", 6);
+                       sv_setpvs(sv, "\0:utf8");
                   SvSETMAGIC(sv);
              }
         }
@@ -2572,7 +2576,7 @@ Perl_call_pv(pTHX_ const char *sub_name, I32 flags)
 {
     PERL_ARGS_ASSERT_CALL_PV;
 
-    return call_sv((SV*)get_cv(sub_name, TRUE), flags);
+    return call_sv(MUTABLE_SV(get_cv(sub_name, TRUE)), flags);
 }
 
 /*
@@ -2649,7 +2653,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
          && (PL_DBcv || (PL_DBcv = GvCV(PL_DBsub)))
           /* Try harder, since this may have been a sighandler, thus
            * curstash may be meaningless. */
-         && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != PL_debstash)
+         && (SvTYPE(sv) != SVt_PVCV || CvSTASH((const CV *)sv) != PL_debstash)
          && !(flags & G_NODEBUG))
        PL_op->op_private |= OPpENTERSUB_DB;
 
@@ -2852,7 +2856,7 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
     PUTBACK;
 
     if (croak_on_error && SvTRUE(ERRSV)) {
-       Perl_croak(aTHX_ SvPVx_nolen_const(ERRSV));
+       Perl_croak(aTHX_ "%s", SvPVx_nolen_const(ERRSV));
     }
 
     return sv;
@@ -2896,7 +2900,7 @@ Perl_magicname(pTHX_ const char *sym, const char *name, I32 namlen)
     PERL_ARGS_ASSERT_MAGICNAME;
 
     if (gv)
-       sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
+       sv_magic(GvSV(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, namlen);
 }
 
 STATIC void
@@ -3306,13 +3310,13 @@ Perl_moreswitches(pTHX_ const char *s)
            upg_version(PL_patchlevel, TRUE);
 #if !defined(DGUX)
        PerlIO_printf(PerlIO_stdout(),
-               Perl_form(aTHX_ "\nThis is perl, %"SVf
+               "\nThis is perl, %"SVf
 #ifdef PERL_PATCHNUM
-                         " DEVEL" STRINGIFY(PERL_PATCHNUM)
+               " DEVEL" STRINGIFY(PERL_PATCHNUM)
 #endif
-                         " built for %s",
-                         SVfARG(vstringify(PL_patchlevel)),
-                         ARCHNAME));
+               " built for %s",
+               SVfARG(vstringify(PL_patchlevel)),
+               ARCHNAME);
 #else /* DGUX */
 /* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
        PerlIO_printf(PerlIO_stdout(),
@@ -3573,7 +3577,7 @@ S_init_main_stash(pTHX)
     PL_globalstash = GvHV(gv_fetchpvs("CORE::GLOBAL::", GV_ADDMULTI,
                                      SVt_PVHV));
     /* We must init $/ before switches are processed. */
-    sv_setpvn(get_sv("/", TRUE), "\n", 1);
+    sv_setpvs(get_sv("/", TRUE), "\n");
 }
 
 STATIC int
@@ -4546,7 +4550,9 @@ S_init_predump_symbols(pTHX)
     GV *tmpgv;
     IO *io;
 
-    sv_setpvn(get_sv("\"", TRUE), " ", 1);
+    sv_setpvs(get_sv("\"", TRUE), " ");
+    PL_ofsgv = (GV*)SvREFCNT_inc(gv_fetchpvs(",", GV_ADD|GV_NOTQUAL, SVt_PV));
+
     PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     GvMULTI_on(PL_stdingv);
     io = GvIOp(PL_stdingv);
@@ -4554,7 +4560,7 @@ S_init_predump_symbols(pTHX)
     IoIFP(io) = PerlIO_stdin();
     tmpgv = gv_fetchpvs("stdin", GV_ADD|GV_NOTQUAL, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc_simple(io);
+    GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io));
 
     tmpgv = gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     GvMULTI_on(tmpgv);
@@ -4564,7 +4570,7 @@ S_init_predump_symbols(pTHX)
     setdefout(tmpgv);
     tmpgv = gv_fetchpvs("stdout", GV_ADD|GV_NOTQUAL, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc_simple(io);
+    GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io));
 
     PL_stderrgv = gv_fetchpvs("STDERR", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     GvMULTI_on(PL_stderrgv);
@@ -4573,7 +4579,7 @@ S_init_predump_symbols(pTHX)
     IoOFP(io) = IoIFP(io) = PerlIO_stderr();
     tmpgv = gv_fetchpvs("stderr", GV_ADD|GV_NOTQUAL, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc_simple(io);
+    GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io));
 
     PL_statname = newSV(0);            /* last filename we did stat on */
 
@@ -4633,9 +4639,9 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
 
     PL_toptarget = newSV_type(SVt_PVFM);
-    sv_setpvn(PL_toptarget, "", 0);
+    sv_setpvs(PL_toptarget, "");
     PL_bodytarget = newSV_type(SVt_PVFM);
-    sv_setpvn(PL_bodytarget, "", 0);
+    sv_setpvs(PL_bodytarget, "");
     PL_formtarget = PL_bodytarget;
 
     TAINT;
@@ -5114,19 +5120,19 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
     PERL_ARGS_ASSERT_CALL_LIST;
 
     while (av_len(paramList) >= 0) {
-       cv = (CV*)av_shift(paramList);
+       cv = MUTABLE_CV(av_shift(paramList));
        if (PL_savebegin) {
            if (paramList == PL_beginav) {
                /* save PL_beginav for compiler */
-               Perl_av_create_and_push(aTHX_ &PL_beginav_save, (SV*)cv);
+               Perl_av_create_and_push(aTHX_ &PL_beginav_save, MUTABLE_SV(cv));
            }
            else if (paramList == PL_checkav) {
                /* save PL_checkav for compiler */
-               Perl_av_create_and_push(aTHX_ &PL_checkav_save, (SV*)cv);
+               Perl_av_create_and_push(aTHX_ &PL_checkav_save, MUTABLE_SV(cv));
            }
            else if (paramList == PL_unitcheckav) {
                /* save PL_unitcheckav for compiler */
-               Perl_av_create_and_push(aTHX_ &PL_unitcheckav_save, (SV*)cv);
+               Perl_av_create_and_push(aTHX_ &PL_unitcheckav_save, MUTABLE_SV(cv));
            }
        } else {
            if (!PL_madskills)