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