home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / pp_hot.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-22  |  37.1 KB  |  1,806 lines  |  [TEXT/MPS ]
  1. /*    pp_hot.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
  12.  * shaking the air.
  13.  *
  14.  *            Awake!  Awake!  Fear, Fire, Foes!  Awake!
  15.  *                     Fire, Foes!  Awake!
  16.  */
  17.  
  18. #include "EXTERN.h"
  19. #include "perl.h"
  20.  
  21. /* Hot code. */
  22.  
  23. PP(pp_const)
  24. {
  25.     dSP;
  26.     XPUSHs(cSVOP->op_sv);
  27.     RETURN;
  28. }
  29.  
  30. PP(pp_nextstate)
  31. {
  32.     curcop = (COP*)op;
  33.     TAINT_NOT;        /* Each statement is presumed innocent */
  34.     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
  35.     FREETMPS;
  36.     return NORMAL;
  37. }
  38.  
  39. PP(pp_gvsv)
  40. {
  41.     dSP;
  42.     EXTEND(sp,1);
  43.     if (op->op_private & OPpLVAL_INTRO)
  44.     PUSHs(save_scalar(cGVOP->op_gv));
  45.     else
  46.     PUSHs(GvSV(cGVOP->op_gv));
  47.     RETURN;
  48. }
  49.  
  50. PP(pp_null)
  51. {
  52.     return NORMAL;
  53. }
  54.  
  55. PP(pp_pushmark)
  56. {
  57.     PUSHMARK(stack_sp);
  58.     return NORMAL;
  59. }
  60.  
  61. PP(pp_stringify)
  62. {
  63.     dSP; dTARGET;
  64.     STRLEN len;
  65.     char *s;
  66.     s = SvPV(TOPs,len);
  67.     sv_setpvn(TARG,s,len);
  68.     SETTARG;
  69.     RETURN;
  70. }
  71.  
  72. PP(pp_gv)
  73. {
  74.     dSP;
  75.     XPUSHs((SV*)cGVOP->op_gv);
  76.     RETURN;
  77. }
  78.  
  79. PP(pp_and)
  80. {
  81.     dSP;
  82.     if (!SvTRUE(TOPs))
  83.     RETURN;
  84.     else {
  85.     --SP;
  86.     RETURNOP(cLOGOP->op_other);
  87.     }
  88. }
  89.  
  90. PP(pp_sassign)
  91. {
  92.     dSP; dPOPTOPssrl;
  93.     if (op->op_private & OPpASSIGN_BACKWARDS) {
  94.     SV *temp;
  95.     temp = left; left = right; right = temp;
  96.     }
  97.     if (tainting && tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) ||
  98.                 !mg_find(left, 't'))) {
  99.     TAINT_NOT;
  100.     }
  101.     SvSetSV(right, left);
  102.     SvSETMAGIC(right);
  103.     SETs(right);
  104.     RETURN;
  105. }
  106.  
  107. PP(pp_cond_expr)
  108. {
  109.     dSP;
  110.     if (SvTRUEx(POPs))
  111.     RETURNOP(cCONDOP->op_true);
  112.     else
  113.     RETURNOP(cCONDOP->op_false);
  114. }
  115.  
  116. PP(pp_unstack)
  117. {
  118.     I32 oldsave;
  119.     TAINT_NOT;        /* Each statement is presumed innocent */
  120.     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
  121.     FREETMPS;
  122.     oldsave = scopestack[scopestack_ix - 1];
  123.     LEAVE_SCOPE(oldsave);
  124.     return NORMAL;
  125. }
  126.  
  127. PP(pp_seq)
  128. {
  129.     dSP; tryAMAGICbinSET(seq,0); 
  130.     {
  131.       dPOPTOPssrl;
  132.       SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
  133.       RETURN;
  134.     }
  135. }
  136.  
  137. PP(pp_concat)
  138. {
  139.     dSP; dATARGET; dPOPTOPssrl;
  140.     STRLEN len;
  141.     char *s;
  142.     if (TARG != left) {
  143.     s = SvPV(left,len);
  144.     sv_setpvn(TARG,s,len);
  145.     }
  146.     s = SvPV(right,len);
  147.     sv_catpvn(TARG,s,len);
  148.     SETTARG;
  149.     RETURN;
  150. }
  151.  
  152. PP(pp_padsv)
  153. {
  154.     dSP; dTARGET;
  155.     XPUSHs(TARG);
  156.     if (op->op_private & OPpLVAL_INTRO)
  157.     SAVECLEARSV(curpad[op->op_targ]);
  158.     RETURN;
  159. }
  160.  
  161. PP(pp_readline)
  162. {
  163.     last_in_gv = (GV*)(*stack_sp--);
  164.     return do_readline();
  165. }
  166.  
  167. PP(pp_eq)
  168. {
  169.     dSP; tryAMAGICbinSET(eq,0); 
  170.     {
  171.       dPOPnv;
  172.       SETs((TOPn == value) ? &sv_yes : &sv_no);
  173.       RETURN;
  174.     }
  175. }
  176.  
  177. PP(pp_preinc)
  178. {
  179.     dSP;
  180.     sv_inc(TOPs);
  181.     SvSETMAGIC(TOPs);
  182.     return NORMAL;
  183. }
  184.  
  185. PP(pp_or)
  186. {
  187.     dSP;
  188.     if (SvTRUE(TOPs))
  189.     RETURN;
  190.     else {
  191.     --SP;
  192.     RETURNOP(cLOGOP->op_other);
  193.     }
  194. }
  195.  
  196. PP(pp_add)
  197. {
  198.     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
  199.     {
  200.       dPOPTOPnnrl;
  201.       SETn( left + right );
  202.       RETURN;
  203.     }
  204. }
  205.  
  206. PP(pp_aelemfast)
  207. {
  208.     dSP;
  209.     AV *av = GvAV((GV*)cSVOP->op_sv);
  210.     SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
  211.     PUSHs(svp ? *svp : &sv_undef);
  212.     RETURN;
  213. }
  214.  
  215. PP(pp_join)
  216. {
  217.     dSP; dMARK; dTARGET;
  218.     MARK++;
  219.     do_join(TARG, *MARK, MARK, SP);
  220.     SP = MARK;
  221.     SETs(TARG);
  222.     RETURN;
  223. }
  224.  
  225. PP(pp_pushre)
  226. {
  227.     dSP;
  228.     XPUSHs((SV*)op);
  229.     RETURN;
  230. }
  231.  
  232. /* Oversized hot code. */
  233.  
  234. PP(pp_print)
  235. {
  236.     dSP; dMARK; dORIGMARK;
  237.     GV *gv;
  238.     IO *io;
  239.     register FILE *fp;
  240.  
  241.     if (op->op_flags & OPf_STACKED)
  242.     gv = (GV*)*++MARK;
  243.     else
  244.     gv = defoutgv;
  245.     if (!(io = GvIO(gv))) {
  246.     if (dowarn)
  247.         warn("Filehandle %s never opened", GvNAME(gv));
  248.     errno = EBADF;
  249.     goto just_say_no;
  250.     }
  251.     else if (!(fp = IoOFP(io))) {
  252.     if (dowarn)  {
  253.         if (IoIFP(io))
  254.         warn("Filehandle %s opened only for input", GvNAME(gv));
  255.         else
  256.         warn("print on closed filehandle %s", GvNAME(gv));
  257.     }
  258.     errno = EBADF;
  259.     goto just_say_no;
  260.     }
  261.     else {
  262.     MARK++;
  263.     if (ofslen) {
  264.         while (MARK <= SP) {
  265.         if (!do_print(*MARK, fp))
  266.             break;
  267.         MARK++;
  268.         if (MARK <= SP) {
  269.             if (fwrite1(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
  270.             MARK--;
  271.             break;
  272.             }
  273.         }
  274.         }
  275.     }
  276.     else {
  277.         while (MARK <= SP) {
  278.         if (!do_print(*MARK, fp))
  279.             break;
  280.         MARK++;
  281.         }
  282.     }
  283.     if (MARK <= SP)
  284.         goto just_say_no;
  285.     else {
  286.         if (orslen)
  287.         if (fwrite1(ors, 1, orslen, fp) == 0 || ferror(fp))
  288.             goto just_say_no;
  289.  
  290.         if (IoFLAGS(io) & IOf_FLUSH)
  291.         if (fflush(fp) == EOF)
  292.             goto just_say_no;
  293.     }
  294.     }
  295.     SP = ORIGMARK;
  296.     PUSHs(&sv_yes);
  297.     RETURN;
  298.  
  299.   just_say_no:
  300.     SP = ORIGMARK;
  301.     PUSHs(&sv_undef);
  302.     RETURN;
  303. }
  304.  
  305. PP(pp_rv2av)
  306. {
  307.     dSP; dPOPss;
  308.  
  309.     AV *av;
  310.  
  311.     if (SvROK(sv)) {
  312.       wasref:
  313.     av = (AV*)SvRV(sv);
  314.     if (SvTYPE(av) != SVt_PVAV)
  315.         DIE("Not an ARRAY reference");
  316.     if (op->op_private & OPpLVAL_INTRO)
  317.         av = (AV*)save_svref((SV**)sv);
  318.     if (op->op_flags & OPf_REF) {
  319.         PUSHs((SV*)av);
  320.         RETURN;
  321.     }
  322.     }
  323.     else {
  324.     if (SvTYPE(sv) == SVt_PVAV) {
  325.         av = (AV*)sv;
  326.         if (op->op_flags & OPf_REF) {
  327.         PUSHs((SV*)av);
  328.         RETURN;
  329.         }
  330.     }
  331.     else {
  332.         if (SvTYPE(sv) != SVt_PVGV) {
  333.         if (SvGMAGICAL(sv)) {
  334.             mg_get(sv);
  335.             if (SvROK(sv))
  336.             goto wasref;
  337.         }
  338.         if (!SvOK(sv)) {
  339.             if (op->op_flags & OPf_REF ||
  340.               op->op_private & HINT_STRICT_REFS)
  341.             DIE(no_usym, "an ARRAY");
  342.             RETPUSHUNDEF;
  343.         }
  344.         if (op->op_private & HINT_STRICT_REFS)
  345.             DIE(no_symref, "an ARRAY");
  346.         sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVAV);
  347.         }
  348.         av = GvAVn(sv);
  349.         if (op->op_private & OPpLVAL_INTRO)
  350.         av = save_ary(sv);
  351.         if (op->op_flags & OPf_REF) {
  352.         PUSHs((SV*)av);
  353.         RETURN;
  354.         }
  355.     }
  356.     }
  357.  
  358.     if (GIMME == G_ARRAY) {
  359.     I32 maxarg = AvFILL(av) + 1;
  360.     EXTEND(SP, maxarg);
  361.     Copy(AvARRAY(av), SP+1, maxarg, SV*);
  362.     SP += maxarg;
  363.     }
  364.     else {
  365.     dTARGET;
  366.     I32 maxarg = AvFILL(av) + 1;
  367.     PUSHi(maxarg);
  368.     }
  369.     RETURN;
  370. }
  371.  
  372. PP(pp_rv2hv)
  373. {
  374.  
  375.     dSP; dTOPss;
  376.  
  377.     HV *hv;
  378.  
  379.     if (SvROK(sv)) {
  380.       wasref:
  381.     hv = (HV*)SvRV(sv);
  382.     if (SvTYPE(hv) != SVt_PVHV)
  383.         DIE("Not a HASH reference");
  384.     if (op->op_private & OPpLVAL_INTRO)
  385.         hv = (HV*)save_svref((SV**)sv);
  386.     if (op->op_flags & OPf_REF) {
  387.         SETs((SV*)hv);
  388.         RETURN;
  389.     }
  390.     }
  391.     else {
  392.     if (SvTYPE(sv) == SVt_PVHV) {
  393.         hv = (HV*)sv;
  394.         if (op->op_flags & OPf_REF) {
  395.         SETs((SV*)hv);
  396.         RETURN;
  397.         }
  398.     }
  399.     else {
  400.         if (SvTYPE(sv) != SVt_PVGV) {
  401.         if (SvGMAGICAL(sv)) {
  402.             mg_get(sv);
  403.             if (SvROK(sv))
  404.             goto wasref;
  405.         }
  406.         if (!SvOK(sv)) {
  407.             if (op->op_flags & OPf_REF ||
  408.               op->op_private & HINT_STRICT_REFS)
  409.             DIE(no_usym, "a HASH");
  410.             RETSETUNDEF;
  411.         }
  412.         if (op->op_private & HINT_STRICT_REFS)
  413.             DIE(no_symref, "a HASH");
  414.         sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVHV);
  415.         }
  416.         hv = GvHVn(sv);
  417.         if (op->op_private & OPpLVAL_INTRO)
  418.         hv = save_hash(sv);
  419.         if (op->op_flags & OPf_REF) {
  420.         SETs((SV*)hv);
  421.         RETURN;
  422.         }
  423.     }
  424.     }
  425.  
  426.     if (GIMME == G_ARRAY) { /* array wanted */
  427.     *stack_sp = (SV*)hv;
  428.     return do_kv(ARGS);
  429.     }
  430.     else {
  431.     dTARGET;
  432.     if (HvFILL(hv)) {
  433.         sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
  434.         sv_setpv(TARG, buf);
  435.     }
  436.     else
  437.         sv_setiv(TARG, 0);
  438.     SETTARG;
  439.     RETURN;
  440.     }
  441. }
  442.  
  443. PP(pp_aassign)
  444. {
  445.     dSP;
  446.     SV **lastlelem = stack_sp;
  447.     SV **lastrelem = stack_base + POPMARK;
  448.     SV **firstrelem = stack_base + POPMARK + 1;
  449.     SV **firstlelem = lastrelem + 1;
  450.  
  451.     register SV **relem;
  452.     register SV **lelem;
  453.  
  454.     register SV *sv;
  455.     register AV *ary;
  456.  
  457.     HV *hash;
  458.     I32 i;
  459.     int magic;
  460.  
  461.     delaymagic = DM_DELAY;        /* catch simultaneous items */
  462.  
  463.     /* If there's a common identifier on both sides we have to take
  464.      * special care that assigning the identifier on the left doesn't
  465.      * clobber a value on the right that's used later in the list.
  466.      */
  467.     if (op->op_private & OPpASSIGN_COMMON) {
  468.         for (relem = firstrelem; relem <= lastrelem; relem++) {
  469.             /*SUPPRESS 560*/
  470.             if (sv = *relem)
  471.                 *relem = sv_mortalcopy(sv);
  472.         }
  473.     }
  474.  
  475.     relem = firstrelem;
  476.     lelem = firstlelem;
  477.     ary = Null(AV*);
  478.     hash = Null(HV*);
  479.     while (lelem <= lastlelem) {
  480.     sv = *lelem++;
  481.     switch (SvTYPE(sv)) {
  482.     case SVt_PVAV:
  483.         ary = (AV*)sv;
  484.         magic = SvSMAGICAL(ary) != 0;
  485.         
  486.         av_clear(ary);
  487.         i = 0;
  488.         while (relem <= lastrelem) {    /* gobble up all the rest */
  489.         sv = NEWSV(28,0);
  490.         assert(*relem);
  491.         sv_setsv(sv,*relem);
  492.         *(relem++) = sv;
  493.         (void)av_store(ary,i++,sv);
  494.         if (magic)
  495.             mg_set(sv);
  496.         }
  497.         break;
  498.     case SVt_PVHV: {
  499.         char *tmps;
  500.         SV *tmpstr;
  501.  
  502.         hash = (HV*)sv;
  503.         magic = SvSMAGICAL(hash) != 0;
  504.         hv_clear(hash);
  505.  
  506.         while (relem < lastrelem) {    /* gobble up all the rest */
  507.             STRLEN len;
  508.             if (*relem)
  509.             sv = *(relem++);
  510.             else
  511.             sv = &sv_no, relem++;
  512.             tmps = SvPV(sv, len);
  513.             tmpstr = NEWSV(29,0);
  514.             if (*relem)
  515.             sv_setsv(tmpstr,*relem);    /* value */
  516.             *(relem++) = tmpstr;
  517.             (void)hv_store(hash,tmps,len,tmpstr,0);
  518.             if (magic)
  519.             mg_set(tmpstr);
  520.         }
  521.         }
  522.         break;
  523.     default:
  524.         if (SvTHINKFIRST(sv)) {
  525.         if (SvREADONLY(sv) && curcop != &compiling) {
  526.             if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
  527.             DIE(no_modify);
  528.             if (relem <= lastrelem)
  529.             relem++;
  530.             break;
  531.         }
  532.         if (SvROK(sv))
  533.             sv_unref(sv);
  534.         }
  535.         if (relem <= lastrelem) {
  536.         sv_setsv(sv, *relem);
  537.         *(relem++) = sv;
  538.         }
  539.         else
  540.         sv_setsv(sv, &sv_undef);
  541.         SvSETMAGIC(sv);
  542.         break;
  543.     }
  544.     }
  545.     if (delaymagic & ~DM_DELAY) {
  546.     if (delaymagic & DM_UID) {
  547. #ifdef HAS_SETRESUID
  548.         (void)setresuid(uid,euid,(Uid_t)-1);
  549. #else /* not HAS_SETRESUID */
  550. #ifdef HAS_SETREUID
  551.         (void)setreuid(uid,euid);
  552. #else /* not HAS_SETREUID */
  553. #ifdef HAS_SETRUID
  554.         if ((delaymagic & DM_UID) == DM_RUID) {
  555.         (void)setruid(uid);
  556.         delaymagic =~ DM_RUID;
  557.         }
  558. #endif /* HAS_SETRUID */
  559. #endif /* HAS_SETRESUID */
  560. #ifdef HAS_SETEUID
  561.         if ((delaymagic & DM_UID) == DM_EUID) {
  562.         (void)seteuid(uid);
  563.         delaymagic =~ DM_EUID;
  564.         }
  565. #endif /* HAS_SETEUID */
  566.         if (delaymagic & DM_UID) {
  567.         if (uid != euid)
  568.             DIE("No setreuid available");
  569.         (void)setuid(uid);
  570.         }
  571. #endif /* not HAS_SETREUID */
  572.         uid = (int)getuid();
  573.         euid = (int)geteuid();
  574.     }
  575.     if (delaymagic & DM_GID) {
  576. #ifdef HAS_SETRESGID
  577.         (void)setresgid(gid,egid,(Gid_t)-1);
  578. #else /* not HAS_SETREGID */
  579. #ifdef HAS_SETREGID
  580.         (void)setregid(gid,egid);
  581. #else /* not HAS_SETREGID */
  582. #endif /* not HAS_SETRESGID */
  583. #ifdef HAS_SETRGID
  584.         if ((delaymagic & DM_GID) == DM_RGID) {
  585.         (void)setrgid(gid);
  586.         delaymagic =~ DM_RGID;
  587.         }
  588. #endif /* HAS_SETRGID */
  589. #ifdef HAS_SETRESGID
  590.         (void)setresgid(gid,egid,(Gid_t)-1);
  591. #else /* not HAS_SETREGID */
  592. #ifdef HAS_SETEGID
  593.         if ((delaymagic & DM_GID) == DM_EGID) {
  594.         (void)setegid(gid);
  595.         delaymagic =~ DM_EGID;
  596.         }
  597. #endif /* HAS_SETEGID */
  598.         if (delaymagic & DM_GID) {
  599.         if (gid != egid)
  600.             DIE("No setregid available");
  601.         (void)setgid(gid);
  602.         }
  603. #endif /* not HAS_SETRESGID */
  604. #endif /* not HAS_SETREGID */
  605.         gid = (int)getgid();
  606.         egid = (int)getegid();
  607.     }
  608.     tainting |= (euid != uid || egid != gid);
  609.     }
  610.     delaymagic = 0;
  611.     if (GIMME == G_ARRAY) {
  612.     if (ary || hash)
  613.         SP = lastrelem;
  614.     else
  615.         SP = firstrelem + (lastlelem - firstlelem);
  616.     RETURN;
  617.     }
  618.     else {
  619.     SP = firstrelem;
  620.     for (relem = firstrelem; relem <= lastrelem; ++relem) {
  621.         if (SvOK(*relem)) {
  622.         dTARGET;
  623.         
  624.         SETi(lastrelem - firstrelem + 1);
  625.         RETURN;
  626.         }
  627.     }
  628.     RETSETUNDEF;
  629.     }
  630. }
  631.  
  632. PP(pp_match)
  633. {
  634.     dSP; dTARG;
  635.     register PMOP *pm = cPMOP;
  636.     register char *t;
  637.     register char *s;
  638.     char *strend;
  639.     I32 global;
  640.     I32 safebase;
  641.     char *truebase;
  642.     register REGEXP *rx = pm->op_pmregexp;
  643.     I32 gimme = GIMME;
  644.     STRLEN len;
  645.  
  646.     if (op->op_flags & OPf_STACKED)
  647.     TARG = POPs;
  648.     else {
  649.     TARG = GvSV(defgv);
  650.     EXTEND(SP,1);
  651.     }
  652.     s = SvPV(TARG, len);
  653.     strend = s + len;
  654.     if (!s)
  655.     DIE("panic: do_match");
  656.  
  657.     if (pm->op_pmflags & PMf_USED) {
  658.     if (gimme == G_ARRAY)
  659.         RETURN;
  660.     RETPUSHNO;
  661.     }
  662.  
  663.     if (!rx->prelen && curpm) {
  664.     pm = curpm;
  665.     rx = pm->op_pmregexp;
  666.     }
  667.     truebase = t = s;
  668.     if (global = pm->op_pmflags & PMf_GLOBAL) {
  669.     rx->startp[0] = 0;
  670.     if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
  671.         MAGIC* mg = mg_find(TARG, 'g');
  672.         if (mg && mg->mg_len >= 0)
  673.         rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
  674.     }
  675.     }
  676.     safebase = (gimme == G_ARRAY) || global;
  677.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  678.     SAVEINT(multiline);
  679.     multiline = pm->op_pmflags & PMf_MULTILINE;
  680.     }
  681.  
  682. play_it_again:
  683.     if (global && rx->startp[0]) {
  684.     t = s = rx->endp[0];
  685.     if (s > strend)
  686.         goto nope;
  687.     }
  688.     if (pm->op_pmshort) {
  689.     if (pm->op_pmflags & PMf_SCANFIRST) {
  690.         if (SvSCREAM(TARG)) {
  691.         if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
  692.             goto nope;
  693.         else if (!(s = screaminstr(TARG, pm->op_pmshort)))
  694.             goto nope;
  695.         else if (pm->op_pmflags & PMf_ALL)
  696.             goto yup;
  697.         }
  698.         else if (!(s = fbm_instr((unsigned char*)s,
  699.           (unsigned char*)strend, pm->op_pmshort)))
  700.         goto nope;
  701.         else if (pm->op_pmflags & PMf_ALL)
  702.         goto yup;
  703.         if (s && rx->regback >= 0) {
  704.         ++BmUSEFUL(pm->op_pmshort);
  705.         s -= rx->regback;
  706.         if (s < t)
  707.             s = t;
  708.         }
  709.         else
  710.         s = t;
  711.     }
  712.     else if (!multiline) {
  713.         if (*SvPVX(pm->op_pmshort) != *s ||
  714.           bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
  715.         if (pm->op_pmflags & PMf_FOLD) {
  716.             if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
  717.             goto nope;
  718.         }
  719.         else
  720.             goto nope;
  721.         }
  722.     }
  723.     if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
  724.         SvREFCNT_dec(pm->op_pmshort);
  725.         pm->op_pmshort = Nullsv;    /* opt is being useless */
  726.     }
  727.     }
  728.     if (!rx->nparens && !global) {
  729.     gimme = G_SCALAR;            /* accidental array context? */
  730.     safebase = FALSE;
  731.     }
  732.     if (regexec(rx, s, strend, truebase, 0,
  733.       SvSCREAM(TARG) ? TARG : Nullsv,
  734.       safebase)) {
  735.     curpm = pm;
  736.     if (pm->op_pmflags & PMf_ONCE)
  737.         pm->op_pmflags |= PMf_USED;
  738.     goto gotcha;
  739.     }
  740.     else
  741.     goto ret_no;
  742.     /*NOTREACHED*/
  743.  
  744.   gotcha:
  745.     if (gimme == G_ARRAY) {
  746.     I32 iters, i, len;
  747.  
  748.     iters = rx->nparens;
  749.     if (global && !iters)
  750.         i = 1;
  751.     else
  752.         i = 0;
  753.     EXTEND(SP, iters + i);
  754.     for (i = !i; i <= iters; i++) {
  755.         PUSHs(sv_newmortal());
  756.         /*SUPPRESS 560*/
  757.         if ((s = rx->startp[i]) && rx->endp[i] ) {
  758.         len = rx->endp[i] - s;
  759.         sv_setpvn(*SP, s, len);
  760.         }
  761.     }
  762.     if (global) {
  763.         truebase = rx->subbeg;
  764.         if (rx->startp[0] && rx->startp[0] == rx->endp[0])
  765.         ++rx->endp[0];
  766.         goto play_it_again;
  767.     }
  768.     RETURN;
  769.     }
  770.     else {
  771.     if (global) {
  772.         MAGIC* mg = 0;
  773.         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
  774.         mg = mg_find(TARG, 'g');
  775.         if (!mg) {
  776.         sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
  777.         mg = mg_find(TARG, 'g');
  778.         }
  779.         mg->mg_len = rx->startp[0] ? rx->endp[0] - truebase : -1;
  780.     }
  781.     RETPUSHYES;
  782.     }
  783.  
  784. yup:
  785.     ++BmUSEFUL(pm->op_pmshort);
  786.     curpm = pm;
  787.     if (pm->op_pmflags & PMf_ONCE)
  788.     pm->op_pmflags |= PMf_USED;
  789.     if (global) {
  790.     rx->subbeg = truebase;
  791.     rx->subend = strend;
  792.     rx->startp[0] = s;
  793.     rx->endp[0] = s + SvCUR(pm->op_pmshort);
  794.     goto gotcha;
  795.     }
  796.     if (sawampersand) {
  797.     char *tmps;
  798.  
  799.     if (rx->subbase)
  800.         Safefree(rx->subbase);
  801.     tmps = rx->subbase = savepvn(t, strend-t);
  802.     rx->subbeg = tmps;
  803.     rx->subend = tmps + (strend-t);
  804.     tmps = rx->startp[0] = tmps + (s - t);
  805.     rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
  806.     }
  807.     RETPUSHYES;
  808.  
  809. nope:
  810.     if (pm->op_pmshort)
  811.     ++BmUSEFUL(pm->op_pmshort);
  812.  
  813. ret_no:
  814.     if (global) {
  815.     if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
  816.         MAGIC* mg = mg_find(TARG, 'g');
  817.         if (mg)
  818.         mg->mg_len = -1;
  819.     }
  820.     }
  821.     if (gimme == G_ARRAY)
  822.     RETURN;
  823.     RETPUSHNO;
  824. }
  825.  
  826. OP *
  827. do_readline()
  828. {
  829.     dSP; dTARGETSTACKED;
  830.     register SV *sv;
  831.     STRLEN tmplen = 0;
  832.     STRLEN offset;
  833.     FILE *fp;
  834.     register IO *io = GvIO(last_in_gv);
  835.     register I32 type = op->op_type;
  836.  
  837.     fp = Nullfp;
  838.     if (io) {
  839.     fp = IoIFP(io);
  840.     if (!fp) {
  841.         if (IoFLAGS(io) & IOf_ARGV) {
  842.         if (IoFLAGS(io) & IOf_START) {
  843.             IoFLAGS(io) &= ~IOf_START;
  844.             IoLINES(io) = 0;
  845.             if (av_len(GvAVn(last_in_gv)) < 0) {
  846. #ifdef macintosh
  847.             SV *tmpstr = newSVpv("Dev:Stdin", 9); /* assume stdin */
  848. #else
  849.             SV *tmpstr = newSVpv("-", 1); /* assume stdin */
  850. #endif
  851.             av_push(GvAVn(last_in_gv), tmpstr);
  852.             }
  853.         }
  854.         fp = nextargv(last_in_gv);
  855.         if (!fp) { /* Note: fp != IoIFP(io) */
  856.             (void)do_close(last_in_gv, FALSE); /* now it does*/
  857.             IoFLAGS(io) |= IOf_START;
  858.         }
  859.         }
  860.         else if (type == OP_GLOB) {
  861.         SV *tmpcmd = NEWSV(55, 0);
  862.         SV *tmpglob = POPs;
  863.         ENTER;
  864.         SAVEFREESV(tmpcmd);
  865. #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
  866.            /* since spawning off a process is a real performance hit */
  867.         {
  868. #include <descrip.h>
  869. #include <lib$routines.h>
  870. #include <nam.h>
  871. #include <rmsdef.h>
  872.             char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
  873.             char vmsspec[NAM$C_MAXRSS+1];
  874.             char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
  875.             char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
  876.             $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
  877.             FILE *tmpfp;
  878.             STRLEN i;
  879.             struct dsc$descriptor_s wilddsc
  880.                = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
  881.             struct dsc$descriptor_vs rsdsc
  882.                = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt};
  883.             unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0;
  884.  
  885.             /* We could find out if there's an explicit dev/dir or version
  886.                by peeking into lib$find_file's internal context at
  887.                ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
  888.                but that's unsupported, so I don't want to do it now and
  889.                have it bite someone in the future. */
  890.             strcat(tmpfnam,tmpnam(NULL));
  891.             cp = SvPV(tmpglob,i);
  892.             for (; i; i--) {
  893.                if (cp[i] == ';') hasver = 1;
  894.                if (cp[i] == '.') {
  895.                    if (sts) hasver = 1;
  896.                    else sts = 1;
  897.                }
  898.                if (cp[i] == '/') {
  899.                   hasdir = isunix = 1;
  900.                   break;
  901.                }
  902.                if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') {
  903.                    hasdir = 1;
  904.                    break;
  905.                }
  906.             }
  907.             if ((tmpfp = fopen(tmpfnam,"w+","fop=dlt")) != NULL) {
  908.                 ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
  909.                 if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
  910.                 while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
  911.                                             &dfltdsc,NULL,NULL,NULL))&1)) {
  912.                     end = rstr + (unsigned long int) *rslt;
  913.                     if (!hasver) while (*end != ';') end--;
  914.                     *(end++) = '\n';  *end = '\0';
  915.                     for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
  916.                     if (hasdir) {
  917.                       if (isunix) trim_unixpath(SvPVX(tmpglob),rstr);
  918.                       begin = rstr;
  919.                     }
  920.                     else {
  921.                         begin = end;
  922.                         while (*(--begin) != ']' && *begin != '>') ;
  923.                         ++begin;
  924.                     }
  925.                     ok = (fputs(begin,tmpfp) != EOF);
  926.                 }
  927.                 if (cxt) (void)lib$find_file_end(&cxt);
  928.                 if (ok && sts != RMS$_NMF) ok = 0;
  929.                 if (!ok) {
  930.                     fp = NULL;
  931.                 }
  932.                 else {
  933.                    rewind(tmpfp);
  934.                    IoTYPE(io) = '<';
  935.                    IoIFP(io) = fp = tmpfp;
  936.                 }
  937.             }
  938.         }
  939. #else /* !VMS */
  940. #ifdef macintosh
  941.         sv_setpv(tmpcmd, "glob ");
  942.         sv_catsv(tmpcmd, tmpglob);
  943.         sv_catpv(tmpcmd, " |");
  944. #else
  945. #ifdef DOSISH
  946.         sv_setpv(tmpcmd, "perlglob ");
  947.         sv_catsv(tmpcmd, tmpglob);
  948.         sv_catpv(tmpcmd, " |");
  949. #else
  950. #ifdef CSH
  951.         sv_setpvn(tmpcmd, cshname, cshlen);
  952.         sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
  953.         sv_catsv(tmpcmd, tmpglob);
  954.         sv_catpv(tmpcmd, "'|");
  955. #else
  956.         sv_setpv(tmpcmd, "echo ");
  957.         sv_catsv(tmpcmd, tmpglob);
  958. #if 'z' - 'a' == 25
  959.         sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
  960. #else
  961.         sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
  962. #endif
  963. #endif /* !CSH */
  964. #endif /* !MSDOS */
  965. #endif /* macintosh */
  966.         (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),Nullfp);
  967.         fp = IoIFP(io);
  968. #endif /* !VMS */
  969.         LEAVE;
  970.         }
  971.     }
  972.     else if (type == OP_GLOB)
  973.         SP--;
  974.     }
  975.     if (!fp) {
  976.     if (dowarn)
  977.         warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
  978.     if (GIMME == G_SCALAR) {
  979.         (void)SvOK_off(TARG);
  980.         PUSHTARG;
  981.     }
  982.     RETURN;
  983.     }
  984.     if (GIMME == G_ARRAY) {
  985.     sv = sv_2mortal(NEWSV(57, 80));
  986.     offset = 0;
  987.     }
  988.     else {
  989.     sv = TARG;
  990.     (void)SvUPGRADE(sv, SVt_PV);
  991.     tmplen = SvLEN(sv);    /* remember if already alloced */
  992.     if (!tmplen)
  993.         Sv_Grow(sv, 80);    /* try short-buffering it */
  994.     if (type == OP_RCATLINE)
  995.         offset = SvCUR(sv);
  996.     else
  997.         offset = 0;
  998.     }
  999.     for (;;) {
  1000.     if (!sv_gets(sv, fp, offset)) {
  1001.         clearerr(fp);
  1002.         if (IoFLAGS(io) & IOf_ARGV) {
  1003.         fp = nextargv(last_in_gv);
  1004.         if (fp)
  1005.             continue;
  1006.         (void)do_close(last_in_gv, FALSE);
  1007.         IoFLAGS(io) |= IOf_START;
  1008.         }
  1009.         else if (type == OP_GLOB) {
  1010.         (void)do_close(last_in_gv, FALSE);
  1011.         }
  1012.         if (GIMME == G_SCALAR) {
  1013.         (void)SvOK_off(TARG);
  1014.         PUSHTARG;
  1015.         }
  1016.         RETURN;
  1017.     }
  1018.     IoLINES(io)++;
  1019.     XPUSHs(sv);
  1020.     if (tainting) {
  1021.         tainted = TRUE;
  1022.         SvTAINT(sv); /* Anything from the outside world...*/
  1023.     }
  1024.     if (type == OP_GLOB) {
  1025.         char *tmps;
  1026.  
  1027.         if (SvCUR(sv) > 0)
  1028.         SvCUR(sv)--;
  1029.         if (*SvEND(sv) == rschar)
  1030.         *SvEND(sv) = '\0';
  1031.         else
  1032.         SvCUR(sv)++;
  1033.         for (tmps = SvPVX(sv); *tmps; tmps++)
  1034.         if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
  1035.             strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
  1036.             break;
  1037.         if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
  1038.         (void)POPs;        /* Unmatched wildcard?  Chuck it... */
  1039.         continue;
  1040.         }
  1041.     }
  1042.     if (GIMME == G_ARRAY) {
  1043.         if (SvLEN(sv) - SvCUR(sv) > 20) {
  1044.         SvLEN_set(sv, SvCUR(sv)+1);
  1045.         Renew(SvPVX(sv), SvLEN(sv), char);
  1046.         }
  1047.         sv = sv_2mortal(NEWSV(58, 80));
  1048.         continue;
  1049.     }
  1050.     else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
  1051.         /* try to reclaim a bit of scalar space (only on 1st alloc) */
  1052.         if (SvCUR(sv) < 60)
  1053.         SvLEN_set(sv, 80);
  1054.         else
  1055.         SvLEN_set(sv, SvCUR(sv)+40);    /* allow some slop */
  1056.         Renew(SvPVX(sv), SvLEN(sv), char);
  1057.     }
  1058.     RETURN;
  1059.     }
  1060. }
  1061.  
  1062. PP(pp_enter)
  1063. {
  1064.     dSP;
  1065.     register CONTEXT *cx;
  1066.     I32 gimme;
  1067.  
  1068.     /*
  1069.      * We don't just use the GIMME macro here because it assumes there's
  1070.      * already a context, which ain't necessarily so at initial startup.
  1071.      */
  1072.  
  1073.     if (op->op_flags & OPf_KNOW)
  1074.     gimme = op->op_flags & OPf_LIST;
  1075.     else if (cxstack_ix >= 0)
  1076.     gimme = cxstack[cxstack_ix].blk_gimme;
  1077.     else
  1078.     gimme = G_SCALAR;
  1079.  
  1080.     ENTER;
  1081.  
  1082.     SAVETMPS;
  1083.     PUSHBLOCK(cx, CXt_BLOCK, sp);
  1084.  
  1085.     RETURN;
  1086. }
  1087.  
  1088. PP(pp_helem)
  1089. {
  1090.     dSP;
  1091.     SV** svp;
  1092.     SV *keysv = POPs;
  1093.     STRLEN keylen;
  1094.     char *key = SvPV(keysv, keylen);
  1095.     HV *hv = (HV*)POPs;
  1096.     I32 lval = op->op_flags & OPf_MOD;
  1097.  
  1098.     if (SvTYPE(hv) != SVt_PVHV)
  1099.     RETPUSHUNDEF;
  1100.     svp = hv_fetch(hv, key, keylen, lval);
  1101.     if (lval) {
  1102.     if (!svp || *svp == &sv_undef)
  1103.         DIE(no_helem, key);
  1104.     if (op->op_private & OPpLVAL_INTRO)
  1105.         save_svref(svp);
  1106.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
  1107.         SV* sv = *svp;
  1108.         if (SvGMAGICAL(sv))
  1109.         mg_get(sv);
  1110.         if (!SvOK(sv)) {
  1111.         (void)SvUPGRADE(sv, SVt_RV);
  1112.         SvRV(sv) = (op->op_private & OPpDEREF_HV ?
  1113.                 (SV*)newHV() : (SV*)newAV());
  1114.         SvROK_on(sv);
  1115.         SvSETMAGIC(sv);
  1116.         }
  1117.     }
  1118.     }
  1119.     PUSHs(svp ? *svp : &sv_undef);
  1120.     RETURN;
  1121. }
  1122.  
  1123. PP(pp_leave)
  1124. {
  1125.     dSP;
  1126.     register CONTEXT *cx;
  1127.     register SV **mark;
  1128.     SV **newsp;
  1129.     PMOP *newpm;
  1130.     I32 gimme;
  1131.  
  1132.     if (op->op_flags & OPf_SPECIAL) {
  1133.     cx = &cxstack[cxstack_ix];
  1134.     cx->blk_oldpm = curpm;    /* fake block should preserve $1 et al */
  1135.     }
  1136.  
  1137.     POPBLOCK(cx,newpm);
  1138.  
  1139.     if (op->op_flags & OPf_KNOW)
  1140.     gimme = op->op_flags & OPf_LIST;
  1141.     else if (cxstack_ix >= 0)
  1142.     gimme = cxstack[cxstack_ix].blk_gimme;
  1143.     else
  1144.     gimme = G_SCALAR;
  1145.  
  1146.     if (gimme == G_SCALAR) {
  1147.     if (op->op_private & OPpLEAVE_VOID)
  1148.         SP = newsp;
  1149.     else {
  1150.         MARK = newsp + 1;
  1151.         if (MARK <= SP)
  1152.         if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
  1153.             *MARK = TOPs;
  1154.         else
  1155.             *MARK = sv_mortalcopy(TOPs);
  1156.         else {
  1157.         MEXTEND(mark,0);
  1158.         *MARK = &sv_undef;
  1159.         }
  1160.         SP = MARK;
  1161.     }
  1162.     }
  1163.     else {
  1164.     for (mark = newsp + 1; mark <= SP; mark++)
  1165.         if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
  1166.         *mark = sv_mortalcopy(*mark);
  1167.         /* in case LEAVE wipes old return values */
  1168.     }
  1169.     curpm = newpm;    /* Don't pop $1 et al till now */
  1170.  
  1171.     LEAVE;
  1172.  
  1173.     RETURN;
  1174. }
  1175.  
  1176. PP(pp_iter)
  1177. {
  1178.     dSP;
  1179.     register CONTEXT *cx;
  1180.     SV *sv;
  1181.  
  1182.     EXTEND(sp, 1);
  1183.     cx = &cxstack[cxstack_ix];
  1184.     if (cx->cx_type != CXt_LOOP)
  1185.     DIE("panic: pp_iter");
  1186.  
  1187.     if (cx->blk_loop.iterix >= cx->blk_oldsp)
  1188.     RETPUSHNO;
  1189.  
  1190.     if (sv = AvARRAY(cx->blk_loop.iterary)[++cx->blk_loop.iterix]) {
  1191.     SvTEMP_off(sv);
  1192.     *cx->blk_loop.itervar = sv;
  1193.     }
  1194.     else
  1195.     *cx->blk_loop.itervar = &sv_undef;
  1196.  
  1197.     RETPUSHYES;
  1198. }
  1199.  
  1200. PP(pp_subst)
  1201. {
  1202.     dSP; dTARG;
  1203.     register PMOP *pm = cPMOP;
  1204.     PMOP *rpm = pm;
  1205.     register SV *dstr;
  1206.     register char *s;
  1207.     char *strend;
  1208.     register char *m;
  1209.     char *c;
  1210.     register char *d;
  1211.     STRLEN clen;
  1212.     I32 iters = 0;
  1213.     I32 maxiters;
  1214.     register I32 i;
  1215.     bool once;
  1216.     char *orig;
  1217.     I32 safebase;
  1218.     register REGEXP *rx = pm->op_pmregexp;
  1219.     STRLEN len;
  1220.     int force_on_match = 0;
  1221.  
  1222.     if (pm->op_pmflags & PMf_CONST)    /* known replacement string? */
  1223.     dstr = POPs;
  1224.     if (op->op_flags & OPf_STACKED)
  1225.     TARG = POPs;
  1226.     else {
  1227.     TARG = GvSV(defgv);
  1228.     EXTEND(SP,1);
  1229.     }
  1230.     s = SvPV(TARG, len);
  1231.     if (!SvPOKp(TARG))
  1232.     force_on_match = 1;
  1233.  
  1234.   force_it:
  1235.     if (!pm || !s)
  1236.     DIE("panic: do_subst");
  1237.  
  1238.     strend = s + len;
  1239.     maxiters = (strend - s) + 10;
  1240.  
  1241.     if (!rx->prelen && curpm) {
  1242.     pm = curpm;
  1243.     rx = pm->op_pmregexp;
  1244.     }
  1245.     safebase = ((!rx || !rx->nparens) && !sawampersand);
  1246.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  1247.     SAVEINT(multiline);
  1248.     multiline = pm->op_pmflags & PMf_MULTILINE;
  1249.     }
  1250.     orig = m = s;
  1251.     if (pm->op_pmshort) {
  1252.     if (pm->op_pmflags & PMf_SCANFIRST) {
  1253.         if (SvSCREAM(TARG)) {
  1254.         if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
  1255.             goto nope;
  1256.         else if (!(s = screaminstr(TARG, pm->op_pmshort)))
  1257.             goto nope;
  1258.         }
  1259.         else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
  1260.           pm->op_pmshort)))
  1261.         goto nope;
  1262.         if (s && rx->regback >= 0) {
  1263.         ++BmUSEFUL(pm->op_pmshort);
  1264.         s -= rx->regback;
  1265.         if (s < m)
  1266.             s = m;
  1267.         }
  1268.         else
  1269.         s = m;
  1270.     }
  1271.     else if (!multiline) {
  1272.         if (*SvPVX(pm->op_pmshort) != *s ||
  1273.           bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
  1274.         if (pm->op_pmflags & PMf_FOLD) {
  1275.             if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
  1276.             goto nope;
  1277.         }
  1278.         else
  1279.             goto nope;
  1280.         }
  1281.     }
  1282.     if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
  1283.         SvREFCNT_dec(pm->op_pmshort);
  1284.         pm->op_pmshort = Nullsv;    /* opt is being useless */
  1285.     }
  1286.     }
  1287.     once = !(rpm->op_pmflags & PMf_GLOBAL);
  1288.     if (rpm->op_pmflags & PMf_CONST) {    /* known replacement string? */
  1289.     c = SvPV(dstr, clen);
  1290.     if (clen <= rx->minlen) {
  1291.                     /* can do inplace substitution */
  1292.         if (regexec(rx, s, strend, orig, 0,
  1293.           SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
  1294.         if (force_on_match) {
  1295.             force_on_match = 0;
  1296.             s = SvPV_force(TARG, len);
  1297.             goto force_it;
  1298.         }
  1299.         if (rx->subbase)     /* oops, no we can't */
  1300.             goto long_way;
  1301.         d = s;
  1302.         curpm = pm;
  1303.         SvSCREAM_off(TARG);    /* disable possible screamer */
  1304.         if (once) {
  1305.             m = rx->startp[0];
  1306.             d = rx->endp[0];
  1307.             s = orig;
  1308.             if (m - s > strend - d) {    /* faster to shorten from end */
  1309.             if (clen) {
  1310.                 Copy(c, m, clen, char);
  1311.                 m += clen;
  1312.             }
  1313.             i = strend - d;
  1314.             if (i > 0) {
  1315.                 Move(d, m, i, char);
  1316.                 m += i;
  1317.             }
  1318.             *m = '\0';
  1319.             SvCUR_set(TARG, m - s);
  1320.             (void)SvPOK_only(TARG);
  1321.             SvSETMAGIC(TARG);
  1322.             PUSHs(&sv_yes);
  1323.             RETURN;
  1324.             }
  1325.             /*SUPPRESS 560*/
  1326.             else if (i = m - s) {    /* faster from front */
  1327.             d -= clen;
  1328.             m = d;
  1329.             sv_chop(TARG, d-i);
  1330.             s += i;
  1331.             while (i--)
  1332.                 *--d = *--s;
  1333.             if (clen)
  1334.                 Copy(c, m, clen, char);
  1335.             (void)SvPOK_only(TARG);
  1336.             SvSETMAGIC(TARG);
  1337.             PUSHs(&sv_yes);
  1338.             RETURN;
  1339.             }
  1340.             else if (clen) {
  1341.             d -= clen;
  1342.             sv_chop(TARG, d);
  1343.             Copy(c, d, clen, char);
  1344.             (void)SvPOK_only(TARG);
  1345.             SvSETMAGIC(TARG);
  1346.             PUSHs(&sv_yes);
  1347.             RETURN;
  1348.             }
  1349.             else {
  1350.             sv_chop(TARG, d);
  1351.             (void)SvPOK_only(TARG);
  1352.             SvSETMAGIC(TARG);
  1353.             PUSHs(&sv_yes);
  1354.             RETURN;
  1355.             }
  1356.             /* NOTREACHED */
  1357.         }
  1358.         do {
  1359.             if (iters++ > maxiters)
  1360.             DIE("Substitution loop");
  1361.             m = rx->startp[0];
  1362.             /*SUPPRESS 560*/
  1363.             if (i = m - s) {
  1364.             if (s != d)
  1365.                 Move(s, d, i, char);
  1366.             d += i;
  1367.             }
  1368.             if (clen) {
  1369.             Copy(c, d, clen, char);
  1370.             d += clen;
  1371.             }
  1372.             s = rx->endp[0];
  1373.         } while (regexec(rx, s, strend, orig, s == m,
  1374.             Nullsv, TRUE));    /* (don't match same null twice) */
  1375.         if (s != d) {
  1376.             i = strend - s;
  1377.             SvCUR_set(TARG, d - SvPVX(TARG) + i);
  1378.             Move(s, d, i+1, char);        /* include the Null */
  1379.         }
  1380.         (void)SvPOK_only(TARG);
  1381.         SvSETMAGIC(TARG);
  1382.         PUSHs(sv_2mortal(newSViv((I32)iters)));
  1383.         RETURN;
  1384.         }
  1385.         PUSHs(&sv_no);
  1386.         RETURN;
  1387.     }
  1388.     }
  1389.     else
  1390.     c = Nullch;
  1391.     if (regexec(rx, s, strend, orig, 0,
  1392.       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
  1393.     long_way:
  1394.     if (force_on_match) {
  1395.         force_on_match = 0;
  1396.         s = SvPV_force(TARG, len);
  1397.         goto force_it;
  1398.     }
  1399.     dstr = NEWSV(25, sv_len(TARG));
  1400.     sv_setpvn(dstr, m, s-m);
  1401.     curpm = pm;
  1402.     if (!c) {
  1403.         register CONTEXT *cx;
  1404.         PUSHSUBST(cx);
  1405.         RETURNOP(cPMOP->op_pmreplroot);
  1406.     }
  1407.     do {
  1408.         if (iters++ > maxiters)
  1409.         DIE("Substitution loop");
  1410.         if (rx->subbase && rx->subbase != orig) {
  1411.         m = s;
  1412.         s = orig;
  1413.         orig = rx->subbase;
  1414.         s = orig + (m - s);
  1415.         strend = s + (strend - m);
  1416.         }
  1417.         m = rx->startp[0];
  1418.         sv_catpvn(dstr, s, m-s);
  1419.         s = rx->endp[0];
  1420.         if (clen)
  1421.         sv_catpvn(dstr, c, clen);
  1422.         if (once)
  1423.         break;
  1424.     } while (regexec(rx, s, strend, orig, s == m, Nullsv,
  1425.         safebase));
  1426.     sv_catpvn(dstr, s, strend - s);
  1427.     sv_replace(TARG, dstr);
  1428.     (void)SvPOK_only(TARG);
  1429.     SvSETMAGIC(TARG);
  1430.     PUSHs(sv_2mortal(newSViv((I32)iters)));
  1431.     RETURN;
  1432.     }
  1433.     PUSHs(&sv_no);
  1434.     RETURN;
  1435.  
  1436. nope:
  1437.     ++BmUSEFUL(pm->op_pmshort);
  1438.     PUSHs(&sv_no);
  1439.     RETURN;
  1440. }
  1441.  
  1442. PP(pp_grepwhile)
  1443. {
  1444.     dSP;
  1445.  
  1446.     if (SvTRUEx(POPs))
  1447.     stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
  1448.     ++*markstack_ptr;
  1449.     LEAVE;                    /* exit inner scope */
  1450.  
  1451.     /* All done yet? */
  1452.     if (stack_base + *markstack_ptr > sp) {
  1453.     I32 items;
  1454.  
  1455.     LEAVE;                    /* exit outer scope */
  1456.     (void)POPMARK;                /* pop src */
  1457.     items = --*markstack_ptr - markstack_ptr[-1];
  1458.     (void)POPMARK;                /* pop dst */
  1459.     SP = stack_base + POPMARK;        /* pop original mark */
  1460.     if (GIMME != G_ARRAY) {
  1461.         dTARGET;
  1462.         XPUSHi(items);
  1463.         RETURN;
  1464.     }
  1465.     SP += items;
  1466.     RETURN;
  1467.     }
  1468.     else {
  1469.     SV *src;
  1470.  
  1471.     ENTER;                    /* enter inner scope */
  1472.     SAVESPTR(curpm);
  1473.  
  1474.     src = stack_base[*markstack_ptr];
  1475.     SvTEMP_off(src);
  1476.     GvSV(defgv) = src;
  1477.  
  1478.     RETURNOP(cLOGOP->op_other);
  1479.     }
  1480. }
  1481.  
  1482. PP(pp_leavesub)
  1483. {
  1484.     dSP;
  1485.     SV **mark;
  1486.     SV **newsp;
  1487.     PMOP *newpm;
  1488.     I32 gimme;
  1489.     register CONTEXT *cx;
  1490.  
  1491.     POPBLOCK(cx,newpm);
  1492.     POPSUB(cx);
  1493.  
  1494.     if (gimme == G_SCALAR) {
  1495.     MARK = newsp + 1;
  1496.     if (MARK <= SP)
  1497.         if (SvFLAGS(TOPs) & SVs_TEMP)
  1498.         *MARK = TOPs;
  1499.         else
  1500.         *MARK = sv_mortalcopy(TOPs);
  1501.     else {
  1502.         MEXTEND(mark,0);
  1503.         *MARK = &sv_undef;
  1504.     }
  1505.     SP = MARK;
  1506.     }
  1507.     else {
  1508.     for (mark = newsp + 1; mark <= SP; mark++)
  1509.         if (!(SvFLAGS(*mark) & SVs_TEMP))
  1510.         *mark = sv_mortalcopy(*mark);
  1511.         /* in case LEAVE wipes old return values */
  1512.     }
  1513.  
  1514.     if (cx->blk_sub.hasargs) {        /* You don't exist; go away. */
  1515.     AV* av = cx->blk_sub.argarray;
  1516.  
  1517.     av_clear(av);
  1518.     AvREAL_off(av);
  1519.     }
  1520.     curpm = newpm;    /* Don't pop $1 et al till now */
  1521.  
  1522.     LEAVE;
  1523.     PUTBACK;
  1524.     return pop_return();
  1525. }
  1526.  
  1527. PP(pp_entersub)
  1528. {
  1529.     dSP; dPOPss;
  1530.     GV *gv;
  1531.     HV *stash;
  1532.     register CV *cv;
  1533.     register CONTEXT *cx;
  1534.  
  1535.     if (!sv)
  1536.     DIE("Not a CODE reference");
  1537.     switch (SvTYPE(sv)) {
  1538.     default:
  1539.     if (!SvROK(sv)) {
  1540.         if (sv == &sv_yes)        /* unfound import, ignore */
  1541.         RETURN;
  1542.         if (!SvOK(sv))
  1543.         DIE(no_usym, "a subroutine");
  1544.         if (op->op_private & HINT_STRICT_REFS)
  1545.         DIE(no_symref, "a subroutine");
  1546.         gv = gv_fetchpv(SvPV(sv, na), FALSE, SVt_PVCV);
  1547.         if (!gv)
  1548.         cv = 0;
  1549.         else
  1550.         cv = GvCV(gv);
  1551.         break;
  1552.     }
  1553.     cv = (CV*)SvRV(sv);
  1554.     if (SvTYPE(cv) == SVt_PVCV)
  1555.         break;
  1556.     /* FALL THROUGH */
  1557.     case SVt_PVHV:
  1558.     case SVt_PVAV:
  1559.     DIE("Not a CODE reference");
  1560.     case SVt_PVCV:
  1561.     cv = (CV*)sv;
  1562.     break;
  1563.     case SVt_PVGV:
  1564.     if (!(cv = GvCV((GV*)sv)))
  1565.         cv = sv_2cv(sv, &stash, &gv, TRUE);
  1566.     break;
  1567.     }
  1568.  
  1569.     ENTER;
  1570.     SAVETMPS;
  1571.  
  1572.   retry:
  1573.     if (!cv)
  1574.     DIE("Not a CODE reference");
  1575.  
  1576.     if (!CvROOT(cv) && !CvXSUB(cv)) {
  1577.     if (gv = CvGV(cv)) {
  1578.         SV *tmpstr = sv_newmortal();
  1579.         GV *ngv;
  1580.         gv_efullname(tmpstr, gv);
  1581.         ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
  1582.         if (ngv && ngv != gv && (cv = GvCV(ngv))) {    /* One more chance... */
  1583.         gv = ngv;
  1584.         sv_setsv(GvSV(CvGV(cv)), tmpstr);    /* Set CV's $AUTOLOAD */
  1585.         goto retry;
  1586.         }
  1587.         else
  1588.         DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
  1589.     }
  1590.     DIE("Undefined subroutine called");
  1591.     }
  1592.  
  1593.     if ((op->op_private & OPpDEREF_DB) && !CvXSUB(cv)) {
  1594.     sv = GvSV(DBsub);
  1595.     save_item(sv);
  1596.     gv = CvGV(cv);
  1597.     gv_efullname(sv,gv);
  1598.     cv = GvCV(DBsub);
  1599.     if (!cv)
  1600.         DIE("No DBsub routine");
  1601.     }
  1602.  
  1603.     if (CvXSUB(cv)) {
  1604.     if (CvOLDSTYLE(cv)) {
  1605.         dMARK;
  1606.         register I32 items = SP - MARK;
  1607.         while (sp > mark) {
  1608.         sp[1] = sp[0];
  1609.         sp--;
  1610.         }
  1611.         stack_sp = mark + 1;
  1612.         items = (*(I32(*)_((int,int,int)))CvXSUB(cv))(CvXSUBANY(cv).any_i32,
  1613.                     MARK - stack_base + 1, items);
  1614.         stack_sp = stack_base + items;
  1615.     }
  1616.     else {
  1617.         PUTBACK;
  1618.         (void)(*CvXSUB(cv))(cv);
  1619.     }
  1620.     LEAVE;
  1621.     return NORMAL;
  1622.     }
  1623.     else {
  1624.     dMARK;
  1625.     register I32 items = SP - MARK;
  1626.     I32 hasargs = (op->op_flags & OPf_STACKED) != 0;
  1627.     I32 gimme = GIMME;
  1628.     AV* padlist = CvPADLIST(cv);
  1629.     SV** svp = AvARRAY(padlist);
  1630.     push_return(op->op_next);
  1631.     PUSHBLOCK(cx, CXt_SUB, MARK);
  1632.     PUSHSUB(cx);
  1633.     CvDEPTH(cv)++;
  1634.     if (CvDEPTH(cv) < 2)
  1635.         (void)SvREFCNT_inc(cv);
  1636.     else {    /* save temporaries on recursion? */
  1637. #ifdef macintosh
  1638.         StackAttack();
  1639. #endif
  1640.         if (CvDEPTH(cv) == 100 && dowarn)
  1641.         warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
  1642.         if (CvDEPTH(cv) > AvFILL(padlist)) {
  1643.         AV *av;
  1644.         AV *newpad = newAV();
  1645.         I32 ix = AvFILL((AV*)svp[1]);
  1646.         svp = AvARRAY(svp[0]);
  1647.         while (ix > 0) {
  1648.             if (svp[ix] != &sv_undef) {
  1649.             char *name = SvPVX(svp[ix]);    /* XXX */
  1650.             if (*name == '@')
  1651.                 av_store(newpad, ix--, sv = (SV*)newAV());
  1652.             else if (*name == '%')
  1653.                 av_store(newpad, ix--, sv = (SV*)newHV());
  1654.             else
  1655.                 av_store(newpad, ix--, sv = NEWSV(0,0));
  1656.             SvPADMY_on(sv);
  1657.             }
  1658.             else {
  1659.             av_store(newpad, ix--, sv = NEWSV(0,0));
  1660.             SvPADTMP_on(sv);
  1661.             }
  1662.         }
  1663.         av = newAV();        /* will be @_ */
  1664.         av_extend(av, 0);
  1665.         av_store(newpad, 0, (SV*)av);
  1666.         AvFLAGS(av) = AVf_REIFY;
  1667.         av_store(padlist, CvDEPTH(cv), (SV*)newpad);
  1668.         AvFILL(padlist) = CvDEPTH(cv);
  1669.         svp = AvARRAY(padlist);
  1670.         }
  1671.     }
  1672.     SAVESPTR(curpad);
  1673.     curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
  1674.     if (hasargs) {
  1675.         AV* av = (AV*)curpad[0];
  1676.         SV** ary;
  1677.  
  1678.         if (AvREAL(av)) {
  1679.         av_clear(av);
  1680.         AvREAL_off(av);
  1681.         }
  1682.         cx->blk_sub.savearray = GvAV(defgv);
  1683.         cx->blk_sub.argarray = av;
  1684.         GvAV(defgv) = cx->blk_sub.argarray;
  1685.         ++MARK;
  1686.  
  1687.         if (items > AvMAX(av) + 1) {
  1688.         ary = AvALLOC(av);
  1689.         if (AvARRAY(av) != ary) {
  1690.             AvMAX(av) += AvARRAY(av) - AvALLOC(av);
  1691.             SvPVX(av) = (char*)ary;
  1692.         }
  1693.         if (items > AvMAX(av) + 1) {
  1694.             AvMAX(av) = items - 1;
  1695.             Renew(ary,items,SV*);
  1696.             AvALLOC(av) = ary;
  1697.             SvPVX(av) = (char*)ary;
  1698.         }
  1699.         }
  1700.         Copy(MARK,AvARRAY(av),items,SV*);
  1701.         AvFILL(av) = items - 1;
  1702.         
  1703.         while (items--) {
  1704.         if (*MARK)
  1705.             SvTEMP_off(*MARK);
  1706.         MARK++;
  1707.         }
  1708.     }
  1709.     RETURNOP(CvSTART(cv));
  1710.     }
  1711. }
  1712.  
  1713. PP(pp_aelem)
  1714. {
  1715.     dSP;
  1716.     SV** svp;
  1717.     I32 elem = POPi - curcop->cop_arybase;
  1718.     AV *av = (AV*)POPs;
  1719.     I32 lval = op->op_flags & OPf_MOD;
  1720.  
  1721.     if (SvTYPE(av) != SVt_PVAV)
  1722.     RETPUSHUNDEF;
  1723.     svp = av_fetch(av, elem, lval);
  1724.     if (lval) {
  1725.     if (!svp || *svp == &sv_undef)
  1726.         DIE(no_aelem, elem);
  1727.     if (op->op_private & OPpLVAL_INTRO)
  1728.         save_svref(svp);
  1729.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
  1730.         SV* sv = *svp;
  1731.         if (SvGMAGICAL(sv))
  1732.         mg_get(sv);
  1733.         if (!SvOK(sv)) {
  1734.         (void)SvUPGRADE(sv, SVt_RV);
  1735.         SvRV(sv) = (op->op_private & OPpDEREF_HV ?
  1736.                 (SV*)newHV() : (SV*)newAV());
  1737.         SvROK_on(sv);
  1738.         SvSETMAGIC(sv);
  1739.         }
  1740.     }
  1741.     }
  1742.     PUSHs(svp ? *svp : &sv_undef);
  1743.     RETURN;
  1744. }
  1745.  
  1746. PP(pp_method)
  1747. {
  1748.     dSP;
  1749.     SV* sv;
  1750.     SV* ob;
  1751.     GV* gv;
  1752.     SV* nm;
  1753.  
  1754.     nm = TOPs;
  1755.     sv = *(stack_base + TOPMARK + 1);
  1756.     
  1757.     gv = 0;
  1758.     if (SvROK(sv))
  1759.     ob = SvRV(sv);
  1760.     else {
  1761.     GV* iogv;
  1762.     char* packname = 0;
  1763.  
  1764.     if (!SvOK(sv) ||
  1765.         !(packname = SvPV(sv, na)) ||
  1766.         !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
  1767.         !(ob=(SV*)GvIO(iogv)))
  1768.     {
  1769.         char *name = SvPV(nm, na);
  1770.         HV *stash;
  1771.         if (!packname || !isALPHA(*packname))
  1772. DIE("Can't call method \"%s\" without a package or object reference", name);
  1773.         if (!(stash = gv_stashpv(packname, FALSE))) {
  1774.         if (gv_stashpv("UNIVERSAL", FALSE))
  1775.             stash = gv_stashpv(packname, TRUE);
  1776.         else
  1777.             DIE("Can't call method \"%s\" in empty package \"%s\"",
  1778.             name, packname);
  1779.         }
  1780.         gv = gv_fetchmethod(stash,name);
  1781.         if (!gv)
  1782.         DIE("Can't locate object method \"%s\" via package \"%s\"",
  1783.             name, packname);
  1784.         SETs(gv);
  1785.         RETURN;
  1786.     }
  1787.     }
  1788.  
  1789.     if (!ob || !SvOBJECT(ob)) {
  1790.     char *name = SvPV(nm, na);
  1791.     DIE("Can't call method \"%s\" on unblessed reference", name);
  1792.     }
  1793.  
  1794.     if (!gv) {        /* nothing cached */
  1795.     char *name = SvPV(nm, na);
  1796.     gv = gv_fetchmethod(SvSTASH(ob),name);
  1797.     if (!gv)
  1798.         DIE("Can't locate object method \"%s\" via package \"%s\"",
  1799.         name, HvNAME(SvSTASH(ob)));
  1800.     }
  1801.  
  1802.     SETs(gv);
  1803.     RETURN;
  1804. }
  1805.  
  1806.