extern Pid_t getpid (void);
#endif
+/*
+ * Some BSDs and Cygwin default to POSIX math instead of IEEE.
+ * This switches them over to IEEE.
+ */
+#if defined(LIBM_LIB_VERSION)
+ _LIB_VERSION_TYPE _LIB_VERSION = _IEEE_;
+#endif
+
/* variations on pp_null */
PP(pp_stub)
}
gimme = GIMME_V;
if (gimme == G_ARRAY) {
- I32 maxarg = AvFILL((AV*)TARG) + 1;
+ const I32 maxarg = AvFILL((AV*)TARG) + 1;
EXTEND(SP, maxarg);
if (SvMAGICAL(TARG)) {
U32 i;
}
else if (gimme == G_SCALAR) {
SV* sv = sv_newmortal();
- I32 maxarg = AvFILL((AV*)TARG) + 1;
+ const I32 maxarg = AvFILL((AV*)TARG) + 1;
sv_setiv(sv, maxarg);
PUSHs(sv);
}
if (SvREADONLY(sv))
Perl_croak(aTHX_ PL_no_modify);
if (PL_op->op_private & OPpDEREF) {
- char *name;
GV *gv;
if (cUNOP->op_targ) {
STRLEN len;
SV *namesv = PAD_SV(cUNOP->op_targ);
- name = SvPV(namesv, len);
+ const char *name = SvPV(namesv, len);
gv = (GV*)NEWSV(0,0);
gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
}
else {
- name = CopSTASHPV(PL_curcop);
+ const char *name = CopSTASHPV(PL_curcop);
gv = newGVgen(name);
}
if (SvTYPE(sv) < SVt_RV)
sv_upgrade(sv, SVt_RV);
- if (SvPVX(sv)) {
- SvOOK_off(sv); /* backoff */
- if (SvLEN(sv))
- Safefree(SvPVX(sv));
- SvLEN(sv)=SvCUR(sv)=0;
+ if (SvPVX_const(sv)) {
+ SvPV_free(sv);
+ SvLEN_set(sv, 0);
+ SvCUR_set(sv, 0);
}
- SvRV(sv) = (SV*)gv;
+ SvRV_set(sv, (SV*)gv);
SvROK_on(sv);
SvSETMAGIC(sv);
goto wasref;
{
dSP;
AV *av = (AV*)TOPs;
- SV *sv = AvARYLEN(av);
- if (!sv) {
- AvARYLEN(av) = sv = NEWSV(0,0);
- sv_upgrade(sv, SVt_IV);
- sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
+ SV **sv = Perl_av_arylen_p(aTHX_ (AV*)av);
+ if (!*sv) {
+ *sv = NEWSV(0,0);
+ sv_upgrade(*sv, SVt_PVMG);
+ sv_magic(*sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
}
- SETs(sv);
+ SETs(*sv);
RETURN;
}
ret = &PL_sv_undef;
if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
- char *s = SvPVX(TOPs);
+ const char *s = SvPVX_const(TOPs);
if (strnEQ(s, "CORE::", 6)) {
- int code;
-
- code = keyword(s + 6, SvCUR(TOPs) - 6);
+ const int 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' */
- if (code == -KEY_chop || code == -KEY_chomp)
+ if (code == -KEY_chop || code == -KEY_chomp
+ || code == -KEY_exec || code == -KEY_system)
goto set;
while (i < MAXO) { /* The slow way. */
if (strEQ(s + 6, PL_op_name[i])
seen_question = 1;
str[n++] = ';';
}
- else if (n && str[0] == ';' && seen_question)
- goto set; /* XXXX system, exec */
if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
&& (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
/* But globs are already references (kinda) */
}
cv = sv_2cv(TOPs, &stash, &gv, FALSE);
if (cv && SvPOK(cv))
- ret = sv_2mortal(newSVpvn(SvPVX(cv), SvCUR(cv)));
+ ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv)));
set:
SETs(ret);
RETURN;
}
rv = sv_newmortal();
sv_upgrade(rv, SVt_RV);
- SvRV(rv) = sv;
+ SvRV_set(rv, sv);
SvROK_on(rv);
return rv;
}
{
dSP; dTARGET;
SV *sv;
- char *pv;
+ const char *pv;
sv = POPs;
else {
SV *ssv = POPs;
STRLEN len;
- char *ptr;
+ const char *ptr;
if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
Perl_croak(aTHX_ "Attempt to bless into a reference");
GV *gv;
SV *sv;
SV *tmpRef;
- char *elem;
+ const char *elem;
dSP;
STRLEN n_a;
break;
case 'P':
if (strEQ(elem2, "ACKAGE")) {
- char *name = HvNAME(GvSTASH(gv));
- sv = newSVpv(name ? name : "__ANON__", 0);
+ const char *name = HvNAME_get(GvSTASH(gv));
+ sv = newSVpvn(name ? name : "__ANON__",
+ name ? HvNAMELEN_get(GvSTASH(gv)) : 8);
}
break;
case 'S':
}
break;
default:
- if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
- SvOOK_off(sv);
- Safefree(SvPVX(sv));
+ if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
+ SvPV_free(sv);
SvPV_set(sv, Nullch);
SvLEN_set(sv, 0);
}
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
{
- --SvIVX(TOPs);
+ SvIV_set(TOPs, SvIVX(TOPs) - 1);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
{
- ++SvIVX(TOPs);
+ SvIV_set(TOPs, SvIVX(TOPs) + 1);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
{
- --SvIVX(TOPs);
+ SvIV_set(TOPs, SvIVX(TOPs) - 1);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
if (count < 1)
SvCUR_set(TARG, 0);
else {
- IV max = count * len;
+ STRLEN max = (UV)count * len;
if (len > ((MEM_SIZE)~0)/count)
Perl_croak(aTHX_ oom_string_extend);
MEM_WRAP_CHECK_1(max, char, oom_string_extend);
- SvGROW(TARG, (count * len) + 1);
+ SvGROW(TARG, max + 1);
repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
- SvCUR(TARG) *= count;
+ SvCUR_set(TARG, SvCUR(TARG) * count);
}
*SvEND(TARG) = '\0';
}
PP(pp_i_modulo_0)
{
/* This is the vanilla old i_modulo. */
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
* See below for pp_i_modulo. */
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
PP(pp_i_modulo)
{
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
I32 pos;
I32 rem;
I32 fail;
- I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
- char *tmps;
- I32 arybase = PL_curcop->cop_arybase;
+ const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+ const char *tmps;
+ const I32 arybase = PL_curcop->cop_arybase;
SV *repl_sv = NULL;
- char *repl = 0;
+ const char *repl = 0;
STRLEN repl_len;
int num_args = PL_op->op_private & 7;
bool repl_need_utf8_upgrade = FALSE;
PP(pp_crypt)
{
- dSP; dTARGET;
#ifdef HAS_CRYPT
+ dSP; dTARGET;
dPOPTOPssrl;
STRLEN n_a;
STRLEN len;
SETs(TARG);
}
else {
+ STRLEN min = len + 1;
+
(void)SvUPGRADE(TARG, SVt_PV);
- SvGROW(TARG, len + 1);
+ SvGROW(TARG, min);
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
send = s + len;
STRLEN u = UTF8SKIP(s);
toUPPER_utf8(s, tmpbuf, &ulen);
- if (ulen > u) {
+ if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
+ /* If the eventually required minimum size outgrows
+ * the available space, we need to grow. */
UV o = d - (U8*)SvPVX(TARG);
/* If someone uppercases one million U+03B0s we
* SvGROW() one million times. Or we could try
* guessing how much to allocate without allocating
* too much. Such is life. */
- SvGROW(TARG, SvLEN(TARG) + ulen - u);
+ SvGROW(TARG, min);
d = (U8*)SvPVX(TARG) + o;
}
Copy(tmpbuf, d, ulen, U8);
SETs(TARG);
}
else {
+ STRLEN min = len + 1;
+
(void)SvUPGRADE(TARG, SVt_PV);
- SvGROW(TARG, len + 1);
+ SvGROW(TARG, min);
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
send = s + len;
* See lib/unicore/SpecialCasing.txt.
*/
}
- if (ulen > u) {
+ if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
+ /* If the eventually required minimum size outgrows
+ * the available space, we need to grow. */
UV o = d - (U8*)SvPVX(TARG);
/* If someone lowercases one million U+0130s we
* SvGROW() one million times. Or we could try
* guessing how much to allocate without allocating.
* too much. Such is life. */
- SvGROW(TARG, SvLEN(TARG) + ulen - u);
+ SvGROW(TARG, min);
d = (U8*)SvPVX(TARG) + o;
}
Copy(tmpbuf, d, ulen, U8);
dSP;
HV *hash = (HV*)POPs;
HE *entry;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
PUTBACK;
/* might clobber stack_sp */
PP(pp_delete)
{
dSP;
- I32 gimme = GIMME_V;
- I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
+ const I32 gimme = GIMME_V;
+ const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
SV *sv;
HV *hv;
if (lval) {
if (!svp || *svp == &PL_sv_undef) {
- STRLEN n_a;
- DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
+ DIE(aTHX_ PL_no_helem_sv, keysv);
}
if (localizing) {
if (preeminent)
PP(pp_splice)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register AV *ary = (AV*)*++MARK;
register SV **src;
register SV **dst;
*dst-- = *src--;
}
dst = AvARRAY(ary);
- SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
+ SvPV_set(ary, (char*)(AvARRAY(ary) - diff)); /* diff is negative */
AvMAX(ary) += diff;
}
else {
dst = src - diff;
Move(src, dst, offset, SV*);
}
- SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
+ SvPV_set(ary, (char*)(AvARRAY(ary) - diff));/* diff is positive */
AvMAX(ary) += diff;
AvFILLp(ary) += diff;
}
PP(pp_push)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv = &PL_sv_undef;
MAGIC *mg;
PP(pp_unshift)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv;
register I32 i = 0;
PP(pp_split)
{
- dSP; dTARG;
+ dVAR; dSP; dTARG;
AV *ary;
register IV limit = POPi; /* note, negative is forever */
SV *sv = POPs;
register SV *dstr;
register char *m;
I32 iters = 0;
- STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
+ const STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
I32 maxiters = slen + 10;
I32 i;
char *orig;
I32 origlimit = limit;
I32 realarray = 0;
I32 base;
- I32 gimme = GIMME_V;
- I32 oldsave = PL_savestack_ix;
+ const I32 gimme = GIMME_V;
+ const I32 oldsave = PL_savestack_ix;
I32 make_mortal = 1;
bool multiline = 0;
MAGIC *mg = (MAGIC *) NULL;
}
}
else {
-#ifndef lint
while (s < strend && --limit &&
(m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
csv, multiline ? FBMrf_MULTILINE : 0)) )
-#endif
{
dstr = newSVpvn(s, m-s);
if (make_mortal)
* indent-tabs-mode: t
* End:
*
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
projects / p5sagit/p5-mst-13.2.git / blobdiff