X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=be11625eb839cb317dcec6118470a803147bc043;hb=0e455d2b24396ba08377dc3cf2d01e6db5f47048;hp=6cf99f1b92cabe5c063ea9a7ab2a543d9b88ee10;hpb=404ad9dc9dfa2116d2907212d3650df6870ff9bc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index 6cf99f1..be11625 100644 --- a/perl.c +++ b/perl.c @@ -26,6 +26,7 @@ #define PERL_IN_PERL_C #include "perl.h" #include "patchlevel.h" /* for local_patches */ +#include "XSUB.h" #ifdef NETWARE #include "nwutil.h" @@ -1626,6 +1627,92 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) return ret; } +/* This needs to stay in perl.c, as perl.c is compiled with different flags for + miniperl, and we need to see those flags reflected in the values here. */ + +/* What this returns is subject to change. Use the public interface in Config. + */ +static void +S_Internals_V(pTHX_ CV *cv) +{ + dXSARGS; +#ifdef LOCAL_PATCH_COUNT + const int local_patch_count = LOCAL_PATCH_COUNT; +#else + const int local_patch_count = 0; +#endif + const int entries = 4 + local_patch_count; + int i; + static char non_bincompat_options[] = +# ifdef DEBUGGING + " DEBUGGING" +# endif +# ifdef NO_MATHOMS + " NO_MATHOMS" +# endif +# ifdef PERL_DISABLE_PMC + " PERL_DISABLE_PMC" +# endif +# ifdef PERL_DONT_CREATE_GVSV + " PERL_DONT_CREATE_GVSV" +# endif +# ifdef PERL_IS_MINIPERL + " PERL_IS_MINIPERL" +# endif +# ifdef PERL_MALLOC_WRAP + " PERL_MALLOC_WRAP" +# endif +# ifdef PERL_MEM_LOG + " PERL_MEM_LOG" +# endif +# ifdef PERL_MEM_LOG_NOIMPL + " PERL_MEM_LOG_NOIMPL" +# endif +# ifdef PERL_USE_DEVEL + " PERL_USE_DEVEL" +# endif +# ifdef PERL_USE_SAFE_PUTENV + " PERL_USE_SAFE_PUTENV" +# endif +# ifdef USE_SITECUSTOMIZE + " USE_SITECUSTOMIZE" +# endif +# ifdef USE_FAST_STDIO + " USE_FAST_STDIO" +# endif + ; + PERL_UNUSED_ARG(cv); + PERL_UNUSED_ARG(items); + + EXTEND(SP, entries); + + PUSHs(sv_2mortal(newSVpv(PL_bincompat_options, 0))); + PUSHs(Perl_newSVpvn_flags(aTHX_ non_bincompat_options, + sizeof(non_bincompat_options) - 1, SVs_TEMP)); + +#ifdef __DATE__ +# ifdef __TIME__ + PUSHs(Perl_newSVpvn_flags(aTHX_ + STR_WITH_LEN("Compiled at " __DATE__ " " __TIME__), + SVs_TEMP)); +# else + PUSHs(Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN("Compiled on " __DATE__), + SVs_TEMP)); +# endif +#else + PUSHs(&PL_sv_undef); +#endif + + PUSHs(Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN(OSNAME), SVs_TEMP)); + + for (i = 1; i <= local_patch_count; i++) { + /* This will be an undef, if PL_localpatches[i] is NULL. */ + PUSHs(sv_2mortal(newSVpv(PL_localpatches[i], 0))); + } + + XSRETURN(entries); +} + #define INCPUSH_UNSHIFT 0x01 #define INCPUSH_ADD_OLD_VERS 0x02 #define INCPUSH_ADD_VERSIONED_SUB_DIRS 0x04 @@ -1757,97 +1844,17 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { SV *opts_prog; - Perl_av_create_and_push(aTHX_ &PL_preambleav, newSVpvs("use Config;")); if (*++s != ':') { - /* Can't do newSVpvs() as that would involve pre-processor - condititionals inside a macro expansion. */ - opts_prog = Perl_newSVpv(aTHX_ "$_ = join ' ', sort qw(" -# ifdef DEBUGGING - " DEBUGGING" -# endif -# ifdef NO_MATHOMS - " NO_MATHOMS" -# endif -# ifdef PERL_DISABLE_PMC - " PERL_DISABLE_PMC" -# endif -# ifdef PERL_DONT_CREATE_GVSV - " PERL_DONT_CREATE_GVSV" -# endif -# ifdef PERL_MALLOC_WRAP - " PERL_MALLOC_WRAP" -# endif -# ifdef PERL_MEM_LOG - " PERL_MEM_LOG" -# endif -# ifdef PERL_MEM_LOG_NOIMPL - " PERL_MEM_LOG_NOIMPL" -# endif -# ifdef PERL_USE_DEVEL - " PERL_USE_DEVEL" -# endif -# ifdef PERL_USE_SAFE_PUTENV - " PERL_USE_SAFE_PUTENV" -# endif -# ifdef USE_SITECUSTOMIZE - " USE_SITECUSTOMIZE" -# endif -# ifdef USE_FAST_STDIO - " USE_FAST_STDIO" -# endif - , 0); - - sv_catpv(opts_prog, PL_bincompat_options); - /* Terminate the qw(, and then wrap at 76 columns. */ - sv_catpvs(opts_prog, "); s/(?=.{53})(.{1,53}) /$1\\n /mg;print Config::myconfig(),"); -#ifdef VMS - sv_catpvs(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n"); -#else - sv_catpvs(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n"); -#endif - sv_catpvs(opts_prog," Compile-time options: $_\\n\","); - -#if defined(LOCAL_PATCH_COUNT) - if (LOCAL_PATCH_COUNT > 0) { - int i; - sv_catpvs(opts_prog, - "\" Locally applied patches:\\n\","); - for (i = 1; i <= LOCAL_PATCH_COUNT; i++) { - if (PL_localpatches[i]) - Perl_sv_catpvf(aTHX_ opts_prog,"q%c\t%s\n%c,", - 0, PL_localpatches[i], 0); - } - } -#endif - Perl_sv_catpvf(aTHX_ opts_prog, - "\" Built under %s\\n",OSNAME); -#ifdef __DATE__ -# ifdef __TIME__ - sv_catpvs(opts_prog, - " Compiled at " __DATE__ " " __TIME__ "\\n\""); -# else - sv_catpvs(opts_prog, " Compiled on " __DATE__ "\\n\""); -# endif -#endif - sv_catpvs(opts_prog, "; $\"=\"\\n \"; " - "@env = map { \"$_=\\\"$ENV{$_}\\\"\" } " - "sort grep {/^PERL/} keys %ENV; "); -#ifdef __CYGWIN__ - sv_catpvs(opts_prog, - "push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";"); -#endif - sv_catpvs(opts_prog, - "print \" \\%ENV:\\n @env\\n\" if @env;" - "print \" \\@INC:\\n @INC\\n\";"); + opts_prog = newSVpvs("use Config; Config::_V()"); } else { ++s; opts_prog = Perl_newSVpvf(aTHX_ - "Config::config_vars(qw%c%s%c)", + "use Config; Config::config_vars(qw%c%s%c)", 0, s, 0); s += strlen(s); } - av_push(PL_preambleav, opts_prog); + Perl_av_create_and_push(aTHX_ &PL_preambleav, opts_prog); /* don't look for script or read stdin */ scriptname = BIT_BUCKET; goto reswitch; @@ -1940,7 +1947,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } } -#ifdef USE_SITECUSTOMIZE +#if defined(USE_SITECUSTOMIZE) && !defined(PERL_IS_MINIPERL) if (!minus_f) { /* SITELIB_EXP is a function call on Win32. The games with local $! are to avoid setting errno if there is no @@ -2021,6 +2028,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) boot_core_PerlIO(); boot_core_UNIVERSAL(); boot_core_mro(); + newXS("Internals::V", S_Internals_V, __FILE__); if (xsinit) (*xsinit)(aTHX); /* in case linked C routines want magical variables */ @@ -2052,6 +2060,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #if defined(__SYMBIAN32__) PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */ #endif +# ifndef PERL_IS_MINIPERL if (PL_unicode) { /* Requires init_predump_symbols(). */ if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) { @@ -2090,6 +2099,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } } } +#endif { const char *s; @@ -4055,6 +4065,10 @@ S_init_perllib(pTHX) #endif /* VMS */ } +#ifndef PERL_IS_MINIPERL + /* miniperl gets just -I..., the split of $ENV{PERL5LIB}, and "." in @INC + (and not the architecture specific directories from $ENV{PERL5LIB}) */ + /* Use the ~-expanded versions of APPLLIB (undocumented), ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB */ @@ -4185,6 +4199,7 @@ S_init_perllib(pTHX) INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS |INCPUSH_CAN_RELOCATE); #endif +#endif /* !PERL_IS_MINIPERL */ if (!PL_tainting) S_incpush(aTHX_ STR_WITH_LEN("."), 0);