summaryrefslogtreecommitdiff
path: root/sv.c
diff options
context:
space:
mode:
Diffstat (limited to 'sv.c')
-rw-r--r--sv.c2046
1 files changed, 2046 insertions, 0 deletions
diff --git a/sv.c b/sv.c
new file mode 100644
index 0000000000..0c745af477
--- /dev/null
+++ b/sv.c
@@ -0,0 +1,2046 @@
+/* $RCSfile: sv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:45 $
+ *
+ * Copyright (c) 1991, Larry Wall
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ * $Log: sv.c,v $
+ * Revision 4.1 92/08/07 18:26:45 lwall
+ *
+ * Revision 4.0.1.6 92/06/11 21:14:21 lwall
+ * patch34: quotes containing subscripts containing variables didn't parse right
+ *
+ * Revision 4.0.1.5 92/06/08 15:40:43 lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: fixed memory leak in doube-quote interpretation
+ * patch20: made /\$$foo/ look for literal '$foo'
+ * patch20: "$var{$foo'bar}" didn't scan subscript correctly
+ * patch20: a splice on non-existent array elements could dump core
+ * patch20: running taintperl explicitly now does checks even if $< == $>
+ *
+ * Revision 4.0.1.4 91/11/05 18:40:51 lwall
+ * patch11: $foo .= <BAR> could overrun malloced memory
+ * patch11: \$ didn't always make it through double-quoter to regexp routines
+ * patch11: prepared for ctype implementations that don't define isascii()
+ *
+ * Revision 4.0.1.3 91/06/10 01:27:54 lwall
+ * patch10: $) and $| incorrectly handled in run-time patterns
+ *
+ * Revision 4.0.1.2 91/06/07 11:58:13 lwall
+ * patch4: new copyright notice
+ * patch4: taint check on undefined string could cause core dump
+ *
+ * Revision 4.0.1.1 91/04/12 09:15:30 lwall
+ * patch1: fixed undefined environ problem
+ * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
+ * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
+ *
+ * Revision 4.0 91/03/20 01:39:55 lwall
+ * 4.0 baseline.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+
+static void ucase();
+static void lcase();
+
+bool
+sv_upgrade(sv, mt)
+register SV* sv;
+U32 mt;
+{
+ char* pv;
+ U32 cur;
+ U32 len;
+ I32 iv;
+ double nv;
+ MAGIC* magic;
+ HV* stash;
+
+ if (SvTYPE(sv) == mt)
+ return TRUE;
+
+ switch (SvTYPE(sv)) {
+ case SVt_NULL:
+ pv = 0;
+ cur = 0;
+ len = 0;
+ iv = 0;
+ nv = 0.0;
+ magic = 0;
+ stash = 0;
+ break;
+ case SVt_REF:
+ sv_free((SV*)SvANY(sv));
+ pv = 0;
+ cur = 0;
+ len = 0;
+ iv = SvANYI32(sv);
+ nv = (double)SvANYI32(sv);
+ SvNOK_only(sv);
+ magic = 0;
+ stash = 0;
+ if (mt == SVt_PV)
+ mt = SVt_PVIV;
+ break;
+ case SVt_IV:
+ pv = 0;
+ cur = 0;
+ len = 0;
+ iv = SvIV(sv);
+ nv = (double)SvIV(sv);
+ del_XIV(SvANY(sv));
+ magic = 0;
+ stash = 0;
+ if (mt == SVt_PV)
+ mt = SVt_PVIV;
+ break;
+ case SVt_NV:
+ pv = 0;
+ cur = 0;
+ len = 0;
+ if (SvIOK(sv))
+ iv = SvIV(sv);
+ else
+ iv = (I32)SvNV(sv);
+ nv = SvNV(sv);
+ magic = 0;
+ stash = 0;
+ del_XNV(SvANY(sv));
+ SvANY(sv) = 0;
+ if (mt == SVt_PV || mt == SVt_PVIV)
+ mt = SVt_PVNV;
+ break;
+ case SVt_PV:
+ nv = 0.0;
+ pv = SvPV(sv);
+ cur = SvCUR(sv);
+ len = SvLEN(sv);
+ iv = 0;
+ nv = 0.0;
+ magic = 0;
+ stash = 0;
+ del_XPV(SvANY(sv));
+ break;
+ case SVt_PVIV:
+ nv = 0.0;
+ pv = SvPV(sv);
+ cur = SvCUR(sv);
+ len = SvLEN(sv);
+ iv = SvIV(sv);
+ nv = 0.0;
+ magic = 0;
+ stash = 0;
+ del_XPVIV(SvANY(sv));
+ break;
+ case SVt_PVNV:
+ nv = SvNV(sv);
+ pv = SvPV(sv);
+ cur = SvCUR(sv);
+ len = SvLEN(sv);
+ iv = SvIV(sv);
+ nv = SvNV(sv);
+ magic = 0;
+ stash = 0;
+ del_XPVNV(SvANY(sv));
+ break;
+ case SVt_PVMG:
+ pv = SvPV(sv);
+ cur = SvCUR(sv);
+ len = SvLEN(sv);
+ iv = SvIV(sv);
+ nv = SvNV(sv);
+ magic = SvMAGIC(sv);
+ stash = SvSTASH(sv);
+ del_XPVMG(SvANY(sv));
+ break;
+ default:
+ fatal("Can't upgrade that kind of scalar");
+ }
+
+ switch (mt) {
+ case SVt_NULL:
+ fatal("Can't upgrade to undef");
+ case SVt_REF:
+ SvIOK_on(sv);
+ break;
+ case SVt_IV:
+ SvANY(sv) = new_XIV();
+ SvIV(sv) = iv;
+ break;
+ case SVt_NV:
+ SvANY(sv) = new_XNV();
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ break;
+ case SVt_PV:
+ SvANY(sv) = new_XPV();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ break;
+ case SVt_PVIV:
+ SvANY(sv) = new_XPVIV();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ if (SvNIOK(sv))
+ SvIOK_on(sv);
+ SvNOK_off(sv);
+ break;
+ case SVt_PVNV:
+ SvANY(sv) = new_XPVNV();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ break;
+ case SVt_PVMG:
+ SvANY(sv) = new_XPVMG();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ SvMAGIC(sv) = magic;
+ SvSTASH(sv) = stash;
+ break;
+ case SVt_PVLV:
+ SvANY(sv) = new_XPVLV();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ SvMAGIC(sv) = magic;
+ SvSTASH(sv) = stash;
+ LvTARGOFF(sv) = 0;
+ LvTARGLEN(sv) = 0;
+ LvTARG(sv) = 0;
+ LvTYPE(sv) = 0;
+ break;
+ case SVt_PVAV:
+ SvANY(sv) = new_XPVAV();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ SvMAGIC(sv) = magic;
+ SvSTASH(sv) = stash;
+ AvMAGIC(sv) = 0;
+ AvARRAY(sv) = 0;
+ AvALLOC(sv) = 0;
+ AvMAX(sv) = 0;
+ AvFILL(sv) = 0;
+ AvARYLEN(sv) = 0;
+ AvFLAGS(sv) = 0;
+ break;
+ case SVt_PVHV:
+ SvANY(sv) = new_XPVHV();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ SvMAGIC(sv) = magic;
+ SvSTASH(sv) = stash;
+ HvMAGIC(sv) = 0;
+ HvARRAY(sv) = 0;
+ HvMAX(sv) = 0;
+ HvDOSPLIT(sv) = 0;
+ HvFILL(sv) = 0;
+ HvRITER(sv) = 0;
+ HvEITER(sv) = 0;
+ HvPMROOT(sv) = 0;
+ HvNAME(sv) = 0;
+ HvDBM(sv) = 0;
+ HvCOEFFSIZE(sv) = 0;
+ break;
+ case SVt_PVCV:
+ SvANY(sv) = new_XPVCV();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ SvMAGIC(sv) = magic;
+ SvSTASH(sv) = stash;
+ CvSTASH(sv) = 0;
+ CvSTART(sv) = 0;
+ CvROOT(sv) = 0;
+ CvUSERSUB(sv) = 0;
+ CvUSERINDEX(sv) = 0;
+ CvFILEGV(sv) = 0;
+ CvDEPTH(sv) = 0;
+ CvPADLIST(sv) = 0;
+ CvDELETED(sv) = 0;
+ break;
+ case SVt_PVGV:
+ SvANY(sv) = new_XPVGV();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ SvMAGIC(sv) = magic;
+ SvSTASH(sv) = stash;
+ GvNAME(sv) = 0;
+ GvNAMELEN(sv) = 0;
+ GvSTASH(sv) = 0;
+ break;
+ case SVt_PVBM:
+ SvANY(sv) = new_XPVBM();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ SvMAGIC(sv) = magic;
+ SvSTASH(sv) = stash;
+ BmRARE(sv) = 0;
+ BmUSEFUL(sv) = 0;
+ BmPREVIOUS(sv) = 0;
+ break;
+ case SVt_PVFM:
+ SvANY(sv) = new_XPVFM();
+ SvPV(sv) = pv;
+ SvCUR(sv) = cur;
+ SvLEN(sv) = len;
+ SvIV(sv) = iv;
+ SvNV(sv) = nv;
+ SvMAGIC(sv) = magic;
+ SvSTASH(sv) = stash;
+ FmLINES(sv) = 0;
+ break;
+ }
+ SvTYPE(sv) = mt;
+ return TRUE;
+}
+
+char *
+sv_peek(sv)
+register SV *sv;
+{
+ char *t = tokenbuf;
+ *t = '\0';
+
+ retry:
+ if (!sv) {
+ strcpy(t, "VOID");
+ return tokenbuf;
+ }
+ else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
+ strcpy(t, "WILD");
+ return tokenbuf;
+ }
+ else if (SvREFCNT(sv) == 0 && !SvREADONLY(sv)) {
+ strcpy(t, "UNREF");
+ return tokenbuf;
+ }
+ else {
+ switch (SvTYPE(sv)) {
+ default:
+ strcpy(t,"FREED");
+ return tokenbuf;
+ break;
+
+ case SVt_NULL:
+ return "UNDEF";
+ case SVt_REF:
+ strcpy(t, "\\");
+ t += strlen(t);
+ sv = (SV*)SvANY(sv);
+ goto retry;
+ case SVt_IV:
+ strcpy(t,"IV");
+ break;
+ case SVt_NV:
+ strcpy(t,"NV");
+ break;
+ case SVt_PV:
+ strcpy(t,"PV");
+ break;
+ case SVt_PVIV:
+ strcpy(t,"PVIV");
+ break;
+ case SVt_PVNV:
+ strcpy(t,"PVNV");
+ break;
+ case SVt_PVMG:
+ strcpy(t,"PVMG");
+ break;
+ case SVt_PVLV:
+ strcpy(t,"PVLV");
+ break;
+ case SVt_PVAV:
+ strcpy(t,"AV");
+ break;
+ case SVt_PVHV:
+ strcpy(t,"HV");
+ break;
+ case SVt_PVCV:
+ strcpy(t,"CV");
+ break;
+ case SVt_PVGV:
+ strcpy(t,"GV");
+ break;
+ case SVt_PVBM:
+ strcpy(t,"BM");
+ break;
+ case SVt_PVFM:
+ strcpy(t,"FM");
+ break;
+ }
+ }
+ t += strlen(t);
+
+ if (SvPOK(sv)) {
+ if (!SvPV(sv))
+ return "(null)";
+ if (SvOOK(sv))
+ sprintf(t,"(%d+\"%0.127s\")",SvIV(sv),SvPV(sv));
+ else
+ sprintf(t,"(\"%0.127s\")",SvPV(sv));
+ }
+ else if (SvNOK(sv))
+ sprintf(t,"(%g)",SvNV(sv));
+ else if (SvIOK(sv))
+ sprintf(t,"(%ld)",(long)SvIV(sv));
+ else
+ strcpy(t,"()");
+ return tokenbuf;
+}
+
+int
+sv_backoff(sv)
+register SV *sv;
+{
+ assert(SvOOK(sv));
+ if (SvIV(sv)) {
+ char *s = SvPV(sv);
+ SvLEN(sv) += SvIV(sv);
+ SvPV(sv) -= SvIV(sv);
+ SvIV_set(sv, 0);
+ Move(s, SvPV(sv), SvCUR(sv)+1, char);
+ }
+ SvFLAGS(sv) &= ~SVf_OOK;
+}
+
+char *
+sv_grow(sv,newlen)
+register SV *sv;
+#ifndef DOSISH
+register I32 newlen;
+#else
+unsigned long newlen;
+#endif
+{
+ register char *s;
+
+#ifdef MSDOS
+ if (newlen >= 0x10000) {
+ fprintf(stderr, "Allocation too large: %lx\n", newlen);
+ my_exit(1);
+ }
+#endif /* MSDOS */
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (SvTYPE(sv) < SVt_PV) {
+ sv_upgrade(sv, SVt_PV);
+ s = SvPV(sv);
+ }
+ else if (SvOOK(sv)) { /* pv is offset? */
+ sv_backoff(sv);
+ s = SvPV(sv);
+ if (newlen > SvLEN(sv))
+ newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
+ }
+ else
+ s = SvPV(sv);
+ if (newlen > SvLEN(sv)) { /* need more room? */
+ if (SvLEN(sv))
+ Renew(s,newlen,char);
+ else
+ New(703,s,newlen,char);
+ SvPV_set(sv, s);
+ SvLEN_set(sv, newlen);
+ }
+ return s;
+}
+
+void
+sv_setiv(sv,i)
+register SV *sv;
+I32 i;
+{
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (SvTYPE(sv) < SVt_IV)
+ sv_upgrade(sv, SVt_IV);
+ else if (SvTYPE(sv) == SVt_PV)
+ sv_upgrade(sv, SVt_PVIV);
+ SvIV(sv) = i;
+ SvIOK_only(sv); /* validate number */
+ SvTDOWN(sv);
+}
+
+void
+sv_setnv(sv,num)
+register SV *sv;
+double num;
+{
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (SvTYPE(sv) < SVt_NV)
+ sv_upgrade(sv, SVt_NV);
+ else if (SvTYPE(sv) < SVt_PVNV)
+ sv_upgrade(sv, SVt_PVNV);
+ else if (SvPOK(sv)) {
+ SvOOK_off(sv);
+ }
+ SvNV(sv) = num;
+ SvNOK_only(sv); /* validate number */
+ SvTDOWN(sv);
+}
+
+I32
+sv_2iv(sv)
+register SV *sv;
+{
+ if (!sv)
+ return 0;
+ if (SvREADONLY(sv)) {
+ if (SvNOK(sv))
+ return (I32)SvNV(sv);
+ if (SvPOK(sv) && SvLEN(sv))
+ return atof(SvPV(sv));
+ if (dowarn)
+ warn("Use of uninitialized variable");
+ return 0;
+ }
+ if (SvTYPE(sv) < SVt_IV) {
+ if (SvTYPE(sv) == SVt_REF)
+ return (I32)SvANYI32(sv);
+ sv_upgrade(sv, SVt_IV);
+ DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvIV(sv)));
+ return SvIV(sv);
+ }
+ else if (SvTYPE(sv) == SVt_PV)
+ sv_upgrade(sv, SVt_PVIV);
+ if (SvNOK(sv))
+ SvIV(sv) = (I32)SvNV(sv);
+ else if (SvPOK(sv) && SvLEN(sv))
+ SvIV(sv) = atol(SvPV(sv));
+ else {
+ if (dowarn)
+ warn("Use of uninitialized variable");
+ SvUPGRADE(sv, SVt_IV);
+ SvIV(sv) = 0;
+ }
+ SvIOK_on(sv);
+ DEBUG_c((stderr,"0x%lx 2iv(%d)\n",sv,SvIV(sv)));
+ return SvIV(sv);
+}
+
+double
+sv_2nv(sv)
+register SV *sv;
+{
+ if (!sv)
+ return 0.0;
+ if (SvREADONLY(sv)) {
+ if (SvPOK(sv) && SvLEN(sv))
+ return atof(SvPV(sv));
+ if (dowarn)
+ warn("Use of uninitialized variable");
+ return 0.0;
+ }
+ if (SvTYPE(sv) < SVt_NV) {
+ if (SvTYPE(sv) == SVt_REF)
+ return (double)SvANYI32(sv);
+ sv_upgrade(sv, SVt_NV);
+ DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvNV(sv)));
+ return SvNV(sv);
+ }
+ else if (SvTYPE(sv) < SVt_PVNV)
+ sv_upgrade(sv, SVt_PVNV);
+ if (SvPOK(sv) && SvLEN(sv))
+ SvNV(sv) = atof(SvPV(sv));
+ else if (SvIOK(sv))
+ SvNV(sv) = (double)SvIV(sv);
+ else {
+ if (dowarn)
+ warn("Use of uninitialized variable");
+ SvNV(sv) = 0.0;
+ }
+ SvNOK_on(sv);
+ DEBUG_c((stderr,"0x%lx 2nv(%g)\n",sv,SvNV(sv)));
+ return SvNV(sv);
+}
+
+char *
+sv_2pv(sv)
+register SV *sv;
+{
+ register char *s;
+ int olderrno;
+
+ if (!sv)
+ return "";
+ if (SvTYPE(sv) == SVt_REF) {
+ sv = (SV*)SvANY(sv);
+ if (!sv)
+ return "<Empty reference>";
+ switch (SvTYPE(sv)) {
+ case SVt_NULL: s = "an undefined value"; break;
+ case SVt_REF: s = "a reference"; break;
+ case SVt_IV: s = "an integer value"; break;
+ case SVt_NV: s = "a numeric value"; break;
+ case SVt_PV: s = "a string value"; break;
+ case SVt_PVIV: s = "a string+integer value"; break;
+ case SVt_PVNV: s = "a scalar value"; break;
+ case SVt_PVMG: s = "a magic value"; break;
+ case SVt_PVLV: s = "an lvalue"; break;
+ case SVt_PVAV: s = "an array value"; break;
+ case SVt_PVHV: s = "an associative array value"; break;
+ case SVt_PVCV: s = "a code value"; break;
+ case SVt_PVGV: s = "a glob value"; break;
+ case SVt_PVBM: s = "a search string"; break;
+ case SVt_PVFM: s = "a formatline"; break;
+ default: s = "something weird"; break;
+ }
+ sprintf(tokenbuf,"<Reference to %s at 0x%lx>", s, (unsigned long)sv);
+ return tokenbuf;
+ }
+ if (SvREADONLY(sv)) {
+ if (SvIOK(sv)) {
+ (void)sprintf(tokenbuf,"%ld",SvIV(sv));
+ return tokenbuf;
+ }
+ if (SvNOK(sv)) {
+ (void)sprintf(tokenbuf,"%.20g",SvNV(sv));
+ return tokenbuf;
+ }
+ if (dowarn)
+ warn("Use of uninitialized variable");
+ return "";
+ }
+ if (!SvUPGRADE(sv, SVt_PV))
+ return 0;
+ if (SvNOK(sv)) {
+ if (SvTYPE(sv) < SVt_PVNV)
+ sv_upgrade(sv, SVt_PVNV);
+ SvGROW(sv, 28);
+ s = SvPV(sv);
+ olderrno = errno; /* some Xenix systems wipe out errno here */
+#if defined(scs) && defined(ns32000)
+ gcvt(SvNV(sv),20,s);
+#else
+#ifdef apollo
+ if (SvNV(sv) == 0.0)
+ (void)strcpy(s,"0");
+ else
+#endif /*apollo*/
+ (void)sprintf(s,"%.20g",SvNV(sv));
+#endif /*scs*/
+ errno = olderrno;
+ while (*s) s++;
+#ifdef hcx
+ if (s[-1] == '.')
+ s--;
+#endif
+ }
+ else if (SvIOK(sv)) {
+ if (SvTYPE(sv) < SVt_PVIV)
+ sv_upgrade(sv, SVt_PVIV);
+ SvGROW(sv, 11);
+ s = SvPV(sv);
+ olderrno = errno; /* some Xenix systems wipe out errno here */
+ (void)sprintf(s,"%ld",SvIV(sv));
+ errno = olderrno;
+ while (*s) s++;
+ }
+ else {
+ if (dowarn)
+ warn("Use of uninitialized variable");
+ sv_grow(sv, 1);
+ s = SvPV(sv);
+ }
+ *s = '\0';
+ SvCUR_set(sv, s - SvPV(sv));
+ SvPOK_on(sv);
+ DEBUG_c((stderr,"0x%lx 2pv(%s)\n",sv,SvPV(sv)));
+ return SvPV(sv);
+}
+
+/* Note: sv_setsv() should not be called with a source string that needs
+ * be reused, since it may destroy the source string if it is marked
+ * as temporary.
+ */
+
+void
+sv_setsv(dstr,sstr)
+SV *dstr;
+register SV *sstr;
+{
+ if (sstr == dstr)
+ return;
+ if (SvREADONLY(dstr))
+ fatal(no_modify);
+ if (!sstr)
+ sstr = &sv_undef;
+
+ if (SvTYPE(dstr) < SvTYPE(sstr))
+ sv_upgrade(dstr, SvTYPE(sstr));
+ else if (SvTYPE(dstr) == SVt_PV && SvTYPE(sstr) <= SVt_NV) {
+ if (SvTYPE(sstr) <= SVt_IV)
+ sv_upgrade(dstr, SVt_PVIV); /* handle discontinuities */
+ else
+ sv_upgrade(dstr, SVt_PVNV);
+ }
+ else if (SvTYPE(dstr) == SVt_PVIV && SvTYPE(sstr) == SVt_NV)
+ sv_upgrade(dstr, SVt_PVNV);
+
+ switch (SvTYPE(sstr)) {
+ case SVt_NULL:
+ if (SvTYPE(dstr) == SVt_REF) {
+ sv_free((SV*)SvANY(dstr));
+ SvANY(dstr) = 0;
+ SvTYPE(dstr) = SVt_NULL;
+ }
+ else
+ SvOK_off(dstr);
+ return;
+ case SVt_REF:
+ SvTUP(sstr);
+ if (SvTYPE(dstr) == SVt_REF) {
+ SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr));
+ }
+ else {
+ if (SvMAGICAL(dstr))
+ fatal("Can't assign a reference to a magical variable");
+ sv_clear(dstr);
+ SvTYPE(dstr) = SVt_REF;
+ SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr));
+ SvOK_off(dstr);
+ }
+ SvTDOWN(sstr);
+ return;
+ case SVt_PVGV:
+ SvTUP(sstr);
+ if (SvTYPE(dstr) == SVt_PVGV) {
+ SvOK_off(dstr);
+ if (!GvAV(sstr))
+ gv_AVadd(sstr);
+ if (!GvHV(sstr))
+ gv_HVadd(sstr);
+ if (!GvIO(sstr))
+ GvIO(sstr) = newIO();
+ if (GvGP(dstr))
+ gp_free(dstr);
+ GvGP(dstr) = gp_ref(GvGP(sstr));
+ SvTDOWN(sstr);
+ return;
+ }
+ /* FALL THROUGH */
+
+ default:
+ if (SvMAGICAL(sstr))
+ mg_get(sstr);
+ /* XXX */
+ break;
+ }
+
+ SvPRIVATE(dstr) = SvPRIVATE(sstr);
+ SvSTORAGE(dstr) = SvSTORAGE(sstr);
+
+ if (SvPOK(sstr)) {
+
+ SvTUP(sstr);
+
+ /*
+ * Check to see if we can just swipe the string. If so, it's a
+ * possible small lose on short strings, but a big win on long ones.
+ * It might even be a win on short strings if SvPV(dstr)
+ * has to be allocated and SvPV(sstr) has to be freed.
+ */
+
+ if (SvTEMP(sstr)) { /* slated for free anyway? */
+ if (SvPOK(dstr)) {
+ SvOOK_off(dstr);
+ Safefree(SvPV(dstr));
+ }
+ SvPV_set(dstr, SvPV(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvTYPE(dstr) = SvTYPE(sstr);
+ SvPOK_only(dstr);
+ SvTEMP_off(dstr);
+ SvPV_set(sstr, Nullch);
+ SvLEN_set(sstr, 0);
+ SvPOK_off(sstr); /* wipe out any weird flags */
+ SvTYPE(sstr) = 0; /* so sstr frees uneventfully */
+ }
+ else { /* have to copy actual string */
+ if (SvPV(dstr)) { /* XXX ck type */
+ SvOOK_off(dstr);
+ }
+ sv_setpvn(dstr,SvPV(sstr),SvCUR(sstr));
+ }
+ /*SUPPRESS 560*/
+ if (SvNOK(sstr)) {
+ SvNOK_on(dstr);
+ SvNV(dstr) = SvNV(sstr);
+ }
+ if (SvIOK(sstr)) {
+ SvIOK_on(dstr);
+ SvIV(dstr) = SvIV(sstr);
+ }
+ }
+ else if (SvNOK(sstr)) {
+ SvTUP(sstr);
+ SvNV(dstr) = SvNV(sstr);
+ SvNOK_only(dstr);
+ if (SvIOK(sstr)) {
+ SvIOK_on(dstr);
+ SvIV(dstr) = SvIV(sstr);
+ }
+ }
+ else if (SvIOK(sstr)) {
+ SvTUP(sstr);
+ SvIOK_only(dstr);
+ SvIV(dstr) = SvIV(sstr);
+ }
+ else {
+ SvTUP(sstr);
+ SvOK_off(dstr);
+ }
+ SvTDOWN(dstr);
+}
+
+void
+sv_setpvn(sv,ptr,len)
+register SV *sv;
+register char *ptr;
+register STRLEN len;
+{
+ if (!SvUPGRADE(sv, SVt_PV))
+ return;
+ SvGROW(sv, len + 1);
+ if (ptr)
+ Move(ptr,SvPV(sv),len,char);
+ SvCUR_set(sv, len);
+ *SvEND(sv) = '\0';
+ SvPOK_only(sv); /* validate pointer */
+ SvTDOWN(sv);
+}
+
+void
+sv_setpv(sv,ptr)
+register SV *sv;
+register char *ptr;
+{
+ register STRLEN len;
+
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (!ptr)
+ ptr = "";
+ len = strlen(ptr);
+ if (!SvUPGRADE(sv, SVt_PV))
+ return;
+ SvGROW(sv, len + 1);
+ Move(ptr,SvPV(sv),len+1,char);
+ SvCUR_set(sv, len);
+ SvPOK_only(sv); /* validate pointer */
+ SvTDOWN(sv);
+}
+
+void
+sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
+register SV *sv;
+register char *ptr;
+{
+ register STRLEN delta;
+
+ if (!ptr || !SvPOK(sv))
+ return;
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (SvTYPE(sv) < SVt_PVIV)
+ sv_upgrade(sv,SVt_PVIV);
+
+ if (!SvOOK(sv)) {
+ SvIV(sv) = 0;
+ SvFLAGS(sv) |= SVf_OOK;
+ }
+ SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
+ delta = ptr - SvPV(sv);
+ SvLEN(sv) -= delta;
+ SvCUR(sv) -= delta;
+ SvPV(sv) += delta;
+ SvIV(sv) += delta;
+}
+
+void
+sv_catpvn(sv,ptr,len)
+register SV *sv;
+register char *ptr;
+register STRLEN len;
+{
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (!(SvPOK(sv)))
+ (void)sv_2pv(sv);
+ SvGROW(sv, SvCUR(sv) + len + 1);
+ Move(ptr,SvPV(sv)+SvCUR(sv),len,char);
+ SvCUR(sv) += len;
+ *SvEND(sv) = '\0';
+ SvPOK_only(sv); /* validate pointer */
+ SvTDOWN(sv);
+}
+
+void
+sv_catsv(dstr,sstr)
+SV *dstr;
+register SV *sstr;
+{
+ char *s;
+ if (!sstr)
+ return;
+ if (s = SvPVn(sstr)) {
+ if (SvPOK(sstr))
+ sv_catpvn(dstr,s,SvCUR(sstr));
+ else
+ sv_catpv(dstr,s);
+ }
+}
+
+void
+sv_catpv(sv,ptr)
+register SV *sv;
+register char *ptr;
+{
+ register STRLEN len;
+
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (!ptr)
+ return;
+ if (!(SvPOK(sv)))
+ (void)sv_2pv(sv);
+ len = strlen(ptr);
+ SvGROW(sv, SvCUR(sv) + len + 1);
+ Move(ptr,SvPV(sv)+SvCUR(sv),len+1,char);
+ SvCUR(sv) += len;
+ SvPOK_only(sv); /* validate pointer */
+ SvTDOWN(sv);
+}
+
+char *
+sv_append_till(sv,from,fromend,delim,keeplist)
+register SV *sv;
+register char *from;
+register char *fromend;
+register I32 delim;
+char *keeplist;
+{
+ register char *to;
+ register STRLEN len;
+
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (!from)
+ return Nullch;
+ len = fromend - from;
+ if (!SvUPGRADE(sv, SVt_PV))
+ return 0;
+ SvGROW(sv, SvCUR(sv) + len + 1);
+ SvPOK_only(sv); /* validate pointer */
+ to = SvPV(sv)+SvCUR(sv);
+ for (; from < fromend; from++,to++) {
+ if (*from == '\\' && from+1 < fromend && delim != '\\') {
+ if (!keeplist)
+ *to++ = *from++;
+ else if (from[1] && index(keeplist,from[1]))
+ *to++ = *from++;
+ else
+ from++;
+ }
+ else if (*from == delim)
+ break;
+ *to = *from;
+ }
+ *to = '\0';
+ SvCUR_set(sv, to - SvPV(sv));
+ return from;
+}
+
+SV *
+#ifdef LEAKTEST
+newSV(x,len)
+I32 x;
+#else
+newSV(len)
+#endif
+STRLEN len;
+{
+ register SV *sv;
+
+ sv = (SV*)new_SV();
+ Zero(sv, 1, SV);
+ SvREFCNT(sv)++;
+ if (len) {
+ sv_upgrade(sv, SVt_PV);
+ SvGROW(sv, len + 1);
+ }
+ return sv;
+}
+
+void
+sv_magic(sv, obj, how, name, namlen)
+register SV *sv;
+SV *obj;
+char how;
+char *name;
+STRLEN namlen;
+{
+ MAGIC* mg;
+
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (!SvUPGRADE(sv, SVt_PVMG))
+ return;
+ Newz(702,mg, 1, MAGIC);
+ mg->mg_moremagic = SvMAGIC(sv);
+ SvMAGICAL_on(sv);
+ SvMAGIC(sv) = mg;
+ mg->mg_obj = obj;
+ mg->mg_type = how;
+ if (name) {
+ mg->mg_ptr = nsavestr(name, namlen);
+ mg->mg_len = namlen;
+ }
+ switch (how) {
+ case 0:
+ mg->mg_virtual = &vtbl_sv;
+ break;
+ case 'B':
+ mg->mg_virtual = &vtbl_bm;
+ break;
+ case 'D':
+ mg->mg_virtual = &vtbl_dbm;
+ break;
+ case 'd':
+ mg->mg_virtual = &vtbl_dbmelem;
+ break;
+ case 'E':
+ mg->mg_virtual = &vtbl_env;
+ break;
+ case 'e':
+ mg->mg_virtual = &vtbl_envelem;
+ break;
+ case 'L':
+ mg->mg_virtual = &vtbl_dbline;
+ break;
+ case 'S':
+ mg->mg_virtual = &vtbl_sig;
+ break;
+ case 's':
+ mg->mg_virtual = &vtbl_sigelem;
+ break;
+ case 'U':
+ mg->mg_virtual = &vtbl_uvar;
+ break;
+ case 'v':
+ mg->mg_virtual = &vtbl_vec;
+ break;
+ case 'x':
+ mg->mg_virtual = &vtbl_substr;
+ break;
+ case '*':
+ mg->mg_virtual = &vtbl_glob;
+ break;
+ case '#':
+ mg->mg_virtual = &vtbl_arylen;
+ break;
+ default:
+ fatal("Don't know how to handle magic of type '%c'", how);
+ }
+}
+
+void
+sv_insert(bigstr,offset,len,little,littlelen)
+SV *bigstr;
+STRLEN offset;
+STRLEN len;
+char *little;
+STRLEN littlelen;
+{
+ register char *big;
+ register char *mid;
+ register char *midend;
+ register char *bigend;
+ register I32 i;
+
+ if (SvREADONLY(bigstr))
+ fatal(no_modify);
+ SvPOK_only(bigstr);
+
+ i = littlelen - len;
+ if (i > 0) { /* string might grow */
+ if (!SvUPGRADE(bigstr, SVt_PV))
+ return;
+ SvGROW(bigstr, SvCUR(bigstr) + i + 1);
+ big = SvPV(bigstr);
+ mid = big + offset + len;
+ midend = bigend = big + SvCUR(bigstr);
+ bigend += i;
+ *bigend = '\0';
+ while (midend > mid) /* shove everything down */
+ *--bigend = *--midend;
+ Move(little,big+offset,littlelen,char);
+ SvCUR(bigstr) += i;
+ SvSETMAGIC(bigstr);
+ return;
+ }
+ else if (i == 0) {
+ Move(little,SvPV(bigstr)+offset,len,char);
+ SvSETMAGIC(bigstr);
+ return;
+ }
+
+ big = SvPV(bigstr);
+ mid = big + offset;
+ midend = mid + len;
+ bigend = big + SvCUR(bigstr);
+
+ if (midend > bigend)
+ fatal("panic: sv_insert");
+
+ if (mid - big > bigend - midend) { /* faster to shorten from end */
+ if (littlelen) {
+ Move(little, mid, littlelen,char);
+ mid += littlelen;
+ }
+ i = bigend - midend;
+ if (i > 0) {
+ Move(midend, mid, i,char);
+ mid += i;
+ }
+ *mid = '\0';
+ SvCUR_set(bigstr, mid - big);
+ }
+ /*SUPPRESS 560*/
+ else if (i = mid - big) { /* faster from front */
+ midend -= littlelen;
+ mid = midend;
+ sv_chop(bigstr,midend-i);
+ big += i;
+ while (i--)
+ *--midend = *--big;
+ if (littlelen)
+ Move(little, mid, littlelen,char);
+ }
+ else if (littlelen) {
+ midend -= littlelen;
+ sv_chop(bigstr,midend);
+ Move(little,midend,littlelen,char);
+ }
+ else {
+ sv_chop(bigstr,midend);
+ }
+ SvSETMAGIC(bigstr);
+}
+
+/* make sv point to what nstr did */
+
+void
+sv_replace(sv,nsv)
+register SV *sv;
+register SV *nsv;
+{
+ U32 refcnt = SvREFCNT(sv);
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (SvREFCNT(nsv) != 1)
+ warn("Reference miscount in sv_replace()");
+ SvREFCNT(sv) = 0;
+ sv_clear(sv);
+ StructCopy(nsv,sv,SV);
+ SvREFCNT(sv) = refcnt;
+ Safefree(nsv);
+}
+
+void
+sv_clear(sv)
+register SV *sv;
+{
+ assert(sv);
+ assert(SvREFCNT(sv) == 0);
+
+ switch (SvTYPE(sv)) {
+ case SVt_PVFM:
+ goto freemagic;
+ case SVt_PVBM:
+ goto freemagic;
+ case SVt_PVGV:
+ gp_free(sv);
+ goto freemagic;
+ case SVt_PVCV:
+ op_free(CvSTART(sv));
+ goto freemagic;
+ case SVt_PVHV:
+ hv_clear(sv, FALSE);
+ goto freemagic;
+ case SVt_PVAV:
+ av_clear(sv);
+ goto freemagic;
+ case SVt_PVLV:
+ goto freemagic;
+ case SVt_PVMG:
+ freemagic:
+ if (SvMAGICAL(sv))
+ mg_freeall(sv);
+ case SVt_PVNV:
+ case SVt_PVIV:
+ SvOOK_off(sv);
+ /* FALL THROUGH */
+ case SVt_PV:
+ if (SvPV(sv))
+ Safefree(SvPV(sv));
+ break;
+ case SVt_NV:
+ break;
+ case SVt_IV:
+ break;
+ case SVt_REF:
+ sv_free((SV*)SvANY(sv));
+ break;
+ case SVt_NULL:
+ break;
+ }
+
+ switch (SvTYPE(sv)) {
+ case SVt_NULL:
+ break;
+ case SVt_REF:
+ break;
+ case SVt_IV:
+ del_XIV(SvANY(sv));
+ break;
+ case SVt_NV:
+ del_XNV(SvANY(sv));
+ break;
+ case SVt_PV:
+ del_XPV(SvANY(sv));
+ break;
+ case SVt_PVIV:
+ del_XPVIV(SvANY(sv));
+ break;
+ case SVt_PVNV:
+ del_XPVNV(SvANY(sv));
+ break;
+ case SVt_PVMG:
+ del_XPVMG(SvANY(sv));
+ break;
+ case SVt_PVLV:
+ del_XPVLV(SvANY(sv));
+ break;
+ case SVt_PVAV:
+ del_XPVAV(SvANY(sv));
+ break;
+ case SVt_PVHV:
+ del_XPVHV(SvANY(sv));
+ break;
+ case SVt_PVCV:
+ del_XPVCV(SvANY(sv));
+ break;
+ case SVt_PVGV:
+ del_XPVGV(SvANY(sv));
+ break;
+ case SVt_PVBM:
+ del_XPVBM(SvANY(sv));
+ break;
+ case SVt_PVFM:
+ del_XPVFM(SvANY(sv));
+ break;
+ }
+ DEB(SvTYPE(sv) = 0xff;)
+}
+
+SV *
+sv_ref(sv)
+SV* sv;
+{
+ SvREFCNT(sv)++;
+ return sv;
+}
+
+void
+sv_free(sv)
+SV *sv;
+{
+ if (!sv)
+ return;
+ if (SvREADONLY(sv)) {
+ if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
+ return;
+ }
+ if (SvREFCNT(sv) == 0) {
+ warn("Attempt to free unreferenced scalar");
+ return;
+ }
+ if (--SvREFCNT(sv) > 0)
+ return;
+ if (SvSTORAGE(sv) == 'O') {
+ dSP;
+ BINOP myop; /* fake syntax tree node */
+ GV* destructor;
+
+ SvSTORAGE(sv) = 0; /* Curse the object. */
+
+ ENTER;
+ SAVESPTR(curcop);
+ SAVESPTR(op);
+ curcop = &compiling;
+ curstash = SvSTASH(sv);
+ destructor = gv_fetchpv("DESTROY", FALSE);
+
+ if (GvCV(destructor)) {
+ SV* ref = sv_mortalcopy(&sv_undef);
+ SvREFCNT(ref) = 1;
+ sv_upgrade(ref, SVt_REF);
+ SvANY(ref) = (void*)sv_ref(sv);
+
+ op = (OP*)&myop;
+ Zero(op, 1, OP);
+ myop.op_last = (OP*)&myop;
+ myop.op_flags = OPf_STACKED;
+ myop.op_next = Nullop;
+
+ EXTEND(SP, 2);
+ PUSHs((SV*)destructor);
+ pp_pushmark();
+ PUSHs(ref);
+ PUTBACK;
+ op = pp_entersubr();
+ run();
+ stack_sp--;
+ LEAVE; /* Will eventually free sv as ordinary item. */
+ return;
+ }
+ LEAVE;
+ }
+ sv_clear(sv);
+ DEB(SvTYPE(sv) = 0xff;)
+ del_SV(sv);
+}
+
+STRLEN
+sv_len(sv)
+register SV *sv;
+{
+ I32 paren;
+ I32 i;
+ char *s;
+
+ if (!sv)
+ return 0;
+
+ if (SvMAGICAL(sv))
+ return mg_len(sv, SvMAGIC(sv));
+
+ if (!(SvPOK(sv))) {
+ (void)sv_2pv(sv);
+ if (!SvOK(sv))
+ return 0;
+ }
+ if (SvPV(sv))
+ return SvCUR(sv);
+ else
+ return 0;
+}
+
+I32
+sv_eq(str1,str2)
+register SV *str1;
+register SV *str2;
+{
+ char *pv1;
+ U32 cur1;
+ char *pv2;
+ U32 cur2;
+
+ if (!str1) {
+ pv1 = "";
+ cur1 = 0;
+ }
+ else {
+ if (SvMAGICAL(str1))
+ mg_get(str1);
+ if (!SvPOK(str1)) {
+ (void)sv_2pv(str1);
+ if (!SvPOK(str1))
+ str1 = &sv_no;
+ }
+ pv1 = SvPV(str1);
+ cur1 = SvCUR(str1);
+ }
+
+ if (!str2)
+ return !cur1;
+ else {
+ if (SvMAGICAL(str2))
+ mg_get(str2);
+ if (!SvPOK(str2)) {
+ (void)sv_2pv(str2);
+ if (!SvPOK(str2))
+ return !cur1;
+ }
+ pv2 = SvPV(str2);
+ cur2 = SvCUR(str2);
+ }
+
+ if (cur1 != cur2)
+ return 0;
+
+ return !bcmp(pv1, pv2, cur1);
+}
+
+I32
+sv_cmp(str1,str2)
+register SV *str1;
+register SV *str2;
+{
+ I32 retval;
+ char *pv1;
+ U32 cur1;
+ char *pv2;
+ U32 cur2;
+
+ if (!str1) {
+ pv1 = "";
+ cur1 = 0;
+ }
+ else {
+ if (SvMAGICAL(str1))
+ mg_get(str1);
+ if (!SvPOK(str1)) {
+ (void)sv_2pv(str1);
+ if (!SvPOK(str1))
+ str1 = &sv_no;
+ }
+ pv1 = SvPV(str1);
+ cur1 = SvCUR(str1);
+ }
+
+ if (!str2) {
+ pv2 = "";
+ cur2 = 0;
+ }
+ else {
+ if (SvMAGICAL(str2))
+ mg_get(str2);
+ if (!SvPOK(str2)) {
+ (void)sv_2pv(str2);
+ if (!SvPOK(str2))
+ str2 = &sv_no;
+ }
+ pv2 = SvPV(str2);
+ cur2 = SvCUR(str2);
+ }
+
+ if (!cur1)
+ return cur2 ? -1 : 0;
+ if (!cur2)
+ return 1;
+
+ if (cur1 < cur2) {
+ /*SUPPRESS 560*/
+ if (retval = memcmp(pv1, pv2, cur1))
+ return retval < 0 ? -1 : 1;
+ else
+ return -1;
+ }
+ /*SUPPRESS 560*/
+ else if (retval = memcmp(pv1, pv2, cur2))
+ return retval < 0 ? -1 : 1;
+ else if (cur1 == cur2)
+ return 0;
+ else
+ return 1;
+}
+
+char *
+sv_gets(sv,fp,append)
+register SV *sv;
+register FILE *fp;
+I32 append;
+{
+ register char *bp; /* we're going to steal some values */
+ register I32 cnt; /* from the stdio struct and put EVERYTHING */
+ register STDCHAR *ptr; /* in the innermost loop into registers */
+ register I32 newline = rschar;/* (assuming >= 6 registers) */
+ I32 i;
+ STRLEN bpx;
+ I32 shortbuffered;
+
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (!SvUPGRADE(sv, SVt_PV))
+ return;
+ if (rspara) { /* have to do this both before and after */
+ do { /* to make sure file boundaries work right */
+ i = getc(fp);
+ if (i != '\n') {
+ ungetc(i,fp);
+ break;
+ }
+ } while (i != EOF);
+ }
+#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */
+ cnt = fp->_cnt; /* get count into register */
+ SvPOK_only(sv); /* validate pointer */
+ if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
+ if (cnt > 80 && SvLEN(sv) > append) {
+ shortbuffered = cnt - SvLEN(sv) + append + 1;
+ cnt -= shortbuffered;
+ }
+ else {
+ shortbuffered = 0;
+ SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
+ }
+ }
+ else
+ shortbuffered = 0;
+ bp = SvPV(sv) + append; /* move these two too to registers */
+ ptr = fp->_ptr;
+ for (;;) {
+ screamer:
+ while (--cnt >= 0) { /* this */ /* eat */
+ if ((*bp++ = *ptr++) == newline) /* really */ /* dust */
+ goto thats_all_folks; /* screams */ /* sed :-) */
+ }
+
+ if (shortbuffered) { /* oh well, must extend */
+ cnt = shortbuffered;
+ shortbuffered = 0;
+ bpx = bp - SvPV(sv); /* prepare for possible relocation */
+ SvCUR_set(sv, bpx);
+ SvGROW(sv, SvLEN(sv) + append + cnt + 2);
+ bp = SvPV(sv) + bpx; /* reconstitute our pointer */
+ continue;
+ }
+
+ fp->_cnt = cnt; /* deregisterize cnt and ptr */
+ fp->_ptr = ptr;
+ i = _filbuf(fp); /* get more characters */
+ cnt = fp->_cnt;
+ ptr = fp->_ptr; /* reregisterize cnt and ptr */
+
+ bpx = bp - SvPV(sv); /* prepare for possible relocation */
+ SvCUR_set(sv, bpx);
+ SvGROW(sv, bpx + cnt + 2);
+ bp = SvPV(sv) + bpx; /* reconstitute our pointer */
+
+ if (i == newline) { /* all done for now? */
+ *bp++ = i;
+ goto thats_all_folks;
+ }
+ else if (i == EOF) /* all done for ever? */
+ goto thats_really_all_folks;
+ *bp++ = i; /* now go back to screaming loop */
+ }
+
+thats_all_folks:
+ if (rslen > 1 && (bp - SvPV(sv) < rslen || bcmp(bp - rslen, rs, rslen)))
+ goto screamer; /* go back to the fray */
+thats_really_all_folks:
+ if (shortbuffered)
+ cnt += shortbuffered;
+ fp->_cnt = cnt; /* put these back or we're in trouble */
+ fp->_ptr = ptr;
+ *bp = '\0';
+ SvCUR_set(sv, bp - SvPV(sv)); /* set length */
+
+#else /* !STDSTDIO */ /* The big, slow, and stupid way */
+
+ {
+ char buf[8192];
+ register char * bpe = buf + sizeof(buf) - 3;
+
+screamer:
+ bp = buf;
+ while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
+
+ if (append)
+ sv_catpvn(sv, buf, bp - buf);
+ else
+ sv_setpvn(sv, buf, bp - buf);
+ if (i != EOF /* joy */
+ &&
+ (i != newline
+ ||
+ (rslen > 1
+ &&
+ (SvCUR(sv) < rslen
+ ||
+ bcmp(SvPV(sv) + SvCUR(sv) - rslen, rs, rslen)
+ )
+ )
+ )
+ )
+ {
+ append = -1;
+ goto screamer;
+ }
+ }
+
+#endif /* STDSTDIO */
+
+ if (rspara) {
+ while (i != EOF) {
+ i = getc(fp);
+ if (i != '\n') {
+ ungetc(i,fp);
+ break;
+ }
+ }
+ }
+ return SvCUR(sv) - append ? SvPV(sv) : Nullch;
+}
+
+void
+sv_inc(sv)
+register SV *sv;
+{
+ register char *d;
+
+ if (!sv)
+ return;
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (SvMAGICAL(sv))
+ mg_get(sv);
+ if (SvIOK(sv)) {
+ ++SvIV(sv);
+ SvIOK_only(sv);
+ return;
+ }
+ if (SvNOK(sv)) {
+ SvNV(sv) += 1.0;
+ SvNOK_only(sv);
+ return;
+ }
+ if (!SvPOK(sv) || !*SvPV(sv)) {
+ if (!SvUPGRADE(sv, SVt_NV))
+ return;
+ SvNV(sv) = 1.0;
+ SvNOK_only(sv);
+ return;
+ }
+ d = SvPV(sv);
+ while (isALPHA(*d)) d++;
+ while (isDIGIT(*d)) d++;
+ if (*d) {
+ sv_setnv(sv,atof(SvPV(sv)) + 1.0); /* punt */
+ return;
+ }
+ d--;
+ while (d >= SvPV(sv)) {
+ if (isDIGIT(*d)) {
+ if (++*d <= '9')
+ return;
+ *(d--) = '0';
+ }
+ else {
+ ++*d;
+ if (isALPHA(*d))
+ return;
+ *(d--) -= 'z' - 'a' + 1;
+ }
+ }
+ /* oh,oh, the number grew */
+ SvGROW(sv, SvCUR(sv) + 2);
+ SvCUR(sv)++;
+ for (d = SvPV(sv) + SvCUR(sv); d > SvPV(sv); d--)
+ *d = d[-1];
+ if (isDIGIT(d[1]))
+ *d = '1';
+ else
+ *d = d[1];
+}
+
+void
+sv_dec(sv)
+register SV *sv;
+{
+ if (!sv)
+ return;
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (SvMAGICAL(sv))
+ mg_get(sv);
+ if (SvIOK(sv)) {
+ --SvIV(sv);
+ SvIOK_only(sv);
+ return;
+ }
+ if (SvNOK(sv)) {
+ SvNV(sv) -= 1.0;
+ SvNOK_only(sv);
+ return;
+ }
+ if (!SvPOK(sv)) {
+ if (!SvUPGRADE(sv, SVt_NV))
+ return;
+ SvNV(sv) = -1.0;
+ SvNOK_only(sv);
+ return;
+ }
+ sv_setnv(sv,atof(SvPV(sv)) - 1.0);
+}
+
+/* Make a string that will exist for the duration of the expression
+ * evaluation. Actually, it may have to last longer than that, but
+ * hopefully we won't free it until it has been assigned to a
+ * permanent location. */
+
+SV *
+sv_mortalcopy(oldstr)
+SV *oldstr;
+{
+ register SV *sv = NEWSV(78,0);
+
+ sv_setsv(sv,oldstr);
+ if (++tmps_ix > tmps_max) {
+ tmps_max = tmps_ix;
+ if (!(tmps_max & 127)) {
+ if (tmps_max)
+ Renew(tmps_stack, tmps_max + 128, SV*);
+ else
+ New(702,tmps_stack, 128, SV*);
+ }
+ }
+ tmps_stack[tmps_ix] = sv;
+ if (SvPOK(sv))
+ SvTEMP_on(sv);
+ return sv;
+}
+
+/* same thing without the copying */
+
+SV *
+sv_2mortal(sv)
+register SV *sv;
+{
+ if (!sv)
+ return sv;
+ if (SvREADONLY(sv))
+ fatal(no_modify);
+ if (++tmps_ix > tmps_max) {
+ tmps_max = tmps_ix;
+ if (!(tmps_max & 127)) {
+ if (tmps_max)
+ Renew(tmps_stack, tmps_max + 128, SV*);
+ else
+ New(704,tmps_stack, 128, SV*);
+ }
+ }
+ tmps_stack[tmps_ix] = sv;
+ if (SvPOK(sv))
+ SvTEMP_on(sv);
+ return sv;
+}
+
+SV *
+newSVpv(s,len)
+char *s;
+STRLEN len;
+{
+ register SV *sv = NEWSV(79,0);
+
+ if (!len)
+ len = strlen(s);
+ sv_setpvn(sv,s,len);
+ return sv;
+}
+
+SV *
+newSVnv(n)
+double n;
+{
+ register SV *sv = NEWSV(80,0);
+
+ sv_setnv(sv,n);
+ return sv;
+}
+
+SV *
+newSViv(i)
+I32 i;
+{
+ register SV *sv = NEWSV(80,0);
+
+ sv_setiv(sv,i);
+ return sv;
+}
+
+/* make an exact duplicate of old */
+
+SV *
+newSVsv(old)
+register SV *old;
+{
+ register SV *new;
+
+ if (!old)
+ return Nullsv;
+ if (SvTYPE(old) == 0xff) {
+ warn("semi-panic: attempt to dup freed string");
+ return Nullsv;
+ }
+ new = NEWSV(80,0);
+ if (SvTEMP(old)) {
+ SvTEMP_off(old);
+ sv_setsv(new,old);
+ SvTEMP_on(old);
+ }
+ else
+ sv_setsv(new,old);
+ return new;
+}
+
+void
+sv_reset(s,stash)
+register char *s;
+HV *stash;
+{
+ register HE *entry;
+ register GV *gv;
+ register SV *sv;
+ register I32 i;
+ register PMOP *pm;
+ register I32 max;
+
+ if (!*s) { /* reset ?? searches */
+ for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
+ pm->op_pmflags &= ~PMf_USED;
+ }
+ return;
+ }
+
+ /* reset variables */
+
+ if (!HvARRAY(stash))
+ return;
+ while (*s) {
+ i = *s;
+ if (s[1] == '-') {
+ s += 2;
+ }
+ max = *s++;
+ for ( ; i <= max; i++) {
+ for (entry = HvARRAY(stash)[i];
+ entry;
+ entry = entry->hent_next) {
+ gv = (GV*)entry->hent_val;
+ sv = GvSV(gv);
+ SvOK_off(sv);
+ if (SvTYPE(sv) >= SVt_PV) {
+ SvCUR_set(sv, 0);
+ SvTDOWN(sv);
+ if (SvPV(sv) != Nullch)
+ *SvPV(sv) = '\0';
+ }
+ if (GvAV(gv)) {
+ av_clear(GvAV(gv));
+ }
+ if (GvHV(gv)) {
+ hv_clear(GvHV(gv), FALSE);
+ if (gv == envgv)
+ environ[0] = Nullch;
+ }
+ }
+ }
+ }
+}
+
+#ifdef OLD
+AV *
+sv_2av(sv, st, gvp, lref)
+SV *sv;
+HV **st;
+GV **gvp;
+I32 lref;
+{
+ GV *gv;
+
+ switch (SvTYPE(sv)) {
+ case SVt_PVAV:
+ *st = sv->sv_u.sv_stash;
+ *gvp = Nullgv;
+ return sv->sv_u.sv_av;
+ case SVt_PVHV:
+ case SVt_PVCV:
+ *gvp = Nullgv;
+ return Nullav;
+ default:
+ if (isGV(sv))
+ gv = (GV*)sv;
+ else
+ gv = gv_fetchpv(SvPVn(sv), lref);
+ *gvp = gv;
+ if (!gv)
+ return Nullav;
+ *st = GvESTASH(gv);
+ if (lref)
+ return GvAVn(gv);
+ else
+ return GvAV(gv);
+ }
+}
+
+HV *
+sv_2hv(sv, st, gvp, lref)
+SV *sv;
+HV **st;
+GV **gvp;
+I32 lref;
+{
+ GV *gv;
+
+ switch (SvTYPE(sv)) {
+ case SVt_PVHV:
+ *st = sv->sv_u.sv_stash;
+ *gvp = Nullgv;
+ return sv->sv_u.sv_hv;
+ case SVt_PVAV:
+ case SVt_PVCV:
+ *gvp = Nullgv;
+ return Nullhv;
+ default:
+ if (isGV(sv))
+ gv = (GV*)sv;
+ else
+ gv = gv_fetchpv(SvPVn(sv), lref);
+ *gvp = gv;
+ if (!gv)
+ return Nullhv;
+ *st = GvESTASH(gv);
+ if (lref)
+ return GvHVn(gv);
+ else
+ return GvHV(gv);
+ }
+}
+#endif;
+
+CV *
+sv_2cv(sv, st, gvp, lref)
+SV *sv;
+HV **st;
+GV **gvp;
+I32 lref;
+{
+ GV *gv;
+ CV *cv;
+
+ if (!sv)
+ return Nullcv;
+ switch (SvTYPE(sv)) {
+ case SVt_REF:
+ cv = (CV*)SvANY(sv);
+ if (SvTYPE(cv) != SVt_PVCV)
+ fatal("Not a subroutine reference");
+ *gvp = Nullgv;
+ *st = CvSTASH(cv);
+ return cv;
+ case SVt_PVCV:
+ *st = CvSTASH(sv);
+ *gvp = Nullgv;
+ return (CV*)sv;
+ case SVt_PVHV:
+ case SVt_PVAV:
+ *gvp = Nullgv;
+ return Nullcv;
+ default:
+ if (isGV(sv))
+ gv = (GV*)sv;
+ else
+ gv = gv_fetchpv(SvPVn(sv), lref);
+ *gvp = gv;
+ if (!gv)
+ return Nullcv;
+ *st = GvESTASH(gv);
+ return GvCV(gv);
+ }
+}
+
+#ifndef SvTRUE
+I32
+SvTRUE(sv)
+register SV *sv;
+{
+ if (SvMAGICAL(sv))
+ mg_get(sv);
+ if (SvPOK(sv)) {
+ register XPV* Xpv;
+ if ((Xpv = (XPV*)SvANY(sv)) &&
+ (*Xpv->xpv_pv > '0' ||
+ Xpv->xpv_cur > 1 ||
+ (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+ return 1;
+ else
+ return 0;
+ }
+ else {
+ if (SvIOK(sv))
+ return SvIV(sv) != 0;
+ else {
+ if (SvNOK(sv))
+ return SvNV(sv) != 0.0;
+ else
+ return 0;
+ }
+ }
+}
+#endif /* SvTRUE */
+
+#ifndef SvNVn
+double SvNVn(Sv)
+register SV *Sv;
+{
+ SvTUP(Sv);
+ if (SvMAGICAL(sv))
+ mg_get(sv);
+ if (SvNOK(Sv))
+ return SvNV(Sv);
+ if (SvIOK(Sv))
+ return (double)SvIV(Sv);
+ return sv_2nv(Sv);
+}
+#endif /* SvNVn */
+
+#ifndef SvPVn
+char *
+SvPVn(sv)
+SV *sv;
+{
+ SvTUP(sv);
+ if (SvMAGICAL(sv))
+ mg_get(sv);
+ return SvPOK(sv) ? SvPV(sv) : sv_2pv(sv);
+}
+#endif
+
View Lorry Controller Status