X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=7e9f07a4f41b57007c4b7434583051e96296a183;hb=787c52d8bb6dedd5bba58a5ebeb34b15ca3d5aad;hp=0651279ff6b978e890d024a56b3539bbc1902c44;hpb=88dc0f0d4b3e8ced559c2ad1971419074a49337b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index 0651279..7e9f07a 100644
--- a/perl.c
+++ b/perl.c
@@ -1,6 +1,6 @@
 /*    perl.c
  *
- *    Copyright (c) 1987-1999 Larry Wall
+ *    Copyright (c) 1987-2000 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.
@@ -27,13 +27,6 @@ char *getenv (char *); /* Usually in <stdlib.h> */
 
 static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
 
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
-
 #ifdef IAMSUID
 #ifndef DOSUID
 #define DOSUID
@@ -47,43 +40,54 @@ static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
 #endif
 
 #ifdef PERL_OBJECT
-CPerlObj*
-perl_alloc(struct IPerlMem* ipM, struct IPerlEnv* ipE,
-		 struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
-		 struct IPerlDir* ipD, struct IPerlSock* ipS,
-		 struct IPerlProc* ipP)
-{
-    CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP);
-    if (pPerl != NULL)
-	pPerl->Init();
-
-    return pPerl;
-}
-#else
+#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
 
 #ifdef PERL_IMPLICIT_SYS
 PerlInterpreter *
-perl_alloc_using(struct IPerlMem* ipM, struct IPerlEnv* ipE,
+perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
+		 struct IPerlMem* ipMP, struct IPerlEnv* ipE,
 		 struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
 		 struct IPerlDir* ipD, struct IPerlSock* ipS,
 		 struct IPerlProc* ipP)
 {
     PerlInterpreter *my_perl;
-
+#ifdef PERL_OBJECT
+    my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
+						  ipLIO, ipD, ipS, ipP);
+    PERL_SET_INTERP(my_perl);
+#else
     /* New() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     PERL_SET_INTERP(my_perl);
     Zero(my_perl, 1, PerlInterpreter);
     PL_Mem = ipM;
+    PL_MemShared = ipMS;
+    PL_MemParse = ipMP;
     PL_Env = ipE;
     PL_StdIO = ipStd;
     PL_LIO = ipLIO;
     PL_Dir = ipD;
     PL_Sock = ipS;
     PL_Proc = ipP;
+#endif
+
     return my_perl;
 }
 #else
+
+/*
+=for apidoc perl_alloc
+
+Allocates a new Perl interpreter.  See L<perlembed>.
+
+=cut
+*/
+
 PerlInterpreter *
 perl_alloc(void)
 {
@@ -92,10 +96,18 @@ perl_alloc(void)
     /* New() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
     PERL_SET_INTERP(my_perl);
+    Zero(my_perl, 1, PerlInterpreter);
     return my_perl;
 }
 #endif /* PERL_IMPLICIT_SYS */
-#endif /* PERL_OBJECT */
+
+/*
+=for apidoc perl_construct
+
+Initializes a new Perl interpreter.  See L<perlembed>.
+
+=cut
+*/
 
 void
 perl_construct(pTHXx)
@@ -117,9 +129,8 @@ perl_construct(pTHXx)
 
    /* Init the real globals (and main thread)? */
     if (!PL_linestr) {
-#ifdef USE_THREADS
-
     	INIT_THREADS;
+#ifdef USE_THREADS
 #ifdef ALLOC_THREAD_KEY
         ALLOC_THREAD_KEY;
 #else
@@ -144,7 +155,9 @@ perl_construct(pTHXx)
 	thr = init_main_thread();
 #endif /* USE_THREADS */
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 	PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
+#endif
 
 	PL_curcop = &PL_compiling;	/* needed by ckWARN, right away */
 
@@ -202,14 +215,29 @@ perl_construct(pTHXx)
     init_i18nl10n(1);
     SET_NUMERIC_STANDARD();
 
+    {
+	U8 *s;
+	PL_patchlevel = NEWSV(0,4);
+	SvUPGRADE(PL_patchlevel, SVt_PVNV);
+	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);
+	*s = '\0';
+	SvCUR_set(PL_patchlevel, s - (U8*)SvPVX(PL_patchlevel));
+	SvPOK_on(PL_patchlevel);
+	SvNVX(PL_patchlevel) = (NV)PERL_REVISION
+				+ ((NV)PERL_VERSION / (NV)1000)
 #if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
-    sprintf(PL_patchlevel, "%7.5f",   (double) PERL_REVISION
-				+ ((double) PERL_VERSION / (double) 1000)
-				+ ((double) PERL_SUBVERSION / (double) 100000));
-#else
-    sprintf(PL_patchlevel, "%5.3f", (double) PERL_REVISION +
-				((double) PERL_VERSION / (double) 1000));
+				+ ((NV)PERL_SUBVERSION / (NV)1000000)
 #endif
+				;
+	SvNOK_on(PL_patchlevel);	/* dual valued */
+	SvUTF8_on(PL_patchlevel);
+	SvREADONLY_on(PL_patchlevel);
+    }
 
 #if defined(LOCAL_PATCH_COUNT)
     PL_localpatches = local_patches;	/* For possible -v */
@@ -223,6 +251,14 @@ perl_construct(pTHXx)
     ENTER;
 }
 
