X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=7192122f5f9a556ee6aac0facb9d8997d21f46c0;hb=143014bf2594b56fdf762b3cf36b37c248c55291;hp=b90dea9b04b9510a8f9d735716e34018740ec9a8;hpb=7e0f6a1f00659d26d3dff8670411159e65089d91;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index b90dea9..7192122 100644
--- a/perl.c
+++ b/perl.c
@@ -25,7 +25,7 @@
 char *getenv (char *); /* Usually in <stdlib.h> */
 #endif
 
-static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
+static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 
 #ifdef IAMSUID
 #ifndef DOSUID
@@ -39,15 +39,7 @@ static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
 #endif
 #endif
 
-#ifdef PERL_OBJECT
-#define perl_construct	Perl_construct
-#define perl_parse	Perl_parse
-#define perl_run	Perl_run
-#define perl_destruct	Perl_destruct
-#define perl_free	Perl_free
-#endif
-
-#if defined(USE_THREADS)
+#if defined(USE_5005THREADS)
 #  define INIT_TLS_AND_INTERP \
     STMT_START {				\
 	if (!PL_curinterp) {			\
@@ -91,11 +83,6 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
 		 struct IPerlProc* ipP)
 {
     PerlInterpreter *my_perl;
-#ifdef PERL_OBJECT
-    my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
-						  ipLIO, ipD, ipS, ipP);
-    INIT_TLS_AND_INTERP;
-#else
     /* New() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     INIT_TLS_AND_INTERP;
@@ -109,7 +96,6 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
     PL_Dir = ipD;
     PL_Sock = ipS;
     PL_Proc = ipP;
-#endif
 
     return my_perl;
 }
@@ -148,12 +134,11 @@ Initializes a new Perl interpreter.  See L<perlembed>.
 void
 perl_construct(pTHXx)
 {
-#ifdef USE_THREADS
-    int i;
+#ifdef USE_5005THREADS
 #ifndef FAKE_THREADS
     struct perl_thread *thr = NULL;
 #endif /* FAKE_THREADS */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
 #ifdef MULTIPLICITY
     init_interp();
@@ -165,7 +150,7 @@ perl_construct(pTHXx)
 
    /* Init the real globals (and main thread)? */
     if (!PL_linestr) {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 	MUTEX_INIT(&PL_sv_mutex);
 	/*
 	 * Safe to use basic SV functions from now on (though
@@ -184,7 +169,7 @@ perl_construct(pTHXx)
 	MUTEX_INIT(&PL_fdpid_mutex);
 
 	thr = init_main_thread();
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
 #ifdef PERL_FLEXIBLE_EXCEPTIONS
 	PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
@@ -213,12 +198,7 @@ perl_construct(pTHXx)
 	    SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
 	}
 
-#ifdef PERL_OBJECT
-	/* TODO: */
-	/* PL_sighandlerp = sighandler; */
-#else
 	PL_sighandlerp = Perl_sighandler;
-#endif
 	PL_pidstatus = newHV();
 
 #ifdef MSDOS
@@ -227,13 +207,12 @@ perl_construct(pTHXx)
 	 * space.  The other alternative would be to provide STDAUX and STDPRN
 	 * filehandles.
 	 */
-	(void)fclose(stdaux);
-	(void)fclose(stdprn);
+	(void)PerlIO_close(PerlIO_importFILE(stdaux, 0));
+	(void)PerlIO_close(PerlIO_importFILE(stdprn, 0));
 #endif
     }
 
-    PL_nrs = newSVpvn("\n", 1);
-    PL_rs = SvREFCNT_inc(PL_nrs);
+    PL_rs = newSVpvn("\n", 1);
 
     init_stacks();
 
@@ -253,9 +232,10 @@ perl_construct(pTHXx)
 	if (PERL_REVISION > 127 || PERL_VERSION > 127 || PERL_SUBVERSION > 127)
 	    SvGROW(PL_patchlevel, UTF8_MAXLEN*3+1);
 	s = (U8*)SvPVX(PL_patchlevel);
-	s = uv_to_utf8(s, (UV)PERL_REVISION);
-	s = uv_to_utf8(s, (UV)PERL_VERSION);
-	s = uv_to_utf8(s, (UV)PERL_SUBVERSION);
+	/* Build version strings using "native" characters */
+	s = uvchr_to_utf8(s, (UV)PERL_REVISION);
+	s = uvchr_to_utf8(s, (UV)PERL_VERSION);
+	s = uvchr_to_utf8(s, (UV)PERL_SUBVERSION);
 	*s = '\0';
 	SvCUR_set(PL_patchlevel, s - (U8*)SvPVX(PL_patchlevel));
 	SvPOK_on(PL_patchlevel);
@@ -278,11 +258,40 @@ perl_construct(pTHXx)
     sys_intern_init();
 #endif
 
-    PerlIO_init();			/* Hook to IO system */
+    PerlIO_init(aTHX);			/* Hook to IO system */
 
     PL_fdpid = newAV();			/* for remembering popen pids by fd */
     PL_modglobal = newHV();		/* pointers to per-interpreter module globals */
     PL_errors = newSVpvn("",0);
+#ifdef USE_ITHREADS
+    PL_regex_padav = newAV();
+    av_push(PL_regex_padav,(SV*)newAV());    /* First entry is an array of empty elements */
+    PL_regex_pad = AvARRAY(PL_regex_padav);
+#endif
+#ifdef USE_REENTRANT_API
+    New(31337, PL_reentrant_buffer,1, REBUF);
+    New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
+#endif
+
+    /* Note that strtab is a rather special HV.  Assumptions are made
+       about not iterating on it, and not adding tie magic to it.
+       It is properly deallocated in perl_destruct() */
+    PL_strtab = newHV();
+
+#ifdef USE_5005THREADS
+    MUTEX_INIT(&PL_strtab_mutex);
+#endif
+    HvSHAREKEYS_off(PL_strtab);			/* mandatory */
+    hv_ksplit(PL_strtab, 512);
+
+#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
+    _dyld_lookup_and_bind
+	("__environ", (unsigned long *) &environ_pointer, NULL);
+#endif /* environ */
+
+#ifdef  USE_ENVIRON_ARRAY
+    PL_origenviron = environ;
+#endif
 
     ENTER;
 }
