{
djSP;
if (GIMME_V == G_SCALAR)
- XPUSHs(&sv_undef);
+ XPUSHs(&PL_sv_undef);
RETURN;
}
PP(pp_padav)
{
djSP; dTARGET;
- if (op->op_private & OPpLVAL_INTRO)
- SAVECLEARSV(curpad[op->op_targ]);
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ SAVECLEARSV(PL_curpad[PL_op->op_targ]);
EXTEND(SP, 1);
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
PUSHs(TARG);
RETURN;
}
U32 i;
for (i=0; i < maxarg; i++) {
SV **svp = av_fetch((AV*)TARG, i, FALSE);
- SP[i+1] = (svp) ? *svp : &sv_undef;
+ SP[i+1] = (svp) ? *svp : &PL_sv_undef;
}
}
else {
I32 gimme;
XPUSHs(TARG);
- if (op->op_private & OPpLVAL_INTRO)
- SAVECLEARSV(curpad[op->op_targ]);
- if (op->op_flags & OPf_REF)
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+ if (PL_op->op_flags & OPf_REF)
RETURN;
gimme = GIMME_V;
if (gimme == G_ARRAY) {
goto wasref;
}
if (!SvOK(sv)) {
- if (op->op_flags & OPf_REF ||
- op->op_private & HINT_STRICT_REFS)
+ if (PL_op->op_flags & OPf_REF ||
+ PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a symbol");
- if (dowarn)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
RETSETUNDEF;
}
- sym = SvPV(sv, na);
- if (op->op_private & HINT_STRICT_REFS)
+ sym = SvPV(sv, PL_na);
+ if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a symbol");
sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
}
}
- if (op->op_private & OPpLVAL_INTRO)
- save_gp((GV*)sv, !(op->op_flags & OPf_SPECIAL));
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL));
SETs(sv);
RETURN;
}
goto wasref;
}
if (!SvOK(sv)) {
- if (op->op_flags & OPf_REF ||
- op->op_private & HINT_STRICT_REFS)
+ if (PL_op->op_flags & OPf_REF ||
+ PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a SCALAR");
- if (dowarn)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
RETSETUNDEF;
}
- sym = SvPV(sv, na);
- if (op->op_private & HINT_STRICT_REFS)
+ sym = SvPV(sv, PL_na);
+ if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a SCALAR");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
}
sv = GvSV(gv);
}
- if (op->op_flags & OPf_MOD) {
- if (op->op_private & OPpLVAL_INTRO)
+ if (PL_op->op_flags & OPf_MOD) {
+ if (PL_op->op_private & OPpLVAL_INTRO)
sv = save_scalar((GV*)TOPs);
- else if (op->op_private & OPpDEREF)
- vivify_ref(sv, op->op_private & OPpDEREF);
+ else if (PL_op->op_private & OPpDEREF)
+ vivify_ref(sv, PL_op->op_private & OPpDEREF);
}
SETs(sv);
RETURN;
{
djSP; dTARGET; dPOPss;
- if (op->op_flags & OPf_MOD) {
+ if (PL_op->op_flags & OPf_MOD) {
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
sv_magic(TARG, Nullsv, '.', Nullch, 0);
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
mg = mg_find(sv, 'g');
if (mg && mg->mg_len >= 0) {
- PUSHi(mg->mg_len + curcop->cop_arybase);
+ I32 i = mg->mg_len;
+ if (IN_UTF8)
+ sv_pos_b2u(sv, &i);
+ PUSHi(i + PL_curcop->cop_arybase);
RETURN;
}
}
/* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
/* (But not in defined().) */
- CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
+ CV *cv = sv_2cv(TOPs, &stash, &gv, !(PL_op->op_flags & OPf_SPECIAL));
if (cv) {
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
}
else
- cv = (CV*)&sv_undef;
+ cv = (CV*)&PL_sv_undef;
SETs((SV*)cv);
RETURN;
}
GV *gv;
SV *ret;
- ret = &sv_undef;
+ ret = &PL_sv_undef;
if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
char *s = SvPVX(TOPs);
if (strnEQ(s, "CORE::", 6)) {
PP(pp_anoncode)
{
djSP;
- CV* cv = (CV*)curpad[op->op_targ];
+ CV* cv = (CV*)PL_curpad[PL_op->op_targ];
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
EXTEND(SP,1);
if (++MARK <= SP)
*MARK = *SP;
else
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
*MARK = refto(*MARK);
SP = MARK;
RETURN;
if (LvTARGLEN(sv))
vivify_defelem(sv);
if (!(sv = LvTARG(sv)))
- sv = &sv_undef;
+ sv = &PL_sv_undef;
}
else if (SvPADTMP(sv))
sv = newSVsv(sv);
HV *stash;
if (MAXARG == 1)
- stash = curcop->cop_stash;
+ stash = PL_curcop->cop_stash;
else {
SV *ssv = POPs;
STRLEN len;
char *ptr = SvPV(ssv,len);
- if (dowarn && len == 0)
- warn("Explicit blessing to '' (assuming package main)");
+ if (ckWARN(WARN_UNSAFE) && len == 0)
+ warner(WARN_UNSAFE,
+ "Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
djSP;
sv = POPs;
- elem = SvPV(sv, na);
+ elem = SvPV(sv, PL_na);
gv = (GV*)POPs;
tmpRef = Nullsv;
sv = Nullsv;
if (sv)
sv_2mortal(sv);
else
- sv = &sv_undef;
+ sv = &PL_sv_undef;
XPUSHs(sv);
RETURN;
}
register I32 *snext;
STRLEN len;
- if(unop->op_first && unop->op_first->op_type == OP_PUSHRE) {
- PMOP *pm = (PMOP *)unop->op_first;
- SV *rv = sv_newmortal();
- sv = newSVrv(rv, "Regexp");
- sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
- RETURNX(PUSHs(rv));
- }
-
- if (sv == lastscream) {
+ if (sv == PL_lastscream) {
if (SvSCREAM(sv))
RETPUSHYES;
}
else {
- if (lastscream) {
- SvSCREAM_off(lastscream);
- SvREFCNT_dec(lastscream);
+ if (PL_lastscream) {
+ SvSCREAM_off(PL_lastscream);
+ SvREFCNT_dec(PL_lastscream);
}
- lastscream = SvREFCNT_inc(sv);
+ PL_lastscream = SvREFCNT_inc(sv);
}
s = (unsigned char*)(SvPV(sv, len));
pos = len;
if (pos <= 0)
RETPUSHNO;
- if (pos > maxscream) {
- if (maxscream < 0) {
- maxscream = pos + 80;
- New(301, screamfirst, 256, I32);
- New(302, screamnext, maxscream, I32);
+ if (pos > PL_maxscream) {
+ if (PL_maxscream < 0) {
+ PL_maxscream = pos + 80;
+ New(301, PL_screamfirst, 256, I32);
+ New(302, PL_screamnext, PL_maxscream, I32);
}
else {
- maxscream = pos + pos / 4;
- Renew(screamnext, maxscream, I32);
+ PL_maxscream = pos + pos / 4;
+ Renew(PL_screamnext, PL_maxscream, I32);
}
}
- sfirst = screamfirst;
- snext = screamnext;
+ sfirst = PL_screamfirst;
+ snext = PL_screamnext;
if (!sfirst || !snext)
DIE("do_study: out of memory");
djSP; dTARG;
SV *sv;
- if (op->op_flags & OPf_STACKED)
+ if (PL_op->op_flags & OPf_STACKED)
sv = POPs;
else {
sv = DEFSV;
EXTEND(SP,1);
}
TARG = sv_newmortal();
- PUSHi(do_trans(sv, op));
+ PUSHi(do_trans(sv));
RETURN;
}
djSP;
SV *sv;
- if (!op->op_private) {
+ if (!PL_op->op_private) {
EXTEND(SP, 1);
RETPUSHUNDEF;
}
hv_undef((HV*)sv);
break;
case SVt_PVCV:
- if (dowarn && cv_const_sv((CV*)sv))
- warn("Constant subroutine %s undefined",
+ if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
+ warner(WARN_UNSAFE, "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
break;
case SVt_PVGV:
if (SvFAKE(sv))
- SvSetMagicSV(sv, &sv_undef);
+ SvSetMagicSV(sv, &PL_sv_undef);
else {
GP *gp;
gp_free((GV*)sv);
Newz(602, gp, 1, GP);
GvGP(sv) = gp_ref(gp);
GvSV(sv) = NEWSV(72,0);
- GvLINE(sv) = curcop->cop_line;
+ GvLINE(sv) = PL_curcop->cop_line;
GvEGV(sv) = (GV*)sv;
GvMULTI_on(sv);
}
djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
{
register I32 count = POPi;
- if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
+ if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
I32 items = SP - MARK;
I32 max;
tmpstr = POPs;
if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
- if (SvREADONLY(tmpstr) && curcop != &compiling)
+ if (SvREADONLY(tmpstr) && PL_curcop != &PL_compiling)
DIE("Can't x= to readonly value");
if (SvROK(tmpstr))
sv_unref(tmpstr);
djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
IBW shift = POPi;
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW i = TOPi;
i = BWi(i) << shift;
SETi(BWi(i));
djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
IBW shift = POPi;
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW i = TOPi;
i = BWi(i) >> shift;
SETi(BWi(i));
else if (left > right)
value = 1;
else {
- SETs(&sv_undef);
+ SETs(&PL_sv_undef);
RETURN;
}
SETi(value);
djSP; tryAMAGICbinSET(slt,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp < 0));
djSP; tryAMAGICbinSET(sgt,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp > 0));
djSP; tryAMAGICbinSET(sle,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp <= 0));
djSP; tryAMAGICbinSET(sge,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp >= 0));
djSP; dTARGET; tryAMAGICbin(scmp,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETi( cmp );
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW value = SvIV(left) & SvIV(right);
SETi(BWi(value));
}
}
}
else {
- do_vop(op->op_type, TARG, left, right);
+ do_vop(PL_op->op_type, TARG, left, right);
SETTARG;
}
RETURN;
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
SETi(BWi(value));
}
}
}
else {
- do_vop(op->op_type, TARG, left, right);
+ do_vop(PL_op->op_type, TARG, left, right);
SETTARG;
}
RETURN;
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
SETi(BWi(value));
}
}
}
else {
- do_vop(op->op_type, TARG, left, right);
+ do_vop(PL_op->op_type, TARG, left, right);
SETTARG;
}
RETURN;
sv_setsv(TARG, sv);
*SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
}
+ else if (IN_UTF8 && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) {
+ sv_setpvn(TARG, "-", 1);
+ sv_catsv(TARG, sv);
+ }
else
sv_setnv(TARG, -SvNV(sv));
SETTARG;
#ifdef OVERLOAD
djSP; tryAMAGICunSET(not);
#endif /* OVERLOAD */
- *stack_sp = boolSV(!SvTRUE(*stack_sp));
+ *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
return NORMAL;
}
{
dTOPss;
if (SvNIOKp(sv)) {
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW value = ~SvIV(sv);
SETi(BWi(value));
}
}
}
+/* Support Configure command-line overrides for rand() functions.
+ After 5.005, perhaps we should replace this by Configure support
+ for drand48(), random(), or rand(). For 5.005, though, maintain
+ compatibility by calling rand() but allow the user to override it.
+ See INSTALL for details. --Andy Dougherty 15 July 1998
+*/
+/* Now it's after 5.005, and Configure supports drand48() and random(),
+ in addition to rand(). So the overrides should not be needed any more.
+ --Jarkko Hietaniemi 27 September 1998
+ */
+
+#ifndef HAS_DRAND48_PROTO
+extern double drand48 _((void));
+#endif
+
PP(pp_rand)
{
djSP; dTARGET;
if (value == 0.0)
value = 1.0;
if (!srand_called) {
- (void)srand((unsigned)seed());
+ (void)seedDrand01((Rand_seed_t)seed());
srand_called = TRUE;
}
-#if RANDBITS == 31
- value = rand() * value / 2147483648.0;
-#else
-#if RANDBITS == 16
- value = rand() * value / 65536.0;
-#else
-#if RANDBITS == 15
- value = rand() * value / 32768.0;
-#else
- value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
-#endif
-#endif
-#endif
+ value *= Drand01();
XPUSHn(value);
RETURN;
}
anum = seed();
else
anum = POPu;
- (void)srand((unsigned)anum);
+ (void)seedDrand01((Rand_seed_t)anum);
srand_called = TRUE;
EXTEND(SP, 1);
RETPUSHYES;
* This is really just a quick hack which grabs various garbage
* values. It really should be a real hash algorithm which
* spreads the effect of every input bit onto every output bit,
- * if someone who knows about such tings would bother to write it.
+ * if someone who knows about such things would bother to write it.
* Might be a good idea to add that function to CORE as well.
- * No numbers below come from careful analysis or anyting here,
+ * No numbers below come from careful analysis or anything here,
* except they are primes and SEED_C1 > 1E6 to get a full-width
* value from (tv_sec * SEED_C1 + tv_usec). The multipliers should
* probably be bigger too.
#define SEED_C5 26107
dTHR;
+#ifndef PERL_NO_DEV_RANDOM
+ int fd;
+#endif
U32 u;
#ifdef VMS
# include <starlet.h>
/* when[] = (low 32 bits, high 32 bits) of time since epoch
* in 100-ns units, typically incremented ever 10 ms. */
unsigned int when[2];
+#else
+# ifdef HAS_GETTIMEOFDAY
+ struct timeval when;
+# else
+ Time_t when;
+# endif
+#endif
+
+/* This test is an escape hatch, this symbol isn't set by Configure. */
+#ifndef PERL_NO_DEV_RANDOM
+#ifndef PERL_RANDOM_DEVICE
+ /* /dev/random isn't used by default because reads from it will block
+ * if there isn't enough entropy available. You can compile with
+ * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
+ * is enough real entropy to fill the seed. */
+# define PERL_RANDOM_DEVICE "/dev/urandom"
+#endif
+ fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
+ if (fd != -1) {
+ if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
+ u = 0;
+ PerlLIO_close(fd);
+ if (u)
+ return u;
+ }
+#endif
+
+#ifdef VMS
_ckvmssts(sys$gettim(when));
u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
#else
# ifdef HAS_GETTIMEOFDAY
- struct timeval when;
gettimeofday(&when,(struct timezone *) 0);
u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
# else
- Time_t when;
(void)time(&when);
u = (U32)SEED_C1 * when;
# endif
#endif
u += SEED_C3 * (U32)getpid();
- u += SEED_C4 * (U32)(UV)stack_sp;
+ u += SEED_C4 * (U32)(UV)PL_stack_sp;
#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
u += SEED_C5 * (U32)(UV)&when;
#endif
PP(pp_length)
{
djSP; dTARGET;
+
+ if (IN_UTF8) {
+ SETi( sv_len_utf8(TOPs) );
+ RETURN;
+ }
+
SETi( sv_len(TOPs) );
RETURN;
}
SV *sv;
I32 len;
STRLEN curlen;
+ STRLEN utfcurlen;
I32 pos;
I32 rem;
I32 fail;
- I32 lvalue = op->op_flags & OPf_MOD;
+ I32 lvalue = PL_op->op_flags & OPf_MOD;
char *tmps;
- I32 arybase = curcop->cop_arybase;
+ I32 arybase = PL_curcop->cop_arybase;
char *repl = 0;
STRLEN repl_len;
sv = POPs;
PUTBACK;
tmps = SvPV(sv, curlen);
+ if (IN_UTF8) {
+ utfcurlen = sv_len_utf8(sv);
+ if (utfcurlen == curlen)
+ utfcurlen = 0;
+ else
+ curlen = utfcurlen;
+ }
+ else
+ utfcurlen = 0;
+
if (pos >= arybase) {
pos -= arybase;
rem = curlen-pos;
rem -= pos;
}
if (fail < 0) {
- if (dowarn || lvalue || repl)
- warn("substr outside of string");
+ if (ckWARN(WARN_SUBSTR) || lvalue || repl)
+ warner(WARN_SUBSTR, "substr outside of string");
RETPUSHUNDEF;
}
else {
+ if (utfcurlen)
+ sv_pos_u2b(sv, &pos, &rem);
tmps += pos;
sv_setpvn(TARG, tmps, rem);
if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
- SvPV_force(sv,na);
- if (dowarn)
- warn("Attempt to use reference as lvalue in substr");
+ SvPV_force(sv,PL_na);
+ if (ckWARN(WARN_SUBSTR))
+ warner(WARN_SUBSTR,
+ "Attempt to use reference as lvalue in substr");
}
if (SvOK(sv)) /* is it defined ? */
(void)SvPOK_only(sv);
register I32 size = POPi;
register I32 offset = POPi;
register SV *src = POPs;
- I32 lvalue = op->op_flags & OPf_MOD;
+ I32 lvalue = PL_op->op_flags & OPf_MOD;
STRLEN srclen;
unsigned char *s = (unsigned char*)SvPV(src, srclen);
unsigned long retnum;
char *tmps;
char *tmps2;
STRLEN biglen;
- I32 arybase = curcop->cop_arybase;
+ I32 arybase = PL_curcop->cop_arybase;
if (MAXARG < 3)
offset = 0;
little = POPs;
big = POPs;
tmps = SvPV(big, biglen);
+ if (IN_UTF8 && offset > 0)
+ sv_pos_u2b(big, &offset, 0);
if (offset < 0)
offset = 0;
else if (offset > biglen)
offset = biglen;
if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
(unsigned char*)tmps + biglen, little, 0)))
- retval = -1 + arybase;
+ retval = -1;
else
- retval = tmps2 - tmps + arybase;
- PUSHi(retval);
+ retval = tmps2 - tmps;
+ if (IN_UTF8 && retval > 0)
+ sv_pos_b2u(big, &retval);
+ PUSHi(retval + arybase);
RETURN;
}
SV *little;
STRLEN blen;
STRLEN llen;
- SV *offstr;
I32 offset;
I32 retval;
char *tmps;
char *tmps2;
- I32 arybase = curcop->cop_arybase;
+ I32 arybase = PL_curcop->cop_arybase;
if (MAXARG >= 3)
- offstr = POPs;
+ offset = POPi;
little = POPs;
big = POPs;
tmps2 = SvPV(little, llen);
tmps = SvPV(big, blen);
if (MAXARG < 3)
offset = blen;
- else
- offset = SvIV(offstr) - arybase + llen;
+ else {
+ if (IN_UTF8 && offset > 0)
+ sv_pos_u2b(big, &offset, 0);
+ offset = offset - arybase + llen;
+ }
if (offset < 0)
offset = 0;
else if (offset > blen)
offset = blen;
if (!(tmps2 = rninstr(tmps, tmps + offset,
tmps2, tmps2 + llen)))
- retval = -1 + arybase;
+ retval = -1;
else
- retval = tmps2 - tmps + arybase;
- PUSHi(retval);
+ retval = tmps2 - tmps;
+ if (IN_UTF8 && retval > 0)
+ sv_pos_b2u(big, &retval);
+ PUSHi(retval + arybase);
RETURN;
}
{
djSP; dMARK; dORIGMARK; dTARGET;
#ifdef USE_LOCALE_NUMERIC
- if (op->op_private & OPpLOCALE)
+ if (PL_op->op_private & OPpLOCALE)
SET_NUMERIC_LOCAL();
else
SET_NUMERIC_STANDARD();
PP(pp_ord)
{
djSP; dTARGET;
- I32 value;
- char *tmps;
+ UV value;
+ U8 *tmps = (U8*)POPp;
+ I32 retlen;
-#ifndef I286
- tmps = POPp;
- value = (I32) (*tmps & 255);
-#else
- I32 anum;
- tmps = POPp;
- anum = (I32) *tmps;
- value = (I32) (anum & 255);
-#endif
- XPUSHi(value);
+ if (IN_UTF8 && (*tmps & 0x80))
+ value = utf8_to_uv(tmps, &retlen);
+ else
+ value = (UV)(*tmps & 255);
+ XPUSHu(value);
RETURN;
}
{
djSP; dTARGET;
char *tmps;
+ U32 value = POPu;
(void)SvUPGRADE(TARG,SVt_PV);
+
+ if (IN_UTF8 && value >= 128) {
+ SvGROW(TARG,8);
+ tmps = SvPVX(TARG);
+ tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
+ SvCUR_set(TARG, tmps - SvPVX(TARG));
+ *tmps = '\0';
+ (void)SvPOK_only(TARG);
+ XPUSHs(TARG);
+ RETURN;
+ }
+
SvGROW(TARG,2);
SvCUR_set(TARG, 1);
tmps = SvPVX(TARG);
- *tmps++ = POPi;
+ *tmps++ = value;
*tmps = '\0';
(void)SvPOK_only(TARG);
XPUSHs(TARG);
{
djSP; dTARGET; dPOPTOPssrl;
#ifdef HAS_CRYPT
- char *tmps = SvPV(left, na);
+ char *tmps = SvPV(left, PL_na);
#ifdef FCRYPT
- sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
+ sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na)));
#else
- sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
+ sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na)));
#endif
#else
DIE(
{
djSP;
SV *sv = TOPs;
- register char *s;
+ register U8 *s;
+ STRLEN slen;
+
+ if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+ I32 ulen;
+ U8 tmpbuf[10];
+ U8 *tend;
+ UV uv = utf8_to_uv(s, &ulen);
+
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ uv = toTITLE_LC_uni(uv);
+ }
+ else
+ uv = toTITLE_utf8(s);
+
+ tend = uv_to_utf8(tmpbuf, uv);
+
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ dTARGET;
+ sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
+ sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
+ SETs(TARG);
+ }
+ else {
+ s = (U8*)SvPV_force(sv, slen);
+ Copy(tmpbuf, s, ulen, U8);
+ }
+ RETURN;
+ }
if (!SvPADTMP(sv)) {
dTARGET;
sv = TARG;
SETs(sv);
}
- s = SvPV_force(sv, na);
+ s = (U8*)SvPV_force(sv, PL_na);
if (*s) {
- if (op->op_private & OPpLOCALE) {
+ if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvTAINTED_on(sv);
*s = toUPPER_LC(*s);
{
djSP;
SV *sv = TOPs;
- register char *s;
+ register U8 *s;
+ STRLEN slen;
+
+ if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+ I32 ulen;
+ U8 tmpbuf[10];
+ U8 *tend;
+ UV uv = utf8_to_uv(s, &ulen);
+
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ uv = toLOWER_LC_uni(uv);
+ }
+ else
+ uv = toLOWER_utf8(s);
+
+ tend = uv_to_utf8(tmpbuf, uv);
+
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ dTARGET;
+ sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
+ sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
+ SETs(TARG);
+ }
+ else {
+ s = (U8*)SvPV_force(sv, slen);
+ Copy(tmpbuf, s, ulen, U8);
+ }
+ RETURN;
+ }
if (!SvPADTMP(sv)) {
dTARGET;
sv = TARG;
SETs(sv);
}
- s = SvPV_force(sv, na);
+ s = (U8*)SvPV_force(sv, PL_na);
if (*s) {
- if (op->op_private & OPpLOCALE) {
+ if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvTAINTED_on(sv);
*s = toLOWER_LC(*s);
{
djSP;
SV *sv = TOPs;
- register char *s;
+ register U8 *s;
STRLEN len;
+ if (IN_UTF8) {
+ dTARGET;
+ I32 ulen;
+ register U8 *d;
+ U8 *send;
+
+ s = (U8*)SvPV(sv,len);
+ if (!len) {
+ sv_setpvn(TARG, "", 0);
+ SETs(TARG);
+ RETURN;
+ }
+
+ (void)SvUPGRADE(TARG, SVt_PV);
+ SvGROW(TARG, (len * 2) + 1);
+ (void)SvPOK_only(TARG);
+ d = (U8*)SvPVX(TARG);
+ send = s + len;
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(TARG);
+ while (s < send) {
+ d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
+ s += ulen;
+ }
+ }
+ else {
+ while (s < send) {
+ d = uv_to_utf8(d, toUPPER_utf8( s ));
+ s += UTF8SKIP(s);
+ }
+ }
+ *d = '\0';
+ SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+ SETs(TARG);
+ RETURN;
+ }
+
if (!SvPADTMP(sv)) {
dTARGET;
sv_setsv(TARG, sv);
SETs(sv);
}
- s = SvPV_force(sv, len);
+ s = (U8*)SvPV_force(sv, len);
if (len) {
- register char *send = s + len;
+ register U8 *send = s + len;
- if (op->op_private & OPpLOCALE) {
+ if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvTAINTED_on(sv);
for (; s < send; s++)
{
djSP;
SV *sv = TOPs;
- register char *s;
+ register U8 *s;
STRLEN len;
+ if (IN_UTF8) {
+ dTARGET;
+ I32 ulen;
+ register U8 *d;
+ U8 *send;
+
+ s = (U8*)SvPV(sv,len);
+ if (!len) {
+ sv_setpvn(TARG, "", 0);
+ SETs(TARG);
+ RETURN;
+ }
+
+ (void)SvUPGRADE(TARG, SVt_PV);
+ SvGROW(TARG, (len * 2) + 1);
+ (void)SvPOK_only(TARG);
+ d = (U8*)SvPVX(TARG);
+ send = s + len;
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(TARG);
+ while (s < send) {
+ d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
+ s += ulen;
+ }
+ }
+ else {
+ while (s < send) {
+ d = uv_to_utf8(d, toLOWER_utf8(s));
+ s += UTF8SKIP(s);
+ }
+ }
+ *d = '\0';
+ SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+ SETs(TARG);
+ RETURN;
+ }
+
if (!SvPADTMP(sv)) {
dTARGET;
sv_setsv(TARG, sv);
SETs(sv);
}
- s = SvPV_force(sv, len);
+ s = (U8*)SvPV_force(sv, len);
if (len) {
- register char *send = s + len;
+ register U8 *send = s + len;
- if (op->op_private & OPpLOCALE) {
+ if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvTAINTED_on(sv);
for (; s < send; s++)
(void)SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
d = SvPVX(TARG);
- while (len--) {
- if (!isALNUM(*s))
- *d++ = '\\';
- *d++ = *s++;
+ if (IN_UTF8) {
+ while (len) {
+ if (*s & 0x80) {
+ STRLEN ulen = UTF8SKIP(s);
+ if (ulen > len)
+ ulen = len;
+ len -= ulen;
+ while (ulen--)
+ *d++ = *s++;
+ }
+ else {
+ if (!isALNUM(*s))
+ *d++ = '\\';
+ *d++ = *s++;
+ len--;
+ }
+ }
+ }
+ else {
+ while (len--) {
+ if (!isALNUM(*s))
+ *d++ = '\\';
+ *d++ = *s++;
+ }
}
*d = '\0';
SvCUR_set(TARG, d - SvPVX(TARG));
djSP; dMARK; dORIGMARK;
register SV** svp;
register AV* av = (AV*)POPs;
- register I32 lval = op->op_flags & OPf_MOD;
- I32 arybase = curcop->cop_arybase;
+ register I32 lval = PL_op->op_flags & OPf_MOD;
+ I32 arybase = PL_curcop->cop_arybase;
I32 elem;
if (SvTYPE(av) == SVt_PVAV) {
- if (lval && op->op_private & OPpLVAL_INTRO) {
+ if (lval && PL_op->op_private & OPpLVAL_INTRO) {
I32 max = -1;
for (svp = MARK + 1; svp <= SP; svp++) {
elem = SvIVx(*svp);
elem -= arybase;
svp = av_fetch(av, elem, lval);
if (lval) {
- if (!svp || *svp == &sv_undef)
+ if (!svp || *svp == &PL_sv_undef)
DIE(no_aelem, elem);
- if (op->op_private & OPpLVAL_INTRO)
+ if (PL_op->op_private & OPpLVAL_INTRO)
save_aelem(av, elem, svp);
}
- *MARK = svp ? *svp : &sv_undef;
+ *MARK = svp ? *svp : &PL_sv_undef;
}
}
if (GIMME != G_ARRAY) {
SV *sv;
HV *hv;
- if (op->op_private & OPpSLICE) {
+ if (PL_op->op_private & OPpSLICE) {
dMARK; dORIGMARK;
U32 hvtype;
hv = (HV*)POPs;
sv = hv_delete_ent(hv, *MARK, discard, 0);
else
DIE("Not a HASH reference");
- *MARK = sv ? sv : &sv_undef;
+ *MARK = sv ? sv : &PL_sv_undef;
}
if (discard)
SP = ORIGMARK;
else
DIE("Not a HASH reference");
if (!sv)
- sv = &sv_undef;
+ sv = &PL_sv_undef;
if (!discard)
PUSHs(sv);
}
{
djSP; dMARK; dORIGMARK;
register HV *hv = (HV*)POPs;
- register I32 lval = op->op_flags & OPf_MOD;
+ register I32 lval = PL_op->op_flags & OPf_MOD;
I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+ if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
+ DIE("Can't localize pseudo-hash element");
+
if (realhv || SvTYPE(hv) == SVt_PVAV) {
while (++MARK <= SP) {
SV *keysv = *MARK;
svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
}
if (lval) {
- if (!svp || *svp == &sv_undef)
- DIE(no_helem, SvPV(keysv, na));
- if (op->op_private & OPpLVAL_INTRO)
+ if (!svp || *svp == &PL_sv_undef)
+ DIE(no_helem, SvPV(keysv, PL_na));
+ if (PL_op->op_private & OPpLVAL_INTRO)
save_helem(hv, keysv, svp);
}
- *MARK = svp ? *svp : &sv_undef;
+ *MARK = svp ? *svp : &PL_sv_undef;
}
}
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
else
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
SP = MARK;
}
RETURN;
PP(pp_lslice)
{
djSP;
- SV **lastrelem = stack_sp;
- SV **lastlelem = stack_base + POPMARK;
- SV **firstlelem = stack_base + POPMARK + 1;
+ SV **lastrelem = PL_stack_sp;
+ SV **lastlelem = PL_stack_base + POPMARK;
+ SV **firstlelem = PL_stack_base + POPMARK + 1;
register SV **firstrelem = lastlelem + 1;
- I32 arybase = curcop->cop_arybase;
- I32 lval = op->op_flags & OPf_MOD;
+ I32 arybase = PL_curcop->cop_arybase;
+ I32 lval = PL_op->op_flags & OPf_MOD;
I32 is_something_there = lval;
register I32 max = lastrelem - lastlelem;
else
ix -= arybase;
if (ix < 0 || ix >= max)
- *firstlelem = &sv_undef;
+ *firstlelem = &PL_sv_undef;
else
*firstlelem = firstrelem[ix];
SP = firstlelem;
if (ix < 0) {
ix += max;
if (ix < 0)
- *lelem = &sv_undef;
+ *lelem = &PL_sv_undef;
else if (!(*lelem = firstrelem[ix]))
- *lelem = &sv_undef;
+ *lelem = &PL_sv_undef;
}
else {
ix -= arybase;
if (ix >= max || !(*lelem = firstrelem[ix]))
- *lelem = &sv_undef;
+ *lelem = &PL_sv_undef;
}
if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem)))
is_something_there = TRUE;
SV *val = NEWSV(46, 0);
if (MARK < SP)
sv_setsv(val, *++MARK);
- else if (dowarn)
- warn("Odd number of elements in hash assignment");
+ else if (ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
SV **tmparyval = 0;
MAGIC *mg;
- if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
- *MARK-- = mg->mg_obj;
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
if (offset < 0)
offset += AvFILLp(ary) + 1;
else
- offset -= curcop->cop_arybase;
+ offset -= PL_curcop->cop_arybase;
if (offset < 0)
DIE(no_aelem, i);
if (++MARK < SP) {
}
i = -diff;
while (i)
- dst[--i] = &sv_undef;
+ dst[--i] = &PL_sv_undef;
if (newlen) {
for (src = tmparyval, dst = AvARRAY(ary) + offset;
Safefree(tmparyval);
}
else
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
}
SP = MARK;
RETURN;
{
djSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
- register SV *sv = &sv_undef;
+ register SV *sv = &PL_sv_undef;
MAGIC *mg;
- if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
- *MARK-- = mg->mg_obj;
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
register I32 i = 0;
MAGIC *mg;
- if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
- *MARK-- = mg->mg_obj;
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
STRLEN len;
if (SP - MARK > 1)
- do_join(TARG, &sv_no, MARK, SP);
+ do_join(TARG, &PL_sv_no, MARK, SP);
else
sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
up = SvPV_force(TARG, len);
if (len > 1) {
+ if (IN_UTF8) { /* first reverse each character */
+ U8* s = (U8*)SvPVX(TARG);
+ U8* send = (U8*)(s + len);
+ while (s < send) {
+ if (*s < 0x80) {
+ s++;
+ continue;
+ }
+ else {
+ up = (char*)s;
+ s += UTF8SKIP(s);
+ down = (char*)(s - 1);
+ if (s > send || !((*down & 0xc0) == 0x80)) {
+ warn("Malformed UTF-8 character");
+ break;
+ }
+ while (down > up) {
+ tmp = *up;
+ *up++ = *down;
+ *down-- = tmp;
+ }
+ }
+ }
+ up = SvPVX(TARG);
+ }
down = SvPVX(TARG) + len - 1;
while (down > up) {
tmp = *up;
/* Explosives and implosives. */
+static const char uuemap[] =
+ "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+static char uudmap[256]; /* Initialised on first use */
+#if 'I' == 73 && 'J' == 74
+/* On an ASCII/ISO kind of system */
+#define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a')
+#else
+/*
+ Some other sort of character set - use memchr() so we don't match
+ the null byte.
+ */
+#define ISUUCHAR(ch) (memchr(uuemap, (ch), sizeof(uuemap)-1) || (ch) == ' ')
+#endif
+
PP(pp_unpack)
{
djSP;
default:
croak("Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && dowarn)
- warn("Invalid type in unpack: '%c'", (int)datumtype);
+ if (commas++ == 0 && ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
if (len == 1 && pat[-1] != '1')
bits >>= 4;
else
bits = *s++;
- *pat++ = hexdigit[bits & 15];
+ *pat++ = PL_hexdigit[bits & 15];
}
}
else {
bits <<= 4;
else
bits = *s++;
- *pat++ = hexdigit[(bits >> 4) & 15];
+ *pat++ = PL_hexdigit[(bits >> 4) & 15];
}
}
*pat = '\0';
}
}
break;
+ case 'U':
+ if (len > strend - s)
+ len = strend - s;
+ if (checksum) {
+ while (len-- > 0 && s < strend) {
+ auint = utf8_to_uv((U8*)s, &along);
+ s += along;
+ if (checksum > 32)
+ cdouble += (double)auint;
+ else
+ culong += auint;
+ }
+ }
+ else {
+ EXTEND(SP, len);
+ EXTEND_MORTAL(len);
+ while (len-- > 0 && s < strend) {
+ auint = utf8_to_uv((U8*)s, &along);
+ s += along;
+ sv = NEWSV(37, 0);
+ sv_setuv(sv, (UV)auint);
+ PUSHs(sv_2mortal(sv));
+ }
+ }
+ break;
case 's':
along = (strend - s) / SIZE16;
if (len > along)
break;
}
}
- t = SvPV(sv, na);
+ t = SvPV(sv, PL_na);
while (*t == '0')
t++;
sv_chop(sv, t);
}
break;
case 'u':
+ /* MKS:
+ * Initialise the decode mapping. By using a table driven
+ * algorithm, the code will be character-set independent
+ * (and just as fast as doing character arithmetic)
+ */
+ if (uudmap['M'] == 0) {
+ int i;
+
+ for (i = 0; i < sizeof(uuemap); i += 1)
+ uudmap[uuemap[i]] = i;
+ /*
+ * Because ' ' and '`' map to the same value,
+ * we need to decode them both the same.
+ */
+ uudmap[' '] = 0;
+ }
+
along = (strend - s) * 3 / 4;
sv = NEWSV(42, along);
if (along)
SvPOK_on(sv);
- while (s < strend && *s > ' ' && *s < 'a') {
+ while (s < strend && *s > ' ' && ISUUCHAR(*s)) {
I32 a, b, c, d;
char hunk[4];
hunk[3] = '\0';
- len = (*s++ - ' ') & 077;
+ len = uudmap[*s++] & 077;
while (len > 0) {
- if (s < strend && *s >= ' ')
- a = (*s++ - ' ') & 077;
- else
- a = 0;
- if (s < strend && *s >= ' ')
- b = (*s++ - ' ') & 077;
- else
- b = 0;
- if (s < strend && *s >= ' ')
- c = (*s++ - ' ') & 077;
- else
- c = 0;
- if (s < strend && *s >= ' ')
- d = (*s++ - ' ') & 077;
+ if (s < strend && ISUUCHAR(*s))
+ a = uudmap[*s++] & 077;
+ else
+ a = 0;
+ if (s < strend && ISUUCHAR(*s))
+ b = uudmap[*s++] & 077;
+ else
+ b = 0;
+ if (s < strend && ISUUCHAR(*s))
+ c = uudmap[*s++] & 077;
+ else
+ c = 0;
+ if (s < strend && ISUUCHAR(*s))
+ d = uudmap[*s++] & 077;
else
d = 0;
hunk[0] = (a << 2) | (b >> 4);
if (checksum) {
sv = NEWSV(42, 0);
if (strchr("fFdD", datumtype) ||
- (checksum > 32 && strchr("iIlLN", datumtype)) ) {
+ (checksum > 32 && strchr("iIlLNU", datumtype)) ) {
double trouble;
adouble = 1.0;
}
}
if (SP == oldsp && gimme == G_SCALAR)
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
RETURN;
}
{
char hunk[5];
- *hunk = len + ' ';
+ *hunk = uuemap[len];
sv_catpvn(sv, hunk, 1);
hunk[4] = '\0';
- while (len > 0) {
- hunk[0] = ' ' + (077 & (*s >> 2));
- hunk[1] = ' ' + (077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)));
- hunk[2] = ' ' + (077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)));
- hunk[3] = ' ' + (077 & (s[2] & 077));
+ while (len > 2) {
+ hunk[0] = uuemap[(077 & (*s >> 2))];
+ hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))];
+ hunk[2] = uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))];
+ hunk[3] = uuemap[(077 & (s[2] & 077))];
sv_catpvn(sv, hunk, 4);
s += 3;
len -= 3;
}
- for (s = SvPVX(sv); *s; s++) {
- if (*s == ' ')
- *s = '`';
+ if (len > 0) {
+ char r = (len > 1 ? s[1] : '\0');
+ hunk[0] = uuemap[(077 & (*s >> 2))];
+ hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))];
+ hunk[2] = uuemap[(077 & ((r << 2) & 074))];
+ hunk[3] = uuemap[0];
+ sv_catpvn(sv, hunk, 4);
}
sv_catpvn(sv, "\n", 1);
}
is_an_int(char *s, STRLEN l)
{
SV *result = newSVpv("", l);
- char *result_c = SvPV(result, na); /* convenience */
+ char *result_c = SvPV(result, PL_na); /* convenience */
char *out = result_c;
bool skip = 1;
bool ignore = 0;
MARK++;
sv_setpvn(cat, "", 0);
while (pat < patend) {
-#define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
+#define NEXTFROM (items-- > 0 ? *MARK++ : &PL_sv_no)
datumtype = *pat++ & 0xFF;
if (isSPACE(datumtype))
continue;
default:
croak("Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && dowarn)
- warn("Invalid type in pack: '%c'", (int)datumtype);
+ if (commas++ == 0 && ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
DIE("%% may only be used in unpack");
sv_catpvn(cat, &achar, sizeof(char));
}
break;
+ case 'U':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ auint = SvUV(fromstr);
+ SvGROW(cat, SvCUR(cat) + 10);
+ SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint)
+ - SvPVX(cat));
+ }
+ *SvEND(cat) = '\0';
+ break;
/* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
case 'f':
case 'F':
case 'p':
while (len-- > 0) {
fromstr = NEXTFROM;
- if (fromstr == &sv_undef)
+ if (fromstr == &PL_sv_undef)
aptr = NULL;
else {
/* XXX better yet, could spirit away the string to
* of pack() (and all copies of the result) are
* gone.
*/
- if (dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
- warn("Attempt to pack pointer to temporary value");
+ if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+ warner(WARN_UNSAFE,
+ "Attempt to pack pointer to temporary value");
if (SvPOK(fromstr) || SvNIOK(fromstr))
- aptr = SvPV(fromstr,na);
+ aptr = SvPV(fromstr,PL_na);
else
- aptr = SvPV_force(fromstr,na);
+ aptr = SvPV_force(fromstr,PL_na);
}
sv_catpvn(cat, (char*)&aptr, sizeof(char*));
}
I32 origlimit = limit;
I32 realarray = 0;
I32 base;
- AV *oldstack = curstack;
+ AV *oldstack = PL_curstack;
I32 gimme = GIMME_V;
- I32 oldsave = savestack_ix;
+ I32 oldsave = PL_savestack_ix;
I32 make_mortal = 1;
MAGIC *mg = (MAGIC *) NULL;
ary = GvAVn((GV*)pm->op_pmreplroot);
else if (gimme != G_ARRAY)
#ifdef USE_THREADS
- ary = (AV*)curpad[0];
+ ary = (AV*)PL_curpad[0];
#else
- ary = GvAVn(defgv);
+ ary = GvAVn(PL_defgv);
#endif /* USE_THREADS */
else
ary = Nullav;
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
- if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) {
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj((SV*)ary, mg));
}
else {
if (!AvREAL(ary)) {
AvREAL_on(ary);
for (i = AvFILLp(ary); i >= 0; i--)
- AvARRAY(ary)[i] = &sv_undef; /* don't free mere refs */
+ AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
}
/* temporarily switch stacks */
- SWITCHSTACK(curstack, ary);
+ SWITCHSTACK(PL_curstack, ary);
make_mortal = 0;
}
}
- base = SP - stack_base;
+ base = SP - PL_stack_base;
orig = s;
if (pm->op_pmflags & PMf_SKIPWHITE) {
if (pm->op_pmflags & PMf_LOCALE) {
}
}
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
- SAVEINT(multiline);
- multiline = pm->op_pmflags & PMf_MULTILINE;
+ SAVEINT(PL_multiline);
+ PL_multiline = pm->op_pmflags & PMf_MULTILINE;
}
if (!limit)
else {
maxiters += (strend - s) * rx->nparens;
while (s < strend && --limit &&
- regexec_flags(rx, s, strend, orig, 1, Nullsv, NULL, 0))
+ CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0))
{
TAINT_IF(RX_MATCH_TAINTED(rx));
if (rx->subbase
}
LEAVE_SCOPE(oldsave);
- iters = (SP - stack_base) - base;
+ iters = (SP - PL_stack_base) - base;
if (iters > maxiters)
DIE("Split loop");
EXTEND(SP, iters);
for (i=0; i < iters; i++) {
SV **svp = av_fetch(ary, i, FALSE);
- PUSHs((svp) ? *svp : &sv_undef);
+ PUSHs((svp) ? *svp : &PL_sv_undef);
}
RETURN;
}
croak("panic: unlock_condpair unlocking mutex that we don't own");
MgOWNER(mg) = 0;
COND_SIGNAL(MgOWNERCONDP(mg));
- DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
(unsigned long)thr, (unsigned long)svv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
}
while (MgOWNER(mg))
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
- DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
(unsigned long)thr, (unsigned long)sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
- SvREFCNT_inc(sv); /* keep alive until magic_mutexfree */
save_destructor(unlock_condpair, sv);
}
#endif /* USE_THREADS */
djSP;
#ifdef USE_THREADS
EXTEND(SP, 1);
- if (op->op_private & OPpLVAL_INTRO)
- PUSHs(*save_threadsv(op->op_targ));
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ PUSHs(*save_threadsv(PL_op->op_targ));
else
- PUSHs(THREADSV(op->op_targ));
+ PUSHs(THREADSV(PL_op->op_targ));
RETURN;
#else
DIE("tried to access per-thread data in non-threaded perl");
https://perl5.git.perl.org / perl5.git / blobdiff