+/*
+=for apidoc perl_destruct
+
+Shuts down a Perl interpreter.  See L<perlembed>.
+
+=cut
+*/
+
 void
 perl_destruct(pTHXx)
 {
@@ -235,6 +271,9 @@ perl_destruct(pTHXx)
     dTHX;
 #endif /* USE_THREADS */
 
+    /* wait for all pseudo-forked children to finish */
+    PERL_WAIT_FOR_CHILDREN;
+
 #ifdef USE_THREADS
 #ifndef FAKE_THREADS
     /* Pass 1 on any remaining threads: detach joinables, join zombies */
@@ -389,6 +428,7 @@ perl_destruct(pTHXx)
 
     Safefree(PL_inplace);
     PL_inplace = Nullch;
+    SvREFCNT_dec(PL_patchlevel);
 
     if (PL_e_script) {
 	SvREFCNT_dec(PL_e_script);
@@ -397,10 +437,10 @@ perl_destruct(pTHXx)
 
     /* magical thingies */
 
-    Safefree(PL_ofs);	/* $, */
+    Safefree(PL_ofs);		/* $, */
     PL_ofs = Nullch;
 
-    Safefree(PL_ors);	/* $\ */
+    Safefree(PL_ors);		/* $\ */
     PL_ors = Nullch;
 
     SvREFCNT_dec(PL_rs);	/* $/ */
@@ -409,7 +449,9 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_nrs);	/* $/ helper */
     PL_nrs = Nullsv;
 
-    PL_multiline = 0;	/* $* */
+    PL_multiline = 0;		/* $* */
+    Safefree(PL_osname);	/* $^O */
+    PL_osname = Nullch;
 
     SvREFCNT_dec(PL_statname);
     PL_statname = Nullsv;
@@ -433,9 +475,11 @@ perl_destruct(pTHXx)
     /* startup and shutdown function lists */
     SvREFCNT_dec(PL_beginav);
     SvREFCNT_dec(PL_endav);
+    SvREFCNT_dec(PL_checkav);
     SvREFCNT_dec(PL_initav);
     PL_beginav = Nullav;
     PL_endav = Nullav;
+    PL_checkav = Nullav;
     PL_initav = Nullav;
 
     /* shortcuts just get cleared */
@@ -449,15 +493,87 @@ perl_destruct(pTHXx)
     PL_stderrgv = Nullgv;
     PL_last_in_gv = Nullgv;
     PL_replgv = Nullgv;
+    PL_debstash = Nullhv;
 
     /* reset so print() ends up where we expect */
     setdefout(Nullgv);
 
+    SvREFCNT_dec(PL_argvout_stack);
+    PL_argvout_stack = Nullav;
+
+    SvREFCNT_dec(PL_modglobal);
+    PL_modglobal = Nullhv;
+    SvREFCNT_dec(PL_preambleav);
+    PL_preambleav = Nullav;
+    SvREFCNT_dec(PL_subname);
+    PL_subname = Nullsv;
+    SvREFCNT_dec(PL_linestr);
+    PL_linestr = Nullsv;
+    SvREFCNT_dec(PL_pidstatus);
+    PL_pidstatus = Nullhv;
+    SvREFCNT_dec(PL_toptarget);
+    PL_toptarget = Nullsv;
+    SvREFCNT_dec(PL_bodytarget);
+    PL_bodytarget = Nullsv;
+    PL_formtarget = Nullsv;
+
+    /* free locale stuff */
+#ifdef USE_LOCALE_COLLATE
+    Safefree(PL_collation_name);
+    PL_collation_name = Nullch;
+#endif
+
+#ifdef USE_LOCALE_NUMERIC
+    Safefree(PL_numeric_name);
+    PL_numeric_name = Nullch;
+#endif
+
+    /* clear utf8 character classes */
+    SvREFCNT_dec(PL_utf8_alnum);
+    SvREFCNT_dec(PL_utf8_alnumc);
+    SvREFCNT_dec(PL_utf8_ascii);
+    SvREFCNT_dec(PL_utf8_alpha);
+    SvREFCNT_dec(PL_utf8_space);
+    SvREFCNT_dec(PL_utf8_cntrl);
+    SvREFCNT_dec(PL_utf8_graph);
+    SvREFCNT_dec(PL_utf8_digit);
+    SvREFCNT_dec(PL_utf8_upper);
+    SvREFCNT_dec(PL_utf8_lower);
+    SvREFCNT_dec(PL_utf8_print);
+    SvREFCNT_dec(PL_utf8_punct);
+    SvREFCNT_dec(PL_utf8_xdigit);
+    SvREFCNT_dec(PL_utf8_mark);
+    SvREFCNT_dec(PL_utf8_toupper);
+    SvREFCNT_dec(PL_utf8_tolower);
+    PL_utf8_alnum	= Nullsv;
+    PL_utf8_alnumc	= Nullsv;
+    PL_utf8_ascii	= Nullsv;
+    PL_utf8_alpha	= Nullsv;
+    PL_utf8_space	= Nullsv;
+    PL_utf8_cntrl	= Nullsv;
+    PL_utf8_graph	= Nullsv;
+    PL_utf8_digit	= Nullsv;
+    PL_utf8_upper	= Nullsv;
+    PL_utf8_lower	= Nullsv;
+    PL_utf8_print	= Nullsv;
+    PL_utf8_punct	= Nullsv;
+    PL_utf8_xdigit	= Nullsv;
+    PL_utf8_mark	= Nullsv;
+    PL_utf8_toupper	= Nullsv;
+    PL_utf8_totitle	= Nullsv;
+    PL_utf8_tolower	= Nullsv;
+
+    if (!specialWARN(PL_compiling.cop_warnings))
+	SvREFCNT_dec(PL_compiling.cop_warnings);
+    PL_compiling.cop_warnings = Nullsv;
+
     /* Prepare to destruct main symbol table.  */
 
     hv = PL_defstash;
     PL_defstash = 0;
     SvREFCNT_dec(hv);
+    SvREFCNT_dec(PL_curstname);
+    PL_curstname = Nullsv;
 
     /* clear queued errors */
     SvREFCNT_dec(PL_errors);
@@ -483,14 +599,21 @@ 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();
     }
+    SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
+    SvFLAGS(PL_fdpid) |= SVt_PVAV;
     SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
     SvFLAGS(PL_strtab) |= SVt_PVHV;
-    
+
+    AvREAL_off(PL_fdpid);		/* no surviving entries */
+    SvREFCNT_dec(PL_fdpid);		/* needed in io_close() */
+    PL_fdpid = Nullav;
+
     /* Destruct the global string table. */
     {
 	/* Yell and reset the HeVAL() slots that are still holding refcounts,
@@ -522,16 +645,23 @@ perl_destruct(pTHXx)
     }
     SvREFCNT_dec(PL_strtab);
 
+    /* free special SVs */
+
+    SvREFCNT(&PL_sv_yes) = 0;
+    sv_clear(&PL_sv_yes);
+    SvANY(&PL_sv_yes) = NULL;
+
+    SvREFCNT(&PL_sv_no) = 0;
+    sv_clear(&PL_sv_no);
+    SvANY(&PL_sv_no) = NULL;
+
     if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
 	Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
 
     sv_free_arenas();
 
     /* No SVs have survived, need to clean out */
-    PL_linestr = NULL;
-    PL_pidstatus = Nullhv;
     Safefree(PL_origfilename);
-    Safefree(PL_archpat_auto);
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
 	Safefree(PL_reg_curpm);
@@ -558,7 +688,7 @@ perl_destruct(pTHXx)
     Safefree(PL_thrsv);
     PL_thrsv = Nullsv;
 #endif /* USE_THREADS */
-    
+
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
@@ -582,6 +712,14 @@ perl_destruct(pTHXx)
     }
 }
 
+/*
+=for apidoc perl_free
+
+Releases a Perl interpreter.  See L<perlembed>.
+
+=cut
+*/
+
 void
 perl_free(pTHXx)
 {
@@ -601,6 +739,14 @@ Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
     ++PL_exitlistlen;
 }
 
+/*
+=for apidoc perl_parse
+
+Tells a Perl interpreter to parse a Perl script.  See L<perlembed>.
+
+=cut
+*/
+
 int
 perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
 {
@@ -656,11 +802,20 @@ setuid perl scripts securely.\n");
     oldscope = PL_scopestack_ix;
     PL_dowarn = G_WARN_OFF;
 
-    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_parse_body),
-		env, xsinit);
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vparse_body), env, xsinit);
+#else
+    JMPENV_PUSH(ret);
+#endif
     switch (ret) {
     case 0:
-	return 0;
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+	parse_body(env,xsinit);
+#endif
+	if (PL_checkav)
+	    call_list(oldscope, PL_checkav);
+	ret = 0;
+	break;
     case 1:
 	STATUS_ALL_FAILURE;
 	/* FALL THROUGH */
@@ -670,23 +825,36 @@ setuid perl scripts securely.\n");
 	    LEAVE;
 	FREETMPS;
 	PL_curstash = PL_defstash;
-	if (PL_endav && !PL_minus_c)
-	    call_list(oldscope, PL_endav);
-	return STATUS_NATIVE_EXPORT;
+	if (PL_checkav)
+	    call_list(oldscope, PL_checkav);
+	ret = STATUS_NATIVE_EXPORT;
+	break;
     case 3:
 	PerlIO_printf(Perl_error_log, "panic: top_env\n");
-	return 1;
+	ret = 1;
+	break;
     }