@@ -295,21 +304,20 @@ Shuts down a Perl interpreter.  See L<perlembed>.
 =cut
 */
 
-void
+int
 perl_destruct(pTHXx)
 {
-    int destruct_level;  /* 0=none, 1=full, 2=full with checks */
-    I32 last_sv_count;
+    volatile int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     HV *hv;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     Thread t;
     dTHX;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     /* wait for all pseudo-forked children to finish */
     PERL_WAIT_FOR_CHILDREN;
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 #ifndef FAKE_THREADS
     /* Pass 1 on any remaining threads: detach joinables, join zombies */
   retry_cleanup:
@@ -378,7 +386,7 @@ perl_destruct(pTHXx)
     COND_DESTROY(&PL_nthreads_cond);
     PL_nthreads--;
 #endif /* !defined(FAKE_THREADS) */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     destruct_level = PL_perl_destruct_level;
 #ifdef DEBUGGING
@@ -392,6 +400,16 @@ perl_destruct(pTHXx)
     }
 #endif
 
+
+    if(PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
+        dJMPENV;
+        int x = 0;
+
+        JMPENV_PUSH(x);
+        if (PL_endav && !PL_minus_c)
+            call_list(PL_scopestack_ix, PL_endav);
+        JMPENV_POP;
+    }
     LEAVE;
     FREETMPS;
 
@@ -409,6 +427,13 @@ perl_destruct(pTHXx)
     PL_main_cv = Nullcv;
     PL_dirty = TRUE;
 
+    /* Tell PerlIO we are about to tear things apart in case
+       we have layers which are using resources that should
+       be cleaned up now.
+     */
+
+    PerlIO_destruct(aTHX);
+
     if (PL_sv_objcount) {
 	/*
 	 * Try to destruct global references.  We do this first so that the
@@ -426,7 +451,7 @@ perl_destruct(pTHXx)
 
     /* call exit list functions */
     while (PL_exitlistlen-- > 0)
-	PL_exitlist[PL_exitlistlen].fn(aTHXo_ PL_exitlist[PL_exitlistlen].ptr);
+	PL_exitlist[PL_exitlistlen].fn(aTHX_ PL_exitlist[PL_exitlistlen].ptr);
 
     Safefree(PL_exitlist);
 
@@ -434,8 +459,13 @@ perl_destruct(pTHXx)
 
 	DEBUG_P(debprofdump());
 
+#if defined(PERLIO_LAYERS)
+	/* No more IO - including error messages ! */
+	PerlIO_cleanup(aTHX);
+#endif
+
 	/* The exit() function will do everything that needs doing. */
-	return;
+        return STATUS_NATIVE_EXPORT;;
     }
 
     /* jettison our possibly duplicated environment */
@@ -446,6 +476,7 @@ perl_destruct(pTHXx)
 
 	for (i = 0; environ[i]; i++)
 	    safesysfree(environ[i]);
+
 	/* Must use safesysfree() when working with environ. */
 	safesysfree(environ);		
 
@@ -453,6 +484,39 @@ perl_destruct(pTHXx)
     }
 #endif
 
+#ifdef USE_ITHREADS
+    /* the syntax tree is shared between clones
+     * so op_free(PL_main_root) only ReREFCNT_dec's
+     * REGEXPs in the parent interpreter
+     * we need to manually ReREFCNT_dec for the clones
+     */
+    {
+        I32 i = AvFILLp(PL_regex_padav) + 1;
+        SV **ary = AvARRAY(PL_regex_padav);
+
+        while (i) {
+            SV *resv = ary[--i];
+            REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
+
+            if (SvFLAGS(resv) & SVf_BREAK) {
+                /* this is PL_reg_curpm, already freed
+                 * flag is set in regexec.c:S_regtry
+                 */
+                SvFLAGS(resv) &= ~SVf_BREAK;
+            }
+	    else if(SvREPADTMP(resv)) {
+	      SvREPADTMP_off(resv);
+	    }
+            else {
+                ReREFCNT_dec(re);
+            }
+        }
+    }
+    SvREFCNT_dec(PL_regex_padav);
+    PL_regex_padav = Nullav;
+    PL_regex_pad = NULL;
+#endif
+
     /* loosen bonds of global variables */
 
     if(PL_rsfp) {
@@ -486,6 +550,11 @@ perl_destruct(pTHXx)
 	PL_e_script = Nullsv;
     }
 
+    while (--PL_origargc >= 0) {
+        Safefree(PL_origargv[PL_origargc]);
+    }
+    Safefree(PL_origargv);
+
     /* magical thingies */
 
     SvREFCNT_dec(PL_ofs_sv);	/* $, */
@@ -497,9 +566,6 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_rs);	/* $/ */
     PL_rs = Nullsv;
 
-    SvREFCNT_dec(PL_nrs);	/* $/ helper */
-    PL_nrs = Nullsv;
-
     PL_multiline = 0;		/* $* */
     Safefree(PL_osname);	/* $^O */
     PL_osname = Nullch;
@@ -525,10 +591,12 @@ perl_destruct(pTHXx)
 
     /* startup and shutdown function lists */
     SvREFCNT_dec(PL_beginav);
+    SvREFCNT_dec(PL_beginav_save);
     SvREFCNT_dec(PL_endav);
     SvREFCNT_dec(PL_checkav);
     SvREFCNT_dec(PL_initav);
     PL_beginav = Nullav;
+    PL_beginav_save = Nullav;
     PL_endav = Nullav;
     PL_checkav = Nullav;
     PL_initav = Nullav;
@@ -577,7 +645,7 @@ perl_destruct(pTHXx)
 #ifdef USE_LOCALE_NUMERIC
     Safefree(PL_numeric_name);
     PL_numeric_name = Nullch;
-    SvREFCNT_dec(PL_numeric_radix);
+    SvREFCNT_dec(PL_numeric_radix_sv);
 #endif
 
     /* clear utf8 character classes */
@@ -596,6 +664,7 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_utf8_xdigit);
     SvREFCNT_dec(PL_utf8_mark);
     SvREFCNT_dec(PL_utf8_toupper);
+    SvREFCNT_dec(PL_utf8_totitle);
     SvREFCNT_dec(PL_utf8_tolower);
     PL_utf8_alnum	= Nullsv;
     PL_utf8_alnumc	= Nullsv;
@@ -662,13 +731,13 @@ perl_destruct(pTHXx)
     }
 
     /* Now absolutely destruct everything, somehow or other, loops or no. */
-    last_sv_count = 0;
     SvFLAGS(PL_fdpid) |= SVTYPEMASK;		/* don't clean out pid table now */
     SvFLAGS(PL_strtab) |= SVTYPEMASK;		/* don't clean out strtab now */
-    while (PL_sv_count != 0 && PL_sv_count != last_sv_count) {
-	last_sv_count = PL_sv_count;
-	sv_clean_all();
-    }
+
+    /* the 2 is for PL_fdpid and PL_strtab */
+    while (PL_sv_count > 2 && sv_clean_all())
+	;
+
     SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
     SvFLAGS(PL_fdpid) |= SVt_PVAV;
     SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
@@ -736,6 +805,11 @@ perl_destruct(pTHXx)
     if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
 	Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
 
+#if defined(PERLIO_LAYERS)
+    /* No more IO - including error messages ! */
+    PerlIO_cleanup(aTHX);
+#endif
+
     Safefree(PL_origfilename);
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
@@ -745,12 +819,13 @@ perl_destruct(pTHXx)
     Safefree(PL_op_mask);
     Safefree(PL_psig_ptr);
     Safefree(PL_psig_name);
+    Safefree(PL_bitcount);
     Safefree(PL_psig_pend);
     nuke_stacks();
     PL_hints = 0;		/* Reset hints. Should hints be per-interpreter ? */
 
     DEBUG_P(debprofdump());
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     MUTEX_DESTROY(&PL_strtab_mutex);
     MUTEX_DESTROY(&PL_sv_mutex);
     MUTEX_DESTROY(&PL_eval_mutex);
@@ -766,7 +841,12 @@ perl_destruct(pTHXx)
     Safefree(SvANY(PL_thrsv));
     Safefree(PL_thrsv);
     PL_thrsv = Nullsv;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
+
+#ifdef USE_REENTRANT_API
+    Safefree(PL_reentrant_buffer->tmbuff);
+    Safefree(PL_reentrant_buffer);
+#endif
 
     sv_free_arenas();
 
@@ -779,7 +859,8 @@ perl_destruct(pTHXx)
 	    MAGIC* moremagic;
 	    for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
 		moremagic = mg->mg_moremagic;
-		if (mg->mg_ptr && mg->mg_type != 'g' && mg->mg_len >= 0)
+		if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
+						&& mg->mg_len >= 0)
 		    Safefree(mg->mg_ptr);
 		Safefree(mg);
 	    }
@@ -791,6 +872,7 @@ perl_destruct(pTHXx)
 	Safefree(PL_mess_sv);
 	PL_mess_sv = Nullsv;
     }
+    return STATUS_NATIVE_EXPORT;
 }
 
 /*
@@ -804,24 +886,24 @@ Releases a Perl interpreter.  See L<perlembed>.
 void
 perl_free(pTHXx)
 {
-#if defined(PERL_OBJECT)
-    PerlMem_free(this);
-#else
-#  if defined(WIN32)
+#if defined(WIN32) || defined(NETWARE)
 #  if defined(PERL_IMPLICIT_SYS)
+#    ifdef NETWARE
+    void *host = nw_internal_host;
+#    else
     void *host = w32_internal_host;
-    if (PerlProc_lasthost()) {
-	PerlIO_cleanup();
-    }
+#    endif
     PerlMem_free(aTHXx);
+#    ifdef NETWARE
+    nw5_delete_internal_host(host);
+#    else
     win32_delete_internal_host(host);
-#else
-    PerlIO_cleanup();
-    PerlMem_free(aTHXx);
-#endif
+#    endif
 #  else
     PerlMem_free(aTHXx);
 #  endif
+#else
+    PerlMem_free(aTHXx);
 #endif
 }
 
@@ -848,7 +930,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     I32 oldscope;
     int ret;
     dJMPENV;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     dTHX;
 #endif
 
@@ -860,16 +942,22 @@ setuid perl scripts securely.\n");
 #endif
 #endif
 
-#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
-    _dyld_lookup_and_bind
-	("__environ", (unsigned long *) &environ_pointer, NULL);
-#endif /* environ */
-
-    PL_origargv = argv;
     PL_origargc = argc;
