* 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 DONT_DECLARE_STD
#ifdef I_UNISTD
#include <unistd.h>
#endif
-#else
-extern pid_t getpid (void);
+
+/* 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)
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;
}
{
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)
len = POPi;
pos = POPi;
sv = POPs;
+ PUTBACK;
tmps = SvPV(sv, curlen);
if (pos >= arybase) {
pos -= arybase;
LvTARGLEN(TARG) = rem;
}
}
+ SPAGAIN;
PUSHs(TARG); /* avoid SvSETMAGIC here */
RETURN;
}
}
}
- sv_setiv(TARG, (IV)retnum);
+ sv_setuv(TARG, (UV)retnum);
PUSHs(TARG);
RETURN;
}
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;
}
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;
}
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;
MAGIC *mg;
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);
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;
{
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')
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')
checksum = 0;
}
}
- if (sp == oldsp && gimme == G_SCALAR)
+ if (SP == oldsp && gimme == G_SCALAR)
PUSHs(&sv_undef);
RETURN;
}
fromstr = NEXTFROM;
ashort = (I16)SvIV(fromstr);
#ifdef HAS_HTONS
- ashort = htons(ashort);
+ ashort = PerlSock_htons(ashort);
#endif
CAT16(cat, &ashort);
}
fromstr = NEXTFROM;
aulong = SvUV(fromstr);
#ifdef HAS_HTONL
- aulong = htonl(aulong);
+ aulong = PerlSock_htonl(aulong);
#endif
CAT32(cat, &aulong);
}
{
djSP;
#ifdef USE_THREADS
- EXTEND(sp, 1);
+ EXTEND(SP, 1);
if (op->op_private & OPpLVAL_INTRO)
PUSHs(*save_threadsv(op->op_targ));
else
- PUSHs(*av_fetch(thr->threadsv, op->op_targ, FALSE));
+ PUSHs(THREADSV(op->op_targ));
RETURN;
#else
DIE("tried to access per-thread data in non-threaded perl");