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