int putenv(char *);
#endif
+#ifdef __amigaos__
+# include "amigaos4/amigaio.h"
+#endif
+
#ifdef HAS_SELECT
# ifdef I_SYS_SELECT
# include <sys/select.h>
PERL_ARGS_ASSERT_INSTR;
- /* libc prior to 4.6.27 (late 1994) did not work properly on a NULL
- * 'little' */
- if (!little)
- return (char*)big;
return strstr((char*)big, (char*)little);
}
=for apidoc fbm_compile
-Analyses the string in order to make fast searches on it using fbm_instr()
+Analyses the string in order to make fast searches on it using C<fbm_instr()>
-- the Boyer-Moore algorithm.
=cut
Returns the location of the SV in the string delimited by C<big> and
C<bigend>. It returns C<NULL> if the string can't be found. The C<sv>
-does not have to be fbm_compiled, but the search will not be as fast
+does not have to be C<fbm_compiled>, but the search will not be as fast
then.
=cut
/*
=for apidoc foldEQ
-Returns true if the leading len bytes of the strings s1 and s2 are the same
+Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
+same
case-insensitively; false otherwise. Uppercase and lowercase ASCII range bytes
match themselves and their opposite case counterparts. Non-cased and non-ASCII
range bytes match only themselves.
/*
=for apidoc foldEQ_locale
-Returns true if the leading len bytes of the strings s1 and s2 are the same
-case-insensitively in the current locale; false otherwise.
+Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
+same case-insensitively in the current locale; false otherwise.
=cut
*/
=for apidoc savesharedpvn
A version of C<savepvn()> which allocates the duplicate string in memory
-which is shared between threads. (With the specific difference that a NULL
+which is shared between threads. (With the specific difference that a C<NULL>
pointer is not acceptable)
=cut
=for apidoc Am|SV *|vmess|const char *pat|va_list *args
C<pat> and C<args> are a sprintf-style format pattern and encapsulated
-argument list. These are used to generate a string message. If the
+argument list, respectively. These are used to generate a string message. If
+the
message does not end with a newline, then it will be extended with
some indication of the current location in the code, as described for
L</mess_sv>.
SV *exarg;
ENTER;
+ save_re_context();
if (warn) {
SAVESPTR(*hook);
*hook = NULL;
{
dVAR;
PERL_ARGS_ASSERT_VWARNER;
- if (PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) {
+ if (
+ (PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) &&
+ !(PL_in_eval & EVAL_KEEPERR)
+ ) {
SV * const msv = vmess(pat, args);
if (PL_parser && PL_parser->error_count) {
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
dVAR;
+#if defined(__amigaos4__)
+ amigaos4_obtain_environ(__FUNCTION__);
+#endif
#ifdef USE_ITHREADS
/* only parent thread can modify process environment */
if (PL_curinterp == aTHX)
environ[i] = environ[i+1];
i++;
}
+#if defined(__amigaos4__)
+ goto my_setenv_out;
+#else
return;
+#endif
}
if (!environ[i]) { /* does not exist yet */
environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
}
#endif
}
+#if defined(__amigaos4__)
+my_setenv_out:
+ amigaos4_release_environ(__FUNCTION__);
+#endif
}
#else /* WIN32 || NETWARE */
/* Close parent's end of error status pipe (if any) */
if (did_pipes) {
PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
/* Close error pipe automatically if exec works */
if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
return NULL;
pid = fork();
#endif
return pid;
+#elif defined(__amigaos4__)
+ return amigaos_fork();
#else
/* this "canna happen" since nothing should be calling here if !HAS_FORK */
Perl_croak_nocontext("fork() not available");
=for apidoc getcwd_sv
-Fill the sv with current working directory
+Fill C<sv> with current working directory
=cut
*/
Dummy routine which "shares" an SV when there is no sharing module present.
Or "locks" it. Or "unlocks" it. In other
words, ignores its single SV argument.
-Exists to avoid test for a NULL function pointer and because it could
+Exists to avoid test for a C<NULL> function pointer and because it could
potentially warn under some level of strict-ness.
=cut
Dummy routine which reports that object can be destroyed when there is no
sharing module present. It ignores its single SV argument, and returns
-'true'. Exists to avoid test for a NULL function pointer and because it
+'true'. Exists to avoid test for a C<NULL> function pointer and because it
could potentially warn under some level of strict-ness.
=cut
if (isDIGIT(*p)) {
const char* endptr;
UV uv;
- if (grok_atoUV(p, &uv, &endptr)
- && uv <= U32_MAX
- && (p = endptr)
- && *p && *p != '\n' && *p != '\r'
- ) {
+ if (grok_atoUV(p, &uv, &endptr) && uv <= U32_MAX) {
opt = (U32)uv;
- if (isSPACE(*p))
- goto the_end_of_the_opts_parser;
- else
- Perl_croak(aTHX_ "Unknown Unicode option letter '%c'", *p);
+ p = endptr;
+ if (p && *p && *p != '\n' && *p != '\r') {
+ if (isSPACE(*p))
+ goto the_end_of_the_opts_parser;
+ else
+ Perl_croak(aTHX_ "Unknown Unicode option letter '%c'", *p);
+ }
}
}
else {
int fd;
#endif
U32 u;
-#ifdef VMS
- /* when[] = (low 32 bits, high 32 bits) of time since epoch
- * in 100-ns units, typically incremented ever 10 ms. */
- unsigned int when[2];
-#else
-# ifdef HAS_GETTIMEOFDAY
+#ifdef HAS_GETTIMEOFDAY
struct timeval when;
-# else
+#else
Time_t when;
-# endif
#endif
/* This test is an escape hatch, this symbol isn't set by Configure. */
}
#endif
-#ifdef VMS
- _ckvmssts(sys$gettim(when));
- u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
-#else
-# ifdef HAS_GETTIMEOFDAY
+#ifdef HAS_GETTIMEOFDAY
PerlProc_gettimeofday(&when,NULL);
u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
-# else
+#else
(void)time(&when);
u = (U32)SEED_C1 * when;
-# endif
#endif
u += SEED_C3 * (U32)PerlProc_getpid();
u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
/*
=for apidoc quadmath_format_single
-quadmath_snprintf() is very strict about its format string and will
-fail, returning -1, if the format is invalid. It acccepts exactly
+C<quadmath_snprintf()> is very strict about its C<format> string and will
+fail, returning -1, if the format is invalid. It accepts exactly
one format spec.
-quadmath_format_single() checks that the intended single spec looks
+C<quadmath_format_single()> checks that the intended single spec looks
sane: begins with C<%>, has only one C<%>, ends with C<[efgaEFGA]>,
and has C<Q> before it. This is not a full "printf syntax check",
just the basics.
Returns the format if it is valid, NULL if not.
-quadmath_format_single() can and will actually patch in the missing
+C<quadmath_format_single()> can and will actually patch in the missing
C<Q>, if necessary. In this case it will return the modified copy of
the format, B<which the caller will need to free.>
/*
=for apidoc quadmath_format_needed
-quadmath_format_needed() returns true if the format string seems to
-contain at least one non-Q-prefixed %[efgaEFGA] format specifier,
+C<quadmath_format_needed()> returns true if the C<format> string seems to
+contain at least one non-Q-prefixed C<%[efgaEFGA]> format specifier,
or returns false otherwise.
The format specifier detection is not complete printf-syntax detection,
but it should catch most common cases.
If true is returned, those arguments B<should> in theory be processed
-with quadmath_snprintf(), but in case there is more than one such
+with C<quadmath_snprintf()>, but in case there is more than one such
format specifier (see L</quadmath_format_single>), and if there is
anything else beyond that one (even just a single byte), they
-B<cannot> be processed because quadmath_snprintf() is very strict,
+B<cannot> be processed because C<quadmath_snprintf()> is very strict,
accepting only one format spec, and nothing else.
In this case, the code should probably fail.
SAVEPPTR(PL_xsubfilename);/* which was require'd from a XSUB BEGIN */
PL_xsubfilename = file; /* so the old name must be restored for
additional XSUBs to register themselves */
- (void)gv_fetchfile(file);
+ /* XSUBs can't be perl lang/perl5db.pl debugged
+ if (PERLDB_LINE_OR_SAVESRC)
+ (void)gv_fetchfile(file); */
}
if(key & HSf_POPMARK) {
PERL_ARGS_ASSERT_DRAND48_INIT_R;
#ifdef PERL_DRAND48_QUAD
- *random_state = FREEBSD_DRAND48_SEED_0 + ((U64TYPE)seed << 16);
+ *random_state = FREEBSD_DRAND48_SEED_0 + ((U64)seed << 16);
#else
random_state->seed[0] = FREEBSD_DRAND48_SEED_0;
random_state->seed[1] = (U16) seed;
=for apidoc get_c_backtrace
Collects the backtrace (aka "stacktrace") into a single linear
-malloced buffer, which the caller B<must> Perl_free_c_backtrace().
+malloced buffer, which the caller B<must> C<Perl_free_c_backtrace()>.
-Scans the frames back by depth + skip, then drops the skip innermost,
-returning at most depth frames.
+Scans the frames back by S<C<depth + skip>>, then drops the C<skip> innermost,
+returning at most C<depth> frames.
=cut
*/
/*
=for apidoc get_c_backtrace_dump
-Returns a SV a dump of |depth| frames of the call stack, skipping
-the |skip| innermost ones. depth of 20 is usually enough.
+Returns a SV containing a dump of C<depth> frames of the call stack, skipping
+the C<skip> innermost ones. C<depth> of 20 is usually enough.
The appended output looks like:
The fields are tab-separated. The first column is the depth (zero
being the innermost non-skipped frame). In the hex:offset, the hex is
-where the program counter was in S_parse_body, and the :offset (might
-be missing) tells how much inside the S_parse_body the program counter was.
+where the program counter was in C<S_parse_body>, and the :offset (might
+be missing) tells how much inside the C<S_parse_body> the program counter was.
-The util.c:1716 is the source code file and line number.
+The C<util.c:1716> is the source code file and line number.
-The /usr/bin/perl is obvious (hopefully).
+The F</usr/bin/perl> is obvious (hopefully).
Unknowns are C<"-">. Unknowns can happen unfortunately quite easily:
if the platform doesn't support retrieving the information;
/*
=for apidoc dump_c_backtrace
-Dumps the C backtrace to the given fp.
+Dumps the C backtrace to the given C<fp>.
Returns true if a backtrace could be retrieved, false if not.
#endif /* #ifdef USE_C_BACKTRACE */
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff