Be sure to find the vmsish pragma for one-liners in exit.t.
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 684fd80..d9ebaca 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1228,14 +1228,18 @@ perl_destruct(pTHXx)
     Safefree(PL_reg_poscache);
     free_tied_hv_pool();
     Safefree(PL_op_mask);
-    Safefree(PL_psig_ptr);
-    PL_psig_ptr = (SV**)NULL;
     Safefree(PL_psig_name);
     PL_psig_name = (SV**)NULL;
-    Safefree(PL_bitcount);
-    PL_bitcount = NULL;
+    PL_psig_ptr = (SV**)NULL;
     Safefree(PL_psig_pend);
     PL_psig_pend = (int*)NULL;
+    {
+       /* We need to NULL PL_psig_pend first, so that
+          signal handlers know not to use it */
+       int *psig_save = PL_psig_pend;
+       PL_psig_pend = (int*)NULL;
+       Safefree(psig_save);
+    }
     PL_formfeed = NULL;
     nuke_stacks();
     PL_tainting = FALSE;
@@ -1642,7 +1646,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     char **argv = PL_origargv;
     const char *scriptname = NULL;
     VOL bool dosearch = FALSE;
-    register SV *sv;
     register char c;
     const char *cddir = NULL;
 #ifdef USE_SITECUSTOMIZE
@@ -1654,8 +1657,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     SvGROW(linestr_sv, 80);
     sv_setpvs(linestr_sv,"");
 