-#ifdef  USE_ENVIRON_ARRAY
-    PL_origenviron = environ;
-#endif
+    {
+        /* we copy rather than point to argv
+         * since perl_clone will copy and perl_destruct
+         * has no way of knowing if we've made a copy or
+         * just point to argv
+         */
+        int i = PL_origargc;
+        New(0, PL_origargv, i+1, char*);
+        PL_origargv[i] = '\0';
+        while (i-- > 0) {
+            PL_origargv[i] = savepv(argv[i]);
+        }
+    }
+
+
 
     if (PL_do_undump) {
 
@@ -1081,8 +1169,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef MULTIPLICITY
 		sv_catpv(PL_Sv," MULTIPLICITY");
 #  endif
-#  ifdef USE_THREADS
-		sv_catpv(PL_Sv," USE_THREADS");
+#  ifdef USE_5005THREADS
+		sv_catpv(PL_Sv," USE_5005THREADS");
 #  endif
 #  ifdef USE_ITHREADS
 		sv_catpv(PL_Sv," USE_ITHREADS");
@@ -1102,9 +1190,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef USE_SOCKS
 		sv_catpv(PL_Sv," USE_SOCKS");
 #  endif
-#  ifdef PERL_OBJECT
-		sv_catpv(PL_Sv," PERL_OBJECT");
-#  endif
 #  ifdef PERL_IMPLICIT_CONTEXT
 		sv_catpv(PL_Sv," PERL_IMPLICIT_CONTEXT");
 #  endif
@@ -1133,7 +1218,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
 		sv_catpv(PL_Sv, "; \
 $\"=\"\\n    \"; \
-@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; \
+@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; ");
+#ifdef __CYGWIN__
+		sv_catpv(PL_Sv,"\
+push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
+#endif
+		sv_catpv(PL_Sv, "\
 print \"  \\%ENV:\\n    @env\\n\" if @env; \
 print \"  \\@INC:\\n    @INC\\n\";");
 	    }
@@ -1182,11 +1272,13 @@ print \"  \\@INC:\\n    @INC\\n\";");
 #endif
 	(s = PerlEnv_getenv("PERL5OPT")))
     {
+    	char *popt = s;
 	while (isSPACE(*s))
 	    s++;
 	if (*s == '-' && *(s+1) == 'T')
 	    PL_tainting = TRUE;
 	else {
+	    char *popt_copy = Nullch;
 	    while (s && *s) {
 	        char *d;
 		while (isSPACE(*s))
@@ -1203,6 +1295,11 @@ print \"  \\@INC:\\n    @INC\\n\";");
 		    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
 		while (++s && *s) {
 		    if (isSPACE(*s)) {
+			if (!popt_copy) {
+			    popt_copy = SvPVX(sv_2mortal(newSVpv(popt,0)));
+			    s = popt_copy + (s - popt);
+			    d = popt_copy + (d - popt);
+			}
 		        *s++ = '\0';
 			break;
 		    }
@@ -1271,14 +1368,14 @@ print \"  \\@INC:\\n    @INC\\n\";");
     PL_comppad_name_fill = 0;
     PL_min_intro_pending = 0;
     PL_padix = 0;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
     PL_curpad[0] = (SV*)newAV();
     SvPADMY_on(PL_curpad[0]);	/* XXX Needed? */
     CvOWNER(PL_compcv) = 0;
     New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(PL_compcv));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
@@ -1286,13 +1383,14 @@ print \"  \\@INC:\\n    @INC\\n\";");
     av_store(comppadlist, 1, (SV*)PL_comppad);
     CvPADLIST(PL_compcv) = comppadlist;
 
+    boot_core_PerlIO();
     boot_core_UNIVERSAL();
 #ifndef PERL_MICRO
     boot_core_xsutils();
 #endif
 
     if (xsinit)
-	(*xsinit)(aTHXo);	/* in case linked C routines want magical variables */
+	(*xsinit)(aTHX);	/* in case linked C routines want magical variables */
 #ifndef PERL_MICRO
 #if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) || defined(EPOC)
     init_os_extras();
@@ -1347,10 +1445,12 @@ print \"  \\@INC:\\n    @INC\\n\";");
 	PL_e_script = Nullsv;
     }
 
-    /* now that script is parsed, we can modify record separator */
-    SvREFCNT_dec(PL_rs);
-    PL_rs = SvREFCNT_inc(PL_nrs);
+/*
+   Not sure that this is still the right place to do this now that we
+   no longer use PL_nrs. HVDS 2001/09/09
+*/
     sv_setsv(get_sv("/", TRUE), PL_rs);
+
     if (PL_do_undump)
 	my_unexec();
 
