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