-    sv = newSVpvs("");         /* first used for -I flags */
-    SAVEFREESV(sv);
     init_main_stash();
 
     {
@@ -1714,11 +1715,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            PL_minus_E = TRUE;
            /* FALL THROUGH */
        case 'e':
-#ifdef MACOS_TRADITIONAL
-           /* ignore -e for Dev:Pseudo argument */
-           if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
-               break;
-#endif
            forbid_setid('e', FALSE);
            if (!PL_e_script) {
                PL_e_script = newSVpvs("");
@@ -1750,9 +1746,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            if (s && *s) {
                STRLEN len = strlen(s);
                incpush(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
-               sv_catpvs(sv, "-I");
-               sv_catpvn(sv, s, len);
-               sv_catpvs(sv, " ");
            }
            else
                Perl_croak(aTHX_ "No directory specified for -I");
@@ -1786,17 +1779,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef PERL_MEM_LOG
                             " PERL_MEM_LOG"
 #  endif
-#  ifdef PERL_MEM_LOG_ENV
-                            " PERL_MEM_LOG_ENV"
-#  endif
-#  ifdef PERL_MEM_LOG_ENV_FD
-                            " PERL_MEM_LOG_ENV_FD"
-#  endif
-#  ifdef PERL_MEM_LOG_STDERR
-                            " PERL_MEM_LOG_STDERR"
-#  endif
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-                            " PERL_MEM_LOG_TIMESTAMP"
+#  ifdef PERL_MEM_LOG_NOIMPL
+                            " PERL_MEM_LOG_NOIMPL"
 #  endif
 #  ifdef PERL_USE_DEVEL
                             " PERL_USE_DEVEL"
@@ -1929,7 +1913,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                d = s;
                if (!*s)
                    break;
-               if (!strchr("CDIMUdmtw", *s))
+               if (!strchr("CDIMUdmtwW", *s))
                    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
                while (++s && *s) {
                    if (isSPACE(*s)) {
@@ -2008,11 +1992,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  endif
 #endif
 
-       if (PL_doextract
-#ifdef MACOS_TRADITIONAL
-           || gMacPerl_AlwaysExtract
-#endif
-           ) {
+       if (PL_doextract) {
 
            /* This will croak if suidscript is true, as -x cannot be used with
               setuid scripts.  */
@@ -2034,7 +2014,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
     boot_core_PerlIO();
     boot_core_UNIVERSAL();
-    boot_core_xsutils();
     boot_core_mro();
 
     if (xsinit)
@@ -2153,16 +2132,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     /* now parse the script */
 
     SETERRNO(0,SS_NORMAL);
-#ifdef MACOS_TRADITIONAL
-    if (gMacPerl_SyntaxError = (yyparse() || PL_parser->error_count)) {
-       if (PL_minus_c)
-           Perl_croak(aTHX_ "%s had compilation errors.\n", MacPerl_MPWFileName(PL_origfilename));
-       else {
-           Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
-                      MacPerl_MPWFileName(PL_origfilename));
-       }
-    }
-#else
     if (yyparse() || PL_parser->error_count) {
        if (PL_minus_c)
            Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
@@ -2171,7 +2140,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                       PL_origfilename);
        }
     }
-#endif
     CopLINE_set(PL_curcop, 0);
     PL_curstash = PL_defstash;
     if (PL_e_script) {
@@ -2289,13 +2257,7 @@ S_run_body(pTHX_ I32 oldscope)
 #endif
 
        if (PL_minus_c) {
-#ifdef MACOS_TRADITIONAL
-           PerlIO_printf(Perl_error_log, "%s%s syntax OK\n",
-               (gMacPerl_ErrorFormat ? "# " : ""),
-               MacPerl_MPWFileName(PL_origfilename));
-#else
            PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
-#endif
            my_exit(0);
        }
        if (PERLDB_SINGLE && PL_DBsingle)
@@ -3209,9 +3171,6 @@ Perl_moreswitches(pTHX_ const 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;
@@ -3270,11 +3229,6 @@ Perl_moreswitches(pTHX_ const char *s)
 
        PerlIO_printf(PerlIO_stdout(),
                      "\n\nCopyright 1987-2009, Larry Wall\n");
-#ifdef MACOS_TRADITIONAL
-       PerlIO_printf(PerlIO_stdout(),
-                     "\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
-                     "maintained by Chris Nandor\n");
-#endif
 #ifdef MSDOS
        PerlIO_printf(PerlIO_stdout(),
                      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -3671,38 +3625,14 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
     dVAR;
     const char *s;
     register const char *s2;
-#ifdef MACOS_TRADITIONAL
-    int maclines = 0;
-#endif
 
     PERL_ARGS_ASSERT_FIND_BEGINNING;
 
     /* skip forward in input to the real script? */
 
-#ifdef MACOS_TRADITIONAL
-    /* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
-
-    while (PL_doextract || gMacPerl_AlwaysExtract) {
-       if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL) {
-           if (!gMacPerl_AlwaysExtract)
-               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(rsfp);
-
-           break;
-       }
-#else
     while (PL_doextract) {
        if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL)
            Perl_croak(aTHX_ "No Perl script found in input\n");
-#endif
        s2 = s;
        if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) {
            PerlIO_ungetc(rsfp, '\n');          /* to keep line count right */
@@ -3717,20 +3647,6 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
                    while ((s = moreswitches(s)))
                        ;
            }
-#ifdef MACOS_TRADITIONAL
-           /* We are always searching for the #!perl line in MacPerl,
-            * so if we find it, still keep the line count correct
-            * by counting lines we already skipped over
-            */
-           for (; maclines > 0 ; maclines--)
-               PerlIO_ungetc(rsfp, '\n');
-
-           break;
-
-       /* gMacPerl_AlwaysExtract is false in MPW tool */
-       } else if (gMacPerl_AlwaysExtract) {
-           ++maclines;
-#endif
        }
     }
 }
@@ -4016,17 +3932,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     init_argv_symbols(argc,argv);
 
     if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, SVt_PV))) {
-#ifdef MACOS_TRADITIONAL
-       /* $0 is not majick on a Mac */
-       sv_setpv(GvSV(tmpgv),MacPerl_MPWFileName(PL_origfilename));
-#else
        sv_setpv(GvSV(tmpgv),PL_origfilename);
-       {
-           GV * const gv = gv_fetchpv("0", GV_ADD, SVt_PV);
-           if (gv)
-               sv_magic(GvSV(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, "0", 1);
-       }
-#endif
     }
     if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
        HV *hv;
@@ -4148,33 +4054,6 @@ S_init_perllib(pTHX)
                      INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
 #endif
 
-#ifdef MACOS_TRADITIONAL
-    {
-       Stat_t tmpstatbuf;
-       SV * privdir = newSV(0);
-       char * macperl = PerlEnv_getenv("MACPERL");
-       
-       if (!macperl)
-           macperl = "";
-
-#  ifdef ARCHLIB_EXP
-       S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE);
-#  endif
-       
-       Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
-       if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
-           incpush_use_sep(SvPVX(privdir), SvCUR(privdir),
-                           INCPUSH_ADD_SUB_DIRS);
-       Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl);
-       if (PerlLIO_stat(SvPVX(privdir), SvCUR(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
-           incpush_use_sep(SvPVX(privdir), SvCUR(privdir),
-                           INCPUSH_ADD_SUB_DIRS);
-       
-       SvREFCNT_dec(privdir);
-       if (!PL_tainting)
-           S_incpush(aTHX_ STR_WITH_LEN(":"), 0);
-    }
-#else
 #ifdef SITEARCH_EXP
     /* sitearch is always relative to sitelib on Windows for
      * DLL-based path intuition to work correctly */
@@ -4241,7 +4120,6 @@ S_init_perllib(pTHX)
                      INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_NOT_BASEDIR
                      |INCPUSH_CAN_RELOCATE);
 #endif
-#endif /* MACOS_TRADITIONAL */
 
     if (!PL_tainting) {
 #ifndef VMS
@@ -4280,7 +4158,6 @@ S_init_perllib(pTHX)
                      |INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE);
 #endif
 
-#ifndef MACOS_TRADITIONAL
 #if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST)
     /* Search for version-specific dirs below here */
     S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM),