-    return 0;
+    JMPENV_POP;
+    return ret;
 }
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+STATIC void *
+S_vparse_body(pTHX_ va_list args)
+{
+    char **env = va_arg(args, char**);
+    XSINIT_t xsinit = va_arg(args, XSINIT_t);
+
+    return parse_body(env, xsinit);
+}
+#endif
+
 STATIC void *
-S_parse_body(pTHX_ va_list args)
+S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 {
     dTHR;
     int argc = PL_origargc;
     char **argv = PL_origargv;
-    char **env = va_arg(args, char**);
     char *scriptname = NULL;
     int fdscript = -1;
     VOL bool dosearch = FALSE;
@@ -696,8 +864,6 @@ S_parse_body(pTHX_ va_list args)
     register char *s;
     char *cddir = Nullch;
 
-    XSINIT_t xsinit = va_arg(args, XSINIT_t);
-
     sv_setpvn(PL_linestr,"",0);
     sv = newSVpvn("",0);		/* first used for -I flags */
     SAVEFREESV(sv);
@@ -720,6 +886,7 @@ S_parse_body(pTHX_ va_list args)
 #endif
 	case ' ':
 	case '0':
+	case 'C':
 	case 'F':
 	case 'a':
 	case 'c':
@@ -749,11 +916,6 @@ S_parse_body(pTHX_ va_list args)
 	    goto reswitch;
 
 	case 'e':
-#ifdef MACOS_TRADITIONAL
-	    /* ignore -e for Dev:Pseudo argument */
-	    if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
-	    	break; 
-#endif
 	    if (PL_euid != PL_uid || PL_egid != PL_gid)
 		Perl_croak(aTHX_ "No -e allowed in setuid scripts");
 	    if (!PL_e_script) {
@@ -776,18 +938,18 @@ S_parse_body(pTHX_ va_list args)
 	    if (!*++s && (s=argv[1]) != Nullch) {
 		argc--,argv++;
 	    }
-	    while (s && isSPACE(*s))
-		++s;
 	    if (s && *s) {
-		char *e, *p;
-		for (e = s; *e && !isSPACE(*e); e++) ;
-		p = savepvn(s, e-s);
+		char *p;
+		STRLEN len = strlen(s);
+		p = savepvn(s, len);
 		incpush(p, TRUE);
-		sv_catpv(sv,"-I");
-		sv_catpv(sv,p);
-		sv_catpv(sv," ");
+		sv_catpvn(sv, "-I", 2);
+		sv_catpvn(sv, p, len);
+		sv_catpvn(sv, " ", 1);
 		Safefree(p);
-	    }	/* XXX else croak? */
+	    }
+	    else
+		Perl_croak(aTHX_ "No directory specified for -I");
 	    break;
 	case 'P':
 	    forbid_setid("-P");
@@ -820,6 +982,24 @@ S_parse_body(pTHX_ va_list args)
 #  ifdef USE_THREADS
 		sv_catpv(PL_Sv," USE_THREADS");
 #  endif
+#  ifdef USE_ITHREADS
+		sv_catpv(PL_Sv," USE_ITHREADS");
+#  endif
+#  ifdef USE_64_BIT_INT
+		sv_catpv(PL_Sv," USE_64_BIT_INT");
+#  endif
+#  ifdef USE_64_BIT_ALL
+		sv_catpv(PL_Sv," USE_64_BIT_ALL");
+#  endif
+#  ifdef USE_LONG_DOUBLE
+		sv_catpv(PL_Sv," USE_LONG_DOUBLE");
+#  endif
+#  ifdef USE_LARGE_FILES
+		sv_catpv(PL_Sv," USE_LARGE_FILES");
+#  endif
+#  ifdef USE_SOCKS
+		sv_catpv(PL_Sv," USE_SOCKS");
+#  endif
 #  ifdef PERL_OBJECT
 		sv_catpv(PL_Sv," PERL_OBJECT");
 #  endif
@@ -898,7 +1078,8 @@ print \"  \\@INC:\\n    @INC\\n\";");
 #ifndef SECURE_INTERNAL_GETENV
         !PL_tainting &&
 #endif
-                        (s = PerlEnv_getenv("PERL5OPT"))) {
+	(s = PerlEnv_getenv("PERL5OPT")))
+    {
 	while (isSPACE(*s))
 	    s++;
 	if (*s == '-' && *(s+1) == 'T')
@@ -956,14 +1137,11 @@ print \"  \\@INC:\\n    @INC\\n\";");
     }
 #endif
 
-#ifdef MACOS_TRADITIONAL
-    if (PL_doextract || gAlwaysExtract)
-#else
     if (PL_doextract) {
-#endif
 	find_beginning();
 	if (cddir && PerlDir_chdir(cddir) < 0)
 	    Perl_croak(aTHX_ "Can't chdir to %s",cddir);
+
     }
 
     PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
@@ -993,11 +1171,13 @@ print \"  \\@INC:\\n    @INC\\n\";");
     CvPADLIST(PL_compcv) = comppadlist;
 
     boot_core_UNIVERSAL();
+#ifndef PERL_MICRO
     boot_core_xsutils();
+#endif
 
     if (xsinit)
 	(*xsinit)(aTHXo);	/* in case linked C routines want magical variables */
-#if defined(VMS) || defined(WIN32) || defined(DJGPP)
+#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__)
     init_os_extras();
 #endif
 
@@ -1018,16 +1198,6 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     SETERRNO(0,SS$_NORMAL);
     PL_error_count = 0;
-#ifdef MACOS_TRADITIONAL
-    if (gSyntaxError = (yyparse() || PL_error_count)) {
-	if (PL_minus_c)
-	    Perl_croak(aTHX_ "%s had compilation errors.\n", MPWFileName(PL_origfilename));
-	else {
-	    Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
-		       MPWFileName(PL_origfilename));
-	}
-    }
-#else
     if (yyparse() || PL_error_count) {
 	if (PL_minus_c)
 	    Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
@@ -1036,8 +1206,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 		       PL_origfilename);
 	}
     }
-#endif
-    PL_curcop->cop_line = 0;
+    CopLINE_set(PL_curcop, 0);
     PL_curstash = PL_defstash;
     PL_preprocess = FALSE;
     if (PL_e_script) {
@@ -1052,8 +1221,11 @@ print \"  \\@INC:\\n    @INC\\n\";");
     if (PL_do_undump)
 	my_unexec();
 
-    if (isWARN_ONCE)
+    if (isWARN_ONCE) {
+	SAVECOPFILE(PL_curcop);
+	SAVECOPLINE(PL_curcop);
 	gv_check(PL_defstash);
+    }
 
     LEAVE;
     FREETMPS;
@@ -1068,12 +1240,20 @@ print \"  \\@INC:\\n    @INC\\n\";");
     return NULL;
 }
 
