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