@@ -1387,11 +1487,14 @@ perl_run(pTHXx)
     I32 oldscope;
     int ret = 0;
     dJMPENV;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     dTHX;
 #endif
 
     oldscope = PL_scopestack_ix;
+#ifdef VMS
+    VMSISH_HUSHED = 0;
+#endif
 
 #ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
@@ -1414,7 +1517,8 @@ perl_run(pTHXx)
 	    LEAVE;
 	FREETMPS;
 	PL_curstash = PL_defstash;
-	if (PL_endav && !PL_minus_c)
+	if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
+	    PL_endav && !PL_minus_c)
 	    call_list(oldscope, PL_endav);
 #ifdef MYMALLOC
 	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
@@ -1462,7 +1566,7 @@ S_run_body(pTHX_ I32 oldscope)
 
 	if (PL_minus_c) {
 #ifdef MACOS_TRADITIONAL
-	    PerlIO_printf(Perl_error_log, "%s syntax OK\n", MacPerl_MPWFileName(PL_origfilename));
+	    PerlIO_printf(Perl_error_log, "# %s syntax OK\n", MacPerl_MPWFileName(PL_origfilename));
 #else
 	    PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
 #endif
@@ -1506,13 +1610,13 @@ SV*
 Perl_get_sv(pTHX_ const char *name, I32 create)
 {
     GV *gv;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     if (name[1] == '\0' && !isALPHA(name[0])) {
 	PADOFFSET tmp = find_threadsv(name);
     	if (tmp != NOT_IN_PAD)
 	    return THREADSV(tmp);
     }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     gv = gv_fetchpv(name, create, SVt_PV);
     if (gv)
 	return GvSV(gv);
@@ -1670,7 +1774,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     LOGOP myop;		/* fake syntax tree node */
     UNOP method_op;
     I32 oldmark;
-    I32 retval;
+    volatile I32 retval = 0;
     I32 oldscope;
     bool oldcatch = CATCH_GET;
     int ret;
@@ -1857,8 +1961,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 {
     dSP;
     UNOP myop;		/* fake syntax tree node */
-    I32 oldmark = SP - PL_stack_base;
-    I32 retval;
+    volatile I32 oldmark = SP - PL_stack_base;
+    volatile I32 retval = 0;
     I32 oldscope;
     int ret;
     OP* oldop = PL_op;
@@ -1976,10 +2080,11 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 /*
 =for apidoc p||require_pv
 
-Tells Perl to C<require> a module.
+Tells Perl to C<require> the file named by the string argument.  It is
+analogous to the Perl code C<eval "require '$file'">.  It's even
+implemented that way; consider using Perl_load_module instead.
 
-=cut
-*/
+=cut */
 
 void
 Perl_require_pv(pTHX_ const char *pv)
@@ -2003,14 +2108,14 @@ Perl_magicname(pTHX_ char *sym, char *name, I32 namlen)
     register GV *gv;
 
     if ((gv = gv_fetchpv(sym,TRUE, SVt_PV)))
-	sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen);
+	sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
 }
 
 STATIC void
 S_usage(pTHX_ char *name)		/* XXX move this out into a module ? */
 {
     /* This message really ought to be max 23 lines.
-     * Removed -h because the user already knows that opton. Others? */
+     * Removed -h because the user already knows that option. Others? */
 
     static char *usage_msg[] = {
 "-0[octal]       specify record separator (\\0, if no argument)",
@@ -2062,16 +2167,17 @@ Perl_moreswitches(pTHX_ char *s)
     switch (*s) {
     case '0':
     {
-	numlen = 0;			/* disallow underscores */
-	rschar = (U32)scan_oct(s, 4, &numlen);
-	SvREFCNT_dec(PL_nrs);
+        I32 flags = 0;
+	numlen = 4;
+	rschar = (U32)grok_oct(s, &numlen, &flags, NULL);
+	SvREFCNT_dec(PL_rs);
 	if (rschar & ~((U8)~0))
-	    PL_nrs = &PL_sv_undef;
+	    PL_rs = &PL_sv_undef;
 	else if (!rschar && numlen >= 2)
-	    PL_nrs = newSVpvn("", 0);
+	    PL_rs = newSVpvn("", 0);
 	else {
 	    char ch = rschar;
-	    PL_nrs = newSVpvn(&ch, 1);
+	    PL_rs = newSVpvn(&ch, 1);
 	}
 	return s + numlen;
     }
@@ -2125,7 +2231,8 @@ Perl_moreswitches(pTHX_ char *s)
 #ifdef DEBUGGING
 	forbid_setid("-D");
 	if (isALPHA(s[1])) {
-	    static char debopts[] = "psltocPmfrxuLHXDST";
+	    /* if adding extra options, remember to update DEBUG_MASK */
+	    static char debopts[] = "psltocPmfrxuLHXDSTR";
 	    char *d;
 
 	    for (s++; *s && (d = strchr(debopts,*s)); s++)
@@ -2135,7 +2242,7 @@ Perl_moreswitches(pTHX_ char *s)
 	    PL_debug = atoi(s+1);
 	    for (s++; isDIGIT(*s); s++) ;
 	}
-	PL_debug |= 0x80000000;
+	PL_debug |= DEBUG_TOP_FLAG;
 #else
 	if (ckWARN_d(WARN_DEBUGGING))
 	    Perl_warner(aTHX_ WARN_DEBUGGING,
@@ -2193,17 +2300,18 @@ Perl_moreswitches(pTHX_ char *s)
 	    PL_ors_sv = Nullsv;
 	}
 	if (isDIGIT(*s)) {
+            I32 flags = 0;
 	    PL_ors_sv = newSVpvn("\n",1);
-	    numlen = 0;			/* disallow underscores */
-	    *SvPVX(PL_ors_sv) = (char)scan_oct(s, 3 + (*s == '0'), &numlen);
+	    numlen = 3 + (*s == '0');
+	    *SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL);
 	    s += numlen;
 	}
 	else {
-	    if (RsPARA(PL_nrs)) {
+	    if (RsPARA(PL_rs)) {
 		PL_ors_sv = newSVpvn("\n\n",2);
 	    }
 	    else {
-		PL_ors_sv = newSVsv(PL_nrs);
+		PL_ors_sv = newSVsv(PL_rs);
 	    }
 	}
 	return s;
@@ -2276,9 +2384,22 @@ Perl_moreswitches(pTHX_ char *s)
 	s++;
 	return s;
     case 'v':
+#if !defined(DGUX)
 	PerlIO_printf(PerlIO_stdout(),
 		      Perl_form(aTHX_ "\nThis is perl, v%"VDf" built for %s",
 				PL_patchlevel, ARCHNAME));
+#else /* DGUX */
+/* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
+	PerlIO_printf(PerlIO_stdout(),
+			Perl_form(aTHX_ "\nThis is perl, version %vd\n", PL_patchlevel));
+	PerlIO_printf(PerlIO_stdout(),
+			Perl_form(aTHX_ "        built under %s at %s %s\n",
+					OSNAME, __DATE__, __TIME__));
+	PerlIO_printf(PerlIO_stdout(),
+			Perl_form(aTHX_ "        OS Specific Release: %s\n",
+					OSVERS));
+#endif /* !DGUX */
+
 #if defined(LOCAL_PATCH_COUNT)
 	if (LOCAL_PATCH_COUNT > 0)
 	    PerlIO_printf(PerlIO_stdout(),
@@ -2292,7 +2413,8 @@ Perl_moreswitches(pTHX_ char *s)
 		      "\n\nCopyright 1987-2001, Larry Wall\n");
 #ifdef MACOS_TRADITIONAL
 	PerlIO_printf(PerlIO_stdout(),
-		      "\nMac OS port Copyright (c) 1991-2001, Matthias Neeracher\n");
+		      "\nMac OS port Copyright 1991-2001, Matthias Neeracher;\n"
+		      "maintained by Chris Nandor\n");
 #endif
 #ifdef MSDOS
 	PerlIO_printf(PerlIO_stdout(),
@@ -2318,7 +2440,7 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 #ifdef MPE
 	PerlIO_printf(PerlIO_stdout(),
-		      "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1999\n");
+		      "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2001\n");
 #endif
 #ifdef OEMVS
 	PerlIO_printf(PerlIO_stdout(),
@@ -2344,6 +2466,11 @@ Perl_moreswitches(pTHX_ char *s)
 	PerlIO_printf(PerlIO_stdout(),
 		      "EPOC port by Olaf Flebbe, 1999-2000\n");
 #endif
+#ifdef UNDER_CE
+	printf("WINCE port by Rainer Keuchel, 2001\n");
+	printf("Built on " __DATE__ " " __TIME__ "\n\n");
+	wce_hitreturn();
+#endif
 #ifdef BINARY_BUILD_NOTICE
 	BINARY_BUILD_NOTICE;
 #endif
@@ -2434,77 +2561,42 @@ STATIC void
 S_init_interp(pTHX)
 {
 
-#ifdef PERL_OBJECT		/* XXX kludge */
-#define I_REINIT \
-  STMT_START {				\
-    PL_chopset		= " \n-";	\
-    PL_copline		= NOLINE;	\
-    PL_curcop		= &PL_compiling;\
-    PL_curcopdb		= NULL;		\
-    PL_dbargs		= 0;		\
-    PL_dumpindent	= 4;		\
-    PL_laststatval	= -1;		\
-    PL_laststype	= OP_STAT;	\
-    PL_maxscream	= -1;		\
-    PL_maxsysfd		= MAXSYSFD;	\
-    PL_statname		= Nullsv;	\
-    PL_tmps_floor	= -1;		\
-    PL_tmps_ix		= -1;		\
-    PL_op_mask		= NULL;		\
-    PL_laststatval	= -1;		\
-    PL_laststype	= OP_STAT;	\
-    PL_mess_sv		= Nullsv;	\
-    PL_splitstr		= " ";		\
-    PL_generation	= 100;		\
-    PL_exitlist		= NULL;		\
-    PL_exitlistlen	= 0;		\
-    PL_regindent	= 0;		\
-    PL_in_clean_objs	= FALSE;	\
-    PL_in_clean_all	= FALSE;	\
-    PL_profiledata	= NULL;		\
-    PL_rsfp		= Nullfp;	\
-    PL_rsfp_filters	= Nullav;	\
-    PL_dirty		= FALSE;	\
-  } STMT_END
-    I_REINIT;
-#else
-#  ifdef MULTIPLICITY
-#    define PERLVAR(var,type)
-#    define PERLVARA(var,n,type)
-#    if defined(PERL_IMPLICIT_CONTEXT)
-#      if defined(USE_THREADS)
-#        define PERLVARI(var,type,init)		PERL_GET_INTERP->var = init;
-#        define PERLVARIC(var,type,init)	PERL_GET_INTERP->var = init;
-#      else /* !USE_THREADS */
-#        define PERLVARI(var,type,init)		aTHX->var = init;
-#        define PERLVARIC(var,type,init)	aTHX->var = init;
-#      endif /* USE_THREADS */
-#    else
-#      define PERLVARI(var,type,init)	PERL_GET_INTERP->var = init;
+#ifdef MULTIPLICITY
+#  define PERLVAR(var,type)
+#  define PERLVARA(var,n,type)
+#  if defined(PERL_IMPLICIT_CONTEXT)
+#    if defined(USE_5005THREADS)
+#      define PERLVARI(var,type,init)		PERL_GET_INTERP->var = init;
 #      define PERLVARIC(var,type,init)	PERL_GET_INTERP->var = init;
-#    endif
-#    include "intrpvar.h"
-#    ifndef USE_THREADS
-#      include "thrdvar.h"
-#    endif
-#    undef PERLVAR
-#    undef PERLVARA
-#    undef PERLVARI
-#    undef PERLVARIC
+#    else /* !USE_5005THREADS */
+#      define PERLVARI(var,type,init)		aTHX->var = init;
+#      define PERLVARIC(var,type,init)	aTHX->var = init;
+#    endif /* USE_5005THREADS */
 #  else
-#    define PERLVAR(var,type)
-#    define PERLVARA(var,n,type)
-#    define PERLVARI(var,type,init)	PL_##var = init;
-#    define PERLVARIC(var,type,init)	PL_##var = init;
-#    include "intrpvar.h"
-#    ifndef USE_THREADS
-#      include "thrdvar.h"
-#    endif
-#    undef PERLVAR
-#    undef PERLVARA
-#    undef PERLVARI
-#    undef PERLVARIC
+#    define PERLVARI(var,type,init)	PERL_GET_INTERP->var = init;
+#    define PERLVARIC(var,type,init)	PERL_GET_INTERP->var = init;
+#  endif
+#  include "intrpvar.h"
+#  ifndef USE_5005THREADS
+#    include "thrdvar.h"
 #  endif
+#  undef PERLVAR
+#  undef PERLVARA
+#  undef PERLVARI
+#  undef PERLVARIC
+#else
+#  define PERLVAR(var,type)
+#  define PERLVARA(var,n,type)
+#  define PERLVARI(var,type,init)	PL_##var = init;
+#  define PERLVARIC(var,type,init)	PL_##var = init;
+#  include "intrpvar.h"
+#  ifndef USE_5005THREADS
+#    include "thrdvar.h"
+#  endif
+#  undef PERLVAR
+#  undef PERLVARA
+#  undef PERLVARI
+#  undef PERLVARIC
 #endif
 
 }
@@ -2514,15 +2606,7 @@ S_init_main_stash(pTHX)
 {
     GV *gv;
 
-    /* Note that strtab is a rather special HV.  Assumptions are made
-       about not iterating on it, and not adding tie magic to it.
-       It is properly deallocated in perl_destruct() */
-    PL_strtab = newHV();
-#ifdef USE_THREADS
-    MUTEX_INIT(&PL_strtab_mutex);
-#endif
-    HvSHAREKEYS_off(PL_strtab);			/* mandatory */
-    hv_ksplit(PL_strtab, 512);
+
 
     PL_curstash = PL_defstash = newHV();
     PL_curstname = newSVpvn("main",4);
@@ -2604,6 +2688,9 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 	sv_catpvn(sv, "-I", 2);
 	sv_catpv(sv,PRIVLIB_EXP);
 
+	DEBUG_P(PerlIO_printf(Perl_debug_log,
+			      "PL_preprocess: scriptname=\"%s\", cpp=\"%s\", sv=\"%s\", CPPMINUS=\"%s\"\n",
+			      scriptname, SvPVX (cpp), SvPVX (sv), CPPMINUS));
 #if defined(MSDOS) || defined(WIN32)
 	Perl_sv_setpvf(aTHX_ cmd, "\
 sed %s -e \"/^[^#]/b\" \
@@ -2707,8 +2794,14 @@ sed %s -e \"/^[^#]/b\" \
 	}
 #endif
 #endif
+#ifdef IAMSUID
+	errno = EPERM;
+	Perl_croak(aTHX_ "Can't open perl script: %s\n",
+		   Strerror(errno));
+#else
 	Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
 		   CopFILE(PL_curcop), Strerror(errno));
+#endif
     }
 }
 
@@ -3091,7 +3184,8 @@ S_find_beginning(pTHX)
 	if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch)
 	    Perl_croak(aTHX_ "No Perl script found in input\n");
 #endif
-	if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) {
+	s2 = s;
+	if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) {
 	    PerlIO_ungetc(PL_rsfp, '\n');		/* to keep line count right */
 	    PL_doextract = FALSE;
 	    while (*s && !(isSPACE (*s) || *s == '#')) s++;
@@ -3104,6 +3198,9 @@ S_find_beginning(pTHX)
 		    while ((s = moreswitches(s)))
 			;
 	    }
+#ifdef MACOS_TRADITIONAL
+	    break;
+#endif
 	}
     }
 }
