This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8-ize @ARGV when -C switch is used on Windows
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index eba7e5c..ef6a8bd 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -47,6 +47,37 @@ static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
 #define perl_free      Perl_free
 #endif
 
+#if defined(USE_THREADS)
+#  define INIT_TLS_AND_INTERP \
+    STMT_START {                               \
+       if (!PL_curinterp) {                    \
+           PERL_SET_INTERP(my_perl);           \
+           INIT_THREADS;                       \
+           ALLOC_THREAD_KEY;                   \
+       }                                       \
+    } STMT_END
+#else
+#  if defined(USE_ITHREADS)
+#  define INIT_TLS_AND_INTERP \
+    STMT_START {                               \
+       if (!PL_curinterp) {                    \
+           PERL_SET_INTERP(my_perl);           \
+           INIT_THREADS;                       \
+           ALLOC_THREAD_KEY;                   \
+       }                                       \
+       PERL_SET_THX(my_perl);                  \
+    } STMT_END
+#  else
+#  define INIT_TLS_AND_INTERP \
+    STMT_START {                               \
+       if (!PL_curinterp) {                    \
+           PERL_SET_INTERP(my_perl);           \
+       }                                       \
+       PERL_SET_THX(my_perl);                  \
+    } STMT_END
+#  endif
+#endif
+
 #ifdef PERL_IMPLICIT_SYS
 PerlInterpreter *
 perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
@@ -59,11 +90,11 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
 #ifdef PERL_OBJECT
     my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
                                                  ipLIO, ipD, ipS, ipP);
-    PERL_SET_INTERP(my_perl);
+    INIT_TLS_AND_INTERP;
 #else
     /* New() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
-    PERL_SET_INTERP(my_perl);
+    INIT_TLS_AND_INTERP;
     Zero(my_perl, 1, PerlInterpreter);
     PL_Mem = ipM;
     PL_MemShared = ipMS;
@@ -95,7 +126,8 @@ perl_alloc(void)
 
     /* New() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
-    PERL_SET_INTERP(my_perl);
+
+    INIT_TLS_AND_INTERP;
     Zero(my_perl, 1, PerlInterpreter);
     return my_perl;
 }
@@ -118,7 +150,7 @@ perl_construct(pTHXx)
     struct perl_thread *thr = NULL;
 #endif /* FAKE_THREADS */
 #endif /* USE_THREADS */
-    
+
 #ifdef MULTIPLICITY
     init_interp();
     PL_perl_destruct_level = 1; 
@@ -129,14 +161,7 @@ perl_construct(pTHXx)
 
    /* Init the real globals (and main thread)? */
     if (!PL_linestr) {
-       INIT_THREADS;
 #ifdef USE_THREADS
-#ifdef ALLOC_THREAD_KEY
-        ALLOC_THREAD_KEY;
-#else
-       if (pthread_key_create(&PL_thr_key, 0))
-           Perl_croak(aTHX_ "panic: pthread_key_create");
-#endif
        MUTEX_INIT(&PL_sv_mutex);
        /*
         * Safe to use basic SV functions from now on (though
@@ -146,9 +171,9 @@ perl_construct(pTHXx)
        COND_INIT(&PL_eval_cond);
        MUTEX_INIT(&PL_threads_mutex);
        COND_INIT(&PL_nthreads_cond);
-#ifdef EMULATE_ATOMIC_REFCOUNTS
+#  ifdef EMULATE_ATOMIC_REFCOUNTS
        MUTEX_INIT(&PL_svref_mutex);
-#endif /* EMULATE_ATOMIC_REFCOUNTS */
+#  endif /* EMULATE_ATOMIC_REFCOUNTS */
        
        MUTEX_INIT(&PL_cred_mutex);
 
@@ -220,7 +245,7 @@ perl_construct(pTHXx)
        PL_patchlevel = NEWSV(0,4);
        SvUPGRADE(PL_patchlevel, SVt_PVNV);
        if (PERL_REVISION > 127 || PERL_VERSION > 127 || PERL_SUBVERSION > 127)
-           SvGROW(PL_patchlevel,24);
+           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);
@@ -881,12 +906,16 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        s = argv[0]+1;
       reswitch:
        switch (*s) {
+       case 'C':
+#ifdef WIN32
+           win32_argv2utf8(aTHX_ argc-1, argv+1);
+           /* FALL THROUGH */
+#endif
 #ifndef PERL_STRICT_CR
        case '\r':
 #endif
        case ' ':
        case '0':
-       case 'C':
        case 'F':
        case 'a':
        case 'c':
@@ -985,8 +1014,11 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef USE_ITHREADS
                sv_catpv(PL_Sv," USE_ITHREADS");
 #  endif
-#  ifdef USE_64_BITS
-               sv_catpv(PL_Sv," USE_64_BITS");
+#  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");
@@ -1174,7 +1206,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     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
 
@@ -1907,6 +1939,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
@@ -2122,7 +2156,7 @@ Perl_moreswitches(pTHX_ char *s)
        s++;
        return s;
     case 'v':
-       printf(Perl_form(aTHX_ "\nThis is perl, v%v built for %s",
+       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)
@@ -2166,6 +2200,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
@@ -2534,7 +2571,7 @@ sed %s -e \"/^[^#]/b\" \
 /* 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. */
 
@@ -3120,7 +3157,10 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        (void)gv_AVadd(PL_argvgv);
        av_clear(GvAVn(PL_argvgv));
        for (; argc > 0; argc--,argv++) {
-           av_push(GvAVn(PL_argvgv),newSVpv(argv[0],0));
+           SV *sv = newSVpv(argv[0],0);
+           av_push(GvAVn(PL_argvgv),sv);
+           if (PL_widesyscalls)
+               sv_utf8_upgrade(sv);
        }
     }
     if (PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
@@ -3393,7 +3433,7 @@ S_init_main_thread(pTHX)
 #else
     thr->self = pthread_self();
 #endif /* SET_THREAD_SELF */
-    SET_THR(thr);
+    PERL_SET_THX(thr);
 
     /*
      * These must come after the SET_THR because sv_setpvn does