+/*
+=for apidoc perl_run
+
+Tells a Perl interpreter to run.  See L<perlembed>.
+
+=cut
+*/
+
 int
 perl_run(pTHXx)
 {
     dTHR;
     I32 oldscope;
-    int ret;
+    int ret = 0;
     dJMPENV;
 #ifdef USE_THREADS
     dTHX;
@@ -1081,14 +1261,23 @@ perl_run(pTHXx)
 
     oldscope = PL_scopestack_ix;
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
-    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vrun_body), oldscope);
+#else
+    JMPENV_PUSH(ret);
+#endif
     switch (ret) {
     case 1:
 	cxstack_ix = -1;		/* start context stack again */
 	goto redo_body;
-    case 0:  /* normal completion */
-    case 2:  /* my_exit() */
+    case 0:				/* normal completion */
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	run_body(oldscope);
+#endif
+	/* FALL THROUGH */
+    case 2:				/* my_exit() */
 	while (PL_scopestack_ix > oldscope)
 	    LEAVE;
 	FREETMPS;
@@ -1099,7 +1288,8 @@ perl_run(pTHXx)
 	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
 #endif
-	return STATUS_NATIVE_EXPORT;
+	ret = STATUS_NATIVE_EXPORT;
+	break;
     case 3:
 	if (PL_restartop) {
 	    POPSTACK_TO(PL_mainstack);
@@ -1107,19 +1297,30 @@ perl_run(pTHXx)
 	}
 	PerlIO_printf(Perl_error_log, "panic: restartop\n");
 	FREETMPS;
-	return 1;
+	ret = 1;
+	break;
     }
 
-    /* NOTREACHED */
-    return 0;
+    JMPENV_POP;
+    return ret;
 }
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 STATIC void *
-S_run_body(pTHX_ va_list args)
+S_vrun_body(pTHX_ va_list args)
 {
-    dTHR;
     I32 oldscope = va_arg(args, I32);
 
+    return run_body(oldscope);
+}
+#endif
+
+
+STATIC void *
+S_run_body(pTHX_ I32 oldscope)
+{
+    dTHR;
+
     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
                     PL_sawampersand ? "Enabling" : "Omitting"));
 
@@ -1130,12 +1331,8 @@ S_run_body(pTHX_ va_list args)
 			      PTR2UV(thr)));
 
 	if (PL_minus_c) {
-#ifdef MACOS_TRADITIONAL
-	    PerlIO_printf(PerlIO_stderr(), "# %s syntax OK\n", MPWFileName(PL_origfilename));
-#else
 	    PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
-#endif	    
-my_exit(0);
+	    my_exit(0);
 	}
 	if (PERLDB_SINGLE && PL_DBsingle)
 	    sv_setiv(PL_DBsingle, 1); 
@@ -1161,6 +1358,16 @@ my_exit(0);
     return NULL;
 }
 
+/*
+=for apidoc p||get_sv
+
+Returns the SV of the specified Perl scalar.  If C<create> is set and the
+Perl variable does not exist then it will be created.  If C<create> is not
+set and the variable does not exist then NULL is returned.
+
+=cut
+*/
+
 SV*
 Perl_get_sv(pTHX_ const char *name, I32 create)
 {
@@ -1180,6 +1387,16 @@ Perl_get_sv(pTHX_ const char *name, I32 create)
     return Nullsv;
 }
 
+/*
+=for apidoc p||get_av
+
+Returns the AV of the specified Perl array.  If C<create> is set and the
+Perl variable does not exist then it will be created.  If C<create> is not
+set and the variable does not exist then NULL is returned.
+
+=cut
+*/
+
 AV*
 Perl_get_av(pTHX_ const char *name, I32 create)
 {
@@ -1191,6 +1408,16 @@ Perl_get_av(pTHX_ const char *name, I32 create)
     return Nullav;
 }
 
+/*
+=for apidoc p||get_hv
+
+Returns the HV of the specified Perl hash.  If C<create> is set and the
+Perl variable does not exist then it will be created.  If C<create> is not
+set and the variable does not exist then NULL is returned.
+
+=cut
+*/
+
 HV*
 Perl_get_hv(pTHX_ const char *name, I32 create)
 {
@@ -1202,6 +1429,17 @@ Perl_get_hv(pTHX_ const char *name, I32 create)
     return Nullhv;
 }
 
+/*
+=for apidoc p||get_cv
+
+Returns the CV of the specified Perl subroutine.  If C<create> is set and
+the Perl subroutine does not exist then it will be declared (which has the
+same effect as saying C<sub name;>).  If C<create> is not set and the
+subroutine does not exist then NULL is returned.
+
+=cut
+*/
+
 CV*
 Perl_get_cv(pTHX_ const char *name, I32 create)
 {
@@ -1222,6 +1460,14 @@ Perl_get_cv(pTHX_ const char *name, I32 create)
 
 /* Be sure to refetch the stack pointer after calling these routines. */
 
+/*
+=for apidoc p||call_argv
+
+Performs a callback to the specified Perl sub.  See L<perlcall>.
+
+=cut
+*/
+
 I32
 Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
               
@@ -1241,6 +1487,14 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
     return call_pv(sub_name, flags);
 }
 
+/*
+=for apidoc p||call_pv
+
+Performs a callback to the specified Perl sub.  See L<perlcall>.
+
+=cut
+*/
+
 I32
 Perl_call_pv(pTHX_ const char *sub_name, I32 flags)
               		/* name of the subroutine */
@@ -1249,6 +1503,15 @@ Perl_call_pv(pTHX_ const char *sub_name, I32 flags)
     return call_sv((SV*)get_cv(sub_name, TRUE), flags);
 }
 
+/*
+=for apidoc p||call_method
+
+Performs a callback to the specified Perl method.  The blessed object must
+be on the stack.  See L<perlcall>.
+
+=cut
+*/
+
 I32
 Perl_call_method(pTHX_ const char *methname, I32 flags)
                		/* name of the subroutine */
@@ -1256,17 +1519,28 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
 {
     dSP;
     OP myop;
-    if (!PL_op)
+    if (!PL_op) {
+	Zero(&myop, 1, OP);
 	PL_op = &myop;
+    }
     XPUSHs(sv_2mortal(newSVpv(methname,0)));
     PUTBACK;
     pp_method();
-	if(PL_op == &myop)
-		PL_op = Nullop;
+    if (PL_op == &myop)
+	PL_op = Nullop;
     return call_sv(*PL_stack_sp--, flags);
 }
 
 /* May be called with any of a CV, a GV, or an SV containing the name. */
+/*
+=for apidoc p||call_sv
+
+Performs a callback to the Perl sub whose name is in the SV.  See
+L<perlcall>.
+
+=cut
+*/
+
 I32
 Perl_call_sv(pTHX_ SV *sv, I32 flags)
        
@@ -1313,7 +1587,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 
     if (!(flags & G_EVAL)) {
 	CATCH_SET(TRUE);
-	call_xbody((OP*)&myop, FALSE);
+	call_body((OP*)&myop, FALSE);
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
 	CATCH_SET(oldcatch);
     }
@@ -1341,11 +1615,19 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	}
 	PL_markstack_ptr++;
 
-  redo_body:
-	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
 		    (OP*)&myop, FALSE);
