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