integrated relevant parts og changes #2385 & #2387 from mainline
authorGraham Barr <gbarr@pobox.com>
Thu, 31 Dec 1998 06:17:13 +0000 (06:17 +0000)
committerGraham Barr <gbarr@pobox.com>
Thu, 31 Dec 1998 06:17:13 +0000 (06:17 +0000)
various fixes for race conditions under threads: mutex locks based
on PL_threadnum were seriously flawed, since it means more than one
thread could enter the critical region; PL_na was global instead of
thread-local; child thread could finish and free thr structures
before Thread->new() got around to creating the Thread object;
cv_clone() needed locking, as it mucks with PL_comppad and other
global data; new_struct_thread() needed to lock template-thread's
mutex while copying its data

another threads reliability fix: serialize writes to thr->threadsv
avoid most uses of PL_na (which is much more inefficient than a
simple local); update docs to suit; PL_na now being thr->Tna may
be a minor compatibility issue for extensions--will require dTHR
outside of XSUBs (those get automatic dTHR)

p4raw-link: @2385 on //depot/perl: b099ddc068b2498767e6f04ac167d9633b895ec4

p4raw-id: //depot/maint-5.005/perl@2543

44 files changed:
XSUB.h
djgpp/djgpp.c
doio.c
doop.c
dump.c
embedvar.h
ext/DynaLoader/dl_next.xs
ext/IO/IO.xs
ext/Opcode/Opcode.xs
ext/POSIX/POSIX.xs
ext/Thread/Thread.xs
ext/attrs/attrs.xs
gv.c
malloc.c
mg.c
objXSUB.h
op.c
os2/OS2/REXX/REXX.xs
os2/os2.c
perl.c
perlvars.h
perly.c
perly.y
pod/perlcall.pod
pod/perlembed.pod
pod/perlguts.pod
pod/perlxs.pod
pp.c
pp.h
pp_ctl.c
pp_hot.c
pp_sys.c
run.c
sv.c
taint.c
thread.h
toke.c
universal.c
util.c
vms/ext/Stdio/Stdio.xs
vms/perly_c.vms
vms/vms.c
win32/win32.c
win32/win32thread.c

index 12ebc32..a6577d8 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -57,8 +57,8 @@
 #ifdef XS_VERSION
 # define XS_VERSION_BOOTCHECK \
     STMT_START {                                                       \
-       SV *tmpsv;                                                      \
-       char *vn = Nullch, *module = SvPV(ST(0),PL_na);                 \
+       SV *tmpsv; STRLEN n_a;                                          \
+       char *vn = Nullch, *module = SvPV(ST(0),n_a);                   \
        if (items >= 2)  /* version supplied as bootstrap arg */        \
            tmpsv = ST(1);                                              \
        else {                                                          \
@@ -69,7 +69,7 @@
                tmpsv = perl_get_sv(form("%s::%s", module,              \
                                      vn = "VERSION"), FALSE);          \
        }                                                               \
-       if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, PL_na))))   \
+       if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a))))     \
            croak("%s object version %s does not match %s%s%s%s %_",    \
                  module, XS_VERSION,                                   \
                  vn ? "$" : "", vn ? module : "", vn ? "::" : "",      \
index 4d0d9fd..696acc3 100644 (file)
@@ -133,7 +133,8 @@ do_aspawn (SV *really,SV **mark,SV **sp)
 {
     dTHR;
     int  rc;
-    char **a,*tmps,**argv; 
+    char **a,*tmps,**argv;
+    STRLEN n_a;
 
     if (sp<=mark)
         return -1;
@@ -141,7 +142,7 @@ do_aspawn (SV *really,SV **mark,SV **sp)
 
     while (++mark <= sp)
         if (*mark)
-            *a++ = SvPVx(*mark, PL_na);
+            *a++ = SvPVx(*mark, n_a);
         else
             *a++ = "";
     *a = Nullch;
@@ -152,7 +153,7 @@ do_aspawn (SV *really,SV **mark,SV **sp)
      ) /* will swawnvp use PATH? */
          TAINT_ENV();  /* testing IFS here is overkill, probably */
 
-    if (really && *(tmps = SvPV(really, PL_na)))
+    if (really && *(tmps = SvPV(really, n_a)))
         rc=spawnvp (P_WAIT,tmps,argv);
     else
         rc=spawnvp (P_WAIT,argv[0],argv);
diff --git a/doio.c b/doio.c
index 85d604b..ab73bdd 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -545,7 +545,7 @@ nextargv(register GV *gv)
        }
        else
            PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
-             SvPV(sv, PL_na), Strerror(errno));
+             SvPV(sv, oldlen), Strerror(errno));
     }
     if (PL_inplace) {
        (void)do_close(PL_argvoutgv,FALSE);
@@ -920,6 +920,7 @@ my_stat(ARGSproto)
     else {
        SV* sv = POPs;
        char *s;
+       STRLEN n_a;
        PUTBACK;
        if (SvTYPE(sv) == SVt_PVGV) {
            tmpgv = (GV*)sv;
@@ -930,7 +931,7 @@ my_stat(ARGSproto)
            goto do_fstat;
        }
 
-       s = SvPV(sv, PL_na);
+       s = SvPV(sv, n_a);
        PL_statgv = Nullgv;
        sv_setpv(PL_statname, s);
        PL_laststype = OP_STAT;
@@ -946,6 +947,7 @@ my_lstat(ARGSproto)
 {
     djSP;
     SV *sv;
+    STRLEN n_a;
     if (PL_op->op_flags & OPf_REF) {
        EXTEND(SP,1);
        if (cGVOP->op_gv == PL_defgv) {
@@ -960,13 +962,13 @@ my_lstat(ARGSproto)
     PL_statgv = Nullgv;
     sv = POPs;
     PUTBACK;
-    sv_setpv(PL_statname,SvPV(sv, PL_na));
+    sv_setpv(PL_statname,SvPV(sv, n_a));
 #ifdef HAS_LSTAT
-    PL_laststatval = PerlLIO_lstat(SvPV(sv, PL_na),&PL_statcache);
+    PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
 #else
-    PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache);
+    PL_laststatval = PerlLIO_stat(SvPV(sv, n_a),&PL_statcache);
 #endif
-    if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
+    if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, n_a), '\n'))
        warn(warn_nl, "lstat");
     return PL_laststatval;
 }
@@ -976,6 +978,7 @@ do_aexec(SV *really, register SV **mark, register SV **sp)
 {
     register char **a;
     char *tmps;
+    STRLEN n_a;
 
     if (sp > mark) {
        dTHR;
@@ -983,14 +986,14 @@ do_aexec(SV *really, register SV **mark, register SV **sp)
        a = PL_Argv;
        while (++mark <= sp) {
            if (*mark)
-               *a++ = SvPVx(*mark, PL_na);
+               *a++ = SvPVx(*mark, n_a);
            else
                *a++ = "";
        }
        *a = Nullch;
        if (*PL_Argv[0] != '/') /* will execvp use PATH? */
            TAINT_ENV();                /* testing IFS here is overkill, probably */
-       if (really && *(tmps = SvPV(really, PL_na)))
+       if (really && *(tmps = SvPV(really, n_a)))
            PerlProc_execvp(tmps,PL_Argv);
        else
            PerlProc_execvp(PL_Argv[0],PL_Argv);
@@ -1116,6 +1119,7 @@ apply(I32 type, register SV **mark, register SV **sp)
     char *what;
     char *s;
     SV **oldmark = mark;
+    STRLEN n_a;
 
 #define APPLY_TAINT_PROPER() \
     STMT_START {                                                       \
@@ -1141,7 +1145,7 @@ apply(I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               char *name = SvPVx(*mark, PL_na);
+               char *name = SvPVx(*mark, n_a);
                APPLY_TAINT_PROPER();
                if (PerlLIO_chmod(name, val))
                    tot--;
@@ -1158,7 +1162,7 @@ apply(I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               char *name = SvPVx(*mark, PL_na);
+               char *name = SvPVx(*mark, n_a);
                APPLY_TAINT_PROPER();
                if (PerlLIO_chown(name, val, val2))
                    tot--;
@@ -1178,7 +1182,7 @@ nothing in the core.
        APPLY_TAINT_PROPER();
        if (mark == sp)
            break;
-       s = SvPVx(*++mark, PL_na);
+       s = SvPVx(*++mark, n_a);
        if (isUPPER(*s)) {
            if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
                s += 3;
@@ -1248,7 +1252,7 @@ nothing in the core.
        APPLY_TAINT_PROPER();
        tot = sp - mark;
        while (++mark <= sp) {
-           s = SvPVx(*mark, PL_na);
+           s = SvPVx(*mark, n_a);
            APPLY_TAINT_PROPER();
            if (PL_euid || PL_unsafe) {
                if (UNLINK(s))
@@ -1293,7 +1297,7 @@ nothing in the core.
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               char *name = SvPVx(*mark, PL_na);
+               char *name = SvPVx(*mark, n_a);
                APPLY_TAINT_PROPER();
                if (PerlLIO_utime(name, &utbuf))
                    tot--;
diff --git a/doop.c b/doop.c
index d7c315f..16df32f 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -352,7 +352,8 @@ do_vop(I32 optype, SV *sv, SV *left, SV *right)
     len = leftlen < rightlen ? leftlen : rightlen;
     lensave = len;
     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
-       dc = SvPV_force(sv, PL_na);
+       STRLEN n_a;
+       dc = SvPV_force(sv, n_a);
        if (SvCUR(sv) < len) {
            dc = SvGROW(sv, len + 1);
            (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
diff --git a/dump.c b/dump.c
index b1e984b..6e61979 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -239,11 +239,12 @@ dump_op(OP *o)
     case OP_GVSV:
     case OP_GV:
        if (cGVOPo->op_gv) {
+           STRLEN n_a;
            SV *tmpsv = NEWSV(0,0);
            ENTER;
            SAVEFREESV(tmpsv);
            gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
-           dump("GV = %s\n", SvPV(tmpsv, PL_na));
+           dump("GV = %s\n", SvPV(tmpsv, n_a));
            LEAVE;
        }
        else
index 1c00fe7..25b31e0 100644 (file)
 #define PL_collxfrm_base       (PL_Vars.Gcollxfrm_base)
 #define PL_collxfrm_mult       (PL_Vars.Gcollxfrm_mult)
 #define PL_cop_seqmax          (PL_Vars.Gcop_seqmax)
+#define PL_cred_mutex          (PL_Vars.Gcred_mutex)
 #define PL_cryptseen           (PL_Vars.Gcryptseen)
 #define PL_cshlen              (PL_Vars.Gcshlen)
 #define PL_cshname             (PL_Vars.Gcshname)
 #define PL_Gcollxfrm_base      PL_collxfrm_base
 #define PL_Gcollxfrm_mult      PL_collxfrm_mult
 #define PL_Gcop_seqmax         PL_cop_seqmax
+#define PL_Gcred_mutex         PL_cred_mutex
 #define PL_Gcryptseen          PL_cryptseen
 #define PL_Gcshlen             PL_cshlen
 #define PL_Gcshname            PL_cshname
index 2b547f0..dfa8a3e 100644 (file)
@@ -172,6 +172,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */)
     I32 i, psize;
     char *result;
     char **p;
+    STRLEN n_a;
        
     /* Do not load what is already loaded into this process */
     if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
@@ -182,7 +183,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */)
     p = (char **) safemalloc(psize * sizeof(char*));
     p[0] = path;
     for(i=1; i<psize-1; i++) {
-       p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), PL_na);
+       p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
     }
     p[psize-1] = 0;
     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
index a434cca..300581e 100644 (file)
@@ -111,7 +111,8 @@ fsetpos(handle, pos)
        SV *            pos
     CODE:
        char *p;
-       if (handle && (p = SvPVx(pos, PL_na)) && PL_na == sizeof(Fpos_t))
+       STRLEN n_a;
+       if (handle && (p = SvPVx(pos, n_a)) && n_a == sizeof(Fpos_t))
 #ifdef PerlIO
            RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
 #else
index e853cf1..e93b900 100644 (file)
@@ -400,7 +400,8 @@ PPCODE:
        }
        else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) {
            int b, j;
-           char *bitmap = SvPV(bitspec,PL_na);
+           STRLEN n_a;
+           char *bitmap = SvPV(bitspec,n_a);
            myopcode = 0;
            for (b=0; b < opset_len; b++) {
                U16 bits = bitmap[b];
index 7b97586..268196d 100644 (file)
@@ -3179,10 +3179,11 @@ sigaction(sig, action, oldaction = 0)
                                 sig_name[sig],
                                 strlen(sig_name[sig]),
                                 TRUE);
+           STRLEN n_a;
 
            /* Remember old handler name if desired. */
            if (oldaction) {
-               char *hand = SvPVx(*sigsvp, PL_na);
+               char *hand = SvPVx(*sigsvp, n_a);
                svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
                sv_setpv(*svp, *hand ? hand : "DEFAULT");
            }
@@ -3193,7 +3194,7 @@ sigaction(sig, action, oldaction = 0)
                svp = hv_fetch(action, "HANDLER", 7, FALSE);
                if (!svp)
                    croak("Can't supply an action without a HANDLER");
-               sv_setpv(*sigsvp, SvPV(*svp, PL_na));
+               sv_setpv(*sigsvp, SvPV(*svp, n_a));
                mg_set(*sigsvp);        /* handles DEFAULT and IGNORE */
                act.sa_handler = sighandler;
 
index ad87725..da001ff 100644 (file)
@@ -122,13 +122,14 @@ threadstart(void *arg)
     retval = SP - (PL_stack_base + oldmark);
     SP = PL_stack_base + oldmark + 1;
     if (SvCUR(thr->errsv)) {
+       STRLEN n_a;
        MUTEX_LOCK(&thr->mutex);
        thr->flags |= THRf_DID_DIE;
        MUTEX_UNLOCK(&thr->mutex);
        av_store(av, 0, &PL_sv_no);
        av_store(av, 1, newSVsv(thr->errsv));
        DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
-                             thr, SvPV(thr->errsv, PL_na)));
+                             thr, SvPV(thr->errsv, n_a)));
     } else {
        DEBUG_S(STMT_START {
            for (i = 1; i <= retval; i++) {
@@ -248,11 +249,13 @@ newthread (SV *startsv, AV *initargs, char *classname)
        XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
     XPUSHs(SvREFCNT_inc(startsv));
     PUTBACK;
+
+    /* On your marks... */
+    MUTEX_LOCK(&thr->mutex);
+
 #ifdef THREAD_CREATE
     err = THREAD_CREATE(thr, threadstart);
 #else    
-    /* On your marks... */
-    MUTEX_LOCK(&thr->mutex);
     /* Get set...  */
     sigfillset(&fullmask);
     if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
@@ -283,10 +286,9 @@ newthread (SV *startsv, AV *initargs, char *classname)
 #else
        err = pthread_create(&thr->self, &attr, threadstart, (void*) thr);
 #endif
-    /* Go */
-    MUTEX_UNLOCK(&thr->mutex);
 #endif
     if (err) {
+       MUTEX_UNLOCK(&thr->mutex);
         DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                              "%p: create of %p failed %d\n",
                              savethread, thr, err));
@@ -299,16 +301,23 @@ newthread (SV *startsv, AV *initargs, char *classname)
        SvREFCNT_dec(startsv);
        return NULL;
     }
+
 #ifdef THREAD_POST_CREATE
     THREAD_POST_CREATE(thr);
 #else
     if (sigprocmask(SIG_SETMASK, &oldmask, 0))
        croak("panic: sigprocmask");
 #endif
+
     sv = newSViv(thr->tid);
     sv_magic(sv, thr->oursv, '~', 0, 0);
     SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
-    return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
+    sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
+
+    /* Go */
+    MUTEX_UNLOCK(&thr->mutex);
+
+    return sv;
 #else
     croak("No threads in this perl");
     return &PL_sv_undef;
@@ -375,7 +384,8 @@ join(t)
            for (i = 1; i <= AvFILL(av); i++)
                XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
        } else {
-           char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na);
+           STRLEN n_a;
+           char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a);
            DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                                  "%p: join propagating die message: %s\n",
                                  thr, mess));
