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