+#else
+	JMPENV_PUSH(ret);
+#endif
 	switch (ret) {
 	case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	    call_body((OP*)&myop, FALSE);
+#endif
 	    retval = PL_stack_sp - (PL_stack_base + oldmark);
 	    if (!(flags & G_KEEPERR))
 		sv_setpv(ERRSV,"");
@@ -1357,7 +1639,8 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	    /* my_exit() was called */
 	    PL_curstash = PL_defstash;
 	    FREETMPS;
-	    if (PL_statusvalue)
+	    JMPENV_POP;
+	    if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
 		Perl_croak(aTHX_ "Callback called exit");
 	    my_exit_jump();
 	    /* NOTREACHED */
@@ -1390,6 +1673,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	    PL_curpm = newpm;
 	    LEAVE;
 	}
+	JMPENV_POP;
     }
 
     if (flags & G_DISCARD) {
@@ -1402,18 +1686,20 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     return retval;
 }
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 STATIC void *
-S_call_body(pTHX_ va_list args)
+S_vcall_body(pTHX_ va_list args)
 {
     OP *myop = va_arg(args, OP*);
     int is_eval = va_arg(args, int);
 
-    call_xbody(myop, is_eval);
+    call_body(myop, is_eval);
     return NULL;
 }
+#endif
 
 STATIC void
-S_call_xbody(pTHX_ OP *myop, int is_eval)
+S_call_body(pTHX_ OP *myop, int is_eval)
 {
     dTHR;
 
@@ -1429,6 +1715,14 @@ S_call_xbody(pTHX_ OP *myop, int is_eval)
 
 /* Eval a string. The G_EVAL flag is always assumed. */
 
+/*
+=for apidoc p||eval_sv
+
+Tells Perl to C<eval> the string in the SV.
+
+=cut
+*/
+
 I32
 Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        
@@ -1465,11 +1759,19 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     if (flags & G_KEEPERR)
 	myop.op_flags |= OPf_SPECIAL;
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
-    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
 		(OP*)&myop, TRUE);
+#else
+    JMPENV_PUSH(ret);
+#endif
     switch (ret) {
     case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	call_body((OP*)&myop,TRUE);
+#endif
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
 	if (!(flags & G_KEEPERR))
 	    sv_setpv(ERRSV,"");
@@ -1481,7 +1783,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	/* my_exit() was called */
 	PL_curstash = PL_defstash;
 	FREETMPS;
-	if (PL_statusvalue)
+	JMPENV_POP;
+	if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
 	    Perl_croak(aTHX_ "Callback called exit");
 	my_exit_jump();
 	/* NOTREACHED */
@@ -1501,6 +1804,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	break;
     }
 
+    JMPENV_POP;
     if (flags & G_DISCARD) {
 	PL_stack_sp = PL_stack_base + oldmark;
 	retval = 0;
@@ -1511,6 +1815,14 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     return retval;
 }
 
+/*
+=for apidoc p||eval_pv
+
+Tells Perl to C<eval> the given string and return an SV* result.
+
+=cut
+*/
+
 SV*
 Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 {
@@ -1535,6 +1847,14 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 
 /* Require a module. */
 
+/*
+=for apidoc p||require_pv
+
+Tells Perl to C<require> a module.
+
+=cut
+*/
+
 void
 Perl_require_pv(pTHX_ const char *pv)
 {
@@ -1569,6 +1889,7 @@ S_usage(pTHX_ char *name)		/* XXX move this out into a module ? */
     static char *usage_msg[] = {
 "-0[octal]       specify record separator (\\0, if no argument)",
 "-a              autosplit mode with -n or -p (splits $_ into @F)",
+"-C              enable native wide character system interfaces",
 "-c              check syntax only (runs BEGIN and END blocks)",
 "-d[:debugger]   run program under debugger",
 "-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
@@ -1589,6 +1910,8 @@ S_usage(pTHX_ char *name)		/* XXX move this out into a module ? */
 "-v              print version, subversion (includes VERY IMPORTANT perl info)",
 "-V[:variable]   print configuration summary (or a single Config.pm variable)",
 "-w              enable many useful warnings (RECOMMENDED)",
+"-W              enable all warnings",
+"-X              disable all warnings",
 "-x[directory]   strip off text before #!perl line and perhaps cd to directory",
 "\n",
 NULL
@@ -1624,6 +1947,10 @@ Perl_moreswitches(pTHX_ char *s)
 	}
 	return s + numlen;
     }
+    case 'C':
+	PL_widesyscalls = TRUE;
+	s++;
+	return s;
     case 'F':
 	PL_minus_F = TRUE;
 	PL_splitstr = savepv(s + 1);
@@ -1697,14 +2024,23 @@ Perl_moreswitches(pTHX_ char *s)
 	    ++s;
 	if (*s) {
 	    char *e, *p;
-	    for (e = s; *e && !isSPACE(*e); e++) ;
-	    p = savepvn(s, e-s);
-	    incpush(p, TRUE);
-	    Safefree(p);
-	    s = e;
+	    p = s;
+	    /* ignore trailing spaces (possibly followed by other switches) */
+	    do {
+		for (e = p; *e && !isSPACE(*e); e++) ;
+		p = e;
+		while (isSPACE(*p))
+		    p++;
+	    } while (*p && *p != '-');
+	    e = savepvn(s, e-s);
+	    incpush(e, TRUE);
+	    Safefree(e);
+	    s = p;
+	    if (*s == '-')
+		s++;
 	}
 	else
-	    Perl_croak(aTHX_ "No space allowed after -I");
+	    Perl_croak(aTHX_ "No directory specified for -I");
 	return s;
     case 'l':
 	PL_minus_l = TRUE;
@@ -1757,7 +2093,7 @@ Perl_moreswitches(pTHX_ char *s)
 		sv_catpv(sv,    "})");
 	    }
 	    s += strlen(s);
-	    if (PL_preambleav == NULL)
+	    if (!PL_preambleav)
 		PL_preambleav = newAV();
 	    av_push(PL_preambleav, sv);
 	}
@@ -1783,9 +2119,6 @@ Perl_moreswitches(pTHX_ char *s)
 	s++;
 	return s;
     case 'u':
-#ifdef MACOS_TRADITIONAL
-	Perl_croak(aTHX_ "Believe me, you don't want to use \"-u\" on a Macintosh");
-#endif
 	PL_do_undump = TRUE;
 	s++;
 	return s;
@@ -1794,23 +2127,15 @@ Perl_moreswitches(pTHX_ char *s)
 	s++;
 	return s;
     case 'v':
-#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
-	printf("\nThis is perl, version %d.%03d_%02d built for %s",
-	    PERL_REVISION, PERL_VERSION, PERL_SUBVERSION, ARCHNAME);
-#else
-	printf("\nThis is perl, version %s built for %s",
-		PL_patchlevel, ARCHNAME);
-#endif
+	printf(Perl_form(aTHX_ "\nThis is perl, v%vd built for %s",
+			 PL_patchlevel, ARCHNAME));
 #if defined(LOCAL_PATCH_COUNT)
 	if (LOCAL_PATCH_COUNT > 0)
 	    printf("\n(with %d registered patch%s, see perl -V for more detail)",
 		(int)LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
 #endif
 
-	printf("\n\nCopyright 1987-1999, Larry Wall\n");
-#ifdef MACOS_TRADITIONAL
-        fputs("Macintosh port Copyright 1991-1999, Matthias Neeracher\n", stdout);
-#endif
+	printf("\n\nCopyright 1987-2000, Larry Wall\n");
 #ifdef MSDOS
 	printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
 #endif
@@ -1846,6 +2171,9 @@ Perl_moreswitches(pTHX_ char *s)
 #ifdef __MINT__
 	printf("MiNT port by Guido Flohr, 1997-1999\n");
 #endif
+#ifdef EPOC
+	printf("EPOC port by Olaf Flebbe, 1999-2000\n");
+#endif
 #ifdef BINARY_BUILD_NOTICE
 	BINARY_BUILD_NOTICE;
 #endif
@@ -2008,12 +2336,6 @@ S_init_interp(pTHX)
 #  endif
 #endif
 
-#ifdef MACOS_TRADITIONAL
-  /* In MacOS time() already returns values in excess of 2**31-1,
-   * therefore we patch the integerness away. */
-  PL_opargs[OP_TIME] &= ~OA_RETINTEGER;
-#endif
-
 }
 
 STATIC void
@@ -2052,7 +2374,7 @@ S_init_main_stash(pTHX)
     sv_grow(ERRSV, 240);	/* Preallocate - for immediate signals. */
     sv_setpvn(ERRSV, "", 0);
     PL_curstash = PL_defstash;
-    PL_compiling.cop_stash = PL_defstash;
+    CopSTASH_set(&PL_compiling, PL_defstash);
     PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
     PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
     /* We must init $/ before switches are processed. */
@@ -2087,7 +2409,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 	}
     }
 
-    PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
+    CopFILE_set(PL_curcop, PL_origfilename);
     if (strEQ(PL_origfilename,"-"))
 	scriptname = "";
     if (*fdscript >= 0) {
@@ -2106,7 +2428,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 	    Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP);
 	sv_catpv(cpp, cpp_cfg);
 
-	sv_catpv(sv,"-I");
+	sv_catpvn(sv, "-I", 2);
 	sv_catpv(sv,PRIVLIB_EXP);
 
 #ifdef MSDOS
@@ -2122,7 +2444,7 @@ sed %s -e \"/^[^#]/b\" \
  -e \"/^#[ 	]*undef[ 	]/b\" \
  -e \"/^#[ 	]*endif/b\" \
  -e \"s/^#.*//\" \
- %s | %_ -C %_ %s",
+ %s | %"SVf" -C %"SVf" %s",
 	  (PL_doextract ? "-e \"1,/^#/d\n\"" : ""),
 #else
 #  ifdef __OPEN_VM
@@ -2138,7 +2460,7 @@ sed %s -e \"/^[^#]/b\" \
  -e '/^#[ 	]*undef[ 	]/b' \
  -e '/^#[ 	]*endif/b' \
  -e 's/^[ 	]*#.*//' \
- %s | %_ %_ %s",
+ %s | %"SVf" %"SVf" %s",
 #  else
 	Perl_sv_setpvf(aTHX_ cmd, "\
 %s %s -e '/^[^#]/b' \
@@ -2152,7 +2474,7 @@ sed %s -e \"/^[^#]/b\" \
  -e '/^#[ 	]*undef[ 	]/b' \
  -e '/^#[ 	]*endif/b' \
  -e 's/^[ 	]*#.*//' \
- %s | %_ -C %_ %s",
+ %s | %"SVf" -C %"SVf" %s",
 #  endif
 #ifdef LOC_SED
 	  LOC_SED,
@@ -2201,24 +2523,26 @@ sed %s -e \"/^[^#]/b\" \
 #ifdef DOSUID
 #ifndef IAMSUID		/* in case script is not readable before setuid */
 	if (PL_euid &&
-	    PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&PL_statbuf) >= 0 &&
+	    PerlLIO_stat(CopFILE(PL_curcop),&PL_statbuf) >= 0 &&
 	    PL_statbuf.st_mode & (S_ISUID|S_ISGID))
 	{
 	    /* try again */
-	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
+				     (int)PERL_REVISION, (int)PERL_VERSION,
+				     (int)PERL_SUBVERSION), PL_origargv);
 	    Perl_croak(aTHX_ "Can't do setuid\n");
 	}
 #endif
 #endif
 	Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
-	  SvPVX(GvSV(PL_curcop->cop_filegv)), Strerror(errno));
+		   CopFILE(PL_curcop), Strerror(errno));
     }
 }
 
 /* Mention
  * I_SYSSTATVFS	HAS_FSTATVFS
  * I_SYSMOUNT
- * I_STATFS	HAS_FSTATFS
+ * I_STATFS	HAS_FSTATFS	HAS_GETFSSTAT
  * I_MNTENT	HAS_GETMNTENT	HAS_HASMNTOPT
  * here so that metaconfig picks them up. */
 
@@ -2253,7 +2577,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
 #               if defined(HAS_FSTAT) && \
 		   defined(HAS_USTAT) && \
 		   defined(HAS_GETMNT) && \
-		   defined(HAS_STRUCT_FS_DATA) &&
+		   defined(HAS_STRUCT_FS_DATA) && \
 		   defined(NOSTAT_ONE)
     struct stat fdst;
     if (fstat(fd, &fdst) == 0) {
@@ -2355,7 +2679,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 	 * But I don't think it's too important.  The manual lies when
 	 * it says access() is useful in setuid programs.
 	 */
-	if (PerlLIO_access(SvPVX(GvSV(PL_curcop->cop_filegv)),1)) /*double check*/
+	if (PerlLIO_access(CopFILE(PL_curcop),1)) /*double check*/
 	    Perl_croak(aTHX_ "Permission denied");
 #else
 	/* If we can swap euid and uid, then we can determine access rights
@@ -2376,7 +2700,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 #endif
 		|| PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
 		Perl_croak(aTHX_ "Can't swap uid and euid");	/* really paranoid */
-	    if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0)
+	    if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0)
 		Perl_croak(aTHX_ "Permission denied");	/* testing full pathname here */
 #if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
 	    if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
@@ -2391,7 +2715,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 (Filename of set-id script was %s, uid %"Uid_t_f" gid %"Gid_t_f".)\n\nSincerely,\nperl\n",
 			PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
 			(long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino,
-			SvPVX(GvSV(PL_curcop->cop_filegv)),
+			CopFILE(PL_curcop),
 			PL_statbuf.st_uid, PL_statbuf.st_gid);
 		    (void)PerlProc_pclose(PL_rsfp);
 		}
@@ -2418,7 +2742,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 	if (PL_statbuf.st_mode & S_IWOTH)
 	    Perl_croak(aTHX_ "Setuid/gid script is writable by world");
 	PL_doswitches = FALSE;		/* -s is insecure in suid */
-	PL_curcop->cop_line++;
+	CopLINE_inc(PL_curcop);
 	if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
 	  strnNE(SvPV(PL_linestr,n_a),"#!",2) )	/* required even on Sys V */
 	    Perl_croak(aTHX_ "No #! line");
@@ -2452,7 +2776,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	    (void)PerlIO_close(PL_rsfp);
 #ifndef IAMSUID
 	    /* try again */
