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