* have an integral type (except char) small enough to be represented
* in a double without loss; that is, it has no 32-bit type.
*/
-#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
+#if LONGSIZE > 4 && defined(_CRAY) && !defined(_CRAYMPP)
# define BW_BITS 32
# define BW_MASK ((1 << BW_BITS) - 1)
# define BW_SIGN (1 << (BW_BITS - 1))
* If they're not right on your machine, then pack() and unpack()
* wouldn't work right anyway; you'll need to apply the Cray hack.
* (I'd like to check them with #if, but you can't use sizeof() in
- * the preprocessor.)
+ * the preprocessor.) --???
+ */
+/*
+ The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
+ defines are now in config.h. --Andy Dougherty April 1998
*/
#define SIZE16 2
#define SIZE32 4
/* variations on pp_null */
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+
+/* XXX I can't imagine anyone who doesn't have this actually _needs_
+ it, since pid_t is an integral type.
+ --AD 2/20/1998
+*/
+#ifdef NEED_GETPID_PROTO
+extern Pid_t getpid (void);
+#endif
+
PP(pp_stub)
{
- dSP;
+ djSP;
if (GIMME_V == G_SCALAR)
XPUSHs(&sv_undef);
RETURN;
PP(pp_padav)
{
- dSP; dTARGET;
+ djSP; dTARGET;
if (op->op_private & OPpLVAL_INTRO)
SAVECLEARSV(curpad[op->op_targ]);
EXTEND(SP, 1);
if (GIMME == G_ARRAY) {
I32 maxarg = AvFILL((AV*)TARG) + 1;
EXTEND(SP, maxarg);
- Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+ if (SvMAGICAL(TARG)) {
+ U32 i;
+ for (i=0; i < maxarg; i++) {
+ SV **svp = av_fetch((AV*)TARG, i, FALSE);
+ SP[i+1] = (svp) ? *svp : &sv_undef;
+ }
+ }
+ else {
+ Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+ }
SP += maxarg;
}
else {
PP(pp_padhv)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 gimme;
XPUSHs(TARG);
PP(pp_rv2gv)
{
- dSP; dTOPss;
-
+ djSP; dTOPss;
+
if (SvROK(sv)) {
wasref:
sv = SvRV(sv);
PP(pp_rv2sv)
{
- dSP; dTOPss;
+ djSP; dTOPss;
if (SvROK(sv)) {
wasref:
PP(pp_av2arylen)
{
- dSP;
+ djSP;
AV *av = (AV*)TOPs;
SV *sv = AvARYLEN(av);
if (!sv) {
PP(pp_pos)
{
- dSP; dTARGET; dPOPss;
-
+ djSP; dTARGET; dPOPss;
+
if (op->op_flags & OPf_MOD) {
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
}
LvTYPE(TARG) = '.';
- LvTARG(TARG) = sv;
+ if (LvTARG(TARG) != sv) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(sv);
+ }
PUSHs(TARG); /* no SvSETMAGIC */
RETURN;
}
else {
- MAGIC* mg;
+ MAGIC* mg;
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
mg = mg_find(sv, 'g');
PP(pp_rv2cv)
{
- dSP;
+ djSP;
GV *gv;
HV *stash;
PP(pp_prototype)
{
- dSP;
+ djSP;
CV *cv;
HV *stash;
GV *gv;
SV *ret;
ret = &sv_undef;
+ if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
+ char *s = SvPVX(TOPs);
+ if (strnEQ(s, "CORE::", 6)) {
+ int code;
+
+ code = keyword(s + 6, SvCUR(TOPs) - 6);
+ if (code < 0) { /* Overridable. */
+#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
+ int i = 0, n = 0, seen_question = 0;
+ I32 oa;
+ char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
+
+ while (i < MAXO) { /* The slow way. */
+ if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i]))
+ goto found;
+ i++;
+ }
+ goto nonesuch; /* Should not happen... */
+ found:
+ oa = opargs[i] >> OASHIFT;
+ while (oa) {
+ if (oa & OA_OPTIONAL) {
+ seen_question = 1;
+ str[n++] = ';';
+ } else if (seen_question)
+ goto set; /* XXXX system, exec */
+ if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
+ && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+ str[n++] = '\\';
+ }
+ /* What to do with R ((un)tie, tied, (sys)read, recv)? */
+ str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
+ oa = oa >> 4;
+ }
+ str[n++] = '\0';
+ ret = sv_2mortal(newSVpv(str, n - 1));
+ } else if (code) /* Non-Overridable */
+ goto set;
+ else { /* None such */
+ nonesuch:
+ croak("Cannot find an opnumber for \"%s\"", s+6);
+ }
+ }
+ }
cv = sv_2cv(TOPs, &stash, &gv, FALSE);
if (cv && SvPOK(cv))
ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
+ set:
SETs(ret);
RETURN;
}
PP(pp_anoncode)
{
- dSP;
+ djSP;
CV* cv = (CV*)curpad[op->op_targ];
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
PP(pp_srefgen)
{
- dSP;
+ djSP;
*SP = refto(*SP);
RETURN;
-}
+}
PP(pp_refgen)
{
- dSP; dMARK;
+ djSP; dMARK;
if (GIMME != G_ARRAY) {
- MARK[1] = *SP;
- SP = MARK + 1;
+ if (++MARK <= SP)
+ *MARK = *SP;
+ else
+ *MARK = &sv_undef;
+ *MARK = refto(*MARK);
+ SP = MARK;
+ RETURN;
}
EXTEND_MORTAL(SP - MARK);
while (++MARK <= SP)
}
static SV*
-refto(sv)
-SV* sv;
+refto(SV *sv)
{
SV* rv;
else if (SvPADTMP(sv))
sv = newSVsv(sv);
else {
- dTHR; /* just for SvREFCNT_inc */
SvTEMP_off(sv);
(void)SvREFCNT_inc(sv);
}
PP(pp_ref)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv;
char *pv;
sv = POPs;
if (sv && SvGMAGICAL(sv))
- mg_get(sv);
+ mg_get(sv);
if (!sv || !SvROK(sv))
RETPUSHNO;
PP(pp_bless)
{
- dSP;
+ djSP;
HV *stash;
if (MAXARG == 1)
stash = curcop->cop_stash;
- else
- stash = gv_stashsv(POPs, TRUE);
+ else {
+ SV *ssv = POPs;
+ STRLEN len;
+ char *ptr = SvPV(ssv,len);
+ if (dowarn && len == 0)
+ warn("Explicit blessing to '' (assuming package main)");
+ stash = gv_stashpvn(ptr, len, TRUE);
+ }
(void)sv_bless(TOPs, stash);
RETURN;
SV *sv;
SV *ref;
char *elem;
- dSP;
+ djSP;
sv = POPs;
elem = SvPV(sv, na);
PP(pp_study)
{
- dSP; dPOPss;
+ djSP; dPOPss;
+ register UNOP *unop = cUNOP;
register unsigned char *s;
register I32 pos;
register I32 ch;
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 (SvSCREAM(sv))
RETPUSHYES;
PP(pp_trans)
{
- dSP; dTARG;
+ djSP; dTARG;
SV *sv;
if (op->op_flags & OPf_STACKED)
sv = POPs;
else {
- sv = GvSV(defgv);
+ sv = DEFSV;
EXTEND(SP,1);
}
TARG = sv_newmortal();
PP(pp_schop)
{
- dSP; dTARGET;
+ djSP; dTARGET;
do_chop(TARG, TOPs);
SETTARG;
RETURN;
PP(pp_chop)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
while (SP > MARK)
do_chop(TARG, POPs);
PUSHTARG;
PP(pp_schomp)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SETi(do_chomp(TOPs));
RETURN;
}
PP(pp_chomp)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
register I32 count = 0;
-
+
while (SP > MARK)
count += do_chomp(POPs);
PUSHi(count);
PP(pp_defined)
{
- dSP;
+ djSP;
register SV* sv;
sv = POPs;
PP(pp_undef)
{
- dSP;
+ djSP;
SV *sv;
if (!op->op_private) {
break;
case SVt_PVGV:
if (SvFAKE(sv))
- sv_setsv(sv, &sv_undef);
+ SvSetMagicSV(sv, &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;
+ GvEGV(sv) = (GV*)sv;
+ GvMULTI_on(sv);
+ }
break;
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
PP(pp_predec)
{
- dSP;
+ djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
PP(pp_postinc)
{
- dSP; dTARGET;
+ djSP; dTARGET;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
sv_setsv(TARG, TOPs);
PP(pp_postdec)
{
- dSP; dTARGET;
+ djSP; dTARGET;
if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
sv_setsv(TARG, TOPs);
PP(pp_pow)
{
- dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
{
dPOPTOPnnrl;
SETn( pow( left, right) );
PP(pp_multiply)
{
- dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
dPOPTOPnnrl;
SETn( left * right );
PP(pp_divide)
{
- dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPPOPnnrl;
double value;
PP(pp_modulo)
{
- dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
{
UV left;
UV right;
if (right_neg) {
/* XXX may warn: unary minus operator applied to unsigned type */
/* could change -foo to be (~foo)+1 instead */
- if (ans <= -(UV)IV_MAX)
- sv_setiv(TARG, (IV) -ans);
+ if (ans <= ~((UV)IV_MAX)+1)
+ sv_setiv(TARG, ~ans+1);
else
sv_setnv(TARG, -(double)ans);
}
PP(pp_repeat)
{
- dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
{
register I32 count = POPi;
if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
PP(pp_subtract)
{
- dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
dPOPTOPnnrl_ul;
SETn( left - right );
PP(pp_left_shift)
{
- dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
IBW shift = POPi;
if (op->op_private & HINT_INTEGER) {
PP(pp_right_shift)
{
- dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
IBW shift = POPi;
if (op->op_private & HINT_INTEGER) {
PP(pp_lt)
{
- dSP; tryAMAGICbinSET(lt,0);
+ djSP; tryAMAGICbinSET(lt,0);
{
dPOPnv;
SETs(boolSV(TOPn < value));
PP(pp_gt)
{
- dSP; tryAMAGICbinSET(gt,0);
+ djSP; tryAMAGICbinSET(gt,0);
{
dPOPnv;
SETs(boolSV(TOPn > value));
PP(pp_le)
{
- dSP; tryAMAGICbinSET(le,0);
+ djSP; tryAMAGICbinSET(le,0);
{
dPOPnv;
SETs(boolSV(TOPn <= value));
PP(pp_ge)
{
- dSP; tryAMAGICbinSET(ge,0);
+ djSP; tryAMAGICbinSET(ge,0);
{
dPOPnv;
SETs(boolSV(TOPn >= value));
PP(pp_ne)
{
- dSP; tryAMAGICbinSET(ne,0);
+ djSP; tryAMAGICbinSET(ne,0);
{
dPOPnv;
SETs(boolSV(TOPn != value));
PP(pp_ncmp)
{
- dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ djSP; dTARGET; tryAMAGICbin(ncmp,0);
{
dPOPTOPnnrl;
I32 value;
PP(pp_slt)
{
- dSP; tryAMAGICbinSET(slt,0);
+ djSP; tryAMAGICbinSET(slt,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_sgt)
{
- dSP; tryAMAGICbinSET(sgt,0);
+ djSP; tryAMAGICbinSET(sgt,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_sle)
{
- dSP; tryAMAGICbinSET(sle,0);
+ djSP; tryAMAGICbinSET(sle,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_sge)
{
- dSP; tryAMAGICbinSET(sge,0);
+ djSP; tryAMAGICbinSET(sge,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_seq)
{
- dSP; tryAMAGICbinSET(seq,0);
+ djSP; tryAMAGICbinSET(seq,0);
{
dPOPTOPssrl;
SETs(boolSV(sv_eq(left, right)));
PP(pp_sne)
{
- dSP; tryAMAGICbinSET(sne,0);
+ djSP; tryAMAGICbinSET(sne,0);
{
dPOPTOPssrl;
SETs(boolSV(!sv_eq(left, right)));
PP(pp_scmp)
{
- dSP; dTARGET; tryAMAGICbin(scmp,0);
+ djSP; dTARGET; tryAMAGICbin(scmp,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_bit_and)
{
- dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(band,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
if (op->op_private & HINT_INTEGER) {
- IBW value = SvIV(left) & SvIV(right);
+ IBW value = SvIV(left) & SvIV(right);
SETi(BWi(value));
}
else {
- UBW value = SvUV(left) & SvUV(right);
+ UBW value = SvUV(left) & SvUV(right);
SETu(BWu(value));
}
}
PP(pp_bit_xor)
{
- dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
if (op->op_private & HINT_INTEGER) {
- IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
+ IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
SETi(BWi(value));
}
else {
- UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
+ UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
SETu(BWu(value));
}
}
PP(pp_bit_or)
{
- dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
if (op->op_private & HINT_INTEGER) {
- IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
+ IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
SETi(BWi(value));
}
else {
- UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
+ UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
SETu(BWu(value));
}
}
PP(pp_negate)
{
- dSP; dTARGET; tryAMAGICun(neg);
+ djSP; dTARGET; tryAMAGICun(neg);
{
dTOPss;
if (SvGMAGICAL(sv))
PP(pp_not)
{
#ifdef OVERLOAD
- dSP; tryAMAGICunSET(not);
+ djSP; tryAMAGICunSET(not);
#endif /* OVERLOAD */
*stack_sp = boolSV(!SvTRUE(*stack_sp));
return NORMAL;
PP(pp_complement)
{
- dSP; dTARGET; tryAMAGICun(compl);
+ djSP; dTARGET; tryAMAGICun(compl);
{
dTOPss;
if (SvNIOKp(sv)) {
PP(pp_i_multiply)
{
- dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
dPOPTOPiirl;
SETi( left * right );
PP(pp_i_divide)
{
- dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPiv;
if (value == 0)
PP(pp_i_modulo)
{
- dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
{
dPOPTOPiirl;
if (!right)
PP(pp_i_add)
{
- dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
{
dPOPTOPiirl;
SETi( left + right );
PP(pp_i_subtract)
{
- dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
dPOPTOPiirl;
SETi( left - right );
PP(pp_i_lt)
{
- dSP; tryAMAGICbinSET(lt,0);
+ djSP; tryAMAGICbinSET(lt,0);
{
dPOPTOPiirl;
SETs(boolSV(left < right));
PP(pp_i_gt)
{
- dSP; tryAMAGICbinSET(gt,0);
+ djSP; tryAMAGICbinSET(gt,0);
{
dPOPTOPiirl;
SETs(boolSV(left > right));
PP(pp_i_le)
{
- dSP; tryAMAGICbinSET(le,0);
+ djSP; tryAMAGICbinSET(le,0);
{
dPOPTOPiirl;
SETs(boolSV(left <= right));
PP(pp_i_ge)
{
- dSP; tryAMAGICbinSET(ge,0);
+ djSP; tryAMAGICbinSET(ge,0);
{
dPOPTOPiirl;
SETs(boolSV(left >= right));
PP(pp_i_eq)
{
- dSP; tryAMAGICbinSET(eq,0);
+ djSP; tryAMAGICbinSET(eq,0);
{
dPOPTOPiirl;
SETs(boolSV(left == right));
PP(pp_i_ne)
{
- dSP; tryAMAGICbinSET(ne,0);
+ djSP; tryAMAGICbinSET(ne,0);
{
dPOPTOPiirl;
SETs(boolSV(left != right));
PP(pp_i_ncmp)
{
- dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ djSP; dTARGET; tryAMAGICbin(ncmp,0);
{
dPOPTOPiirl;
I32 value;
PP(pp_i_negate)
{
- dSP; dTARGET; tryAMAGICun(neg);
+ djSP; dTARGET; tryAMAGICun(neg);
SETi(-TOPi);
RETURN;
}
PP(pp_atan2)
{
- dSP; dTARGET; tryAMAGICbin(atan2,0);
+ djSP; dTARGET; tryAMAGICbin(atan2,0);
{
dPOPTOPnnrl;
SETn(atan2(left, right));
PP(pp_sin)
{
- dSP; dTARGET; tryAMAGICun(sin);
+ djSP; dTARGET; tryAMAGICun(sin);
{
double value;
value = POPn;
PP(pp_cos)
{
- dSP; dTARGET; tryAMAGICun(cos);
+ djSP; dTARGET; tryAMAGICun(cos);
{
double value;
value = POPn;
PP(pp_rand)
{
- dSP; dTARGET;
+ djSP; dTARGET;
double value;
if (MAXARG < 1)
value = 1.0;
PP(pp_srand)
{
- dSP;
+ djSP;
UV anum;
if (MAXARG < 1)
anum = seed();
}
static U32
-seed()
+seed(void)
{
/*
* This is really just a quick hack which grabs various garbage
PP(pp_exp)
{
- dSP; dTARGET; tryAMAGICun(exp);
+ djSP; dTARGET; tryAMAGICun(exp);
{
double value;
value = POPn;
PP(pp_log)
{
- dSP; dTARGET; tryAMAGICun(log);
+ djSP; dTARGET; tryAMAGICun(log);
{
double value;
value = POPn;
PP(pp_sqrt)
{
- dSP; dTARGET; tryAMAGICun(sqrt);
+ djSP; dTARGET; tryAMAGICun(sqrt);
{
double value;
value = POPn;
PP(pp_int)
{
- dSP; dTARGET;
+ djSP; dTARGET;
{
double value = TOPn;
IV iv;
PP(pp_abs)
{
- dSP; dTARGET; tryAMAGICun(abs);
+ djSP; dTARGET; tryAMAGICun(abs);
{
double value = TOPn;
IV iv;
PP(pp_hex)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
I32 argtype;
PP(pp_oct)
{
- dSP; dTARGET;
+ djSP; dTARGET;
UV value;
I32 argtype;
char *tmps;
PP(pp_length)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SETi( sv_len(TOPs) );
RETURN;
}
PP(pp_substr)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv;
I32 len;
+ I32 len_ok = 0;
STRLEN curlen;
I32 pos;
I32 rem;
I32 lvalue = op->op_flags & OPf_MOD;
char *tmps;
I32 arybase = curcop->cop_arybase;
+ char *repl = 0;
+ STRLEN repl_len;
- if (MAXARG > 2)
+ SvTAINTED_off(TARG); /* decontaminate */
+ if (MAXARG > 3) {
+ /* pop off replacement string */
+ sv = POPs;
+ repl = SvPV(sv, repl_len);
+ /* pop off length */
+ sv = POPs;
+ if (SvOK(sv)) {
+ len = SvIV(sv);
+ len_ok++;
+ }
+ } else if (MAXARG == 3) {
len = POPi;
+ len_ok++;
+ }
+
pos = POPi;
sv = POPs;
+ PUTBACK;
tmps = SvPV(sv, curlen);
if (pos >= arybase) {
pos -= arybase;
rem = curlen-pos;
fail = rem;
- if (MAXARG > 2) {
+ if (len_ok) {
if (len < 0) {
rem += len;
if (rem < 0)
}
else {
pos += curlen;
- if (MAXARG < 3)
+ if (!len_ok)
rem = curlen;
else if (len >= 0) {
rem = pos+len;
rem -= pos;
}
if (fail < 0) {
- if (dowarn || lvalue)
+ if (dowarn || lvalue || repl)
warn("substr outside of string");
RETPUSHUNDEF;
}
}
LvTYPE(TARG) = 'x';
- LvTARG(TARG) = sv;
+ if (LvTARG(TARG) != sv) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(sv);
+ }
LvTARGOFF(TARG) = pos;
- LvTARGLEN(TARG) = rem;
+ LvTARGLEN(TARG) = rem;
}
+ else if (repl)
+ sv_insert(sv, pos, rem, repl, repl_len);
}
+ SPAGAIN;
PUSHs(TARG); /* avoid SvSETMAGIC here */
RETURN;
}
PP(pp_vec)
{
- dSP; dTARGET;
+ djSP; dTARGET;
register I32 size = POPi;
register I32 offset = POPi;
register SV *src = POPs;
unsigned long retnum;
I32 len;
+ SvTAINTED_off(TARG); /* decontaminate */
offset *= size; /* turn into bit offset */
len = (offset + size + 7) / 8;
if (offset < 0 || size < 1)
}
LvTYPE(TARG) = 'v';
- LvTARG(TARG) = src;
- LvTARGOFF(TARG) = offset;
- LvTARGLEN(TARG) = size;
+ if (LvTARG(TARG) != src) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(src);
+ }
+ LvTARGOFF(TARG) = offset;
+ LvTARGLEN(TARG) = size;
}
if (len > srclen) {
if (size <= 8)
}
}
- sv_setiv(TARG, (IV)retnum);
+ sv_setuv(TARG, (UV)retnum);
PUSHs(TARG);
RETURN;
}
PP(pp_index)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *big;
SV *little;
I32 offset;
PP(pp_rindex)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *big;
SV *little;
STRLEN blen;
PP(pp_sprintf)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
#ifdef USE_LOCALE_NUMERIC
if (op->op_private & OPpLOCALE)
SET_NUMERIC_LOCAL();
PP(pp_ord)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 value;
char *tmps;
PP(pp_chr)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
(void)SvUPGRADE(TARG,SVt_PV);
PP(pp_crypt)
{
- dSP; dTARGET; dPOPTOPssrl;
+ djSP; dTARGET; dPOPTOPssrl;
#ifdef HAS_CRYPT
char *tmps = SvPV(left, na);
#ifdef FCRYPT
PP(pp_ucfirst)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
PP(pp_lcfirst)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
PP(pp_uc)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
STRLEN len;
PP(pp_lc)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
STRLEN len;
PP(pp_quotemeta)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv = TOPs;
STRLEN len;
register char *s = SvPV(sv,len);
PP(pp_aslice)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV** svp;
register AV* av = (AV*)POPs;
register I32 lval = op->op_flags & OPf_MOD;
if (SvTYPE(av) == SVt_PVAV) {
if (lval && op->op_private & OPpLVAL_INTRO) {
I32 max = -1;
- for (svp = mark + 1; svp <= sp; svp++) {
+ for (svp = MARK + 1; svp <= SP; svp++) {
elem = SvIVx(*svp);
if (elem > max)
max = elem;
if (!svp || *svp == &sv_undef)
DIE(no_aelem, elem);
if (op->op_private & OPpLVAL_INTRO)
- save_svref(svp);
+ save_aelem(av, elem, svp);
}
*MARK = svp ? *svp : &sv_undef;
}
PP(pp_each)
{
- dSP; dTARGET;
+ djSP; dTARGET;
HV *hash = (HV*)POPs;
HE *entry;
I32 gimme = GIMME_V;
I32 realhv = (SvTYPE(hash) == SVt_PVHV);
-
+
PUTBACK;
/* might clobber stack_sp */
entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
PP(pp_delete)
{
- dSP;
+ djSP;
I32 gimme = GIMME_V;
I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
SV *sv;
PP(pp_exists)
{
- dSP;
+ djSP;
SV *tmpsv = POPs;
HV *hv = (HV*)POPs;
if (SvTYPE(hv) == SVt_PVHV) {
PP(pp_hslice)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register HE *he;
register HV *hv = (HV*)POPs;
register I32 lval = op->op_flags & OPf_MOD;
if (!he || HeVAL(he) == &sv_undef)
DIE(no_helem, SvPV(keysv, na));
if (op->op_private & OPpLVAL_INTRO)
- save_svref(&HeVAL(he));
+ save_helem(hv, keysv, &HeVAL(he));
}
*MARK = he ? HeVAL(he) : &sv_undef;
}
PP(pp_list)
{
- dSP; dMARK;
+ djSP; dMARK;
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
PP(pp_lslice)
{
- dSP;
+ djSP;
SV **lastrelem = stack_sp;
SV **lastlelem = stack_base + POPMARK;
SV **firstlelem = stack_base + POPMARK + 1;
PP(pp_anonlist)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
I32 items = SP - MARK;
SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
SP = ORIGMARK; /* av_make() might realloc stack_sp */
PP(pp_anonhash)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
HV* hv = (HV*)sv_2mortal((SV*)newHV());
while (MARK < SP) {
if (MARK < SP)
sv_setsv(val, *++MARK);
else if (dowarn)
- warn("Odd number of elements in hash list");
+ warn("Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
PP(pp_splice)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register AV *ary = (AV*)*++MARK;
register SV **src;
register SV **dst;
I32 after;
I32 diff;
SV **tmparyval = 0;
+ MAGIC *mg;
+
+ if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
+ *MARK-- = mg->mg_obj;
+ PUSHMARK(MARK);
+ PUTBACK;
+ ENTER;
+ perl_call_method("SPLICE",GIMME_V);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
SP++;
if (++MARK < SP) {
offset = i = SvIVx(*MARK);
if (offset < 0)
- offset += AvFILL(ary) + 1;
+ offset += AvFILLp(ary) + 1;
else
offset -= curcop->cop_arybase;
if (offset < 0)
offset = 0;
length = AvMAX(ary) + 1;
}
- if (offset > AvFILL(ary) + 1)
- offset = AvFILL(ary) + 1;
- after = AvFILL(ary) + 1 - (offset + length);
+ if (offset > AvFILLp(ary) + 1)
+ offset = AvFILLp(ary) + 1;
+ after = AvFILLp(ary) + 1 - (offset + length);
if (after < 0) { /* not that much array */
length += after; /* offset+length now in array */
after = 0;
SvREFCNT_dec(*dst++); /* free them now */
}
}
- AvFILL(ary) += diff;
+ AvFILLp(ary) += diff;
/* pull up or down? */
dst = src + diff; /* diff is negative */
Move(src, dst, after, SV*);
}
- dst = &AvARRAY(ary)[AvFILL(ary)+1];
+ dst = &AvARRAY(ary)[AvFILLp(ary)+1];
/* avoid later double free */
}
i = -diff;
}
SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
AvMAX(ary) += diff;
- AvFILL(ary) += diff;
+ AvFILLp(ary) += diff;
}
else {
- if (AvFILL(ary) + diff >= AvMAX(ary)) /* oh, well */
- av_extend(ary, AvFILL(ary) + diff);
- AvFILL(ary) += diff;
+ if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */
+ av_extend(ary, AvFILLp(ary) + diff);
+ AvFILLp(ary) += diff;
if (after) {
- dst = AvARRAY(ary) + AvFILL(ary);
+ dst = AvARRAY(ary) + AvFILLp(ary);
src = dst - diff;
for (i = after; i; i--) {
*dst-- = *src--;
PP(pp_push)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv = &sv_undef;
+ MAGIC *mg;
- for (++MARK; MARK <= SP; MARK++) {
- sv = NEWSV(51, 0);
- if (*MARK)
- sv_setsv(sv, *MARK);
- av_push(ary, sv);
+ if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
+ *MARK-- = mg->mg_obj;
+ PUSHMARK(MARK);
+ PUTBACK;
+ ENTER;
+ perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+ LEAVE;
+ SPAGAIN;
+ }
+ else {
+ /* Why no pre-extend of ary here ? */
+ for (++MARK; MARK <= SP; MARK++) {
+ sv = NEWSV(51, 0);
+ if (*MARK)
+ sv_setsv(sv, *MARK);
+ av_push(ary, sv);
+ }
}
SP = ORIGMARK;
PUSHi( AvFILL(ary) + 1 );
PP(pp_pop)
{
- dSP;
+ djSP;
AV *av = (AV*)POPs;
SV *sv = av_pop(av);
if (!SvIMMORTAL(sv) && AvREAL(av))
PP(pp_shift)
{
- dSP;
+ djSP;
AV *av = (AV*)POPs;
SV *sv = av_shift(av);
EXTEND(SP, 1);
PP(pp_unshift)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv;
register I32 i = 0;
+ MAGIC *mg;
- av_unshift(ary, SP - MARK);
- while (MARK < SP) {
- sv = NEWSV(27, 0);
- sv_setsv(sv, *++MARK);
- (void)av_store(ary, i++, sv);
+ if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
+ *MARK-- = mg->mg_obj;
+ PUSHMARK(MARK);
+ PUTBACK;
+ ENTER;
+ perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
+ LEAVE;
+ SPAGAIN;
+ }
+ else {
+ av_unshift(ary, SP - MARK);
+ while (MARK < SP) {
+ sv = NEWSV(27, 0);
+ sv_setsv(sv, *++MARK);
+ (void)av_store(ary, i++, sv);
+ }
}
-
SP = ORIGMARK;
PUSHi( AvFILL(ary) + 1 );
RETURN;
PP(pp_reverse)
{
- dSP; dMARK;
+ djSP; dMARK;
register SV *tmp;
SV **oldsp = SP;
if (SP - MARK > 1)
do_join(TARG, &sv_no, MARK, SP);
else
- sv_setsv(TARG, (SP > MARK) ? *SP : GvSV(defgv));
+ sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
up = SvPV_force(TARG, len);
if (len > 1) {
down = SvPVX(TARG) + len - 1;
}
static SV *
-mul128(sv, m)
- SV *sv;
- U8 m;
+mul128(SV *sv, U8 m)
{
STRLEN len;
char *s = SvPV(sv, len);
U32 i = 0;
if (!strnEQ(s, "0000", 4)) { /* need to grow sv */
- SV *new = newSVpv("0000000000", 10);
+ SV *tmpNew = newSVpv("0000000000", 10);
- sv_catsv(new, sv);
+ sv_catsv(tmpNew, sv);
SvREFCNT_dec(sv); /* free old sv */
- sv = new;
+ sv = tmpNew;
s = SvPV(sv, len);
}
t = s + len - 1;
PP(pp_unpack)
{
- dSP;
+ djSP;
dPOPPOPssrl;
- SV **oldsp = sp;
+ SV **oldsp = SP;
I32 gimme = GIMME_V;
SV *sv;
STRLEN llen;
s += SIZE16;
#ifdef HAS_NTOHS
if (datumtype == 'n')
- aushort = ntohs(aushort);
+ aushort = PerlSock_ntohs(aushort);
#endif
#ifdef HAS_VTOHS
if (datumtype == 'v')
sv = NEWSV(39, 0);
#ifdef HAS_NTOHS
if (datumtype == 'n')
- aushort = ntohs(aushort);
+ aushort = PerlSock_ntohs(aushort);
#endif
#ifdef HAS_VTOHS
if (datumtype == 'v')
Copy(s, &aint, 1, int);
s += sizeof(int);
sv = NEWSV(40, 0);
+#ifdef __osf__
+ /* Without the dummy below unpack("i", pack("i",-1))
+ * return 0xFFffFFff instead of -1 for Digital Unix V4.0
+ * cc with optimization turned on */
+ (aint) ?
+ sv_setiv(sv, (IV)aint) :
+#endif
sv_setiv(sv, (IV)aint);
PUSHs(sv_2mortal(sv));
}
s += SIZE32;
#ifdef HAS_NTOHL
if (datumtype == 'N')
- aulong = ntohl(aulong);
+ aulong = PerlSock_ntohl(aulong);
#endif
#ifdef HAS_VTOHL
if (datumtype == 'V')
s += SIZE32;
#ifdef HAS_NTOHL
if (datumtype == 'N')
- aulong = ntohl(aulong);
+ aulong = PerlSock_ntohl(aulong);
#endif
#ifdef HAS_VTOHL
if (datumtype == 'V')
case 'w':
EXTEND(SP, len);
EXTEND_MORTAL(len);
- {
+ {
UV auv = 0;
U32 bytes = 0;
d = (*s++ - ' ') & 077;
else
d = 0;
- hunk[0] = a << 2 | b >> 4;
- hunk[1] = b << 4 | c >> 2;
- hunk[2] = c << 6 | d;
- sv_catpvn(sv, hunk, len > 3 ? 3 : len);
+ hunk[0] = (a << 2) | (b >> 4);
+ hunk[1] = (b << 4) | (c >> 2);
+ hunk[2] = (c << 6) | d;
+ sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
len -= 3;
}
if (*s == '\n')
checksum = 0;
}
}
- if (sp == oldsp && gimme == G_SCALAR)
+ if (SP == oldsp && gimme == G_SCALAR)
PUSHs(&sv_undef);
RETURN;
}
static void
-doencodes(sv, s, len)
-register SV *sv;
-register char *s;
-register I32 len;
+doencodes(register SV *sv, register char *s, register I32 len)
{
char hunk[5];
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[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));
sv_catpvn(sv, hunk, 4);
s += 3;
}
static SV *
-is_an_int(s, l)
- char *s;
- STRLEN l;
+is_an_int(char *s, STRLEN l)
{
SV *result = newSVpv("", l);
char *result_c = SvPV(result, na); /* convenience */
}
static int
-div128(pnum, done)
- SV *pnum; /* must be '\0' terminated */
- bool *done;
+div128(SV *pnum, bool *done)
+ /* must be '\0' terminated */
+
{
STRLEN len;
char *s = SvPV(pnum, len);
PP(pp_pack)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register SV *cat = TARG;
register I32 items;
STRLEN fromlen;
fromstr = NEXTFROM;
ashort = (I16)SvIV(fromstr);
#ifdef HAS_HTONS
- ashort = htons(ashort);
+ ashort = PerlSock_htons(ashort);
#endif
CAT16(cat, &ashort);
}
SV *norm;
STRLEN len;
bool done;
-
+
/* Copy string and check for compliance */
from = SvPV(fromstr, len);
if ((norm = is_an_int(from, len)) == NULL)
fromstr = NEXTFROM;
aulong = SvUV(fromstr);
#ifdef HAS_HTONL
- aulong = htonl(aulong);
+ aulong = PerlSock_htonl(aulong);
#endif
CAT32(cat, &aulong);
}
}
#undef NEXTFROM
+
PP(pp_split)
{
- dSP; dTARG;
+ djSP; dTARG;
AV *ary;
register I32 limit = POPi; /* note, negative is forever */
SV *sv = POPs;
AV *oldstack = curstack;
I32 gimme = GIMME_V;
I32 oldsave = savestack_ix;
+ I32 make_mortal = 1;
+ MAGIC *mg = (MAGIC *) NULL;
#ifdef DEBUGGING
Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
ary = Nullav;
if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
realarray = 1;
- if (!AvREAL(ary)) {
- AvREAL_on(ary);
- for (i = AvFILL(ary); i >= 0; i--)
- AvARRAY(ary)[i] = &sv_undef; /* don't free mere refs */
- }
+ PUTBACK;
av_extend(ary,0);
av_clear(ary);
- /* temporarily switch stacks */
- SWITCHSTACK(curstack, ary);
+ SPAGAIN;
+ if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) {
+ PUSHMARK(SP);
+ XPUSHs(mg->mg_obj);
+ }
+ else {
+ if (!AvREAL(ary)) {
+ AvREAL_on(ary);
+ for (i = AvFILLp(ary); i >= 0; i--)
+ AvARRAY(ary)[i] = &sv_undef; /* don't free mere refs */
+ }
+ /* temporarily switch stacks */
+ SWITCHSTACK(curstack, ary);
+ make_mortal = 0;
+ }
}
base = SP - stack_base;
orig = s;
dstr = NEWSV(30, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
break;
dstr = NEWSV(30, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
s = m;
}
}
- else if (pm->op_pmshort && !rx->nparens) {
- i = SvCUR(pm->op_pmshort);
- if (i == 1) {
- i = *SvPVX(pm->op_pmshort);
+ else if (rx->check_substr && !rx->nparens
+ && (rx->reganch & ROPT_CHECK_ALL)
+ && !(rx->reganch & ROPT_ANCH)) {
+ i = SvCUR(rx->check_substr);
+ if (i == 1 && !SvTAIL(rx->check_substr)) {
+ i = *SvPVX(rx->check_substr);
while (--limit) {
/*SUPPRESS 530*/
for (m = s; m < strend && *m != i; m++) ;
break;
dstr = NEWSV(30, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
s = m + 1;
#ifndef lint
while (s < strend && --limit &&
(m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
- pm->op_pmshort)) )
+ rx->check_substr)) )
#endif
{
dstr = NEWSV(31, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
s = m + i;
else {
maxiters += (strend - s) * rx->nparens;
while (s < strend && --limit &&
- pregexec(rx, s, strend, orig, 1, Nullsv, TRUE))
+ regexec_flags(rx, s, strend, orig, 1, Nullsv, NULL, 0))
{
- TAINT_IF(rx->exec_tainted);
+ TAINT_IF(RX_MATCH_TAINTED(rx));
if (rx->subbase
&& rx->subbase != orig) {
m = s;
m = rx->startp[0];
dstr = NEWSV(32, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
if (rx->nparens) {
}
else
dstr = NEWSV(33, 0);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
}
s = rx->endp[0];
}
}
+
LEAVE_SCOPE(oldsave);
iters = (SP - stack_base) - base;
if (iters > maxiters)
DIE("Split loop");
-
+
/* keep field after final delim? */
if (s < strend || (iters && origlimit)) {
dstr = NEWSV(34, strend-s);
sv_setpvn(dstr, s, strend-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
iters++;
while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
iters--, SP--;
}
+
if (realarray) {
- SWITCHSTACK(ary, oldstack);
- if (SvSMAGICAL(ary)) {
+ if (!mg) {
+ SWITCHSTACK(ary, oldstack);
+ if (SvSMAGICAL(ary)) {
+ PUTBACK;
+ mg_set((SV*)ary);
+ SPAGAIN;
+ }
+ if (gimme == G_ARRAY) {
+ EXTEND(SP, iters);
+ Copy(AvARRAY(ary), SP + 1, iters, SV*);
+ SP += iters;
+ RETURN;
+ }
+ }
+ else {
PUTBACK;
- mg_set((SV*)ary);
+ ENTER;
+ perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+ LEAVE;
SPAGAIN;
- }
- if (gimme == G_ARRAY) {
- EXTEND(SP, iters);
- Copy(AvARRAY(ary), SP + 1, iters, SV*);
- SP += iters;
- RETURN;
+ if (gimme == G_ARRAY) {
+ /* EXTEND should not be needed - we just popped them */
+ EXTEND(SP, iters);
+ for (i=0; i < iters; i++) {
+ SV **svp = av_fetch(ary, i, FALSE);
+ PUSHs((svp) ? *svp : &sv_undef);
+ }
+ RETURN;
+ }
}
}
else {
#ifdef USE_THREADS
void
-unlock_condpair(svv)
-void *svv;
+unlock_condpair(void *svv)
{
dTHR;
MAGIC *mg = mg_find((SV*)svv, 'm');
-
+
if (!mg)
croak("panic: unlock_condpair unlocking non-mutex");
MUTEX_LOCK(MgMUTEXP(mg));
PP(pp_lock)
{
- dSP;
-#ifdef USE_THREADS
+ djSP;
dTOPss;
+ SV *retsv = sv;
+#ifdef USE_THREADS
MAGIC *mg;
-
+
if (SvROK(sv))
sv = SvRV(sv);
DEBUG_L(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 */
+ if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
+ || SvTYPE(retsv) == SVt_PVCV) {
+ retsv = refto(retsv);
+ }
+ SETs(retsv);
+ RETURN;
+}
+
+PP(pp_threadsv)
+{
+ djSP;
+#ifdef USE_THREADS
+ EXTEND(SP, 1);
+ if (op->op_private & OPpLVAL_INTRO)
+ PUSHs(*save_threadsv(op->op_targ));
+ else
+ PUSHs(THREADSV(op->op_targ));
RETURN;
+#else
+ DIE("tried to access per-thread data in non-threaded perl");
+#endif /* USE_THREADS */
}
projects / p5sagit/p5-mst-13.2.git / blobdiff