home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / utilities / cli / perl / !Perl / c / sv < prev    next >
Encoding:
Text File  |  1995-04-19  |  65.6 KB  |  3,432 lines
  1. /*    sv.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.  * "I wonder what the Entish is for 'yes' and 'no'," he thought.
  12.  */
  13.  
  14. #include "EXTERN.h"
  15. #include "perl.h"
  16.  
  17. /* The following is all to get DBL_DIG, in order to pick a nice
  18.    default value for printing floating point numbers in Gconvert.
  19.    (see config.h)
  20. */
  21. #ifdef I_LIMITS
  22. #include <limits.h>
  23. #endif
  24. #ifdef I_FLOAT
  25. #include <float.h>
  26. #endif
  27. #ifndef HAS_DBL_DIG
  28. #define DBL_DIG    15   /* A guess that works lots of places */
  29. #endif
  30.  
  31. static SV *more_sv _((void));
  32. static XPVIV *more_xiv _((void));
  33. static XPVNV *more_xnv _((void));
  34. static XPV *more_xpv _((void));
  35. static XRV *more_xrv _((void));
  36. static SV *new_sv _((void));
  37. static XPVIV *new_xiv _((void));
  38. static XPVNV *new_xnv _((void));
  39. static XPV *new_xpv _((void));
  40. static XRV *new_xrv _((void));
  41. static void del_xiv _((XPVIV* p));
  42. static void del_xnv _((XPVNV* p));
  43. static void del_xpv _((XPV* p));
  44. static void del_xrv _((XRV* p));
  45. static void sv_mortalgrow _((void));
  46.  
  47. static void sv_unglob _((SV* sv));
  48.  
  49. #ifdef PURIFY
  50.  
  51. #define new_SV() sv = (SV*)safemalloc(sizeof(SV))
  52. #define del_SV(p) free((char*)p)
  53.  
  54. #else
  55.  
  56. #define new_SV()            \
  57.     if (sv_root) {            \
  58.     sv = sv_root;            \
  59.     sv_root = (SV*)SvANY(sv);    \
  60.     ++sv_count;            \
  61.     }                    \
  62.     else                \
  63.     sv = more_sv();
  64.  
  65. static SV*
  66. new_sv()
  67. {
  68.     SV* sv;
  69.     if (sv_root) {
  70.     sv = sv_root;
  71.     sv_root = (SV*)SvANY(sv);
  72.     ++sv_count;
  73.     return sv;
  74.     }
  75.     return more_sv();
  76. }
  77.  
  78. #ifdef DEBUGGING
  79. #define del_SV(p)            \
  80.     if (debug & 32768)            \
  81.     del_sv(p);            \
  82.     else {                \
  83.     SvANY(p) = (void *)sv_root;    \
  84.     sv_root = p;            \
  85.     --sv_count;            \
  86.     }
  87.  
  88. static void
  89. del_sv(SV* p)
  90. {
  91.     if (debug & 32768) {
  92.     SV* sv;
  93.     SV* svend;
  94.     int ok = 0;
  95.     for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(svend)) {
  96.         svend = &sv[1008 / sizeof(SV)];
  97.         if (p >= sv && p < svend)
  98.         ok = 1;
  99.     }
  100.     if (!ok) {
  101.         warn("Attempt to free non-arena SV: 0x%lx", (unsigned long)p);
  102.         return;
  103.     }
  104.     }
  105.     SvANY(p) = (void *) sv_root;
  106.     sv_root = p;
  107.     --sv_count;
  108. }
  109. #else
  110. #define del_SV(p)            \
  111.     SvANY(p) = (void *)sv_root;        \
  112.     sv_root = p;            \
  113.     --sv_count;
  114.  
  115. #endif
  116.  
  117. static SV*
  118. more_sv()
  119. {
  120.     register SV* sv;
  121.     register SV* svend;
  122.     sv_root = (SV*)safemalloc(1012);
  123.     sv = sv_root;
  124.     Zero(sv, 1012, char);
  125.     svend = &sv[1008 / sizeof(SV) - 1];
  126.     while (sv < svend) {
  127.     SvANY(sv) = (void *)(SV*)(sv + 1);
  128.     SvFLAGS(sv) = SVTYPEMASK;
  129.     sv++;
  130.     }
  131.     SvANY(sv) = 0;
  132.     sv++;
  133.     SvANY(sv) = (void *) sv_arenaroot;
  134.     sv_arenaroot = sv_root;
  135.     return new_sv();
  136. }
  137. #endif
  138.  
  139. void
  140. sv_report_used()
  141. {
  142.     SV* sv;
  143.     register SV* svend;
  144.  
  145.     for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
  146.     svend = &sv[1008 / sizeof(SV)];
  147.     while (sv < svend) {
  148.         if (SvTYPE(sv) != SVTYPEMASK) {
  149.         fprintf(stderr, "****\n");
  150.         sv_dump(sv);
  151.         }
  152.         ++sv;
  153.     }
  154.     }
  155. }
  156.  
  157. void
  158. sv_clean_objs()
  159. {
  160.     register SV* sv;
  161.     register SV* svend;
  162.     SV* rv;
  163.  
  164.     for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
  165.     svend = &sv[1008 / sizeof(SV)];
  166.     while (sv < svend) {
  167.         if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
  168.         DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
  169.              sv_dump(sv));)
  170.         SvROK_off(sv);
  171.         SvRV(sv) = 0;
  172.         SvREFCNT_dec(rv);
  173.         }
  174.         /* XXX Might want to check arrays, etc. */
  175.         ++sv;
  176.     }
  177.     }
  178. }
  179.  
  180. void
  181. sv_clean_all()
  182. {
  183.     register SV* sv;
  184.     register SV* svend;
  185.  
  186.     for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
  187.     svend = &sv[1008 / sizeof(SV)];
  188.     while (sv < svend) {
  189.         if (SvTYPE(sv) != SVTYPEMASK) {
  190.         DEBUG_D((fprintf(stderr, "Cleaning loops:\n "), sv_dump(sv));)
  191.         SvFLAGS(sv) |= SVf_BREAK;
  192.         SvREFCNT_dec(sv);
  193.         }
  194.         ++sv;
  195.     }
  196.     }
  197. }
  198.  
  199. static XPVIV*
  200. new_xiv()
  201. {
  202.     IV** xiv;
  203.     if (xiv_root) {
  204.     xiv = xiv_root;
  205.     /*
  206.      * See comment in more_xiv() -- RAM.
  207.      */
  208.     xiv_root = (IV**)*xiv;
  209.     return (XPVIV*)((char*)xiv - sizeof(XPV));
  210.     }
  211.     return more_xiv();
  212. }
  213.  
  214. static void
  215. del_xiv(XPVIV* p)
  216. {
  217.     IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
  218.     *xiv = (IV *)xiv_root;
  219.     xiv_root = xiv;
  220. }
  221.  
  222. static XPVIV*
  223. more_xiv()
  224. {
  225.     register IV** xiv;
  226.     register IV** xivend;
  227.     XPV* ptr = (XPV*)safemalloc(1008);
  228.     ptr->xpv_pv = (char*)xiv_arenaroot;        /* linked list of xiv arenas */
  229.     xiv_arenaroot = ptr;            /* to keep Purify happy */
  230.  
  231.     xiv = (IV**) ptr;
  232.     xivend = &xiv[1008 / sizeof(IV *) - 1];
  233.     xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1;   /* fudge by size of XPV */
  234.     xiv_root = xiv;
  235.     while (xiv < xivend) {
  236.     *xiv = (IV *)(xiv + 1);
  237.     xiv++;
  238.     }
  239.     *xiv = 0;
  240.     return new_xiv();
  241. }
  242.  
  243. static XPVNV*
  244. new_xnv()
  245. {
  246.     double* xnv;
  247.     if (xnv_root) {
  248.     xnv = xnv_root;
  249.     xnv_root = *(double**)xnv;
  250.     return (XPVNV*)((char*)xnv - sizeof(XPVIV));
  251.     }
  252.     return more_xnv();
  253. }
  254.  
  255. static void
  256. del_xnv(XPVNV* p)
  257. {
  258.     double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
  259.     *(double**)xnv = xnv_root;
  260.     xnv_root = xnv;
  261. }
  262.  
  263. static XPVNV*
  264. more_xnv()
  265. {
  266.     register double* xnv;
  267.     register double* xnvend;
  268.     xnv = (double*)safemalloc(1008);
  269.     xnvend = &xnv[1008 / sizeof(double) - 1];
  270.     xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
  271.     xnv_root = xnv;
  272.     while (xnv < xnvend) {
  273.     *(double**)xnv = (double*)(xnv + 1);
  274.     xnv++;
  275.     }
  276.     *(double**)xnv = 0;
  277.     return new_xnv();
  278. }
  279.  
  280. static XRV*
  281. new_xrv()
  282. {
  283.     XRV* xrv;
  284.     if (xrv_root) {
  285.     xrv = xrv_root;
  286.     xrv_root = (XRV*)xrv->xrv_rv;
  287.     return xrv;
  288.     }
  289.     return more_xrv();
  290. }
  291.  
  292. static void
  293. del_xrv(XRV* p)
  294. {
  295.     p->xrv_rv = (SV*)xrv_root;
  296.     xrv_root = p;
  297. }
  298.  
  299. static XRV*
  300. more_xrv()
  301. {
  302.     register XRV* xrv;
  303.     register XRV* xrvend;
  304.     xrv_root = (XRV*)safemalloc(1008);
  305.     xrv = xrv_root;
  306.     xrvend = &xrv[1008 / sizeof(XRV) - 1];
  307.     while (xrv < xrvend) {
  308.     xrv->xrv_rv = (SV*)(xrv + 1);
  309.     xrv++;
  310.     }
  311.     xrv->xrv_rv = 0;
  312.     return new_xrv();
  313. }
  314.  
  315. static XPV*
  316. new_xpv()
  317. {
  318.     XPV* xpv;
  319.     if (xpv_root) {
  320.     xpv = xpv_root;
  321.     xpv_root = (XPV*)xpv->xpv_pv;
  322.     return xpv;
  323.     }
  324.     return more_xpv();
  325. }
  326.  
  327. static void
  328. del_xpv(XPV* p)
  329. {
  330.     p->xpv_pv = (char*)xpv_root;
  331.     xpv_root = p;
  332. }
  333.  
  334. static XPV*
  335. more_xpv()
  336. {
  337.     register XPV* xpv;
  338.     register XPV* xpvend;
  339.     xpv_root = (XPV*)safemalloc(1008);
  340.     xpv = xpv_root;
  341.     xpvend = &xpv[1008 / sizeof(XPV) - 1];
  342.     while (xpv < xpvend) {
  343.     xpv->xpv_pv = (char*)(xpv + 1);
  344.     xpv++;
  345.     }
  346.     xpv->xpv_pv = 0;
  347.     return new_xpv();
  348. }
  349.  
  350. #ifdef PURIFY
  351. #define new_XIV() (void*)safemalloc(sizeof(XPVIV))
  352. #define del_XIV(p) free((char*)p)
  353. #else
  354. #define new_XIV() (void*)new_xiv()
  355. #define del_XIV(p) del_xiv(p)
  356. #endif
  357.  
  358. #ifdef PURIFY
  359. #define new_XNV() (void*)safemalloc(sizeof(XPVNV))
  360. #define del_XNV(p) free((char*)p)
  361. #else
  362. #define new_XNV() (void*)new_xnv()
  363. #define del_XNV(p) del_xnv(p)
  364. #endif
  365.  
  366. #ifdef PURIFY
  367. #define new_XRV() (void*)safemalloc(sizeof(XRV))
  368. #define del_XRV(p) free((char*)p)
  369. #else
  370. #define new_XRV() (void*)new_xrv()
  371. #define del_XRV(p) del_xrv(p)
  372. #endif
  373.  
  374. #ifdef PURIFY
  375. #define new_XPV() (void*)safemalloc(sizeof(XPV))
  376. #define del_XPV(p) free((char*)p)
  377. #else
  378. #define new_XPV() (void*)new_xpv()
  379. #define del_XPV(p) del_xpv(p)
  380. #endif
  381.  
  382. #define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
  383. #define del_XPVIV(p) free((char*)p)
  384.  
  385. #define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
  386. #define del_XPVNV(p) free((char*)p)
  387.  
  388. #define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
  389. #define del_XPVMG(p) free((char*)p)
  390.  
  391. #define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
  392. #define del_XPVLV(p) free((char*)p)
  393.  
  394. #define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
  395. #define del_XPVAV(p) free((char*)p)
  396.  
  397. #define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
  398. #define del_XPVHV(p) free((char*)p)
  399.  
  400. #define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
  401. #define del_XPVCV(p) free((char*)p)
  402.  
  403. #define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
  404. #define del_XPVGV(p) free((char*)p)
  405.  
  406. #define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
  407. #define del_XPVBM(p) free((char*)p)
  408.  
  409. #define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
  410. #define del_XPVFM(p) free((char*)p)
  411.  
  412. #define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
  413. #define del_XPVIO(p) free((char*)p)
  414.  
  415. bool
  416. sv_upgrade(SV* sv,U32 mt)
  417. {
  418.     char*    pv;
  419.     U32        cur;
  420.     U32        len;
  421.     IV        iv;
  422.     double    nv;
  423.     MAGIC*    magic;
  424.     HV*        stash;
  425.  
  426.     if (SvTYPE(sv) == mt)
  427.     return TRUE;
  428.  
  429.     switch (SvTYPE(sv)) {
  430.     case SVt_NULL:
  431.     pv    = 0;
  432.     cur    = 0;
  433.     len    = 0;
  434.     iv    = 0;
  435.     nv    = 0.0;
  436.     magic    = 0;
  437.     stash    = 0;
  438.     break;
  439.     case SVt_IV:
  440.     pv    = 0;
  441.     cur    = 0;
  442.     len    = 0;
  443.     iv    = SvIVX(sv);
  444.     nv    = (double)SvIVX(sv);
  445.     del_XIV(SvANY(sv));
  446.     magic    = 0;
  447.     stash    = 0;
  448.     if (mt == SVt_NV)
  449.         mt = SVt_PVNV;
  450.     else if (mt < SVt_PVIV)
  451.         mt = SVt_PVIV;
  452.     break;
  453.     case SVt_NV:
  454.     pv    = 0;
  455.     cur    = 0;
  456.     len    = 0;
  457.     nv    = SvNVX(sv);
  458.     iv    = I_32(nv);
  459.     magic    = 0;
  460.     stash    = 0;
  461.     del_XNV(SvANY(sv));
  462.     SvANY(sv) = 0;
  463.     if (mt < SVt_PVNV)
  464.         mt = SVt_PVNV;
  465.     break;
  466.     case SVt_RV:
  467.     pv    = (char*)SvRV(sv);
  468.     cur    = 0;
  469.     len    = 0;
  470.     iv    = (IV)pv;
  471.     nv    = (double)(unsigned long)pv;
  472.     del_XRV(SvANY(sv));
  473.     magic    = 0;
  474.     stash    = 0;
  475.     break;
  476.     case SVt_PV:
  477.     nv = 0.0;
  478.     pv    = SvPVX(sv);
  479.     cur    = SvCUR(sv);
  480.     len    = SvLEN(sv);
  481.     iv    = 0;
  482.     nv    = 0.0;
  483.     magic    = 0;
  484.     stash    = 0;
  485.     del_XPV(SvANY(sv));
  486.     if (mt <= SVt_IV)
  487.         mt = SVt_PVIV;
  488.     else if (mt == SVt_NV)
  489.         mt = SVt_PVNV;
  490.     break;
  491.     case SVt_PVIV:
  492.     nv = 0.0;
  493.     pv    = SvPVX(sv);
  494.     cur    = SvCUR(sv);
  495.     len    = SvLEN(sv);
  496.     iv    = SvIVX(sv);
  497.     nv    = 0.0;
  498.     magic    = 0;
  499.     stash    = 0;
  500.     del_XPVIV(SvANY(sv));
  501.     break;
  502.     case SVt_PVNV:
  503.     nv = SvNVX(sv);
  504.     pv    = SvPVX(sv);
  505.     cur    = SvCUR(sv);
  506.     len    = SvLEN(sv);
  507.     iv    = SvIVX(sv);
  508.     nv    = SvNVX(sv);
  509.     magic    = 0;
  510.     stash    = 0;
  511.     del_XPVNV(SvANY(sv));
  512.     break;
  513.     case SVt_PVMG:
  514.     pv    = SvPVX(sv);
  515.     cur    = SvCUR(sv);
  516.     len    = SvLEN(sv);
  517.     iv    = SvIVX(sv);
  518.     nv    = SvNVX(sv);
  519.     magic    = SvMAGIC(sv);
  520.     stash    = SvSTASH(sv);
  521.     del_XPVMG(SvANY(sv));
  522.     break;
  523.     default:
  524.     croak("Can't upgrade that kind of scalar");
  525.     }
  526.  
  527.     switch (mt) {
  528.     case SVt_NULL:
  529.     croak("Can't upgrade to undef");
  530.     case SVt_IV:
  531.     SvANY(sv) = new_XIV();
  532.     SvIVX(sv)    = iv;
  533.     break;
  534.     case SVt_NV:
  535.     SvANY(sv) = new_XNV();
  536.     SvNVX(sv)    = nv;
  537.     break;
  538.     case SVt_RV:
  539.     SvANY(sv) = new_XRV();
  540.     SvRV(sv) = (SV*)pv;
  541.     break;
  542.     case SVt_PV:
  543.     SvANY(sv) = new_XPV();
  544.     SvPVX(sv)    = pv;
  545.     SvCUR(sv)    = cur;
  546.     SvLEN(sv)    = len;
  547.     break;
  548.     case SVt_PVIV:
  549.     SvANY(sv) = new_XPVIV();
  550.     SvPVX(sv)    = pv;
  551.     SvCUR(sv)    = cur;
  552.     SvLEN(sv)    = len;
  553.     SvIVX(sv)    = iv;
  554.     if (SvNIOK(sv))
  555.         (void)SvIOK_on(sv);
  556.     SvNOK_off(sv);
  557.     break;
  558.     case SVt_PVNV:
  559.     SvANY(sv) = new_XPVNV();
  560.     SvPVX(sv)    = pv;
  561.     SvCUR(sv)    = cur;
  562.     SvLEN(sv)    = len;
  563.     SvIVX(sv)    = iv;
  564.     SvNVX(sv)    = nv;
  565.     break;
  566.     case SVt_PVMG:
  567.     SvANY(sv) = new_XPVMG();
  568.     SvPVX(sv)    = pv;
  569.     SvCUR(sv)    = cur;
  570.     SvLEN(sv)    = len;
  571.     SvIVX(sv)    = iv;
  572.     SvNVX(sv)    = nv;
  573.     SvMAGIC(sv)    = magic;
  574.     SvSTASH(sv)    = stash;
  575.     break;
  576.     case SVt_PVLV:
  577.     SvANY(sv) = new_XPVLV();
  578.     SvPVX(sv)    = pv;
  579.     SvCUR(sv)    = cur;
  580.     SvLEN(sv)    = len;
  581.     SvIVX(sv)    = iv;
  582.     SvNVX(sv)    = nv;
  583.     SvMAGIC(sv)    = magic;
  584.     SvSTASH(sv)    = stash;
  585.     LvTARGOFF(sv)    = 0;
  586.     LvTARGLEN(sv)    = 0;
  587.     LvTARG(sv)    = 0;
  588.     LvTYPE(sv)    = 0;
  589.     break;
  590.     case SVt_PVAV:
  591.     SvANY(sv) = new_XPVAV();
  592.     if (pv)
  593.         Safefree(pv);
  594.     SvPVX(sv)    = 0;
  595.     AvMAX(sv)    = 0;
  596.     AvFILL(sv)    = 0;
  597.     SvIVX(sv)    = 0;
  598.     SvNVX(sv)    = 0.0;
  599.     SvMAGIC(sv)    = magic;
  600.     SvSTASH(sv)    = stash;
  601.     AvALLOC(sv)    = 0;
  602.     AvARYLEN(sv)    = 0;
  603.     AvFLAGS(sv)    = 0;
  604.     break;
  605.     case SVt_PVHV:
  606.     SvANY(sv) = new_XPVHV();
  607.     if (pv)
  608.         Safefree(pv);
  609.     SvPVX(sv)    = 0;
  610.     HvFILL(sv)    = 0;
  611.     HvMAX(sv)    = 0;
  612.     HvKEYS(sv)    = 0;
  613.     SvNVX(sv)    = 0.0;
  614.     SvMAGIC(sv)    = magic;
  615.     SvSTASH(sv)    = stash;
  616.     HvRITER(sv)    = 0;
  617.     HvEITER(sv)    = 0;
  618.     HvPMROOT(sv)    = 0;
  619.     HvNAME(sv)    = 0;
  620.     break;
  621.     case SVt_PVCV:
  622.     SvANY(sv) = new_XPVCV();
  623.     Zero(SvANY(sv), 1, XPVCV);
  624.     SvPVX(sv)    = pv;
  625.     SvCUR(sv)    = cur;
  626.     SvLEN(sv)    = len;
  627.     SvIVX(sv)    = iv;
  628.     SvNVX(sv)    = nv;
  629.     SvMAGIC(sv)    = magic;
  630.     SvSTASH(sv)    = stash;
  631.     break;
  632.     case SVt_PVGV:
  633.     SvANY(sv) = new_XPVGV();
  634.     SvPVX(sv)    = pv;
  635.     SvCUR(sv)    = cur;
  636.     SvLEN(sv)    = len;
  637.     SvIVX(sv)    = iv;
  638.     SvNVX(sv)    = nv;
  639.     SvMAGIC(sv)    = magic;
  640.     SvSTASH(sv)    = stash;
  641.     GvGP(sv)    = 0;
  642.     GvNAME(sv)    = 0;
  643.     GvNAMELEN(sv)    = 0;
  644.     GvSTASH(sv)    = 0;
  645.     break;
  646.     case SVt_PVBM:
  647.     SvANY(sv) = new_XPVBM();
  648.     SvPVX(sv)    = pv;
  649.     SvCUR(sv)    = cur;
  650.     SvLEN(sv)    = len;
  651.     SvIVX(sv)    = iv;
  652.     SvNVX(sv)    = nv;
  653.     SvMAGIC(sv)    = magic;
  654.     SvSTASH(sv)    = stash;
  655.     BmRARE(sv)    = 0;
  656.     BmUSEFUL(sv)    = 0;
  657.     BmPREVIOUS(sv)    = 0;
  658.     break;
  659.     case SVt_PVFM:
  660.     SvANY(sv) = new_XPVFM();
  661.     Zero(SvANY(sv), 1, XPVFM);
  662.     SvPVX(sv)    = pv;
  663.     SvCUR(sv)    = cur;
  664.     SvLEN(sv)    = len;
  665.     SvIVX(sv)    = iv;
  666.     SvNVX(sv)    = nv;
  667.     SvMAGIC(sv)    = magic;
  668.     SvSTASH(sv)    = stash;
  669.     break;
  670.     case SVt_PVIO:
  671.     SvANY(sv) = new_XPVIO();
  672.     Zero(SvANY(sv), 1, XPVIO);
  673.     SvPVX(sv)    = pv;
  674.     SvCUR(sv)    = cur;
  675.     SvLEN(sv)    = len;
  676.     SvIVX(sv)    = iv;
  677.     SvNVX(sv)    = nv;
  678.     SvMAGIC(sv)    = magic;
  679.     SvSTASH(sv)    = stash;
  680.     IoPAGE_LEN(sv)    = 60;
  681.     break;
  682.     }
  683.     SvFLAGS(sv) &= ~SVTYPEMASK;
  684.     SvFLAGS(sv) |= mt;
  685.     return TRUE;
  686. }
  687.  
  688. #ifdef DEBUGGING
  689. char *
  690. sv_peek(sv)
  691. register SV *sv;
  692. {
  693.     char *t = tokenbuf;
  694.     int unref = 0;
  695.  
  696.   retry:
  697.     if (!sv) {
  698.     strcpy(t, "VOID");
  699.     goto finish;
  700.     }
  701.     else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
  702.     strcpy(t, "WILD");
  703.     goto finish;
  704.     }
  705.     else if (sv == &sv_undef || sv == &sv_no || sv == &sv_yes) {
  706.     if (sv == &sv_undef) {
  707.         strcpy(t, "SV_UNDEF");
  708.         if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
  709.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  710.         SvREADONLY(sv))
  711.         goto finish;
  712.     }
  713.     else if (sv == &sv_no) {
  714.         strcpy(t, "SV_NO");
  715.         if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
  716.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  717.         !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
  718.                   SVp_POK|SVp_NOK)) &&
  719.         SvCUR(sv) == 0 &&
  720.         SvNVX(sv) == 0.0)
  721.         goto finish;
  722.     }
  723.     else {
  724.         strcpy(t, "SV_YES");
  725.         if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
  726.                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
  727.         !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
  728.                   SVp_POK|SVp_NOK)) &&
  729.         SvCUR(sv) == 1 &&
  730.         SvPVX(sv) && *SvPVX(sv) == '1' &&
  731.         SvNVX(sv) == 1.0)
  732.         goto finish;
  733.     }
  734.     t += strlen(t);
  735.     *t++ = ':';
  736.     }
  737.     else if (SvREFCNT(sv) == 0) {
  738.     *t++ = '(';
  739.     unref++;
  740.     }
  741.     if (SvROK(sv)) {
  742.     *t++ = '\\';
  743.     if (t - tokenbuf + unref > 10) {
  744.         strcpy(tokenbuf + unref + 3,"...");
  745.         goto finish;
  746.     }
  747.     sv = (SV*)SvRV(sv);
  748.     goto retry;
  749.     }
  750.     switch (SvTYPE(sv)) {
  751.     default:
  752.     strcpy(t,"FREED");
  753.     goto finish;
  754.  
  755.     case SVt_NULL:
  756.     strcpy(t,"UNDEF");
  757.     return tokenbuf;
  758.     case SVt_IV:
  759.     strcpy(t,"IV");
  760.     break;
  761.     case SVt_NV:
  762.     strcpy(t,"NV");
  763.     break;
  764.     case SVt_RV:
  765.     strcpy(t,"RV");
  766.     break;
  767.     case SVt_PV:
  768.     strcpy(t,"PV");
  769.     break;
  770.     case SVt_PVIV:
  771.     strcpy(t,"PVIV");
  772.     break;
  773.     case SVt_PVNV:
  774.     strcpy(t,"PVNV");
  775.     break;
  776.     case SVt_PVMG:
  777.     strcpy(t,"PVMG");
  778.     break;
  779.     case SVt_PVLV:
  780.     strcpy(t,"PVLV");
  781.     break;
  782.     case SVt_PVAV:
  783.     strcpy(t,"AV");
  784.     break;
  785.     case SVt_PVHV:
  786.     strcpy(t,"HV");
  787.     break;
  788.     case SVt_PVCV:
  789.     if (CvGV(sv))
  790.         sprintf(t, "CV(%s)", GvNAME(CvGV(sv)));
  791.     else
  792.         strcpy(t, "CV()");
  793.     goto finish;
  794.     case SVt_PVGV:
  795.     strcpy(t,"GV");
  796.     break;
  797.     case SVt_PVBM:
  798.     strcpy(t,"BM");
  799.     break;
  800.     case SVt_PVFM:
  801.     strcpy(t,"FM");
  802.     break;
  803.     case SVt_PVIO:
  804.     strcpy(t,"IO");
  805.     break;
  806.     }
  807.     t += strlen(t);
  808.  
  809.     if (SvPOKp(sv)) {
  810.     if (!SvPVX(sv))
  811.         strcpy(t, "(null)");
  812.     if (SvOOK(sv))
  813.         sprintf(t,"(%ld+\"%.127s\")",(long)SvIVX(sv),SvPVX(sv));
  814.     else
  815.         sprintf(t,"(\"%.127s\")",SvPVX(sv));
  816.     }
  817.     else if (SvNOKp(sv))
  818.     sprintf(t,"(%g)",SvNVX(sv));
  819.     else if (SvIOKp(sv))
  820.     sprintf(t,"(%ld)",(long)SvIVX(sv));
  821.     else
  822.     strcpy(t,"()");
  823.     
  824.   finish:
  825.     if (unref) {
  826.     t += strlen(t);
  827.     while (unref--)
  828.         *t++ = ')';
  829.     *t = '\0';
  830.     }
  831.     return tokenbuf;
  832. }
  833. #endif
  834.  
  835. int
  836. sv_backoff(sv)
  837. register SV *sv;
  838. {
  839.     assert(SvOOK(sv));
  840.     if (SvIVX(sv)) {
  841.     char *s = SvPVX(sv);
  842.     SvLEN(sv) += SvIVX(sv);
  843.     SvPVX(sv) -= SvIVX(sv);
  844.     SvIV_set(sv, 0);
  845.     Move(s, SvPVX(sv), SvCUR(sv)+1, char);
  846.     }
  847.     SvFLAGS(sv) &= ~SVf_OOK;
  848.     return 0;
  849. }
  850.  
  851. char *
  852. sv_grow(register SV *sv,register I32 newlen)
  853. {
  854.     register char *s;
  855.  
  856. #ifdef MSDOS
  857.     if (newlen >= 0x10000) {
  858.     fprintf(stderr, "Allocation too large: %lx\n", newlen);
  859.     my_exit(1);
  860.     }
  861. #endif /* MSDOS */
  862.     if (SvROK(sv))
  863.     sv_unref(sv);
  864.     if (SvTYPE(sv) < SVt_PV) {
  865.     sv_upgrade(sv, SVt_PV);
  866.     s = SvPVX(sv);
  867.     }
  868.     else if (SvOOK(sv)) {    /* pv is offset? */
  869.     sv_backoff(sv);
  870.     s = SvPVX(sv);
  871.     if (newlen > SvLEN(sv))
  872.         newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
  873.     }
  874.     else
  875.     s = SvPVX(sv);
  876.     if (newlen > SvLEN(sv)) {        /* need more room? */
  877.         if (SvLEN(sv) && s)
  878.         Renew(s,newlen,char);
  879.         else
  880.         New(703,s,newlen,char);
  881.     SvPV_set(sv, s);
  882.         SvLEN_set(sv, newlen);
  883.     }
  884.     return s;
  885. }
  886.  
  887. void
  888. sv_setiv(sv,i)
  889. register SV *sv;
  890. IV i;
  891. {
  892.     if (SvTHINKFIRST(sv)) {
  893.     if (SvREADONLY(sv) && curcop != &compiling)
  894.         croak(no_modify);
  895.     if (SvROK(sv))
  896.         sv_unref(sv);
  897.     }
  898.     switch (SvTYPE(sv)) {
  899.     case SVt_NULL:
  900.     sv_upgrade(sv, SVt_IV);
  901.     break;
  902.     case SVt_NV:
  903.     sv_upgrade(sv, SVt_PVNV);
  904.     break;
  905.     case SVt_RV:
  906.     case SVt_PV:
  907.     sv_upgrade(sv, SVt_PVIV);
  908.     break;
  909.  
  910.     case SVt_PVGV:
  911.     if (SvFAKE(sv)) {
  912.         sv_unglob(sv);
  913.         break;
  914.     }
  915.     /* FALL THROUGH */
  916.     case SVt_PVAV:
  917.     case SVt_PVHV:
  918.     case SVt_PVCV:
  919.     case SVt_PVFM:
  920.     case SVt_PVIO:
  921.     croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
  922.         op_name[op->op_type]);
  923.     }
  924.     SvIVX(sv) = i;
  925.     (void)SvIOK_only(sv);            /* validate number */
  926.     SvTAINT(sv);
  927. }
  928.  
  929. void
  930. sv_setnv(sv,num)
  931. register SV *sv;
  932. double num;
  933. {
  934.     if (SvTHINKFIRST(sv)) {
  935.     if (SvREADONLY(sv) && curcop != &compiling)
  936.         croak(no_modify);
  937.     if (SvROK(sv))
  938.         sv_unref(sv);
  939.     }
  940.     switch (SvTYPE(sv)) {
  941.     case SVt_NULL:
  942.     case SVt_IV:
  943.     sv_upgrade(sv, SVt_NV);
  944.     break;
  945.     case SVt_NV:
  946.     case SVt_RV:
  947.     case SVt_PV:
  948.     case SVt_PVIV:
  949.     sv_upgrade(sv, SVt_PVNV);
  950.     /* FALL THROUGH */
  951.     case SVt_PVNV:
  952.     case SVt_PVMG:
  953.     case SVt_PVBM:
  954.     case SVt_PVLV:
  955.     if (SvOOK(sv))
  956.         (void)SvOOK_off(sv);
  957.     break;
  958.     case SVt_PVGV:
  959.     if (SvFAKE(sv)) {
  960.         sv_unglob(sv);
  961.         break;
  962.     }
  963.     /* FALL THROUGH */
  964.     case SVt_PVAV:
  965.     case SVt_PVHV:
  966.     case SVt_PVCV:
  967.     case SVt_PVFM:
  968.     case SVt_PVIO:
  969.     croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
  970.         op_name[op->op_type]);
  971.     }
  972.     SvNVX(sv) = num;
  973.     (void)SvNOK_only(sv);            /* validate number */
  974.     SvTAINT(sv);
  975. }
  976.  
  977. static void
  978. not_a_number(sv)
  979. SV *sv;
  980. {
  981.     char tmpbuf[64];
  982.     char *d = tmpbuf;
  983.     char *s;
  984.     int i;
  985.  
  986.     for (s = SvPVX(sv), i = 50; *s && i; s++,i--) {
  987.     int ch = *s;
  988.     if (ch & 128 && !isprint(ch)) {
  989.         *d++ = 'M';
  990.         *d++ = '-';
  991.         ch &= 127;
  992.     }
  993.     if (isprint(ch))
  994.         *d++ = ch;
  995.     else {
  996.         *d++ = '^';
  997.         *d++ = ch ^ 64;
  998.     }
  999.     }
  1000.     if (*s) {
  1001.     *d++ = '.';
  1002.     *d++ = '.';
  1003.     *d++ = '.';
  1004.     }
  1005.     *d = '\0';
  1006.  
  1007.     if (op)
  1008.     warn("Argument \"%s\" isn't numeric for %s", tmpbuf,
  1009.         op_name[op->op_type]);
  1010.     else
  1011.     warn("Argument \"%s\" isn't numeric", tmpbuf);
  1012. }
  1013.  
  1014. IV
  1015. sv_2iv(sv)
  1016. register SV *sv;
  1017. {
  1018.     if (!sv)
  1019.     return 0;
  1020.     if (SvGMAGICAL(sv)) {
  1021.     mg_get(sv);
  1022.     if (SvIOKp(sv))
  1023.         return SvIVX(sv);
  1024.     if (SvNOKp(sv)) {
  1025.         if (SvNVX(sv) < 0.0)
  1026.         return I_V(SvNVX(sv));
  1027.         else
  1028.         return (IV)(UV)SvNVX(sv);
  1029.     }
  1030.     if (SvPOKp(sv) && SvLEN(sv)) {
  1031.         if (dowarn && !looks_like_number(sv))
  1032.         not_a_number(sv);
  1033.         return (IV)atol(SvPVX(sv));
  1034.     }
  1035.     return 0;
  1036.     }
  1037.     if (SvTHINKFIRST(sv)) {
  1038.     if (SvROK(sv)) {
  1039. #ifdef OVERLOAD
  1040.       SV* tmpstr;
  1041.       if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
  1042.         return SvIV(tmpstr);
  1043. #endif /* OVERLOAD */
  1044.       return (IV)SvRV(sv);
  1045.     }
  1046.     if (SvREADONLY(sv)) {
  1047.         if (SvNOKp(sv)) {
  1048.         if (SvNVX(sv) < 0.0)
  1049.             return I_V(SvNVX(sv));
  1050.         else
  1051.             return (IV)(UV)SvNVX(sv);
  1052.         }
  1053.         if (SvPOKp(sv) && SvLEN(sv)) {
  1054.         if (dowarn && !looks_like_number(sv))
  1055.             not_a_number(sv);
  1056.         return (IV)atol(SvPVX(sv));
  1057.         }
  1058.         if (dowarn)
  1059.         warn(warn_uninit);
  1060.         return 0;
  1061.     }
  1062.     }
  1063.     switch (SvTYPE(sv)) {
  1064.     case SVt_NULL:
  1065.     sv_upgrade(sv, SVt_IV);
  1066.     return SvIVX(sv);
  1067.     case SVt_PV:
  1068.     sv_upgrade(sv, SVt_PVIV);
  1069.     break;
  1070.     case SVt_NV:
  1071.     sv_upgrade(sv, SVt_PVNV);
  1072.     break;
  1073.     }
  1074.     if (SvNOKp(sv)) {
  1075.     if (SvNVX(sv) < 0.0)
  1076.         SvIVX(sv) = I_V(SvNVX(sv));
  1077.     else
  1078.         SvIVX(sv) = (IV)(UV)SvNVX(sv);
  1079.     }
  1080.     else if (SvPOKp(sv) && SvLEN(sv)) {
  1081.     if (dowarn && !looks_like_number(sv))
  1082.         not_a_number(sv);
  1083.     SvIVX(sv) = (IV)atol(SvPVX(sv));
  1084.     }
  1085.     else  {
  1086.     if (dowarn && !localizing)
  1087.         warn(warn_uninit);
  1088.     return 0;
  1089.     }
  1090.     (void)SvIOK_on(sv);
  1091.     DEBUG_c(fprintf(stderr,"0x%lx 2iv(%ld)\n",
  1092.     (unsigned long)sv,(long)SvIVX(sv)));
  1093.     return SvIVX(sv);
  1094. }
  1095.  
  1096. double
  1097. sv_2nv(sv)
  1098. register SV *sv;
  1099. {
  1100.     if (!sv)
  1101.     return 0.0;
  1102.     if (SvGMAGICAL(sv)) {
  1103.     mg_get(sv);
  1104.     if (SvNOKp(sv))
  1105.         return SvNVX(sv);
  1106.     if (SvPOKp(sv) && SvLEN(sv)) {
  1107.         if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1108.         not_a_number(sv);
  1109.         return atof(SvPVX(sv));
  1110.     }
  1111.     if (SvIOKp(sv))
  1112.         return (double)SvIVX(sv);
  1113.     return 0;
  1114.     }
  1115.     if (SvTHINKFIRST(sv)) {
  1116.     if (SvROK(sv)) {
  1117. #ifdef OVERLOAD
  1118.       SV* tmpstr;
  1119.       if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
  1120.         return SvNV(tmpstr);
  1121. #endif /* OVERLOAD */
  1122.       return (double)(unsigned long)SvRV(sv);
  1123.     }
  1124.     if (SvREADONLY(sv)) {
  1125.         if (SvPOKp(sv) && SvLEN(sv)) {
  1126.         if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1127.             not_a_number(sv);
  1128.         return atof(SvPVX(sv));
  1129.         }
  1130.         if (SvIOKp(sv))
  1131.         return (double)SvIVX(sv);
  1132.         if (dowarn)
  1133.         warn(warn_uninit);
  1134.         return 0.0;
  1135.     }
  1136.     }
  1137.     if (SvTYPE(sv) < SVt_NV) {
  1138.     if (SvTYPE(sv) == SVt_IV)
  1139.         sv_upgrade(sv, SVt_PVNV);
  1140.     else
  1141.         sv_upgrade(sv, SVt_NV);
  1142.     DEBUG_c(fprintf(stderr,"0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
  1143.     }
  1144.     else if (SvTYPE(sv) < SVt_PVNV)
  1145.     sv_upgrade(sv, SVt_PVNV);
  1146.     if (SvIOKp(sv) &&
  1147.         (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
  1148.     {
  1149.     SvNVX(sv) = (double)SvIVX(sv);
  1150.     }
  1151.     else if (SvPOKp(sv) && SvLEN(sv)) {
  1152.     if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
  1153.         not_a_number(sv);
  1154.     SvNVX(sv) = atof(SvPVX(sv));
  1155.     }
  1156.     else  {
  1157.     if (dowarn && !localizing)
  1158.         warn(warn_uninit);
  1159.     return 0.0;
  1160.     }
  1161.     SvNOK_on(sv);
  1162.     DEBUG_c(fprintf(stderr,"0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
  1163.     return SvNVX(sv);
  1164. }
  1165.  
  1166. char *
  1167. sv_2pv(sv, lp)
  1168. register SV *sv;
  1169. STRLEN *lp;
  1170. {
  1171.     register char *s;
  1172.     int olderrno;
  1173.  
  1174.     if (!sv) {
  1175.     *lp = 0;
  1176.     return "";
  1177.     }
  1178.     if (SvGMAGICAL(sv)) {
  1179.     mg_get(sv);
  1180.     if (SvPOKp(sv)) {
  1181.         *lp = SvCUR(sv);
  1182.         return SvPVX(sv);
  1183.     }
  1184.     if (SvIOKp(sv)) {
  1185.         (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
  1186.         goto tokensave;
  1187.     }
  1188.     if (SvNOKp(sv)) {
  1189.         Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
  1190.         goto tokensave;
  1191.     }
  1192.     *lp = 0;
  1193.     return "";
  1194.     }
  1195.     if (SvTHINKFIRST(sv)) {
  1196.     if (SvROK(sv)) {
  1197. #ifdef OVERLOAD
  1198.         SV* tmpstr;
  1199.         if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)))
  1200.           return SvPV(tmpstr,*lp);
  1201. #endif /* OVERLOAD */
  1202.         sv = (SV*)SvRV(sv);
  1203.         if (!sv)
  1204.         s = "NULLREF";
  1205.         else {
  1206.         switch (SvTYPE(sv)) {
  1207.         case SVt_NULL:
  1208.         case SVt_IV:
  1209.         case SVt_NV:
  1210.         case SVt_RV:
  1211.         case SVt_PV:
  1212.         case SVt_PVIV:
  1213.         case SVt_PVNV:
  1214.         case SVt_PVBM:
  1215.         case SVt_PVMG:    s = "SCALAR";            break;
  1216.         case SVt_PVLV:    s = "LVALUE";            break;
  1217.         case SVt_PVAV:    s = "ARRAY";            break;
  1218.         case SVt_PVHV:    s = "HASH";            break;
  1219.         case SVt_PVCV:    s = "CODE";            break;
  1220.         case SVt_PVGV:    s = "GLOB";            break;
  1221.         case SVt_PVFM:    s = "FORMATLINE";        break;
  1222.         case SVt_PVIO:    s = "FILEHANDLE";        break;
  1223.         default:    s = "UNKNOWN";            break;
  1224.         }
  1225.         if (SvOBJECT(sv))
  1226.             sprintf(tokenbuf, "%s=%s(0x%lx)",
  1227.                 HvNAME(SvSTASH(sv)), s, (unsigned long)sv);
  1228.         else
  1229.             sprintf(tokenbuf, "%s(0x%lx)", s, (unsigned long)sv);
  1230.         goto tokensaveref;
  1231.         }
  1232.         *lp = strlen(s);
  1233.         return s;
  1234.     }
  1235.     if (SvREADONLY(sv)) {
  1236.         if (SvIOKp(sv)) {
  1237.         (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
  1238.         goto tokensave;
  1239.         }
  1240.         if (SvNOKp(sv)) {
  1241.         Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
  1242.         goto tokensave;
  1243.         }
  1244.         if (dowarn)
  1245.         warn(warn_uninit);
  1246.         *lp = 0;
  1247.         return "";
  1248.     }
  1249.     }
  1250.     if (!SvUPGRADE(sv, SVt_PV))
  1251.     return 0;
  1252.     if (SvNOKp(sv)) {
  1253.     if (SvTYPE(sv) < SVt_PVNV)
  1254.         sv_upgrade(sv, SVt_PVNV);
  1255.     SvGROW(sv, 28);
  1256.     s = SvPVX(sv);
  1257.     olderrno = errno;    /* some Xenix systems wipe out errno here */
  1258. #ifdef apollo
  1259.     if (SvNVX(sv) == 0.0)
  1260.         (void)strcpy(s,"0");
  1261.     else
  1262. #endif /*apollo*/
  1263.         Gconvert(SvNVX(sv), DBL_DIG, 0, s);
  1264.     errno = olderrno;
  1265. #ifdef FIXNEGATIVEZERO
  1266.         if (*s == '-' && s[1] == '0' && !s[2])
  1267.         strcpy(s,"0");
  1268. #endif
  1269.     while (*s) s++;
  1270. #ifdef hcx
  1271.     if (s[-1] == '.')
  1272.         s--;
  1273. #endif
  1274.     }
  1275.     else if (SvIOKp(sv)) {
  1276.     if (SvTYPE(sv) < SVt_PVIV)
  1277.         sv_upgrade(sv, SVt_PVIV);
  1278.     SvGROW(sv, 11);
  1279.     s = SvPVX(sv);
  1280.     olderrno = errno;    /* some Xenix systems wipe out errno here */
  1281.     (void)sprintf(s,"%ld",(long)SvIVX(sv));
  1282.     errno = olderrno;
  1283.     while (*s) s++;
  1284.     }
  1285.     else {
  1286.     if (dowarn && !localizing)
  1287.         warn(warn_uninit);
  1288.     *lp = 0;
  1289.     return "";
  1290.     }
  1291.     *s = '\0';
  1292.     *lp = s - SvPVX(sv);
  1293.     SvCUR_set(sv, *lp);
  1294.     SvPOK_on(sv);
  1295.     DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv)));
  1296.     return SvPVX(sv);
  1297.  
  1298.   tokensave:
  1299.     if (SvROK(sv)) {    /* XXX Skip this when sv_pvn_force calls */
  1300.     /* Sneaky stuff here */
  1301.  
  1302.       tokensaveref:
  1303.     sv = sv_newmortal();
  1304.     *lp = strlen(tokenbuf);
  1305.     sv_setpvn(sv, tokenbuf, *lp);
  1306.     return SvPVX(sv);
  1307.     }
  1308.     else {
  1309.     STRLEN len;
  1310.     
  1311. #ifdef FIXNEGATIVEZERO
  1312.     if (*tokenbuf == '-' && tokenbuf[1] == '0' && !tokenbuf[2])
  1313.         strcpy(tokenbuf,"0");
  1314. #endif
  1315.     (void)SvUPGRADE(sv, SVt_PV);
  1316.     len = *lp = strlen(tokenbuf);
  1317.     s = SvGROW(sv, len + 1);
  1318.     SvCUR_set(sv, len);
  1319.     (void)strcpy(s, tokenbuf);
  1320.     /* NO SvPOK_on(sv) here! */
  1321.     return s;
  1322.     }
  1323. }
  1324.  
  1325. /* This function is only called on magical items */
  1326. bool
  1327. sv_2bool(sv)
  1328. register SV *sv;
  1329. {
  1330.     if (SvGMAGICAL(sv))
  1331.     mg_get(sv);
  1332.  
  1333.     if (!SvOK(sv))
  1334.     return 0;
  1335.     if (SvROK(sv)) {
  1336. #ifdef OVERLOAD
  1337.       {
  1338.     SV* tmpsv;
  1339.     if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
  1340.       return SvTRUE(tmpsv);
  1341.       }
  1342. #endif /* OVERLOAD */
  1343.       return SvRV(sv) != 0;
  1344.     }
  1345.     if (SvPOKp(sv)) {
  1346.     register XPV* Xpv;
  1347.     if ((Xpv = (XPV*)SvANY(sv)) &&
  1348.         (*Xpv->xpv_pv > '0' ||
  1349.         Xpv->xpv_cur > 1 ||
  1350.         (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
  1351.         return 1;
  1352.     else
  1353.         return 0;
  1354.     }
  1355.     else {
  1356.     if (SvIOKp(sv))
  1357.         return SvIVX(sv) != 0;
  1358.     else {
  1359.         if (SvNOKp(sv))
  1360.         return SvNVX(sv) != 0.0;
  1361.         else
  1362.         return FALSE;
  1363.     }
  1364.     }
  1365. }
  1366.  
  1367. /* Note: sv_setsv() should not be called with a source string that needs
  1368.  * to be reused, since it may destroy the source string if it is marked
  1369.  * as temporary.
  1370.  */
  1371.  
  1372. void
  1373. sv_setsv(dstr,sstr)
  1374. SV *dstr;
  1375. register SV *sstr;
  1376. {
  1377.     register U32 sflags;
  1378.     register int dtype;
  1379.     register int stype;
  1380.  
  1381.     if (sstr == dstr)
  1382.     return;
  1383.     if (SvTHINKFIRST(dstr)) {
  1384.     if (SvREADONLY(dstr) && curcop != &compiling)
  1385.         croak(no_modify);
  1386.     if (SvROK(dstr))
  1387.         sv_unref(dstr);
  1388.     }
  1389.     if (!sstr)
  1390.     sstr = &sv_undef;
  1391.     stype = SvTYPE(sstr);
  1392.     dtype = SvTYPE(dstr);
  1393.  
  1394. #ifdef OVERLOAD
  1395.     SvAMAGIC_off(dstr);
  1396. #endif /* OVERLOAD */
  1397.     /* There's a lot of redundancy below but we're going for speed here */
  1398.  
  1399.     switch (stype) {
  1400.     case SVt_NULL:
  1401.     (void)SvOK_off(dstr);
  1402.     return;
  1403.     case SVt_IV:
  1404.     if (dtype <= SVt_PV) {
  1405.         if (dtype < SVt_IV)
  1406.         sv_upgrade(dstr, SVt_IV);
  1407.         else if (dtype == SVt_NV)
  1408.         sv_upgrade(dstr, SVt_PVNV);
  1409.         else if (dtype <= SVt_PV)
  1410.         sv_upgrade(dstr, SVt_PVIV);
  1411.     }
  1412.     break;
  1413.     case SVt_NV:
  1414.     if (dtype <= SVt_PVIV) {
  1415.         if (dtype < SVt_NV)
  1416.         sv_upgrade(dstr, SVt_NV);
  1417.         else if (dtype == SVt_PVIV)
  1418.         sv_upgrade(dstr, SVt_PVNV);
  1419.         else if (dtype <= SVt_PV)
  1420.         sv_upgrade(dstr, SVt_PVNV);
  1421.     }
  1422.     break;
  1423.     case SVt_RV:
  1424.     if (dtype < SVt_RV)
  1425.         sv_upgrade(dstr, SVt_RV);
  1426.     break;
  1427.     case SVt_PV:
  1428.     if (dtype < SVt_PV)
  1429.         sv_upgrade(dstr, SVt_PV);
  1430.     break;
  1431.     case SVt_PVIV:
  1432.     if (dtype < SVt_PVIV)
  1433.         sv_upgrade(dstr, SVt_PVIV);
  1434.     break;
  1435.     case SVt_PVNV:
  1436.     if (dtype < SVt_PVNV)
  1437.         sv_upgrade(dstr, SVt_PVNV);
  1438.     break;
  1439.     case SVt_PVGV:
  1440.     if (dtype <= SVt_PVGV) {
  1441.         if (dtype < SVt_PVGV) {
  1442.         char *name = GvNAME(sstr);
  1443.         STRLEN len = GvNAMELEN(sstr);
  1444.         sv_upgrade(dstr, SVt_PVGV);
  1445.         sv_magic(dstr, dstr, '*', name, len);
  1446.         GvSTASH(dstr) = GvSTASH(sstr);
  1447.         GvNAME(dstr) = savepvn(name, len);
  1448.         GvNAMELEN(dstr) = len;
  1449.         SvFAKE_on(dstr);    /* can coerce to non-glob */
  1450.         }
  1451.         (void)SvOK_off(dstr);
  1452.         if (!GvAV(sstr))
  1453.         gv_AVadd(sstr);
  1454.         if (!GvHV(sstr))
  1455.         gv_HVadd(sstr);
  1456.         if (!GvIO(sstr))
  1457.         gv_IOadd(sstr);
  1458.         if (GvGP(dstr))
  1459.         gp_free(dstr);
  1460.         GvGP(dstr) = gp_ref(GvGP(sstr));
  1461.         SvTAINT(dstr);
  1462.         GvFLAGS(dstr) &= ~GVf_INTRO;    /* one-shot flag */
  1463.         SvMULTI_on(dstr);
  1464.         return;
  1465.     }
  1466.     /* FALL THROUGH */
  1467.  
  1468.     default:
  1469.     if (dtype < stype)
  1470.         sv_upgrade(dstr, stype);
  1471.     if (SvGMAGICAL(sstr))
  1472.         mg_get(sstr);
  1473.     }
  1474.  
  1475.     sflags = SvFLAGS(sstr);
  1476.  
  1477.     if (sflags & SVf_ROK) {
  1478.     if (dtype >= SVt_PV) {
  1479.         if (dtype == SVt_PVGV) {
  1480.         SV *sref = SvREFCNT_inc(SvRV(sstr));
  1481.         SV *dref = 0;
  1482.         int intro = GvFLAGS(dstr) & GVf_INTRO;
  1483.  
  1484.         if (intro) {
  1485.             GP *gp;
  1486.             GvGP(dstr)->gp_refcnt--;
  1487.             Newz(602,gp, 1, GP);
  1488.             GvGP(dstr) = gp;
  1489.             GvREFCNT(dstr) = 1;
  1490.             GvSV(dstr) = NEWSV(72,0);
  1491.             GvLINE(dstr) = curcop->cop_line;
  1492.             GvEGV(dstr) = dstr;
  1493.             GvFLAGS(dstr) &= ~GVf_INTRO;    /* one-shot flag */
  1494.         }
  1495.         SvMULTI_on(dstr);
  1496.         switch (SvTYPE(sref)) {
  1497.         case SVt_PVAV:
  1498.             if (intro)
  1499.             SAVESPTR(GvAV(dstr));
  1500.             else
  1501.             dref = (SV*)GvAV(dstr);
  1502.             GvAV(dstr) = (AV*)sref;
  1503.             break;
  1504.         case SVt_PVHV:
  1505.             if (intro)
  1506.             SAVESPTR(GvHV(dstr));
  1507.             else
  1508.             dref = (SV*)GvHV(dstr);
  1509.             GvHV(dstr) = (HV*)sref;
  1510.             break;
  1511.         case SVt_PVCV:
  1512.             if (intro)
  1513.             SAVESPTR(GvCV(dstr));
  1514.             else {
  1515.             CV* cv = GvCV(dstr);
  1516.             dref = (SV*)cv;
  1517.             if (dowarn && cv && sref != dref &&
  1518.                 !GvCVGEN((GV*)dstr) &&
  1519.                 (CvROOT(cv) || CvXSUB(cv)) )
  1520.                 warn("Subroutine %s redefined", GvENAME((GV*)dstr));
  1521.             }
  1522.             GvFLAGS(dstr) |= GVf_IMPORTED;
  1523.             GvCV(dstr) = (CV*)sref;
  1524.             break;
  1525.         default:
  1526.             if (intro)
  1527.             SAVESPTR(GvSV(dstr));
  1528.             else
  1529.             dref = (SV*)GvSV(dstr);
  1530.             GvSV(dstr) = sref;
  1531.             break;
  1532.         }
  1533.         if (dref)
  1534.             SvREFCNT_dec(dref);
  1535.         if (intro)
  1536.             SAVEFREESV(sref);
  1537.         SvTAINT(dstr);
  1538.         return;
  1539.         }
  1540.         if (SvPVX(dstr)) {
  1541.         Safefree(SvPVX(dstr));
  1542.         SvLEN(dstr)=SvCUR(dstr)=0;
  1543.         }
  1544.     }
  1545.     (void)SvOK_off(dstr);
  1546.     SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
  1547.     SvROK_on(dstr);
  1548.     if (sflags & SVp_NOK) {
  1549.         SvNOK_on(dstr);
  1550.         SvNVX(dstr) = SvNVX(sstr);
  1551.     }
  1552.     if (sflags & SVp_IOK) {
  1553.         (void)SvIOK_on(dstr);
  1554.         SvIVX(dstr) = SvIVX(sstr);
  1555.     }
  1556. #ifdef OVERLOAD
  1557.     if (SvAMAGIC(sstr)) {
  1558.         SvAMAGIC_on(dstr);
  1559.     }
  1560. #endif /* OVERLOAD */
  1561.     }
  1562.     else if (sflags & SVp_POK) {
  1563.  
  1564.     /*
  1565.      * Check to see if we can just swipe the string.  If so, it's a
  1566.      * possible small lose on short strings, but a big win on long ones.
  1567.      * It might even be a win on short strings if SvPVX(dstr)
  1568.      * has to be allocated and SvPVX(sstr) has to be freed.
  1569.      */
  1570.  
  1571.     if (SvTEMP(sstr)) {        /* slated for free anyway? */
  1572.         if (SvPVX(dstr)) {        /* we know that dtype >= SVt_PV */
  1573.         (void)SvOOK_off(dstr);
  1574.         Safefree(SvPVX(dstr));
  1575.         }
  1576.         SvPV_set(dstr, SvPVX(sstr));
  1577.         SvLEN_set(dstr, SvLEN(sstr));
  1578.         SvCUR_set(dstr, SvCUR(sstr));
  1579.         (void)SvPOK_only(dstr);
  1580.         SvTEMP_off(dstr);
  1581.         SvPV_set(sstr, Nullch);
  1582.         SvLEN_set(sstr, 0);
  1583.         SvPOK_off(sstr);            /* wipe out any weird flags */
  1584.         SvPVX(sstr) = 0;            /* so sstr frees uneventfully */
  1585.     }
  1586.     else {                    /* have to copy actual string */
  1587.         STRLEN len = SvCUR(sstr);
  1588.  
  1589.         SvGROW(dstr, len + 1);        /* inlined from sv_setpvn */
  1590.         Move(SvPVX(sstr),SvPVX(dstr),len,char);
  1591.         SvCUR_set(dstr, len);
  1592.         *SvEND(dstr) = '\0';
  1593.         (void)SvPOK_only(dstr);
  1594.     }
  1595.     /*SUPPRESS 560*/
  1596.     if (sflags & SVp_NOK) {
  1597.         SvNOK_on(dstr);
  1598.         SvNVX(dstr) = SvNVX(sstr);
  1599.     }
  1600.     if (sflags & SVp_IOK) {
  1601.         (void)SvIOK_on(dstr);
  1602.         SvIVX(dstr) = SvIVX(sstr);
  1603.     }
  1604.     }
  1605.     else if (sflags & SVp_NOK) {
  1606.     SvNVX(dstr) = SvNVX(sstr);
  1607.     (void)SvNOK_only(dstr);
  1608.     if (SvIOK(sstr)) {
  1609.         (void)SvIOK_on(dstr);
  1610.         SvIVX(dstr) = SvIVX(sstr);
  1611.     }
  1612.     }
  1613.     else if (sflags & SVp_IOK) {
  1614.     (void)SvIOK_only(dstr);
  1615.     SvIVX(dstr) = SvIVX(sstr);
  1616.     }
  1617.     else {
  1618.     (void)SvOK_off(dstr);
  1619.     }
  1620.     SvTAINT(dstr);
  1621. }
  1622.  
  1623. void
  1624. sv_setpvn(sv,ptr,len)
  1625. register SV *sv;
  1626. register char *ptr;
  1627. register STRLEN len;
  1628. {
  1629.     assert(len >= 0);
  1630.     if (SvTHINKFIRST(sv)) {
  1631.     if (SvREADONLY(sv) && curcop != &compiling)
  1632.         croak(no_modify);
  1633.     if (SvROK(sv))
  1634.         sv_unref(sv);
  1635.     }
  1636.     if (!ptr) {
  1637.     (void)SvOK_off(sv);
  1638.     return;
  1639.     }
  1640.     if (!SvUPGRADE(sv, SVt_PV))
  1641.     return;
  1642.     SvGROW(sv, len + 1);
  1643.     Move(ptr,SvPVX(sv),len,char);
  1644.     SvCUR_set(sv, len);
  1645.     *SvEND(sv) = '\0';
  1646.     (void)SvPOK_only(sv);        /* validate pointer */
  1647.     SvTAINT(sv);
  1648. }
  1649.  
  1650. void
  1651. sv_setpv(sv,ptr)
  1652. register SV *sv;
  1653. register char *ptr;
  1654. {
  1655.     register STRLEN len;
  1656.  
  1657.     if (SvTHINKFIRST(sv)) {
  1658.     if (SvREADONLY(sv) && curcop != &compiling)
  1659.         croak(no_modify);
  1660.     if (SvROK(sv))
  1661.         sv_unref(sv);
  1662.     }
  1663.     if (!ptr) {
  1664.     (void)SvOK_off(sv);
  1665.     return;
  1666.     }
  1667.     len = strlen(ptr);
  1668.     if (!SvUPGRADE(sv, SVt_PV))
  1669.     return;
  1670.     SvGROW(sv, len + 1);
  1671.     Move(ptr,SvPVX(sv),len+1,char);
  1672.     SvCUR_set(sv, len);
  1673.     (void)SvPOK_only(sv);        /* validate pointer */
  1674.     SvTAINT(sv);
  1675. }
  1676.  
  1677. void
  1678. sv_usepvn(sv,ptr,len)
  1679. register SV *sv;
  1680. register char *ptr;
  1681. register STRLEN len;
  1682. {
  1683.     if (SvTHINKFIRST(sv)) {
  1684.     if (SvREADONLY(sv) && curcop != &compiling)
  1685.         croak(no_modify);
  1686.     if (SvROK(sv))
  1687.         sv_unref(sv);
  1688.     }
  1689.     if (!SvUPGRADE(sv, SVt_PV))
  1690.     return;
  1691.     if (!ptr) {
  1692.     (void)SvOK_off(sv);
  1693.     return;
  1694.     }
  1695.     if (SvPVX(sv))
  1696.     Safefree(SvPVX(sv));
  1697.     Renew(ptr, len+1, char);
  1698.     SvPVX(sv) = ptr;
  1699.     SvCUR_set(sv, len);
  1700.     SvLEN_set(sv, len+1);
  1701.     *SvEND(sv) = '\0';
  1702.     (void)SvPOK_only(sv);        /* validate pointer */
  1703.     SvTAINT(sv);
  1704. }
  1705.  
  1706. void
  1707. sv_chop(sv,ptr)    /* like set but assuming ptr is in sv */
  1708. register SV *sv;
  1709. register char *ptr;
  1710. {
  1711.     register STRLEN delta;
  1712.  
  1713.     if (!ptr || !SvPOKp(sv))
  1714.     return;
  1715.     if (SvTHINKFIRST(sv)) {
  1716.     if (SvREADONLY(sv) && curcop != &compiling)
  1717.         croak(no_modify);
  1718.     if (SvROK(sv))
  1719.         sv_unref(sv);
  1720.     }
  1721.     if (SvTYPE(sv) < SVt_PVIV)
  1722.     sv_upgrade(sv,SVt_PVIV);
  1723.  
  1724.     if (!SvOOK(sv)) {
  1725.     SvIVX(sv) = 0;
  1726.     SvFLAGS(sv) |= SVf_OOK;
  1727.     }
  1728.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK);
  1729.     delta = ptr - SvPVX(sv);
  1730.     SvLEN(sv) -= delta;
  1731.     SvCUR(sv) -= delta;
  1732.     SvPVX(sv) += delta;
  1733.     SvIVX(sv) += delta;
  1734. }
  1735.  
  1736. void
  1737. sv_catpvn(sv,ptr,len)
  1738. register SV *sv;
  1739. register char *ptr;
  1740. register STRLEN len;
  1741. {
  1742.     STRLEN tlen;
  1743.     char *junk;
  1744.  
  1745.     junk = SvPV_force(sv, tlen);
  1746.     SvGROW(sv, tlen + len + 1);
  1747.     Move(ptr,SvPVX(sv)+tlen,len,char);
  1748.     SvCUR(sv) += len;
  1749.     *SvEND(sv) = '\0';
  1750.     (void)SvPOK_only(sv);        /* validate pointer */
  1751.     SvTAINT(sv);
  1752. }
  1753.  
  1754. void
  1755. sv_catsv(dstr,sstr)
  1756. SV *dstr;
  1757. register SV *sstr;
  1758. {
  1759.     char *s;
  1760.     STRLEN len;
  1761.     if (!sstr)
  1762.     return;
  1763.     if (s = SvPV(sstr, len))
  1764.     sv_catpvn(dstr,s,len);
  1765. }
  1766.  
  1767. void
  1768. sv_catpv(sv,ptr)
  1769. register SV *sv;
  1770. register char *ptr;
  1771. {
  1772.     register STRLEN len;
  1773.     STRLEN tlen;
  1774.     char *junk;
  1775.  
  1776.     if (!ptr)
  1777.     return;
  1778.     junk = SvPV_force(sv, tlen);
  1779.     len = strlen(ptr);
  1780.     SvGROW(sv, tlen + len + 1);
  1781.     Move(ptr,SvPVX(sv)+tlen,len+1,char);
  1782.     SvCUR(sv) += len;
  1783.     (void)SvPOK_only(sv);        /* validate pointer */
  1784.     SvTAINT(sv);
  1785. }
  1786.  
  1787. SV *
  1788. #ifdef LEAKTEST
  1789. newSV(x,len)
  1790. I32 x;
  1791. #else
  1792. newSV(len)
  1793. #endif
  1794. STRLEN len;
  1795. {
  1796.     register SV *sv;
  1797.     
  1798.     new_SV();
  1799.     SvANY(sv) = 0;
  1800.     SvREFCNT(sv) = 1;
  1801.     SvFLAGS(sv) = 0;
  1802.     if (len) {
  1803.     sv_upgrade(sv, SVt_PV);
  1804.     SvGROW(sv, len + 1);
  1805.     }
  1806.     return sv;
  1807. }
  1808.  
  1809. void
  1810. sv_magic(sv, obj, how, name, namlen)
  1811. register SV *sv;
  1812. SV *obj;
  1813. int how;
  1814. char *name;
  1815. I32 namlen;
  1816. {
  1817.     MAGIC* mg;
  1818.     
  1819.     if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
  1820.     croak(no_modify);
  1821.     if (SvMAGICAL(sv)) {
  1822.     if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
  1823.         if (how == 't')
  1824.         mg->mg_len |= 1;
  1825.         return;
  1826.     }
  1827.     }
  1828.     else {
  1829.     if (!SvUPGRADE(sv, SVt_PVMG))
  1830.         return;
  1831.     }
  1832.     Newz(702,mg, 1, MAGIC);
  1833.     mg->mg_moremagic = SvMAGIC(sv);
  1834.  
  1835.     SvMAGIC(sv) = mg;
  1836.     if (!obj || obj == sv || how == '#')
  1837.     mg->mg_obj = obj;
  1838.     else {
  1839.     mg->mg_obj = SvREFCNT_inc(obj);
  1840.     mg->mg_flags |= MGf_REFCOUNTED;
  1841.     }
  1842.     mg->mg_type = how;
  1843.     mg->mg_len = namlen;
  1844.     if (name && namlen >= 0)
  1845.     mg->mg_ptr = savepvn(name, namlen);
  1846.     switch (how) {
  1847.     case 0:
  1848.     mg->mg_virtual = &vtbl_sv;
  1849.     break;
  1850. #ifdef OVERLOAD
  1851.     case 'A':
  1852.         mg->mg_virtual = &vtbl_amagic;
  1853.         break;
  1854.     case 'a':
  1855.         mg->mg_virtual = &vtbl_amagicelem;
  1856.         break;
  1857.     case 'c':
  1858.         mg->mg_virtual = 0;
  1859.         break;
  1860. #endif /* OVERLOAD */
  1861.     case 'B':
  1862.     mg->mg_virtual = &vtbl_bm;
  1863.     break;
  1864.     case 'E':
  1865.     mg->mg_virtual = &vtbl_env;
  1866.     break;
  1867.     case 'e':
  1868.     mg->mg_virtual = &vtbl_envelem;
  1869.     break;
  1870.     case 'g':
  1871.     mg->mg_virtual = &vtbl_mglob;
  1872.     break;
  1873.     case 'I':
  1874.     mg->mg_virtual = &vtbl_isa;
  1875.     break;
  1876.     case 'i':
  1877.     mg->mg_virtual = &vtbl_isaelem;
  1878.     break;
  1879.     case 'L':
  1880.     SvRMAGICAL_on(sv);
  1881.     mg->mg_virtual = 0;
  1882.     break;
  1883.     case 'l':
  1884.     mg->mg_virtual = &vtbl_dbline;
  1885.     break;
  1886.     case 'P':
  1887.     mg->mg_virtual = &vtbl_pack;
  1888.     break;
  1889.     case 'p':
  1890.     case 'q':
  1891.     mg->mg_virtual = &vtbl_packelem;
  1892.     break;
  1893.     case 'S':
  1894.     mg->mg_virtual = &vtbl_sig;
  1895.     break;
  1896.     case 's':
  1897.     mg->mg_virtual = &vtbl_sigelem;
  1898.     break;
  1899.     case 't':
  1900.     mg->mg_virtual = &vtbl_taint;
  1901.     mg->mg_len = 1;
  1902.     break;
  1903.     case 'U':
  1904.     mg->mg_virtual = &vtbl_uvar;
  1905.     break;
  1906.     case 'v':
  1907.     mg->mg_virtual = &vtbl_vec;
  1908.     break;
  1909.     case 'x':
  1910.     mg->mg_virtual = &vtbl_substr;
  1911.     break;
  1912.     case '*':
  1913.     mg->mg_virtual = &vtbl_glob;
  1914.     break;
  1915.     case '#':
  1916.     mg->mg_virtual = &vtbl_arylen;
  1917.     break;
  1918.     case '.':
  1919.     mg->mg_virtual = &vtbl_pos;
  1920.     break;
  1921.     case '~':    /* reserved for extensions but multiple extensions may clash */
  1922.     break;
  1923.     default:
  1924.     croak("Don't know how to handle magic of type '%c'", how);
  1925.     }
  1926.     mg_magical(sv);
  1927.     if (SvGMAGICAL(sv))
  1928.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  1929. }
  1930.  
  1931. int
  1932. sv_unmagic(sv, type)
  1933. SV* sv;
  1934. int type;
  1935. {
  1936.     MAGIC* mg;
  1937.     MAGIC** mgp;
  1938.     if (!SvMAGICAL(sv))
  1939.     return 0;
  1940.     mgp = &SvMAGIC(sv);
  1941.     for (mg = *mgp; mg; mg = *mgp) {
  1942.     if (mg->mg_type == type) {
  1943.         MGVTBL* vtbl = mg->mg_virtual;
  1944.         *mgp = mg->mg_moremagic;
  1945.         if (vtbl && vtbl->svt_free)
  1946.         (*vtbl->svt_free)(sv, mg);
  1947.         if (mg->mg_ptr && mg->mg_type != 'g')
  1948.         Safefree(mg->mg_ptr);
  1949.         if (mg->mg_flags & MGf_REFCOUNTED)
  1950.         SvREFCNT_dec(mg->mg_obj);
  1951.         Safefree(mg);
  1952.     }
  1953.     else
  1954.         mgp = &mg->mg_moremagic;
  1955.     }
  1956.     if (!SvMAGIC(sv)) {
  1957.     SvMAGICAL_off(sv);
  1958.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  1959.     }
  1960.  
  1961.     return 0;
  1962. }
  1963.  
  1964. void
  1965. sv_insert(bigstr,offset,len,little,littlelen)
  1966. SV *bigstr;
  1967. STRLEN offset;
  1968. STRLEN len;
  1969. char *little;
  1970. STRLEN littlelen;
  1971. {
  1972.     register char *big;
  1973.     register char *mid;
  1974.     register char *midend;
  1975.     register char *bigend;
  1976.     register I32 i;
  1977.  
  1978.     if (!bigstr)
  1979.     croak("Can't modify non-existent substring");
  1980.     SvPV_force(bigstr, na);
  1981.  
  1982.     i = littlelen - len;
  1983.     if (i > 0) {            /* string might grow */
  1984.     big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
  1985.     mid = big + offset + len;
  1986.     midend = bigend = big + SvCUR(bigstr);
  1987.     bigend += i;
  1988.     *bigend = '\0';
  1989.     while (midend > mid)        /* shove everything down */
  1990.         *--bigend = *--midend;
  1991.     Move(little,big+offset,littlelen,char);
  1992.     SvCUR(bigstr) += i;
  1993.     SvSETMAGIC(bigstr);
  1994.     return;
  1995.     }
  1996.     else if (i == 0) {
  1997.     Move(little,SvPVX(bigstr)+offset,len,char);
  1998.     SvSETMAGIC(bigstr);
  1999.     return;
  2000.     }
  2001.  
  2002.     big = SvPVX(bigstr);
  2003.     mid = big + offset;
  2004.     midend = mid + len;
  2005.     bigend = big + SvCUR(bigstr);
  2006.  
  2007.     if (midend > bigend)
  2008.     croak("panic: sv_insert");
  2009.  
  2010.     if (mid - big > bigend - midend) {    /* faster to shorten from end */
  2011.     if (littlelen) {
  2012.         Move(little, mid, littlelen,char);
  2013.         mid += littlelen;
  2014.     }
  2015.     i = bigend - midend;
  2016.     if (i > 0) {
  2017.         Move(midend, mid, i,char);
  2018.         mid += i;
  2019.     }
  2020.     *mid = '\0';
  2021.     SvCUR_set(bigstr, mid - big);
  2022.     }
  2023.     /*SUPPRESS 560*/
  2024.     else if (i = mid - big) {    /* faster from front */
  2025.     midend -= littlelen;
  2026.     mid = midend;
  2027.     sv_chop(bigstr,midend-i);
  2028.     big += i;
  2029.     while (i--)
  2030.         *--midend = *--big;
  2031.     if (littlelen)
  2032.         Move(little, mid, littlelen,char);
  2033.     }
  2034.     else if (littlelen) {
  2035.     midend -= littlelen;
  2036.     sv_chop(bigstr,midend);
  2037.     Move(little,midend,littlelen,char);
  2038.     }
  2039.     else {
  2040.     sv_chop(bigstr,midend);
  2041.     }
  2042.     SvSETMAGIC(bigstr);
  2043. }
  2044.  
  2045. /* make sv point to what nstr did */
  2046.  
  2047. void
  2048. sv_replace(sv,nsv)
  2049. register SV *sv;
  2050. register SV *nsv;
  2051. {
  2052.     U32 refcnt = SvREFCNT(sv);
  2053.     if (SvTHINKFIRST(sv)) {
  2054.     if (SvREADONLY(sv) && curcop != &compiling)
  2055.         croak(no_modify);
  2056.     if (SvROK(sv))
  2057.         sv_unref(sv);
  2058.     }
  2059.     if (SvREFCNT(nsv) != 1)
  2060.     warn("Reference miscount in sv_replace()");
  2061.     if (SvMAGICAL(sv)) {
  2062.     if (SvMAGICAL(nsv))
  2063.         mg_free(nsv);
  2064.     else
  2065.         sv_upgrade(nsv, SVt_PVMG);
  2066.     SvMAGIC(nsv) = SvMAGIC(sv);
  2067.     SvFLAGS(nsv) |= SvMAGICAL(sv);
  2068.     SvMAGICAL_off(sv);
  2069.     SvMAGIC(sv) = 0;
  2070.     }
  2071.     SvREFCNT(sv) = 0;
  2072.     sv_clear(sv);
  2073.     StructCopy(nsv,sv,SV);
  2074.     SvREFCNT(sv) = refcnt;
  2075.     del_SV(nsv);
  2076. }
  2077.  
  2078. void
  2079. sv_clear(sv)
  2080. register SV *sv;
  2081. {
  2082.     assert(sv);
  2083.     assert(SvREFCNT(sv) == 0);
  2084.  
  2085.     if (SvOBJECT(sv)) {
  2086.     dSP;
  2087.     GV* destructor;
  2088.  
  2089.     if (defstash) {        /* Still have a symbol table? */
  2090.         destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
  2091.  
  2092.         ENTER;
  2093.         SAVEFREESV(SvSTASH(sv));
  2094.         if (destructor && GvCV(destructor)) {
  2095.         SV ref;
  2096.  
  2097.         Zero(&ref, 1, SV);
  2098.         sv_upgrade(&ref, SVt_RV);
  2099.         SAVEI32(SvREFCNT(sv));
  2100.         SvRV(&ref) = SvREFCNT_inc(sv);
  2101.         SvROK_on(&ref);
  2102.  
  2103.         EXTEND(SP, 2);
  2104.         PUSHMARK(SP);
  2105.         PUSHs(&ref);
  2106.         PUTBACK;
  2107.         perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL);
  2108.         del_XRV(SvANY(&ref));
  2109.         }
  2110.         LEAVE;
  2111.     }
  2112.     if (SvOBJECT(sv)) {
  2113.         SvOBJECT_off(sv);    /* Curse the object. */
  2114.         if (SvTYPE(sv) != SVt_PVIO)
  2115.         --sv_objcount;    /* XXX Might want something more general */
  2116.     }
  2117.     }
  2118.     if (SvMAGICAL(sv))
  2119.     mg_free(sv);
  2120.     switch (SvTYPE(sv)) {
  2121.     case SVt_PVIO:
  2122.     Safefree(IoTOP_NAME(sv));
  2123.     Safefree(IoFMT_NAME(sv));
  2124.     Safefree(IoBOTTOM_NAME(sv));
  2125.     /* FALL THROUGH */
  2126.     case SVt_PVBM:
  2127.     goto freescalar;
  2128.     case SVt_PVCV:
  2129.     case SVt_PVFM:
  2130.     cv_undef((CV*)sv);
  2131.     goto freescalar;
  2132.     case SVt_PVHV:
  2133.     hv_undef((HV*)sv);
  2134.     break;
  2135.     case SVt_PVAV:
  2136.     av_undef((AV*)sv);
  2137.     break;
  2138.     case SVt_PVGV:
  2139.     gp_free(sv);
  2140.     Safefree(GvNAME(sv));
  2141.     /* FALL THROUGH */
  2142.     case SVt_PVLV:
  2143.     case SVt_PVMG:
  2144.     case SVt_PVNV:
  2145.     case SVt_PVIV:
  2146.       freescalar:
  2147.     (void)SvOOK_off(sv);
  2148.     /* FALL THROUGH */
  2149.     case SVt_PV:
  2150.     case SVt_RV:
  2151.     if (SvROK(sv))
  2152.         SvREFCNT_dec(SvRV(sv));
  2153.     else if (SvPVX(sv))
  2154.         Safefree(SvPVX(sv));
  2155.     break;
  2156. /*
  2157.     case SVt_NV:
  2158.     case SVt_IV:
  2159.     case SVt_NULL:
  2160.     break;
  2161. */
  2162.     }
  2163.  
  2164.     switch (SvTYPE(sv)) {
  2165.     case SVt_NULL:
  2166.     break;
  2167.     case SVt_IV:
  2168.     del_XIV(SvANY(sv));
  2169.     break;
  2170.     case SVt_NV:
  2171.     del_XNV(SvANY(sv));
  2172.     break;
  2173.     case SVt_RV:
  2174.     del_XRV(SvANY(sv));
  2175.     break;
  2176.     case SVt_PV:
  2177.     del_XPV(SvANY(sv));
  2178.     break;
  2179.     case SVt_PVIV:
  2180.     del_XPVIV(SvANY(sv));
  2181.     break;
  2182.     case SVt_PVNV:
  2183.     del_XPVNV(SvANY(sv));
  2184.     break;
  2185.     case SVt_PVMG:
  2186.     del_XPVMG(SvANY(sv));
  2187.     break;
  2188.     case SVt_PVLV:
  2189.     del_XPVLV(SvANY(sv));
  2190.     break;
  2191.     case SVt_PVAV:
  2192.     del_XPVAV(SvANY(sv));
  2193.     break;
  2194.     case SVt_PVHV:
  2195.     del_XPVHV(SvANY(sv));
  2196.     break;
  2197.     case SVt_PVCV:
  2198.     del_XPVCV(SvANY(sv));
  2199.     break;
  2200.     case SVt_PVGV:
  2201.     del_XPVGV(SvANY(sv));
  2202.     break;
  2203.     case SVt_PVBM:
  2204.     del_XPVBM(SvANY(sv));
  2205.     break;
  2206.     case SVt_PVFM:
  2207.     del_XPVFM(SvANY(sv));
  2208.     break;
  2209.     case SVt_PVIO:
  2210.     del_XPVIO(SvANY(sv));
  2211.     break;
  2212.     }
  2213.     SvFLAGS(sv) &= SVf_BREAK;
  2214.     SvFLAGS(sv) |= SVTYPEMASK;
  2215. }
  2216.  
  2217. SV *
  2218. sv_newref(sv)
  2219. SV* sv;
  2220. {
  2221.     if (sv)
  2222.     SvREFCNT(sv)++;
  2223.     return sv;
  2224. }
  2225.  
  2226. void
  2227. sv_free(sv)
  2228. SV *sv;
  2229. {
  2230.     if (!sv)
  2231.     return;
  2232.     if (SvREADONLY(sv)) {
  2233.     if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
  2234.         return;
  2235.     }
  2236.     if (SvREFCNT(sv) == 0) {
  2237.     if (SvFLAGS(sv) & SVf_BREAK)
  2238.         return;
  2239.     warn("Attempt to free unreferenced scalar");
  2240.     return;
  2241.     }
  2242.     if (--SvREFCNT(sv) > 0)
  2243.     return;
  2244. #ifdef DEBUGGING
  2245.     if (SvTEMP(sv)) {
  2246.     warn("Attempt to free temp prematurely");
  2247.     return;
  2248.     }
  2249. #endif
  2250.     sv_clear(sv);
  2251.     del_SV(sv);
  2252. }
  2253.  
  2254. STRLEN
  2255. sv_len(sv)
  2256. register SV *sv;
  2257. {
  2258.     char *junk;
  2259.     STRLEN len;
  2260.  
  2261.     if (!sv)
  2262.     return 0;
  2263.  
  2264.     if (SvGMAGICAL(sv))
  2265.     len = mg_len(sv);
  2266.     else
  2267.     junk = SvPV(sv, len);
  2268.     return len;
  2269. }
  2270.  
  2271. I32
  2272. sv_eq(str1,str2)
  2273. register SV *str1;
  2274. register SV *str2;
  2275. {
  2276.     char *pv1;
  2277.     STRLEN cur1;
  2278.     char *pv2;
  2279.     STRLEN cur2;
  2280.  
  2281.     if (!str1) {
  2282.     pv1 = "";
  2283.     cur1 = 0;
  2284.     }
  2285.     else
  2286.     pv1 = SvPV(str1, cur1);
  2287.  
  2288.     if (!str2)
  2289.     return !cur1;
  2290.     else
  2291.     pv2 = SvPV(str2, cur2);
  2292.  
  2293.     if (cur1 != cur2)
  2294.     return 0;
  2295.  
  2296.     return !bcmp(pv1, pv2, cur1);
  2297. }
  2298.  
  2299. I32
  2300. sv_cmp(str1,str2)
  2301. register SV *str1;
  2302. register SV *str2;
  2303. {
  2304.     I32 retval;
  2305.     char *pv1;
  2306.     STRLEN cur1;
  2307.     char *pv2;
  2308.     STRLEN cur2;
  2309.  
  2310.     if (!str1) {
  2311.     pv1 = "";
  2312.     cur1 = 0;
  2313.     }
  2314.     else
  2315.     pv1 = SvPV(str1, cur1);
  2316.  
  2317.     if (!str2) {
  2318.     pv2 = "";
  2319.     cur2 = 0;
  2320.     }
  2321.     else
  2322.     pv2 = SvPV(str2, cur2);
  2323.  
  2324.     if (!cur1)
  2325.     return cur2 ? -1 : 0;
  2326.     if (!cur2)
  2327.     return 1;
  2328.  
  2329.     if (cur1 < cur2) {
  2330.     /*SUPPRESS 560*/
  2331.     if (retval = memcmp((void*)pv1, (void*)pv2, cur1))
  2332.         return retval < 0 ? -1 : 1;
  2333.     else
  2334.         return -1;
  2335.     }
  2336.     /*SUPPRESS 560*/
  2337.     else if (retval = memcmp((void*)pv1, (void*)pv2, cur2))
  2338.     return retval < 0 ? -1 : 1;
  2339.     else if (cur1 == cur2)
  2340.     return 0;
  2341.     else
  2342.     return 1;
  2343. }
  2344.  
  2345. char *
  2346. sv_gets(sv,fp,append)
  2347. register SV *sv;
  2348. register FILE *fp;
  2349. I32 append;
  2350. {
  2351.     register char *bp;        /* we're going to steal some values */
  2352. #ifdef USE_STD_STDIO
  2353.     register I32 cnt;        /*  from the stdio struct and put EVERYTHING */
  2354.     register STDCHAR *ptr;    /*   in the innermost loop into registers */
  2355.     STRLEN bpx;
  2356.     I32 shortbuffered;
  2357. #endif
  2358.     register I32 newline = rschar;/* (assuming >= 6 registers) */
  2359.     I32 i;
  2360.  
  2361.     if (SvTHINKFIRST(sv)) {
  2362.     if (SvREADONLY(sv) && curcop != &compiling)
  2363.         croak(no_modify);
  2364.     if (SvROK(sv))
  2365.         sv_unref(sv);
  2366.     }
  2367.     if (!SvUPGRADE(sv, SVt_PV))
  2368.     return 0;
  2369.     if (rspara) {        /* have to do this both before and after */
  2370.     do {            /* to make sure file boundaries work right */
  2371.         if (feof(fp))
  2372.         return 0;
  2373.         i = getc(fp);
  2374.         if (i != '\n') {
  2375.         if (i == -1)
  2376.             return 0;
  2377.         ungetc(i,fp);
  2378.         break;
  2379.         }
  2380.     } while (i != EOF);
  2381.     }
  2382. #ifdef USE_STD_STDIO    /* Here is some breathtakingly efficient cheating */
  2383.     cnt = fp->_cnt;            /* get count into register */
  2384.     (void)SvPOK_only(sv);        /* validate pointer */
  2385.     if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
  2386.     if (cnt > 80 && SvLEN(sv) > append) {
  2387.         shortbuffered = cnt - SvLEN(sv) + append + 1;
  2388.         cnt -= shortbuffered;
  2389.     }
  2390.     else {
  2391.         shortbuffered = 0;
  2392.         SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
  2393.     }
  2394.     }
  2395.     else
  2396.     shortbuffered = 0;
  2397.     bp = SvPVX(sv) + append;        /* move these two too to registers */
  2398.     ptr = fp->_ptr;
  2399.     for (;;) {
  2400.       screamer:
  2401.     if (cnt > 0) {
  2402.         while (--cnt >= 0) {         /* this */    /* eat */
  2403.         if ((*bp++ = *ptr++) == newline) /* really */    /* dust */
  2404.             goto thats_all_folks;     /* screams */    /* sed :-) */ 
  2405.         }
  2406.     }
  2407.     
  2408.     if (shortbuffered) {        /* oh well, must extend */
  2409.         cnt = shortbuffered;
  2410.         shortbuffered = 0;
  2411.         bpx = bp - SvPVX(sv);    /* prepare for possible relocation */
  2412.         SvCUR_set(sv, bpx);
  2413.         SvGROW(sv, SvLEN(sv) + append + cnt + 2);
  2414.         bp = SvPVX(sv) + bpx;    /* reconstitute our pointer */
  2415.         continue;
  2416.     }
  2417.  
  2418.     fp->_cnt = cnt;            /* deregisterize cnt and ptr */
  2419.     fp->_ptr = ptr;
  2420.     i = _filbuf(fp);        /* get more characters */
  2421.     cnt = fp->_cnt;
  2422.     ptr = fp->_ptr;            /* reregisterize cnt and ptr */
  2423.  
  2424.     if (i == EOF)            /* all done for ever? */
  2425.         goto thats_really_all_folks;
  2426.  
  2427.     bpx = bp - SvPVX(sv);        /* prepare for possible relocation */
  2428.     SvCUR_set(sv, bpx);
  2429.     SvGROW(sv, bpx + cnt + 2);
  2430.     bp = SvPVX(sv) + bpx;        /* reconstitute our pointer */
  2431.  
  2432.     if (i == newline) {        /* all done for now? */
  2433.         *bp++ = i;
  2434.         goto thats_all_folks;
  2435.     }
  2436.     *bp++ = i;            /* now go back to screaming loop */
  2437.     }
  2438.  
  2439. thats_all_folks:
  2440.     if (rslen > 1 && (bp - SvPVX(sv) < rslen || bcmp(bp - rslen, rs, rslen)))
  2441.     goto screamer;            /* go back to the fray */
  2442. thats_really_all_folks:
  2443.     if (shortbuffered)
  2444.     cnt += shortbuffered;
  2445.     fp->_cnt = cnt;            /* put these back or we're in trouble */
  2446.     fp->_ptr = ptr;
  2447.     *bp = '\0';
  2448.     SvCUR_set(sv, bp - SvPVX(sv));    /* set length */
  2449.  
  2450. #else /* !USE_STD_STDIO */    /* The big, slow, and stupid way */
  2451.  
  2452.     {
  2453.     char buf[8192];
  2454.     register char * bpe = buf + sizeof(buf) - 3;
  2455.  
  2456. screamer:
  2457.     bp = buf;
  2458.     while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
  2459.  
  2460.     if (append)
  2461.         sv_catpvn(sv, buf, bp - buf);
  2462.     else
  2463.         sv_setpvn(sv, buf, bp - buf);
  2464.     if (i != EOF            /* joy */
  2465.         &&
  2466.         (i != newline
  2467.          ||
  2468.          (rslen > 1
  2469.           &&
  2470.           (SvCUR(sv) < rslen
  2471.            ||
  2472.            bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rs, rslen)
  2473.           )
  2474.          )
  2475.         )
  2476.        )
  2477.     {
  2478.         append = -1;
  2479.         goto screamer;
  2480.     }
  2481.     }
  2482.  
  2483. #endif /* USE_STD_STDIO */
  2484.  
  2485.     if (rspara) {
  2486.         while (i != EOF) {
  2487.         i = getc(fp);
  2488.         if (i != '\n') {
  2489.         ungetc(i,fp);
  2490.         break;
  2491.         }
  2492.     }
  2493.     }
  2494.     return SvCUR(sv) - append ? SvPVX(sv) : Nullch;
  2495. }
  2496.  
  2497. void
  2498. sv_inc(sv)
  2499. register SV *sv;
  2500. {
  2501.     register char *d;
  2502.     int flags;
  2503.  
  2504.     if (!sv)
  2505.     return;
  2506.     if (SvTHINKFIRST(sv)) {
  2507.     if (SvREADONLY(sv) && curcop != &compiling)
  2508.         croak(no_modify);
  2509.     if (SvROK(sv)) {
  2510. #ifdef OVERLOAD
  2511.       if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
  2512. #endif /* OVERLOAD */
  2513.       sv_unref(sv);
  2514.     }
  2515.     }
  2516.     if (SvGMAGICAL(sv))
  2517.     mg_get(sv);
  2518.     flags = SvFLAGS(sv);
  2519.     if (flags & SVp_IOK) {
  2520.     ++SvIVX(sv);
  2521.     (void)SvIOK_only(sv);
  2522.     return;
  2523.     }
  2524.     if (flags & SVp_NOK) {
  2525.     SvNVX(sv) += 1.0;
  2526.     (void)SvNOK_only(sv);
  2527.     return;
  2528.     }
  2529.     if (!(flags & SVp_POK) || !*SvPVX(sv)) {
  2530.     sv_upgrade(sv, SVt_NV);
  2531.     SvNVX(sv) = 1.0;
  2532.     (void)SvNOK_only(sv);
  2533.     return;
  2534.     }
  2535.     d = SvPVX(sv);
  2536.     while (isALPHA(*d)) d++;
  2537.     while (isDIGIT(*d)) d++;
  2538.     if (*d) {
  2539.         sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
  2540.     return;
  2541.     }
  2542.     d--;
  2543.     while (d >= SvPVX(sv)) {
  2544.     if (isDIGIT(*d)) {
  2545.         if (++*d <= '9')
  2546.         return;
  2547.         *(d--) = '0';
  2548.     }
  2549.     else {
  2550.         ++*d;
  2551.         if (isALPHA(*d))
  2552.         return;
  2553.         *(d--) -= 'z' - 'a' + 1;
  2554.     }
  2555.     }
  2556.     /* oh,oh, the number grew */
  2557.     SvGROW(sv, SvCUR(sv) + 2);
  2558.     SvCUR(sv)++;
  2559.     for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
  2560.     *d = d[-1];
  2561.     if (isDIGIT(d[1]))
  2562.     *d = '1';
  2563.     else
  2564.     *d = d[1];
  2565. }
  2566.  
  2567. void
  2568. sv_dec(sv)
  2569. register SV *sv;
  2570. {
  2571.     int flags;
  2572.  
  2573.     if (!sv)
  2574.     return;
  2575.     if (SvTHINKFIRST(sv)) {
  2576.     if (SvREADONLY(sv) && curcop != &compiling)
  2577.         croak(no_modify);
  2578.     if (SvROK(sv)) {
  2579. #ifdef OVERLOAD
  2580.       if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
  2581. #endif /* OVERLOAD */
  2582.       sv_unref(sv);
  2583.     }
  2584.     }
  2585.     if (SvGMAGICAL(sv))
  2586.     mg_get(sv);
  2587.     flags = SvFLAGS(sv);
  2588.     if (flags & SVp_IOK) {
  2589.     --SvIVX(sv);
  2590.     (void)SvIOK_only(sv);
  2591.     return;
  2592.     }
  2593.     if (flags & SVp_NOK) {
  2594.     SvNVX(sv) -= 1.0;
  2595.     (void)SvNOK_only(sv);
  2596.     return;
  2597.     }
  2598.     if (!(flags & SVp_POK)) {
  2599.     sv_upgrade(sv, SVt_NV);
  2600.     SvNVX(sv) = -1.0;
  2601.     (void)SvNOK_only(sv);
  2602.     return;
  2603.     }
  2604.     sv_setnv(sv,atof(SvPVX(sv)) - 1.0);
  2605. }
  2606.  
  2607. /* Make a string that will exist for the duration of the expression
  2608.  * evaluation.  Actually, it may have to last longer than that, but
  2609.  * hopefully we won't free it until it has been assigned to a
  2610.  * permanent location. */
  2611.  
  2612. static void
  2613. sv_mortalgrow()
  2614. {
  2615.     tmps_max += 128;
  2616.     Renew(tmps_stack, tmps_max, SV*);
  2617. }
  2618.  
  2619. SV *
  2620. sv_mortalcopy(oldstr)
  2621. SV *oldstr;
  2622. {
  2623.     register SV *sv;
  2624.  
  2625.     new_SV();
  2626.     SvANY(sv) = 0;
  2627.     SvREFCNT(sv) = 1;
  2628.     SvFLAGS(sv) = 0;
  2629.     sv_setsv(sv,oldstr);
  2630.     if (++tmps_ix >= tmps_max)
  2631.     sv_mortalgrow();
  2632.     tmps_stack[tmps_ix] = sv;
  2633.     SvTEMP_on(sv);
  2634.     return sv;
  2635. }
  2636.  
  2637. SV *
  2638. sv_newmortal()
  2639. {
  2640.     register SV *sv;
  2641.  
  2642.     new_SV();
  2643.     SvANY(sv) = 0;
  2644.     SvREFCNT(sv) = 1;
  2645.     SvFLAGS(sv) = SVs_TEMP;
  2646.     if (++tmps_ix >= tmps_max)
  2647.     sv_mortalgrow();
  2648.     tmps_stack[tmps_ix] = sv;
  2649.     return sv;
  2650. }
  2651.  
  2652. /* same thing without the copying */
  2653.  
  2654. SV *
  2655. sv_2mortal(sv)
  2656. register SV *sv;
  2657. {
  2658.     if (!sv)
  2659.     return sv;
  2660.     if (SvREADONLY(sv) && curcop != &compiling)
  2661.     croak(no_modify);
  2662.     if (++tmps_ix >= tmps_max)
  2663.     sv_mortalgrow();
  2664.     tmps_stack[tmps_ix] = sv;
  2665.     SvTEMP_on(sv);
  2666.     return sv;
  2667. }
  2668.  
  2669. SV *
  2670. newSVpv(s,len)
  2671. char *s;
  2672. STRLEN len;
  2673. {
  2674.     register SV *sv;
  2675.  
  2676.     new_SV();
  2677.     SvANY(sv) = 0;
  2678.     SvREFCNT(sv) = 1;
  2679.     SvFLAGS(sv) = 0;
  2680.     if (!len)
  2681.     len = strlen(s);
  2682.     sv_setpvn(sv,s,len);
  2683.     return sv;
  2684. }
  2685.  
  2686. SV *
  2687. newSVnv(n)
  2688. double n;
  2689. {
  2690.     register SV *sv;
  2691.  
  2692.     new_SV();
  2693.     SvANY(sv) = 0;
  2694.     SvREFCNT(sv) = 1;
  2695.     SvFLAGS(sv) = 0;
  2696.     sv_setnv(sv,n);
  2697.     return sv;
  2698. }
  2699.  
  2700. SV *
  2701. newSViv(i)
  2702. IV i;
  2703. {
  2704.     register SV *sv;
  2705.  
  2706.     new_SV();
  2707.     SvANY(sv) = 0;
  2708.     SvREFCNT(sv) = 1;
  2709.     SvFLAGS(sv) = 0;
  2710.     sv_setiv(sv,i);
  2711.     return sv;
  2712. }
  2713.  
  2714. SV *
  2715. newRV(ref)
  2716. SV *ref;
  2717. {
  2718.     register SV *sv;
  2719.  
  2720.     new_SV();
  2721.     SvANY(sv) = 0;
  2722.     SvREFCNT(sv) = 1;
  2723.     SvFLAGS(sv) = 0;
  2724.     sv_upgrade(sv, SVt_RV);
  2725.     SvTEMP_off(ref);
  2726.     SvRV(sv) = SvREFCNT_inc(ref);
  2727.     SvROK_on(sv);
  2728.     return sv;
  2729. }
  2730.  
  2731. /* make an exact duplicate of old */
  2732.  
  2733. SV *
  2734. newSVsv(old)
  2735. register SV *old;
  2736. {
  2737.     register SV *sv;
  2738.  
  2739.     if (!old)
  2740.     return Nullsv;
  2741.     if (SvTYPE(old) == SVTYPEMASK) {
  2742.     warn("semi-panic: attempt to dup freed string");
  2743.     return Nullsv;
  2744.     }
  2745.     new_SV();
  2746.     SvANY(sv) = 0;
  2747.     SvREFCNT(sv) = 1;
  2748.     SvFLAGS(sv) = 0;
  2749.     if (SvTEMP(old)) {
  2750.     SvTEMP_off(old);
  2751.     sv_setsv(sv,old);
  2752.     SvTEMP_on(old);
  2753.     }
  2754.     else
  2755.     sv_setsv(sv,old);
  2756.     return sv;
  2757. }
  2758.  
  2759. void
  2760. sv_reset(s,stash)
  2761. register char *s;
  2762. HV *stash;
  2763. {
  2764.     register HE *entry;
  2765.     register GV *gv;
  2766.     register SV *sv;
  2767.     register I32 i;
  2768.     register PMOP *pm;
  2769.     register I32 max;
  2770.     char todo[256];
  2771.  
  2772.     if (!*s) {        /* reset ?? searches */
  2773.     for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
  2774.         pm->op_pmflags &= ~PMf_USED;
  2775.     }
  2776.     return;
  2777.     }
  2778.  
  2779.     /* reset variables */
  2780.  
  2781.     if (!HvARRAY(stash))
  2782.     return;
  2783.  
  2784.     Zero(todo, 256, char);
  2785.     while (*s) {
  2786.     i = *s;
  2787.     if (s[1] == '-') {
  2788.         s += 2;
  2789.     }
  2790.     max = *s++;
  2791.     for ( ; i <= max; i++) {
  2792.         todo[i] = 1;
  2793.     }
  2794.     for (i = 0; i <= (I32) HvMAX(stash); i++) {
  2795.         for (entry = HvARRAY(stash)[i];
  2796.           entry;
  2797.           entry = entry->hent_next) {
  2798.         if (!todo[(U8)*entry->hent_key])
  2799.             continue;
  2800.         gv = (GV*)entry->hent_val;
  2801.         sv = GvSV(gv);
  2802.         (void)SvOK_off(sv);
  2803.         if (SvTYPE(sv) >= SVt_PV) {
  2804.             SvCUR_set(sv, 0);
  2805.             SvTAINT(sv);
  2806.             if (SvPVX(sv) != Nullch)
  2807.             *SvPVX(sv) = '\0';
  2808.         }
  2809.         if (GvAV(gv)) {
  2810.             av_clear(GvAV(gv));
  2811.         }
  2812.         if (GvHV(gv)) {
  2813.             if (HvNAME(GvHV(gv)))
  2814.             continue;
  2815.             hv_clear(GvHV(gv));
  2816. #ifndef VMS  /* VMS has no environ array */
  2817.             if (gv == envgv)
  2818.             environ[0] = Nullch;
  2819. #endif
  2820.         }
  2821.         }
  2822.     }
  2823.     }
  2824. }
  2825.  
  2826. CV *
  2827. sv_2cv(sv, st, gvp, lref)
  2828. SV *sv;
  2829. HV **st;
  2830. GV **gvp;
  2831. I32 lref;
  2832. {
  2833.     GV *gv;
  2834.     CV *cv;
  2835.  
  2836.     if (!sv)
  2837.     return *gvp = Nullgv, Nullcv;
  2838.     switch (SvTYPE(sv)) {
  2839.     case SVt_PVCV:
  2840.     *st = CvSTASH(sv);
  2841.     *gvp = Nullgv;
  2842.     return (CV*)sv;
  2843.     case SVt_PVHV:
  2844.     case SVt_PVAV:
  2845.     *gvp = Nullgv;
  2846.     return Nullcv;
  2847.     case SVt_PVGV:
  2848.     gv = (GV*)sv;
  2849.     *gvp = gv;
  2850.     *st = GvESTASH(gv);
  2851.     goto fix_gv;
  2852.  
  2853.     default:
  2854.     if (SvGMAGICAL(sv))
  2855.         mg_get(sv);
  2856.     if (SvROK(sv)) {
  2857.         cv = (CV*)SvRV(sv);
  2858.         if (SvTYPE(cv) != SVt_PVCV)
  2859.         croak("Not a subroutine reference");
  2860.         *gvp = Nullgv;
  2861.         *st = CvSTASH(cv);
  2862.         return cv;
  2863.     }
  2864.     if (isGV(sv))
  2865.         gv = (GV*)sv;
  2866.     else
  2867.         gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
  2868.     *gvp = gv;
  2869.     if (!gv)
  2870.         return Nullcv;
  2871.     *st = GvESTASH(gv);
  2872.     fix_gv:
  2873.     if (lref && !GvCV(gv)) {
  2874.         ENTER;
  2875.         sv = NEWSV(704,0);
  2876.         gv_efullname(sv, gv);
  2877.         newSUB(start_subparse(),
  2878.            newSVOP(OP_CONST, 0, sv),
  2879.            Nullop);
  2880.         LEAVE;
  2881.     }
  2882.     return GvCV(gv);
  2883.     }
  2884. }
  2885.  
  2886. #ifndef SvTRUE
  2887. I32
  2888. SvTRUE(sv)
  2889. register SV *sv;
  2890. {
  2891.     if (!sv)
  2892.     return 0;
  2893.     if (SvGMAGICAL(sv))
  2894.     mg_get(sv);
  2895.     if (SvPOK(sv)) {
  2896.     register XPV* Xpv;
  2897.     if ((Xpv = (XPV*)SvANY(sv)) &&
  2898.         (*Xpv->xpv_pv > '0' ||
  2899.         Xpv->xpv_cur > 1 ||
  2900.         (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
  2901.         return 1;
  2902.     else
  2903.         return 0;
  2904.     }
  2905.     else {
  2906.     if (SvIOK(sv))
  2907.         return SvIVX(sv) != 0;
  2908.     else {
  2909.         if (SvNOK(sv))
  2910.         return SvNVX(sv) != 0.0;
  2911.         else
  2912.         return sv_2bool(sv);
  2913.     }
  2914.     }
  2915. }
  2916. #endif /* SvTRUE */
  2917.  
  2918. #ifndef SvIV
  2919. IV SvIV(Sv)
  2920. register SV *Sv;
  2921. {
  2922.     if (SvIOK(Sv))
  2923.     return SvIVX(Sv);
  2924.     return sv_2iv(Sv);
  2925. }
  2926. #endif /* SvIV */
  2927.  
  2928.  
  2929. #ifndef SvNV
  2930. double SvNV(Sv)
  2931. register SV *Sv;
  2932. {
  2933.     if (SvNOK(Sv))
  2934.     return SvNVX(Sv);
  2935.     if (SvIOK(Sv))
  2936.     return (double)SvIVX(Sv);
  2937.     return sv_2nv(Sv);
  2938. }
  2939. #endif /* SvNV */
  2940.  
  2941. #ifdef CRIPPLED_CC
  2942. char *
  2943. sv_pvn(sv, lp)
  2944. SV *sv;
  2945. STRLEN *lp;
  2946. {
  2947.     if (SvPOK(sv)) {
  2948.     *lp = SvCUR(sv);
  2949.     return SvPVX(sv);
  2950.     }
  2951.     return sv_2pv(sv, lp);
  2952. }
  2953. #endif
  2954.  
  2955. char *
  2956. sv_pvn_force(sv, lp)
  2957. SV *sv;
  2958. STRLEN *lp;
  2959. {
  2960.     char *s;
  2961.  
  2962.     if (SvREADONLY(sv) && curcop != &compiling)
  2963.     croak(no_modify);
  2964.     
  2965.     if (SvPOK(sv)) {
  2966.     *lp = SvCUR(sv);
  2967.     }
  2968.     else {
  2969.     if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
  2970.         if (SvFAKE(sv))
  2971.         sv_unglob(sv);
  2972.         else
  2973.         croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
  2974.             op_name[op->op_type]);
  2975.     }
  2976.     s = sv_2pv(sv, lp);
  2977.     if (s != SvPVX(sv)) {    /* Almost, but not quite, sv_setpvn() */
  2978.         STRLEN len = *lp;
  2979.         
  2980.         if (SvROK(sv))
  2981.         sv_unref(sv);
  2982.         (void)SvUPGRADE(sv, SVt_PV);        /* Never FALSE */
  2983.         SvGROW(sv, len + 1);
  2984.         Move(s,SvPVX(sv),len,char);
  2985.         SvCUR_set(sv, len);
  2986.         *SvEND(sv) = '\0';
  2987.     }
  2988.     if (!SvPOK(sv)) {
  2989.         SvPOK_on(sv);        /* validate pointer */
  2990.         SvTAINT(sv);
  2991.         DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",
  2992.         (unsigned long)sv,SvPVX(sv)));
  2993.     }
  2994.     }
  2995.     return SvPVX(sv);
  2996. }
  2997.  
  2998. char *
  2999. sv_reftype(sv, ob)
  3000. SV* sv;
  3001. int ob;
  3002. {
  3003.     if (ob && SvOBJECT(sv))
  3004.     return HvNAME(SvSTASH(sv));
  3005.     else {
  3006.     switch (SvTYPE(sv)) {
  3007.     case SVt_NULL:
  3008.     case SVt_IV:
  3009.     case SVt_NV:
  3010.     case SVt_RV:
  3011.     case SVt_PV:
  3012.     case SVt_PVIV:
  3013.     case SVt_PVNV:
  3014.     case SVt_PVMG:
  3015.     case SVt_PVBM:
  3016.                 if (SvROK(sv))
  3017.                     return "REF";
  3018.                 else
  3019.                     return "SCALAR";
  3020.     case SVt_PVLV:        return "LVALUE";
  3021.     case SVt_PVAV:        return "ARRAY";
  3022.     case SVt_PVHV:        return "HASH";
  3023.     case SVt_PVCV:        return "CODE";
  3024.     case SVt_PVGV:        return "GLOB";
  3025.     case SVt_PVFM:        return "FORMLINE";
  3026.     default:        return "UNKNOWN";
  3027.     }
  3028.     }
  3029. }
  3030.  
  3031. int
  3032. sv_isobject(sv)
  3033. SV *sv;
  3034. {
  3035.     if (!SvROK(sv))
  3036.     return 0;
  3037.     sv = (SV*)SvRV(sv);
  3038.     if (!SvOBJECT(sv))
  3039.     return 0;
  3040.     return 1;
  3041. }
  3042.  
  3043. int
  3044. sv_isa(sv, name)
  3045. SV *sv;
  3046. char *name;
  3047. {
  3048.     if (!SvROK(sv))
  3049.     return 0;
  3050.     sv = (SV*)SvRV(sv);
  3051.     if (!SvOBJECT(sv))
  3052.     return 0;
  3053.  
  3054.     return strEQ(HvNAME(SvSTASH(sv)), name);
  3055. }
  3056.  
  3057. SV*
  3058. newSVrv(rv, classname)
  3059. SV *rv;
  3060. char *classname;
  3061. {
  3062.     SV *sv;
  3063.  
  3064.     new_SV();
  3065.     SvANY(sv) = 0;
  3066.     SvREFCNT(sv) = 0;
  3067.     SvFLAGS(sv) = 0;
  3068.     sv_upgrade(rv, SVt_RV);
  3069.     SvRV(rv) = SvREFCNT_inc(sv);
  3070.     SvROK_on(rv);
  3071.  
  3072.     if (classname) {
  3073.     HV* stash = gv_stashpv(classname, TRUE);
  3074.     (void)sv_bless(rv, stash);
  3075.     }
  3076.     return sv;
  3077. }
  3078.  
  3079. SV*
  3080. sv_setref_pv(rv, classname, pv)
  3081. SV *rv;
  3082. char *classname;
  3083. void* pv;
  3084. {
  3085.     if (!pv)
  3086.     sv_setsv(rv, &sv_undef);
  3087.     else
  3088.     sv_setiv(newSVrv(rv,classname), (IV)pv);
  3089.     return rv;
  3090. }
  3091.  
  3092. SV*
  3093. sv_setref_iv(rv, classname, iv)
  3094. SV *rv;
  3095. char *classname;
  3096. IV iv;
  3097. {
  3098.     sv_setiv(newSVrv(rv,classname), iv);
  3099.     return rv;
  3100. }
  3101.  
  3102. SV*
  3103. sv_setref_nv(rv, classname, nv)
  3104. SV *rv;
  3105. char *classname;
  3106. double nv;
  3107. {
  3108.     sv_setnv(newSVrv(rv,classname), nv);
  3109.     return rv;
  3110. }
  3111.  
  3112. SV*
  3113. sv_setref_pvn(rv, classname, pv, n)
  3114. SV *rv;
  3115. char *classname;
  3116. char* pv;
  3117. I32 n;
  3118. {
  3119.     sv_setpvn(newSVrv(rv,classname), pv, n);
  3120.     return rv;
  3121. }
  3122.  
  3123. SV*
  3124. sv_bless(sv,stash)
  3125. SV* sv;
  3126. HV* stash;
  3127. {
  3128.     SV *ref;
  3129.     if (!SvROK(sv))
  3130.         croak("Can't bless non-reference value");
  3131.     ref = SvRV(sv);
  3132.     if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
  3133.     if (SvREADONLY(ref))
  3134.         croak(no_modify);
  3135.     if (SvOBJECT(ref) && SvTYPE(ref) != SVt_PVIO)
  3136.         --sv_objcount;
  3137.     }
  3138.     SvOBJECT_on(ref);
  3139.     ++sv_objcount;
  3140.     (void)SvUPGRADE(ref, SVt_PVMG);
  3141.     SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
  3142.  
  3143. #ifdef OVERLOAD
  3144.     SvAMAGIC_off(sv);
  3145.     if (Gv_AMG(stash)) {
  3146.       SvAMAGIC_on(sv);
  3147.     }
  3148. #endif /* OVERLOAD */
  3149.  
  3150.     return sv;
  3151. }
  3152.  
  3153. static void
  3154. sv_unglob(sv)
  3155. SV* sv;
  3156. {
  3157.     assert(SvTYPE(sv) == SVt_PVGV);
  3158.     SvFAKE_off(sv);
  3159.     if (GvGP(sv))
  3160.     gp_free(sv);
  3161.     sv_unmagic(sv, '*');
  3162.     Safefree(GvNAME(sv));
  3163.     SvFLAGS(sv) &= ~SVTYPEMASK;
  3164.     SvFLAGS(sv) |= SVt_PVMG;
  3165. }
  3166.  
  3167. void
  3168. sv_unref(sv)
  3169. SV* sv;
  3170. {
  3171.     SV* rv = SvRV(sv);
  3172.     
  3173.     SvRV(sv) = 0;
  3174.     SvROK_off(sv);
  3175.     SvREFCNT_dec(rv);
  3176. }
  3177.  
  3178. #ifdef DEBUGGING
  3179. void
  3180. sv_dump(sv)
  3181. SV* sv;
  3182. {
  3183.     char tmpbuf[1024];
  3184.     char *d = tmpbuf;
  3185.     U32 flags;
  3186.     U32 type;
  3187.  
  3188.     if (!sv) {
  3189.     fprintf(stderr, "SV = 0\n");
  3190.     return;
  3191.     }
  3192.     
  3193.     flags = SvFLAGS(sv);
  3194.     type = SvTYPE(sv);
  3195.  
  3196.     sprintf(d, "(0x%lx)\n  REFCNT = %ld\n  FLAGS = (",
  3197.     (unsigned long)SvANY(sv), (long)SvREFCNT(sv));
  3198.     d += strlen(d);
  3199.     if (flags & SVs_PADBUSY)    strcat(d, "PADBUSY,");
  3200.     if (flags & SVs_PADTMP)    strcat(d, "PADTMP,");
  3201.     if (flags & SVs_PADMY)    strcat(d, "PADMY,");
  3202.     if (flags & SVs_TEMP)    strcat(d, "TEMP,");
  3203.     if (flags & SVs_OBJECT)    strcat(d, "OBJECT,");
  3204.     if (flags & SVs_GMG)    strcat(d, "GMG,");
  3205.     if (flags & SVs_SMG)    strcat(d, "SMG,");
  3206.     if (flags & SVs_RMG)    strcat(d, "RMG,");
  3207.     d += strlen(d);
  3208.  
  3209.     if (flags & SVf_IOK)    strcat(d, "IOK,");
  3210.     if (flags & SVf_NOK)    strcat(d, "NOK,");
  3211.     if (flags & SVf_POK)    strcat(d, "POK,");
  3212.     if (flags & SVf_ROK)    strcat(d, "ROK,");
  3213.     if (flags & SVf_OOK)    strcat(d, "OOK,");
  3214.     if (flags & SVf_FAKE)    strcat(d, "FAKE,");
  3215.     if (flags & SVf_READONLY)    strcat(d, "READONLY,");
  3216.     d += strlen(d);
  3217.  
  3218.     if (flags & SVp_IOK)    strcat(d, "pIOK,");
  3219.     if (flags & SVp_NOK)    strcat(d, "pNOK,");
  3220.     if (flags & SVp_POK)    strcat(d, "pPOK,");
  3221.     if (flags & SVp_SCREAM)    strcat(d, "SCREAM,");
  3222.     d += strlen(d);
  3223.     if (d[-1] == ',')
  3224.     d--;
  3225.     *d++ = ')';
  3226.     *d = '\0';
  3227.  
  3228.     fprintf(stderr, "SV = ");
  3229.     switch (type) {
  3230.     case SVt_NULL:
  3231.     fprintf(stderr,"NULL%s\n", tmpbuf);
  3232.     return;
  3233.     case SVt_IV:
  3234.     fprintf(stderr,"IV%s\n", tmpbuf);
  3235.     break;
  3236.     case SVt_NV:
  3237.     fprintf(stderr,"NV%s\n", tmpbuf);
  3238.     break;
  3239.     case SVt_RV:
  3240.     fprintf(stderr,"RV%s\n", tmpbuf);
  3241.     break;
  3242.     case SVt_PV:
  3243.     fprintf(stderr,"PV%s\n", tmpbuf);
  3244.     break;
  3245.     case SVt_PVIV:
  3246.     fprintf(stderr,"PVIV%s\n", tmpbuf);
  3247.     break;
  3248.     case SVt_PVNV:
  3249.     fprintf(stderr,"PVNV%s\n", tmpbuf);
  3250.     break;
  3251.     case SVt_PVBM:
  3252.     fprintf(stderr,"PVBM%s\n", tmpbuf);
  3253.     break;
  3254.     case SVt_PVMG:
  3255.     fprintf(stderr,"PVMG%s\n", tmpbuf);
  3256.     break;
  3257.     case SVt_PVLV:
  3258.     fprintf(stderr,"PVLV%s\n", tmpbuf);
  3259.     break;
  3260.     case SVt_PVAV:
  3261.     fprintf(stderr,"PVAV%s\n", tmpbuf);
  3262.     break;
  3263.     case SVt_PVHV:
  3264.     fprintf(stderr,"PVHV%s\n", tmpbuf);
  3265.     break;
  3266.     case SVt_PVCV:
  3267.     fprintf(stderr,"PVCV%s\n", tmpbuf);
  3268.     break;
  3269.     case SVt_PVGV:
  3270.     fprintf(stderr,"PVGV%s\n", tmpbuf);
  3271.     break;
  3272.     case SVt_PVFM:
  3273.     fprintf(stderr,"PVFM%s\n", tmpbuf);
  3274.     break;
  3275.     case SVt_PVIO:
  3276.     fprintf(stderr,"PVIO%s\n", tmpbuf);
  3277.     break;
  3278.     default:
  3279.     fprintf(stderr,"UNKNOWN%s\n", tmpbuf);
  3280.     return;
  3281.     }
  3282.     if (type >= SVt_PVIV || type == SVt_IV)
  3283.     fprintf(stderr, "  IV = %ld\n", (long)SvIVX(sv));
  3284.     if (type >= SVt_PVNV || type == SVt_NV)
  3285.     fprintf(stderr, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
  3286.     if (SvROK(sv)) {
  3287.     fprintf(stderr, "  RV = 0x%lx\n", (long)SvRV(sv));
  3288.     sv_dump(SvRV(sv));
  3289.     return;
  3290.     }
  3291.     if (type < SVt_PV)
  3292.     return;
  3293.     if (type <= SVt_PVLV) {
  3294.     if (SvPVX(sv))
  3295.         fprintf(stderr, "  PV = 0x%lx \"%s\"\n  CUR = %ld\n  LEN = %ld\n",
  3296.         (long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv));
  3297.     else
  3298.         fprintf(stderr, "  PV = 0\n");
  3299.     }
  3300.     if (type >= SVt_PVMG) {
  3301.     if (SvMAGIC(sv)) {
  3302.         fprintf(stderr, "  MAGIC = 0x%lx\n", (long)SvMAGIC(sv));
  3303.     }
  3304.     if (SvSTASH(sv))
  3305.         fprintf(stderr, "  STASH = %s\n", HvNAME(SvSTASH(sv)));
  3306.     }
  3307.     switch (type) {
  3308.     case SVt_PVLV:
  3309.     fprintf(stderr, "  TYPE = %c\n", LvTYPE(sv));
  3310.     fprintf(stderr, "  TARGOFF = %ld\n", (long)LvTARGOFF(sv));
  3311.     fprintf(stderr, "  TARGLEN = %ld\n", (long)LvTARGLEN(sv));
  3312.     fprintf(stderr, "  TARG = 0x%lx\n", (long)LvTARG(sv));
  3313.     sv_dump(LvTARG(sv));
  3314.     break;
  3315.     case SVt_PVAV:
  3316.     fprintf(stderr, "  ARRAY = 0x%lx\n", (long)AvARRAY(sv));
  3317.     fprintf(stderr, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
  3318.     fprintf(stderr, "  FILL = %ld\n", (long)AvFILL(sv));
  3319.     fprintf(stderr, "  MAX = %ld\n", (long)AvMAX(sv));
  3320.     fprintf(stderr, "  ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
  3321.     if (AvREAL(sv))
  3322.         fprintf(stderr, "  FLAGS = (REAL)\n");
  3323.     else
  3324.         fprintf(stderr, "  FLAGS = ()\n");
  3325.     break;
  3326.     case SVt_PVHV:
  3327.     fprintf(stderr, "  ARRAY = 0x%lx\n",(long)HvARRAY(sv));
  3328.     fprintf(stderr, "  KEYS = %ld\n", (long)HvKEYS(sv));
  3329.     fprintf(stderr, "  FILL = %ld\n", (long)HvFILL(sv));
  3330.     fprintf(stderr, "  MAX = %ld\n", (long)HvMAX(sv));
  3331.     fprintf(stderr, "  RITER = %ld\n", (long)HvRITER(sv));
  3332.     fprintf(stderr, "  EITER = 0x%lx\n",(long) HvEITER(sv));
  3333.     if (HvPMROOT(sv))
  3334.         fprintf(stderr, "  PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
  3335.     if (HvNAME(sv))
  3336.         fprintf(stderr, "  NAME = \"%s\"\n", HvNAME(sv));
  3337.     break;
  3338.     case SVt_PVFM:
  3339.     case SVt_PVCV:
  3340.     fprintf(stderr, "  STASH = 0x%lx\n", (long)CvSTASH(sv));
  3341.     fprintf(stderr, "  START = 0x%lx\n", (long)CvSTART(sv));
  3342.     fprintf(stderr, "  ROOT = 0x%lx\n", (long)CvROOT(sv));
  3343.     fprintf(stderr, "  XSUB = 0x%lx\n", (long)CvXSUB(sv));
  3344.     fprintf(stderr, "  XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32);
  3345.     fprintf(stderr, "  FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
  3346.     fprintf(stderr, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
  3347.     fprintf(stderr, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
  3348.     if (type == SVt_PVFM)
  3349.         fprintf(stderr, "  LINES = %ld\n", (long)FmLINES(sv));
  3350.     break;
  3351.     case SVt_PVGV:
  3352.     fprintf(stderr, "  NAME = %s\n", GvNAME(sv));
  3353.     fprintf(stderr, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
  3354.     fprintf(stderr, "  STASH = 0x%lx\n", (long)GvSTASH(sv));
  3355.     fprintf(stderr, "  GP = 0x%lx\n", (long)GvGP(sv));
  3356.     fprintf(stderr, "    SV = 0x%lx\n", (long)GvSV(sv));
  3357.     fprintf(stderr, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
  3358.     fprintf(stderr, "    IO = 0x%lx\n", (long)GvIOp(sv));
  3359.     fprintf(stderr, "    FORM = 0x%lx\n", (long)GvFORM(sv));
  3360.     fprintf(stderr, "    AV = 0x%lx\n", (long)GvAV(sv));
  3361.     fprintf(stderr, "    HV = 0x%lx\n", (long)GvHV(sv));
  3362.     fprintf(stderr, "    CV = 0x%lx\n", (long)GvCV(sv));
  3363.     fprintf(stderr, "    CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
  3364.     fprintf(stderr, "    LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
  3365.     fprintf(stderr, "    LINE = %ld\n", (long)GvLINE(sv));
  3366.     fprintf(stderr, "    FLAGS = 0x%x\n", (int)GvFLAGS(sv));
  3367.     fprintf(stderr, "    STASH = 0x%lx\n", (long)GvSTASH(sv));
  3368.     fprintf(stderr, "    EGV = 0x%lx\n", (long)GvEGV(sv));
  3369.     break;
  3370.     case SVt_PVIO:
  3371.     fprintf(stderr, "  IFP = 0x%lx\n", (long)IoIFP(sv));
  3372.     fprintf(stderr, "  OFP = 0x%lx\n", (long)IoOFP(sv));
  3373.     fprintf(stderr, "  DIRP = 0x%lx\n", (long)IoDIRP(sv));
  3374.     fprintf(stderr, "  LINES = %ld\n", (long)IoLINES(sv));
  3375.     fprintf(stderr, "  PAGE = %ld\n", (long)IoPAGE(sv));
  3376.     fprintf(stderr, "  PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv));
  3377.     fprintf(stderr, "  LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv));
  3378.     fprintf(stderr, "  TOP_NAME = %s\n", IoTOP_NAME(sv));
  3379.     fprintf(stderr, "  TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv));
  3380.     fprintf(stderr, "  FMT_NAME = %s\n", IoFMT_NAME(sv));
  3381.     fprintf(stderr, "  FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv));
  3382.     fprintf(stderr, "  BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv));
  3383.     fprintf(stderr, "  BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv));
  3384.     fprintf(stderr, "  SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
  3385.     fprintf(stderr, "  TYPE = %c\n", IoTYPE(sv));
  3386.     fprintf(stderr, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
  3387.     break;
  3388.     }
  3389. }
  3390. #else
  3391. void
  3392. sv_dump(sv)
  3393. SV* sv;
  3394. {
  3395. }
  3396. #endif
  3397.  
  3398. IO*
  3399. sv_2io(sv)
  3400. SV *sv;
  3401. {
  3402.     IO* io;
  3403.     GV* gv;
  3404.  
  3405.     switch (SvTYPE(sv)) {
  3406.     case SVt_PVIO:
  3407.     io = (IO*)sv;
  3408.     break;
  3409.     case SVt_PVGV:
  3410.     gv = (GV*)sv;
  3411.     io = GvIO(gv);
  3412.     if (!io)
  3413.         croak("Bad filehandle: %s", GvNAME(gv));
  3414.     break;
  3415.     default:
  3416.     if (!SvOK(sv))
  3417.         croak(no_usym, "filehandle");
  3418.     if (SvROK(sv))
  3419.         return sv_2io(SvRV(sv));
  3420.     gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
  3421.     if (gv)
  3422.         io = GvIO(gv);
  3423.     else
  3424.         io = 0;
  3425.     if (!io)
  3426.         croak("Bad filehandle: %s", SvPV(sv,na));
  3427.     break;
  3428.     }
  3429.     return io;
  3430. }
  3431.  
  3432.