index da952d5..7f7970d 100644 (file)
@@ -27,7 +27,8 @@ char *        Class
        if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
            croak("can't set attributes outside a subroutine scope");
        for (i = 1; i < items; i++) {
-           char *attr = SvPV(ST(i), PL_na);
+           STRLEN n_a;
+           char *attr = SvPV(ST(i), n_a);
            cv_flags_t flag = get_flag(attr);
            if (!flag)
                croak("invalid attribute name %s", attr);
@@ -47,7 +48,8 @@ SV *  sub
                sub = Nullsv;
        }
        else {
-           char *name = SvPV(sub, PL_na);
+           STRLEN n_a;
+           char *name = SvPV(sub, n_a);
            sub = (SV*)perl_get_cv(name, FALSE);
        }
        if (!sub)
diff --git a/gv.c b/gv.c
index a4b0b43..930c87e 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -112,6 +112,7 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
     if (doproto) {                     /* Replicate part of newSUB here. */
        SvIOK_off(gv);
        ENTER;
+       /* XXX unsafe for threads if eval_owner isn't held */
        start_subparse(0,0);            /* Create CV in compcv. */
        GvCV(gv) = PL_compcv;
        LEAVE;
@@ -993,6 +994,7 @@ Gv_AMupdate(HV *stash)
   MAGIC* mg=mg_find((SV*)stash,'c');
   AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
   AMT amt;
+  STRLEN n_a;
 
   if (mg && amtp->was_ok_am == PL_amagic_generation
       && amtp->was_ok_sub == PL_sub_generation)
@@ -1040,7 +1042,7 @@ Gv_AMupdate(HV *stash)
             default:
               if (!SvROK(sv)) {
                 if (!SvOK(sv)) break;
-               gv = gv_fetchmethod(stash, SvPV(sv, PL_na));
+               gv = gv_fetchmethod(stash, SvPV(sv, n_a));
                 if (gv) cv = GvCV(gv);
                 break;
               }
@@ -1101,7 +1103,7 @@ Gv_AMupdate(HV *stash)
                GV *ngv;
                
                DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", 
-                            SvPV(GvSV(gv), PL_na), cp, HvNAME(stash)) );
+                            SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
                if (!SvPOK(GvSV(gv)) 
                    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
                                                       FALSE)))
index fcb6370..1c1bef2 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -599,6 +599,7 @@ emergency_sbrk(MEM_SIZE size)
        SV *sv;
        char *pv;
        int have = 0;
+       STRLEN n_a;
 
        if (emergency_buffer_size) {
            add_to_chain(emergency_buffer, emergency_buffer_size, 0);
@@ -614,7 +615,7 @@ emergency_sbrk(MEM_SIZE size)
            return (char *)-1;          /* Now die die die... */
        }
        /* Got it, now detach SvPV: */
-       pv = SvPV(sv, PL_na);
+       pv = SvPV(sv, n_a);
        /* Check alignment: */
        if (((UV)(pv - sizeof(union overhead))) & ((1<<LOG_OF_MIN_ARENA) - 1)) {
            PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
diff --git a/mg.c b/mg.c
index 046c32b..6940dae 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -341,8 +341,10 @@ magic_len(SV *sv, MAGIC *mg)
        return (STRLEN)PL_orslen;
     }
     magic_get(sv,mg);
-    if (!SvPOK(sv) && SvNIOK(sv))
-       sv_2pv(sv, &PL_na);
+    if (!SvPOK(sv) && SvNIOK(sv)) {
+       STRLEN n_a;
+       sv_2pv(sv, &n_a);
+    }
     if (SvPOK(sv))
        return SvCUR(sv);
     return 0;
@@ -721,7 +723,8 @@ magic_setenv(SV *sv, MAGIC *mg)
 int
 magic_clearenv(SV *sv, MAGIC *mg)
 {
-    my_setenv(MgPV(mg,PL_na),Nullch);
+    STRLEN n_a;
+    my_setenv(MgPV(mg,n_a),Nullch);
     return 0;
 }
 
@@ -734,12 +737,13 @@ magic_set_all_env(SV *sv, MAGIC *mg)
     dTHR;
     if (PL_localizing) {
        HE* entry;
+       STRLEN n_a;
        magic_clear_all_env(sv,mg);
        hv_iterinit((HV*)sv);
        while (entry = hv_iternext((HV*)sv)) {
            I32 keylen;
            my_setenv(hv_iterkey(entry, &keylen),
-                     SvPV(hv_iterval((HV*)sv, entry), PL_na));
+                     SvPV(hv_iterval((HV*)sv, entry), n_a));
        }
     }
 #endif
@@ -787,8 +791,9 @@ int
 magic_getsig(SV *sv, MAGIC *mg)
 {
     I32 i;
+    STRLEN n_a;
     /* Are we fetching a signal entry? */
-    i = whichsig(MgPV(mg,PL_na));
+    i = whichsig(MgPV(mg,n_a));
     if (i) {
        if(psig_ptr[i])
            sv_setsv(sv,psig_ptr[i]);
@@ -810,8 +815,9 @@ int
 magic_clearsig(SV *sv, MAGIC *mg)
 {
     I32 i;
+    STRLEN n_a;
     /* Are we clearing a signal entry? */
-    i = whichsig(MgPV(mg,PL_na));
+    i = whichsig(MgPV(mg,n_a));
     if (i) {
        if(psig_ptr[i]) {
            SvREFCNT_dec(psig_ptr[i]);
@@ -832,8 +838,9 @@ magic_setsig(SV *sv, MAGIC *mg)
     register char *s;
     I32 i;
     SV** svp;
+    STRLEN n_a;
 
-    s = MgPV(mg,PL_na);
+    s = MgPV(mg,n_a);
     if (*s == '_') {
        if (strEQ(s,"__DIE__"))
            svp = &PL_diehook;
@@ -870,7 +877,7 @@ magic_setsig(SV *sv, MAGIC *mg)
            *svp = SvREFCNT_inc(sv);
        return 0;
     }
-    s = SvPV_force(sv,PL_na);
+    s = SvPV_force(sv,n_a);
     if (strEQ(s,"IGNORE")) {
        if (i)
            (void)rsignal(i, SIG_IGN);
@@ -1098,11 +1105,12 @@ magic_setdbline(SV *sv, MAGIC *mg)
     I32 i;
     GV* gv;
     SV** svp;
+    STRLEN n_a;
 
     gv = PL_DBline;
     i = SvTRUE(sv);
     svp = av_fetch(GvAV(gv),
-                    atoi(MgPV(mg,PL_na)), FALSE);
+                    atoi(MgPV(mg,n_a)), FALSE);
     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
        o->op_private = i;
     else
@@ -1198,10 +1206,11 @@ magic_setglob(SV *sv, MAGIC *mg)
 {
     register char *s;
     GV* gv;
+    STRLEN n_a;
 
     if (!SvOK(sv))
        return 0;
-    s = SvPV(sv, PL_na);
+    s = SvPV(sv, n_a);
     if (*s == '*' && s[1])
        s++;
     gv = gv_fetchpv(s,TRUE, SVt_PVGV);
@@ -1411,8 +1420,10 @@ vivify_defelem(SV *sv)
            if (svp)
                value = *svp;
        }
-       if (!value || value == &PL_sv_undef)
-           croak(no_helem, SvPV(mg->mg_obj, PL_na));
+       if (!value || value == &PL_sv_undef) {
+           STRLEN n_a;
+           croak(no_helem, SvPV(mg->mg_obj, n_a));
+       }
     }
     else {
        AV* av = (AV*)LvTARG(sv);
@@ -1529,7 +1540,7 @@ magic_set(SV *sv, MAGIC *mg)
        if (PL_inplace)
            Safefree(PL_inplace);
        if (SvOK(sv))
-           PL_inplace = savepv(SvPV(sv,PL_na));
+           PL_inplace = savepv(SvPV(sv,len));
        else
            PL_inplace = Nullch;
        break;
@@ -1537,7 +1548,7 @@ magic_set(SV *sv, MAGIC *mg)
        if (PL_osname)
            Safefree(PL_osname);
        if (SvOK(sv))
-           PL_osname = savepv(SvPV(sv,PL_na));
+           PL_osname = savepv(SvPV(sv,len));
        else
            PL_osname = Nullch;
        break;
@@ -1564,12 +1575,12 @@ magic_set(SV *sv, MAGIC *mg)
        break;
     case '^':
        Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
-       IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na));
+       IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
        IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
        break;
     case '~':
        Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
-       IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na));
+       IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
        IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
        break;
     case '=':
@@ -1626,7 +1637,7 @@ magic_set(SV *sv, MAGIC *mg)
     case '#':
        if (PL_ofmt)
            Safefree(PL_ofmt);
-       PL_ofmt = savepv(SvPV(sv,PL_na));
+       PL_ofmt = savepv(SvPV(sv,len));
        break;
     case '[':
        PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -1734,7 +1745,7 @@ magic_set(SV *sv, MAGIC *mg)
     case ')':
 #ifdef HAS_SETGROUPS
        {
-           char *p = SvPV(sv, PL_na);
+           char *p = SvPV(sv, len);
            Groups_t gary[NGROUPS];
 
            SET_NUMERIC_STANDARD();
@@ -1782,7 +1793,7 @@ magic_set(SV *sv, MAGIC *mg)
        PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
        break;
     case ':':
-       PL_chopset = SvPV_force(sv,PL_na);
+       PL_chopset = SvPV_force(sv,len);
        break;
     case '0':
        if (!PL_origalen) {
index 60df30d..5acce97 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -19,6 +19,8 @@
 #define PL_colors                              pPerl->PL_colors                
 #undef  PL_colorset            
 #define PL_colorset                            pPerl->PL_colorset              
+#undef  PL_cred_mutex
+#define PL_cred_mutex                          pPerl->PL_cred_mutex   
 #undef  PL_curcop              
 #define PL_curcop                              pPerl->PL_curcop                
 #undef  PL_curpad              
diff --git a/op.c b/op.c
index 273b418..01b04c0 100644 (file)
--- a/op.c
+++ b/op.c
@@ -57,8 +57,9 @@ STATIC char*
 gv_ename(GV *gv)
 {
     SV* tmpsv = sv_newmortal();
+    STRLEN n_a;
     gv_efullname3(tmpsv, gv, Nullch);
-    return SvPV(tmpsv,PL_na);
+    return SvPV(tmpsv,n_a);
 }
 
 STATIC OP *
@@ -543,11 +544,15 @@ find_threadsv(char *name)
     if (!p)
        return NOT_IN_PAD;
     key = p - PL_threadsv_names;
+    MUTEX_LOCK(&thr->mutex);
     svp = av_fetch(thr->threadsv, key, FALSE);
-    if (!svp) {
+    if (svp)
+       MUTEX_UNLOCK(&thr->mutex);
+    else {
        SV *sv = NEWSV(0, 0);
        av_store(thr->threadsv, key, sv);
        thr->threadsvp = AvARRAY(thr->threadsv);
+       MUTEX_UNLOCK(&thr->mutex);
        /*
         * Some magic variables used to be automagically initialised
         * in gv_fetchpv. Those which are now per-thread magicals get
@@ -1112,6 +1117,7 @@ mod(OP *o, I32 type)
     dTHR;
     OP *kid;
     SV *sv;
+    STRLEN n_a;
 
     if (!o || PL_error_count)
        return o;
@@ -1238,7 +1244,7 @@ mod(OP *o, I32 type)
        PL_modcount++;
        if (!type)
            croak("Can't localize lexical variable %s",
-               SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na));
+               SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
        break;
 
 #ifdef USE_THREADS
@@ -3152,13 +3158,14 @@ newLOOPEX(I32 type, OP *label)
 {
     dTHR;
     OP *o;
+    STRLEN n_a;
     if (type != OP_GOTO || label->op_type == OP_CONST) {
        /* "last()" means "last" */
        if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
            o = newOP(type, OPf_SPECIAL);
        else {
            o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
-                                       ? SvPVx(((SVOP*)label)->op_sv, PL_na)
+                                       ? SvPVx(((SVOP*)label)->op_sv, n_a)
                                        : ""));
        }
        op_free(label);
@@ -3412,7 +3419,11 @@ cv_clone2(CV *proto, CV *outside)
 CV *
 cv_clone(CV *proto)
 {
-    return cv_clone2(proto, CvOUTSIDE(proto));
+    CV *cv;
+    MUTEX_LOCK(&PL_cred_mutex);                /* XXX create separate mutex */
+    cv = cv_clone2(proto, CvOUTSIDE(proto));
+    MUTEX_UNLOCK(&PL_cred_mutex);      /* XXX create separate mutex */
+    return cv;
 }
 
 void
@@ -3488,10 +3499,11 @@ CV *
 newSUB(I32 floor, OP *o, OP *proto, OP *block)
 {
     dTHR;
-    char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch;
+    STRLEN n_a;
+    char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
     GV *gv = gv_fetchpv(name ? name : "__ANON__",
                        GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
-    char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch;
+    char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
     register CV *cv=0;
     I32 ix;
 
@@ -3596,7 +3608,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
                else {
                    /* force display of errors found but not reported */
                    sv_catpv(ERRSV, not_safe);
-                   croak("%s", SvPVx(ERRSV, PL_na));
+                   croak("%s", SvPVx(ERRSV, n_a));
                }
            }
        }
@@ -3721,6 +3733,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     return cv;
 }
 
+/* XXX unsafe for threads if eval_owner isn't held */
 void
 newCONSTSUB(HV *stash, char *name, SV *sv)
 {
@@ -3837,9 +3850,10 @@ newFORM(I32 floor, OP *o, OP *block)
     char *name;
     GV *gv;
     I32 ix;
+    STRLEN n_a;
 
     if (o)
-       name = SvPVx(cSVOPo->op_sv, PL_na);
+       name = SvPVx(cSVOPo->op_sv, n_a);
     else
        name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
@@ -4186,6 +4200,7 @@ ck_rvconst(register OP *o)
        int iscv;
        GV *gv;
        SV *kidsv = kid->op_sv;
+       STRLEN n_a;
 
        /* Is it a constant from cv_const_sv()? */
        if (SvROK(kidsv) && SvREADONLY(kidsv)) {
@@ -4224,7 +4239,7 @@ ck_rvconst(register OP *o)
                croak("Constant is not %s reference", badtype);
            return o;
        }
-       name = SvPV(kidsv, PL_na);
+       name = SvPV(kidsv, n_a);
 
        if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
            char *badthing = Nullch;
@@ -4288,8 +4303,9 @@ ck_ftst(OP *o)
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
        if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+           STRLEN n_a;
            OP *newop = newGVOP(type, OPf_REF,
-               gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO));
+               gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
            op_free(o);
            return newop;
        }
@@ -4324,6 +4340,7 @@ ck_fun(OP *o)
     }
 
     if (o->op_flags & OPf_KIDS) {
+       STRLEN n_a;
        tokid = &cLISTOPo->op_first;
        kid = cLISTOPo->op_first;
        if (kid->op_type == OP_PUSHMARK ||
@@ -4353,7 +4370,7 @@ ck_fun(OP *o)
            case OA_AVREF:
                if (kid->op_type == OP_CONST &&
                  (kid->op_private & OPpCONST_BARE)) {
-                   char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
+                   char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
                    if (PL_dowarn)
@@ -4371,7 +4388,7 @@ ck_fun(OP *o)
            case OA_HVREF:
                if (kid->op_type == OP_CONST &&
                  (kid->op_private & OPpCONST_BARE)) {
-                   char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
+                   char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
                    if (PL_dowarn)
@@ -4402,7 +4419,7 @@ ck_fun(OP *o)
                    if (kid->op_type == OP_CONST &&
                      (kid->op_private & OPpCONST_BARE)) {
                        OP *newop = newGVOP(OP_GV, 0,
-                           gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE,
+                           gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
                                        SVt_PVIO) );
                        op_free(kid);
                        kid = newop;
@@ -4849,6 +4866,7 @@ ck_subr(OP *o)
     GV *namegv = 0;
     int optional = 0;
     I32 arg = 0;
+    STRLEN n_a;
 
     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
     if (cvop->op_type == OP_RV2CV) {
@@ -4860,7 +4878,7 @@ ck_subr(OP *o)
            cv = GvCVu(tmpop->op_sv);
            if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
                namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
-               proto = SvPV((SV*)cv, PL_na);
+               proto = SvPV((SV*)cv, n_a);
            }
        }
     }
@@ -4952,7 +4970,7 @@ ck_subr(OP *o)
            default:
              oops:
                croak("Malformed prototype for %s: %s",
-                       gv_ename(namegv), SvPV((SV*)cv, PL_na));
+                       gv_ename(namegv), SvPV((SV*)cv, n_a));
            }
        }
        else