@@ -3218,16 +3315,10 @@ S_nuke_stacks(pTHX)
     Safefree(PL_retstack);
 }
 
-#ifndef PERL_OBJECT
-static PerlIO *tmpfp;  /* moved outside init_lexer() because of UNICOS bug */
-#endif
-
 STATIC void
 S_init_lexer(pTHX)
 {
-#ifdef PERL_OBJECT
-	PerlIO *tmpfp;
-#endif
+    PerlIO *tmpfp;
     tmpfp = PL_rsfp;
     PL_rsfp = Nullfp;
     lex_start(PL_linestr);
@@ -3245,6 +3336,7 @@ S_init_predump_symbols(pTHX)
     PL_stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(PL_stdingv);
     io = GvIOp(PL_stdingv);
+    IoTYPE(io) = IoTYPE_RDONLY;
     IoIFP(io) = PerlIO_stdin();
     tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
@@ -3253,6 +3345,7 @@ S_init_predump_symbols(pTHX)
     tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
     GvMULTI_on(tmpgv);
     io = GvIOp(tmpgv);
+    IoTYPE(io) = IoTYPE_WRONLY;
     IoOFP(io) = IoIFP(io) = PerlIO_stdout();
     setdefout(tmpgv);
     tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
@@ -3262,6 +3355,7 @@ S_init_predump_symbols(pTHX)
     PL_stderrgv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
     GvMULTI_on(PL_stderrgv);
     io = GvIOp(PL_stderrgv);
+    IoTYPE(io) = IoTYPE_WRONLY;
     IoOFP(io) = IoIFP(io) = PerlIO_stderr();
     tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
@@ -3280,8 +3374,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     char *s;
     SV *sv;
     GV* tmpgv;
-    char **dup_env_base = 0;
 #ifdef NEED_ENVIRON_DUP_FOR_MODIFY
+    char **dup_env_base = 0;
     int dup_env_count = 0;
 #endif
 
@@ -3341,7 +3435,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	HV *hv;
 	GvMULTI_on(PL_envgv);
 	hv = GvHVn(PL_envgv);
-	hv_magic(hv, Nullgv, 'E');
+	hv_magic(hv, Nullgv, PERL_MAGIC_env);
 #ifdef USE_ENVIRON_ARRAY
 	/* Note that if the supplied env parameter is actually a copy
 	   of the global environ then it may now point to free'd memory
@@ -3355,7 +3449,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 #ifdef NEED_ENVIRON_DUP_FOR_MODIFY
 	{
 	    char **env_base;
-	    for (env_base = env; *env; env++) 
+	    for (env_base = env; *env; env++)
 		dup_env_count++;
 	    if ((dup_env_base = (char **)
 		 safesysmalloc( sizeof(char *) * (dup_env_count+1) ))) {
@@ -3372,7 +3466,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	    } /* else what? */
 	}
 #endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