-	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
+				     (int)PERL_REVISION, (int)PERL_VERSION,
+				     (int)PERL_SUBVERSION), PL_origargv);
 #endif
 	    Perl_croak(aTHX_ "Can't do setuid\n");
 	}
@@ -2534,7 +2860,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);	/* ensure no close-on-exec */
 #endif
-    PerlProc_execv(Perl_form(aTHX_ "%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */
+    PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
+			     (int)PERL_REVISION, (int)PERL_VERSION,
+			     (int)PERL_SUBVERSION), PL_origargv);/* try again */
     Perl_croak(aTHX_ "Can't do setuid\n");
 #endif /* IAMSUID */
 #else /* !DOSUID */
@@ -2563,32 +2891,11 @@ S_find_beginning(pTHX)
     /* skip forward in input to the real script? */
 
     forbid_setid("-x");
-#ifdef MACOS_TRADITIONAL
-    /* Since the Mac OS does not honor !# arguments for us,
-     * we do it ourselves. */
-    while (PL_doextract || gAlwaysExtract) {
-	if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
-	    if (!gAlwaysExtract)
-		Perl_croak(aTHX_ "No Perl script found in input\n");
-		
-	    if (PL_doextract)		/* require explicit override ? */
-		if (!OverrideExtract(PL_origfilename))
-		    Perl_croak(aTHX_ "User aborted script\n");
-		else
-		    PL_doextract = FALSE;
-		
-	    /* Pater peccavi, file does not have #! */
-	    PerlIO_rewind(PL_rsfp);
-	    
-	    break;
-	}
-#else
     while (PL_doextract) {
 	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"))) {
-	    PerlIO_ungetc(PL_rsfp, '\n');	/* to keep line count right */
+	    PerlIO_ungetc(PL_rsfp, '\n');		/* to keep line count right */
 	    PL_doextract = FALSE;
 	    while (*s && !(isSPACE (*s) || *s == '#')) s++;
 	    s2 = s;
@@ -2678,7 +2985,7 @@ Perl_init_stacks(pTHX)
     PL_markstack_ptr = PL_markstack;
     PL_markstack_max = PL_markstack + REASONABLE(32);
 
-    SET_MARKBASE;
+    SET_MARK_OFFSET;
 
     New(54,PL_scopestack,REASONABLE(32),I32);
     PL_scopestack_ix = 0;
@@ -2768,9 +3075,8 @@ S_init_predump_symbols(pTHX)
 
     PL_statname = NEWSV(66,0);		/* last filename we did stat on */
 
-    if (PL_osname)
-    	Safefree(PL_osname);
-    PL_osname = savepv(OSNAME);
+    if (!PL_osname)
+	PL_osname = savepv(OSNAME);
 }
 
 STATIC void
@@ -2786,7 +3092,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	for (; argc > 0 && **argv == '-'; argc--,argv++) {
 	    if (!argv[0][1])
 		break;
-	    if (argv[0][1] == '-') {
+	    if (argv[0][1] == '-' && !argv[0][2]) {
 		argc--,argv++;
 		break;
 	    }
@@ -2808,13 +3114,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 
     TAINT;
     if (tmpgv = gv_fetchpv("0",TRUE, SVt_PV)) {
-#ifdef MACOS_TRADITIONAL
-	sv_setpv(GvSV(tmpgv),MPWFileName(PL_origfilename));
-	/* $0 is not majick on a Mac */
-#else
 	sv_setpv(GvSV(tmpgv),PL_origfilename);
 	magicname("0", "0", 1);
-#endif
     }
     if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))
 #ifdef OS2
@@ -2867,7 +3168,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     }
     TAINT_NOT;
     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
-	sv_setiv(GvSV(tmpgv), (IV)getpid());
+	sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
 }
 
 STATIC void
@@ -2905,24 +3206,6 @@ S_init_perllib(pTHX)
 #ifdef ARCHLIB_EXP
     incpush(ARCHLIB_EXP, FALSE);
 #endif
-#ifdef MACOS_TRADITIONAL
-    {
-	struct stat tmpstatbuf;
-    	SV * privdir = NEWSV(55, 0);
-	char * macperl = getenv("MACPERL") || "";
-	
-	Perl_sv_setpvf(privdir, "%slib:", macperl);
-	if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
-	    incpush(SvPVX(privdir), TRUE);
-	Perl_sv_setpvf(privdir, "%ssite_perl:", macperl);
-	if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
-	    incpush(SvPVX(privdir), TRUE);
-	    
-   	SvREFCNT_dec(privdir);
-    }
-    if (!PL_tainting)
-	incpush(":", FALSE);
-#else
 #ifndef PRIVLIB_EXP
 #define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
 #endif
@@ -2932,14 +3215,21 @@ S_init_perllib(pTHX)
     incpush(PRIVLIB_EXP, FALSE);
 #endif
 
-#ifdef SITEARCH_EXP
-    incpush(SITEARCH_EXP, FALSE);
-#endif
-#ifdef SITELIB_EXP
-#if defined(WIN32) 
-    incpush(SITELIB_EXP, TRUE);
+#if defined(WIN32)
+    incpush(SITELIB_EXP, TRUE);	/* XXX Win32 needs inc_version_list support */
 #else
-    incpush(SITELIB_EXP, FALSE);
+#ifdef SITELIB_EXP
+    {
+	char *path = SITELIB_EXP;
+
+	if (path) {
+	    char buf[1024];
+	    strcpy(buf,path);
+	    if (strrchr(buf,'/'))	/* XXX Hack, Configure var needed */
+		*strrchr(buf,'/') = '\0';
+	    incpush(buf, TRUE);
+	}
+    }
 #endif
 #endif
 #if defined(PERL_VENDORLIB_EXP)
@@ -2951,24 +3241,19 @@ S_init_perllib(pTHX)
 #endif
     if (!PL_tainting)
 	incpush(".", FALSE);
-#endif /* MACOS_TRADITIONAL */
 }
 
-#if defined(MACOS_TRADITIONAL)
-#      define PERLLIB_SEP ','
+#if defined(DOSISH)
+#    define PERLLIB_SEP ';'
 #else
-#  if defined(DOSISH)
-#      define PERLLIB_SEP ';'
+#  if defined(VMS)
+#    define PERLLIB_SEP '|'
 #  else
-#    if defined(VMS)
-#      define PERLLIB_SEP '|'
-#    else
-#      define PERLLIB_SEP ':'
-#    endif
+#    define PERLLIB_SEP ':'
 #  endif
-#endif 
+#endif
 #ifndef PERLLIB_MANGLE
-#    define PERLLIB_MANGLE(s,n) (s)
+#  define PERLLIB_MANGLE(s,n) (s)
 #endif 
 
 STATIC void
@@ -2981,21 +3266,6 @@ S_incpush(pTHX_ char *p, int addsubdirs)
 
     if (addsubdirs) {
 	subdir = sv_newmortal();
-	if (!PL_archpat_auto) {
-	    STRLEN len = (sizeof(ARCHNAME) + strlen(PL_patchlevel)
-			  + sizeof("//auto"));
-	    New(55, PL_archpat_auto, len, char);
-#ifdef MACOS_TRADITIONAL
-	    sprintf(PL_archpat_auto, "%s:%s:auto:", ARCHNAME, PL_patchlevel);
-#else
-  	    sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel);
-#endif
-#ifdef VMS
-	for (len = sizeof(ARCHNAME) + 2;
-	     PL_archpat_auto[len] != '\0' && PL_archpat_auto[len] != '/'; len++)
-		if (PL_archpat_auto[len] == '.') PL_archpat_auto[len] = '_';
-#endif
-	}
     }
 
     /* Break at all separators */