@@ -4996,6 +5014,7 @@ peep(register OP *o)
 {
     dTHR;
     register OP* oldop = 0;
+    STRLEN n_a;
     if (!o || o->op_seq)
        return;
     ENTER;
@@ -5157,7 +5176,7 @@ peep(register OP *o)
            indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
            if (!indsvp) {
                croak("No such field \"%s\" in variable %s of type %s",
-                     key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname)));
+                     key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
            }
            ind = SvIV(*indsvp);
            if (ind < 1)
index 2d13f3e..60266f4 100644 (file)
@@ -96,7 +96,8 @@ exec_in_REXX(char *cmd, char * handlerName, RexxFunctionHandler *handler)
     }
     if (rc || SvTRUE(GvSV(PL_errgv))) {
        if (SvTRUE(GvSV(PL_errgv))) {
-           die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), PL_na)) ;
+           STRLEN n_a;
+           die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), n_a)) ;
        }
        die ("REXX compartment returned non-zero status %li", rc);
     }
index 008eda3..afbd87c 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -162,7 +162,8 @@ int
 os2_cond_wait(perl_cond *c, perl_mutex *m)
 {                                              
     int rc;
-    if ((rc = DosResetEventSem(*c,&PL_na)) && (rc != ERROR_ALREADY_RESET))
+    STRLEN n_a;
+    if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET))
        croak("panic: COND_WAIT-reset: rc=%i", rc);             
     if (m) MUTEX_UNLOCK(m);                                    
     if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
@@ -443,6 +444,7 @@ char *inicmd;
        char **argsp = fargs;
        char nargs = 4;
        int force_shell;
+       STRLEN n_a;
        
        if (flag == P_WAIT)
                flag = P_NOWAIT;
@@ -457,7 +459,7 @@ char *inicmd;
            ) /* will spawnvp use PATH? */
            TAINT_ENV();        /* testing IFS here is overkill, probably */
        /* We should check PERL_SH* and PERLLIB_* as well? */
-       if (!really || !*(tmps = SvPV(really, PL_na)))
+       if (!really || !*(tmps = SvPV(really, n_a)))
            tmps = PL_Argv[0];
 
       reread:
@@ -759,6 +761,7 @@ register SV **sp;
     char *tmps = NULL;
     int rc;
     int flag = P_WAIT, trueflag, err, secondtry = 0;
