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