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