*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
* 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
- * 2013, 2014, 2015, 2016 by Larry Wall and others
+ * 2013, 2014, 2015, 2016, 2017 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#ifdef USE_REENTRANT_API
Perl_reentrant_init(aTHX);
#endif
-#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
- /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0
- * This MUST be done before any hash stores or fetches take place.
- * If you set PL_hash_seed (and presumably also PL_hash_seed_set)
- * yourself, it is your responsibility to provide a good random seed!
- * You can also define PERL_HASH_SEED in compile time, see hv.h.
- *
- * XXX: fix this comment */
if (PL_hash_seed_set == FALSE) {
+ /* Initialize the hash seed and state at startup. This must be
+ * done very early, before ANY hashes are constructed, and once
+ * setup is fixed for the lifetime of the process.
+ *
+ * If you decide to disable the seeding process you should choose
+ * a suitable seed yourself and define PERL_HASH_SEED to a well chosen
+ * string. See hv_func.h for details.
+ */
+#if defined(USE_HASH_SEED)
+ /* get the hash seed from the environment or from an RNG */
Perl_get_hash_seed(aTHX_ PL_hash_seed);
+#else
+ /* they want a hard coded seed, check that it is long enough */
+ assert( strlen(PERL_HASH_SEED) >= PERL_HASH_SEED_BYTES );
+#endif
+
+ /* now we use the chosen seed to initialize the state -
+ * in some configurations this may be a relatively speaking
+ * expensive operation, but we only have to do it once at startup */
+ PERL_HASH_SEED_STATE(PERL_HASH_SEED,PL_hash_state);
+
+#ifdef PERL_USE_SINGLE_CHAR_HASH_CACHE
+ /* we can build a special cache for 0/1 byte keys, if people choose
+ * I suspect most of the time it is not worth it */
+ {
+ char str[2]="\0";
+ int i;
+ for (i=0;i<256;i++) {
+ str[0]= i;
+ PERL_HASH_WITH_STATE(PL_hash_state,PL_hash_chars[i],str,1);
+ }
+ PERL_HASH_WITH_STATE(PL_hash_state,PL_hash_chars[256],str,0);
+ }
+#endif
+ /* at this point we have initialezed the hash function, and we can start
+ * constructing hashes */
PL_hash_seed_set= TRUE;
}
-#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
-
/* Note that strtab is a rather special HV. Assumptions are made
about not iterating on it, and not adding tie magic to it.
It is properly deallocated in perl_destruct() */
PL_strtab = newHV();
+ /* SHAREKEYS tells us that the hash has its keys shared with PL_strtab,
+ * which is not the case with PL_strtab itself */
HvSHAREKEYS_off(PL_strtab); /* mandatory */
- hv_ksplit(PL_strtab, 512);
+ hv_ksplit(PL_strtab, 1 << 11);
Zero(PL_sv_consts, SV_CONSTS_COUNT, SV*);
PL_SB_invlist = _new_invlist_C_array(_Perl_SB_invlist);
PL_WB_invlist = _new_invlist_C_array(_Perl_WB_invlist);
PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
+ PL_Assigned_invlist = _new_invlist_C_array(Assigned_invlist);
#ifdef USE_THREAD_SAFE_LOCALE
PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", NULL);
#endif
PerlIO_printf(Perl_debug_log, "Trace of all OPs executed:\n");
for (i = 0; i <= OP_max; ++i) {
if (PL_op_exec_cnt[i])
- PerlIO_printf(Perl_debug_log, " %s: %"UVuf"\n", PL_op_name[i], PL_op_exec_cnt[i]);
+ PerlIO_printf(Perl_debug_log, " %s: %" UVuf "\n", PL_op_name[i], PL_op_exec_cnt[i]);
}
/* Utility slot for easily doing little tracing experiments in the runloop: */
if (PL_op_exec_cnt[OP_max+1] != 0)
- PerlIO_printf(Perl_debug_log, " SPECIAL: %"UVuf"\n", PL_op_exec_cnt[OP_max+1]);
+ PerlIO_printf(Perl_debug_log, " SPECIAL: %" UVuf "\n", PL_op_exec_cnt[OP_max+1]);
PerlIO_printf(Perl_debug_log, "\n");
no_trace_out:
#endif
PL_LB_invlist = NULL;
PL_SB_invlist = NULL;
PL_WB_invlist = NULL;
+ PL_Assigned_invlist = NULL;
if (!specialWARN(PL_compiling.cop_warnings))
PerlMemShared_free(PL_compiling.cop_warnings);
PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
" flags=0x%"UVxf
" refcnt=%"UVuf pTHX__FORMAT "\n"
- "\tallocated at %s:%d %s %s (parent 0x%"UVxf");"
- "serial %"UVuf"\n",
+ "\tallocated at %s:%d %s %s (parent 0x%" UVxf ");"
+ "serial %" UVuf "\n",
(void*)sv, (UV)sv->sv_flags, (UV)sv->sv_refcnt
pTHX__VALUE,
sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
#ifndef MULTIPLICITY
PERL_UNUSED_ARG(my_perl);
#endif
-#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) || defined(USE_HASH_SEED_DEBUG)
+#if (defined(USE_HASH_SEED) || defined(USE_HASH_SEED_DEBUG)) && !defined(NO_PERL_HASH_SEED_DEBUG)
{
const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
PerlIO_printf(Perl_debug_log, "\n");
}
}
-#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
+#endif /* #if (defined(USE_HASH_SEED) ... */
#ifdef __amigaos4__
{
* the original argv[0]. (See below for 'contiguous', though.)
* --jhi */
const char *s = NULL;
- int i;
const UV mask = ~(UV)(PTRSIZE-1);
/* Do the mask check only if the args seem like aligned. */
const UV aligned =
* like the argv[] interleaved with some other data, we are
* fine. (Did I just evoke Murphy's Law?) --jhi */
if (PL_origargv && PL_origargc >= 1 && (s = PL_origargv[0])) {
+ int i;
while (*s) s++;
for (i = 1; i < PL_origargc; i++) {
if ((PL_origargv[i] == s + 1
INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
)
{
+ int i;
#ifndef OS2 /* ENVIRON is read by the kernel too. */
s = PL_origenviron[0];
while (*s) s++;
# ifdef USE_FAST_STDIO
" USE_FAST_STDIO"
# endif
-# ifdef USE_HASH_SEED_EXPLICIT
- " USE_HASH_SEED_EXPLICIT"
-# endif
# ifdef USE_LOCALE
" USE_LOCALE"
# endif
it should be reported immediately as a build failure. */
(void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
Perl_newSVpvf(aTHX_
- "BEGIN { my $f = q%c%s%"SVf"/buildcustomize.pl%c; "
+ "BEGIN { my $f = q%c%s%" SVf "/buildcustomize.pl%c; "
"do {local $!; -f $f }"
" and do $f || die $@ || qq '$f: $!' }",
0, (TAINTING_get ? "./" : ""), SVfARG(*inc0), 0));
SETERRNO(0,SS_NORMAL);
if (yyparse(GRAMPROG) || PL_parser->error_count) {
- if (PL_minus_c)
- Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
- else {
- Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
- PL_origfilename);
- }
+ abort_execution("", PL_origfilename);
}
CopLINE_set(PL_curcop, 0);
SET_CURSTASH(PL_defstash);
"\nThis is perl " STRINGIFY(PERL_REVISION)
", version " STRINGIFY(PERL_VERSION)
", subversion " STRINGIFY(PERL_SUBVERSION)
- " (%"SVf") built for " ARCHNAME, SVfARG(level)
+ " (%" SVf ") built for " ARCHNAME, SVfARG(level)
);
SvREFCNT_dec_NN(level);
}
#endif
PerlIO_printf(PIO_stdout,
- "\n\nCopyright 1987-2016, Larry Wall\n");
+ "\n\nCopyright 1987-2017, Larry Wall\n");
#ifdef MSDOS
PerlIO_printf(PIO_stdout,
"\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
if (!rsfp) {
/* PSz 16 Sep 03 Keep neat error message */
if (PL_e_script)
- Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno));
+ Perl_croak(aTHX_ "Can't open " BIT_BUCKET ": %s\n", Strerror(errno));
else
Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
CopFILE(PL_curcop), Strerror(errno));
while (PL_scopestack_ix > oldscope)
LEAVE;
JMPENV_POP;
- Perl_croak(aTHX_ "%"SVf"", SVfARG(atsv));
+ Perl_croak(aTHX_ "%" SVf, SVfARG(atsv));
}
break;
case 1:
https://perl5.git.perl.org / perl5.git / blobdiff