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