+    STRLEN n_a;
 
     if (sp > mark) {
        New(1301,PL_Argv, sp - mark + 3, char*);
@@ -771,7 +774,7 @@ register SV **sp;
 
        while (++mark <= sp) {
            if (*mark)
-               *a++ = SvPVx(*mark, PL_na);
+               *a++ = SvPVx(*mark, n_a);
            else
                *a++ = "";
        }
@@ -1148,8 +1151,9 @@ XS(XS_File__Copy_syscopy)
     if (items < 2 || items > 3)
        croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
     {
-       char *  src = (char *)SvPV(ST(0),PL_na);
-       char *  dst = (char *)SvPV(ST(1),PL_na);
+       STRLEN n_a;
+       char *  src = (char *)SvPV(ST(0),n_a);
+       char *  dst = (char *)SvPV(ST(1),n_a);
        U32     flag;
        int     RETVAL, rc;
 
@@ -1178,6 +1182,7 @@ mod2fname(sv)
     AV  *av;
     SV  *svp;
     char *s;
+    STRLEN n_a;
 
     if (!SvROK(sv)) croak("Not a reference given to mod2fname");
     sv = SvRV(sv);
@@ -1188,7 +1193,7 @@ mod2fname(sv)
     if (avlen < 0) 
       croak("Empty array reference given to mod2fname");
 
-    s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
+    s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
     strncpy(fname, s, 8);
     len = strlen(s);
     if (len < 6) pos = len;
@@ -1198,7 +1203,7 @@ mod2fname(sv)
     }
     avlen --;
     while (avlen >= 0) {
-       s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
+       s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
        while (*s) {
            sum = 33 * sum + *(s++);    /* 7 is primitive mod 13. */
        }
@@ -1335,7 +1340,8 @@ XS(XS_Cwd_sys_chdir)
     if (items != 1)
        croak("Usage: Cwd::sys_chdir(path)");
     {
-       char *  path = (char *)SvPV(ST(0),PL_na);
+       STRLEN n_a;
+       char *  path = (char *)SvPV(ST(0),n_a);
        bool    RETVAL;
 
        RETVAL = sys_chdir(path);
@@ -1351,7 +1357,8 @@ XS(XS_Cwd_change_drive)
     if (items != 1)
        croak("Usage: Cwd::change_drive(d)");
     {
-       char    d = (char)*SvPV(ST(0),PL_na);
+       STRLEN n_a;
+       char    d = (char)*SvPV(ST(0),n_a);
        bool    RETVAL;
 
        RETVAL = change_drive(d);
@@ -1367,7 +1374,8 @@ XS(XS_Cwd_sys_is_absolute)
     if (items != 1)
        croak("Usage: Cwd::sys_is_absolute(path)");
     {
-       char *  path = (char *)SvPV(ST(0),PL_na);
+       STRLEN n_a;
+       char *  path = (char *)SvPV(ST(0),n_a);
        bool    RETVAL;
 
        RETVAL = sys_is_absolute(path);
@@ -1383,7 +1391,8 @@ XS(XS_Cwd_sys_is_rooted)
     if (items != 1)
        croak("Usage: Cwd::sys_is_rooted(path)");
     {
-       char *  path = (char *)SvPV(ST(0),PL_na);
+       STRLEN n_a;
+       char *  path = (char *)SvPV(ST(0),n_a);
        bool    RETVAL;
 
        RETVAL = sys_is_rooted(path);
@@ -1399,7 +1408,8 @@ XS(XS_Cwd_sys_is_relative)
     if (items != 1)
        croak("Usage: Cwd::sys_is_relative(path)");
     {
-       char *  path = (char *)SvPV(ST(0),PL_na);
+       STRLEN n_a;
+       char *  path = (char *)SvPV(ST(0),n_a);
        bool    RETVAL;
 
        RETVAL = sys_is_relative(path);
@@ -1430,7 +1440,8 @@ XS(XS_Cwd_sys_abspath)
     if (items < 1 || items > 2)
        croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
     {
-       char *  path = (char *)SvPV(ST(0),PL_na);
+       STRLEN n_a;
+       char *  path = (char *)SvPV(ST(0),n_a);
        char *  dir;
        char p[MAXPATHLEN];
        char *  RETVAL;
@@ -1438,7 +1449,7 @@ XS(XS_Cwd_sys_abspath)
        if (items < 2)
            dir = NULL;
        else {
-           dir = (char *)SvPV(ST(1),PL_na);
+           dir = (char *)SvPV(ST(1),n_a);
        }
        if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
            path += 2;
@@ -1578,7 +1589,8 @@ XS(XS_Cwd_extLibpath_set)
     if (items < 1 || items > 2)
        croak("Usage: Cwd::extLibpath_set(s, type = 0)");
     {
-       char *  s = (char *)SvPV(ST(0),PL_na);
+       STRLEN n_a;
+       char *  s = (char *)SvPV(ST(0),n_a);
        bool    type;
        U32     rc;
        bool    RETVAL;
diff --git a/perl.c b/perl.c
index 027288c..f0e4e41 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1139,6 +1139,7 @@ CV*
 perl_get_cv(char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVCV);
+    /* XXX unsafe for threads if eval_owner isn't held */
     if (create && !GvCVu(gv))
        return newSUB(start_subparse(FALSE, 0),
                      newSVOP(OP_CONST, 0, newSVpv(name,0)),
@@ -1441,8 +1442,10 @@ perl_eval_pv(char *p, I32 croak_on_error)
     sv = POPs;
     PUTBACK;
 
-    if (croak_on_error && SvTRUE(ERRSV))
-       croak(SvPVx(ERRSV, PL_na));
+    if (croak_on_error && SvTRUE(ERRSV)) {
+       STRLEN n_a;
+       croak(SvPVx(ERRSV, n_a));
+    }
 
     return sv;
 }
@@ -2096,6 +2099,7 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
        croak("Can't stat script \"%s\"",PL_origfilename);
     if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
        I32 len;
+       STRLEN n_a;
 
 #ifdef IAMSUID
 #ifndef HAS_SETREUID
@@ -2168,12 +2172,12 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
        PL_doswitches = FALSE;          /* -s is insecure in suid */
        PL_curcop->cop_line++;
        if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
-         strnNE(SvPV(PL_linestr,PL_na),"#!",2) )       /* required even on Sys V */
+         strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
            croak("No #! line");
-       s = SvPV(PL_linestr,PL_na)+2;
+       s = SvPV(PL_linestr,n_a)+2;
        if (*s == ' ') s++;
        while (!isSPACE(*s)) s++;
-       for (s2 = s;  (s2 > SvPV(PL_linestr,PL_na)+2 &&
+       for (s2 = s;  (s2 > SvPV(PL_linestr,n_a)+2 &&
                       (isDIGIT(s2[-1]) || strchr("._-", s2[-1])));  s2--) ;
        if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
            croak("Not a perl script");
@@ -2712,7 +2716,7 @@ incpush(char *p, int addsubdirs)
            char *unix;
            STRLEN len;
 
-           if ((unix = tounixspec_ts(SvPV(libdir,PL_na),Nullch)) != Nullch) {
+           if ((unix = tounixspec_ts(SvPV(libdir,len),Nullch)) != Nullch) {
                len = strlen(unix);
                while (unix[len-1] == '/') len--;  /* Cosmetic */
                sv_usepvn(libdir,unix,len);
@@ -2720,7 +2724,7 @@ incpush(char *p, int addsubdirs)
            else
                PerlIO_printf(PerlIO_stderr(),
                              "Failed to unixify @INC element \"%s\"\n",
-                             SvPV(libdir,PL_na));
+                             SvPV(libdir,len));
 #endif
            /* .../archname/version if -d .../archname/version/auto */
            sv_setsv(subdir, libdir);
index ad84b47..ffb3fe6 100644 (file)
@@ -178,3 +178,6 @@ PERLVARIC(Gpatleave,        char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}")
 
 PERLVAR(Gspecialsv_list[4],SV *)       /* from byterun.h */
 
+#ifdef USE_THREADS
+PERLVAR(Gcred_mutex,      perl_mutex)     /* altered credentials in effect */
+#endif
diff --git a/perly.c b/perly.c
index 7a53d4b..4bf717d 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -1772,7 +1772,7 @@ case 56:
 break;
 case 57:
 #line 302 "perly.y"
-{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na);
+{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a);
                          if (strEQ(name, "BEGIN") || strEQ(name, "END")
                              || strEQ(name, "INIT"))
                              CvUNIQUE_on(PL_compcv);
diff --git a/perly.y b/perly.y
index e016cf4..1e48771 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -299,7 +299,7 @@ startformsub:       /* NULL */      /* start a format subroutine scope */
                        { $$ = start_subparse(TRUE, 0); }
        ;
 
-subname        :       WORD    { char *name = SvPV(((SVOP*)$1)->op_sv, PL_na);
+subname        :       WORD    { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv, n_a);
                          if (strEQ(name, "BEGIN") || strEQ(name, "END")
                              || strEQ(name, "INIT"))
                              CvUNIQUE_on(PL_compcv);
index b049c58..01b97b2 100644 (file)
@@ -971,7 +971,8 @@ and some C to call it
         /* Check the eval first */
         if (SvTRUE(ERRSV))
         {
-            printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ;
+            STRLEN n_a;
+            printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ;
             POPs ;
         }
         else
@@ -1013,7 +1014,8 @@ The code
 
     if (SvTRUE(ERRSV))
     {
-        printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ;
+        STRLEN n_a;
+        printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ;
         POPs ;
     }
 
index c09d6e3..1314350 100644 (file)
@@ -285,6 +285,7 @@ the first, a C<float> from the second, and a C<char *> from the third.
    
    main (int argc, char **argv, char **env)
    {
+       STRLEN n_a;
        char *embedding[] = { "", "-e", "0" };
    
        my_perl = perl_alloc();
@@ -303,7 +304,7 @@ the first, a C<float> from the second, and a C<char *> from the third.
    
        /** Treat $a as a string **/
        perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
-       printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), PL_na));
+       printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a));
    
        perl_destruct(my_perl);
        perl_free(my_perl);
@@ -325,8 +326,9 @@ possible and in most cases a better strategy to fetch the return value
 from I<perl_eval_pv()> instead.  Example:
 
    ...
+   STRLEN n_a;
    SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE);
-   printf("%s\n", SvPV(val,PL_na));
+   printf("%s\n", SvPV(val,n_a));
    ...
 
 This way, we avoid namespace pollution by not creating global
@@ -371,6 +373,7 @@ been wrapped here):
  {
      dSP;
      SV* retval;
+     STRLEN n_a;
  
      PUSHMARK(SP);
      perl_eval_sv(sv, G_SCALAR);
@@ -380,7 +383,7 @@ been wrapped here):
      PUTBACK;
  
      if (croak_on_error && SvTRUE(ERRSV))
-       croak(SvPVx(ERRSV, PL_na));
+       croak(SvPVx(ERRSV, n_a));
  
      return retval;
  }
@@ -395,9 +398,10 @@ been wrapped here):
  I32 match(SV *string, char *pattern)
  {
      SV *command = NEWSV(1099, 0), *retval;
+     STRLEN n_a;
  
      sv_setpvf(command, "my $string = '%s'; $string =~ %s",
-             SvPV(string,PL_na), pattern);
+             SvPV(string,n_a), pattern);
  
      retval = my_perl_eval_sv(command, TRUE);
      SvREFCNT_dec(command);
@@ -416,9 +420,10 @@ been wrapped here):
  I32 substitute(SV **string, char *pattern)
  {
      SV *command = NEWSV(1099, 0), *retval;
+     STRLEN n_a;
  
      sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
-             SvPV(*string,PL_na), pattern);
+             SvPV(*string,n_a), pattern);
  
      retval = my_perl_eval_sv(command, TRUE);
      SvREFCNT_dec(command);
@@ -439,9 +444,10 @@ been wrapped here):
  {
      SV *command = NEWSV(1099, 0);
      I32 num_matches;
+     STRLEN n_a;
  
      sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
-             SvPV(string,PL_na), pattern);
+             SvPV(string,n_a), pattern);
  
      my_perl_eval_sv(command, TRUE);
      SvREFCNT_dec(command);
@@ -459,6 +465,7 @@ been wrapped here):
      AV *match_list;
      I32 num_matches, i;
      SV *text = NEWSV(1099,0);
+     STRLEN n_a;
  
      perl_construct(my_perl);
      perl_parse(my_perl, NULL, 3, embedding, NULL);
@@ -480,7 +487,7 @@ been wrapped here):
      printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
  
      for (i = 0; i < num_matches; i++)
-       printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),PL_na));
+       printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),n_a));
      printf("\n");
  
      /** Remove all vowels from text **/
@@ -488,7 +495,7 @@ been wrapped here):
      if (num_matches) {
        printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
               num_matches);
-       printf("Now text is: %s\n\n", SvPV(text,PL_na));
+       printf("Now text is: %s\n\n", SvPV(text,n_a));
      }
  
      /** Attempt a substitution **/
@@ -726,6 +733,7 @@ with L<perlfunc/my> whenever possible.
      char *args[] = { "", DO_CLEAN, NULL };
      char filename [1024];
      int exitstatus = 0;
+     STRLEN n_a;
 
      if((perl = perl_alloc()) == NULL) {
         fprintf(stderr, "no memory!");
@@ -747,7 +755,7 @@ with L<perlfunc/my> whenever possible.
 
             /* check $@ */
             if(SvTRUE(ERRSV))
-                fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,PL_na));
+                fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,n_a));
         }
      }
 
index b268a0b..f958c7f 100644 (file)
@@ -95,7 +95,8 @@ or string.
 
 In the C<SvPV> macro, the length of the string returned is placed into the
 variable C<len> (this is a macro, so you do I<not> use C<&len>).  If you do not
-care what the length of the data is, use the global variable C<PL_na>.  Remember,
+care what the length of the data is, use the global variable C<PL_na>, though
+this is rather less efficient than using a local variable.  Remember,
 however, that Perl allows arbitrary strings of data that may both contain
 NULs and might not be terminated by a NUL.
 
@@ -1634,7 +1635,7 @@ the SV which holds the name of the sub being debugged.  This is the C
 variable which corresponds to Perl's $DB::sub variable.  See C<PL_DBsingle>.
 The sub name can be found by
 
-       SvPV( GvSV( PL_DBsub ), PL_na )
+       SvPV( GvSV( PL_DBsub ), len )
 
 =item PL_DBtrace
 
@@ -1854,7 +1855,8 @@ Returns the key slot of the hash entry as a C<char*> value, doing any
 necessary dereferencing of possibly C<SV*> keys.  The length of
 the string is placed in C<len> (this is a macro, so do I<not> use
 C<&len>).  If you do not care about what the length of the key is,
-you may use the global variable C<PL_na>.  Remember though, that hash
+you may use the global variable C<PL_na>, though this is rather less
+efficient than using a local variable.  Remember though, that hash
 keys in perl are free to contain embedded nulls, so using C<strlen()>
 or similar is not a good way to find the length of hash keys.
 This is very similar to the C<SvPV()> macro described elsewhere in
@@ -2177,8 +2179,9 @@ the type.  Can do overlapping moves.  See also C<Copy>.
 
 =item PL_na
 
-A variable which may be used with C<SvPV> to tell Perl to calculate the
-string length.
+A convenience variable which is typically used with C<SvPV> when one doesn't
+care about the length of the string.  It is usually more efficient to
+declare a local variable and use that instead.
 
 =item New
 
@@ -3006,8 +3009,7 @@ Checks the B<private> setting.  Use C<SvPOK>.
 =item SvPV
 
 Returns a pointer to the string in the SV, or a stringified form of the SV
-if the SV does not contain a string.  If C<len> is C<PL_na> then Perl will
-handle the length on its own.  Handles 'get' magic.
+if the SV does not contain a string.  Handles 'get' magic.
 
        char*   SvPV (SV* sv, int len )
 
index 2e02247..3f05782 100644 (file)
@@ -553,9 +553,10 @@ The XS code, with ellipsis, follows.
           time_t timep = NO_INIT
          PREINIT:
           char *host = "localhost";
+          STRLEN n_a;
           CODE:
                  if( items > 1 )
-                      host = (char *)SvPV(ST(1), PL_na);
+                      host = (char *)SvPV(ST(1), n_a);
                  RETVAL = rpcb_gettime( host, &timep );
           OUTPUT:
           timep
@@ -786,9 +787,10 @@ prototypes.
          PROTOTYPE: $;$
          PREINIT:
           char *host = "localhost";
+          STRLEN n_a;
           CODE:
                  if( items > 1 )
-                      host = (char *)SvPV(ST(1), PL_na);
+                      host = (char *)SvPV(ST(1), n_a);
                  RETVAL = rpcb_gettime( host, &timep );
           OUTPUT:
           timep
