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