-	for (; *env; env++) {
+	if (env)
+	  for (; *env; env++) {
 	    if (!(s = strchr(*env,'=')))
 		continue;
 	    *s++ = '\0';
@@ -3382,25 +3477,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	    sv = newSVpv(s--,0);
 	    (void)hv_store(hv, *env, s - *env, sv, 0);
 	    *s = '=';
-#if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
-	    /* Sins of the RTL. See note in my_setenv(). */
-	    { /* Turn this into Perl_my_putenv()? */
-		char *putenvp = savepv(*env);
-
-		if (putenvp) {
-		    char *p = putenvp;
-
-		    while (*p && *p != '=') p++;
-		    if (p == '=') {
-			*p++ = 0;
-			my_setenv(putenvp, p);
-		    }
-		    
-		    Safefree(putenvp);
-		} /* else what? */
-	    }
-#endif
-	}
+	  }
 #ifdef NEED_ENVIRON_DUP_FOR_MODIFY
 	if (dup_env_base) {
 	    char **dup_env;
@@ -3410,9 +3487,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	}
 #endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
 #endif /* USE_ENVIRON_ARRAY */
-#ifdef DYNAMIC_ENV_FETCH
-	HvNAME(hv) = savepv(ENV_HV_NAME);
-#endif
     }
     TAINT_NOT;
     if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))