diff --git a/pp.c b/pp.c
index 4a498ac..f905c80 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -224,6 +224,7 @@ PP(pp_rv2gv)
     else {
        if (SvTYPE(sv) != SVt_PVGV) {
            char *sym;
+           STRLEN n_a;
 
            if (SvGMAGICAL(sv)) {
                mg_get(sv);
@@ -238,7 +239,7 @@ PP(pp_rv2gv)
                    warn(warn_uninit);
                RETSETUNDEF;
            }
-           sym = SvPV(sv, PL_na);
+           sym = SvPV(sv, n_a);
            if (PL_op->op_private & HINT_STRICT_REFS)
                DIE(no_symref, sym, "a symbol");
            sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
@@ -267,6 +268,7 @@ PP(pp_rv2sv)
     else {
        GV *gv = (GV*)sv;
        char *sym;
+       STRLEN n_a;
 
        if (SvTYPE(gv) != SVt_PVGV) {
            if (SvGMAGICAL(sv)) {
@@ -282,7 +284,7 @@ PP(pp_rv2sv)
                    warn(warn_uninit);
                RETSETUNDEF;
            }
-           sym = SvPV(sv, PL_na);
+           sym = SvPV(sv, n_a);
            if (PL_op->op_private & HINT_STRICT_REFS)
                DIE(no_symref, sym, "a SCALAR");
            gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
@@ -533,9 +535,10 @@ PP(pp_gelem)
     SV *tmpRef;
     char *elem;
     djSP;
+    STRLEN n_a;
 
     sv = POPs;
-    elem = SvPV(sv, PL_na);
+    elem = SvPV(sv, n_a);
     gv = (GV*)POPs;
     tmpRef = Nullsv;
     sv = Nullsv;
@@ -1792,8 +1795,9 @@ PP(pp_hex)
     djSP; dTARGET;
     char *tmps;
     I32 argtype;
+    STRLEN n_a;
 
-    tmps = POPp;
+    tmps = POPpx;
     XPUSHu(scan_hex(tmps, 99, &argtype));
     RETURN;
 }
@@ -1804,8 +1808,9 @@ PP(pp_oct)
     UV value;
     I32 argtype;
     char *tmps;
+    STRLEN n_a;
 
-    tmps = POPp;
+    tmps = POPpx;
     while (*tmps && isSPACE(*tmps))
        tmps++;
     if (*tmps == '0')
@@ -1898,7 +1903,8 @@ PP(pp_substr)
        if (lvalue) {                   /* it's an lvalue! */
            if (!SvGMAGICAL(sv)) {
                if (SvROK(sv)) {
-                   SvPV_force(sv,PL_na);
+                   STRLEN n_a;
+                   SvPV_force(sv,n_a);
                    if (PL_dowarn)
                        warn("Attempt to use reference as lvalue in substr");
                }
@@ -2099,13 +2105,14 @@ PP(pp_ord)
     djSP; dTARGET;
     I32 value;
     char *tmps;
+    STRLEN n_a;
 
 #ifndef I286
-    tmps = POPp;
+    tmps = POPpx;
     value = (I32) (*tmps & 255);
 #else
     I32 anum;
-    tmps = POPp;
+    tmps = POPpx;
     anum = (I32) *tmps;
     value = (I32) (anum & 255);
 #endif
@@ -2132,12 +2139,13 @@ PP(pp_chr)
 PP(pp_crypt)
 {
     djSP; dTARGET; dPOPTOPssrl;
+    STRLEN n_a;
 #ifdef HAS_CRYPT
-    char *tmps = SvPV(left, PL_na);
+    char *tmps = SvPV(left, n_a);
 #ifdef FCRYPT
-    sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na)));
+    sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
 #else
-    sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na)));
+    sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
 #endif
 #else
     DIE(
@@ -2152,6 +2160,7 @@ PP(pp_ucfirst)
     djSP;
     SV *sv = TOPs;
     register char *s;
+    STRLEN n_a;
 
     if (!SvPADTMP(sv)) {
        dTARGET;
@@ -2159,7 +2168,7 @@ PP(pp_ucfirst)
        sv = TARG;
        SETs(sv);
     }
-    s = SvPV_force(sv, PL_na);
+    s = SvPV_force(sv, n_a);
     if (*s) {
        if (PL_op->op_private & OPpLOCALE) {
            TAINT;
@@ -2178,6 +2187,7 @@ PP(pp_lcfirst)
     djSP;
     SV *sv = TOPs;
     register char *s;
+    STRLEN n_a;
 
     if (!SvPADTMP(sv)) {
        dTARGET;
@@ -2185,7 +2195,7 @@ PP(pp_lcfirst)
        sv = TARG;
        SETs(sv);
     }
-    s = SvPV_force(sv, PL_na);
+    s = SvPV_force(sv, n_a);
     if (*s) {
        if (PL_op->op_private & OPpLOCALE) {
            TAINT;
@@ -2460,8 +2470,10 @@ PP(pp_hslice)
                svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
            }
            if (lval) {
-               if (!svp || *svp == &PL_sv_undef)
-                   DIE(no_helem, SvPV(keysv, PL_na));
+               if (!svp || *svp == &PL_sv_undef) {
+                   STRLEN n_a;
+                   DIE(no_helem, SvPV(keysv, n_a));
+               }
                if (PL_op->op_private & OPpLVAL_INTRO)
                    save_helem(hv, keysv, svp);
            }
@@ -3451,6 +3463,7 @@ PP(pp_unpack)
                    }
                    else if (++bytes >= sizeof(UV)) {   /* promote to string */
                        char *t;
+                       STRLEN n_a;
 
                        sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
                        while (s < strend) {
@@ -3460,7 +3473,7 @@ PP(pp_unpack)
                                break;
                            }
                        }
-                       t = SvPV(sv, PL_na);
+                       t = SvPV(sv, n_a);
                        while (*t == '0')
                            t++;
                        sv_chop(sv, t);
@@ -3708,8 +3721,9 @@ doencodes(register SV *sv, register char *s, register I32 len)
 STATIC SV      *
 is_an_int(char *s, STRLEN l)
 {
+  STRLEN          n_a;
   SV             *result = newSVpv("", l);
-  char           *result_c = SvPV(result, PL_na);      /* convenience */
+  char           *result_c = SvPV(result, n_a);        /* convenience */
   char           *out = result_c;
   bool            skip = 1;
   bool            ignore = 0;
@@ -4204,6 +4218,7 @@ PP(pp_pack)
                if (fromstr == &PL_sv_undef)
                    aptr = NULL;
                else {
+                   STRLEN n_a;
                    /* XXX better yet, could spirit away the string to
                     * a safe spot and hang on to it until the result
                     * of pack() (and all copies of the result) are
@@ -4212,9 +4227,9 @@ PP(pp_pack)
                    if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
                        warn("Attempt to pack pointer to temporary value");
                    if (SvPOK(fromstr) || SvNIOK(fromstr))
-                       aptr = SvPV(fromstr,PL_na);
+                       aptr = SvPV(fromstr,n_a);
                    else
-                       aptr = SvPV_force(fromstr,PL_na);
+                       aptr = SvPV_force(fromstr,n_a);
                }
                sv_catpvn(cat, (char*)&aptr, sizeof(char*));
            }
diff --git a/pp.h b/pp.h
index 6fe91f4..de5aaea 100644 (file)
--- a/pp.h
+++ b/pp.h
 #define RETURNX(x)     return x, PUTBACK, NORMAL
 
 #define POPs           (*sp--)
-#define POPp           (SvPVx(POPs, PL_na))
+#define POPp           (SvPVx(POPs, PL_na))            /* deprecated */
+#define POPpx          (SvPVx(POPs, n_a))
 #define POPn           (SvNVx(POPs))
 #define POPi           ((IV)SvIVx(POPs))
 #define POPu           ((UV)SvUVx(POPs))
 #define POPl           ((long)SvIVx(POPs))
 
 #define TOPs           (*sp)
-#define TOPp           (SvPV(TOPs, PL_na))
+#define TOPp           (SvPV(TOPs, PL_na))             /* deprecated */
+#define TOPpx          (SvPV(TOPs, n_a))
 #define TOPn           (SvNV(TOPs))
 #define TOPi           ((IV)SvIV(TOPs))
 #define TOPu           ((UV)SvUV(TOPs))
index 874dddc..0ca7a06 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -789,8 +789,10 @@ PP(pp_sort)
            if (!PL_sortcop && !SvPOK(*up)) {
                if (SvAMAGIC(*up))
                    overloading = 1;
-               else
-                   (void)sv_2pv(*up, &PL_na);
+               else {
+                   STRLEN n_a;
+                   (void)sv_2pv(*up, &n_a);
+               }
            }
            up++;
        }
@@ -921,10 +923,11 @@ PP(pp_flop)
        else {
            SV *final = sv_mortalcopy(right);
            STRLEN len;
+           STRLEN n_a;
            char *tmps = SvPV(final, len);
 
            sv = sv_mortalcopy(left);
-           SvPV_force(sv,PL_na);
+           SvPV_force(sv,n_a);
            while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
                XPUSHs(sv);
                if (strEQ(SvPVX(sv),tmps))
@@ -1139,6 +1142,7 @@ OP *
 die_where(char *message)
 {
     dSP;
+    STRLEN n_a;
     if (PL_in_eval) {
        I32 cxix;
        register PERL_CONTEXT *cx;
@@ -1170,7 +1174,7 @@ die_where(char *message)
                sv_setpv(ERRSV, message);
        }
        else
-           message = SvPVx(ERRSV, PL_na);
+           message = SvPVx(ERRSV, n_a);
 
        while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
            dounwind(-1);
@@ -1197,14 +1201,14 @@ die_where(char *message)
            LEAVE;
 
            if (optype == OP_REQUIRE) {
-               char* msg = SvPVx(ERRSV, PL_na);
+               char* msg = SvPVx(ERRSV, n_a);
                DIE("%s", *msg ? msg : "Compilation failed in require");
            }
            return pop_return();
        }
     }
     if(!message)
-       message = SvPVx(ERRSV, PL_na);
+       message = SvPVx(ERRSV, n_a);
     PerlIO_printf(PerlIO_stderr(), "%s",message);
     PerlIO_flush(PerlIO_stderr());
     my_failure_exit();
@@ -1382,11 +1386,12 @@ PP(pp_reset)
 {
     djSP;
     char *tmps;
+    STRLEN n_a;
 
     if (MAXARG < 1)
        tmps = "";
     else
-       tmps = POPp;
+       tmps = POPpx;
     sv_reset(tmps, PL_curcop->cop_stash);
     PUSHs(&PL_sv_yes);
     RETURN;
@@ -1842,6 +1847,7 @@ PP(pp_goto)
     label = 0;
     if (PL_op->op_flags & OPf_STACKED) {
        SV *sv = POPs;
+       STRLEN n_a;
 
        /* This egregious kludge implements goto &subroutine */
        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
@@ -2091,7 +2097,7 @@ PP(pp_goto)
            }
        }
        else
-           label = SvPV(sv,PL_na);
+           label = SvPV(sv,n_a);
     }
     else if (PL_op->op_flags & OPf_SPECIAL) {
        if (! do_dump)
@@ -2240,7 +2246,8 @@ PP(pp_cswitch)
     if (PL_multiline)
        PL_op = PL_op->op_next;                 /* can't assume anything */
     else {
-       match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255;
+       STRLEN n_a;
+       match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255;
        match -= cCOP->uop.scop.scop_offset;
        if (match < 0)
            match = 0;
@@ -2477,6 +2484,7 @@ doeval(int gimme, OP** startop)
        I32 gimme;
        PERL_CONTEXT *cx;
        I32 optype = 0;                 /* Might be reset by POPEVAL. */
+       STRLEN n_a;
 
        PL_op = saveop;
        if (PL_eval_root) {
@@ -2492,10 +2500,10 @@ doeval(int gimme, OP** startop)
        lex_end();
        LEAVE;
        if (optype == OP_REQUIRE) {
-           char* msg = SvPVx(ERRSV, PL_na);
+           char* msg = SvPVx(ERRSV, n_a);
            DIE("%s", *msg ? msg : "Compilation failed in require");
        } else if (startop) {
-           char* msg = SvPVx(ERRSV, PL_na);
+           char* msg = SvPVx(ERRSV, n_a);
 
            POPBLOCK(cx,PL_curpm);
            POPEVAL(cx);
@@ -2568,13 +2576,14 @@ PP(pp_require)
     SV** svp;
     I32 gimme = G_SCALAR;
     PerlIO *tryrsfp = 0;
+    STRLEN n_a;
 
     sv = POPs;
     if (SvNIOKp(sv) && !SvPOKp(sv)) {
        SET_NUMERIC_STANDARD();
        if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
            DIE("Perl %s required--this is only version %s, stopped",
-               SvPV(sv,PL_na),PL_patchlevel);
+               SvPV(sv,n_a),PL_patchlevel);
        RETPUSHYES;
     }
     name = SvPV(sv, len);
@@ -2617,7 +2626,7 @@ PP(pp_require)
        {
            namesv = NEWSV(806, 0);
            for (i = 0; i <= AvFILL(ar); i++) {
-               char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
+               char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
 #ifdef VMS
                char *unixdir;
                if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
@@ -2653,7 +2662,7 @@ PP(pp_require)
                sv_catpv(msg, " (did you run h2ph?)");
            sv_catpv(msg, " (@INC contains:");
            for (i = 0; i <= AvFILL(ar); i++) {
-               char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
+               char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
                sv_setpvf(dirmsgsv, " %s", dir);
                sv_catsv(msg, dirmsgsv);
            }
index bd7da2b..fbe73ab 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -304,6 +304,7 @@ PP(pp_print)
     IO *io;
     register PerlIO *fp;
     MAGIC *mg;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_STACKED)
        gv = (GV*)*++MARK;
@@ -335,7 +336,7 @@ PP(pp_print)
        if (PL_dowarn) {
            SV* sv = sv_newmortal();
             gv_fullname3(sv, gv, Nullch);
-            warn("Filehandle %s never opened", SvPV(sv,PL_na));
+            warn("Filehandle %s never opened", SvPV(sv,n_a));
         }
 
        SETERRNO(EBADF,RMS$_IFI);
@@ -346,9 +347,9 @@ PP(pp_print)
            SV* sv = sv_newmortal();
             gv_fullname3(sv, gv, Nullch);
            if (IoIFP(io))
-               warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
+               warn("Filehandle %s opened only for input", SvPV(sv,n_a));
            else
-               warn("print on closed filehandle %s", SvPV(sv,PL_na));
+               warn("print on closed filehandle %s", SvPV(sv,n_a));
        }
        SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
        goto just_say_no;
@@ -425,6 +426,7 @@ PP(pp_rv2av)
            
            if (SvTYPE(sv) != SVt_PVGV) {
                char *sym;
+               STRLEN n_a;
 
                if (SvGMAGICAL(sv)) {
                    mg_get(sv);
@@ -441,7 +443,7 @@ PP(pp_rv2av)
                        RETURN;
                    RETPUSHUNDEF;
                }
-               sym = SvPV(sv,PL_na);
+               sym = SvPV(sv,n_a);
                if (PL_op->op_private & HINT_STRICT_REFS)
                    DIE(no_symref, sym, "an ARRAY");
                gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
@@ -509,6 +511,7 @@ PP(pp_rv2hv)
            
            if (SvTYPE(sv) != SVt_PVGV) {
                char *sym;
+               STRLEN n_a;
 
                if (SvGMAGICAL(sv)) {
                    mg_get(sv);
@@ -527,7 +530,7 @@ PP(pp_rv2hv)
                    }
                    RETSETUNDEF;
                }
-               sym = SvPV(sv,PL_na);
+               sym = SvPV(sv,n_a);
                if (PL_op->op_private & HINT_STRICT_REFS)
                    DIE(no_symref, sym, "a HASH");
                gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
@@ -1357,8 +1360,10 @@ PP(pp_helem)
        if (!svp || *svp == &PL_sv_undef) {
            SV* lv;
            SV* key2;
-           if (!defer)
-               DIE(no_helem, SvPV(keysv, PL_na));
+           if (!defer) {
+               STRLEN n_a;
+               DIE(no_helem, SvPV(keysv, n_a));
+           }
            lv = sv_newmortal();
            sv_upgrade(lv, SVt_PVLV);
            LvTYPE(lv) = 'y';
@@ -1984,6 +1989,7 @@ PP(pp_entersub)
     default:
        if (!SvROK(sv)) {
            char *sym;
+           STRLEN n_a;
 
            if (sv == &PL_sv_yes) {             /* unfound import, ignore */
                if (hasargs)
@@ -1995,7 +2001,7 @@ PP(pp_entersub)
                sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
            }
            else
-               sym = SvPV(sv, PL_na);
+               sym = SvPV(sv, n_a);
            if (!sym)
                DIE(no_usym, "a subroutine");
            if (PL_op->op_private & HINT_STRICT_REFS)
@@ -2132,8 +2138,7 @@ PP(pp_entersub)
         * (3) instead of (2) so we'd have to clone. Would the fact
         * that we released the mutex more quickly make up for this?
         */
-       if (PL_threadnum &&
-           (svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
+       if ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
        {
            /* We already have a clone to use */
            MUTEX_UNLOCK(CvMUTEXP(cv));
@@ -2486,7 +2491,7 @@ PP(pp_method)
        }
     }
 
-    name = SvPV(TOPs, PL_na);
+    name = SvPV(TOPs, packlen);
     sv = *(PL_stack_base + TOPMARK + 1);
     
     if (SvGMAGICAL(sv))
index eb2b1a2..a67c1bd 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -190,7 +190,8 @@ PP(pp_backtick)
 {
     djSP; dTARGET;
     PerlIO *fp;
-    char *tmps = POPp;
+    STRLEN n_a;
+    char *tmps = POPpx;
     I32 gimme = GIMME_V;
 
     TAINT_PROPER("``");
@@ -274,7 +275,8 @@ PP(pp_glob)
 #if 0          /* XXX never used! */
 PP(pp_indread)
 {
-    PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), PL_na), TRUE,SVt_PVIO);
+    STRLEN n_a;
+    PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), n_a), TRUE,SVt_PVIO);
     return do_readline();
 }
 #endif
@@ -289,21 +291,22 @@ PP(pp_warn)
 {
     djSP; dMARK;
     char *tmps;
+    STRLEN n_a;
     if (SP - MARK != 1) {
        dTARGET;
        do_join(TARG, &PL_sv_no, MARK, SP);
-       tmps = SvPV(TARG, PL_na);
+       tmps = SvPV(TARG, n_a);
        SP = MARK + 1;
     }
     else {
-       tmps = SvPV(TOPs, PL_na);
+       tmps = SvPV(TOPs, n_a);
     }
     if (!tmps || !*tmps) {
        SV *error = ERRSV;
        (void)SvUPGRADE(error, SVt_PV);
        if (SvPOK(error) && SvCUR(error))
            sv_catpv(error, "\t...caught");
-       tmps = SvPV(error, PL_na);
+       tmps = SvPV(error, n_a);
     }
     if (!tmps || !*tmps)
        tmps = "Warning: something's wrong";
@@ -317,15 +320,16 @@ PP(pp_die)
     char *tmps;
     SV *tmpsv = Nullsv;
     char *pat = "%s";
+    STRLEN n_a;
     if (SP - MARK != 1) {
        dTARGET;
        do_join(TARG, &PL_sv_no, MARK, SP);
-       tmps = SvPV(TARG, PL_na);
+       tmps = SvPV(TARG, n_a);
        SP = MARK + 1;
     }
     else {
        tmpsv = TOPs;
-       tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, PL_na);
+       tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, n_a);
     }
     if (!tmps || !*tmps) {
        SV *error = ERRSV;
@@ -355,7 +359,7 @@ PP(pp_die)
        else {
            if (SvPOK(error) && SvCUR(error))
                sv_catpv(error, "\t...propagated");
-           tmps = SvPV(error, PL_na);
+           tmps = SvPV(error, n_a);
        }
     }
     if (!tmps || !*tmps)
@@ -585,8 +589,9 @@ PP(pp_tie)
         */
        stash = gv_stashsv(*MARK, FALSE);
        if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
+           STRLEN n_a;
            DIE("Can't locate object method \"%s\" via package \"%s\"",
-                methname, SvPV(*MARK,PL_na));                   
+                methname, SvPV(*MARK,n_a));                   
        }
        ENTER;
        PUSHSTACKi(PERLSI_MAGIC);
@@ -724,6 +729,7 @@ PP(pp_sselect)
     struct timeval *tbuf = &timebuf;
     I32 growsize;
     char *fd_sets[4];
+    STRLEN n_a;
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
        I32 masksize;
        I32 offset;
@@ -792,7 +798,7 @@ PP(pp_sselect)
            continue;
        }
        else if (!SvPOK(sv))
-           SvPV_force(sv,PL_na);       /* force string conversion */
+           SvPV_force(sv,n_a); /* force string conversion */
        j = SvLEN(sv);
        if (j < growsize) {
            Sv_Grow(sv, growsize);
@@ -1119,6 +1125,7 @@ PP(pp_prtf)
     PerlIO *fp;
     SV *sv;
     MAGIC *mg;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_STACKED)
        gv = (GV*)*++MARK;
@@ -1149,7 +1156,7 @@ PP(pp_prtf)
     if (!(io = GvIO(gv))) {
        if (PL_dowarn) {
            gv_fullname3(sv, gv, Nullch);
-           warn("Filehandle %s never opened", SvPV(sv,PL_na));
+           warn("Filehandle %s never opened", SvPV(sv,n_a));
        }
        SETERRNO(EBADF,RMS$_IFI);
        goto just_say_no;
@@ -1158,9 +1165,9 @@ PP(pp_prtf)
        if (PL_dowarn)  {
            gv_fullname3(sv, gv, Nullch);
            if (IoIFP(io))
-               warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
+               warn("Filehandle %s opened only for input", SvPV(sv,n_a));
            else
-               warn("printf on closed filehandle %s", SvPV(sv,PL_na));
+               warn("printf on closed filehandle %s", SvPV(sv,n_a));
        }
        SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
        goto just_say_no;
@@ -1510,11 +1517,12 @@ PP(pp_truncate)
     Off_t len = (Off_t)POPn;
     int result = 1;
     GV *tmpgv;
+    STRLEN n_a;
 
     SETERRNO(0,0);
 #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
     if (PL_op->op_flags & OPf_SPECIAL) {
-       tmpgv = gv_fetchpv(POPp, FALSE, SVt_PVIO);
+       tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
     do_ftruncate:
        TAINT_PROPER("truncate");
        if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
@@ -1538,7 +1546,7 @@ PP(pp_truncate)
            goto do_ftruncate;
        }
 
-       name = SvPV(sv, PL_na);
+       name = SvPV(sv, n_a);
        TAINT_PROPER("truncate");
 #ifdef HAS_TRUNCATE
        if (truncate(name, len) < 0)
@@ -2016,8 +2024,9 @@ PP(pp_ssockopt)
            char *buf;
            int aint;
            if (SvPOKp(sv)) {
-               buf = SvPV(sv, PL_na);
-               len = PL_na;
+               STRLEN l;
+               buf = SvPV(sv, l);
+               len = l;
            }
            else {
                aint = (int)SvIV(sv);
@@ -2130,6 +2139,7 @@ PP(pp_stat)
     GV *tmpgv;
     I32 gimme;
     I32 max = 13;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF) {
        tmpgv = cGVOP->op_gv;
@@ -2154,17 +2164,17 @@ PP(pp_stat)
            tmpgv = (GV*)SvRV(sv);
            goto do_fstat;
        }
-       sv_setpv(PL_statname, SvPV(sv,PL_na));
+       sv_setpv(PL_statname, SvPV(sv,n_a));
        PL_statgv = Nullgv;
 #ifdef HAS_LSTAT
        PL_laststype = PL_op->op_type;
        if (PL_op->op_type == OP_LSTAT)
-           PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, PL_na), &PL_statcache);
+           PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
        else
 #endif