@@ -4302,7 +4179,6 @@ S_init_perllib(pTHX)
 
     if (!PL_tainting)
        S_incpush(aTHX_ STR_WITH_LEN("."), 0);
-#endif /* MACOS_TRADITIONAL */
 }
 
 #if defined(DOSISH) || defined(EPOC) || defined(__SYMBIAN32__)
@@ -4311,11 +4187,7 @@ S_init_perllib(pTHX)
 #  if defined(VMS)
 #    define PERLLIB_SEP '|'
 #  else
-#    if defined(MACOS_TRADITIONAL)
-#      define PERLLIB_SEP ','
-#    else
-#      define PERLLIB_SEP ':'
-#    endif
+#    define PERLLIB_SEP ':'
 #  endif
 #endif
 #ifndef PERLLIB_MANGLE
@@ -4355,7 +4227,9 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
        = (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS;
     const U8 add_archonly_sub_dirs
        = (U8)flags & INCPUSH_ADD_ARCHONLY_SUB_DIRS;
+#ifdef PERL_INC_VERSION_LIST
     const U8 addoldvers  = (U8)flags & INCPUSH_ADD_OLD_VERS;
+#endif
     const U8 canrelocate = (U8)flags & INCPUSH_CAN_RELOCATE;
     const U8 unshift     = (U8)flags & INCPUSH_UNSHIFT;
     const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1;
@@ -4388,16 +4262,6 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
            libdir = newSVpv(PERLLIB_MANGLE(dir, 0), 0);
        }
 
-#ifdef MACOS_TRADITIONAL
-       if (!strchr(SvPVX(libdir), ':')) {
-           char buf[256];
-
-           sv_setpv(libdir, MacPerl_CanonDir(SvPVX(libdir), buf, 0));
-       }
-       if (SvPVX(libdir)[SvCUR(libdir)-1] != ':')
-           sv_catpvs(libdir, ":");
-#endif
-
        /* Do the if() outside the #ifdef to avoid warnings about an unused
           parameter.  */
        if (canrelocate) {
@@ -4527,22 +4391,12 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
            subdir = newSVsv(libdir);
 
            if (add_versioned_sub_dirs) {
-#ifdef MACOS_TRADITIONAL
-#define PERL_ARCH_FMT_PREFIX   ""
-#define PERL_ARCH_FMT_SUFFIX   ":"
-#define PERL_ARCH_FMT_PATH     PERL_FS_VERSION ""
-#else
-#define PERL_ARCH_FMT_PREFIX   "/"
-#define PERL_ARCH_FMT_SUFFIX   ""
-#define PERL_ARCH_FMT_PATH     "/" PERL_FS_VERSION
-#endif
                /* .../version/archname if -d .../version/archname */
-               sv_catpvs(subdir, PERL_ARCH_FMT_PATH \
-                         PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX);
+               sv_catpvs(subdir, "/" PERL_FS_VERSION "/" ARCHNAME);
                subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
 
                /* .../version if -d .../version */
-               sv_catpvs(subdir, PERL_ARCH_FMT_PATH);
+               sv_catpvs(subdir, "/" PERL_FS_VERSION);
                subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
            }
 
@@ -4550,8 +4404,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
            if (addoldvers) {
                for (incver = incverlist; *incver; incver++) {
                    /* .../xxx if -d .../xxx */
-                   Perl_sv_catpvf(aTHX_ subdir, PERL_ARCH_FMT_PREFIX \
-                                  "%s" PERL_ARCH_FMT_SUFFIX, *incver);
+                   Perl_sv_catpvf(aTHX_ subdir, "/%s", *incver);
                    subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
                }
            }
@@ -4559,8 +4412,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 
            if (add_archonly_sub_dirs) {
                /* .../archname if -d .../archname */
-               sv_catpvs(subdir,
-                         PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX);
+               sv_catpvs(subdir, "/" ARCHNAME);
                subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
 
            }