This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 2
[perl5.git] / sv.c
CommitLineData
79072805
LW
1/* $RCSfile: sv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:45 $
2 *
3 * Copyright (c) 1991, Larry Wall
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 *
8 * $Log: sv.c,v $
9 * Revision 4.1 92/08/07 18:26:45 lwall
10 *
11 * Revision 4.0.1.6 92/06/11 21:14:21 lwall
12 * patch34: quotes containing subscripts containing variables didn't parse right
13 *
14 * Revision 4.0.1.5 92/06/08 15:40:43 lwall
15 * patch20: removed implicit int declarations on functions
16 * patch20: Perl now distinguishes overlapped copies from non-overlapped
17 * patch20: paragraph mode now skips extra newlines automatically
18 * patch20: fixed memory leak in doube-quote interpretation
19 * patch20: made /\$$foo/ look for literal '$foo'
20 * patch20: "$var{$foo'bar}" didn't scan subscript correctly
21 * patch20: a splice on non-existent array elements could dump core
22 * patch20: running taintperl explicitly now does checks even if $< == $>
23 *
24 * Revision 4.0.1.4 91/11/05 18:40:51 lwall
25 * patch11: $foo .= <BAR> could overrun malloced memory
26 * patch11: \$ didn't always make it through double-quoter to regexp routines
27 * patch11: prepared for ctype implementations that don't define isascii()
28 *
29 * Revision 4.0.1.3 91/06/10 01:27:54 lwall
30 * patch10: $) and $| incorrectly handled in run-time patterns
31 *
32 * Revision 4.0.1.2 91/06/07 11:58:13 lwall
33 * patch4: new copyright notice
34 * patch4: taint check on undefined string could cause core dump
35 *
36 * Revision 4.0.1.1 91/04/12 09:15:30 lwall
37 * patch1: fixed undefined environ problem
38 * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
39 * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
40 *
41 * Revision 4.0 91/03/20 01:39:55 lwall
42 * 4.0 baseline.
43 *
44 */
45
46#include "EXTERN.h"
47#include "perl.h"
48#include "perly.h"
49
50static void ucase();
51static void lcase();
52
53bool
54sv_upgrade(sv, mt)
55register SV* sv;
56U32 mt;
57{
58 char* pv;
59 U32 cur;
60 U32 len;
61 I32 iv;
62 double nv;
63 MAGIC* magic;
64 HV* stash;
65
66 if (SvTYPE(sv) == mt)
67 return TRUE;
68
69 switch (SvTYPE(sv)) {
70 case SVt_NULL:
71 pv = 0;
72 cur = 0;
73 len = 0;
74 iv = 0;
75 nv = 0.0;
76 magic = 0;
77 stash = 0;
78 break;
79 case SVt_REF:
80 sv_free((SV*)SvANY(sv));
81 pv = 0;
82 cur = 0;
83 len = 0;
84 iv = SvANYI32(sv);
85 nv = (double)SvANYI32(sv);
86 SvNOK_only(sv);
87 magic = 0;
88 stash = 0;
89 if (mt == SVt_PV)
90 mt = SVt_PVIV;
91 break;
92 case SVt_IV:
93 pv = 0;
94 cur = 0;
95 len = 0;
96 iv = SvIV(sv);
97 nv = (double)SvIV(sv);
98 del_XIV(SvANY(sv));
99 magic = 0;
100 stash = 0;
101 if (mt == SVt_PV)
102 mt = SVt_PVIV;
103 break;
104 case SVt_NV:
105 pv = 0;
106 cur = 0;
107 len = 0;
108 if (SvIOK(sv))
109 iv = SvIV(sv);
110 else
111 iv = (I32)SvNV(sv);
112 nv = SvNV(sv);
113 magic = 0;
114 stash = 0;
115 del_XNV(SvANY(sv));
116 SvANY(sv) = 0;
117 if (mt == SVt_PV || mt == SVt_PVIV)
118 mt = SVt_PVNV;
119 break;
120 case SVt_PV:
121 nv = 0.0;
122 pv = SvPV(sv);
123 cur = SvCUR(sv);
124 len = SvLEN(sv);
125 iv = 0;
126 nv = 0.0;
127 magic = 0;
128 stash = 0;
129 del_XPV(SvANY(sv));
130 break;
131 case SVt_PVIV:
132 nv = 0.0;
133 pv = SvPV(sv);
134 cur = SvCUR(sv);
135 len = SvLEN(sv);
136 iv = SvIV(sv);
137 nv = 0.0;
138 magic = 0;
139 stash = 0;
140 del_XPVIV(SvANY(sv));
141 break;
142 case SVt_PVNV:
143 nv = SvNV(sv);
144 pv = SvPV(sv);
145 cur = SvCUR(sv);
146 len = SvLEN(sv);
147 iv = SvIV(sv);
148 nv = SvNV(sv);
149 magic = 0;
150 stash = 0;
151 del_XPVNV(SvANY(sv));
152 break;
153 case SVt_PVMG:
154 pv = SvPV(sv);
155 cur = SvCUR(sv);
156 len = SvLEN(sv);
157 iv = SvIV(sv);
158 nv = SvNV(sv);
159 magic = SvMAGIC(sv);
160 stash = SvSTASH(sv);
161 del_XPVMG(SvANY(sv));
162 break;
163 default:
164 fatal("Can't upgrade that kind of scalar");
165 }
166
167 switch (mt) {
168 case SVt_NULL:
169 fatal("Can't upgrade to undef");
170 case SVt_REF:
171 SvIOK_on(sv);
172 break;
173 case SVt_IV:
174 SvANY(sv) = new_XIV();
175 SvIV(sv) = iv;
176 break;
177 case SVt_NV:
178 SvANY(sv) = new_XNV();
179 SvIV(sv) = iv;
180 SvNV(sv) = nv;
181 break;
182 case SVt_PV:
183 SvANY(sv) = new_XPV();
184 SvPV(sv) = pv;
185 SvCUR(sv) = cur;
186 SvLEN(sv) = len;
187 break;
188 case SVt_PVIV:
189 SvANY(sv) = new_XPVIV();
190 SvPV(sv) = pv;
191 SvCUR(sv) = cur;
192 SvLEN(sv) = len;
193 SvIV(sv) = iv;
194 if (SvNIOK(sv))
195 SvIOK_on(sv);
196 SvNOK_off(sv);
197 break;
198 case SVt_PVNV:
199 SvANY(sv) = new_XPVNV();
200 SvPV(sv) = pv;
201 SvCUR(sv) = cur;
202 SvLEN(sv) = len;
203 SvIV(sv) = iv;
204 SvNV(sv) = nv;
205 break;
206 case SVt_PVMG:
207 SvANY(sv) = new_XPVMG();
208 SvPV(sv) = pv;
209 SvCUR(sv) = cur;
210 SvLEN(sv) = len;
211 SvIV(sv) = iv;
212 SvNV(sv) = nv;
213 SvMAGIC(sv) = magic;
214 SvSTASH(sv) = stash;
215 break;
216 case SVt_PVLV:
217 SvANY(sv) = new_XPVLV();
218 SvPV(sv) = pv;
219 SvCUR(sv) = cur;
220 SvLEN(sv) = len;
221 SvIV(sv) = iv;
222 SvNV(sv) = nv;
223 SvMAGIC(sv) = magic;
224 SvSTASH(sv) = stash;
225 LvTARGOFF(sv) = 0;
226 LvTARGLEN(sv) = 0;
227 LvTARG(sv) = 0;
228 LvTYPE(sv) = 0;
229 break;
230 case SVt_PVAV:
231 SvANY(sv) = new_XPVAV();
232 SvPV(sv) = pv;
233 SvCUR(sv) = cur;
234 SvLEN(sv) = len;
235 SvIV(sv) = iv;
236 SvNV(sv) = nv;
237 SvMAGIC(sv) = magic;
238 SvSTASH(sv) = stash;
239 AvMAGIC(sv) = 0;
240 AvARRAY(sv) = 0;
241 AvALLOC(sv) = 0;
242 AvMAX(sv) = 0;
243 AvFILL(sv) = 0;
244 AvARYLEN(sv) = 0;
245 AvFLAGS(sv) = 0;
246 break;
247 case SVt_PVHV:
248 SvANY(sv) = new_XPVHV();
249 SvPV(sv) = pv;
250 SvCUR(sv) = cur;
251 SvLEN(sv) = len;
252 SvIV(sv) = iv;
253 SvNV(sv) = nv;
254 SvMAGIC(sv) = magic;
255 SvSTASH(sv) = stash;
256 HvMAGIC(sv) = 0;
257 HvARRAY(sv) = 0;
258 HvMAX(sv) = 0;
259 HvDOSPLIT(sv) = 0;
260 HvFILL(sv) = 0;
261 HvRITER(sv) = 0;
262 HvEITER(sv) = 0;
263 HvPMROOT(sv) = 0;
264 HvNAME(sv) = 0;
265 HvDBM(sv) = 0;
266 HvCOEFFSIZE(sv) = 0;
267 break;
268 case SVt_PVCV:
269 SvANY(sv) = new_XPVCV();
270 SvPV(sv) = pv;
271 SvCUR(sv) = cur;
272 SvLEN(sv) = len;
273 SvIV(sv) = iv;
274 SvNV(sv) = nv;
275 SvMAGIC(sv) = magic;
276 SvSTASH(sv) = stash;
277 CvSTASH(sv) = 0;
278 CvSTART(sv) = 0;
279 CvROOT(sv) = 0;
280 CvUSERSUB(sv) = 0;
281 CvUSERINDEX(sv) = 0;
282 CvFILEGV(sv) = 0;
283 CvDEPTH(sv) = 0;
284 CvPADLIST(sv) = 0;
285 CvDELETED(sv) = 0;
286 break;
287 case SVt_PVGV:
288 SvANY(sv) = new_XPVGV();
289 SvPV(sv) = pv;
290 SvCUR(sv) = cur;
291 SvLEN(sv) = len;
292 SvIV(sv) = iv;
293 SvNV(sv) = nv;
294 SvMAGIC(sv) = magic;
295 SvSTASH(sv) = stash;
296 GvNAME(sv) = 0;
297 GvNAMELEN(sv) = 0;
298 GvSTASH(sv) = 0;
299 break;
300 case SVt_PVBM:
301 SvANY(sv) = new_XPVBM();
302 SvPV(sv) = pv;
303 SvCUR(sv) = cur;
304 SvLEN(sv) = len;
305 SvIV(sv) = iv;
306 SvNV(sv) = nv;
307 SvMAGIC(sv) = magic;
308 SvSTASH(sv) = stash;
309 BmRARE(sv) = 0;
310 BmUSEFUL(sv) = 0;
311 BmPREVIOUS(sv) = 0;
312 break;
313 case SVt_PVFM:
314 SvANY(sv) = new_XPVFM();
315 SvPV(sv) = pv;
316 SvCUR(sv) = cur;
317 SvLEN(sv) = len;
318 SvIV(sv) = iv;
319 SvNV(sv) = nv;
320 SvMAGIC(sv) = magic;
321 SvSTASH(sv) = stash;
322 FmLINES(sv) = 0;
323 break;
324 }
325 SvTYPE(sv) = mt;
326 return TRUE;
327}
328
329char *
330sv_peek(sv)
331register SV *sv;
332{
333 char *t = tokenbuf;
334 *t = '\0';
335
336 retry:
337 if (!sv) {
338 strcpy(t, "VOID");
339 return tokenbuf;
340 }
341 else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
342 strcpy(t, "WILD");
343 return tokenbuf;
344 }
345 else if (SvREFCNT(sv) == 0 && !SvREADONLY(sv)) {
346 strcpy(t, "UNREF");
347 return tokenbuf;
348 }
349 else {
350 switch (SvTYPE(sv)) {
351 default:
352 strcpy(t,"FREED");
353 return tokenbuf;
354 break;
355
356 case SVt_NULL:
357 return "UNDEF";
358 case SVt_REF:
359 strcpy(t, "\\");
360 t += strlen(t);
361 sv = (SV*)SvANY(sv);
362 goto retry;
363 case SVt_IV:
364 strcpy(t,"IV");
365 break;
366 case SVt_NV:
367 strcpy(t,"NV");
368 break;
369 case SVt_PV:
370 strcpy(t,"PV");
371 break;
372 case SVt_PVIV:
373 strcpy(t,"PVIV");
374 break;
375 case SVt_PVNV:
376 strcpy(t,"PVNV");
377 break;
378 case SVt_PVMG:
379 strcpy(t,"PVMG");
380 break;
381 case SVt_PVLV:
382 strcpy(t,"PVLV");
383 break;
384 case SVt_PVAV:
385 strcpy(t,"AV");
386 break;
387 case SVt_PVHV:
388 strcpy(t,"HV");
389 break;
390 case SVt_PVCV:
391 strcpy(t,"CV");
392 break;
393 case SVt_PVGV:
394 strcpy(t,"GV");
395 break;
396 case SVt_PVBM:
397 strcpy(t,"BM");
398 break;
399 case SVt_PVFM:
400 strcpy(t,"FM");
401 break;
402 }
403 }
404 t += strlen(t);
405
406 if (SvPOK(sv)) {
407 if (!SvPV(sv))
408 return "(null)";
409 if (SvOOK(sv))
410 sprintf(t,"(%d+\"%0.127s\")",SvIV(sv),SvPV(sv));
411 else
412 sprintf(t,"(\"%0.127s\")",SvPV(sv));
413 }
414 else if (SvNOK(sv))
415 sprintf(t,"(%g)",SvNV(sv));
416 else if (SvIOK(sv))
417 sprintf(t,"(%ld)",(long)SvIV(sv));
418 else
419 strcpy(t,"()");
420 return tokenbuf;
421}
422
423int
424sv_backoff(sv)
425register SV *sv;
426{
427 assert(SvOOK(sv));
428 if (SvIV(sv)) {
429 char *s = SvPV(sv);
430 SvLEN(sv) += SvIV(sv);
431 SvPV(sv) -= SvIV(sv);
432 SvIV_set(sv, 0);
433 Move(s, SvPV(sv), SvCUR(sv)+1, char);
434 }
435 SvFLAGS(sv) &= ~SVf_OOK;
436}
437
438char *
439sv_grow(sv,newlen)
440register SV *sv;
441#ifndef DOSISH
442register I32 newlen;
443#else
444unsigned long newlen;
445#endif
446{
447 register char *s;
448
449#ifdef MSDOS
450 if (newlen >= 0x10000) {
451 fprintf(stderr, "Allocation too large: %lx\n", newlen);
452 my_exit(1);
453 }
454#endif /* MSDOS */
455 if (SvREADONLY(sv))
456 fatal(no_modify);
457 if (SvTYPE(sv) < SVt_PV) {
458 sv_upgrade(sv, SVt_PV);
459 s = SvPV(sv);
460 }
461 else if (SvOOK(sv)) { /* pv is offset? */
462 sv_backoff(sv);
463 s = SvPV(sv);
464 if (newlen > SvLEN(sv))
465 newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
466 }
467 else
468 s = SvPV(sv);
469 if (newlen > SvLEN(sv)) { /* need more room? */
470 if (SvLEN(sv))
471 Renew(s,newlen,char);
472 else
473 New(703,s,newlen,char);
474 SvPV_set(sv, s);
475 SvLEN_set(sv, newlen);
476 }
477 return s;
478}
479
480void
481sv_setiv(sv,i)
482register SV *sv;
483I32 i;
484{
485 if (SvREADONLY(sv))
486 fatal(no_modify);
487 if (SvTYPE(sv) < SVt_IV)
488 sv_upgrade(sv, SVt_IV);
489 else if (SvTYPE(sv) == SVt_PV)
490 sv_upgrade(sv, SVt_PVIV);
491 SvIV(sv) = i;
492 SvIOK_only(sv); /* validate number */
493 SvTDOWN(sv);
494}
495
496void
497sv_setnv(sv,num)
498register SV *sv;
499double num;
500{
501 if (SvREADONLY(sv))
502 fatal(no_modify);
503 if (SvTYPE(sv) < SVt_NV)
504 sv_upgrade(sv, SVt_NV);
505 else if (SvTYPE(sv) < SVt_PVNV)
506 sv_upgrade(sv, SVt_PVNV);
507 else if (SvPOK(sv)) {
508 SvOOK_off(sv);
509 }
510 SvNV(sv) = num;
511 SvNOK_only(sv); /* validate number */
512 SvTDOWN(sv);
513}
514
515I32
516sv_2iv(sv)
517register SV *sv;
518{
519 if (!sv)
520 return 0;
521 if (SvREADONLY(sv)) {
522 if (SvNOK(sv))
523 return (I32)SvNV(sv);
524 if (SvPOK(sv) && SvLEN(sv))
525 return atof(SvPV(sv));
526 if (dowarn)
527 warn("Use of uninitialized variable");
528 return 0;
529 }
530 if (SvTYPE(sv) < SVt_IV) {
531 if (SvTYPE(sv) == SVt_REF)
532 return (I32)SvANYI32(sv);
533 sv_upgrade(sv, SVt_IV);
534 DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvIV(sv)));
535 return SvIV(sv);
536 }
537 else if (SvTYPE(sv) == SVt_PV)
538 sv_upgrade(sv, SVt_PVIV);
539 if (SvNOK(sv))
540 SvIV(sv) = (I32)SvNV(sv);
541 else if (SvPOK(sv) && SvLEN(sv))
542 SvIV(sv) = atol(SvPV(sv));
543 else {
544 if (dowarn)
545 warn("Use of uninitialized variable");
546 SvUPGRADE(sv, SVt_IV);
547 SvIV(sv) = 0;
548 }
549 SvIOK_on(sv);
550 DEBUG_c((stderr,"0x%lx 2iv(%d)\n",sv,SvIV(sv)));
551 return SvIV(sv);
552}
553
554double
555sv_2nv(sv)
556register SV *sv;
557{
558 if (!sv)
559 return 0.0;
560 if (SvREADONLY(sv)) {
561 if (SvPOK(sv) && SvLEN(sv))
562 return atof(SvPV(sv));
563 if (dowarn)
564 warn("Use of uninitialized variable");
565 return 0.0;
566 }
567 if (SvTYPE(sv) < SVt_NV) {
568 if (SvTYPE(sv) == SVt_REF)
569 return (double)SvANYI32(sv);
570 sv_upgrade(sv, SVt_NV);
571 DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvNV(sv)));
572 return SvNV(sv);
573 }
574 else if (SvTYPE(sv) < SVt_PVNV)
575 sv_upgrade(sv, SVt_PVNV);
576 if (SvPOK(sv) && SvLEN(sv))
577 SvNV(sv) = atof(SvPV(sv));
578 else if (SvIOK(sv))
579 SvNV(sv) = (double)SvIV(sv);
580 else {
581 if (dowarn)
582 warn("Use of uninitialized variable");
583 SvNV(sv) = 0.0;
584 }
585 SvNOK_on(sv);
586 DEBUG_c((stderr,"0x%lx 2nv(%g)\n",sv,SvNV(sv)));
587 return SvNV(sv);
588}
589
590char *
591sv_2pv(sv)
592register SV *sv;
593{
594 register char *s;
595 int olderrno;
596
597 if (!sv)
598 return "";
599 if (SvTYPE(sv) == SVt_REF) {
600 sv = (SV*)SvANY(sv);
601 if (!sv)
602 return "<Empty reference>";
603 switch (SvTYPE(sv)) {
604 case SVt_NULL: s = "an undefined value"; break;
605 case SVt_REF: s = "a reference"; break;
606 case SVt_IV: s = "an integer value"; break;
607 case SVt_NV: s = "a numeric value"; break;
608 case SVt_PV: s = "a string value"; break;
609 case SVt_PVIV: s = "a string+integer value"; break;
610 case SVt_PVNV: s = "a scalar value"; break;
611 case SVt_PVMG: s = "a magic value"; break;
612 case SVt_PVLV: s = "an lvalue"; break;
613 case SVt_PVAV: s = "an array value"; break;
614 case SVt_PVHV: s = "an associative array value"; break;
615 case SVt_PVCV: s = "a code value"; break;
616 case SVt_PVGV: s = "a glob value"; break;
617 case SVt_PVBM: s = "a search string"; break;
618 case SVt_PVFM: s = "a formatline"; break;
619 default: s = "something weird"; break;
620 }
621 sprintf(tokenbuf,"<Reference to %s at 0x%lx>", s, (unsigned long)sv);
622 return tokenbuf;
623 }
624 if (SvREADONLY(sv)) {
625 if (SvIOK(sv)) {
626 (void)sprintf(tokenbuf,"%ld",SvIV(sv));
627 return tokenbuf;
628 }
629 if (SvNOK(sv)) {
630 (void)sprintf(tokenbuf,"%.20g",SvNV(sv));
631 return tokenbuf;
632 }
633 if (dowarn)
634 warn("Use of uninitialized variable");
635 return "";
636 }
637 if (!SvUPGRADE(sv, SVt_PV))
638 return 0;
639 if (SvNOK(sv)) {
640 if (SvTYPE(sv) < SVt_PVNV)
641 sv_upgrade(sv, SVt_PVNV);
642 SvGROW(sv, 28);
643 s = SvPV(sv);
644 olderrno = errno; /* some Xenix systems wipe out errno here */
645#if defined(scs) && defined(ns32000)
646 gcvt(SvNV(sv),20,s);
647#else
648#ifdef apollo
649 if (SvNV(sv) == 0.0)
650 (void)strcpy(s,"0");
651 else
652#endif /*apollo*/
653 (void)sprintf(s,"%.20g",SvNV(sv));
654#endif /*scs*/
655 errno = olderrno;
656 while (*s) s++;
657#ifdef hcx
658 if (s[-1] == '.')
659 s--;
660#endif
661 }
662 else if (SvIOK(sv)) {
663 if (SvTYPE(sv) < SVt_PVIV)
664 sv_upgrade(sv, SVt_PVIV);
665 SvGROW(sv, 11);
666 s = SvPV(sv);
667 olderrno = errno; /* some Xenix systems wipe out errno here */
668 (void)sprintf(s,"%ld",SvIV(sv));
669 errno = olderrno;
670 while (*s) s++;
671 }
672 else {
673 if (dowarn)
674 warn("Use of uninitialized variable");
675 sv_grow(sv, 1);
676 s = SvPV(sv);
677 }
678 *s = '\0';
679 SvCUR_set(sv, s - SvPV(sv));
680 SvPOK_on(sv);
681 DEBUG_c((stderr,"0x%lx 2pv(%s)\n",sv,SvPV(sv)));
682 return SvPV(sv);
683}
684
685/* Note: sv_setsv() should not be called with a source string that needs
686 * be reused, since it may destroy the source string if it is marked
687 * as temporary.
688 */
689
690void
691sv_setsv(dstr,sstr)
692SV *dstr;
693register SV *sstr;
694{
695 if (sstr == dstr)
696 return;
697 if (SvREADONLY(dstr))
698 fatal(no_modify);
699 if (!sstr)
700 sstr = &sv_undef;
701
702 if (SvTYPE(dstr) < SvTYPE(sstr))
703 sv_upgrade(dstr, SvTYPE(sstr));
704 else if (SvTYPE(dstr) == SVt_PV && SvTYPE(sstr) <= SVt_NV) {
705 if (SvTYPE(sstr) <= SVt_IV)
706 sv_upgrade(dstr, SVt_PVIV); /* handle discontinuities */
707 else
708 sv_upgrade(dstr, SVt_PVNV);
709 }
710 else if (SvTYPE(dstr) == SVt_PVIV && SvTYPE(sstr) == SVt_NV)
711 sv_upgrade(dstr, SVt_PVNV);
712
713 switch (SvTYPE(sstr)) {
714 case SVt_NULL:
715 if (SvTYPE(dstr) == SVt_REF) {
716 sv_free((SV*)SvANY(dstr));
717 SvANY(dstr) = 0;
718 SvTYPE(dstr) = SVt_NULL;
719 }
720 else
721 SvOK_off(dstr);
722 return;
723 case SVt_REF:
724 SvTUP(sstr);
725 if (SvTYPE(dstr) == SVt_REF) {
726 SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr));
727 }
728 else {
729 if (SvMAGICAL(dstr))
730 fatal("Can't assign a reference to a magical variable");
731 sv_clear(dstr);
732 SvTYPE(dstr) = SVt_REF;
733 SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr));
734 SvOK_off(dstr);
735 }
736 SvTDOWN(sstr);
737 return;
738 case SVt_PVGV:
739 SvTUP(sstr);
740 if (SvTYPE(dstr) == SVt_PVGV) {
741 SvOK_off(dstr);
742 if (!GvAV(sstr))
743 gv_AVadd(sstr);
744 if (!GvHV(sstr))
745 gv_HVadd(sstr);
746 if (!GvIO(sstr))
747 GvIO(sstr) = newIO();
748 if (GvGP(dstr))
749 gp_free(dstr);
750 GvGP(dstr) = gp_ref(GvGP(sstr));
751 SvTDOWN(sstr);
752 return;
753 }
754 /* FALL THROUGH */
755
756 default:
757 if (SvMAGICAL(sstr))
758 mg_get(sstr);
759 /* XXX */
760 break;
761 }
762
763 SvPRIVATE(dstr) = SvPRIVATE(sstr);
764 SvSTORAGE(dstr) = SvSTORAGE(sstr);
765
766 if (SvPOK(sstr)) {
767
768 SvTUP(sstr);
769
770 /*
771 * Check to see if we can just swipe the string. If so, it's a
772 * possible small lose on short strings, but a big win on long ones.
773 * It might even be a win on short strings if SvPV(dstr)
774 * has to be allocated and SvPV(sstr) has to be freed.
775 */
776
777 if (SvTEMP(sstr)) { /* slated for free anyway? */
778 if (SvPOK(dstr)) {
779 SvOOK_off(dstr);
780 Safefree(SvPV(dstr));
781 }
782 SvPV_set(dstr, SvPV(sstr));
783 SvLEN_set(dstr, SvLEN(sstr));
784 SvCUR_set(dstr, SvCUR(sstr));
785 SvTYPE(dstr) = SvTYPE(sstr);
786 SvPOK_only(dstr);
787 SvTEMP_off(dstr);
788 SvPV_set(sstr, Nullch);
789 SvLEN_set(sstr, 0);
790 SvPOK_off(sstr); /* wipe out any weird flags */
791 SvTYPE(sstr) = 0; /* so sstr frees uneventfully */
792 }
793 else { /* have to copy actual string */
794 if (SvPV(dstr)) { /* XXX ck type */
795 SvOOK_off(dstr);
796 }
797 sv_setpvn(dstr,SvPV(sstr),SvCUR(sstr));
798 }
799 /*SUPPRESS 560*/
800 if (SvNOK(sstr)) {
801 SvNOK_on(dstr);
802 SvNV(dstr) = SvNV(sstr);
803 }
804 if (SvIOK(sstr)) {
805 SvIOK_on(dstr);
806 SvIV(dstr) = SvIV(sstr);
807 }
808 }
809 else if (SvNOK(sstr)) {
810 SvTUP(sstr);
811 SvNV(dstr) = SvNV(sstr);
812 SvNOK_only(dstr);
813 if (SvIOK(sstr)) {
814 SvIOK_on(dstr);
815 SvIV(dstr) = SvIV(sstr);
816 }
817 }
818 else if (SvIOK(sstr)) {
819 SvTUP(sstr);
820 SvIOK_only(dstr);
821 SvIV(dstr) = SvIV(sstr);
822 }
823 else {
824 SvTUP(sstr);
825 SvOK_off(dstr);
826 }
827 SvTDOWN(dstr);
828}
829
830void
831sv_setpvn(sv,ptr,len)
832register SV *sv;
833register char *ptr;
834register STRLEN len;
835{
836 if (!SvUPGRADE(sv, SVt_PV))
837 return;
838 SvGROW(sv, len + 1);
839 if (ptr)
840 Move(ptr,SvPV(sv),len,char);
841 SvCUR_set(sv, len);
842 *SvEND(sv) = '\0';
843 SvPOK_only(sv); /* validate pointer */
844 SvTDOWN(sv);
845}
846
847void
848sv_setpv(sv,ptr)
849register SV *sv;
850register char *ptr;
851{
852 register STRLEN len;
853
854 if (SvREADONLY(sv))
855 fatal(no_modify);
856 if (!ptr)
857 ptr = "";
858 len = strlen(ptr);
859 if (!SvUPGRADE(sv, SVt_PV))
860 return;
861 SvGROW(sv, len + 1);
862 Move(ptr,SvPV(sv),len+1,char);
863 SvCUR_set(sv, len);
864 SvPOK_only(sv); /* validate pointer */
865 SvTDOWN(sv);
866}
867
868void
869sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
870register SV *sv;
871register char *ptr;
872{
873 register STRLEN delta;
874
875 if (!ptr || !SvPOK(sv))
876 return;
877 if (SvREADONLY(sv))
878 fatal(no_modify);
879 if (SvTYPE(sv) < SVt_PVIV)
880 sv_upgrade(sv,SVt_PVIV);
881
882 if (!SvOOK(sv)) {
883 SvIV(sv) = 0;
884 SvFLAGS(sv) |= SVf_OOK;
885 }
886 SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
887 delta = ptr - SvPV(sv);
888 SvLEN(sv) -= delta;
889 SvCUR(sv) -= delta;
890 SvPV(sv) += delta;
891 SvIV(sv) += delta;
892}
893
894void
895sv_catpvn(sv,ptr,len)
896register SV *sv;
897register char *ptr;
898register STRLEN len;
899{
900 if (SvREADONLY(sv))
901 fatal(no_modify);
902 if (!(SvPOK(sv)))
903 (void)sv_2pv(sv);
904 SvGROW(sv, SvCUR(sv) + len + 1);
905 Move(ptr,SvPV(sv)+SvCUR(sv),len,char);
906 SvCUR(sv) += len;
907 *SvEND(sv) = '\0';
908 SvPOK_only(sv); /* validate pointer */
909 SvTDOWN(sv);
910}
911
912void
913sv_catsv(dstr,sstr)
914SV *dstr;
915register SV *sstr;
916{
917 char *s;
918 if (!sstr)
919 return;
920 if (s = SvPVn(sstr)) {
921 if (SvPOK(sstr))
922 sv_catpvn(dstr,s,SvCUR(sstr));
923 else
924 sv_catpv(dstr,s);
925 }
926}
927
928void
929sv_catpv(sv,ptr)
930register SV *sv;
931register char *ptr;
932{
933 register STRLEN len;
934
935 if (SvREADONLY(sv))
936 fatal(no_modify);
937 if (!ptr)
938 return;
939 if (!(SvPOK(sv)))
940 (void)sv_2pv(sv);
941 len = strlen(ptr);
942 SvGROW(sv, SvCUR(sv) + len + 1);
943 Move(ptr,SvPV(sv)+SvCUR(sv),len+1,char);
944 SvCUR(sv) += len;
945 SvPOK_only(sv); /* validate pointer */
946 SvTDOWN(sv);
947}
948
949char *
950sv_append_till(sv,from,fromend,delim,keeplist)
951register SV *sv;
952register char *from;
953register char *fromend;
954register I32 delim;
955char *keeplist;
956{
957 register char *to;
958 register STRLEN len;
959
960 if (SvREADONLY(sv))
961 fatal(no_modify);
962 if (!from)
963 return Nullch;
964 len = fromend - from;
965 if (!SvUPGRADE(sv, SVt_PV))
966 return 0;
967 SvGROW(sv, SvCUR(sv) + len + 1);
968 SvPOK_only(sv); /* validate pointer */
969 to = SvPV(sv)+SvCUR(sv);
970 for (; from < fromend; from++,to++) {
971 if (*from == '\\' && from+1 < fromend && delim != '\\') {
972 if (!keeplist)
973 *to++ = *from++;
974 else if (from[1] && index(keeplist,from[1]))
975 *to++ = *from++;
976 else
977 from++;
978 }
979 else if (*from == delim)
980 break;
981 *to = *from;
982 }
983 *to = '\0';
984 SvCUR_set(sv, to - SvPV(sv));
985 return from;
986}
987
988SV *
989#ifdef LEAKTEST
990newSV(x,len)
991I32 x;
992#else
993newSV(len)
994#endif
995STRLEN len;
996{
997 register SV *sv;
998
999 sv = (SV*)new_SV();
1000 Zero(sv, 1, SV);
1001 SvREFCNT(sv)++;
1002 if (len) {
1003 sv_upgrade(sv, SVt_PV);
1004 SvGROW(sv, len + 1);
1005 }
1006 return sv;
1007}
1008
1009void
1010sv_magic(sv, obj, how, name, namlen)
1011register SV *sv;
1012SV *obj;
1013char how;
1014char *name;
1015STRLEN namlen;
1016{
1017 MAGIC* mg;
1018
1019 if (SvREADONLY(sv))
1020 fatal(no_modify);
1021 if (!SvUPGRADE(sv, SVt_PVMG))
1022 return;
1023 Newz(702,mg, 1, MAGIC);
1024 mg->mg_moremagic = SvMAGIC(sv);
1025 SvMAGICAL_on(sv);
1026 SvMAGIC(sv) = mg;
1027 mg->mg_obj = obj;
1028 mg->mg_type = how;
1029 if (name) {
1030 mg->mg_ptr = nsavestr(name, namlen);
1031 mg->mg_len = namlen;
1032 }
1033 switch (how) {
1034 case 0:
1035 mg->mg_virtual = &vtbl_sv;
1036 break;
1037 case 'B':
1038 mg->mg_virtual = &vtbl_bm;
1039 break;
1040 case 'D':
1041 mg->mg_virtual = &vtbl_dbm;
1042 break;
1043 case 'd':
1044 mg->mg_virtual = &vtbl_dbmelem;
1045 break;
1046 case 'E':
1047 mg->mg_virtual = &vtbl_env;
1048 break;
1049 case 'e':
1050 mg->mg_virtual = &vtbl_envelem;
1051 break;
1052 case 'L':
1053 mg->mg_virtual = &vtbl_dbline;
1054 break;
1055 case 'S':
1056 mg->mg_virtual = &vtbl_sig;
1057 break;
1058 case 's':
1059 mg->mg_virtual = &vtbl_sigelem;
1060 break;
1061 case 'U':
1062 mg->mg_virtual = &vtbl_uvar;
1063 break;
1064 case 'v':
1065 mg->mg_virtual = &vtbl_vec;
1066 break;
1067 case 'x':
1068 mg->mg_virtual = &vtbl_substr;
1069 break;
1070 case '*':
1071 mg->mg_virtual = &vtbl_glob;
1072 break;
1073 case '#':
1074 mg->mg_virtual = &vtbl_arylen;
1075 break;
1076 default:
1077 fatal("Don't know how to handle magic of type '%c'", how);
1078 }
1079}
1080
1081void
1082sv_insert(bigstr,offset,len,little,littlelen)
1083SV *bigstr;
1084STRLEN offset;
1085STRLEN len;
1086char *little;
1087STRLEN littlelen;
1088{
1089 register char *big;
1090 register char *mid;
1091 register char *midend;
1092 register char *bigend;
1093 register I32 i;
1094
1095 if (SvREADONLY(bigstr))
1096 fatal(no_modify);
1097 SvPOK_only(bigstr);
1098
1099 i = littlelen - len;
1100 if (i > 0) { /* string might grow */
1101 if (!SvUPGRADE(bigstr, SVt_PV))
1102 return;
1103 SvGROW(bigstr, SvCUR(bigstr) + i + 1);
1104 big = SvPV(bigstr);
1105 mid = big + offset + len;
1106 midend = bigend = big + SvCUR(bigstr);
1107 bigend += i;
1108 *bigend = '\0';
1109 while (midend > mid) /* shove everything down */
1110 *--bigend = *--midend;
1111 Move(little,big+offset,littlelen,char);
1112 SvCUR(bigstr) += i;
1113 SvSETMAGIC(bigstr);
1114 return;
1115 }
1116 else if (i == 0) {
1117 Move(little,SvPV(bigstr)+offset,len,char);
1118 SvSETMAGIC(bigstr);
1119 return;
1120 }
1121
1122 big = SvPV(bigstr);
1123 mid = big + offset;
1124 midend = mid + len;
1125 bigend = big + SvCUR(bigstr);
1126
1127 if (midend > bigend)
1128 fatal("panic: sv_insert");
1129
1130 if (mid - big > bigend - midend) { /* faster to shorten from end */
1131 if (littlelen) {
1132 Move(little, mid, littlelen,char);
1133 mid += littlelen;
1134 }
1135 i = bigend - midend;
1136 if (i > 0) {
1137 Move(midend, mid, i,char);
1138 mid += i;
1139 }
1140 *mid = '\0';
1141 SvCUR_set(bigstr, mid - big);
1142 }
1143 /*SUPPRESS 560*/
1144 else if (i = mid - big) { /* faster from front */
1145 midend -= littlelen;
1146 mid = midend;
1147 sv_chop(bigstr,midend-i);
1148 big += i;
1149 while (i--)
1150 *--midend = *--big;
1151 if (littlelen)
1152 Move(little, mid, littlelen,char);
1153 }
1154 else if (littlelen) {
1155 midend -= littlelen;
1156 sv_chop(bigstr,midend);
1157 Move(little,midend,littlelen,char);
1158 }
1159 else {
1160 sv_chop(bigstr,midend);
1161 }
1162 SvSETMAGIC(bigstr);
1163}
1164
1165/* make sv point to what nstr did */
1166
1167void
1168sv_replace(sv,nsv)
1169register SV *sv;
1170register SV *nsv;
1171{
1172 U32 refcnt = SvREFCNT(sv);
1173 if (SvREADONLY(sv))
1174 fatal(no_modify);
1175 if (SvREFCNT(nsv) != 1)
1176 warn("Reference miscount in sv_replace()");
1177 SvREFCNT(sv) = 0;
1178 sv_clear(sv);
1179 StructCopy(nsv,sv,SV);
1180 SvREFCNT(sv) = refcnt;
1181 Safefree(nsv);
1182}
1183
1184void
1185sv_clear(sv)
1186register SV *sv;
1187{
1188 assert(sv);
1189 assert(SvREFCNT(sv) == 0);
1190
1191 switch (SvTYPE(sv)) {
1192 case SVt_PVFM:
1193 goto freemagic;
1194 case SVt_PVBM:
1195 goto freemagic;
1196 case SVt_PVGV:
1197 gp_free(sv);
1198 goto freemagic;
1199 case SVt_PVCV:
1200 op_free(CvSTART(sv));
1201 goto freemagic;
1202 case SVt_PVHV:
1203 hv_clear(sv, FALSE);
1204 goto freemagic;
1205 case SVt_PVAV:
1206 av_clear(sv);
1207 goto freemagic;
1208 case SVt_PVLV:
1209 goto freemagic;
1210 case SVt_PVMG:
1211 freemagic:
1212 if (SvMAGICAL(sv))
1213 mg_freeall(sv);
1214 case SVt_PVNV:
1215 case SVt_PVIV:
1216 SvOOK_off(sv);
1217 /* FALL THROUGH */
1218 case SVt_PV:
1219 if (SvPV(sv))
1220 Safefree(SvPV(sv));
1221 break;
1222 case SVt_NV:
1223 break;
1224 case SVt_IV:
1225 break;
1226 case SVt_REF:
1227 sv_free((SV*)SvANY(sv));
1228 break;
1229 case SVt_NULL:
1230 break;
1231 }
1232
1233 switch (SvTYPE(sv)) {
1234 case SVt_NULL:
1235 break;
1236 case SVt_REF:
1237 break;
1238 case SVt_IV:
1239 del_XIV(SvANY(sv));
1240 break;
1241 case SVt_NV:
1242 del_XNV(SvANY(sv));
1243 break;
1244 case SVt_PV:
1245 del_XPV(SvANY(sv));
1246 break;
1247 case SVt_PVIV:
1248 del_XPVIV(SvANY(sv));
1249 break;
1250 case SVt_PVNV:
1251 del_XPVNV(SvANY(sv));
1252 break;
1253 case SVt_PVMG:
1254 del_XPVMG(SvANY(sv));
1255 break;
1256 case SVt_PVLV:
1257 del_XPVLV(SvANY(sv));
1258 break;
1259 case SVt_PVAV:
1260 del_XPVAV(SvANY(sv));
1261 break;
1262 case SVt_PVHV:
1263 del_XPVHV(SvANY(sv));
1264 break;
1265 case SVt_PVCV:
1266 del_XPVCV(SvANY(sv));
1267 break;
1268 case SVt_PVGV:
1269 del_XPVGV(SvANY(sv));
1270 break;
1271 case SVt_PVBM:
1272 del_XPVBM(SvANY(sv));
1273 break;
1274 case SVt_PVFM:
1275 del_XPVFM(SvANY(sv));
1276 break;
1277 }
1278 DEB(SvTYPE(sv) = 0xff;)
1279}
1280
1281SV *
1282sv_ref(sv)
1283SV* sv;
1284{
1285 SvREFCNT(sv)++;
1286 return sv;
1287}
1288
1289void
1290sv_free(sv)
1291SV *sv;
1292{
1293 if (!sv)
1294 return;
1295 if (SvREADONLY(sv)) {
1296 if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
1297 return;
1298 }
1299 if (SvREFCNT(sv) == 0) {
1300 warn("Attempt to free unreferenced scalar");
1301 return;
1302 }
1303 if (--SvREFCNT(sv) > 0)
1304 return;
1305 if (SvSTORAGE(sv) == 'O') {
1306 dSP;
1307 BINOP myop; /* fake syntax tree node */
1308 GV* destructor;
1309
1310 SvSTORAGE(sv) = 0; /* Curse the object. */
1311
1312 ENTER;
1313 SAVESPTR(curcop);
1314 SAVESPTR(op);
1315 curcop = &compiling;
1316 curstash = SvSTASH(sv);
1317 destructor = gv_fetchpv("DESTROY", FALSE);
1318
1319 if (GvCV(destructor)) {
1320 SV* ref = sv_mortalcopy(&sv_undef);
1321 SvREFCNT(ref) = 1;
1322 sv_upgrade(ref, SVt_REF);
1323 SvANY(ref) = (void*)sv_ref(sv);
1324
1325 op = (OP*)&myop;
1326 Zero(op, 1, OP);
1327 myop.op_last = (OP*)&myop;
1328 myop.op_flags = OPf_STACKED;
1329 myop.op_next = Nullop;
1330
1331 EXTEND(SP, 2);
1332 PUSHs((SV*)destructor);
1333 pp_pushmark();
1334 PUSHs(ref);
1335 PUTBACK;
1336 op = pp_entersubr();
1337 run();
1338 stack_sp--;
1339 LEAVE; /* Will eventually free sv as ordinary item. */
1340 return;
1341 }
1342 LEAVE;
1343 }
1344 sv_clear(sv);
1345 DEB(SvTYPE(sv) = 0xff;)
1346 del_SV(sv);
1347}
1348
1349STRLEN
1350sv_len(sv)
1351register SV *sv;
1352{
1353 I32 paren;
1354 I32 i;
1355 char *s;
1356
1357 if (!sv)
1358 return 0;
1359
1360 if (SvMAGICAL(sv))
1361 return mg_len(sv, SvMAGIC(sv));
1362
1363 if (!(SvPOK(sv))) {
1364 (void)sv_2pv(sv);
1365 if (!SvOK(sv))
1366 return 0;
1367 }
1368 if (SvPV(sv))
1369 return SvCUR(sv);
1370 else
1371 return 0;
1372}
1373
1374I32
1375sv_eq(str1,str2)
1376register SV *str1;
1377register SV *str2;
1378{
1379 char *pv1;
1380 U32 cur1;
1381 char *pv2;
1382 U32 cur2;
1383
1384 if (!str1) {
1385 pv1 = "";
1386 cur1 = 0;
1387 }
1388 else {
1389 if (SvMAGICAL(str1))
1390 mg_get(str1);
1391 if (!SvPOK(str1)) {
1392 (void)sv_2pv(str1);
1393 if (!SvPOK(str1))
1394 str1 = &sv_no;
1395 }
1396 pv1 = SvPV(str1);
1397 cur1 = SvCUR(str1);
1398 }
1399
1400 if (!str2)
1401 return !cur1;
1402 else {
1403 if (SvMAGICAL(str2))
1404 mg_get(str2);
1405 if (!SvPOK(str2)) {
1406 (void)sv_2pv(str2);
1407 if (!SvPOK(str2))
1408 return !cur1;
1409 }
1410 pv2 = SvPV(str2);
1411 cur2 = SvCUR(str2);
1412 }
1413
1414 if (cur1 != cur2)
1415 return 0;
1416
1417 return !bcmp(pv1, pv2, cur1);
1418}
1419
1420I32
1421sv_cmp(str1,str2)
1422register SV *str1;
1423register SV *str2;
1424{
1425 I32 retval;
1426 char *pv1;
1427 U32 cur1;
1428 char *pv2;
1429 U32 cur2;
1430
1431 if (!str1) {
1432 pv1 = "";
1433 cur1 = 0;
1434 }
1435 else {
1436 if (SvMAGICAL(str1))
1437 mg_get(str1);
1438 if (!SvPOK(str1)) {
1439 (void)sv_2pv(str1);
1440 if (!SvPOK(str1))
1441 str1 = &sv_no;
1442 }
1443 pv1 = SvPV(str1);
1444 cur1 = SvCUR(str1);
1445 }
1446
1447 if (!str2) {
1448 pv2 = "";
1449 cur2 = 0;
1450 }
1451 else {
1452 if (SvMAGICAL(str2))
1453 mg_get(str2);
1454 if (!SvPOK(str2)) {
1455 (void)sv_2pv(str2);
1456 if (!SvPOK(str2))
1457 str2 = &sv_no;
1458 }
1459 pv2 = SvPV(str2);
1460 cur2 = SvCUR(str2);
1461 }
1462
1463 if (!cur1)
1464 return cur2 ? -1 : 0;
1465 if (!cur2)
1466 return 1;
1467
1468 if (cur1 < cur2) {
1469 /*SUPPRESS 560*/
1470 if (retval = memcmp(pv1, pv2, cur1))
1471 return retval < 0 ? -1 : 1;
1472 else
1473 return -1;
1474 }
1475 /*SUPPRESS 560*/
1476 else if (retval = memcmp(pv1, pv2, cur2))
1477 return retval < 0 ? -1 : 1;
1478 else if (cur1 == cur2)
1479 return 0;
1480 else
1481 return 1;
1482}
1483
1484char *
1485sv_gets(sv,fp,append)
1486register SV *sv;
1487register FILE *fp;
1488I32 append;
1489{
1490 register char *bp; /* we're going to steal some values */
1491 register I32 cnt; /* from the stdio struct and put EVERYTHING */
1492 register STDCHAR *ptr; /* in the innermost loop into registers */
1493 register I32 newline = rschar;/* (assuming >= 6 registers) */
1494 I32 i;
1495 STRLEN bpx;
1496 I32 shortbuffered;
1497
1498 if (SvREADONLY(sv))
1499 fatal(no_modify);
1500 if (!SvUPGRADE(sv, SVt_PV))
1501 return;
1502 if (rspara) { /* have to do this both before and after */
1503 do { /* to make sure file boundaries work right */
1504 i = getc(fp);
1505 if (i != '\n') {
1506 ungetc(i,fp);
1507 break;
1508 }
1509 } while (i != EOF);
1510 }
1511#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */
1512 cnt = fp->_cnt; /* get count into register */
1513 SvPOK_only(sv); /* validate pointer */
1514 if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
1515 if (cnt > 80 && SvLEN(sv) > append) {
1516 shortbuffered = cnt - SvLEN(sv) + append + 1;
1517 cnt -= shortbuffered;
1518 }
1519 else {
1520 shortbuffered = 0;
1521 SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
1522 }
1523 }
1524 else
1525 shortbuffered = 0;
1526 bp = SvPV(sv) + append; /* move these two too to registers */
1527 ptr = fp->_ptr;
1528 for (;;) {
1529 screamer:
1530 while (--cnt >= 0) { /* this */ /* eat */
1531 if ((*bp++ = *ptr++) == newline) /* really */ /* dust */
1532 goto thats_all_folks; /* screams */ /* sed :-) */
1533 }
1534
1535 if (shortbuffered) { /* oh well, must extend */
1536 cnt = shortbuffered;
1537 shortbuffered = 0;
1538 bpx = bp - SvPV(sv); /* prepare for possible relocation */
1539 SvCUR_set(sv, bpx);
1540 SvGROW(sv, SvLEN(sv) + append + cnt + 2);
1541 bp = SvPV(sv) + bpx; /* reconstitute our pointer */
1542 continue;
1543 }
1544
1545 fp->_cnt = cnt; /* deregisterize cnt and ptr */
1546 fp->_ptr = ptr;
1547 i = _filbuf(fp); /* get more characters */
1548 cnt = fp->_cnt;
1549 ptr = fp->_ptr; /* reregisterize cnt and ptr */
1550
1551 bpx = bp - SvPV(sv); /* prepare for possible relocation */
1552 SvCUR_set(sv, bpx);
1553 SvGROW(sv, bpx + cnt + 2);
1554 bp = SvPV(sv) + bpx; /* reconstitute our pointer */
1555
1556 if (i == newline) { /* all done for now? */
1557 *bp++ = i;
1558 goto thats_all_folks;
1559 }
1560 else if (i == EOF) /* all done for ever? */
1561 goto thats_really_all_folks;
1562 *bp++ = i; /* now go back to screaming loop */
1563 }
1564
1565thats_all_folks:
1566 if (rslen > 1 && (bp - SvPV(sv) < rslen || bcmp(bp - rslen, rs, rslen)))
1567 goto screamer; /* go back to the fray */
1568thats_really_all_folks:
1569 if (shortbuffered)
1570 cnt += shortbuffered;
1571 fp->_cnt = cnt; /* put these back or we're in trouble */
1572 fp->_ptr = ptr;
1573 *bp = '\0';
1574 SvCUR_set(sv, bp - SvPV(sv)); /* set length */
1575
1576#else /* !STDSTDIO */ /* The big, slow, and stupid way */
1577
1578 {
1579 char buf[8192];
1580 register char * bpe = buf + sizeof(buf) - 3;
1581
1582screamer:
1583 bp = buf;
1584 while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
1585
1586 if (append)
1587 sv_catpvn(sv, buf, bp - buf);
1588 else
1589 sv_setpvn(sv, buf, bp - buf);
1590 if (i != EOF /* joy */
1591 &&
1592 (i != newline
1593 ||
1594 (rslen > 1
1595 &&
1596 (SvCUR(sv) < rslen
1597 ||
1598 bcmp(SvPV(sv) + SvCUR(sv) - rslen, rs, rslen)
1599 )
1600 )
1601 )
1602 )
1603 {
1604 append = -1;
1605 goto screamer;
1606 }
1607 }
1608
1609#endif /* STDSTDIO */
1610
1611 if (rspara) {
1612 while (i != EOF) {
1613 i = getc(fp);
1614 if (i != '\n') {
1615 ungetc(i,fp);
1616 break;
1617 }
1618 }
1619 }
1620 return SvCUR(sv) - append ? SvPV(sv) : Nullch;
1621}
1622
1623void
1624sv_inc(sv)
1625register SV *sv;
1626{
1627 register char *d;
1628
1629 if (!sv)
1630 return;
1631 if (SvREADONLY(sv))
1632 fatal(no_modify);
1633 if (SvMAGICAL(sv))
1634 mg_get(sv);
1635 if (SvIOK(sv)) {
1636 ++SvIV(sv);
1637 SvIOK_only(sv);
1638 return;
1639 }
1640 if (SvNOK(sv)) {
1641 SvNV(sv) += 1.0;
1642 SvNOK_only(sv);
1643 return;
1644 }
1645 if (!SvPOK(sv) || !*SvPV(sv)) {
1646 if (!SvUPGRADE(sv, SVt_NV))
1647 return;
1648 SvNV(sv) = 1.0;
1649 SvNOK_only(sv);
1650 return;
1651 }
1652 d = SvPV(sv);
1653 while (isALPHA(*d)) d++;
1654 while (isDIGIT(*d)) d++;
1655 if (*d) {
1656 sv_setnv(sv,atof(SvPV(sv)) + 1.0); /* punt */
1657 return;
1658 }
1659 d--;
1660 while (d >= SvPV(sv)) {
1661 if (isDIGIT(*d)) {
1662 if (++*d <= '9')
1663 return;
1664 *(d--) = '0';
1665 }
1666 else {
1667 ++*d;
1668 if (isALPHA(*d))
1669 return;
1670 *(d--) -= 'z' - 'a' + 1;
1671 }
1672 }
1673 /* oh,oh, the number grew */
1674 SvGROW(sv, SvCUR(sv) + 2);
1675 SvCUR(sv)++;
1676 for (d = SvPV(sv) + SvCUR(sv); d > SvPV(sv); d--)
1677 *d = d[-1];
1678 if (isDIGIT(d[1]))
1679 *d = '1';
1680 else
1681 *d = d[1];
1682}
1683
1684void
1685sv_dec(sv)
1686register SV *sv;
1687{
1688 if (!sv)
1689 return;
1690 if (SvREADONLY(sv))
1691 fatal(no_modify);
1692 if (SvMAGICAL(sv))
1693 mg_get(sv);
1694 if (SvIOK(sv)) {
1695 --SvIV(sv);
1696 SvIOK_only(sv);
1697 return;
1698 }
1699 if (SvNOK(sv)) {
1700 SvNV(sv) -= 1.0;
1701 SvNOK_only(sv);
1702 return;
1703 }
1704 if (!SvPOK(sv)) {
1705 if (!SvUPGRADE(sv, SVt_NV))
1706 return;
1707 SvNV(sv) = -1.0;
1708 SvNOK_only(sv);
1709 return;
1710 }
1711 sv_setnv(sv,atof(SvPV(sv)) - 1.0);
1712}
1713
1714/* Make a string that will exist for the duration of the expression
1715 * evaluation. Actually, it may have to last longer than that, but
1716 * hopefully we won't free it until it has been assigned to a
1717 * permanent location. */
1718
1719SV *
1720sv_mortalcopy(oldstr)
1721SV *oldstr;
1722{
1723 register SV *sv = NEWSV(78,0);
1724
1725 sv_setsv(sv,oldstr);
1726 if (++tmps_ix > tmps_max) {
1727 tmps_max = tmps_ix;
1728 if (!(tmps_max & 127)) {
1729 if (tmps_max)
1730 Renew(tmps_stack, tmps_max + 128, SV*);
1731 else
1732 New(702,tmps_stack, 128, SV*);
1733 }
1734 }
1735 tmps_stack[tmps_ix] = sv;
1736 if (SvPOK(sv))
1737 SvTEMP_on(sv);
1738 return sv;
1739}
1740
1741/* same thing without the copying */
1742
1743SV *
1744sv_2mortal(sv)
1745register SV *sv;
1746{
1747 if (!sv)
1748 return sv;
1749 if (SvREADONLY(sv))
1750 fatal(no_modify);
1751 if (++tmps_ix > tmps_max) {
1752 tmps_max = tmps_ix;
1753 if (!(tmps_max & 127)) {
1754 if (tmps_max)
1755 Renew(tmps_stack, tmps_max + 128, SV*);
1756 else
1757 New(704,tmps_stack, 128, SV*);
1758 }
1759 }
1760 tmps_stack[tmps_ix] = sv;
1761 if (SvPOK(sv))
1762 SvTEMP_on(sv);
1763 return sv;
1764}
1765
1766SV *
1767newSVpv(s,len)
1768char *s;
1769STRLEN len;
1770{
1771 register SV *sv = NEWSV(79,0);
1772
1773 if (!len)
1774 len = strlen(s);
1775 sv_setpvn(sv,s,len);
1776 return sv;
1777}
1778
1779SV *
1780newSVnv(n)
1781double n;
1782{
1783 register SV *sv = NEWSV(80,0);
1784
1785 sv_setnv(sv,n);
1786 return sv;
1787}
1788
1789SV *
1790newSViv(i)
1791I32 i;
1792{
1793 register SV *sv = NEWSV(80,0);
1794
1795 sv_setiv(sv,i);
1796 return sv;
1797}
1798
1799/* make an exact duplicate of old */
1800
1801SV *
1802newSVsv(old)
1803register SV *old;
1804{
1805 register SV *new;
1806
1807 if (!old)
1808 return Nullsv;
1809 if (SvTYPE(old) == 0xff) {
1810 warn("semi-panic: attempt to dup freed string");
1811 return Nullsv;
1812 }
1813 new = NEWSV(80,0);
1814 if (SvTEMP(old)) {
1815 SvTEMP_off(old);
1816 sv_setsv(new,old);
1817 SvTEMP_on(old);
1818 }
1819 else
1820 sv_setsv(new,old);
1821 return new;
1822}
1823
1824void
1825sv_reset(s,stash)
1826register char *s;
1827HV *stash;
1828{
1829 register HE *entry;
1830 register GV *gv;
1831 register SV *sv;
1832 register I32 i;
1833 register PMOP *pm;
1834 register I32 max;
1835
1836 if (!*s) { /* reset ?? searches */
1837 for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
1838 pm->op_pmflags &= ~PMf_USED;
1839 }
1840 return;
1841 }
1842
1843 /* reset variables */
1844
1845 if (!HvARRAY(stash))
1846 return;
1847 while (*s) {
1848 i = *s;
1849 if (s[1] == '-') {
1850 s += 2;
1851 }
1852 max = *s++;
1853 for ( ; i <= max; i++) {
1854 for (entry = HvARRAY(stash)[i];
1855 entry;
1856 entry = entry->hent_next) {
1857 gv = (GV*)entry->hent_val;
1858 sv = GvSV(gv);
1859 SvOK_off(sv);
1860 if (SvTYPE(sv) >= SVt_PV) {
1861 SvCUR_set(sv, 0);
1862 SvTDOWN(sv);
1863 if (SvPV(sv) != Nullch)
1864 *SvPV(sv) = '\0';
1865 }
1866 if (GvAV(gv)) {
1867 av_clear(GvAV(gv));
1868 }
1869 if (GvHV(gv)) {
1870 hv_clear(GvHV(gv), FALSE);
1871 if (gv == envgv)
1872 environ[0] = Nullch;
1873 }
1874 }
1875 }
1876 }
1877}
1878
1879#ifdef OLD
1880AV *
1881sv_2av(sv, st, gvp, lref)
1882SV *sv;
1883HV **st;
1884GV **gvp;
1885I32 lref;
1886{
1887 GV *gv;
1888
1889 switch (SvTYPE(sv)) {
1890 case SVt_PVAV:
1891 *st = sv->sv_u.sv_stash;
1892 *gvp = Nullgv;
1893 return sv->sv_u.sv_av;
1894 case SVt_PVHV:
1895 case SVt_PVCV:
1896 *gvp = Nullgv;
1897 return Nullav;
1898 default:
1899 if (isGV(sv))
1900 gv = (GV*)sv;
1901 else
1902 gv = gv_fetchpv(SvPVn(sv), lref);
1903 *gvp = gv;
1904 if (!gv)
1905 return Nullav;
1906 *st = GvESTASH(gv);
1907 if (lref)
1908 return GvAVn(gv);
1909 else
1910 return GvAV(gv);
1911 }
1912}
1913
1914HV *
1915sv_2hv(sv, st, gvp, lref)
1916SV *sv;
1917HV **st;
1918GV **gvp;
1919I32 lref;
1920{
1921 GV *gv;
1922
1923 switch (SvTYPE(sv)) {
1924 case SVt_PVHV:
1925 *st = sv->sv_u.sv_stash;
1926 *gvp = Nullgv;
1927 return sv->sv_u.sv_hv;
1928 case SVt_PVAV:
1929 case SVt_PVCV:
1930 *gvp = Nullgv;
1931 return Nullhv;
1932 default:
1933 if (isGV(sv))
1934 gv = (GV*)sv;
1935 else
1936 gv = gv_fetchpv(SvPVn(sv), lref);
1937 *gvp = gv;
1938 if (!gv)
1939 return Nullhv;
1940 *st = GvESTASH(gv);
1941 if (lref)
1942 return GvHVn(gv);
1943 else
1944 return GvHV(gv);
1945 }
1946}
1947#endif;
1948
1949CV *
1950sv_2cv(sv, st, gvp, lref)
1951SV *sv;
1952HV **st;
1953GV **gvp;
1954I32 lref;
1955{
1956 GV *gv;
1957 CV *cv;
1958
1959 if (!sv)
1960 return Nullcv;
1961 switch (SvTYPE(sv)) {
1962 case SVt_REF:
1963 cv = (CV*)SvANY(sv);
1964 if (SvTYPE(cv) != SVt_PVCV)
1965 fatal("Not a subroutine reference");
1966 *gvp = Nullgv;
1967 *st = CvSTASH(cv);
1968 return cv;
1969 case SVt_PVCV:
1970 *st = CvSTASH(sv);
1971 *gvp = Nullgv;
1972 return (CV*)sv;
1973 case SVt_PVHV:
1974 case SVt_PVAV:
1975 *gvp = Nullgv;
1976 return Nullcv;
1977 default:
1978 if (isGV(sv))
1979 gv = (GV*)sv;
1980 else
1981 gv = gv_fetchpv(SvPVn(sv), lref);
1982 *gvp = gv;
1983 if (!gv)
1984 return Nullcv;
1985 *st = GvESTASH(gv);
1986 return GvCV(gv);
1987 }
1988}
1989
1990#ifndef SvTRUE
1991I32
1992SvTRUE(sv)
1993register SV *sv;
1994{
1995 if (SvMAGICAL(sv))
1996 mg_get(sv);
1997 if (SvPOK(sv)) {
1998 register XPV* Xpv;
1999 if ((Xpv = (XPV*)SvANY(sv)) &&
2000 (*Xpv->xpv_pv > '0' ||
2001 Xpv->xpv_cur > 1 ||
2002 (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
2003 return 1;
2004 else
2005 return 0;
2006 }
2007 else {
2008 if (SvIOK(sv))
2009 return SvIV(sv) != 0;
2010 else {
2011 if (SvNOK(sv))
2012 return SvNV(sv) != 0.0;
2013 else
2014 return 0;
2015 }
2016 }
2017}
2018#endif /* SvTRUE */
2019
2020#ifndef SvNVn
2021double SvNVn(Sv)
2022register SV *Sv;
2023{
2024 SvTUP(Sv);
2025 if (SvMAGICAL(sv))
2026 mg_get(sv);
2027 if (SvNOK(Sv))
2028 return SvNV(Sv);
2029 if (SvIOK(Sv))
2030 return (double)SvIV(Sv);
2031 return sv_2nv(Sv);
2032}
2033#endif /* SvNVn */
2034
2035#ifndef SvPVn
2036char *
2037SvPVn(sv)
2038SV *sv;
2039{
2040 SvTUP(sv);
2041 if (SvMAGICAL(sv))
2042 mg_get(sv);
2043 return SvPOK(sv) ? SvPV(sv) : sv_2pv(sv);
2044}
2045#endif
2046