-           PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache);
+           PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
        if (PL_laststatval < 0) {
-           if (PL_dowarn && strchr(SvPV(PL_statname, PL_na), '\n'))
+           if (PL_dowarn && strchr(SvPV(PL_statname, n_a), '\n'))
                warn(warn_nl, "stat");
            max = 0;
        }
@@ -2478,6 +2488,7 @@ PP(pp_fttty)
     int fd;
     GV *gv;
     char *tmps = Nullch;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP->op_gv;
@@ -2486,7 +2497,7 @@ PP(pp_fttty)
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
        gv = (GV*)SvRV(POPs);
     else
-       gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
+       gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO);
 
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
        fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
@@ -2518,6 +2529,7 @@ PP(pp_fttext)
     register IO *io;
     register SV *sv;
     GV *gv;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP->op_gv;
@@ -2581,14 +2593,14 @@ PP(pp_fttext)
       really_filename:
        PL_statgv = Nullgv;
        PL_laststatval = -1;
-       sv_setpv(PL_statname, SvPV(sv, PL_na));
+       sv_setpv(PL_statname, SvPV(sv, n_a));
 #ifdef HAS_OPEN3
-       i = PerlLIO_open3(SvPV(sv, PL_na), O_RDONLY, 0);
+       i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0);
 #else
