First pass of integrating the Rhapsody port,

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index c91c960..8e11c43 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -13,7 +13,6 @@
 
 #include "EXTERN.h"
 #include "perl.h"
-#include "patchlevel.h"
 
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
@@ -210,13 +209,13 @@ perl_construct(register PerlInterpreter *sv_interp)
     STATUS_ALL_SUCCESS;
 
     SET_NUMERIC_STANDARD();
-#if defined(SUBVERSION) && SUBVERSION > 0
-    sprintf(PL_patchlevel, "%7.5f",   (double) 5 
-                               + ((double) PATCHLEVEL / (double) 1000)
-                               + ((double) SUBVERSION / (double) 100000));
+#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) 5 +
-                               ((double) PATCHLEVEL / (double) 1000));
+    sprintf(PL_patchlevel, "%5.3f", (double) PERL_REVISION +
+                               ((double) PERL_VERSION / (double) 1000));
 #endif
 
 #if defined(LOCAL_PATCH_COUNT)
@@ -564,6 +563,9 @@ perl_destruct(register PerlInterpreter *sv_interp)
     MUTEX_DESTROY(&PL_eval_mutex);
     MUTEX_DESTROY(&PL_cred_mutex);
     COND_DESTROY(&PL_eval_cond);
+#ifdef EMULATE_ATOMIC_REFCOUNTS
+    MUTEX_DESTROY(&PL_svref_mutex);
+#endif /* EMULATE_ATOMIC_REFCOUNTS */
 
     /* As the penultimate thing, free the non-arena SV for thrsv */
     Safefree(SvPVX(PL_thrsv));
@@ -656,7 +658,7 @@ setuid perl scripts securely.\n");
        return 255;
 #endif
 
-#if defined(NeXT) && defined(__DYNAMIC__)
+#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
     _dyld_lookup_and_bind
        ("__environ", (unsigned long *) &environ_pointer, NULL);
 #endif /* environ */
@@ -730,6 +732,9 @@ setuid perl scripts securely.\n");
        s = argv[0]+1;
       reswitch:
        switch (*s) {
+#ifndef PERL_STRICT_CR
+       case '\r':
+#endif
        case ' ':
        case '0':
        case 'F':
@@ -891,19 +896,25 @@ print \"  \\@INC:\\n    @INC\\n\";");
   switch_end:
 
     if (!PL_tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
-       while (s && *s) {
-           while (isSPACE(*s))
-               s++;
-           if (*s == '-') {
-               s++;
-               if (isSPACE(*s))
-                   continue;
+       while (isSPACE(*s))
+           s++;
+       if (*s == '-' && *(s+1) == 'T')
+           PL_tainting = TRUE;
+       else {
+           while (s && *s) {
+               while (isSPACE(*s))
+                   s++;
+               if (*s == '-') {
+                   s++;
+                   if (isSPACE(*s))
+                       continue;
+               }
+               if (!*s)
+                   break;
+               if (!strchr("DIMUdmw", *s))
+                   croak("Illegal switch in PERL5OPT: -%c", *s);
+               s = moreswitches(s);
            }
-           if (!*s)
-               break;
-           if (!strchr("DIMUdmw", *s))
-               croak("Illegal switch in PERL5OPT: -%c", *s);
-           s = moreswitches(s);
        }
     }
 
@@ -1104,7 +1115,7 @@ perl_run(PerlInterpreter *sv_interp)
 }
 
 SV*
-perl_get_sv(char *name, I32 create)
+perl_get_sv(const char *name, I32 create)
 {
     GV *gv;
 #ifdef USE_THREADS
@@ -1123,7 +1134,7 @@ perl_get_sv(char *name, I32 create)
 }
 
 AV*
-perl_get_av(char *name, I32 create)
+perl_get_av(const char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVAV);
     if (create)
@@ -1134,7 +1145,7 @@ perl_get_av(char *name, I32 create)
 }
 
 HV*
-perl_get_hv(char *name, I32 create)
+perl_get_hv(const char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVHV);
     if (create)
@@ -1145,7 +1156,7 @@ perl_get_hv(char *name, I32 create)
 }
 
 CV*
-perl_get_cv(char *name, I32 create)
+perl_get_cv(const char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVCV);
     /* XXX unsafe for threads if eval_owner isn't held */
@@ -1162,7 +1173,7 @@ perl_get_cv(char *name, I32 create)
 /* Be sure to refetch the stack pointer after calling these routines. */
 
 I32
-perl_call_argv(char *sub_name, I32 flags, register char **argv)
+perl_call_argv(const char *sub_name, I32 flags, register char **argv)
               
                        /* See G_* flags in cop.h */
                        /* null terminated arg list */
@@ -1181,7 +1192,7 @@ perl_call_argv(char *sub_name, I32 flags, register char **argv)
 }
 
 I32
-perl_call_pv(char *sub_name, I32 flags)
+perl_call_pv(const char *sub_name, I32 flags)
                        /* name of the subroutine */
                        /* See G_* flags in cop.h */
 {
@@ -1189,7 +1200,7 @@ perl_call_pv(char *sub_name, I32 flags)
 }
 
 I32
-perl_call_method(char *methname, I32 flags)
+perl_call_method(const char *methname, I32 flags)
                                /* name of the subroutine */
                        /* See G_* flags in cop.h */
 {
@@ -1438,7 +1449,7 @@ perl_eval_sv(SV *sv, I32 flags)
 }
 
 SV*
-perl_eval_pv(char *p, I32 croak_on_error)
+perl_eval_pv(const char *p, I32 croak_on_error)
 {
     dSP;
     SV* sv = newSVpv(p, 0);
@@ -1462,7 +1473,7 @@ perl_eval_pv(char *p, I32 croak_on_error)
 /* Require a module. */
 
 void
-perl_require_pv(char *pv)
+perl_require_pv(const char *pv)
 {
     SV* sv;
     dSP;
@@ -1713,9 +1724,9 @@ moreswitches(char *s)
        s++;
        return s;
     case 'v':
-#if defined(SUBVERSION) && SUBVERSION > 0
-       printf("\nThis is perl, version 5.%03d_%02d built for %s",
-           PATCHLEVEL, SUBVERSION, ARCHNAME);
+#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);
@@ -2113,6 +2124,13 @@ sed %s -e \"/^[^#]/b\" \
     }
 }
 
+/* Mention
+ * I_SYSSTATVFS        HAS_FSTATVFS
+ * I_SYSMOUNT
+ * I_STATFS    HAS_FSTATFS
+ * I_MNTENT    HAS_GETMNTENT   HAS_HASMNTOPT
+ * here so that metaconfig picks them up. */
+
 #ifdef IAMSUID
 static int
 fd_on_nosuid_fs(int fd)