@@ -3019,18 +3289,17 @@ S_incpush(pTHX_ char *p, int addsubdirs)
 	    sv_setpv(libdir, PERLLIB_MANGLE(p, 0));
 	    p = Nullch;	/* break out */
 	}
-#ifdef MACOS_TRADITIONAL
-	if (!strchr(SvPVX(libdir), ':'))
-	    sv_insert(libdir, 0, 0, ":", 1);
-	if (SvPVX(libdir)[SvCUR(libdir)-1] != ':')
-	    sv_catpv(libdir, ":");
-#endif
 
 	/*
 	 * BEFORE pushing libdir onto @INC we may first push version- and
 	 * archname-specific sub-directories.
 	 */
 	if (addsubdirs) {
+#ifdef PERL_INC_VERSION_LIST
+	    /* Configure terminates PERL_INC_VERSION_LIST with a NULL */
+	    const char *incverlist[] = { PERL_INC_VERSION_LIST };
+	    const char **incver;
+#endif
 	    struct stat tmpstatbuf;
 #ifdef VMS
 	    char *unix;
@@ -3046,21 +3315,37 @@ S_incpush(pTHX_ char *p, int addsubdirs)
 		              "Failed to unixify @INC element \"%s\"\n",
 			      SvPV(libdir,len));
 #endif
-	    /* .../archname/version if -d .../archname/version/auto */
-	    sv_setsv(subdir, libdir);
-	    sv_catpv(subdir, PL_archpat_auto);
+	    /* .../version/archname if -d .../version/archname */
+	    Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", libdir,
+			   (int)PERL_REVISION, (int)PERL_VERSION,
+			   (int)PERL_SUBVERSION, ARCHNAME);
+	    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+		  S_ISDIR(tmpstatbuf.st_mode))
+		av_push(GvAVn(PL_incgv), newSVsv(subdir));
+
+	    /* .../version if -d .../version */
+	    Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
+			   (int)PERL_REVISION, (int)PERL_VERSION,
+			   (int)PERL_SUBVERSION);
 	    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
 		  S_ISDIR(tmpstatbuf.st_mode))
-		av_push(GvAVn(PL_incgv),
-			newSVpvn(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
+		av_push(GvAVn(PL_incgv), newSVsv(subdir));
 
-	    /* .../archname if -d .../archname/auto */
-	    sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
-		      strlen(PL_patchlevel) + 1, "", 0);
+	    /* .../archname if -d .../archname */
+	    Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
 	    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
 		  S_ISDIR(tmpstatbuf.st_mode))
-		av_push(GvAVn(PL_incgv),
-			newSVpvn(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
+		av_push(GvAVn(PL_incgv), newSVsv(subdir));
+
+#ifdef PERL_INC_VERSION_LIST
+	    for (incver = incverlist; *incver; incver++) {
+		/* .../xxx if -d .../xxx */
+		Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+		if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+		      S_ISDIR(tmpstatbuf.st_mode))
+		    av_push(GvAVn(PL_incgv), newSVsv(subdir));
+	    }
+#endif
 	}
 
 	/* finally push this lib directory on the end of @INC */
@@ -3149,8 +3434,8 @@ void
 Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 {
     dTHR;
-    SV *atsv = ERRSV;
-    line_t oldline = PL_curcop->cop_line;
+    SV *atsv;
+    line_t oldline = CopLINE(PL_curcop);
     CV *cv;
     STRLEN len;
     int ret;
@@ -3159,20 +3444,34 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
     while (AvFILL(paramList) >= 0) {
 	cv = (CV*)av_shift(paramList);
 	SAVEFREESV(cv);
-	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_list_body), cv);
+#else
+	JMPENV_PUSH(ret);
+#endif
 	switch (ret) {
 	case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+	    call_list_body(cv);
+#endif
+	    atsv = ERRSV;
 	    (void)SvPV(atsv, len);
 	    if (len) {
+		STRLEN n_a;
 		PL_curcop = &PL_compiling;
-		PL_curcop->cop_line = oldline;
+		CopLINE_set(PL_curcop, oldline);
 		if (paramList == PL_beginav)
 		    sv_catpv(atsv, "BEGIN failed--compilation aborted");
 		else
-		    sv_catpv(atsv, "END failed--cleanup aborted");
+		    Perl_sv_catpvf(aTHX_ atsv,
+				   "%s failed--call queue aborted",
+				   paramList == PL_checkav ? "CHECK"
+				   : paramList == PL_initav ? "INIT"
+				   : "END");
 		while (PL_scopestack_ix > oldscope)
 		    LEAVE;
-		Perl_croak(aTHX_ "%s", SvPVX(atsv));
+		JMPENV_POP;
+		Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a));
 	    }
 	    break;
 	case 1:
@@ -3184,37 +3483,46 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 		LEAVE;
 	    FREETMPS;
 	    PL_curstash = PL_defstash;
-	    if (PL_endav && !PL_minus_c)
-		call_list(oldscope, PL_endav);
 	    PL_curcop = &PL_compiling;
-	    PL_curcop->cop_line = oldline;
-	    if (PL_statusvalue) {
+	    CopLINE_set(PL_curcop, oldline);
+	    JMPENV_POP;
+	    if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
 		if (paramList == PL_beginav)
 		    Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
 		else
-		    Perl_croak(aTHX_ "END failed--cleanup aborted");
+		    Perl_croak(aTHX_ "%s failed--call queue aborted",
+			       paramList == PL_checkav ? "CHECK"
+			       : paramList == PL_initav ? "INIT"
+			       : "END");
 	    }
 	    my_exit_jump();
 	    /* NOTREACHED */
 	case 3:
 	    if (PL_restartop) {
 		PL_curcop = &PL_compiling;
-		PL_curcop->cop_line = oldline;
+		CopLINE_set(PL_curcop, oldline);
 		JMPENV_JUMP(3);
 	    }
 	    PerlIO_printf(Perl_error_log, "panic: restartop\n");
 	    FREETMPS;
 	    break;
 	}
+	JMPENV_POP;
     }
 }
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 STATIC void *
-S_call_list_body(pTHX_ va_list args)
+S_vcall_list_body(pTHX_ va_list args)
 {
-    dTHR;
     CV *cv = va_arg(args, CV*);
+    return call_list_body(cv);
+}
+#endif
 
+STATIC void *
+S_call_list_body(pTHX_ CV *cv)
+{
     PUSHMARK(PL_stack_sp);
     call_sv((SV*)cv, G_EVAL|G_DISCARD);
     return NULL;
@@ -3295,7 +3603,6 @@ S_my_exit_jump(pTHX)
 }
 
 #ifdef PERL_OBJECT
-#define NO_XSLOCKS
 #include "XSUB.h"
 #endif
 
@@ -3314,4 +3621,3 @@ read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen)
     sv_chop(PL_e_script, nl);
     return 1;
 }
-