@@ -3667,7 +3741,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
     }
 }
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 STATIC struct perl_thread *
 S_init_main_thread(pTHX)
 {
@@ -3734,6 +3808,7 @@ S_init_main_thread(pTHX)
     (void) find_threadsv("@");	/* Ensure $@ is initialised early */
 
     PL_maxscream = -1;
+    PL_peepp = MEMBER_TO_FPTR(Perl_peep);
     PL_regcompp = MEMBER_TO_FPTR(Perl_pregcomp);
     PL_regexecp = MEMBER_TO_FPTR(Perl_regexec_flags);
     PL_regint_start = MEMBER_TO_FPTR(Perl_re_intuit_start);
@@ -3744,7 +3819,7 @@ S_init_main_thread(pTHX)
 
     return thr;
 }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
 void
 Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
@@ -3758,7 +3833,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 
     while (AvFILL(paramList) >= 0) {
 	cv = (CV*)av_shift(paramList);
-	if ((PL_minus_c & 0x10) && (paramList == PL_beginav)) {
+	if (PL_savebegin && (paramList == PL_beginav)) {
 		/* save PL_beginav for compiler */
 	    if (! PL_beginav_save)
 		PL_beginav_save = newAV();
@@ -3921,12 +3996,8 @@ S_my_exit_jump(pTHX)
     JMPENV_JUMP(2);
 }
 
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
 static I32
-read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen)
+read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
     char *p, *nl;
     p  = SvPVX(PL_e_script);