home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.2J (Developer) / os42jdev.iso / NextDeveloper / Source / GNU / perl / Perl / pp.c < prev    next >
C/C++ Source or Header  |  1995-06-22  |  64KB  |  3,465 lines
  1. /*    pp.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.  * "It's a big house this, and very peculiar.  Always a bit more to discover,
  12.  * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. static void doencodes _((SV *sv, char *s, I32 len));
  19.  
  20. /* variations on pp_null */
  21.  
  22. PP(pp_stub)
  23. {
  24.     dSP;
  25.     if (GIMME != G_ARRAY) {
  26.     XPUSHs(&sv_undef);
  27.     }
  28.     RETURN;
  29. }
  30.  
  31. PP(pp_scalar)
  32. {
  33.     return NORMAL;
  34. }
  35.  
  36. /* Pushy stuff. */
  37.  
  38. PP(pp_padav)
  39. {
  40.     dSP; dTARGET;
  41.     if (op->op_private & OPpLVAL_INTRO)
  42.     SAVECLEARSV(curpad[op->op_targ]);
  43.     EXTEND(SP, 1);
  44.     if (op->op_flags & OPf_REF) {
  45.     PUSHs(TARG);
  46.     RETURN;
  47.     }
  48.     if (GIMME == G_ARRAY) {
  49.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  50.     EXTEND(SP, maxarg);
  51.     Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
  52.     SP += maxarg;
  53.     }
  54.     else {
  55.     SV* sv = sv_newmortal();
  56.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  57.     sv_setiv(sv, maxarg);
  58.     PUSHs(sv);
  59.     }
  60.     RETURN;
  61. }
  62.  
  63. PP(pp_padhv)
  64. {
  65.     dSP; dTARGET;
  66.     XPUSHs(TARG);
  67.     if (op->op_private & OPpLVAL_INTRO)
  68.     SAVECLEARSV(curpad[op->op_targ]);
  69.     if (op->op_flags & OPf_REF)
  70.     RETURN;
  71.     if (GIMME == G_ARRAY) { /* array wanted */
  72.     RETURNOP(do_kv(ARGS));
  73.     }
  74.     else {
  75.     SV* sv = sv_newmortal();
  76.     if (HvFILL((HV*)TARG)) {
  77.         sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
  78.         sv_setpv(sv, buf);
  79.     }
  80.     else
  81.         sv_setiv(sv, 0);
  82.     SETs(sv);
  83.     RETURN;
  84.     }
  85. }
  86.  
  87. PP(pp_padany)
  88. {
  89.     DIE("NOT IMPL LINE %d",__LINE__);
  90. }
  91.  
  92. /* Translations. */
  93.  
  94. PP(pp_rv2gv)
  95. {
  96.     dSP; dTOPss;
  97.     
  98.     if (SvROK(sv)) {
  99.       wasref:
  100.     sv = SvRV(sv);
  101.     if (SvTYPE(sv) != SVt_PVGV)
  102.         DIE("Not a GLOB reference");
  103.     }
  104.     else {
  105.     if (SvTYPE(sv) != SVt_PVGV) {
  106.         char *sym;
  107.  
  108.         if (SvGMAGICAL(sv)) {
  109.         mg_get(sv);
  110.         if (SvROK(sv))
  111.             goto wasref;
  112.         }
  113.         if (!SvOK(sv)) {
  114.         if (op->op_flags & OPf_REF ||
  115.             op->op_private & HINT_STRICT_REFS)
  116.             DIE(no_usym, "a symbol");
  117.         RETSETUNDEF;
  118.         }
  119.         sym = SvPV(sv, na);
  120.         if (op->op_private & HINT_STRICT_REFS)
  121.         DIE(no_symref, sym, "a symbol");
  122.         sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
  123.     }
  124.     }
  125.     if (op->op_private & OPpLVAL_INTRO) {
  126.     GP *ogp = GvGP(sv);
  127.  
  128.     SSCHECK(3);
  129.     SSPUSHPTR(sv);
  130.     SSPUSHPTR(ogp);
  131.     SSPUSHINT(SAVEt_GP);
  132.  
  133.     if (op->op_flags & OPf_SPECIAL) {
  134.         GvGP(sv)->gp_refcnt++;        /* will soon be assigned */
  135.         GvFLAGS(sv) |= GVf_INTRO;
  136.     }
  137.     else {
  138.         GP *gp;
  139.         Newz(602,gp, 1, GP);
  140.         GvGP(sv) = gp;
  141.         GvREFCNT(sv) = 1;
  142.         GvSV(sv) = NEWSV(72,0);
  143.         GvLINE(sv) = curcop->cop_line;
  144.         GvEGV(sv) = sv;
  145.     }
  146.     }
  147.     SETs(sv);
  148.     RETURN;
  149. }
  150.  
  151. PP(pp_sv2len)
  152. {
  153.     dSP; dTARGET;
  154.     dPOPss;
  155.     PUSHi(sv_len(sv));
  156.     RETURN;
  157. }
  158.  
  159. PP(pp_rv2sv)
  160. {
  161.     dSP; dTOPss;
  162.  
  163.     if (SvROK(sv)) {
  164.       wasref:
  165.     sv = SvRV(sv);
  166.     switch (SvTYPE(sv)) {
  167.     case SVt_PVAV:
  168.     case SVt_PVHV:
  169.     case SVt_PVCV:
  170.         DIE("Not a SCALAR reference");
  171.     }
  172.     }
  173.     else {
  174.     GV *gv = sv;
  175.     char *sym;
  176.  
  177.     if (SvTYPE(gv) != SVt_PVGV) {
  178.         if (SvGMAGICAL(sv)) {
  179.         mg_get(sv);
  180.         if (SvROK(sv))
  181.             goto wasref;
  182.         }
  183.         if (!SvOK(sv)) {
  184.         if (op->op_flags & OPf_REF ||
  185.             op->op_private & HINT_STRICT_REFS)
  186.             DIE(no_usym, "a SCALAR");
  187.         RETSETUNDEF;
  188.         }
  189.         sym = SvPV(sv, na);
  190.         if (op->op_private & HINT_STRICT_REFS)
  191.         DIE(no_symref, sym, "a SCALAR");
  192.         gv = (SV*)gv_fetchpv(sym, TRUE, SVt_PV);
  193.     }
  194.     sv = GvSV(gv);
  195.     }
  196.     if (op->op_flags & OPf_MOD) {
  197.     if (op->op_private & OPpLVAL_INTRO)
  198.         sv = save_scalar((GV*)TOPs);
  199.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
  200.         if (SvGMAGICAL(sv))
  201.         mg_get(sv);
  202.         if (!SvOK(sv)) {
  203.         (void)SvUPGRADE(sv, SVt_RV);
  204.         SvRV(sv) = (op->op_private & OPpDEREF_HV ?
  205.                 (SV*)newHV() : (SV*)newAV());
  206.         SvROK_on(sv);
  207.         SvSETMAGIC(sv);
  208.         }
  209.     }
  210.     }
  211.     SETs(sv);
  212.     RETURN;
  213. }
  214.  
  215. PP(pp_av2arylen)
  216. {
  217.     dSP;
  218.     AV *av = (AV*)TOPs;
  219.     SV *sv = AvARYLEN(av);
  220.     if (!sv) {
  221.     AvARYLEN(av) = sv = NEWSV(0,0);
  222.     sv_upgrade(sv, SVt_IV);
  223.     sv_magic(sv, (SV*)av, '#', Nullch, 0);
  224.     }
  225.     SETs(sv);
  226.     RETURN;
  227. }
  228.  
  229. PP(pp_pos)
  230. {
  231.     dSP; dTARGET; dPOPss;
  232.     
  233.     if (op->op_flags & OPf_MOD) {
  234.     LvTYPE(TARG) = '<';
  235.     LvTARG(TARG) = sv;
  236.     PUSHs(TARG);    /* no SvSETMAGIC */
  237.     RETURN;
  238.     }
  239.     else {
  240.     MAGIC* mg; 
  241.  
  242.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
  243.         mg = mg_find(sv, 'g');
  244.         if (mg && mg->mg_len >= 0) {
  245.         PUSHi(mg->mg_len + curcop->cop_arybase);
  246.         RETURN;
  247.         }
  248.     }
  249.     RETPUSHUNDEF;
  250.     }
  251. }
  252.  
  253. PP(pp_rv2cv)
  254. {
  255.     dSP;
  256.     GV *gv;
  257.     HV *stash;
  258.  
  259.     /* We always try to add a non-existent subroutine in case of AUTOLOAD. */
  260.     CV *cv = sv_2cv(TOPs, &stash, &gv, TRUE);
  261.  
  262.     SETs((SV*)cv);
  263.     RETURN;
  264. }
  265.  
  266. PP(pp_anoncode)
  267. {
  268.     dSP;
  269.     CV* cv = (CV*)cSVOP->op_sv;
  270.     EXTEND(SP,1);
  271.  
  272.     if (SvFLAGS(cv) & SVpcv_CLONE) {
  273.     cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
  274.     }
  275.  
  276.     PUSHs((SV*)cv);
  277.     RETURN;
  278. }
  279.  
  280. PP(pp_srefgen)
  281. {
  282.     dSP; dTOPss;
  283.     SV* rv;
  284.     rv = sv_newmortal();
  285.     sv_upgrade(rv, SVt_RV);
  286.     if (SvPADTMP(sv))
  287.     sv = newSVsv(sv);
  288.     else {
  289.     SvTEMP_off(sv);
  290.     (void)SvREFCNT_inc(sv);
  291.     }
  292.     SvRV(rv) = sv;
  293.     SvROK_on(rv);
  294.     SETs(rv);
  295.     RETURN;
  296. } 
  297.  
  298. PP(pp_refgen)
  299. {
  300.     dSP; dMARK;
  301.     SV* sv;
  302.     SV* rv;
  303.     if (GIMME != G_ARRAY) {
  304.     MARK[1] = *SP;
  305.     SP = MARK + 1;
  306.     }
  307.     while (MARK < SP) {
  308.     sv = *++MARK;
  309.     rv = sv_newmortal();
  310.     sv_upgrade(rv, SVt_RV);
  311.     if (SvPADTMP(sv))
  312.         sv = newSVsv(sv);
  313.     else {
  314.         SvTEMP_off(sv);
  315.         (void)SvREFCNT_inc(sv);
  316.     }
  317.     SvRV(rv) = sv;
  318.     SvROK_on(rv);
  319.     *MARK = rv;
  320.     }
  321.     RETURN;
  322. }
  323.  
  324. PP(pp_ref)
  325. {
  326.     dSP; dTARGET;
  327.     SV *sv;
  328.     char *pv;
  329.  
  330.     sv = POPs;
  331.     if (!sv || !SvROK(sv))
  332.     RETPUSHUNDEF;
  333.  
  334.     sv = SvRV(sv);
  335.     pv = sv_reftype(sv,TRUE);
  336.     PUSHp(pv, strlen(pv));
  337.     RETURN;
  338. }
  339.  
  340. PP(pp_bless)
  341. {
  342.     dSP;
  343.     HV *stash;
  344.  
  345.     if (MAXARG == 1)
  346.     stash = curcop->cop_stash;
  347.     else
  348.     stash = gv_stashsv(POPs, TRUE);
  349.  
  350.     (void)sv_bless(TOPs, stash);
  351.     RETURN;
  352. }
  353.  
  354. /* Pattern matching */
  355.  
  356. PP(pp_study)
  357. {
  358.     dSP; dTARGET;
  359.     register unsigned char *s;
  360.     register I32 pos;
  361.     register I32 ch;
  362.     register I32 *sfirst;
  363.     register I32 *snext;
  364.     I32 retval;
  365.     STRLEN len;
  366.  
  367.     s = (unsigned char*)(SvPV(TARG, len));
  368.     pos = len;
  369.     if (lastscream)
  370.     SvSCREAM_off(lastscream);
  371.     lastscream = TARG;
  372.     if (pos <= 0) {
  373.     retval = 0;
  374.     goto ret;
  375.     }
  376.     if (pos > maxscream) {
  377.     if (maxscream < 0) {
  378.         maxscream = pos + 80;
  379.         New(301, screamfirst, 256, I32);
  380.         New(302, screamnext, maxscream, I32);
  381.     }
  382.     else {
  383.         maxscream = pos + pos / 4;
  384.         Renew(screamnext, maxscream, I32);
  385.     }
  386.     }
  387.  
  388.     sfirst = screamfirst;
  389.     snext = screamnext;
  390.  
  391.     if (!sfirst || !snext)
  392.     DIE("do_study: out of memory");
  393.  
  394.     for (ch = 256; ch; --ch)
  395.     *sfirst++ = -1;
  396.     sfirst -= 256;
  397.  
  398.     while (--pos >= 0) {
  399.     ch = s[pos];
  400.     if (sfirst[ch] >= 0)
  401.         snext[pos] = sfirst[ch] - pos;
  402.     else
  403.         snext[pos] = -pos;
  404.     sfirst[ch] = pos;
  405.  
  406.     /* If there were any case insensitive searches, we must assume they
  407.      * all are.  This speeds up insensitive searches much more than
  408.      * it slows down sensitive ones.
  409.      */
  410.     if (sawi)
  411.         sfirst[fold[ch]] = pos;
  412.     }
  413.  
  414.     SvSCREAM_on(TARG);
  415.     retval = 1;
  416.   ret:
  417.     XPUSHs(sv_2mortal(newSViv((I32)retval)));
  418.     RETURN;
  419. }
  420.  
  421. PP(pp_trans)
  422. {
  423.     dSP; dTARG;
  424.     SV *sv;
  425.  
  426.     if (op->op_flags & OPf_STACKED)
  427.     sv = POPs;
  428.     else {
  429.     sv = GvSV(defgv);
  430.     EXTEND(SP,1);
  431.     }
  432.     TARG = sv_newmortal();
  433.     PUSHi(do_trans(sv, op));
  434.     RETURN;
  435. }
  436.  
  437. /* Lvalue operators. */
  438.  
  439. PP(pp_schop)
  440. {
  441.     dSP; dTARGET;
  442.     do_chop(TARG, TOPs);
  443.     SETTARG;
  444.     RETURN;
  445. }
  446.  
  447. PP(pp_chop)
  448. {
  449.     dSP; dMARK; dTARGET;
  450.     while (SP > MARK)
  451.     do_chop(TARG, POPs);
  452.     PUSHTARG;
  453.     RETURN;
  454. }
  455.  
  456. PP(pp_schomp)
  457. {
  458.     dSP; dTARGET;
  459.     SETi(do_chomp(TOPs));
  460.     RETURN;
  461. }
  462.  
  463. PP(pp_chomp)
  464. {
  465.     dSP; dMARK; dTARGET;
  466.     register I32 count = 0;
  467.     
  468.     while (SP > MARK)
  469.     count += do_chomp(POPs);
  470.     PUSHi(count);
  471.     RETURN;
  472. }
  473.  
  474. PP(pp_defined)
  475. {
  476.     dSP;
  477.     register SV* sv;
  478.  
  479.     sv = POPs;
  480.     if (!sv || !SvANY(sv))
  481.     RETPUSHNO;
  482.     switch (SvTYPE(sv)) {
  483.     case SVt_PVAV:
  484.     if (AvMAX(sv) >= 0)
  485.         RETPUSHYES;
  486.     break;
  487.     case SVt_PVHV:
  488.     if (HvARRAY(sv))
  489.         RETPUSHYES;
  490.     break;
  491.     case SVt_PVCV:
  492.     if (CvROOT(sv) || CvXSUB(sv))
  493.         RETPUSHYES;
  494.     break;
  495.     default:
  496.     if (SvGMAGICAL(sv))
  497.         mg_get(sv);
  498.     if (SvOK(sv))
  499.         RETPUSHYES;
  500.     }
  501.     RETPUSHNO;
  502. }
  503.  
  504. PP(pp_undef)
  505. {
  506.     dSP;
  507.     SV *sv;
  508.  
  509.     if (!op->op_private)
  510.     RETPUSHUNDEF;
  511.  
  512.     sv = POPs;
  513.     if (!sv)
  514.     RETPUSHUNDEF;
  515.  
  516.     if (SvTHINKFIRST(sv)) {
  517.     if (SvREADONLY(sv))
  518.         RETPUSHUNDEF;
  519.     if (SvROK(sv))
  520.         sv_unref(sv);
  521.     }
  522.  
  523.     switch (SvTYPE(sv)) {
  524.     case SVt_NULL:
  525.     break;
  526.     case SVt_PVAV:
  527.     av_undef((AV*)sv);
  528.     break;
  529.     case SVt_PVHV:
  530.     hv_undef((HV*)sv);
  531.     break;
  532.     case SVt_PVCV:
  533.     cv_undef((CV*)sv);
  534.     sub_generation++;
  535.     break;
  536.     default:
  537.     if (sv != GvSV(defgv)) {
  538.         if (SvPOK(sv) && SvLEN(sv)) {
  539.         (void)SvOOK_off(sv);
  540.         Safefree(SvPVX(sv));
  541.         SvPV_set(sv, Nullch);
  542.         SvLEN_set(sv, 0);
  543.         }
  544.         (void)SvOK_off(sv);
  545.         SvSETMAGIC(sv);
  546.     }
  547.     }
  548.  
  549.     RETPUSHUNDEF;
  550. }
  551.  
  552. PP(pp_predec)
  553. {
  554.     dSP;
  555.     if (SvIOK(TOPs)) {
  556.     --SvIVX(TOPs);
  557.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  558.     }
  559.     else
  560.     sv_dec(TOPs);
  561.     SvSETMAGIC(TOPs);
  562.     return NORMAL;
  563. }
  564.  
  565. PP(pp_postinc)
  566. {
  567.     dSP; dTARGET;
  568.     sv_setsv(TARG, TOPs);
  569.     if (SvIOK(TOPs)) {
  570.     ++SvIVX(TOPs);
  571.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  572.     }
  573.     else
  574.     sv_inc(TOPs);
  575.     SvSETMAGIC(TOPs);
  576.     if (!SvOK(TARG))
  577.     sv_setiv(TARG, 0);
  578.     SETs(TARG);
  579.     return NORMAL;
  580. }
  581.  
  582. PP(pp_postdec)
  583. {
  584.     dSP; dTARGET;
  585.     sv_setsv(TARG, TOPs);
  586.     if (SvIOK(TOPs)) {
  587.     --SvIVX(TOPs);
  588.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  589.     }
  590.     else
  591.     sv_dec(TOPs);
  592.     SvSETMAGIC(TOPs);
  593.     SETs(TARG);
  594.     return NORMAL;
  595. }
  596.  
  597. /* Ordinary operators. */
  598.  
  599. PP(pp_pow)
  600. {
  601.     dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); 
  602.     {
  603.       dPOPTOPnnrl;
  604.       SETn( pow( left, right) );
  605.       RETURN;
  606.     }
  607. }
  608.  
  609. PP(pp_multiply)
  610. {
  611.     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
  612.     {
  613.       dPOPTOPnnrl;
  614.       SETn( left * right );
  615.       RETURN;
  616.     }
  617. }
  618.  
  619. PP(pp_divide)
  620. {
  621.     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
  622.     {
  623.       dPOPnv;
  624.       if (value == 0.0)
  625.     DIE("Illegal division by zero");
  626. #ifdef SLOPPYDIVIDE
  627.       /* insure that 20./5. == 4. */
  628.       {
  629.     double x;
  630.     I32    k;
  631.     x =  POPn;
  632.     if ((double)I_32(x)     == x &&
  633.         (double)I_32(value) == value &&
  634.         (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
  635.         value = k;
  636.     } else {
  637.         value = x/value;
  638.     }
  639.       }
  640. #else
  641.       value = POPn / value;
  642. #endif
  643.       PUSHn( value );
  644.       RETURN;
  645.     }
  646. }
  647.  
  648. PP(pp_modulo)
  649. {
  650.     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
  651.     {
  652.       register unsigned long tmpulong;
  653.       register long tmplong;
  654.       I32 value;
  655.  
  656.       tmpulong = (unsigned long) POPn;
  657.       if (tmpulong == 0L)
  658.     DIE("Illegal modulus zero");
  659.       value = TOPn;
  660.       if (value >= 0.0)
  661.     value = (I32)(((unsigned long)value) % tmpulong);
  662.       else {
  663.     tmplong = (long)value;
  664.     value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
  665.       }
  666.       SETi(value);
  667.       RETURN;
  668.     }
  669. }
  670.  
  671. PP(pp_repeat)
  672. {
  673.   dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
  674.   {
  675.     register I32 count = POPi;
  676.     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
  677.     dMARK;
  678.     I32 items = SP - MARK;
  679.     I32 max;
  680.  
  681.     max = items * count;
  682.     MEXTEND(MARK, max);
  683.     if (count > 1) {
  684.         while (SP > MARK) {
  685.         if (*SP)
  686.             SvTEMP_off((*SP));
  687.         SP--;
  688.         }
  689.         MARK++;
  690.         repeatcpy((char*)(MARK + items), (char*)MARK,
  691.         items * sizeof(SV*), count - 1);
  692.         SP += max;
  693.     }
  694.     else if (count <= 0)
  695.         SP -= items;
  696.     }
  697.     else {    /* Note: mark already snarfed by pp_list */
  698.     SV *tmpstr;
  699.     STRLEN len;
  700.  
  701.     tmpstr = POPs;
  702.     if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
  703.         if (SvREADONLY(tmpstr) && curcop != &compiling)
  704.         DIE("Can't x= to readonly value");
  705.         if (SvROK(tmpstr))
  706.         sv_unref(tmpstr);
  707.     }
  708.     SvSetSV(TARG, tmpstr);
  709.     SvPV_force(TARG, len);
  710.     if (count >= 1) {
  711.         SvGROW(TARG, (count * len) + 1);
  712.         if (count > 1)
  713.         repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
  714.         SvCUR(TARG) *= count;
  715.         *SvEND(TARG) = '\0';
  716.         (void)SvPOK_only(TARG);
  717.     }
  718.     else
  719.         sv_setsv(TARG, &sv_no);
  720.     PUSHTARG;
  721.     }
  722.     RETURN;
  723.   }
  724. }
  725.  
  726. PP(pp_subtract)
  727. {
  728.     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
  729.     {
  730.       dPOPTOPnnrl;
  731.       SETn( left - right );
  732.       RETURN;
  733.     }
  734. }
  735.  
  736. PP(pp_left_shift)
  737. {
  738.     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); 
  739.     {
  740.         dPOPTOPiirl;
  741.         SETi( left << right );
  742.         RETURN;
  743.     }
  744. }
  745.  
  746. PP(pp_right_shift)
  747. {
  748.     dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); 
  749.     {
  750.       dPOPTOPiirl;
  751.       SETi( left >> right );
  752.       RETURN;
  753.     }
  754. }
  755.  
  756. PP(pp_lt)
  757. {
  758.     dSP; tryAMAGICbinSET(lt,0); 
  759.     {
  760.       dPOPnv;
  761.       SETs((TOPn < value) ? &sv_yes : &sv_no);
  762.       RETURN;
  763.     }
  764. }
  765.  
  766. PP(pp_gt)
  767. {
  768.     dSP; tryAMAGICbinSET(gt,0); 
  769.     {
  770.       dPOPnv;
  771.       SETs((TOPn > value) ? &sv_yes : &sv_no);
  772.       RETURN;
  773.     }
  774. }
  775.  
  776. PP(pp_le)
  777. {
  778.     dSP; tryAMAGICbinSET(le,0); 
  779.     {
  780.       dPOPnv;
  781.       SETs((TOPn <= value) ? &sv_yes : &sv_no);
  782.       RETURN;
  783.     }
  784. }
  785.  
  786. PP(pp_ge)
  787. {
  788.     dSP; tryAMAGICbinSET(ge,0); 
  789.     {
  790.       dPOPnv;
  791.       SETs((TOPn >= value) ? &sv_yes : &sv_no);
  792.       RETURN;
  793.     }
  794. }
  795.  
  796. PP(pp_ne)
  797. {
  798.     dSP; tryAMAGICbinSET(ne,0); 
  799.     {
  800.       dPOPnv;
  801.       SETs((TOPn != value) ? &sv_yes : &sv_no);
  802.       RETURN;
  803.     }
  804. }
  805.  
  806. PP(pp_ncmp)
  807. {
  808.     dSP; dTARGET; tryAMAGICbin(ncmp,0); 
  809.     {
  810.       dPOPTOPnnrl;
  811.       I32 value;
  812.  
  813.       if (left > right)
  814.     value = 1;
  815.       else if (left < right)
  816.     value = -1;
  817.       else
  818.     value = 0;
  819.       SETi(value);
  820.       RETURN;
  821.     }
  822. }
  823.  
  824. PP(pp_slt)
  825. {
  826.     dSP; tryAMAGICbinSET(slt,0); 
  827.     {
  828.       dPOPTOPssrl;
  829.       SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no );
  830.       RETURN;
  831.     }
  832. }
  833.  
  834. PP(pp_sgt)
  835. {
  836.     dSP; tryAMAGICbinSET(sgt,0); 
  837.     {
  838.       dPOPTOPssrl;
  839.       SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no );
  840.       RETURN;
  841.     }
  842. }
  843.  
  844. PP(pp_sle)
  845. {
  846.     dSP; tryAMAGICbinSET(sle,0); 
  847.     {
  848.       dPOPTOPssrl;
  849.       SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no );
  850.       RETURN;
  851.     }
  852. }
  853.  
  854. PP(pp_sge)
  855. {
  856.     dSP; tryAMAGICbinSET(sge,0); 
  857.     {
  858.       dPOPTOPssrl;
  859.       SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no );
  860.       RETURN;
  861.     }
  862. }
  863.  
  864. PP(pp_sne)
  865. {
  866.     dSP; tryAMAGICbinSET(sne,0); 
  867.     {
  868.       dPOPTOPssrl;
  869.       SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
  870.       RETURN;
  871.     }
  872. }
  873.  
  874. PP(pp_scmp)
  875. {
  876.     dSP; dTARGET;  tryAMAGICbin(scmp,0);
  877.     {
  878.       dPOPTOPssrl;
  879.       SETi( sv_cmp(left, right) );
  880.       RETURN;
  881.     }
  882. }
  883.  
  884. PP(pp_bit_and) {
  885.     dSP; dATARGET; tryAMAGICbin(band,opASSIGN); 
  886.     {
  887.       dPOPTOPssrl;
  888.       if (SvNIOK(left) || SvNIOK(right)) {
  889.     unsigned long value = U_L(SvNV(left));
  890.     value = value & U_L(SvNV(right));
  891.     SETn((double)value);
  892.       }
  893.       else {
  894.     do_vop(op->op_type, TARG, left, right);
  895.     SETTARG;
  896.       }
  897.       RETURN;
  898.     }
  899. }
  900.  
  901. PP(pp_bit_xor)
  902. {
  903.     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); 
  904.     {
  905.       dPOPTOPssrl;
  906.       if (SvNIOK(left) || SvNIOK(right)) {
  907.     unsigned long value = U_L(SvNV(left));
  908.     value = value ^ U_L(SvNV(right));
  909.     SETn((double)value);
  910.       }
  911.       else {
  912.     do_vop(op->op_type, TARG, left, right);
  913.     SETTARG;
  914.       }
  915.       RETURN;
  916.     }
  917. }
  918.  
  919. PP(pp_bit_or)
  920. {
  921.     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); 
  922.     {
  923.       dPOPTOPssrl;
  924.       if (SvNIOK(left) || SvNIOK(right)) {
  925.     unsigned long value = U_L(SvNV(left));
  926.     value = value | U_L(SvNV(right));
  927.     SETn((double)value);
  928.       }
  929.       else {
  930.     do_vop(op->op_type, TARG, left, right);
  931.     SETTARG;
  932.       }
  933.       RETURN;
  934.     }
  935. }
  936.  
  937. PP(pp_negate)
  938. {
  939.     dSP; dTARGET; tryAMAGICun(neg);
  940.     {
  941.     dTOPss;
  942.     if (SvNIOK(sv))
  943.         SETn(-SvNV(sv));
  944.     else if (SvPOK(sv)) {
  945.         STRLEN len;
  946.         char *s = SvPV(sv, len);
  947.         if (isALPHA(*s) || *s == '_') {
  948.         sv_setpvn(TARG, "-", 1);
  949.         sv_catsv(TARG, sv);
  950.         }
  951.         else if (*s == '+' || *s == '-') {
  952.         sv_setsv(TARG, sv);
  953.         *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
  954.         }
  955.         else
  956.         sv_setnv(TARG, -SvNV(sv));
  957.         SETTARG;
  958.     }
  959.     }
  960.     RETURN;
  961. }
  962.  
  963. PP(pp_not)
  964. {
  965. #ifdef OVERLOAD
  966.     dSP; tryAMAGICunSET(not);
  967. #endif /* OVERLOAD */
  968.     *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
  969.     return NORMAL;
  970. }
  971.  
  972. PP(pp_complement)
  973. {
  974.     dSP; dTARGET; tryAMAGICun(compl); 
  975.     {
  976.       dTOPss;
  977.       register I32 anum;
  978.  
  979.       if (SvNIOK(sv)) {
  980.     IV iv = ~SvIV(sv);
  981.     if (iv < 0)
  982.         SETn( (double) ~U_L(SvNV(sv)) );
  983.     else
  984.         SETi( iv );
  985.       }
  986.       else {
  987.     register char *tmps;
  988.     register long *tmpl;
  989.     STRLEN len;
  990.  
  991.     SvSetSV(TARG, sv);
  992.     tmps = SvPV_force(TARG, len);
  993.     anum = len;
  994. #ifdef LIBERAL
  995.     for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
  996.         *tmps = ~*tmps;
  997.     tmpl = (long*)tmps;
  998.     for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
  999.         *tmpl = ~*tmpl;
  1000.     tmps = (char*)tmpl;
  1001. #endif
  1002.     for ( ; anum > 0; anum--, tmps++)
  1003.         *tmps = ~*tmps;
  1004.  
  1005.     SETs(TARG);
  1006.       }
  1007.       RETURN;
  1008.     }
  1009. }
  1010.  
  1011. /* integer versions of some of the above */
  1012.  
  1013. PP(pp_i_multiply)
  1014. {
  1015.     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
  1016.     {
  1017.       dPOPTOPiirl;
  1018.       SETi( left * right );
  1019.       RETURN;
  1020.     }
  1021. }
  1022.  
  1023. PP(pp_i_divide)
  1024. {
  1025.     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
  1026.     {
  1027.       dPOPiv;
  1028.       if (value == 0)
  1029.     DIE("Illegal division by zero");
  1030.       value = POPi / value;
  1031.       PUSHi( value );
  1032.       RETURN;
  1033.     }
  1034. }
  1035.  
  1036. PP(pp_i_modulo)
  1037. {
  1038.     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); 
  1039.     {
  1040.       dPOPTOPiirl;
  1041.       SETi( left % right );
  1042.       RETURN;
  1043.     }
  1044. }
  1045.  
  1046. PP(pp_i_add)
  1047. {
  1048.     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
  1049.     {
  1050.       dPOPTOPiirl;
  1051.       SETi( left + right );
  1052.       RETURN;
  1053.     }
  1054. }
  1055.  
  1056. PP(pp_i_subtract)
  1057. {
  1058.     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
  1059.     {
  1060.       dPOPTOPiirl;
  1061.       SETi( left - right );
  1062.       RETURN;
  1063.     }
  1064. }
  1065.  
  1066. PP(pp_i_lt)
  1067. {
  1068.     dSP; tryAMAGICbinSET(lt,0); 
  1069.     {
  1070.       dPOPTOPiirl;
  1071.       SETs((left < right) ? &sv_yes : &sv_no);
  1072.       RETURN;
  1073.     }
  1074. }
  1075.  
  1076. PP(pp_i_gt)
  1077. {
  1078.     dSP; tryAMAGICbinSET(gt,0); 
  1079.     {
  1080.       dPOPTOPiirl;
  1081.       SETs((left > right) ? &sv_yes : &sv_no);
  1082.       RETURN;
  1083.     }
  1084. }
  1085.  
  1086. PP(pp_i_le)
  1087. {
  1088.     dSP; tryAMAGICbinSET(le,0); 
  1089.     {
  1090.       dPOPTOPiirl;
  1091.       SETs((left <= right) ? &sv_yes : &sv_no);
  1092.       RETURN;
  1093.     }
  1094. }
  1095.  
  1096. PP(pp_i_ge)
  1097. {
  1098.     dSP; tryAMAGICbinSET(ge,0); 
  1099.     {
  1100.       dPOPTOPiirl;
  1101.       SETs((left >= right) ? &sv_yes : &sv_no);
  1102.       RETURN;
  1103.     }
  1104. }
  1105.  
  1106. PP(pp_i_eq)
  1107. {
  1108.     dSP; tryAMAGICbinSET(eq,0); 
  1109.     {
  1110.       dPOPTOPiirl;
  1111.       SETs((left == right) ? &sv_yes : &sv_no);
  1112.       RETURN;
  1113.     }
  1114. }
  1115.  
  1116. PP(pp_i_ne)
  1117. {
  1118.     dSP; tryAMAGICbinSET(ne,0); 
  1119.     {
  1120.       dPOPTOPiirl;
  1121.       SETs((left != right) ? &sv_yes : &sv_no);
  1122.       RETURN;
  1123.     }
  1124. }
  1125.  
  1126. PP(pp_i_ncmp)
  1127. {
  1128.     dSP; dTARGET; tryAMAGICbin(ncmp,0); 
  1129.     {
  1130.       dPOPTOPiirl;
  1131.       I32 value;
  1132.  
  1133.       if (left > right)
  1134.     value = 1;
  1135.       else if (left < right)
  1136.     value = -1;
  1137.       else
  1138.     value = 0;
  1139.       SETi(value);
  1140.       RETURN;
  1141.     }
  1142. }
  1143.  
  1144. PP(pp_i_negate)
  1145. {
  1146.     dSP; dTARGET; tryAMAGICun(neg);
  1147.     SETi(-TOPi);
  1148.     RETURN;
  1149. }
  1150.  
  1151. /* High falutin' math. */
  1152.  
  1153. PP(pp_atan2)
  1154. {
  1155.     dSP; dTARGET; tryAMAGICbin(atan2,0); 
  1156.     {
  1157.       dPOPTOPnnrl;
  1158.       SETn(atan2(left, right));
  1159.       RETURN;
  1160.     }
  1161. }
  1162.  
  1163. PP(pp_sin)
  1164. {
  1165.     dSP; dTARGET; tryAMAGICun(sin);
  1166.     {
  1167.       double value;
  1168.       value = POPn;
  1169.       value = sin(value);
  1170.       XPUSHn(value);
  1171.       RETURN;
  1172.     }
  1173. }
  1174.  
  1175. PP(pp_cos)
  1176. {
  1177.     dSP; dTARGET; tryAMAGICun(cos);
  1178.     {
  1179.       double value;
  1180.       value = POPn;
  1181.       value = cos(value);
  1182.       XPUSHn(value);
  1183.       RETURN;
  1184.     }
  1185. }
  1186.  
  1187. PP(pp_rand)
  1188. {
  1189.     dSP; dTARGET;
  1190.     double value;
  1191.     if (MAXARG < 1)
  1192.     value = 1.0;
  1193.     else
  1194.     value = POPn;
  1195.     if (value == 0.0)
  1196.     value = 1.0;
  1197. #if RANDBITS == 31
  1198.     value = rand() * value / 2147483648.0;
  1199. #else
  1200. #if RANDBITS == 16
  1201.     value = rand() * value / 65536.0;
  1202. #else
  1203. #if RANDBITS == 15
  1204.     value = rand() * value / 32768.0;
  1205. #else
  1206.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1207. #endif
  1208. #endif
  1209. #endif
  1210.     XPUSHn(value);
  1211.     RETURN;
  1212. }
  1213.  
  1214. PP(pp_srand)
  1215. {
  1216.     dSP;
  1217.     I32 anum;
  1218.     Time_t when;
  1219.  
  1220.     if (MAXARG < 1) {
  1221.     (void)time(&when);
  1222.     anum = when;
  1223.     }
  1224.     else
  1225.     anum = POPi;
  1226.     (void)srand(anum);
  1227.     EXTEND(SP, 1);
  1228.     RETPUSHYES;
  1229. }
  1230.  
  1231. PP(pp_exp)
  1232. {
  1233.     dSP; dTARGET; tryAMAGICun(exp);
  1234.     {
  1235.       double value;
  1236.       value = POPn;
  1237.       value = exp(value);
  1238.       XPUSHn(value);
  1239.       RETURN;
  1240.     }
  1241. }
  1242.  
  1243. PP(pp_log)
  1244. {
  1245.     dSP; dTARGET; tryAMAGICun(log);
  1246.     {
  1247.       double value;
  1248.       value = POPn;
  1249.       if (value <= 0.0)
  1250.     DIE("Can't take log of %g", value);
  1251.       value = log(value);
  1252.       XPUSHn(value);
  1253.       RETURN;
  1254.     }
  1255. }
  1256.  
  1257. PP(pp_sqrt)
  1258. {
  1259.     dSP; dTARGET; tryAMAGICun(sqrt);
  1260.     {
  1261.       double value;
  1262.       value = POPn;
  1263.       if (value < 0.0)
  1264.     DIE("Can't take sqrt of %g", value);
  1265.       value = sqrt(value);
  1266.       XPUSHn(value);
  1267.       RETURN;
  1268.     }
  1269. }
  1270.  
  1271. PP(pp_int)
  1272. {
  1273.     dSP; dTARGET;
  1274.     double value;
  1275.     value = POPn;
  1276.     if (value >= 0.0)
  1277.     (void)modf(value, &value);
  1278.     else {
  1279.     (void)modf(-value, &value);
  1280.     value = -value;
  1281.     }
  1282.     XPUSHn(value);
  1283.     RETURN;
  1284. }
  1285.  
  1286. PP(pp_abs)
  1287. {
  1288.     dSP; dTARGET; tryAMAGICun(abs);
  1289.     {
  1290.       double value;
  1291.       value = POPn;
  1292.  
  1293.       if (value < 0.0)
  1294.     value = -value;
  1295.  
  1296.       XPUSHn(value);
  1297.       RETURN;
  1298.     }
  1299. }
  1300.  
  1301. PP(pp_hex)
  1302. {
  1303.     dSP; dTARGET;
  1304.     char *tmps;
  1305.     I32 argtype;
  1306.  
  1307.     tmps = POPp;
  1308.     XPUSHi( scan_hex(tmps, 99, &argtype) );
  1309.     RETURN;
  1310. }
  1311.  
  1312. PP(pp_oct)
  1313. {
  1314.     dSP; dTARGET;
  1315.     I32 value;
  1316.     I32 argtype;
  1317.     char *tmps;
  1318.  
  1319.     tmps = POPp;
  1320.     while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
  1321.     tmps++;
  1322.     if (*tmps == 'x')
  1323.     value = (I32)scan_hex(++tmps, 99, &argtype);
  1324.     else
  1325.     value = (I32)scan_oct(tmps, 99, &argtype);
  1326.     XPUSHi(value);
  1327.     RETURN;
  1328. }
  1329.  
  1330. /* String stuff. */
  1331.  
  1332. PP(pp_length)
  1333. {
  1334.     dSP; dTARGET;
  1335.     SETi( sv_len(TOPs) );
  1336.     RETURN;
  1337. }
  1338.  
  1339. PP(pp_substr)
  1340. {
  1341.     dSP; dTARGET;
  1342.     SV *sv;
  1343.     I32 len;
  1344.     STRLEN curlen;
  1345.     I32 pos;
  1346.     I32 rem;
  1347.     I32 lvalue = op->op_flags & OPf_MOD;
  1348.     char *tmps;
  1349.     I32 arybase = curcop->cop_arybase;
  1350.  
  1351.     if (MAXARG > 2)
  1352.     len = POPi;
  1353.     pos = POPi - arybase;
  1354.     sv = POPs;
  1355.     tmps = SvPV(sv, curlen);
  1356.     if (pos < 0)
  1357.     pos += curlen + arybase;
  1358.     if (pos < 0 || pos > curlen) {
  1359.     if (dowarn || lvalue)
  1360.         warn("substr outside of string");
  1361.     RETPUSHUNDEF;
  1362.     }
  1363.     else {
  1364.     if (MAXARG < 3)
  1365.         len = curlen;
  1366.     else if (len < 0) {
  1367.         len += curlen - pos;
  1368.         if (len < 0)
  1369.         len = 0;
  1370.     }
  1371.     tmps += pos;
  1372.     rem = curlen - pos;    /* rem=how many bytes left*/
  1373.     if (rem > len)
  1374.         rem = len;
  1375.     sv_setpvn(TARG, tmps, rem);
  1376.     if (lvalue) {            /* it's an lvalue! */
  1377.         (void)SvPOK_only(sv);
  1378.         if (SvTYPE(TARG) < SVt_PVLV) {
  1379.         sv_upgrade(TARG, SVt_PVLV);
  1380.         sv_magic(TARG, Nullsv, 'x', Nullch, 0);
  1381.         }
  1382.  
  1383.         LvTYPE(TARG) = 's';
  1384.         LvTARG(TARG) = sv;
  1385.         LvTARGOFF(TARG) = pos;
  1386.         LvTARGLEN(TARG) = rem; 
  1387.     }
  1388.     }
  1389.     PUSHs(TARG);        /* avoid SvSETMAGIC here */
  1390.     RETURN;
  1391. }
  1392.  
  1393. PP(pp_vec)
  1394. {
  1395.     dSP; dTARGET;
  1396.     register I32 size = POPi;
  1397.     register I32 offset = POPi;
  1398.     register SV *src = POPs;
  1399.     I32 lvalue = op->op_flags & OPf_MOD;
  1400.     STRLEN srclen;
  1401.     unsigned char *s = (unsigned char*)SvPV(src, srclen);
  1402.     unsigned long retnum;
  1403.     I32 len;
  1404.  
  1405.     offset *= size;        /* turn into bit offset */
  1406.     len = (offset + size + 7) / 8;
  1407.     if (offset < 0 || size < 1)
  1408.     retnum = 0;
  1409.     else {
  1410.     if (lvalue) {                      /* it's an lvalue! */
  1411.         if (SvTYPE(TARG) < SVt_PVLV) {
  1412.         sv_upgrade(TARG, SVt_PVLV);
  1413.         sv_magic(TARG, Nullsv, 'v', Nullch, 0);
  1414.         }
  1415.  
  1416.         LvTYPE(TARG) = 'v';
  1417.         LvTARG(TARG) = src;
  1418.         LvTARGOFF(TARG) = offset; 
  1419.         LvTARGLEN(TARG) = size; 
  1420.     }
  1421.     if (len > srclen) {
  1422.         if (size <= 8)
  1423.         retnum = 0;
  1424.         else {
  1425.         offset >>= 3;
  1426.         if (size == 16) {
  1427.             if (offset >= srclen)
  1428.             retnum = 0;
  1429.             else
  1430.             retnum = (unsigned long) s[offset] << 8;
  1431.         }
  1432.         else if (size == 32) {
  1433.             if (offset >= srclen)
  1434.             retnum = 0;
  1435.             else if (offset + 1 >= srclen)
  1436.             retnum = (unsigned long) s[offset] << 24;
  1437.             else if (offset + 2 >= srclen)
  1438.             retnum = ((unsigned long) s[offset] << 24) +
  1439.                 ((unsigned long) s[offset + 1] << 16);
  1440.             else
  1441.             retnum = ((unsigned long) s[offset] << 24) +
  1442.                 ((unsigned long) s[offset + 1] << 16) +
  1443.                 (s[offset + 2] << 8);
  1444.         }
  1445.         }
  1446.     }
  1447.     else if (size < 8)
  1448.         retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
  1449.     else {
  1450.         offset >>= 3;
  1451.         if (size == 8)
  1452.         retnum = s[offset];
  1453.         else if (size == 16)
  1454.         retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
  1455.         else if (size == 32)
  1456.         retnum = ((unsigned long) s[offset] << 24) +
  1457.             ((unsigned long) s[offset + 1] << 16) +
  1458.             (s[offset + 2] << 8) + s[offset+3];
  1459.     }
  1460.     }
  1461.  
  1462.     sv_setiv(TARG, (I32)retnum);
  1463.     PUSHs(TARG);
  1464.     RETURN;
  1465. }
  1466.  
  1467. PP(pp_index)
  1468. {
  1469.     dSP; dTARGET;
  1470.     SV *big;
  1471.     SV *little;
  1472.     I32 offset;
  1473.     I32 retval;
  1474.     char *tmps;
  1475.     char *tmps2;
  1476.     STRLEN biglen;
  1477.     I32 arybase = curcop->cop_arybase;
  1478.  
  1479.     if (MAXARG < 3)
  1480.     offset = 0;
  1481.     else
  1482.     offset = POPi - arybase;
  1483.     little = POPs;
  1484.     big = POPs;
  1485.     tmps = SvPV(big, biglen);
  1486.     if (offset < 0)
  1487.     offset = 0;
  1488.     else if (offset > biglen)
  1489.     offset = biglen;
  1490.     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
  1491.       (unsigned char*)tmps + biglen, little)))
  1492.     retval = -1 + arybase;
  1493.     else
  1494.     retval = tmps2 - tmps + arybase;
  1495.     PUSHi(retval);
  1496.     RETURN;
  1497. }
  1498.  
  1499. PP(pp_rindex)
  1500. {
  1501.     dSP; dTARGET;
  1502.     SV *big;
  1503.     SV *little;
  1504.     STRLEN blen;
  1505.     STRLEN llen;
  1506.     SV *offstr;
  1507.     I32 offset;
  1508.     I32 retval;
  1509.     char *tmps;
  1510.     char *tmps2;
  1511.     I32 arybase = curcop->cop_arybase;
  1512.  
  1513.     if (MAXARG >= 3)
  1514.     offstr = POPs;
  1515.     little = POPs;
  1516.     big = POPs;
  1517.     tmps2 = SvPV(little, llen);
  1518.     tmps = SvPV(big, blen);
  1519.     if (MAXARG < 3)
  1520.     offset = blen;
  1521.     else
  1522.     offset = SvIV(offstr) - arybase + llen;
  1523.     if (offset < 0)
  1524.     offset = 0;
  1525.     else if (offset > blen)
  1526.     offset = blen;
  1527.     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
  1528.               tmps2, tmps2 + llen)))
  1529.     retval = -1 + arybase;
  1530.     else
  1531.     retval = tmps2 - tmps + arybase;
  1532.     PUSHi(retval);
  1533.     RETURN;
  1534. }
  1535.  
  1536. PP(pp_sprintf)
  1537. {
  1538.     dSP; dMARK; dORIGMARK; dTARGET;
  1539.     do_sprintf(TARG, SP-MARK, MARK+1);
  1540.     SP = ORIGMARK;
  1541.     PUSHTARG;
  1542.     RETURN;
  1543. }
  1544.  
  1545. PP(pp_ord)
  1546. {
  1547.     dSP; dTARGET;
  1548.     I32 value;
  1549.     char *tmps;
  1550.  
  1551. #ifndef I286
  1552.     tmps = POPp;
  1553.     value = (I32) (*tmps & 255);
  1554. #else
  1555.     I32 anum;
  1556.     tmps = POPp;
  1557.     anum = (I32) *tmps;
  1558.     value = (I32) (anum & 255);
  1559. #endif
  1560.     XPUSHi(value);
  1561.     RETURN;
  1562. }
  1563.  
  1564. PP(pp_chr)
  1565. {
  1566.     dSP; dTARGET;
  1567.     char *tmps;
  1568.  
  1569.     (void)SvUPGRADE(TARG,SVt_PV);
  1570.     SvGROW(TARG,2);
  1571.     SvCUR_set(TARG, 1);
  1572.     tmps = SvPVX(TARG);
  1573.     *tmps++ = POPi;
  1574.     *tmps = '\0';
  1575.     (void)SvPOK_only(TARG);
  1576.     XPUSHs(TARG);
  1577.     RETURN;
  1578. }
  1579.  
  1580. PP(pp_crypt)
  1581. {
  1582.     dSP; dTARGET; dPOPTOPssrl;
  1583. #ifdef HAS_CRYPT
  1584.     char *tmps = SvPV(left, na);
  1585. #ifdef FCRYPT
  1586.     sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
  1587. #else
  1588.     sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
  1589. #endif
  1590. #else
  1591.     DIE(
  1592.       "The crypt() function is unimplemented due to excessive paranoia.");
  1593. #endif
  1594.     SETs(TARG);
  1595.     RETURN;
  1596. }
  1597.  
  1598. PP(pp_ucfirst)
  1599. {
  1600.     dSP;
  1601.     SV *sv = TOPs;
  1602.     register char *s;
  1603.  
  1604.     if (!SvPADTMP(sv)) {
  1605.     dTARGET;
  1606.     sv_setsv(TARG, sv);
  1607.     sv = TARG;
  1608.     SETs(sv);
  1609.     }
  1610.     s = SvPV_force(sv, na);
  1611.     if (isLOWER(*s))
  1612.     *s = toUPPER(*s);
  1613.  
  1614.     RETURN;
  1615. }
  1616.  
  1617. PP(pp_lcfirst)
  1618. {
  1619.     dSP;
  1620.     SV *sv = TOPs;
  1621.     register char *s;
  1622.  
  1623.     if (!SvPADTMP(sv)) {
  1624.     dTARGET;
  1625.     sv_setsv(TARG, sv);
  1626.     sv = TARG;
  1627.     SETs(sv);
  1628.     }
  1629.     s = SvPV_force(sv, na);
  1630.     if (isUPPER(*s))
  1631.     *s = toLOWER(*s);
  1632.  
  1633.     SETs(sv);
  1634.     RETURN;
  1635. }
  1636.  
  1637. PP(pp_uc)
  1638. {
  1639.     dSP;
  1640.     SV *sv = TOPs;
  1641.     register char *s;
  1642.     register char *send;
  1643.     STRLEN len;
  1644.  
  1645.     if (!SvPADTMP(sv)) {
  1646.     dTARGET;
  1647.     sv_setsv(TARG, sv);
  1648.     sv = TARG;
  1649.     SETs(sv);
  1650.     }
  1651.     s = SvPV_force(sv, len);
  1652.     send = s + len;
  1653.     while (s < send) {
  1654.     if (isLOWER(*s))
  1655.         *s = toUPPER(*s);
  1656.     s++;
  1657.     }
  1658.     RETURN;
  1659. }
  1660.  
  1661. PP(pp_lc)
  1662. {
  1663.     dSP;
  1664.     SV *sv = TOPs;
  1665.     register char *s;
  1666.     register char *send;
  1667.     STRLEN len;
  1668.  
  1669.     if (!SvPADTMP(sv)) {
  1670.     dTARGET;
  1671.     sv_setsv(TARG, sv);
  1672.     sv = TARG;
  1673.     SETs(sv);
  1674.     }
  1675.     s = SvPV_force(sv, len);
  1676.     send = s + len;
  1677.     while (s < send) {
  1678.     if (isUPPER(*s))
  1679.         *s = toLOWER(*s);
  1680.     s++;
  1681.     }
  1682.     RETURN;
  1683. }
  1684.  
  1685. PP(pp_quotemeta)
  1686. {
  1687.     dSP; dTARGET;
  1688.     SV *sv = TOPs;
  1689.     STRLEN len;
  1690.     register char *s = SvPV(sv,len);
  1691.     register char *d;
  1692.  
  1693.     if (len) {
  1694.     (void)SvUPGRADE(TARG, SVt_PV);
  1695.     SvGROW(TARG, len * 2);
  1696.     d = SvPVX(TARG);
  1697.     while (len--) {
  1698.         if (!isALNUM(*s))
  1699.         *d++ = '\\';
  1700.         *d++ = *s++;
  1701.     }
  1702.     *d = '\0';
  1703.     SvCUR_set(TARG, d - SvPVX(TARG));
  1704.     (void)SvPOK_only(TARG);
  1705.     }
  1706.     else
  1707.     sv_setpvn(TARG, s, len);
  1708.     SETs(TARG);
  1709.     RETURN;
  1710. }
  1711.  
  1712. /* Arrays. */
  1713.  
  1714. PP(pp_aslice)
  1715. {
  1716.     dSP; dMARK; dORIGMARK;
  1717.     register SV** svp;
  1718.     register AV* av = (AV*)POPs;
  1719.     register I32 lval = op->op_flags & OPf_MOD;
  1720.     I32 arybase = curcop->cop_arybase;
  1721.     I32 elem;
  1722.  
  1723.     if (SvTYPE(av) == SVt_PVAV) {
  1724.     if (lval && op->op_private & OPpLVAL_INTRO) {
  1725.         I32 max = -1;
  1726.         for (svp = mark + 1; svp <= sp; svp++) {
  1727.         elem = SvIVx(*svp);
  1728.         if (elem > max)
  1729.             max = elem;
  1730.         }
  1731.         if (max > AvMAX(av))
  1732.         av_extend(av, max);
  1733.     }
  1734.     while (++MARK <= SP) {
  1735.         elem = SvIVx(*MARK);
  1736.  
  1737.         if (elem > 0)
  1738.         elem -= arybase;
  1739.         svp = av_fetch(av, elem, lval);
  1740.         if (lval) {
  1741.         if (!svp || *svp == &sv_undef)
  1742.             DIE(no_aelem, elem);
  1743.         if (op->op_private & OPpLVAL_INTRO)
  1744.             save_svref(svp);
  1745.         }
  1746.         *MARK = svp ? *svp : &sv_undef;
  1747.     }
  1748.     }
  1749.     if (GIMME != G_ARRAY) {
  1750.     MARK = ORIGMARK;
  1751.     *++MARK = *SP;
  1752.     SP = MARK;
  1753.     }
  1754.     RETURN;
  1755. }
  1756.  
  1757. /* Associative arrays. */
  1758.  
  1759. PP(pp_each)
  1760. {
  1761.     dSP; dTARGET;
  1762.     HV *hash = (HV*)POPs;
  1763.     HE *entry = hv_iternext(hash);
  1764.     I32 i;
  1765.     char *tmps;
  1766.  
  1767.     EXTEND(SP, 2);
  1768.     if (entry) {
  1769.     tmps = hv_iterkey(entry, &i);
  1770.     if (!i)
  1771.         tmps = "";
  1772.     PUSHs(sv_2mortal(newSVpv(tmps, i)));
  1773.     if (GIMME == G_ARRAY) {
  1774.         sv_setsv(TARG, hv_iterval(hash, entry));
  1775.         PUSHs(TARG);
  1776.     }
  1777.     }
  1778.     else if (GIMME == G_SCALAR)
  1779.     RETPUSHUNDEF;
  1780.  
  1781.     RETURN;
  1782. }
  1783.  
  1784. PP(pp_values)
  1785. {
  1786.     return do_kv(ARGS);
  1787. }
  1788.  
  1789. PP(pp_keys)
  1790. {
  1791.     return do_kv(ARGS);
  1792. }
  1793.  
  1794. PP(pp_delete)
  1795. {
  1796.     dSP;
  1797.     SV *sv;
  1798.     SV *tmpsv = POPs;
  1799.     HV *hv = (HV*)POPs;
  1800.     char *tmps;
  1801.     STRLEN len;
  1802.     if (SvTYPE(hv) != SVt_PVHV) {
  1803.     DIE("Not a HASH reference");
  1804.     }
  1805.     tmps = SvPV(tmpsv, len);
  1806.     sv = hv_delete(hv, tmps, len,
  1807.     op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
  1808.     if (!sv)
  1809.     RETPUSHUNDEF;
  1810.     PUSHs(sv);
  1811.     RETURN;
  1812. }
  1813.  
  1814. PP(pp_exists)
  1815. {
  1816.     dSP;
  1817.     SV *tmpsv = POPs;
  1818.     HV *hv = (HV*)POPs;
  1819.     char *tmps;
  1820.     STRLEN len;
  1821.     if (SvTYPE(hv) != SVt_PVHV) {
  1822.     DIE("Not a HASH reference");
  1823.     }
  1824.     tmps = SvPV(tmpsv, len);
  1825.     if (hv_exists(hv, tmps, len))
  1826.     RETPUSHYES;
  1827.     RETPUSHNO;
  1828. }
  1829.  
  1830. PP(pp_hslice)
  1831. {
  1832.     dSP; dMARK; dORIGMARK;
  1833.     register SV **svp;
  1834.     register HV *hv = (HV*)POPs;
  1835.     register I32 lval = op->op_flags & OPf_MOD;
  1836.  
  1837.     if (SvTYPE(hv) == SVt_PVHV) {
  1838.     while (++MARK <= SP) {
  1839.         STRLEN keylen;
  1840.         char *key = SvPV(*MARK, keylen);
  1841.  
  1842.         svp = hv_fetch(hv, key, keylen, lval);
  1843.         if (lval) {
  1844.         if (!svp || *svp == &sv_undef)
  1845.             DIE(no_helem, key);
  1846.         if (op->op_private & OPpLVAL_INTRO)
  1847.             save_svref(svp);
  1848.         }
  1849.         *MARK = svp ? *svp : &sv_undef;
  1850.     }
  1851.     }
  1852.     if (GIMME != G_ARRAY) {
  1853.     MARK = ORIGMARK;
  1854.     *++MARK = *SP;
  1855.     SP = MARK;
  1856.     }
  1857.     RETURN;
  1858. }
  1859.  
  1860. /* List operators. */
  1861.  
  1862. PP(pp_list)
  1863. {
  1864.     dSP; dMARK;
  1865.     if (GIMME != G_ARRAY) {
  1866.     if (++MARK <= SP)
  1867.         *MARK = *SP;        /* unwanted list, return last item */
  1868.     else
  1869.         *MARK = &sv_undef;
  1870.     SP = MARK;
  1871.     }
  1872.     RETURN;
  1873. }
  1874.  
  1875. PP(pp_lslice)
  1876. {
  1877.     dSP;
  1878.     SV **lastrelem = stack_sp;
  1879.     SV **lastlelem = stack_base + POPMARK;
  1880.     SV **firstlelem = stack_base + POPMARK + 1;
  1881.     register SV **firstrelem = lastlelem + 1;
  1882.     I32 arybase = curcop->cop_arybase;
  1883.  
  1884.     register I32 max = lastrelem - lastlelem;
  1885.     register SV **lelem;
  1886.     register I32 ix;
  1887.  
  1888.     if (GIMME != G_ARRAY) {
  1889.     ix = SvIVx(*lastlelem);
  1890.     if (ix < 0)
  1891.         ix += max;
  1892.     else
  1893.         ix -= arybase;
  1894.     if (ix < 0 || ix >= max)
  1895.         *firstlelem = &sv_undef;
  1896.     else
  1897.         *firstlelem = firstrelem[ix];
  1898.     SP = firstlelem;
  1899.     RETURN;
  1900.     }
  1901.  
  1902.     if (max == 0) {
  1903.     SP = firstlelem - 1;
  1904.     RETURN;
  1905.     }
  1906.  
  1907.     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
  1908.     ix = SvIVx(*lelem);
  1909.     if (ix < 0) {
  1910.         ix += max;
  1911.         if (ix < 0)
  1912.         *lelem = &sv_undef;
  1913.         else if (!(*lelem = firstrelem[ix]))
  1914.         *lelem = &sv_undef;
  1915.     }
  1916.     else {
  1917.         ix -= arybase;
  1918.         if (ix >= max || !(*lelem = firstrelem[ix]))
  1919.         *lelem = &sv_undef;
  1920.     }
  1921.     }
  1922.     SP = lastlelem;
  1923.     RETURN;
  1924. }
  1925.  
  1926. PP(pp_anonlist)
  1927. {
  1928.     dSP; dMARK;
  1929.     I32 items = SP - MARK;
  1930.     SP = MARK;
  1931.     XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
  1932.     RETURN;
  1933. }
  1934.  
  1935. PP(pp_anonhash)
  1936. {
  1937.     dSP; dMARK; dORIGMARK;
  1938.     STRLEN len;
  1939.     HV* hv = (HV*)sv_2mortal((SV*)newHV());
  1940.  
  1941.     while (MARK < SP) {
  1942.     SV* key = *++MARK;
  1943.     char *tmps;
  1944.     SV *val = NEWSV(46, 0);
  1945.     if (MARK < SP)
  1946.         sv_setsv(val, *++MARK);
  1947.     else
  1948.         warn("Odd number of elements in hash list");
  1949.     tmps = SvPV(key,len);
  1950.     (void)hv_store(hv,tmps,len,val,0);
  1951.     }
  1952.     SP = ORIGMARK;
  1953.     XPUSHs((SV*)hv);
  1954.     RETURN;
  1955. }
  1956.  
  1957. PP(pp_splice)
  1958. {
  1959.     dSP; dMARK; dORIGMARK;
  1960.     register AV *ary = (AV*)*++MARK;
  1961.     register SV **src;
  1962.     register SV **dst;
  1963.     register I32 i;
  1964.     register I32 offset;
  1965.     register I32 length;
  1966.     I32 newlen;
  1967.     I32 after;
  1968.     I32 diff;
  1969.     SV **tmparyval = 0;
  1970.  
  1971.     SP++;
  1972.  
  1973.     if (++MARK < SP) {
  1974.     offset = SvIVx(*MARK);
  1975.     if (offset < 0)
  1976.         offset += AvFILL(ary) + 1;
  1977.     else
  1978.         offset -= curcop->cop_arybase;
  1979.     if (++MARK < SP) {
  1980.         length = SvIVx(*MARK++);
  1981.         if (length < 0)
  1982.         length = 0;
  1983.     }
  1984.     else
  1985.         length = AvMAX(ary) + 1;        /* close enough to infinity */
  1986.     }
  1987.     else {
  1988.     offset = 0;
  1989.     length = AvMAX(ary) + 1;
  1990.     }
  1991.     if (offset < 0) {
  1992.     length += offset;
  1993.     offset = 0;
  1994.     if (length < 0)
  1995.         length = 0;
  1996.     }
  1997.     if (offset > AvFILL(ary) + 1)
  1998.     offset = AvFILL(ary) + 1;
  1999.     after = AvFILL(ary) + 1 - (offset + length);
  2000.     if (after < 0) {                /* not that much array */
  2001.     length += after;            /* offset+length now in array */
  2002.     after = 0;
  2003.     if (!AvALLOC(ary))
  2004.         av_extend(ary, 0);
  2005.     }
  2006.  
  2007.     /* At this point, MARK .. SP-1 is our new LIST */
  2008.  
  2009.     newlen = SP - MARK;
  2010.     diff = newlen - length;
  2011.  
  2012.     if (diff < 0) {                /* shrinking the area */
  2013.     if (newlen) {
  2014.         New(451, tmparyval, newlen, SV*);    /* so remember insertion */
  2015.         Copy(MARK, tmparyval, newlen, SV*);
  2016.     }
  2017.  
  2018.     MARK = ORIGMARK + 1;
  2019.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2020.         MEXTEND(MARK, length);
  2021.         Copy(AvARRAY(ary)+offset, MARK, length, SV*);
  2022.         if (AvREAL(ary)) {
  2023.         for (i = length, dst = MARK; i; i--)
  2024.             sv_2mortal(*dst++);    /* free them eventualy */
  2025.         }
  2026.         MARK += length - 1;
  2027.     }
  2028.     else {
  2029.         *MARK = AvARRAY(ary)[offset+length-1];
  2030.         if (AvREAL(ary)) {
  2031.         sv_2mortal(*MARK);
  2032.         for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
  2033.             SvREFCNT_dec(*dst++);    /* free them now */
  2034.         }
  2035.     }
  2036.     AvFILL(ary) += diff;
  2037.  
  2038.     /* pull up or down? */
  2039.  
  2040.     if (offset < after) {            /* easier to pull up */
  2041.         if (offset) {            /* esp. if nothing to pull */
  2042.         src = &AvARRAY(ary)[offset-1];
  2043.         dst = src - diff;        /* diff is negative */
  2044.         for (i = offset; i > 0; i--)    /* can't trust Copy */
  2045.             *dst-- = *src--;
  2046.         }
  2047.         dst = AvARRAY(ary);
  2048.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
  2049.         AvMAX(ary) += diff;
  2050.     }
  2051.     else {
  2052.         if (after) {            /* anything to pull down? */
  2053.         src = AvARRAY(ary) + offset + length;
  2054.         dst = src + diff;        /* diff is negative */
  2055.         Move(src, dst, after, SV*);
  2056.         }
  2057.         dst = &AvARRAY(ary)[AvFILL(ary)+1];
  2058.                         /* avoid later double free */
  2059.     }
  2060.     i = -diff;
  2061.     while (i)
  2062.         dst[--i] = &sv_undef;
  2063.     
  2064.     if (newlen) {
  2065.         for (src = tmparyval, dst = AvARRAY(ary) + offset;
  2066.           newlen; newlen--) {
  2067.         *dst = NEWSV(46, 0);
  2068.         sv_setsv(*dst++, *src++);
  2069.         }
  2070.         Safefree(tmparyval);
  2071.     }
  2072.     }
  2073.     else {                    /* no, expanding (or same) */
  2074.     if (length) {
  2075.         New(452, tmparyval, length, SV*);    /* so remember deletion */
  2076.         Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
  2077.     }
  2078.  
  2079.     if (diff > 0) {                /* expanding */
  2080.  
  2081.         /* push up or down? */
  2082.  
  2083.         if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
  2084.         if (offset) {
  2085.             src = AvARRAY(ary);
  2086.             dst = src - diff;
  2087.             Move(src, dst, offset, SV*);
  2088.         }
  2089.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
  2090.         AvMAX(ary) += diff;
  2091.         AvFILL(ary) += diff;
  2092.         }
  2093.         else {
  2094.         if (AvFILL(ary) + diff >= AvMAX(ary))    /* oh, well */
  2095.             av_extend(ary, AvFILL(ary) + diff);
  2096.         AvFILL(ary) += diff;
  2097.  
  2098.         if (after) {
  2099.             dst = AvARRAY(ary) + AvFILL(ary);
  2100.             src = dst - diff;
  2101.             for (i = after; i; i--) {
  2102.             *dst-- = *src--;
  2103.             }
  2104.         }
  2105.         }
  2106.     }
  2107.  
  2108.     for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
  2109.         *dst = NEWSV(46, 0);
  2110.         sv_setsv(*dst++, *src++);
  2111.     }
  2112.     MARK = ORIGMARK + 1;
  2113.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2114.         if (length) {
  2115.         Copy(tmparyval, MARK, length, SV*);
  2116.         if (AvREAL(ary)) {
  2117.             for (i = length, dst = MARK; i; i--)
  2118.             sv_2mortal(*dst++);    /* free them eventualy */
  2119.         }
  2120.         Safefree(tmparyval);
  2121.         }
  2122.         MARK += length - 1;
  2123.     }
  2124.     else if (length--) {
  2125.         *MARK = tmparyval[length];
  2126.         if (AvREAL(ary)) {
  2127.         sv_2mortal(*MARK);
  2128.         while (length-- > 0)
  2129.             SvREFCNT_dec(tmparyval[length]);
  2130.         }
  2131.         Safefree(tmparyval);
  2132.     }
  2133.     else
  2134.         *MARK = &sv_undef;
  2135.     }
  2136.     SP = MARK;
  2137.     RETURN;
  2138. }
  2139.  
  2140. PP(pp_push)
  2141. {
  2142.     dSP; dMARK; dORIGMARK; dTARGET;
  2143.     register AV *ary = (AV*)*++MARK;
  2144.     register SV *sv = &sv_undef;
  2145.  
  2146.     for (++MARK; MARK <= SP; MARK++) {
  2147.     sv = NEWSV(51, 0);
  2148.     if (*MARK)
  2149.         sv_setsv(sv, *MARK);
  2150.     av_push(ary, sv);
  2151.     }
  2152.     SP = ORIGMARK;
  2153.     PUSHi( AvFILL(ary) + 1 );
  2154.     RETURN;
  2155. }
  2156.  
  2157. PP(pp_pop)
  2158. {
  2159.     dSP;
  2160.     AV *av = (AV*)POPs;
  2161.     SV *sv = av_pop(av);
  2162.     if (sv != &sv_undef && AvREAL(av))
  2163.     (void)sv_2mortal(sv);
  2164.     PUSHs(sv);
  2165.     RETURN;
  2166. }
  2167.  
  2168. PP(pp_shift)
  2169. {
  2170.     dSP;
  2171.     AV *av = (AV*)POPs;
  2172.     SV *sv = av_shift(av);
  2173.     EXTEND(SP, 1);
  2174.     if (!sv)
  2175.     RETPUSHUNDEF;
  2176.     if (sv != &sv_undef && AvREAL(av))
  2177.     (void)sv_2mortal(sv);
  2178.     PUSHs(sv);
  2179.     RETURN;
  2180. }
  2181.  
  2182. PP(pp_unshift)
  2183. {
  2184.     dSP; dMARK; dORIGMARK; dTARGET;
  2185.     register AV *ary = (AV*)*++MARK;
  2186.     register SV *sv;
  2187.     register I32 i = 0;
  2188.  
  2189.     av_unshift(ary, SP - MARK);
  2190.     while (MARK < SP) {
  2191.     sv = NEWSV(27, 0);
  2192.     sv_setsv(sv, *++MARK);
  2193.     (void)av_store(ary, i++, sv);
  2194.     }
  2195.  
  2196.     SP = ORIGMARK;
  2197.     PUSHi( AvFILL(ary) + 1 );
  2198.     RETURN;
  2199. }
  2200.  
  2201. PP(pp_reverse)
  2202. {
  2203.     dSP; dMARK;
  2204.     register SV *tmp;
  2205.     SV **oldsp = SP;
  2206.  
  2207.     if (GIMME == G_ARRAY) {
  2208.     MARK++;
  2209.     while (MARK < SP) {
  2210.         tmp = *MARK;
  2211.         *MARK++ = *SP;
  2212.         *SP-- = tmp;
  2213.     }
  2214.     SP = oldsp;
  2215.     }
  2216.     else {
  2217.     register char *up;
  2218.     register char *down;
  2219.     register I32 tmp;
  2220.     dTARGET;
  2221.     STRLEN len;
  2222.  
  2223.     if (SP - MARK > 1)
  2224.         do_join(TARG, &sv_no, MARK, SP);
  2225.     else
  2226.         sv_setsv(TARG, *SP);
  2227.     up = SvPV_force(TARG, len);
  2228.     if (len > 1) {
  2229.         down = SvPVX(TARG) + len - 1;
  2230.         while (down > up) {
  2231.         tmp = *up;
  2232.         *up++ = *down;
  2233.         *down-- = tmp;
  2234.         }
  2235.         (void)SvPOK_only(TARG);
  2236.     }
  2237.     SP = MARK + 1;
  2238.     SETTARG;
  2239.     }
  2240.     RETURN;
  2241. }
  2242.  
  2243. /* Explosives and implosives. */
  2244.  
  2245. PP(pp_unpack)
  2246. {
  2247.     dSP;
  2248.     dPOPPOPssrl;
  2249.     SV *sv;
  2250.     STRLEN llen;
  2251.     STRLEN rlen;
  2252.     register char *pat = SvPV(left, llen);
  2253.     register char *s = SvPV(right, rlen);
  2254.     char *strend = s + rlen;
  2255.     char *strbeg = s;
  2256.     register char *patend = pat + llen;
  2257.     I32 datumtype;
  2258.     register I32 len;
  2259.     register I32 bits;
  2260.  
  2261.     /* These must not be in registers: */
  2262.     I16 ashort;
  2263.     int aint;
  2264.     I32 along;
  2265. #ifdef HAS_QUAD
  2266.     Quad_t aquad;
  2267. #endif
  2268.     U16 aushort;
  2269.     unsigned int auint;
  2270.     U32 aulong;
  2271. #ifdef HAS_QUAD
  2272.     unsigned Quad_t auquad;
  2273. #endif
  2274.     char *aptr;
  2275.     float afloat;
  2276.     double adouble;
  2277.     I32 checksum = 0;
  2278.     register U32 culong;
  2279.     double cdouble;
  2280.     static char* bitcount = 0;
  2281.  
  2282.     if (GIMME != G_ARRAY) {        /* arrange to do first one only */
  2283.     /*SUPPRESS 530*/
  2284.     for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
  2285.     if (strchr("aAbBhHP", *patend) || *pat == '%') {
  2286.         patend++;
  2287.         while (isDIGIT(*patend) || *patend == '*')
  2288.         patend++;
  2289.     }
  2290.     else
  2291.         patend++;
  2292.     }
  2293.     while (pat < patend) {
  2294.       reparse:
  2295.     datumtype = *pat++;
  2296.     if (pat >= patend)
  2297.         len = 1;
  2298.     else if (*pat == '*') {
  2299.         len = strend - strbeg;    /* long enough */
  2300.         pat++;
  2301.     }
  2302.     else if (isDIGIT(*pat)) {
  2303.         len = *pat++ - '0';
  2304.         while (isDIGIT(*pat))
  2305.         len = (len * 10) + (*pat++ - '0');
  2306.     }
  2307.     else
  2308.         len = (datumtype != '@');
  2309.     switch(datumtype) {
  2310.     default:
  2311.         break;
  2312.     case '%':
  2313.         if (len == 1 && pat[-1] != '1')
  2314.         len = 16;
  2315.         checksum = len;
  2316.         culong = 0;
  2317.         cdouble = 0;
  2318.         if (pat < patend)
  2319.         goto reparse;
  2320.         break;
  2321.     case '@':
  2322.         if (len > strend - strbeg)
  2323.         DIE("@ outside of string");
  2324.         s = strbeg + len;
  2325.         break;
  2326.     case 'X':
  2327.         if (len > s - strbeg)
  2328.         DIE("X outside of string");
  2329.         s -= len;
  2330.         break;
  2331.     case 'x':
  2332.         if (len > strend - s)
  2333.         DIE("x outside of string");
  2334.         s += len;
  2335.         break;
  2336.     case 'A':
  2337.     case 'a':
  2338.         if (len > strend - s)
  2339.         len = strend - s;
  2340.         if (checksum)
  2341.         goto uchar_checksum;
  2342.         sv = NEWSV(35, len);
  2343.         sv_setpvn(sv, s, len);
  2344.         s += len;
  2345.         if (datumtype == 'A') {
  2346.         aptr = s;    /* borrow register */
  2347.         s = SvPVX(sv) + len - 1;
  2348.         while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
  2349.             s--;
  2350.         *++s = '\0';
  2351.         SvCUR_set(sv, s - SvPVX(sv));
  2352.         s = aptr;    /* unborrow register */
  2353.         }
  2354.         XPUSHs(sv_2mortal(sv));
  2355.         break;
  2356.     case 'B':
  2357.     case 'b':
  2358.         if (pat[-1] == '*' || len > (strend - s) * 8)
  2359.         len = (strend - s) * 8;
  2360.         if (checksum) {
  2361.         if (!bitcount) {
  2362.             Newz(601, bitcount, 256, char);
  2363.             for (bits = 1; bits < 256; bits++) {
  2364.             if (bits & 1)    bitcount[bits]++;
  2365.             if (bits & 2)    bitcount[bits]++;
  2366.             if (bits & 4)    bitcount[bits]++;
  2367.             if (bits & 8)    bitcount[bits]++;
  2368.             if (bits & 16)    bitcount[bits]++;
  2369.             if (bits & 32)    bitcount[bits]++;
  2370.             if (bits & 64)    bitcount[bits]++;
  2371.             if (bits & 128)    bitcount[bits]++;
  2372.             }
  2373.         }
  2374.         while (len >= 8) {
  2375.             culong += bitcount[*(unsigned char*)s++];
  2376.             len -= 8;
  2377.         }
  2378.         if (len) {
  2379.             bits = *s;
  2380.             if (datumtype == 'b') {
  2381.             while (len-- > 0) {
  2382.                 if (bits & 1) culong++;
  2383.                 bits >>= 1;
  2384.             }
  2385.             }
  2386.             else {
  2387.             while (len-- > 0) {
  2388.                 if (bits & 128) culong++;
  2389.                 bits <<= 1;
  2390.             }
  2391.             }
  2392.         }
  2393.         break;
  2394.         }
  2395.         sv = NEWSV(35, len + 1);
  2396.         SvCUR_set(sv, len);
  2397.         SvPOK_on(sv);
  2398.         aptr = pat;            /* borrow register */
  2399.         pat = SvPVX(sv);
  2400.         if (datumtype == 'b') {
  2401.         aint = len;
  2402.         for (len = 0; len < aint; len++) {
  2403.             if (len & 7)        /*SUPPRESS 595*/
  2404.             bits >>= 1;
  2405.             else
  2406.             bits = *s++;
  2407.             *pat++ = '0' + (bits & 1);
  2408.         }
  2409.         }
  2410.         else {
  2411.         aint = len;
  2412.         for (len = 0; len < aint; len++) {
  2413.             if (len & 7)
  2414.             bits <<= 1;
  2415.             else
  2416.             bits = *s++;
  2417.             *pat++ = '0' + ((bits & 128) != 0);
  2418.         }
  2419.         }
  2420.         *pat = '\0';
  2421.         pat = aptr;            /* unborrow register */
  2422.         XPUSHs(sv_2mortal(sv));
  2423.         break;
  2424.     case 'H':
  2425.     case 'h':
  2426.         if (pat[-1] == '*' || len > (strend - s) * 2)
  2427.         len = (strend - s) * 2;
  2428.         sv = NEWSV(35, len + 1);
  2429.         SvCUR_set(sv, len);
  2430.         SvPOK_on(sv);
  2431.         aptr = pat;            /* borrow register */
  2432.         pat = SvPVX(sv);
  2433.         if (datumtype == 'h') {
  2434.         aint = len;
  2435.         for (len = 0; len < aint; len++) {
  2436.             if (len & 1)
  2437.             bits >>= 4;
  2438.             else
  2439.             bits = *s++;
  2440.             *pat++ = hexdigit[bits & 15];
  2441.         }
  2442.         }
  2443.         else {
  2444.         aint = len;
  2445.         for (len = 0; len < aint; len++) {
  2446.             if (len & 1)
  2447.             bits <<= 4;
  2448.             else
  2449.             bits = *s++;
  2450.             *pat++ = hexdigit[(bits >> 4) & 15];
  2451.         }
  2452.         }
  2453.         *pat = '\0';
  2454.         pat = aptr;            /* unborrow register */
  2455.         XPUSHs(sv_2mortal(sv));
  2456.         break;
  2457.     case 'c':
  2458.         if (len > strend - s)
  2459.         len = strend - s;
  2460.         if (checksum) {
  2461.         while (len-- > 0) {
  2462.             aint = *s++;
  2463.             if (aint >= 128)    /* fake up signed chars */
  2464.             aint -= 256;
  2465.             culong += aint;
  2466.         }
  2467.         }
  2468.         else {
  2469.         EXTEND(SP, len);
  2470.         while (len-- > 0) {
  2471.             aint = *s++;
  2472.             if (aint >= 128)    /* fake up signed chars */
  2473.             aint -= 256;
  2474.             sv = NEWSV(36, 0);
  2475.             sv_setiv(sv, (I32)aint);
  2476.             PUSHs(sv_2mortal(sv));
  2477.         }
  2478.         }
  2479.         break;
  2480.     case 'C':
  2481.         if (len > strend - s)
  2482.         len = strend - s;
  2483.         if (checksum) {
  2484.           uchar_checksum:
  2485.         while (len-- > 0) {
  2486.             auint = *s++ & 255;
  2487.             culong += auint;
  2488.         }
  2489.         }
  2490.         else {
  2491.         EXTEND(SP, len);
  2492.         while (len-- > 0) {
  2493.             auint = *s++ & 255;
  2494.             sv = NEWSV(37, 0);
  2495.             sv_setiv(sv, (I32)auint);
  2496.             PUSHs(sv_2mortal(sv));
  2497.         }
  2498.         }
  2499.         break;
  2500.     case 's':
  2501.         along = (strend - s) / sizeof(I16);
  2502.         if (len > along)
  2503.         len = along;
  2504.         if (checksum) {
  2505.         while (len-- > 0) {
  2506.             Copy(s, &ashort, 1, I16);
  2507.             s += sizeof(I16);
  2508.             culong += ashort;
  2509.         }
  2510.         }
  2511.         else {
  2512.         EXTEND(SP, len);
  2513.         while (len-- > 0) {
  2514.             Copy(s, &ashort, 1, I16);
  2515.             s += sizeof(I16);
  2516.             sv = NEWSV(38, 0);
  2517.             sv_setiv(sv, (I32)ashort);
  2518.             PUSHs(sv_2mortal(sv));
  2519.         }
  2520.         }
  2521.         break;
  2522.     case 'v':
  2523.     case 'n':
  2524.     case 'S':
  2525.         along = (strend - s) / sizeof(U16);
  2526.         if (len > along)
  2527.         len = along;
  2528.         if (checksum) {
  2529.         while (len-- > 0) {
  2530.             Copy(s, &aushort, 1, U16);
  2531.             s += sizeof(U16);
  2532. #ifdef HAS_NTOHS
  2533.             if (datumtype == 'n')
  2534.             aushort = ntohs(aushort);
  2535. #endif
  2536. #ifdef HAS_VTOHS
  2537.             if (datumtype == 'v')
  2538.             aushort = vtohs(aushort);
  2539. #endif
  2540.             culong += aushort;
  2541.         }
  2542.         }
  2543.         else {
  2544.         EXTEND(SP, len);
  2545.         while (len-- > 0) {
  2546.             Copy(s, &aushort, 1, U16);
  2547.             s += sizeof(U16);
  2548.             sv = NEWSV(39, 0);
  2549. #ifdef HAS_NTOHS
  2550.             if (datumtype == 'n')
  2551.             aushort = ntohs(aushort);
  2552. #endif
  2553. #ifdef HAS_VTOHS
  2554.             if (datumtype == 'v')
  2555.             aushort = vtohs(aushort);
  2556. #endif
  2557.             sv_setiv(sv, (I32)aushort);
  2558.             PUSHs(sv_2mortal(sv));
  2559.         }
  2560.         }
  2561.         break;
  2562.     case 'i':
  2563.         along = (strend - s) / sizeof(int);
  2564.         if (len > along)
  2565.         len = along;
  2566.         if (checksum) {
  2567.         while (len-- > 0) {
  2568.             Copy(s, &aint, 1, int);
  2569.             s += sizeof(int);
  2570.             if (checksum > 32)
  2571.             cdouble += (double)aint;
  2572.             else
  2573.             culong += aint;
  2574.         }
  2575.         }
  2576.         else {
  2577.         EXTEND(SP, len);
  2578.         while (len-- > 0) {
  2579.             Copy(s, &aint, 1, int);
  2580.             s += sizeof(int);
  2581.             sv = NEWSV(40, 0);
  2582.             sv_setiv(sv, (I32)aint);
  2583.             PUSHs(sv_2mortal(sv));
  2584.         }
  2585.         }
  2586.         break;
  2587.     case 'I':
  2588.         along = (strend - s) / sizeof(unsigned int);
  2589.         if (len > along)
  2590.         len = along;
  2591.         if (checksum) {
  2592.         while (len-- > 0) {
  2593.             Copy(s, &auint, 1, unsigned int);
  2594.             s += sizeof(unsigned int);
  2595.             if (checksum > 32)
  2596.             cdouble += (double)auint;
  2597.             else
  2598.             culong += auint;
  2599.         }
  2600.         }
  2601.         else {
  2602.         EXTEND(SP, len);
  2603.         while (len-- > 0) {
  2604.             Copy(s, &auint, 1, unsigned int);
  2605.             s += sizeof(unsigned int);
  2606.             sv = NEWSV(41, 0);
  2607.             sv_setiv(sv, (I32)auint);
  2608.             PUSHs(sv_2mortal(sv));
  2609.         }
  2610.         }
  2611.         break;
  2612.     case 'l':
  2613.         along = (strend - s) / sizeof(I32);
  2614.         if (len > along)
  2615.         len = along;
  2616.         if (checksum) {
  2617.         while (len-- > 0) {
  2618.             Copy(s, &along, 1, I32);
  2619.             s += sizeof(I32);
  2620.             if (checksum > 32)
  2621.             cdouble += (double)along;
  2622.             else
  2623.             culong += along;
  2624.         }
  2625.         }
  2626.         else {
  2627.         EXTEND(SP, len);
  2628.         while (len-- > 0) {
  2629.             Copy(s, &along, 1, I32);
  2630.             s += sizeof(I32);
  2631.             sv = NEWSV(42, 0);
  2632.             sv_setiv(sv, (I32)along);
  2633.             PUSHs(sv_2mortal(sv));
  2634.         }
  2635.         }
  2636.         break;
  2637.     case 'V':
  2638.     case 'N':
  2639.     case 'L':
  2640.         along = (strend - s) / sizeof(U32);
  2641.         if (len > along)
  2642.         len = along;
  2643.         if (checksum) {
  2644.         while (len-- > 0) {
  2645.             Copy(s, &aulong, 1, U32);
  2646.             s += sizeof(U32);
  2647. #ifdef HAS_NTOHL
  2648.             if (datumtype == 'N')
  2649.             aulong = ntohl(aulong);
  2650. #endif
  2651. #ifdef HAS_VTOHL
  2652.             if (datumtype == 'V')
  2653.             aulong = vtohl(aulong);
  2654. #endif
  2655.             if (checksum > 32)
  2656.             cdouble += (double)aulong;
  2657.             else
  2658.             culong += aulong;
  2659.         }
  2660.         }
  2661.         else {
  2662.         EXTEND(SP, len);
  2663.         while (len-- > 0) {
  2664.             Copy(s, &aulong, 1, U32);
  2665.             s += sizeof(U32);
  2666.             sv = NEWSV(43, 0);
  2667. #ifdef HAS_NTOHL
  2668.             if (datumtype == 'N')
  2669.             aulong = ntohl(aulong);
  2670. #endif
  2671. #ifdef HAS_VTOHL
  2672.             if (datumtype == 'V')
  2673.             aulong = vtohl(aulong);
  2674. #endif
  2675.             sv_setnv(sv, (double)aulong);
  2676.             PUSHs(sv_2mortal(sv));
  2677.         }
  2678.         }
  2679.         break;
  2680.     case 'p':
  2681.         along = (strend - s) / sizeof(char*);
  2682.         if (len > along)
  2683.         len = along;
  2684.         EXTEND(SP, len);
  2685.         while (len-- > 0) {
  2686.         if (sizeof(char*) > strend - s)
  2687.             break;
  2688.         else {
  2689.             Copy(s, &aptr, 1, char*);
  2690.             s += sizeof(char*);
  2691.         }
  2692.         sv = NEWSV(44, 0);
  2693.         if (aptr)
  2694.             sv_setpv(sv, aptr);
  2695.         PUSHs(sv_2mortal(sv));
  2696.         }
  2697.         break;
  2698.     case 'P':
  2699.         EXTEND(SP, 1);
  2700.         if (sizeof(char*) > strend - s)
  2701.         break;
  2702.         else {
  2703.         Copy(s, &aptr, 1, char*);
  2704.         s += sizeof(char*);
  2705.         }
  2706.         sv = NEWSV(44, 0);
  2707.         if (aptr)
  2708.         sv_setpvn(sv, aptr, len);
  2709.         PUSHs(sv_2mortal(sv));
  2710.         break;
  2711. #ifdef HAS_QUAD
  2712.     case 'q':
  2713.         EXTEND(SP, len);
  2714.         while (len-- > 0) {
  2715.         if (s + sizeof(Quad_t) > strend)
  2716.             aquad = 0;
  2717.         else {
  2718.             Copy(s, &aquad, 1, Quad_t);
  2719.             s += sizeof(Quad_t);
  2720.         }
  2721.         sv = NEWSV(42, 0);
  2722.         sv_setiv(sv, (IV)aquad);
  2723.         PUSHs(sv_2mortal(sv));
  2724.         }
  2725.         break;
  2726.     case 'Q':
  2727.         EXTEND(SP, len);
  2728.         while (len-- > 0) {
  2729.         if (s + sizeof(unsigned Quad_t) > strend)
  2730.             auquad = 0;
  2731.         else {
  2732.             Copy(s, &auquad, 1, unsigned Quad_t);
  2733.             s += sizeof(unsigned Quad_t);
  2734.         }
  2735.         sv = NEWSV(43, 0);
  2736.         sv_setiv(sv, (IV)auquad);
  2737.         PUSHs(sv_2mortal(sv));
  2738.         }
  2739.         break;
  2740. #endif
  2741.     /* float and double added gnb@melba.bby.oz.au 22/11/89 */
  2742.     case 'f':
  2743.     case 'F':
  2744.         along = (strend - s) / sizeof(float);
  2745.         if (len > along)
  2746.         len = along;
  2747.         if (checksum) {
  2748.         while (len-- > 0) {
  2749.             Copy(s, &afloat, 1, float);
  2750.             s += sizeof(float);
  2751.             cdouble += afloat;
  2752.         }
  2753.         }
  2754.         else {
  2755.         EXTEND(SP, len);
  2756.         while (len-- > 0) {
  2757.             Copy(s, &afloat, 1, float);
  2758.             s += sizeof(float);
  2759.             sv = NEWSV(47, 0);
  2760.             sv_setnv(sv, (double)afloat);
  2761.             PUSHs(sv_2mortal(sv));
  2762.         }
  2763.         }
  2764.         break;
  2765.     case 'd':
  2766.     case 'D':
  2767.         along = (strend - s) / sizeof(double);
  2768.         if (len > along)
  2769.         len = along;
  2770.         if (checksum) {
  2771.         while (len-- > 0) {
  2772.             Copy(s, &adouble, 1, double);
  2773.             s += sizeof(double);
  2774.             cdouble += adouble;
  2775.         }
  2776.         }
  2777.         else {
  2778.         EXTEND(SP, len);
  2779.         while (len-- > 0) {
  2780.             Copy(s, &adouble, 1, double);
  2781.             s += sizeof(double);
  2782.             sv = NEWSV(48, 0);
  2783.             sv_setnv(sv, (double)adouble);
  2784.             PUSHs(sv_2mortal(sv));
  2785.         }
  2786.         }
  2787.         break;
  2788.     case 'u':
  2789.         along = (strend - s) * 3 / 4;
  2790.         sv = NEWSV(42, along);
  2791.         while (s < strend && *s > ' ' && *s < 'a') {
  2792.         I32 a, b, c, d;
  2793.         char hunk[4];
  2794.  
  2795.         hunk[3] = '\0';
  2796.         len = (*s++ - ' ') & 077;
  2797.         while (len > 0) {
  2798.             if (s < strend && *s >= ' ')
  2799.             a = (*s++ - ' ') & 077;
  2800.             else
  2801.             a = 0;
  2802.             if (s < strend && *s >= ' ')
  2803.             b = (*s++ - ' ') & 077;
  2804.             else
  2805.             b = 0;
  2806.             if (s < strend && *s >= ' ')
  2807.             c = (*s++ - ' ') & 077;
  2808.             else
  2809.             c = 0;
  2810.             if (s < strend && *s >= ' ')
  2811.             d = (*s++ - ' ') & 077;
  2812.             else
  2813.             d = 0;
  2814.             hunk[0] = a << 2 | b >> 4;
  2815.             hunk[1] = b << 4 | c >> 2;
  2816.             hunk[2] = c << 6 | d;
  2817.             sv_catpvn(sv, hunk, len > 3 ? 3 : len);
  2818.             len -= 3;
  2819.         }
  2820.         if (*s == '\n')
  2821.             s++;
  2822.         else if (s[1] == '\n')        /* possible checksum byte */
  2823.             s += 2;
  2824.         }
  2825.         XPUSHs(sv_2mortal(sv));
  2826.         break;
  2827.     }
  2828.     if (checksum) {
  2829.         sv = NEWSV(42, 0);
  2830.         if (strchr("fFdD", datumtype) ||
  2831.           (checksum > 32 && strchr("iIlLN", datumtype)) ) {
  2832.         double trouble;
  2833.  
  2834.         adouble = 1.0;
  2835.         while (checksum >= 16) {
  2836.             checksum -= 16;
  2837.             adouble *= 65536.0;
  2838.         }
  2839.         while (checksum >= 4) {
  2840.             checksum -= 4;
  2841.             adouble *= 16.0;
  2842.         }
  2843.         while (checksum--)
  2844.             adouble *= 2.0;
  2845.         along = (1 << checksum) - 1;
  2846.         while (cdouble < 0.0)
  2847.             cdouble += adouble;
  2848.         cdouble = modf(cdouble / adouble, &trouble) * adouble;
  2849.         sv_setnv(sv, cdouble);
  2850.         }
  2851.         else {
  2852.         if (checksum < 32) {
  2853.             along = (1 << checksum) - 1;
  2854.             culong &= (U32)along;
  2855.         }
  2856.         sv_setnv(sv, (double)culong);
  2857.         }
  2858.         XPUSHs(sv_2mortal(sv));
  2859.         checksum = 0;
  2860.     }
  2861.     }
  2862.     RETURN;
  2863. }
  2864.  
  2865. static void
  2866. doencodes(sv, s, len)
  2867. register SV *sv;
  2868. register char *s;
  2869. register I32 len;
  2870. {
  2871.     char hunk[5];
  2872.  
  2873.     *hunk = len + ' ';
  2874.     sv_catpvn(sv, hunk, 1);
  2875.     hunk[4] = '\0';
  2876.     while (len > 0) {
  2877.     hunk[0] = ' ' + (077 & (*s >> 2));
  2878.     hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
  2879.     hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
  2880.     hunk[3] = ' ' + (077 & (s[2] & 077));
  2881.     sv_catpvn(sv, hunk, 4);
  2882.     s += 3;
  2883.     len -= 3;
  2884.     }
  2885.     for (s = SvPVX(sv); *s; s++) {
  2886.     if (*s == ' ')
  2887.         *s = '`';
  2888.     }
  2889.     sv_catpvn(sv, "\n", 1);
  2890. }
  2891.  
  2892. PP(pp_pack)
  2893. {
  2894.     dSP; dMARK; dORIGMARK; dTARGET;
  2895.     register SV *cat = TARG;
  2896.     register I32 items;
  2897.     STRLEN fromlen;
  2898.     register char *pat = SvPVx(*++MARK, fromlen);
  2899.     register char *patend = pat + fromlen;
  2900.     register I32 len;
  2901.     I32 datumtype;
  2902.     SV *fromstr;
  2903.     /*SUPPRESS 442*/
  2904.     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
  2905.     static char *space10 = "          ";
  2906.  
  2907.     /* These must not be in registers: */
  2908.     char achar;
  2909.     I16 ashort;
  2910.     int aint;
  2911.     unsigned int auint;
  2912.     I32 along;
  2913.     U32 aulong;
  2914. #ifdef HAS_QUAD
  2915.     Quad_t aquad;
  2916.     unsigned Quad_t auquad;
  2917. #endif
  2918.     char *aptr;
  2919.     float afloat;
  2920.     double adouble;
  2921.  
  2922.     items = SP - MARK;
  2923.     MARK++;
  2924.     sv_setpvn(cat, "", 0);
  2925.     while (pat < patend) {
  2926. #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
  2927.     datumtype = *pat++;
  2928.     if (*pat == '*') {
  2929.         len = strchr("@Xxu", datumtype) ? 0 : items;
  2930.         pat++;
  2931.     }
  2932.     else if (isDIGIT(*pat)) {
  2933.         len = *pat++ - '0';
  2934.         while (isDIGIT(*pat))
  2935.         len = (len * 10) + (*pat++ - '0');
  2936.     }
  2937.     else
  2938.         len = 1;
  2939.     switch(datumtype) {
  2940.     default:
  2941.         break;
  2942.     case '%':
  2943.         DIE("%% may only be used in unpack");
  2944.     case '@':
  2945.         len -= SvCUR(cat);
  2946.         if (len > 0)
  2947.         goto grow;
  2948.         len = -len;
  2949.         if (len > 0)
  2950.         goto shrink;
  2951.         break;
  2952.     case 'X':
  2953.       shrink:
  2954.         if (SvCUR(cat) < len)
  2955.         DIE("X outside of string");
  2956.         SvCUR(cat) -= len;
  2957.         *SvEND(cat) = '\0';
  2958.         break;
  2959.     case 'x':
  2960.       grow:
  2961.         while (len >= 10) {
  2962.         sv_catpvn(cat, null10, 10);
  2963.         len -= 10;
  2964.         }
  2965.         sv_catpvn(cat, null10, len);
  2966.         break;
  2967.     case 'A':
  2968.     case 'a':
  2969.         fromstr = NEXTFROM;
  2970.         aptr = SvPV(fromstr, fromlen);
  2971.         if (pat[-1] == '*')
  2972.         len = fromlen;
  2973.         if (fromlen > len)
  2974.         sv_catpvn(cat, aptr, len);
  2975.         else {
  2976.         sv_catpvn(cat, aptr, fromlen);
  2977.         len -= fromlen;
  2978.         if (datumtype == 'A') {
  2979.             while (len >= 10) {
  2980.             sv_catpvn(cat, space10, 10);
  2981.             len -= 10;
  2982.             }
  2983.             sv_catpvn(cat, space10, len);
  2984.         }
  2985.         else {
  2986.             while (len >= 10) {
  2987.             sv_catpvn(cat, null10, 10);
  2988.             len -= 10;
  2989.             }
  2990.             sv_catpvn(cat, null10, len);
  2991.         }
  2992.         }
  2993.         break;
  2994.     case 'B':
  2995.     case 'b':
  2996.         {
  2997.         char *savepat = pat;
  2998.         I32 saveitems;
  2999.  
  3000.         fromstr = NEXTFROM;
  3001.         saveitems = items;
  3002.         aptr = SvPV(fromstr, fromlen);
  3003.         if (pat[-1] == '*')
  3004.             len = fromlen;
  3005.         pat = aptr;
  3006.         aint = SvCUR(cat);
  3007.         SvCUR(cat) += (len+7)/8;
  3008.         SvGROW(cat, SvCUR(cat) + 1);
  3009.         aptr = SvPVX(cat) + aint;
  3010.         if (len > fromlen)
  3011.             len = fromlen;
  3012.         aint = len;
  3013.         items = 0;
  3014.         if (datumtype == 'B') {
  3015.             for (len = 0; len++ < aint;) {
  3016.             items |= *pat++ & 1;
  3017.             if (len & 7)
  3018.                 items <<= 1;
  3019.             else {
  3020.                 *aptr++ = items & 0xff;
  3021.                 items = 0;
  3022.             }
  3023.             }
  3024.         }
  3025.         else {
  3026.             for (len = 0; len++ < aint;) {
  3027.             if (*pat++ & 1)
  3028.                 items |= 128;
  3029.             if (len & 7)
  3030.                 items >>= 1;
  3031.             else {
  3032.                 *aptr++ = items & 0xff;
  3033.                 items = 0;
  3034.             }
  3035.             }
  3036.         }
  3037.         if (aint & 7) {
  3038.             if (datumtype == 'B')
  3039.             items <<= 7 - (aint & 7);
  3040.             else
  3041.             items >>= 7 - (aint & 7);
  3042.             *aptr++ = items & 0xff;
  3043.         }
  3044.         pat = SvPVX(cat) + SvCUR(cat);
  3045.         while (aptr <= pat)
  3046.             *aptr++ = '\0';
  3047.  
  3048.         pat = savepat;
  3049.         items = saveitems;
  3050.         }
  3051.         break;
  3052.     case 'H':
  3053.     case 'h':
  3054.         {
  3055.         char *savepat = pat;
  3056.         I32 saveitems;
  3057.  
  3058.         fromstr = NEXTFROM;
  3059.         saveitems = items;
  3060.         aptr = SvPV(fromstr, fromlen);
  3061.         if (pat[-1] == '*')
  3062.             len = fromlen;
  3063.         pat = aptr;
  3064.         aint = SvCUR(cat);
  3065.         SvCUR(cat) += (len+1)/2;
  3066.         SvGROW(cat, SvCUR(cat) + 1);
  3067.         aptr = SvPVX(cat) + aint;
  3068.         if (len > fromlen)
  3069.             len = fromlen;
  3070.         aint = len;
  3071.         items = 0;
  3072.         if (datumtype == 'H') {
  3073.             for (len = 0; len++ < aint;) {
  3074.             if (isALPHA(*pat))
  3075.                 items |= ((*pat++ & 15) + 9) & 15;
  3076.             else
  3077.                 items |= *pat++ & 15;
  3078.             if (len & 1)
  3079.                 items <<= 4;
  3080.             else {
  3081.                 *aptr++ = items & 0xff;
  3082.                 items = 0;
  3083.             }
  3084.             }
  3085.         }
  3086.         else {
  3087.             for (len = 0; len++ < aint;) {
  3088.             if (isALPHA(*pat))
  3089.                 items |= (((*pat++ & 15) + 9) & 15) << 4;
  3090.             else
  3091.                 items |= (*pat++ & 15) << 4;
  3092.             if (len & 1)
  3093.                 items >>= 4;
  3094.             else {
  3095.                 *aptr++ = items & 0xff;
  3096.                 items = 0;
  3097.             }
  3098.             }
  3099.         }
  3100.         if (aint & 1)
  3101.             *aptr++ = items & 0xff;
  3102.         pat = SvPVX(cat) + SvCUR(cat);
  3103.         while (aptr <= pat)
  3104.             *aptr++ = '\0';
  3105.  
  3106.         pat = savepat;
  3107.         items = saveitems;
  3108.         }
  3109.         break;
  3110.     case 'C':
  3111.     case 'c':
  3112.         while (len-- > 0) {
  3113.         fromstr = NEXTFROM;
  3114.         aint = SvIV(fromstr);
  3115.         achar = aint;
  3116.         sv_catpvn(cat, &achar, sizeof(char));
  3117.         }
  3118.         break;
  3119.     /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
  3120.     case 'f':
  3121.     case 'F':
  3122.         while (len-- > 0) {
  3123.         fromstr = NEXTFROM;
  3124.         afloat = (float)SvNV(fromstr);
  3125.         sv_catpvn(cat, (char *)&afloat, sizeof (float));
  3126.         }
  3127.         break;
  3128.     case 'd':
  3129.     case 'D':
  3130.         while (len-- > 0) {
  3131.         fromstr = NEXTFROM;
  3132.         adouble = (double)SvNV(fromstr);
  3133.         sv_catpvn(cat, (char *)&adouble, sizeof (double));
  3134.         }
  3135.         break;
  3136.     case 'n':
  3137.         while (len-- > 0) {
  3138.         fromstr = NEXTFROM;
  3139.         ashort = (I16)SvIV(fromstr);
  3140. #ifdef HAS_HTONS
  3141.         ashort = htons(ashort);
  3142. #endif
  3143.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3144.         }
  3145.         break;
  3146.     case 'v':
  3147.         while (len-- > 0) {
  3148.         fromstr = NEXTFROM;
  3149.         ashort = (I16)SvIV(fromstr);
  3150. #ifdef HAS_HTOVS
  3151.         ashort = htovs(ashort);
  3152. #endif
  3153.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3154.         }
  3155.         break;
  3156.     case 'S':
  3157.     case 's':
  3158.         while (len-- > 0) {
  3159.         fromstr = NEXTFROM;
  3160.         ashort = (I16)SvIV(fromstr);
  3161.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3162.         }
  3163.         break;
  3164.     case 'I':
  3165.         while (len-- > 0) {
  3166.         fromstr = NEXTFROM;
  3167.         auint = U_I(SvNV(fromstr));
  3168.         sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
  3169.         }
  3170.         break;
  3171.     case 'i':
  3172.         while (len-- > 0) {
  3173.         fromstr = NEXTFROM;
  3174.         aint = SvIV(fromstr);
  3175.         sv_catpvn(cat, (char*)&aint, sizeof(int));
  3176.         }
  3177.         break;
  3178.     case 'N':
  3179.         while (len-- > 0) {
  3180.         fromstr = NEXTFROM;
  3181.         aulong = U_L(SvNV(fromstr));
  3182. #ifdef HAS_HTONL
  3183.         aulong = htonl(aulong);
  3184. #endif
  3185.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3186.         }
  3187.         break;
  3188.     case 'V':
  3189.         while (len-- > 0) {
  3190.         fromstr = NEXTFROM;
  3191.         aulong = U_L(SvNV(fromstr));
  3192. #ifdef HAS_HTOVL
  3193.         aulong = htovl(aulong);
  3194. #endif
  3195.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3196.         }
  3197.         break;
  3198.     case 'L':
  3199.         while (len-- > 0) {
  3200.         fromstr = NEXTFROM;
  3201.         aulong = U_L(SvNV(fromstr));
  3202.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3203.         }
  3204.         break;
  3205.     case 'l':
  3206.         while (len-- > 0) {
  3207.         fromstr = NEXTFROM;
  3208.         along = SvIV(fromstr);
  3209.         sv_catpvn(cat, (char*)&along, sizeof(I32));
  3210.         }
  3211.         break;
  3212. #ifdef HAS_QUAD
  3213.     case 'Q':
  3214.         while (len-- > 0) {
  3215.         fromstr = NEXTFROM;
  3216.         auquad = (unsigned Quad_t)SvIV(fromstr);
  3217.         sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
  3218.         }
  3219.         break;
  3220.     case 'q':
  3221.         while (len-- > 0) {
  3222.         fromstr = NEXTFROM;
  3223.         aquad = (Quad_t)SvIV(fromstr);
  3224.         sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
  3225.         }
  3226.         break;
  3227. #endif /* HAS_QUAD */
  3228.     case 'P':
  3229.         len = 1;        /* assume SV is correct length */
  3230.         /* FALL THROUGH */
  3231.     case 'p':
  3232.         while (len-- > 0) {
  3233.         fromstr = NEXTFROM;
  3234.         aptr = SvPV_force(fromstr, na);    /* XXX Error if TEMP? */
  3235.         sv_catpvn(cat, (char*)&aptr, sizeof(char*));
  3236.         }
  3237.         break;
  3238.     case 'u':
  3239.         fromstr = NEXTFROM;
  3240.         aptr = SvPV(fromstr, fromlen);
  3241.         SvGROW(cat, fromlen * 4 / 3);
  3242.         if (len <= 1)
  3243.         len = 45;
  3244.         else
  3245.         len = len / 3 * 3;
  3246.         while (fromlen > 0) {
  3247.         I32 todo;
  3248.  
  3249.         if (fromlen > len)
  3250.             todo = len;
  3251.         else
  3252.             todo = fromlen;
  3253.         doencodes(cat, aptr, todo);
  3254.         fromlen -= todo;
  3255.         aptr += todo;
  3256.         }
  3257.         break;
  3258.     }
  3259.     }
  3260.     SvSETMAGIC(cat);
  3261.     SP = ORIGMARK;
  3262.     PUSHs(cat);
  3263.     RETURN;
  3264. }
  3265. #undef NEXTFROM
  3266.  
  3267. PP(pp_split)
  3268. {
  3269.     dSP; dTARG;
  3270.     AV *ary;
  3271.     register I32 limit = POPi;            /* note, negative is forever */
  3272.     SV *sv = POPs;
  3273.     STRLEN len;
  3274.     register char *s = SvPV(sv, len);
  3275.     char *strend = s + len;
  3276.     register PMOP *pm = (PMOP*)POPs;
  3277.     register SV *dstr;
  3278.     register char *m;
  3279.     I32 iters = 0;
  3280.     I32 maxiters = (strend - s) + 10;
  3281.     I32 i;
  3282.     char *orig;
  3283.     I32 origlimit = limit;
  3284.     I32 realarray = 0;
  3285.     I32 base;
  3286.     AV *oldstack = stack;
  3287.     register REGEXP *rx = pm->op_pmregexp;
  3288.     I32 gimme = GIMME;
  3289.  
  3290.     if (!pm || !s)
  3291.     DIE("panic: do_split");
  3292.     if (pm->op_pmreplroot)
  3293.     ary = GvAVn((GV*)pm->op_pmreplroot);
  3294.     else if (gimme != G_ARRAY)
  3295.     ary = GvAVn(defgv);
  3296.     else
  3297.     ary = Nullav;
  3298.     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
  3299.     realarray = 1;
  3300.     if (!AvREAL(ary)) {
  3301.         AvREAL_on(ary);
  3302.         for (i = AvFILL(ary); i >= 0; i--)
  3303.         AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
  3304.     }
  3305.     av_extend(ary,0);
  3306.     av_clear(ary);
  3307.     /* temporarily switch stacks */
  3308.     SWITCHSTACK(stack, ary);
  3309.     }
  3310.     base = SP - stack_base;
  3311.     orig = s;
  3312.     if (pm->op_pmflags & PMf_SKIPWHITE) {
  3313.     while (isSPACE(*s))
  3314.         s++;
  3315.     }
  3316.     if (!limit)
  3317.     limit = maxiters + 2;
  3318.     if (pm->op_pmflags & PMf_WHITE) {
  3319.     while (--limit) {
  3320.         /*SUPPRESS 530*/
  3321.         for (m = s; m < strend && !isSPACE(*m); m++) ;
  3322.         if (m >= strend)
  3323.         break;
  3324.         dstr = NEWSV(30, m-s);
  3325.         sv_setpvn(dstr, s, m-s);
  3326.         if (!realarray)
  3327.         sv_2mortal(dstr);
  3328.         XPUSHs(dstr);
  3329.         /*SUPPRESS 530*/
  3330.         for (s = m + 1; s < strend && isSPACE(*s); s++) ;
  3331.     }
  3332.     }
  3333.     else if (strEQ("^", rx->precomp)) {
  3334.     while (--limit) {
  3335.         /*SUPPRESS 530*/
  3336.         for (m = s; m < strend && *m != '\n'; m++) ;
  3337.         m++;
  3338.         if (m >= strend)
  3339.         break;
  3340.         dstr = NEWSV(30, m-s);
  3341.         sv_setpvn(dstr, s, m-s);
  3342.         if (!realarray)
  3343.         sv_2mortal(dstr);
  3344.         XPUSHs(dstr);
  3345.         s = m;
  3346.     }
  3347.     }
  3348.     else if (pm->op_pmshort) {
  3349.     i = SvCUR(pm->op_pmshort);
  3350.     if (i == 1) {
  3351.         I32 fold = (pm->op_pmflags & PMf_FOLD);
  3352.         i = *SvPVX(pm->op_pmshort);
  3353.         if (fold && isUPPER(i))
  3354.         i = toLOWER(i);
  3355.         while (--limit) {
  3356.         if (fold) {
  3357.             for ( m = s;
  3358.               m < strend && *m != i &&
  3359.                 (!isUPPER(*m) || toLOWER(*m) != i);
  3360.               m++)            /*SUPPRESS 530*/
  3361.             ;
  3362.         }
  3363.         else                /*SUPPRESS 530*/
  3364.             for (m = s; m < strend && *m != i; m++) ;
  3365.         if (m >= strend)
  3366.             break;
  3367.         dstr = NEWSV(30, m-s);
  3368.         sv_setpvn(dstr, s, m-s);
  3369.         if (!realarray)
  3370.             sv_2mortal(dstr);
  3371.         XPUSHs(dstr);
  3372.         s = m + 1;
  3373.         }
  3374.     }
  3375.     else {
  3376. #ifndef lint
  3377.         while (s < strend && --limit &&
  3378.           (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
  3379.             pm->op_pmshort)) )
  3380. #endif
  3381.         {
  3382.         dstr = NEWSV(31, m-s);
  3383.         sv_setpvn(dstr, s, m-s);
  3384.         if (!realarray)
  3385.             sv_2mortal(dstr);
  3386.         XPUSHs(dstr);
  3387.         s = m + i;
  3388.         }
  3389.     }
  3390.     }
  3391.     else {
  3392.     maxiters += (strend - s) * rx->nparens;
  3393.     while (s < strend && --limit &&
  3394.         pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
  3395.         if (rx->subbase
  3396.           && rx->subbase != orig) {
  3397.         m = s;
  3398.         s = orig;
  3399.         orig = rx->subbase;
  3400.         s = orig + (m - s);
  3401.         strend = s + (strend - m);
  3402.         }
  3403.         m = rx->startp[0];
  3404.         dstr = NEWSV(32, m-s);
  3405.         sv_setpvn(dstr, s, m-s);
  3406.         if (!realarray)
  3407.         sv_2mortal(dstr);
  3408.         XPUSHs(dstr);
  3409.         if (rx->nparens) {
  3410.         for (i = 1; i <= rx->nparens; i++) {
  3411.             s = rx->startp[i];
  3412.             m = rx->endp[i];
  3413.             if (m && s) {
  3414.             dstr = NEWSV(33, m-s);
  3415.             sv_setpvn(dstr, s, m-s);
  3416.             }
  3417.             else
  3418.             dstr = NEWSV(33, 0);
  3419.             if (!realarray)
  3420.             sv_2mortal(dstr);
  3421.             XPUSHs(dstr);
  3422.         }
  3423.         }
  3424.         s = rx->endp[0];
  3425.     }
  3426.     }
  3427.     iters = (SP - stack_base) - base;
  3428.     if (iters > maxiters)
  3429.     DIE("Split loop");
  3430.     
  3431.     /* keep field after final delim? */
  3432.     if (s < strend || (iters && origlimit)) {
  3433.     dstr = NEWSV(34, strend-s);
  3434.     sv_setpvn(dstr, s, strend-s);
  3435.     if (!realarray)
  3436.         sv_2mortal(dstr);
  3437.     XPUSHs(dstr);
  3438.     iters++;
  3439.     }
  3440.     else if (!origlimit) {
  3441.     while (iters > 0 && SvCUR(TOPs) == 0)
  3442.         iters--, SP--;
  3443.     }
  3444.     if (realarray) {
  3445.     SWITCHSTACK(ary, oldstack);
  3446.     if (gimme == G_ARRAY) {
  3447.         EXTEND(SP, iters);
  3448.         Copy(AvARRAY(ary), SP + 1, iters, SV*);
  3449.         SP += iters;
  3450.         RETURN;
  3451.     }
  3452.     }
  3453.     else {
  3454.     if (gimme == G_ARRAY)
  3455.         RETURN;
  3456.     }
  3457.     if (iters || !pm->op_pmreplroot) {
  3458.     GETTARGET;
  3459.     PUSHi(iters);
  3460.     RETURN;
  3461.     }
  3462.     RETPUSHUNDEF;
  3463. }
  3464.  
  3465.