-       i = PerlLIO_open(SvPV(sv, PL_na), 0);
+       i = PerlLIO_open(SvPV(sv, n_a), 0);
 #endif
        if (i < 0) {
-           if (PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
+           if (PL_dowarn && strchr(SvPV(sv, n_a), '\n'))
                warn(warn_nl, "open");
            RETPUSHUNDEF;
        }
@@ -2644,26 +2656,27 @@ PP(pp_chdir)
     djSP; dTARGET;
     char *tmps;
     SV **svp;
+    STRLEN n_a;
 
     if (MAXARG < 1)
        tmps = Nullch;
     else
-       tmps = POPp;
+       tmps = POPpx;
     if (!tmps || !*tmps) {
        svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
        if (svp)
-           tmps = SvPV(*svp, PL_na);
+           tmps = SvPV(*svp, n_a);
     }
     if (!tmps || !*tmps) {
        svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
        if (svp)
-           tmps = SvPV(*svp, PL_na);
+           tmps = SvPV(*svp, n_a);
     }
 #ifdef VMS
     if (!tmps || !*tmps) {
        svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
        if (svp)
-           tmps = SvPV(*svp, PL_na);
+           tmps = SvPV(*svp, n_a);
     }
 #endif
     TAINT_PROPER("chdir");
@@ -2694,8 +2707,9 @@ PP(pp_chroot)
 {
     djSP; dTARGET;
     char *tmps;
+    STRLEN n_a;
 #ifdef HAS_CHROOT
-    tmps = POPp;
+    tmps = POPpx;
     TAINT_PROPER("chroot");
     PUSHi( chroot(tmps) >= 0 );
     RETURN;
@@ -2738,9 +2752,10 @@ PP(pp_rename)
 {
     djSP; dTARGET;
     int anum;
+    STRLEN n_a;
 
-    char *tmps2 = POPp;
-    char *tmps = SvPV(TOPs, PL_na);
+    char *tmps2 = POPpx;
+    char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("rename");
 #ifdef HAS_RENAME
     anum = PerlLIO_rename(tmps, tmps2);
@@ -2764,8 +2779,9 @@ PP(pp_link)
 {
     djSP; dTARGET;
 #ifdef HAS_LINK
-    char *tmps2 = POPp;
-    char *tmps = SvPV(TOPs, PL_na);
+    STRLEN n_a;
+    char *tmps2 = POPpx;
+    char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("link");
     SETi( link(tmps, tmps2) >= 0 );
 #else
@@ -2778,8 +2794,9 @@ PP(pp_symlink)
 {
     djSP; dTARGET;
 #ifdef HAS_SYMLINK
-    char *tmps2 = POPp;
-    char *tmps = SvPV(TOPs, PL_na);
+    STRLEN n_a;
+    char *tmps2 = POPpx;
+    char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("symlink");
     SETi( symlink(tmps, tmps2) >= 0 );
     RETURN;
@@ -2795,11 +2812,12 @@ PP(pp_readlink)
     char *tmps;
     char buf[MAXPATHLEN];
     int len;
+    STRLEN n_a;
 
 #ifndef INCOMPLETE_TAINTS
     TAINT;
 #endif
-    tmps = POPp;
+    tmps = POPpx;
     len = readlink(tmps, buf, sizeof buf);
     EXTEND(SP, 1);
     if (len < 0)
@@ -2908,7 +2926,8 @@ PP(pp_mkdir)
 #ifndef HAS_MKDIR
     int oldumask;
 #endif
-    char *tmps = SvPV(TOPs, PL_na);
+    STRLEN n_a;
+    char *tmps = SvPV(TOPs, n_a);
 
     TAINT_PROPER("mkdir");
 #ifdef HAS_MKDIR
@@ -2926,8 +2945,9 @@ PP(pp_rmdir)
 {
     djSP; dTARGET;
     char *tmps;
+    STRLEN n_a;
 
-    tmps = POPp;
+    tmps = POPpx;
     TAINT_PROPER("rmdir");
 #ifdef HAS_RMDIR
     XPUSHi( PerlDir_rmdir(tmps) >= 0 );
@@ -2943,7 +2963,8 @@ PP(pp_open_dir)
 {
     djSP;
 #if defined(Direntry_t) && defined(HAS_READDIR)
-    char *dirname = POPp;
+    STRLEN n_a;
+    char *dirname = POPpx;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
 
@@ -3188,10 +3209,11 @@ PP(pp_system)
     int result;
     int status;
     Sigsave_t ihand,qhand;     /* place to save signals during system() */
+    STRLEN n_a;
 
     if (SP - MARK == 1) {
        if (PL_tainting) {
-           char *junk = SvPV(TOPs, PL_na);
+           char *junk = SvPV(TOPs, n_a);
            TAINT_ENV();
            TAINT_PROPER("system");
        }
@@ -3227,7 +3249,7 @@ PP(pp_system)
     else if (SP - MARK != 1)
        value = (I32)do_aexec(Nullsv, MARK, SP);
     else {
-       value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
+       value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
     }
     PerlProc__exit(-1);
 #else /* ! FORK or VMS or OS/2 */
@@ -3238,7 +3260,7 @@ PP(pp_system)
     else if (SP - MARK != 1)
        value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
     else {
-       value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na));
+       value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
     }
     STATUS_NATIVE_SET(value);
     do_execfree();
@@ -3252,6 +3274,7 @@ PP(pp_exec)
 {
     djSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_STACKED) {
        SV *really = *++MARK;
@@ -3265,14 +3288,14 @@ PP(pp_exec)
 #endif
     else {
        if (PL_tainting) {
-           char *junk = SvPV(*SP, PL_na);
+           char *junk = SvPV(*SP, n_a);
            TAINT_ENV();
            TAINT_PROPER("exec");
        }
 #ifdef VMS
-       value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
+       value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
 #else
-       value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
+       value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
 #endif
     }
     SP = ORIGMARK;
@@ -3697,12 +3720,14 @@ PP(pp_ghostent)
     unsigned long len;
 
     EXTEND(SP, 10);
-    if (which == OP_GHBYNAME)
+    if (which == OP_GHBYNAME) {
 #ifdef HAS_GETHOSTBYNAME
-       hent = PerlSock_gethostbyname(POPp);
+       STRLEN n_a;
+       hent = PerlSock_gethostbyname(POPpx);
 #else
        DIE(no_sock_func, "gethostbyname");
 #endif
+    }
     else if (which == OP_GHBYADDR) {
 #ifdef HAS_GETHOSTBYADDR
        int addrtype = POPi;
@@ -3803,12 +3828,14 @@ PP(pp_gnetent)
 #endif
     struct netent *nent;
 
-    if (which == OP_GNBYNAME)
+    if (which == OP_GNBYNAME) {
 #ifdef HAS_GETNETBYNAME
-       nent = PerlSock_getnetbyname(POPp);
+       STRLEN n_a;
+       nent = PerlSock_getnetbyname(POPpx);
 #else
         DIE(no_sock_func, "getnetbyname");
 #endif
+    }
     else if (which == OP_GNBYADDR) {
 #ifdef HAS_GETNETBYADDR
        int addrtype = POPi;
@@ -3890,12 +3917,14 @@ PP(pp_gprotoent)
 #endif
     struct protoent *pent;
 
-    if (which == OP_GPBYNAME)
+    if (which == OP_GPBYNAME) {
 #ifdef HAS_GETPROTOBYNAME
-       pent = PerlSock_getprotobyname(POPp);
+       STRLEN n_a;
+       pent = PerlSock_getprotobyname(POPpx);
 #else
        DIE(no_sock_func, "getprotobyname");
 #endif
+    }
     else if (which == OP_GPBYNUMBER)
 #ifdef HAS_GETPROTOBYNUMBER
        pent = PerlSock_getprotobynumber(POPi);
@@ -3974,8 +4003,9 @@ PP(pp_gservent)
 
     if (which == OP_GSBYNAME) {
 #ifdef HAS_GETSERVBYNAME
-       char *proto = POPp;
-       char *name = POPp;
+       STRLEN n_a;
+       char *proto = POPpx;
+       char *name = POPpx;
 
        if (proto && !*proto)
            proto = Nullch;
@@ -3987,7 +4017,8 @@ PP(pp_gservent)
     }
     else if (which == OP_GSBYPORT) {
 #ifdef HAS_GETSERVBYPORT
-       char *proto = POPp;
+       STRLEN n_a;
+       char *proto = POPpx;
        unsigned short port = POPu;
 
 #ifdef HAS_HTONS
@@ -4164,9 +4195,10 @@ PP(pp_gpwent)
     I32 which = PL_op->op_type;
     register SV *sv;
     struct passwd *pwent;
+    STRLEN n_a;
 
     if (which == OP_GPWNAM)
-       pwent = getpwnam(POPp);
+       pwent = getpwnam(POPpx);
     else if (which == OP_GPWUID)
        pwent = getpwuid(POPi);
     else
@@ -4297,9 +4329,10 @@ PP(pp_ggrent)
     register char **elem;
     register SV *sv;
     struct group *grent;
+    STRLEN n_a;
 
     if (which == OP_GGRNAM)
-       grent = (struct group *)getgrnam(POPp);
+       grent = (struct group *)getgrnam(POPpx);
     else if (which == OP_GGRGID)
        grent = (struct group *)getgrgid(POPi);
     else
@@ -4412,8 +4445,10 @@ PP(pp_syscall)
            a[i++] = SvIV(*MARK);
        else if (*MARK == &PL_sv_undef)
            a[i++] = 0;
-       else 
-           a[i++] = (unsigned long)SvPV_force(*MARK, PL_na);
+       else  {
+           STRLEN n_a;
+           a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
+       }
        if (i > 15)
            break;
     }
diff --git a/run.c b/run.c
index 97444ec..0a3f10b 100644 (file)
--- a/run.c
+++ b/run.c
@@ -77,6 +77,7 @@ debop(OP *o)
 {
 #ifdef DEBUGGING
     SV *sv;
+    STRLEN n_a;
     deb("%s", op_name[o->op_type]);
     switch (o->op_type) {
     case OP_CONST:
@@ -87,7 +88,7 @@ debop(OP *o)
        if (cGVOPo->op_gv) {
            sv = NEWSV(0,0);
            gv_fullname3(sv, cGVOPo->op_gv, Nullch);
-           PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, PL_na));
+           PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
            SvREFCNT_dec(sv);
        }
        else
diff --git a/sv.c b/sv.c
index 86c83ea..881cfdd 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1070,7 +1070,7 @@ sv_peek(SV *sv)
        while (unref--)
            sv_catpv(t, ")");
     }
-    return SvPV(t, PL_na);
+    return SvPV(t, prevlen);
 #else  /* DEBUGGING */
     return "";
 #endif /* DEBUGGING */
@@ -3892,6 +3892,7 @@ sv_2io(SV *sv)
 {
     IO* io;
     GV* gv;
+    STRLEN n_a;
 
     switch (SvTYPE(sv)) {
     case SVt_PVIO:
@@ -3908,13 +3909,13 @@ sv_2io(SV *sv)
            croak(no_usym, "filehandle");
        if (SvROK(sv))
            return sv_2io(SvRV(sv));
-       gv = gv_fetchpv(SvPV(sv,PL_na), FALSE, SVt_PVIO);
+       gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO);
        if (gv)
            io = GvIO(gv);
        else
            io = 0;
        if (!io)
-           croak("Bad filehandle: %s", SvPV(sv,PL_na));
+           croak("Bad filehandle: %s", SvPV(sv,n_a));
        break;
     }
     return io;
@@ -3925,6 +3926,7 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
 {
     GV *gv;
     CV *cv;
+    STRLEN n_a;
 
     if (!sv)
        return *gvp = Nullgv, Nullcv;
@@ -3962,7 +3964,7 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
        else if (isGV(sv))
            gv = (GV*)sv;
        else
-           gv = gv_fetchpv(SvPV(sv, PL_na), lref, SVt_PVCV);
+           gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV);
        *gvp = gv;
        if (!gv)
            return Nullcv;
@@ -3979,7 +3981,7 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
                   Nullop);
            LEAVE;
            if (!GvCVu(gv))
-               croak("Unable to create sub named \"%s\"", SvPV(sv,PL_na));
+               croak("Unable to create sub named \"%s\"", SvPV(sv,n_a));
        }
        return GvCVu(gv);
     }
@@ -5097,8 +5099,10 @@ sv_dump(SV *sv)
            PerlIO_printf(Perl_debug_log, "  NAME = \"%s\"\n", HvNAME(sv));
        break;
     case SVt_PVCV:
-       if (SvPOK(sv))
-           PerlIO_printf(Perl_debug_log, "  PROTOTYPE = \"%s\"\n", SvPV(sv,PL_na));
+       if (SvPOK(sv)) {
+           STRLEN n_a;
+           PerlIO_printf(Perl_debug_log, "  PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
+       }
        /* FALL THROUGH */
     case SVt_PVFM:
        PerlIO_printf(Perl_debug_log, "  STASH = 0x%lx\n", (long)CvSTASH(sv));
diff --git a/taint.c b/taint.c
index 6bb9aa7..7a62d98 100644 (file)
--- a/taint.c
+++ b/taint.c
@@ -89,9 +89,10 @@ taint_env(void)
     svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
     if (svp && *svp && SvTAINTED(*svp)) {
        dTHR;   /* just for taint */
+       STRLEN n_a;
        bool was_tainted = PL_tainted;
-       char *t = SvPV(*svp, PL_na);
-       char *e = t + PL_na;
+       char *t = SvPV(*svp, n_a);
+       char *e = t + n_a;
        PL_tainted = was_tainted;
        if (t < e && isALNUM(*t))
            t++;
index 035c5ca..5bef894 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -138,6 +138,8 @@ struct perl_thread *getTHR _((void));
  * from thrsv which is cached in the per-interpreter structure.
  * Systems with very fast pthread_get_specific (which should be all systems
  * but unfortunately isn't) may wish to simplify to "...*thr = THR".
+ *
+ * The use of PL_threadnum should be safe here.
  */
 #ifndef dTHR
 #  define dTHR \
@@ -160,30 +162,27 @@ struct perl_thread *getTHR _((void));
  * try only locking them if there may be more than one thread in existence.
  * Systems with very fast mutexes (and/or slow conditionals) may wish to
  * remove the "if (threadnum) ..." test.
+ * XXX do NOT use C<if (PL_threadnum) ...> -- it sets up race conditions!
  */
 #define LOCK_SV_MUTEX                          \
     STMT_START {                               \
-       if (PL_threadnum)                       \
-           MUTEX_LOCK(&PL_sv_mutex);           \
+       MUTEX_LOCK(&PL_sv_mutex);               \
     } STMT_END
 
 #define UNLOCK_SV_MUTEX                                \
     STMT_START {                               \
-       if (PL_threadnum)                       \
-           MUTEX_UNLOCK(&PL_sv_mutex);         \
+       MUTEX_UNLOCK(&PL_sv_mutex);             \
     } STMT_END
 
 /* Likewise for strtab_mutex */
 #define LOCK_STRTAB_MUTEX                      \
     STMT_START {                               \
-       if (PL_threadnum)                       \
-           MUTEX_LOCK(&PL_strtab_mutex);       \
+       MUTEX_LOCK(&PL_strtab_mutex);   \
     } STMT_END
 
 #define UNLOCK_STRTAB_MUTEX                    \
     STMT_START {                               \
-       if (PL_threadnum)                       \
-           MUTEX_UNLOCK(&PL_strtab_mutex);     \
+       MUTEX_UNLOCK(&PL_strtab_mutex); \
     } STMT_END
 
 #ifndef THREAD_RET_TYPE
diff --git a/toke.c b/toke.c
index b3def5e..2a2a78d 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1317,8 +1317,10 @@ filter_add(filter_t funcp, SV *datasv)
     if (!SvUPGRADE(datasv, SVt_PVIO))
         die("Can't upgrade filter_add data to SVt_PVIO");
     IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
-    if (filter_debug)
-       warn("filter_add func %p (%s)", funcp, SvPV(datasv,PL_na));
+    if (filter_debug) {
+       STRLEN n_a;
+       warn("filter_add func %p (%s)", funcp, SvPV(datasv,n_a));
+    }
     av_unshift(PL_rsfp_filters, 1);
     av_store(PL_rsfp_filters, 0, datasv) ;
     return(datasv);
@@ -1394,9 +1396,11 @@ filter_read(int idx, SV *buf_sv, int maxlen)
     }
     /* Get function pointer hidden within datasv       */
     funcp = (filter_t)IoDIRP(datasv);
-    if (filter_debug)
+    if (filter_debug) {
+       STRLEN n_a;
        warn("filter_read %d: via function %p (%s)\n",
-               idx, funcp, SvPV(datasv,PL_na));
+               idx, funcp, SvPV(datasv,n_a));
+    }
     /* Call function. The function is expected to      */
     /* call "FILTER_READ(idx+1, buf_sv)" first.                */
     /* Return: <0:error, =0:eof, >0:not eof            */
@@ -2822,6 +2826,7 @@ yylex(void)
     case 'z': case 'Z':
 
       keylookup: {
+       STRLEN n_a;
        gv = Nullgv;
        gvp = 0;
 
@@ -3016,7 +3021,7 @@ yylex(void)
                    if (gv && GvCVu(gv)) {
                        CV *cv;
                        if ((cv = GvCV(gv)) && SvPOK(cv))
-                           PL_last_proto = SvPV((SV*)cv, PL_na);
+                           PL_last_proto = SvPV((SV*)cv, n_a);
                        for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
                        if (*d == ')' && (sv = cv_const_sv(cv))) {
                            s = d + 1;
@@ -3972,7 +3977,7 @@ yylex(void)
                PL_lex_stuff = Nullsv;
            }
 
-           if (*SvPV(PL_subname,PL_na) == '?') {
+           if (*SvPV(PL_subname,n_a) == '?') {
                sv_setpv(PL_subname,"__ANON__");
                TOKEN(ANONSUB);
            }
index b323a2a..aba150e 100644 (file)
@@ -111,12 +111,13 @@ XS(XS_UNIVERSAL_isa)
     dXSARGS;
     SV *sv;
     char *name;
+    STRLEN n_a;
 
     if (items != 2)
        croak("Usage: UNIVERSAL::isa(reference, kind)");
 
     sv = ST(0);
-    name = (char *)SvPV(ST(1),PL_na);
+    name = (char *)SvPV(ST(1),n_a);
 
     ST(0) = boolSV(sv_derived_from(sv, name));
     XSRETURN(1);
@@ -129,12 +130,13 @@ XS(XS_UNIVERSAL_can)
     char *name;
     SV   *rv;
     HV   *pkg = NULL;
+    STRLEN n_a;
 
     if (items != 2)
        croak("Usage: UNIVERSAL::can(object-ref, method)");
 
     sv = ST(0);
-    name = (char *)SvPV(ST(1),PL_na);
+    name = (char *)SvPV(ST(1),n_a);
     rv = &PL_sv_undef;
 
     if(SvROK(sv)) {
@@ -189,9 +191,11 @@ XS(XS_UNIVERSAL_VERSION)
         undef = "(undef)";
     }
 
-    if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv))))
+    if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) {
+       STRLEN n_a;
        croak("%s version %s required--this is only version %s",
-             HvNAME(pkg), SvPV(ST(1),PL_na), undef ? undef : SvPV(sv,PL_na));
+             HvNAME(pkg), SvPV(ST(1),n_a), undef ? undef : SvPV(sv,n_a));
+    }
 
     ST(0) = sv;
 
diff --git a/util.c b/util.c
index 0ef51aa..e3e5cc5 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2757,10 +2757,6 @@ new_struct_thread(struct perl_thread *t)
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
 
-    PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
-    PL_defstash = t->Tdefstash;   /* XXX maybe these should */
-    PL_curstash = t->Tcurstash;   /* always be set to main? */
-
 
     /* top_env needs to be non-zero. It points to an area
        in which longjmp() stuff is stored, as C callstack
@@ -2778,6 +2774,25 @@ new_struct_thread(struct perl_thread *t)
     PL_in_eval = FALSE;
     PL_restartop = 0;
 
+    PL_statname = NEWSV(66,0);
+    PL_maxscream = -1;
+    PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
+    PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
+    PL_regindent = 0;
+    PL_reginterp_cnt = 0;
+    PL_lastscream = Nullsv;
+    PL_screamfirst = 0;
+    PL_screamnext = 0;
+    PL_reg_start_tmp = 0;
+    PL_reg_start_tmpl = 0;
+
+    /* parent thread's data needs to be locked while we make copy */
+    MUTEX_LOCK(&t->mutex);
+
+    PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
+    PL_defstash = t->Tdefstash;   /* XXX maybe these should */
+    PL_curstash = t->Tcurstash;   /* always be set to main? */
+
     PL_tainted = t->Ttainted;
     PL_curpm = t->Tcurpm;         /* XXX No PMOP ref count */
     PL_nrs = newSVsv(t->Tnrs);
@@ -2791,18 +2806,6 @@ new_struct_thread(struct perl_thread *t)
     PL_bodytarget = newSVsv(t->Tbodytarget);
     PL_toptarget = newSVsv(t->Ttoptarget);
 
-    PL_statname = NEWSV(66,0);
-    PL_maxscream = -1;
-    PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
-    PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
-    PL_regindent = 0;
-    PL_reginterp_cnt = 0;
-    PL_lastscream = Nullsv;
-    PL_screamfirst = 0;
-    PL_screamnext = 0;
-    PL_reg_start_tmp = 0;
-    PL_reg_start_tmpl = 0;
-    
     /* Initialise all per-thread SVs that the template thread used */
     svp = AvARRAY(t->threadsv);
     for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) {
@@ -2825,6 +2828,9 @@ new_struct_thread(struct perl_thread *t)
     thr->next->prev = thr;
     MUTEX_UNLOCK(&PL_threads_mutex);
 
+    /* done copying parent's state */
+    MUTEX_UNLOCK(&t->mutex);
+
 #ifdef HAVE_THREAD_INTERN
     init_thread_intern(thr);
 #endif /* HAVE_THREAD_INTERN */
index 6fa1b29..53b4915 100644 (file)
@@ -164,11 +164,12 @@ setdef(...)
            struct FAB deffab = cc$rms_fab;
            struct NAM defnam = cc$rms_nam;
            struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+           STRLEN n_a;
            if (items) {
                SV *defsv = ST(items-1);  /* mimic chdir() */
                ST(0) = &PL_sv_undef;
                if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); }
-               if (tovmsspec(SvPV(defsv,PL_na),vmsdef) == NULL) { XSRETURN(1); }
+               if (tovmsspec(SvPV(defsv,n_a),vmsdef) == NULL) { XSRETURN(1); }
                deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef);
            }
            else {
@@ -232,6 +233,7 @@ vmsopen(spec,...)
            char *args[8],mode[3] = {'r','\0','\0'}, type = '<';
            register int i, myargc;
            FILE *fp;
+           STRLEN n_a;
        
            if (!spec || !*spec) {
               SETERRNO(EINVAL,LIB$_INVARG);
@@ -250,7 +252,7 @@ vmsopen(spec,...)
            }
            else if (*spec == '<') spec++;
            myargc = items - 1;
-           for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),PL_na);
+           for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),n_a);
            /* This hack brought to you by C's opaque arglist management */
            switch (myargc) {
              case 0:
@@ -298,13 +300,14 @@ vmssysopen(spec,mode,perm,...)
            int i, myargc, fd;
            FILE *fp;
            SV *fh;
+           STRLEN n_a;
            if (!spec || !*spec) {
               SETERRNO(EINVAL,LIB$_INVARG);
               XSRETURN_UNDEF;
            }
            if (items > 11) croak("too many args");
            myargc = items - 3;
-           for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),PL_na);
+           for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),n_a);
            /* More fun with C calls; can't combine with above because
               args 2,3 of different types in fopen() and open() */
            switch (myargc) {
index 95e0dcc..78287b3 100644 (file)
@@ -1774,7 +1774,7 @@ case 56:
 break;
 case 57:
 #line 294 "perly.y"
-{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na);
+{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a);
                          if (strEQ(name, "BEGIN") || strEQ(name, "END")
                              || strEQ(name, "INIT"))
                              CvUNIQUE_on(PL_compcv);
index 6bfbe3c..bc09b08 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -2848,6 +2848,7 @@ setup_argstr(SV *really, SV **mark, SV **sp)
   register size_t cmdlen = 0;
   size_t rlen;
   register SV **idx;
+  STRLEN n_a;
 
   idx = mark;
   if (really) {
@@ -2874,7 +2875,7 @@ setup_argstr(SV *really, SV **mark, SV **sp)
   while (++mark <= sp) {
     if (*mark) {
       strcat(PL_Cmd," ");
-      strcat(PL_Cmd,SvPVx(*mark,PL_na));
+      strcat(PL_Cmd,SvPVx(*mark,n_a));
     }
   }
   return PL_Cmd;
@@ -4407,12 +4408,13 @@ rmsexpand_fromperl(CV *cv)
 {
   dXSARGS;
   char *fspec, *defspec = NULL, *rslt;
+  STRLEN n_a;
 
   if (!items || items > 2)
     croak("Usage: VMS::Filespec::rmsexpand(spec[,defspec])");
-  fspec = SvPV(ST(0),PL_na);
+  fspec = SvPV(ST(0),n_a);
   if (!fspec || !*fspec) XSRETURN_UNDEF;
-  if (items == 2) defspec = SvPV(ST(1),PL_na);
+  if (items == 2) defspec = SvPV(ST(1),n_a);
 
   rslt = do_rmsexpand(fspec,NULL,1,defspec,0);
   ST(0) = sv_newmortal();
@@ -4425,9 +4427,10 @@ vmsify_fromperl(CV *cv)
 {
   dXSARGS;
   char *vmsified;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)");
-  vmsified = do_tovmsspec(SvPV(ST(0),PL_na),NULL,1);
+  vmsified = do_tovmsspec(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified));
   XSRETURN(1);
@@ -4438,9 +4441,10 @@ unixify_fromperl(CV *cv)
 {
   dXSARGS;
   char *unixified;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)");
-  unixified = do_tounixspec(SvPV(ST(0),PL_na),NULL,1);
+  unixified = do_tounixspec(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified));
   XSRETURN(1);
@@ -4451,9 +4455,10 @@ fileify_fromperl(CV *cv)
 {
   dXSARGS;
   char *fileified;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)");
-  fileified = do_fileify_dirspec(SvPV(ST(0),PL_na),NULL,1);
+  fileified = do_fileify_dirspec(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified));
   XSRETURN(1);
