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