perl 5.0 alpha 3
[perl.git] / sv.c
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
50 static void ucase();
51 static void lcase();
52
53 bool
54 sv_upgrade(sv, mt)
55 register SV* sv;
56 U32 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         GvGP(sv)        = 0;
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
330 char *
331 sv_peek(sv)
332 register 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:
358             strcpy(t,"UNDEF");
359             return tokenbuf;
360         case SVt_REF:
361             *t++ = '\\';
362             if (t - tokenbuf > 10) {
363                 strcpy(tokenbuf + 3,"...");
364                 return tokenbuf;
365             }
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
428 int
429 sv_backoff(sv)
430 register 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
443 char *
444 sv_grow(sv,newlen)
445 register SV *sv;
446 #ifndef DOSISH
447 register I32 newlen;
448 #else
449 unsigned 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
485 void
486 sv_setiv(sv,i)
487 register SV *sv;
488 I32 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
501 void
502 sv_setnv(sv,num)
503 register SV *sv;
504 double 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
520 I32
521 sv_2iv(sv)
522 register 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);
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         }
553         SvIV(sv) = atol(SvPV(sv));
554     }
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
566 double
567 sv_2nv(sv)
568 register 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);
588     if (SvIOK(sv) &&
589             (!SvPOK(sv) || !strchr(SvPV(sv),'.') || !looks_like_number(sv)))
590     {
591         SvNV(sv) = (double)SvIV(sv);
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     }
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
612 char *
613 sv_2pv(sv)
614 register 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
712 void
713 sv_setsv(dstr,sstr)
714 SV *dstr;
715 register 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
852 void
853 sv_setpvn(sv,ptr,len)
854 register SV *sv;
855 register char *ptr;
856 register 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
869 void
870 sv_setpv(sv,ptr)
871 register SV *sv;
872 register 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
890 void
891 sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
892 register SV *sv;
893 register 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
916 void
917 sv_catpvn(sv,ptr,len)
918 register SV *sv;
919 register char *ptr;
920 register 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
934 void
935 sv_catsv(dstr,sstr)
936 SV *dstr;
937 register 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
950 void
951 sv_catpv(sv,ptr)
952 register SV *sv;
953 register 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
971 SV *
972 #ifdef LEAKTEST
973 newSV(x,len)
974 I32 x;
975 #else
976 newSV(len)
977 #endif
978 STRLEN 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
992 void
993 sv_magic(sv, obj, how, name, namlen)
994 register SV *sv;
995 SV *obj;
996 char how;
997 char *name;
998 STRLEN 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;
1035     case 'g':
1036         mg->mg_virtual = &vtbl_mglob;
1037         break;
1038     case 'L':
1039         mg->mg_virtual = 0;
1040         break;
1041     case 'l':
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
1070 void
1071 sv_insert(bigstr,offset,len,little,littlelen)
1072 SV *bigstr;
1073 STRLEN offset;
1074 STRLEN len;
1075 char *little;
1076 STRLEN 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
1156 void
1157 sv_replace(sv,nsv)
1158 register SV *sv;
1159 register 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()");
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     }
1173     SvREFCNT(sv) = 0;
1174     sv_clear(sv);
1175     StructCopy(nsv,sv,SV);
1176     SvREFCNT(sv) = refcnt;
1177     Safefree(nsv);
1178 }
1179
1180 void
1181 sv_clear(sv)
1182 register 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
1277 SV *
1278 sv_ref(sv)
1279 SV* sv;
1280 {
1281     SvREFCNT(sv)++;
1282     return sv;
1283 }
1284
1285 void
1286 sv_free(sv)
1287 SV *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
1345 STRLEN
1346 sv_len(sv)
1347 register SV *sv;
1348 {
1349     I32 paren;
1350     I32 i;
1351     char *s;
1352
1353     if (!sv)
1354         return 0;
1355
1356     if (SvMAGICAL(sv))
1357         return mg_len(sv);
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
1370 I32
1371 sv_eq(str1,str2)
1372 register SV *str1;
1373 register 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
1416 I32
1417 sv_cmp(str1,str2)
1418 register SV *str1;
1419 register 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
1480 char *
1481 sv_gets(sv,fp,append)
1482 register SV *sv;
1483 register FILE *fp;
1484 I32 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:
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             }
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
1563 thats_all_folks:
1564     if (rslen > 1 && (bp - SvPV(sv) < rslen || bcmp(bp - rslen, rs, rslen)))
1565         goto screamer;  /* go back to the fray */
1566 thats_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
1580 screamer:
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
1621 void
1622 sv_inc(sv)
1623 register 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
1682 void
1683 sv_dec(sv)
1684 register 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
1717 SV *
1718 sv_mortalcopy(oldstr)
1719 SV *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
1741 SV *
1742 sv_2mortal(sv)
1743 register 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
1764 SV *
1765 newSVpv(s,len)
1766 char *s;
1767 STRLEN 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
1777 SV *
1778 newSVnv(n)
1779 double n;
1780 {
1781     register SV *sv = NEWSV(80,0);
1782
1783     sv_setnv(sv,n);
1784     return sv;
1785 }
1786
1787 SV *
1788 newSViv(i)
1789 I32 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
1799 SV *
1800 newSVsv(old)
1801 register 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
1822 void
1823 sv_reset(s,stash)
1824 register char *s;
1825 HV *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
1878 AV *
1879 sv_2av(sv, st, gvp, lref)
1880 SV *sv;
1881 HV **st;
1882 GV **gvp;
1883 I32 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
1912 HV *
1913 sv_2hv(sv, st, gvp, lref)
1914 SV *sv;
1915 HV **st;
1916 GV **gvp;
1917 I32 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
1947 CV *
1948 sv_2cv(sv, st, gvp, lref)
1949 SV *sv;
1950 HV **st;
1951 GV **gvp;
1952 I32 lref;
1953 {
1954     GV *gv;
1955     CV *cv;
1956
1957     if (!sv)
1958         return *gvp = Nullgv, Nullcv;
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
1989 I32
1990 SvTRUE(sv)
1991 register 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
2019 double SvNVn(Sv)
2020 register 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
2034 char *
2035 SvPVn(sv)
2036 SV *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