@@ -4464,9 +4469,10 @@ pathify_fromperl(CV *cv)
 {
   dXSARGS;
   char *pathified;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)");
-  pathified = do_pathify_dirspec(SvPV(ST(0),PL_na),NULL,1);
+  pathified = do_pathify_dirspec(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified));
   XSRETURN(1);
@@ -4477,9 +4483,10 @@ vmspath_fromperl(CV *cv)
 {
   dXSARGS;
   char *vmspath;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)");
-  vmspath = do_tovmspath(SvPV(ST(0),PL_na),NULL,1);
+  vmspath = do_tovmspath(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath));
   XSRETURN(1);
@@ -4490,9 +4497,10 @@ unixpath_fromperl(CV *cv)
 {
   dXSARGS;
   char *unixpath;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)");
-  unixpath = do_tounixpath(SvPV(ST(0),PL_na),NULL,1);
+  unixpath = do_tounixpath(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath));
   XSRETURN(1);
@@ -4505,6 +4513,7 @@ candelete_fromperl(CV *cv)
   char fspec[NAM$C_MAXRSS+1], *fsp;
   SV *mysv;
   IO *io;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
 
@@ -4518,7 +4527,7 @@ candelete_fromperl(CV *cv)
     fsp = fspec;
   }
   else {
-    if (mysv != ST(0) || !(fsp = SvPV(mysv,PL_na)) || !*fsp) {
+    if (mysv != ST(0) || !(fsp = SvPV(mysv,n_a)) || !*fsp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);
@@ -4540,6 +4549,7 @@ rmscopy_fromperl(CV *cv)
   unsigned long int sts;
   SV *mysv;
   IO *io;
+  STRLEN n_a;
 
   if (items < 2 || items > 3)
     croak("Usage: File::Copy::rmscopy(from,to[,date_flag])");
@@ -4554,7 +4564,7 @@ rmscopy_fromperl(CV *cv)
     inp = inspec;
   }
   else {
-    if (mysv != ST(0) || !(inp = SvPV(mysv,PL_na)) || !*inp) {
+    if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);
@@ -4570,7 +4580,7 @@ rmscopy_fromperl(CV *cv)
     outp = outspec;
   }
   else {
-    if (mysv != ST(1) || !(outp = SvPV(mysv,PL_na)) || !*outp) {
+    if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);
index be5f5e1..4bb073c 100644 (file)
@@ -469,6 +469,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     int status;
     int flag = P_WAIT;
     int index = 0;
+    STRLEN n_a;
 
     if (sp <= mark)
        return -1;
@@ -482,7 +483,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     }
 
     while (++mark <= sp) {
-       if (*mark && (str = SvPV(*mark, PL_na)))
+       if (*mark && (str = SvPV(*mark, n_a)))
            argv[index++] = str;
        else
            argv[index++] = "";
@@ -490,7 +491,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     argv[index++] = 0;
    
     status = win32_spawnvp(flag,
-                          (const char*)(really ? SvPV(really,PL_na) : argv[0]),
+                          (const char*)(really ? SvPV(really,n_a) : argv[0]),
                           (const char* const*)argv);
 
     if (status < 0 && errno == ENOEXEC) {
@@ -503,7 +504,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
            argv[sh_items] = w32_perlshell_vec[sh_items];
    
        status = win32_spawnvp(flag,
-                              (const char*)(really ? SvPV(really,PL_na) : argv[0]),
+                              (const char*)(really ? SvPV(really,n_a) : argv[0]),
                               (const char* const*)argv);
     }
 
@@ -2158,9 +2159,10 @@ static
 XS(w32_SetCwd)
 {
     dXSARGS;
+    STRLEN n_a;
     if (items != 1)
        croak("usage: Win32::SetCurrentDirectory($cwd)");
-    if (SetCurrentDirectory(SvPV(ST(0),PL_na)))
+    if (SetCurrentDirectory(SvPV(ST(0),n_a)))
        XSRETURN_YES;
 
     XSRETURN_NO;
@@ -2339,12 +2341,13 @@ XS(w32_Spawn)
     PROCESS_INFORMATION stProcInfo;
     STARTUPINFO stStartInfo;
     BOOL bSuccess = FALSE;
+    STRLEN n_a;
 
     if (items != 3)
        croak("usage: Win32::Spawn($cmdName, $args, $PID)");
 
-    cmd = SvPV(ST(0),PL_na);
-    args = SvPV(ST(1), PL_na);
+    cmd = SvPV(ST(0),n_a);
+    args = SvPV(ST(1), n_a);
 
     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
     stStartInfo.cb = sizeof(stStartInfo);          /* Set the structure size */
index 1eb0e87..b40c5aa 100644 (file)
@@ -92,7 +92,6 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
     DWORD junk;
     unsigned long th;
 
-    MUTEX_LOCK(&thr->mutex);
     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                          "%p: create OS thread\n", thr));
 #ifdef USE_RTL_THREAD_API
@@ -126,7 +125,6 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
 #endif /* !USE_RTL_THREAD_API */
     DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                          "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
-    MUTEX_UNLOCK(&thr->mutex);
     return thr->self ? 0 : -1;
 }
 #endif