taint_proper(NULL, s); \
}
# define TAINT_set(s) (PL_tainted = (s))
-# define TAINT_get (PL_tainted)
+# define TAINT_get (PL_tainted) /* Is something tainted? */
# define TAINTING_get (PL_tainting) /* Is taint checking enabled? */
# define TAINTING_set(s) (PL_tainting = (s))
# define TAINT_WARN_get (PL_taint_warn) /* FALSE => tainting violations
#include <sys/types.h>
-/* EVC 4 SDK headers includes a bad definition of MB_CUR_MAX in stdlib.h
- which is included from stdarg.h. Bad definition not present in SD 2008
- SDK headers. wince.h is not yet included, so we cant fix this from there
- since by then MB_CUR_MAX will be defined from stdlib.h.
- cewchar.h includes a correct definition of MB_CUR_MAX and it is copied here
- since cewchar.h can't be included this early */
-#if defined(UNDER_CE) && (_MSC_VER < 1300)
-# define MB_CUR_MAX 1uL
-#endif
-
# include <stdarg.h>
#ifdef I_STDINT
EXTERN_C char *crypt(const char *, const char *);
#endif
+/*
+=head1 Errno
+
+=for apidoc m|void|SETERRNO|int errcode|int vmserrcode
+
+Set C<errno>, and on VMS set C<vaxc$errno>.
+
+=for apidoc mn|void|dSAVEDERRNO
+
+Declare variables needed to save C<errno> and any operating system
+specific error number.
+
+=for apidoc mn|void|dSAVE_ERRNO
+
+Declare variables needed to save C<errno> and any operating system
+specific error number, and save them for optional later restoration
+by C<RESTORE_ERRNO>.
+
+=for apidoc mn|void|SAVE_ERRNO
+
+Save C<errno> and any operating system specific error number for
+optional later restoration by C<RESTORE_ERRNO>. Requires
+C<dSAVEDERRNO> or C<dSAVE_ERRNO> in scope.
+
+=for apidoc mn|void|RESTORE_ERRNO
+
+Restore C<errno> and any operating system specific error number that
+was saved by C<dSAVE_ERRNO> or C<RESTORE_ERRNO>.
+
+=cut
+*/
+
#ifdef SETERRNO
# undef SETERRNO /* SOCKS might have defined this */
#endif
# define RESTORE_ERRNO (errno = saved_errno)
#endif
+/*
+=head1 Warning and Dieing
+
+=for apidoc Amn|SV *|ERRSV
+
+Returns the SV for C<$@>, creating it if needed.
+
+=for apidoc Am|void|CLEAR_ERRSV
+
+Clear the contents of C<$@>, setting it to the empty string.
+
+This replaces any read-only SV with a fresh SV and removes any magic.
+
+=for apidoc Am|void|SANE_ERRSV
+
+Clean up ERRSV so we can safely set it.
+
+This replaces any read-only SV with a fresh writable copy and removes
+any magic.
+
+=cut
+*/
+
#define ERRSV GvSVn(PL_errgv)
/* contains inlined gv_add_by_type */
} \
} STMT_END
+/* contains inlined gv_add_by_type */
+#define SANE_ERRSV() STMT_START { \
+ SV ** const svp = &GvSV(PL_errgv); \
+ if (!*svp) { \
+ *svp = newSVpvs(""); \
+ } else if (SvREADONLY(*svp)) { \
+ SV *dupsv = newSVsv(*svp); \
+ SvREFCNT_dec_NN(*svp); \
+ *svp = dupsv; \
+ } else { \
+ SV *const errsv = *svp; \
+ if (SvMAGICAL(errsv)) { \
+ mg_free(errsv); \
+ } \
+ } \
+ } STMT_END
+
#ifdef PERL_CORE
# define DEFSV (0 + GvSVn(PL_defgv))
/* This used to be conditionally defined based on whether we had a sprintf()
* that correctly returns the string length (as required by C89), but we no
* longer need that. XS modules can (and do) use this name, so it must remain
- * a part of the API that's visible to modules. But we no longer document it
- * either (because using sprintf() rather than snprintf() is almost always
- * a bad idea). */
+ * a part of the API that's visible to modules.
+
+=head1 Miscellaneous Functions
+
+=for apidoc ATmD|int|my_sprintf|NN char *buffer|NN const char *pat|...
+
+Do NOT use this due to the possibility of overflowing C<buffer>. Instead use
+my_snprintf()
+
+=cut
+*/
#define my_sprintf sprintf
/*
#ifdef HAS_STRLCAT
# define my_strlcat strlcat
-#else
-# define my_strlcat Perl_my_strlcat
#endif
#if defined(PERL_CORE) || defined(PERL_EXT)
#ifdef HAS_STRLCPY
# define my_strlcpy strlcpy
-#else
-# define my_strlcpy Perl_my_strlcpy
#endif
#ifdef HAS_STRNLEN
# define my_strnlen strnlen
-#else
-# define my_strnlen Perl_my_strnlen
#endif
/*
(Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x))
#endif
-#ifdef UNDER_CE
-int isnan(double d);
-#endif
-
#ifndef Perl_isnan
# ifdef Perl_fp_class_nan
# define Perl_isnan(x) Perl_fp_class_nan(x)
#else
# define EXPECT(expr,val) (expr)
#endif
+
+/*
+=head1 Miscellaneous Functions
+
+=for apidoc AmU|bool|LIKELY|const bool expr
+
+Returns the input unchanged, but at the same time it gives a branch prediction
+hint to the compiler that this condition is likely to be true.
+
+=for apidoc AmU|bool|UNLIKELY|const bool expr
+
+Returns the input unchanged, but at the same time it gives a branch prediction
+hint to the compiler that this condition is likely to be false.
+
+=cut
+*/
#define LIKELY(cond) EXPECT(cBOOL(cond),TRUE)
#define UNLIKELY(cond) EXPECT(cBOOL(cond),FALSE)
+
#ifdef HAS_BUILTIN_CHOOSE_EXPR
/* placeholder */
#endif
# define NOT_REACHED
#elif defined(DEBUGGING) && (__has_builtin(__builtin_unreachable) \
|| (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4)) /* 4.5 -> */
-# define NOT_REACHED STMT_START { ASSUME(0); __builtin_unreachable(); } STMT_END
+# define NOT_REACHED STMT_START { ASSUME(!"UNREACHABLE"); __builtin_unreachable(); } STMT_END
#else
-# define NOT_REACHED ASSUME(0)
+# define NOT_REACHED ASSUME(!"UNREACHABLE")
#endif
/* Some unistd.h's give a prototype for pause() even though
#endif
#ifndef __cplusplus
-#if !(defined(WIN32) || defined(UNDER_CE) || defined(SYMBIAN))
+#if !(defined(WIN32) || defined(SYMBIAN))
Uid_t getuid (void);
Uid_t geteuid (void);
Gid_t getgid (void);
# define IN_SOME_LOCALE_FORM_COMPILETIME \
cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
+/*
+=head1 Locale-related functions and macros
+
+=for apidoc Amn|bool|IN_LOCALE
+
+Evaluates to TRUE if the plain locale pragma without a parameter (S<C<use
+locale>>) is in effect.
+
+=for apidoc Amn|bool|IN_LOCALE_COMPILETIME
+
+Evaluates to TRUE if, when compiling a perl program (including an C<eval>) if
+the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
+
+=for apidoc Amn|bool|IN_LOCALE_RUNTIME
+
+Evaluates to TRUE if, when executing a perl program (including an C<eval>) if
+the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
+
+=cut
+*/
+
# define IN_LOCALE \
(IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
# define IN_SOME_LOCALE_FORM \
On threaded perls not operating with thread-safe functionality, this macro uses
a mutex to force a critical section. Therefore the matching RESTORE should be
-close by, and guaranteed to be called.
+close by, and guaranteed to be called; see L</WITH_LC_NUMERIC_SET_TO_NEEDED>
+for a more contained way to ensure that.
+
+=for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric
+
+Same as L</STORE_LC_NUMERIC_SET_TO_NEEDED> with in_lc_numeric provided
+as the precalculated value of C<IN_LC(LC_NUMERIC)>. It is the caller's
+responsibility to ensure that the status of C<PL_compiling> and C<PL_hints>
+cannot have changed since the precalculation.
=for apidoc Am|void|RESTORE_LC_NUMERIC
...
}
+=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED
+
+This macro invokes the supplied statement or block within the context
+of a L</STORE_LC_NUMERIC_SET_TO_NEEDED> .. L</RESTORE_LC_NUMERIC> pair
+if required, so eg:
+
+ WITH_LC_NUMERIC_SET_TO_NEEDED(
+ SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis)
+ );
+
+is equivalent to:
+
+ {
+#ifdef USE_LOCALE_NUMERIC
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+#endif
+ SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis);
+#ifdef USE_LOCALE_NUMERIC
+ RESTORE_LC_NUMERIC();
+#endif
+ }
+
+=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric
+
+Same as L</WITH_LC_NUMERIC_SET_TO_NEEDED> with in_lc_numeric provided
+as the precalculated value of C<IN_LC(LC_NUMERIC)>. It is the caller's
+responsibility to ensure that the status of C<PL_compiling> and C<PL_hints>
+cannot have changed since the precalculation.
+
=cut
*/
# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \
void (*_restore_LC_NUMERIC_function)(pTHX) = NULL
-# define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in) \
STMT_START { \
+ bool _in_lc_numeric = (in); \
LC_NUMERIC_LOCK( \
- ( ( IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_UNDERLYING) \
- || (! IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_STANDARD)));\
- if (IN_LC(LC_NUMERIC)) { \
+ ( ( _in_lc_numeric && _NOT_IN_NUMERIC_UNDERLYING) \
+ || (! _in_lc_numeric && _NOT_IN_NUMERIC_STANDARD))); \
+ if (_in_lc_numeric) { \
if (_NOT_IN_NUMERIC_UNDERLYING) { \
Perl_set_numeric_underlying(aTHX); \
_restore_LC_NUMERIC_function \
} \
} STMT_END
+# define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ STORE_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC))
+
# define RESTORE_LC_NUMERIC() \
STMT_START { \
if (_restore_LC_NUMERIC_function) { \
__FILE__, __LINE__, PL_numeric_standard)); \
} STMT_END
+# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \
+ STMT_START { \
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \
+ STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric); \
+ block; \
+ RESTORE_LC_NUMERIC(); \
+ } STMT_END;
+
+# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \
+ WITH_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC), block)
+
#else /* !USE_LOCALE_NUMERIC */
# define SET_NUMERIC_STANDARD()
# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION
# define STORE_LC_NUMERIC_SET_STANDARD()
# define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING()
+# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric)
# define STORE_LC_NUMERIC_SET_TO_NEEDED()
# define RESTORE_LC_NUMERIC()
# define LOCK_LC_NUMERIC_STANDARD()
# define UNLOCK_LC_NUMERIC_STANDARD()
+# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \
+ STMT_START { block; } STMT_END
+# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \
+ STMT_START { block; } STMT_END
#endif /* !USE_LOCALE_NUMERIC */
#define Atof my_atof
+
+/*
+
+=head1 Numeric functions
+
+=for apidoc AmTR|NV|Strtod|NN const char * const s|NULLOK char ** e
+
+This is a synonym for L</my_strtod>.
+
+=for apidoc AmTR|NV|Strtol|NN const char * const s|NULLOK char ** e|int base
+
+Platform and configuration independent C<strtol>. This expands to the
+appropriate C<strotol>-like function based on the platform and F<Configure>
+options>. For example it could expand to C<strtoll> or C<strtoq> instead of
+C<strtol>.
+
+=for apidoc AmTR|NV|Strtoul|NN const char * const s|NULLOK char ** e|int base
+
+Platform and configuration independent C<strtoul>. This expands to the
+appropriate C<strotoul>-like function based on the platform and F<Configure>
+options>. For example it could expand to C<strtoull> or C<strtouq> instead of
+C<strtoul>.
+
+=cut
+
+*/
+
#define Strtod my_strtod
#if defined(HAS_STRTOD) \
#define IS_NUMBER_NAN 0x20 /* this is not */
#define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */
+/*
+=head1 Numeric functions
+
+=for apidoc AmdR|bool|GROK_NUMERIC_RADIX|NN const char **sp|NN const char *send
+
+A synonym for L</grok_numeric_radix>
+
+=cut
+*/
#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
/* Input flags: */
#define PERL_GPROF_MONCONTROL(x)
#endif
-#ifdef UNDER_CE
-#include "wince.h"
-#endif
-
/* ISO 6429 NEL - C1 control NExt Line */
/* See http://www.unicode.org/unicode/reports/tr13/ */
#define NEXT_LINE_CHAR NEXT_LINE_NATIVE
#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
-/* Use instead of abs() since abs() forces its argument to be an int,
- * but also beware since this evaluates its argument twice, so no x++. */
+/*
+=head1 Numeric functions
+
+=for apidoc Am|int|PERL_ABS|int
+
+Typeless C<abs> or C<fabs>, I<etc>. (The usage below indicates it is for
+integers, but it works for any type.) Use instead of these, since the C
+library ones force their argument to be what it is expecting, potentially
+leading to disaster. But also beware that this evaluates its argument twice,
+so no C<x++>.
+
+=cut
+*/
+
#define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
#if defined(__DECC) && defined(__osf__)
https://perl5.git.perl.org / perl5.git / blobdiff