diff options
Diffstat (limited to 'pp_hot.c')
| -rw-r--r-- | pp_hot.c | 1792 |
1 files changed, 1792 insertions, 0 deletions
diff --git a/pp_hot.c b/pp_hot.c new file mode 100644 index 0000000000..69023cf005 --- /dev/null +++ b/pp_hot.c @@ -0,0 +1,1792 @@ +/* pp_hot.c + * + * Copyright (c) 1991-1994, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * Then he heard Merry change the note, and up went the Horn-cry of Buckland, + * shaking the air. + * + * Awake! Awake! Fear, Fire, Foes! Awake! + * Fire, Foes! Awake! + */ + +#include "EXTERN.h" +#include "perl.h" + +/* Hot code. */ + +PP(pp_const) +{ + dSP; + XPUSHs(cSVOP->op_sv); + RETURN; +} + +PP(pp_nextstate) +{ + curcop = (COP*)op; + TAINT_NOT; /* Each statement is presumed innocent */ + stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; + FREETMPS; + return NORMAL; +} + +PP(pp_gvsv) +{ + dSP; + EXTEND(sp,1); + if (op->op_private & OPpLVAL_INTRO) + PUSHs(save_scalar(cGVOP->op_gv)); + else + PUSHs(GvSV(cGVOP->op_gv)); + RETURN; +} + +PP(pp_null) +{ + return NORMAL; +} + +PP(pp_pushmark) +{ + PUSHMARK(stack_sp); + return NORMAL; +} + +PP(pp_stringify) +{ + dSP; dTARGET; + STRLEN len; + char *s; + s = SvPV(TOPs,len); + sv_setpvn(TARG,s,len); + SETTARG; + RETURN; +} + +PP(pp_gv) +{ + dSP; + XPUSHs((SV*)cGVOP->op_gv); + RETURN; +} + +PP(pp_and) +{ + dSP; + if (!SvTRUE(TOPs)) + RETURN; + else { + --SP; + RETURNOP(cLOGOP->op_other); + } +} + +PP(pp_sassign) +{ + dSP; dPOPTOPssrl; + if (op->op_private & OPpASSIGN_BACKWARDS) { + SV *temp; + temp = left; left = right; right = temp; + } + if (tainting && tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) || + !mg_find(left, 't'))) { + TAINT_NOT; + } + SvSetSV(right, left); + SvSETMAGIC(right); + SETs(right); + RETURN; +} + +PP(pp_cond_expr) +{ + dSP; + if (SvTRUEx(POPs)) + RETURNOP(cCONDOP->op_true); + else + RETURNOP(cCONDOP->op_false); +} + +PP(pp_unstack) +{ + I32 oldsave; + TAINT_NOT; /* Each statement is presumed innocent */ + stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; + FREETMPS; + oldsave = scopestack[scopestack_ix - 1]; + LEAVE_SCOPE(oldsave); + return NORMAL; +} + +PP(pp_seq) +{ + dSP; tryAMAGICbinSET(seq,0); + { + dPOPTOPssrl; + SETs( sv_eq(left, right) ? &sv_yes : &sv_no ); + RETURN; + } +} + +PP(pp_concat) +{ + dSP; dATARGET; dPOPTOPssrl; + STRLEN len; + char *s; + if (TARG != left) { + s = SvPV(left,len); + sv_setpvn(TARG,s,len); + } + s = SvPV(right,len); + sv_catpvn(TARG,s,len); + SETTARG; + RETURN; +} + +PP(pp_padsv) +{ + dSP; dTARGET; + XPUSHs(TARG); + if (op->op_private & OPpLVAL_INTRO) + SAVECLEARSV(curpad[op->op_targ]); + RETURN; +} + +PP(pp_readline) +{ + last_in_gv = (GV*)(*stack_sp--); + return do_readline(); +} + +PP(pp_eq) +{ + dSP; tryAMAGICbinSET(eq,0); + { + dPOPnv; + SETs((TOPn == value) ? &sv_yes : &sv_no); + RETURN; + } +} + +PP(pp_preinc) +{ + dSP; + sv_inc(TOPs); + SvSETMAGIC(TOPs); + return NORMAL; +} + +PP(pp_or) +{ + dSP; + if (SvTRUE(TOPs)) + RETURN; + else { + --SP; + RETURNOP(cLOGOP->op_other); + } +} + +PP(pp_add) +{ + dSP; dATARGET; tryAMAGICbin(add,opASSIGN); + { + dPOPTOPnnrl; + SETn( left + right ); + RETURN; + } +} + +PP(pp_aelemfast) +{ + dSP; + AV *av = GvAV((GV*)cSVOP->op_sv); + SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD); + PUSHs(svp ? *svp : &sv_undef); + RETURN; +} + +PP(pp_join) +{ + dSP; dMARK; dTARGET; + MARK++; + do_join(TARG, *MARK, MARK, SP); + SP = MARK; + SETs(TARG); + RETURN; +} + +PP(pp_pushre) +{ + dSP; + XPUSHs((SV*)op); + RETURN; +} + +/* Oversized hot code. */ + +PP(pp_print) +{ + dSP; dMARK; dORIGMARK; + GV *gv; + IO *io; + register FILE *fp; + + if (op->op_flags & OPf_STACKED) + gv = (GV*)*++MARK; + else + gv = defoutgv; + if (!(io = GvIO(gv))) { + if (dowarn) + warn("Filehandle %s never opened", GvNAME(gv)); + errno = EBADF; + goto just_say_no; + } + else if (!(fp = IoOFP(io))) { + if (dowarn) { + if (IoIFP(io)) + warn("Filehandle %s opened only for input", GvNAME(gv)); + else + warn("print on closed filehandle %s", GvNAME(gv)); + } + errno = EBADF; + goto just_say_no; + } + else { + MARK++; + if (ofslen) { + while (MARK <= SP) { + if (!do_print(*MARK, fp)) + break; + MARK++; + if (MARK <= SP) { + if (fwrite1(ofs, 1, ofslen, fp) == 0 || ferror(fp)) { + MARK--; + break; + } + } + } + } + else { + while (MARK <= SP) { + if (!do_print(*MARK, fp)) + break; + MARK++; + } + } + if (MARK <= SP) + goto just_say_no; + else { + if (orslen) + if (fwrite1(ors, 1, orslen, fp) == 0 || ferror(fp)) + goto just_say_no; + + if (IoFLAGS(io) & IOf_FLUSH) + if (fflush(fp) == EOF) + goto just_say_no; + } + } + SP = ORIGMARK; + PUSHs(&sv_yes); + RETURN; + + just_say_no: + SP = ORIGMARK; + PUSHs(&sv_undef); + RETURN; +} + +PP(pp_rv2av) +{ + dSP; dPOPss; + + AV *av; + + if (SvROK(sv)) { + wasref: + av = (AV*)SvRV(sv); + if (SvTYPE(av) != SVt_PVAV) + DIE("Not an ARRAY reference"); + if (op->op_private & OPpLVAL_INTRO) + av = (AV*)save_svref((SV**)sv); + if (op->op_flags & OPf_REF) { + PUSHs((SV*)av); + RETURN; + } + } + else { + if (SvTYPE(sv) == SVt_PVAV) { + av = (AV*)sv; + if (op->op_flags & OPf_REF) { + PUSHs((SV*)av); + RETURN; + } + } + else { + if (SvTYPE(sv) != SVt_PVGV) { + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvROK(sv)) + goto wasref; + } + if (!SvOK(sv)) { + if (op->op_flags & OPf_REF || + op->op_private & HINT_STRICT_REFS) + DIE(no_usym, "an ARRAY"); + RETPUSHUNDEF; + } + if (op->op_private & HINT_STRICT_REFS) + DIE(no_symref, "an ARRAY"); + sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVAV); + } + av = GvAVn(sv); + if (op->op_private & OPpLVAL_INTRO) + av = save_ary(sv); + if (op->op_flags & OPf_REF) { + PUSHs((SV*)av); + RETURN; + } + } + } + + if (GIMME == G_ARRAY) { + I32 maxarg = AvFILL(av) + 1; + EXTEND(SP, maxarg); + Copy(AvARRAY(av), SP+1, maxarg, SV*); + SP += maxarg; + } + else { + dTARGET; + I32 maxarg = AvFILL(av) + 1; + PUSHi(maxarg); + } + RETURN; +} + +PP(pp_rv2hv) +{ + + dSP; dTOPss; + + HV *hv; + + if (SvROK(sv)) { + wasref: + hv = (HV*)SvRV(sv); + if (SvTYPE(hv) != SVt_PVHV) + DIE("Not a HASH reference"); + if (op->op_private & OPpLVAL_INTRO) + hv = (HV*)save_svref((SV**)sv); + if (op->op_flags & OPf_REF) { + SETs((SV*)hv); + RETURN; + } + } + else { + if (SvTYPE(sv) == SVt_PVHV) { + hv = (HV*)sv; + if (op->op_flags & OPf_REF) { + SETs((SV*)hv); + RETURN; + } + } + else { + if (SvTYPE(sv) != SVt_PVGV) { + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvROK(sv)) + goto wasref; + } + if (!SvOK(sv)) { + if (op->op_flags & OPf_REF || + op->op_private & HINT_STRICT_REFS) + DIE(no_usym, "a HASH"); + RETSETUNDEF; + } + if (op->op_private & HINT_STRICT_REFS) + DIE(no_symref, "a HASH"); + sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVHV); + } + hv = GvHVn(sv); + if (op->op_private & OPpLVAL_INTRO) + hv = save_hash(sv); + if (op->op_flags & OPf_REF) { + SETs((SV*)hv); + RETURN; + } + } + } + + if (GIMME == G_ARRAY) { /* array wanted */ + *stack_sp = (SV*)hv; + return do_kv(ARGS); + } + else { + dTARGET; + if (HvFILL(hv)) { + sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1); + sv_setpv(TARG, buf); + } + else + sv_setiv(TARG, 0); + SETTARG; + RETURN; + } +} + +PP(pp_aassign) +{ + dSP; + SV **lastlelem = stack_sp; + SV **lastrelem = stack_base + POPMARK; + SV **firstrelem = stack_base + POPMARK + 1; + SV **firstlelem = lastrelem + 1; + + register SV **relem; + register SV **lelem; + + register SV *sv; + register AV *ary; + + HV *hash; + I32 i; + int magic; + + delaymagic = DM_DELAY; /* catch simultaneous items */ + + /* If there's a common identifier on both sides we have to take + * special care that assigning the identifier on the left doesn't + * clobber a value on the right that's used later in the list. + */ + if (op->op_private & OPpASSIGN_COMMON) { + for (relem = firstrelem; relem <= lastrelem; relem++) { + /*SUPPRESS 560*/ + if (sv = *relem) + *relem = sv_mortalcopy(sv); + } + } + + relem = firstrelem; + lelem = firstlelem; + ary = Null(AV*); + hash = Null(HV*); + while (lelem <= lastlelem) { + sv = *lelem++; + switch (SvTYPE(sv)) { + case SVt_PVAV: + ary = (AV*)sv; + magic = SvSMAGICAL(ary) != 0; + + av_clear(ary); + i = 0; + while (relem <= lastrelem) { /* gobble up all the rest */ + sv = NEWSV(28,0); + assert(*relem); + sv_setsv(sv,*relem); + *(relem++) = sv; + (void)av_store(ary,i++,sv); + if (magic) + mg_set(sv); + } + break; + case SVt_PVHV: { + char *tmps; + SV *tmpstr; + + hash = (HV*)sv; + magic = SvSMAGICAL(hash) != 0; + hv_clear(hash); + + while (relem < lastrelem) { /* gobble up all the rest */ + STRLEN len; + if (*relem) + sv = *(relem++); + else + sv = &sv_no, relem++; + tmps = SvPV(sv, len); + tmpstr = NEWSV(29,0); + if (*relem) + sv_setsv(tmpstr,*relem); /* value */ + *(relem++) = tmpstr; + (void)hv_store(hash,tmps,len,tmpstr,0); + if (magic) + mg_set(tmpstr); + } + } + break; + default: + if (SvTHINKFIRST(sv)) { + if (SvREADONLY(sv) && curcop != &compiling) { + if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no) + DIE(no_modify); + if (relem <= lastrelem) + relem++; + break; + } + if (SvROK(sv)) + sv_unref(sv); + } + if (relem <= lastrelem) { + sv_setsv(sv, *relem); + *(relem++) = sv; + } + else + sv_setsv(sv, &sv_undef); + SvSETMAGIC(sv); + break; + } + } + if (delaymagic & ~DM_DELAY) { + if (delaymagic & DM_UID) { +#ifdef HAS_SETRESUID + (void)setresuid(uid,euid,(Uid_t)-1); +#else /* not HAS_SETRESUID */ +#ifdef HAS_SETREUID + (void)setreuid(uid,euid); +#else /* not HAS_SETREUID */ +#ifdef HAS_SETRUID + if ((delaymagic & DM_UID) == DM_RUID) { + (void)setruid(uid); + delaymagic =~ DM_RUID; + } +#endif /* HAS_SETRUID */ +#endif /* HAS_SETRESUID */ +#ifdef HAS_SETEUID + if ((delaymagic & DM_UID) == DM_EUID) { + (void)seteuid(uid); + delaymagic =~ DM_EUID; + } +#endif /* HAS_SETEUID */ + if (delaymagic & DM_UID) { + if (uid != euid) + DIE("No setreuid available"); + (void)setuid(uid); + } +#endif /* not HAS_SETREUID */ + uid = (int)getuid(); + euid = (int)geteuid(); + } + if (delaymagic & DM_GID) { +#ifdef HAS_SETRESGID + (void)setresgid(gid,egid,(Gid_t)-1); +#else /* not HAS_SETREGID */ +#ifdef HAS_SETREGID + (void)setregid(gid,egid); +#else /* not HAS_SETREGID */ +#endif /* not HAS_SETRESGID */ +#ifdef HAS_SETRGID + if ((delaymagic & DM_GID) == DM_RGID) { + (void)setrgid(gid); + delaymagic =~ DM_RGID; + } +#endif /* HAS_SETRGID */ +#ifdef HAS_SETRESGID + (void)setresgid(gid,egid,(Gid_t)-1); +#else /* not HAS_SETREGID */ +#ifdef HAS_SETEGID + if ((delaymagic & DM_GID) == DM_EGID) { + (void)setegid(gid); + delaymagic =~ DM_EGID; + } +#endif /* HAS_SETEGID */ + if (delaymagic & DM_GID) { + if (gid != egid) + DIE("No setregid available"); + (void)setgid(gid); + } +#endif /* not HAS_SETRESGID */ +#endif /* not HAS_SETREGID */ + gid = (int)getgid(); + egid = (int)getegid(); + } + tainting |= (euid != uid || egid != gid); + } + delaymagic = 0; + if (GIMME == G_ARRAY) { + if (ary || hash) + SP = lastrelem; + else + SP = firstrelem + (lastlelem - firstlelem); + RETURN; + } + else { + SP = firstrelem; + for (relem = firstrelem; relem <= lastrelem; ++relem) { + if (SvOK(*relem)) { + dTARGET; + + SETi(lastrelem - firstrelem + 1); + RETURN; + } + } + RETSETUNDEF; + } +} + +PP(pp_match) +{ + dSP; dTARG; + register PMOP *pm = cPMOP; + register char *t; + register char *s; + char *strend; + I32 global; + I32 safebase; + char *truebase; + register REGEXP *rx = pm->op_pmregexp; + I32 gimme = GIMME; + STRLEN len; + + if (op->op_flags & OPf_STACKED) + TARG = POPs; + else { + TARG = GvSV(defgv); + EXTEND(SP,1); + } + s = SvPV(TARG, len); + strend = s + len; + if (!s) + DIE("panic: do_match"); + + if (pm->op_pmflags & PMf_USED) { + if (gimme == G_ARRAY) + RETURN; + RETPUSHNO; + } + + if (!rx->prelen && curpm) { + pm = curpm; + rx = pm->op_pmregexp; + } + truebase = t = s; + if (global = pm->op_pmflags & PMf_GLOBAL) { + rx->startp[0] = 0; + if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { + MAGIC* mg = mg_find(TARG, 'g'); + if (mg && mg->mg_len >= 0) + rx->endp[0] = rx->startp[0] = s + mg->mg_len; + } + } + safebase = (gimme == G_ARRAY) || global; + if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + SAVEINT(multiline); + multiline = pm->op_pmflags & PMf_MULTILINE; + } + +play_it_again: + if (global && rx->startp[0]) { + t = s = rx->endp[0]; + if (s > strend) + goto nope; + } + if (pm->op_pmshort) { + if (pm->op_pmflags & PMf_SCANFIRST) { + if (SvSCREAM(TARG)) { + if (screamfirst[BmRARE(pm->op_pmshort)] < 0) + goto nope; + else if (!(s = screaminstr(TARG, pm->op_pmshort))) + goto nope; + else if (pm->op_pmflags & PMf_ALL) + goto yup; + } + else if (!(s = fbm_instr((unsigned char*)s, + (unsigned char*)strend, pm->op_pmshort))) + goto nope; + else if (pm->op_pmflags & PMf_ALL) + goto yup; + if (s && rx->regback >= 0) { + ++BmUSEFUL(pm->op_pmshort); + s -= rx->regback; + if (s < t) + s = t; + } + else + s = t; + } + else if (!multiline) { + if (*SvPVX(pm->op_pmshort) != *s || + bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) { + if (pm->op_pmflags & PMf_FOLD) { + if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) ) + goto nope; + } + else + goto nope; + } + } + if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) { + SvREFCNT_dec(pm->op_pmshort); + pm->op_pmshort = Nullsv; /* opt is being useless */ + } + } + if (!rx->nparens && !global) { + gimme = G_SCALAR; /* accidental array context? */ + safebase = FALSE; + } + if (regexec(rx, s, strend, truebase, 0, + SvSCREAM(TARG) ? TARG : Nullsv, + safebase)) { + curpm = pm; + if (pm->op_pmflags & PMf_ONCE) + pm->op_pmflags |= PMf_USED; + goto gotcha; + } + else + goto ret_no; + /*NOTREACHED*/ + + gotcha: + if (gimme == G_ARRAY) { + I32 iters, i, len; + + iters = rx->nparens; + if (global && !iters) + i = 1; + else + i = 0; + EXTEND(SP, iters + i); + for (i = !i; i <= iters; i++) { + PUSHs(sv_newmortal()); + /*SUPPRESS 560*/ + if ((s = rx->startp[i]) && rx->endp[i] ) { + len = rx->endp[i] - s; + sv_setpvn(*SP, s, len); + } + } + if (global) { + truebase = rx->subbeg; + if (rx->startp[0] && rx->startp[0] == rx->endp[0]) + ++rx->endp[0]; + goto play_it_again; + } + RETURN; + } + else { + if (global) { + MAGIC* mg = 0; + if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) + mg = mg_find(TARG, 'g'); + if (!mg) { + sv_magic(TARG, (SV*)0, 'g', Nullch, 0); + mg = mg_find(TARG, 'g'); + } + mg->mg_len = rx->startp[0] ? rx->endp[0] - truebase : -1; + } + RETPUSHYES; + } + +yup: + ++BmUSEFUL(pm->op_pmshort); + curpm = pm; + if (pm->op_pmflags & PMf_ONCE) + pm->op_pmflags |= PMf_USED; + if (global) { + rx->subbeg = truebase; + rx->subend = strend; + rx->startp[0] = s; + rx->endp[0] = s + SvCUR(pm->op_pmshort); + goto gotcha; + } + if (sawampersand) { + char *tmps; + + if (rx->subbase) + Safefree(rx->subbase); + tmps = rx->subbase = savepvn(t, strend-t); + rx->subbeg = tmps; + rx->subend = tmps + (strend-t); + tmps = rx->startp[0] = tmps + (s - t); + rx->endp[0] = tmps + SvCUR(pm->op_pmshort); + } + RETPUSHYES; + +nope: + if (pm->op_pmshort) + ++BmUSEFUL(pm->op_pmshort); + +ret_no: + if (global) { + if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { + MAGIC* mg = mg_find(TARG, 'g'); + if (mg) + mg->mg_len = -1; + } + } + if (gimme == G_ARRAY) + RETURN; + RETPUSHNO; +} + +OP * +do_readline() +{ + dSP; dTARGETSTACKED; + register SV *sv; + STRLEN tmplen = 0; + STRLEN offset; + FILE *fp; + register IO *io = GvIO(last_in_gv); + register I32 type = op->op_type; + + fp = Nullfp; + if (io) { + fp = IoIFP(io); + if (!fp) { + if (IoFLAGS(io) & IOf_ARGV) { + if (IoFLAGS(io) & IOf_START) { + IoFLAGS(io) &= ~IOf_START; + IoLINES(io) = 0; + if (av_len(GvAVn(last_in_gv)) < 0) { + SV *tmpstr = newSVpv("-", 1); /* assume stdin */ + av_push(GvAVn(last_in_gv), tmpstr); + } + } + fp = nextargv(last_in_gv); + if (!fp) { /* Note: fp != IoIFP(io) */ + (void)do_close(last_in_gv, FALSE); /* now it does*/ + IoFLAGS(io) |= IOf_START; + } + } + else if (type == OP_GLOB) { + SV *tmpcmd = NEWSV(55, 0); + SV *tmpglob = POPs; + ENTER; + SAVEFREESV(tmpcmd); +#ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */ + /* since spawning off a process is a real performance hit */ + { +#include <descrip.h> +#include <lib$routines.h> +#include <nam.h> +#include <rmsdef.h> + char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'}; + char vmsspec[NAM$C_MAXRSS+1]; + char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp; + char tmpfnam[L_tmpnam] = "SYS$SCRATCH:"; + $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;"); + FILE *tmpfp; + STRLEN i; + struct dsc$descriptor_s wilddsc + = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + struct dsc$descriptor_vs rsdsc + = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt}; + unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0; + + /* We could find out if there's an explicit dev/dir or version + by peeking into lib$find_file's internal context at + ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb + but that's unsupported, so I don't want to do it now and + have it bite someone in the future. */ + strcat(tmpfnam,tmpnam(NULL)); + cp = SvPV(tmpglob,i); + for (; i; i--) { + if (cp[i] == ';') hasver = 1; + if (cp[i] == '.') { + if (sts) hasver = 1; + else sts = 1; + } + if (cp[i] == '/') { + hasdir = isunix = 1; + break; + } + if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') { + hasdir = 1; + break; + } + } + if ((tmpfp = fopen(tmpfnam,"w+","fop=dlt")) != NULL) { + ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL); + if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer); + while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt, + &dfltdsc,NULL,NULL,NULL))&1)) { + end = rstr + (unsigned long int) *rslt; + if (!hasver) while (*end != ';') end--; + *(end++) = '\n'; *end = '\0'; + for (cp = rstr; *cp; cp++) *cp = _tolower(*cp); + if (hasdir) { + if (isunix) trim_unixpath(SvPVX(tmpglob),rstr); + begin = rstr; + } + else { + begin = end; + while (*(--begin) != ']' && *begin != '>') ; + ++begin; + } + ok = (fputs(begin,tmpfp) != EOF); + } + if (cxt) (void)lib$find_file_end(&cxt); + if (ok && sts != RMS$_NMF) ok = 0; + if (!ok) { + fp = NULL; + } + else { + rewind(tmpfp); + IoTYPE(io) = '<'; + IoIFP(io) = fp = tmpfp; + } + } + } +#else /* !VMS */ +#ifdef DOSISH + sv_setpv(tmpcmd, "perlglob "); + sv_catsv(tmpcmd, tmpglob); + sv_catpv(tmpcmd, " |"); +#else +#ifdef CSH + sv_setpvn(tmpcmd, cshname, cshlen); + sv_catpv(tmpcmd, " -cf 'set nonomatch; glob "); + sv_catsv(tmpcmd, tmpglob); + sv_catpv(tmpcmd, "'|"); +#else + sv_setpv(tmpcmd, "echo "); + sv_catsv(tmpcmd, tmpglob); +#if 'z' - 'a' == 25 + sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); +#else + sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|"); +#endif +#endif /* !CSH */ +#endif /* !MSDOS */ + (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),Nullfp); + fp = IoIFP(io); +#endif /* !VMS */ + LEAVE; + } + } + else if (type == OP_GLOB) + SP--; + } + if (!fp) { + if (dowarn) + warn("Read on closed filehandle <%s>", GvENAME(last_in_gv)); + if (GIMME == G_SCALAR) { + (void)SvOK_off(TARG); + PUSHTARG; + } + RETURN; + } + if (GIMME == G_ARRAY) { + sv = sv_2mortal(NEWSV(57, 80)); + offset = 0; + } + else { + sv = TARG; + (void)SvUPGRADE(sv, SVt_PV); + tmplen = SvLEN(sv); /* remember if already alloced */ + if (!tmplen) + Sv_Grow(sv, 80); /* try short-buffering it */ + if (type == OP_RCATLINE) + offset = SvCUR(sv); + else + offset = 0; + } + for (;;) { + if (!sv_gets(sv, fp, offset)) { + clearerr(fp); + if (IoFLAGS(io) & IOf_ARGV) { + fp = nextargv(last_in_gv); + if (fp) + continue; + (void)do_close(last_in_gv, FALSE); + IoFLAGS(io) |= IOf_START; + } + else if (type == OP_GLOB) { + (void)do_close(last_in_gv, FALSE); + } + if (GIMME == G_SCALAR) { + (void)SvOK_off(TARG); + PUSHTARG; + } + RETURN; + } + IoLINES(io)++; + XPUSHs(sv); + if (tainting) { + tainted = TRUE; + SvTAINT(sv); /* Anything from the outside world...*/ + } + if (type == OP_GLOB) { + char *tmps; + + if (SvCUR(sv) > 0) + SvCUR(sv)--; + if (*SvEND(sv) == rschar) + *SvEND(sv) = '\0'; + else + SvCUR(sv)++; + for (tmps = SvPVX(sv); *tmps; tmps++) + if (!isALPHA(*tmps) && !isDIGIT(*tmps) && + strchr("$&*(){}[]'\";\\|?<>~`", *tmps)) + break; + if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) { + (void)POPs; /* Unmatched wildcard? Chuck it... */ + continue; + } + } + if (GIMME == G_ARRAY) { + if (SvLEN(sv) - SvCUR(sv) > 20) { + SvLEN_set(sv, SvCUR(sv)+1); + Renew(SvPVX(sv), SvLEN(sv), char); + } + sv = sv_2mortal(NEWSV(58, 80)); + continue; + } + else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) { + /* try to reclaim a bit of scalar space (only on 1st alloc) */ + if (SvCUR(sv) < 60) + SvLEN_set(sv, 80); + else + SvLEN_set(sv, SvCUR(sv)+40); /* allow some slop */ + Renew(SvPVX(sv), SvLEN(sv), char); + } + RETURN; + } +} + +PP(pp_enter) +{ + dSP; + register CONTEXT *cx; + I32 gimme; + + /* + * We don't just use the GIMME macro here because it assumes there's + * already a context, which ain't necessarily so at initial startup. + */ + + if (op->op_flags & OPf_KNOW) + gimme = op->op_flags & OPf_LIST; + else if (cxstack_ix >= 0) + gimme = cxstack[cxstack_ix].blk_gimme; + else + gimme = G_SCALAR; + + ENTER; + + SAVETMPS; + PUSHBLOCK(cx, CXt_BLOCK, sp); + + RETURN; +} + +PP(pp_helem) +{ + dSP; + SV** svp; + SV *keysv = POPs; + STRLEN keylen; + char *key = SvPV(keysv, keylen); + HV *hv = (HV*)POPs; + I32 lval = op->op_flags & OPf_MOD; + + if (SvTYPE(hv) != SVt_PVHV) + RETPUSHUNDEF; + svp = hv_fetch(hv, key, keylen, lval); + if (lval) { + if (!svp || *svp == &sv_undef) + DIE(no_helem, key); + if (op->op_private & OPpLVAL_INTRO) + save_svref(svp); + else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) { + SV* sv = *svp; + if (SvGMAGICAL(sv)) + mg_get(sv); + if (!SvOK(sv)) { + (void)SvUPGRADE(sv, SVt_RV); + SvRV(sv) = (op->op_private & OPpDEREF_HV ? + (SV*)newHV() : (SV*)newAV()); + SvROK_on(sv); + SvSETMAGIC(sv); + } + } + } + PUSHs(svp ? *svp : &sv_undef); + RETURN; +} + +PP(pp_leave) +{ + dSP; + register CONTEXT *cx; + register SV **mark; + SV **newsp; + PMOP *newpm; + I32 gimme; + + if (op->op_flags & OPf_SPECIAL) { + cx = &cxstack[cxstack_ix]; + cx->blk_oldpm = curpm; /* fake block should preserve $1 et al */ + } + + POPBLOCK(cx,newpm); + + if (op->op_flags & OPf_KNOW) + gimme = op->op_flags & OPf_LIST; + else if (cxstack_ix >= 0) + gimme = cxstack[cxstack_ix].blk_gimme; + else + gimme = G_SCALAR; + + if (gimme == G_SCALAR) { + if (op->op_private & OPpLEAVE_VOID) + SP = newsp; + else { + MARK = newsp + 1; + if (MARK <= SP) + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + else { + MEXTEND(mark,0); + *MARK = &sv_undef; + } + SP = MARK; + } + } + else { + for (mark = newsp + 1; mark <= SP; mark++) + if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) + *mark = sv_mortalcopy(*mark); + /* in case LEAVE wipes old return values */ + } + curpm = newpm; /* Don't pop $1 et al till now */ + + LEAVE; + + RETURN; +} + +PP(pp_iter) +{ + dSP; + register CONTEXT *cx; + SV *sv; + + EXTEND(sp, 1); + cx = &cxstack[cxstack_ix]; + if (cx->cx_type != CXt_LOOP) + DIE("panic: pp_iter"); + + if (cx->blk_loop.iterix >= cx->blk_oldsp) + RETPUSHNO; + + if (sv = AvARRAY(cx->blk_loop.iterary)[++cx->blk_loop.iterix]) { + SvTEMP_off(sv); + *cx->blk_loop.itervar = sv; + } + else + *cx->blk_loop.itervar = &sv_undef; + + RETPUSHYES; +} + +PP(pp_subst) +{ + dSP; dTARG; + register PMOP *pm = cPMOP; + PMOP *rpm = pm; + register SV *dstr; + register char *s; + char *strend; + register char *m; + char *c; + register char *d; + STRLEN clen; + I32 iters = 0; + I32 maxiters; + register I32 i; + bool once; + char *orig; + I32 safebase; + register REGEXP *rx = pm->op_pmregexp; + STRLEN len; + int force_on_match = 0; + + if (pm->op_pmflags & PMf_CONST) /* known replacement string? */ + dstr = POPs; + if (op->op_flags & OPf_STACKED) + TARG = POPs; + else { + TARG = GvSV(defgv); + EXTEND(SP,1); + } + s = SvPV(TARG, len); + if (!SvPOKp(TARG)) + force_on_match = 1; + + force_it: + if (!pm || !s) + DIE("panic: do_subst"); + + strend = s + len; + maxiters = (strend - s) + 10; + + if (!rx->prelen && curpm) { + pm = curpm; + rx = pm->op_pmregexp; + } + safebase = ((!rx || !rx->nparens) && !sawampersand); + if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + SAVEINT(multiline); + multiline = pm->op_pmflags & PMf_MULTILINE; + } + orig = m = s; + if (pm->op_pmshort) { + if (pm->op_pmflags & PMf_SCANFIRST) { + if (SvSCREAM(TARG)) { + if (screamfirst[BmRARE(pm->op_pmshort)] < 0) + goto nope; + else if (!(s = screaminstr(TARG, pm->op_pmshort))) + goto nope; + } + else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend, + pm->op_pmshort))) + goto nope; + if (s && rx->regback >= 0) { + ++BmUSEFUL(pm->op_pmshort); + s -= rx->regback; + if (s < m) + s = m; + } + else + s = m; + } + else if (!multiline) { + if (*SvPVX(pm->op_pmshort) != *s || + bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) { + if (pm->op_pmflags & PMf_FOLD) { + if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) ) + goto nope; + } + else + goto nope; + } + } + if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) { + SvREFCNT_dec(pm->op_pmshort); + pm->op_pmshort = Nullsv; /* opt is being useless */ + } + } + once = !(rpm->op_pmflags & PMf_GLOBAL); + if (rpm->op_pmflags & PMf_CONST) { /* known replacement string? */ + c = SvPV(dstr, clen); + if (clen <= rx->minlen) { + /* can do inplace substitution */ + if (regexec(rx, s, strend, orig, 0, + SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { + if (force_on_match) { + force_on_match = 0; + s = SvPV_force(TARG, len); + goto force_it; + } + if (rx->subbase) /* oops, no we can't */ + goto long_way; + d = s; + curpm = pm; + SvSCREAM_off(TARG); /* disable possible screamer */ + if (once) { + m = rx->startp[0]; + d = rx->endp[0]; + s = orig; + if (m - s > strend - d) { /* faster to shorten from end */ + if (clen) { + Copy(c, m, clen, char); + m += clen; + } + i = strend - d; + if (i > 0) { + Move(d, m, i, char); + m += i; + } + *m = '\0'; + SvCUR_set(TARG, m - s); + (void)SvPOK_only(TARG); + SvSETMAGIC(TARG); + PUSHs(&sv_yes); + RETURN; + } + /*SUPPRESS 560*/ + else if (i = m - s) { /* faster from front */ + d -= clen; + m = d; + sv_chop(TARG, d-i); + s += i; + while (i--) + *--d = *--s; + if (clen) + Copy(c, m, clen, char); + (void)SvPOK_only(TARG); + SvSETMAGIC(TARG); + PUSHs(&sv_yes); + RETURN; + } + else if (clen) { + d -= clen; + sv_chop(TARG, d); + Copy(c, d, clen, char); + (void)SvPOK_only(TARG); + SvSETMAGIC(TARG); + PUSHs(&sv_yes); + RETURN; + } + else { + sv_chop(TARG, d); + (void)SvPOK_only(TARG); + SvSETMAGIC(TARG); + PUSHs(&sv_yes); + RETURN; + } + /* NOTREACHED */ + } + do { + if (iters++ > maxiters) + DIE("Substitution loop"); + m = rx->startp[0]; + /*SUPPRESS 560*/ + if (i = m - s) { + if (s != d) + Move(s, d, i, char); + d += i; + } + if (clen) { + Copy(c, d, clen, char); + d += clen; + } + s = rx->endp[0]; + } while (regexec(rx, s, strend, orig, s == m, + Nullsv, TRUE)); /* (don't match same null twice) */ + if (s != d) { + i = strend - s; + SvCUR_set(TARG, d - SvPVX(TARG) + i); + Move(s, d, i+1, char); /* include the Null */ + } + (void)SvPOK_only(TARG); + SvSETMAGIC(TARG); + PUSHs(sv_2mortal(newSViv((I32)iters))); + RETURN; + } + PUSHs(&sv_no); + RETURN; + } + } + else + c = Nullch; + if (regexec(rx, s, strend, orig, 0, + SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { + long_way: + if (force_on_match) { + force_on_match = 0; + s = SvPV_force(TARG, len); + goto force_it; + } + dstr = NEWSV(25, sv_len(TARG)); + sv_setpvn(dstr, m, s-m); + curpm = pm; + if (!c) { + register CONTEXT *cx; + PUSHSUBST(cx); + RETURNOP(cPMOP->op_pmreplroot); + } + do { + if (iters++ > maxiters) + DIE("Substitution loop"); + if (rx->subbase && rx->subbase != orig) { + m = s; + s = orig; + orig = rx->subbase; + s = orig + (m - s); + strend = s + (strend - m); + } + m = rx->startp[0]; + sv_catpvn(dstr, s, m-s); + s = rx->endp[0]; + if (clen) + sv_catpvn(dstr, c, clen); + if (once) + break; + } while (regexec(rx, s, strend, orig, s == m, Nullsv, + safebase)); + sv_catpvn(dstr, s, strend - s); + sv_replace(TARG, dstr); + (void)SvPOK_only(TARG); + SvSETMAGIC(TARG); + PUSHs(sv_2mortal(newSViv((I32)iters))); + RETURN; + } + PUSHs(&sv_no); + RETURN; + +nope: + ++BmUSEFUL(pm->op_pmshort); + PUSHs(&sv_no); + RETURN; +} + +PP(pp_grepwhile) +{ + dSP; + + if (SvTRUEx(POPs)) + stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr]; + ++*markstack_ptr; + LEAVE; /* exit inner scope */ + + /* All done yet? */ + if (stack_base + *markstack_ptr > sp) { + I32 items; + + LEAVE; /* exit outer scope */ + (void)POPMARK; /* pop src */ + items = --*markstack_ptr - markstack_ptr[-1]; + (void)POPMARK; /* pop dst */ + SP = stack_base + POPMARK; /* pop original mark */ + if (GIMME != G_ARRAY) { + dTARGET; + XPUSHi(items); + RETURN; + } + SP += items; + RETURN; + } + else { + SV *src; + + ENTER; /* enter inner scope */ + SAVESPTR(curpm); + + src = stack_base[*markstack_ptr]; + SvTEMP_off(src); + GvSV(defgv) = src; + + RETURNOP(cLOGOP->op_other); + } +} + +PP(pp_leavesub) +{ + dSP; + SV **mark; + SV **newsp; + PMOP *newpm; + I32 gimme; + register CONTEXT *cx; + + POPBLOCK(cx,newpm); + POPSUB(cx); + + if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) + if (SvFLAGS(TOPs) & SVs_TEMP) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + else { + MEXTEND(mark,0); + *MARK = &sv_undef; + } + SP = MARK; + } + else { + for (mark = newsp + 1; mark <= SP; mark++) + if (!(SvFLAGS(*mark) & SVs_TEMP)) + *mark = sv_mortalcopy(*mark); + /* in case LEAVE wipes old return values */ + } + + if (cx->blk_sub.hasargs) { /* You don't exist; go away. */ + AV* av = cx->blk_sub.argarray; + + av_clear(av); + AvREAL_off(av); + } + curpm = newpm; /* Don't pop $1 et al till now */ + + LEAVE; + PUTBACK; + return pop_return(); +} + +PP(pp_entersub) +{ + dSP; dPOPss; + GV *gv; + HV *stash; + register CV *cv; + register CONTEXT *cx; + + if (!sv) + DIE("Not a CODE reference"); + switch (SvTYPE(sv)) { + default: + if (!SvROK(sv)) { + if (sv == &sv_yes) /* unfound import, ignore */ + RETURN; + if (!SvOK(sv)) + DIE(no_usym, "a subroutine"); + if (op->op_private & HINT_STRICT_REFS) + DIE(no_symref, "a subroutine"); + gv = gv_fetchpv(SvPV(sv, na), FALSE, SVt_PVCV); + if (!gv) + cv = 0; + else + cv = GvCV(gv); + break; + } + cv = (CV*)SvRV(sv); + if (SvTYPE(cv) == SVt_PVCV) + break; + /* FALL THROUGH */ + case SVt_PVHV: + case SVt_PVAV: + DIE("Not a CODE reference"); + case SVt_PVCV: + cv = (CV*)sv; + break; + case SVt_PVGV: + if (!(cv = GvCV((GV*)sv))) + cv = sv_2cv(sv, &stash, &gv, TRUE); + break; + } + + ENTER; + SAVETMPS; + + retry: + if (!cv) + DIE("Not a CODE reference"); + + if (!CvROOT(cv) && !CvXSUB(cv)) { + if (gv = CvGV(cv)) { + SV *tmpstr = sv_newmortal(); + GV *ngv; + gv_efullname(tmpstr, gv); + ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD"); + if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */ + gv = ngv; + sv_setsv(GvSV(CvGV(cv)), tmpstr); /* Set CV's $AUTOLOAD */ + goto retry; + } + else + DIE("Undefined subroutine &%s called",SvPVX(tmpstr)); + } + DIE("Undefined subroutine called"); + } + + if ((op->op_private & OPpDEREF_DB) && !CvXSUB(cv)) { + sv = GvSV(DBsub); + save_item(sv); + gv = CvGV(cv); + gv_efullname(sv,gv); + cv = GvCV(DBsub); + if (!cv) + DIE("No DBsub routine"); + } + + if (CvXSUB(cv)) { + if (CvOLDSTYLE(cv)) { + dMARK; + register I32 items = SP - MARK; + while (sp > mark) { + sp[1] = sp[0]; + sp--; + } + stack_sp = mark + 1; + items = (*(I32(*)_((int,int,int)))CvXSUB(cv))(CvXSUBANY(cv).any_i32, + MARK - stack_base + 1, items); + stack_sp = stack_base + items; + } + else { + PUTBACK; + (void)(*CvXSUB(cv))(cv); + } + LEAVE; + return NORMAL; + } + else { + dMARK; + register I32 items = SP - MARK; + I32 hasargs = (op->op_flags & OPf_STACKED) != 0; + I32 gimme = GIMME; + AV* padlist = CvPADLIST(cv); + SV** svp = AvARRAY(padlist); + push_return(op->op_next); + PUSHBLOCK(cx, CXt_SUB, MARK); + PUSHSUB(cx); + CvDEPTH(cv)++; + if (CvDEPTH(cv) < 2) + (void)SvREFCNT_inc(cv); + else { /* save temporaries on recursion? */ + if (CvDEPTH(cv) == 100 && dowarn) + warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv))); + if (CvDEPTH(cv) > AvFILL(padlist)) { + AV *av; + AV *newpad = newAV(); + I32 ix = AvFILL((AV*)svp[1]); + svp = AvARRAY(svp[0]); + while (ix > 0) { + if (svp[ix] != &sv_undef) { + char *name = SvPVX(svp[ix]); /* XXX */ + if (*name == '@') + av_store(newpad, ix--, sv = (SV*)newAV()); + else if (*name == '%') + av_store(newpad, ix--, sv = (SV*)newHV()); + else + av_store(newpad, ix--, sv = NEWSV(0,0)); + SvPADMY_on(sv); + } + else { + av_store(newpad, ix--, sv = NEWSV(0,0)); + SvPADTMP_on(sv); + } + } + av = newAV(); /* will be @_ */ + av_extend(av, 0); + av_store(newpad, 0, (SV*)av); + AvFLAGS(av) = AVf_REIFY; + av_store(padlist, CvDEPTH(cv), (SV*)newpad); + AvFILL(padlist) = CvDEPTH(cv); + svp = AvARRAY(padlist); + } + } + SAVESPTR(curpad); + curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); + if (hasargs) { + AV* av = (AV*)curpad[0]; + SV** ary; + + if (AvREAL(av)) { + av_clear(av); + AvREAL_off(av); + } + cx->blk_sub.savearray = GvAV(defgv); + cx->blk_sub.argarray = av; + GvAV(defgv) = cx->blk_sub.argarray; + ++MARK; + + if (items > AvMAX(av) + 1) { + ary = AvALLOC(av); + if (AvARRAY(av) != ary) { + AvMAX(av) += AvARRAY(av) - AvALLOC(av); + SvPVX(av) = (char*)ary; + } + if (items > AvMAX(av) + 1) { + AvMAX(av) = items - 1; + Renew(ary,items,SV*); + AvALLOC(av) = ary; + SvPVX(av) = (char*)ary; + } + } + Copy(MARK,AvARRAY(av),items,SV*); + AvFILL(av) = items - 1; + + while (items--) { + if (*MARK) + SvTEMP_off(*MARK); + MARK++; + } + } + RETURNOP(CvSTART(cv)); + } +} + +PP(pp_aelem) +{ + dSP; + SV** svp; + I32 elem = POPi - curcop->cop_arybase; + AV *av = (AV*)POPs; + I32 lval = op->op_flags & OPf_MOD; + + if (SvTYPE(av) != SVt_PVAV) + RETPUSHUNDEF; + svp = av_fetch(av, elem, lval); + if (lval) { + if (!svp || *svp == &sv_undef) + DIE(no_aelem, elem); + if (op->op_private & OPpLVAL_INTRO) + save_svref(svp); + else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) { + SV* sv = *svp; + if (SvGMAGICAL(sv)) + mg_get(sv); + if (!SvOK(sv)) { + (void)SvUPGRADE(sv, SVt_RV); + SvRV(sv) = (op->op_private & OPpDEREF_HV ? + (SV*)newHV() : (SV*)newAV()); + SvROK_on(sv); + SvSETMAGIC(sv); + } + } + } + PUSHs(svp ? *svp : &sv_undef); + RETURN; +} + +PP(pp_method) +{ + dSP; + SV* sv; + SV* ob; + GV* gv; + SV* nm; + + nm = TOPs; + sv = *(stack_base + TOPMARK + 1); + + gv = 0; + if (SvROK(sv)) + ob = SvRV(sv); + else { + GV* iogv; + char* packname = 0; + + if (!SvOK(sv) || + !(packname = SvPV(sv, na)) || + !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) || + !(ob=(SV*)GvIO(iogv))) + { + char *name = SvPV(nm, na); + HV *stash; + if (!packname || !isALPHA(*packname)) +DIE("Can't call method \"%s\" without a package or object reference", name); + if (!(stash = gv_stashpv(packname, FALSE))) { + if (gv_stashpv("UNIVERSAL", FALSE)) + stash = gv_stashpv(packname, TRUE); + else + DIE("Can't call method \"%s\" in empty package \"%s\"", + name, packname); + } + gv = gv_fetchmethod(stash,name); + if (!gv) + DIE("Can't locate object method \"%s\" via package \"%s\"", + name, packname); + SETs(gv); + RETURN; + } + } + + if (!ob || !SvOBJECT(ob)) { + char *name = SvPV(nm, na); + DIE("Can't call method \"%s\" on unblessed reference", name); + } + + if (!gv) { /* nothing cached */ + char *name = SvPV(nm, na); + gv = gv_fetchmethod(SvSTASH(ob),name); + if (!gv) + DIE("Can't locate object method \"%s\" via package \"%s\"", + name, HvNAME(SvSTASH(ob))); + } + + SETs(gv); + RETURN; +} + |