util.h

   1 /*    util.h
   2  *
   3  *    Copyright (C) 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004, 2005,
   4  *    2007, by Larry Wall and others
   5  *
   6  *    You may distribute under the terms of either the GNU General Public
   7  *    License or the Artistic License, as specified in the README file.
   8  *
   9  */
  10
  11 #ifndef PERL_UTIL_H_
  12 #define PERL_UTIL_H_
  13
  14
  15 #ifdef VMS
  16 #  define PERL_FILE_IS_ABSOLUTE(f) \
  17         (*(f) == '/'                                                    \
  18          || (strchr(f,':')                                              \
  19              || ((*(f) == '[' || *(f) == '<')                           \
  20                  && (isWORDCHAR((f)[1]) || memCHRs("$-_]>",(f)[1])))))
  21
  22 #elif defined(WIN32) || defined(__CYGWIN__)
  23 #  define PERL_FILE_IS_ABSOLUTE(f) \
  24         (*(f) == '/' || *(f) == '\\'            /* UNC/rooted path */   \
  25          || ((f)[0] && (f)[1] == ':'))          /* drive name */
  26 #elif defined(DOSISH)
  27 #  define PERL_FILE_IS_ABSOLUTE(f) \
  28         (*(f) == '/'                                                    \
  29          || ((f)[0] && (f)[1] == ':'))          /* drive name */
  30 #else   /* NOT DOSISH */
  31 #  define PERL_FILE_IS_ABSOLUTE(f)      (*(f) == '/')
  32 #endif
  33
  34 /*
  35 =for apidoc_section $string
  36
  37 =for apidoc      ibcmp
  38 =for apidoc_item ibcmp_locale
  39 =for apidoc_item ibcmp_utf8
  40
  41 These return the complement of C<L</foldEQ>>, C<L</foldEQ_locale>>, and
  42 C<L</foldEQ_utf8>> respectively.  Those other names are preferred, as being
  43 clearer.
  44
  45 Hence, for example, C<ibcmp()> is S<C<(! foldEQ())>>
  46
  47 =cut
  48 */
  49 #define ibcmp(s1, s2, len)         cBOOL(! foldEQ(s1, s2, len))
  50 #define ibcmp_locale(s1, s2, len)  cBOOL(! foldEQ_locale(s1, s2, len))
  51 #define ibcmp_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \
  52                     cBOOL(! foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2))
  53
  54 /* outside the core, perl.h undefs HAS_QUAD if IV isn't 64-bit
  55    We can't swap this to HAS_QUAD, because the logic here affects the type of
  56    perl_drand48_t below, and that is visible outside of the core.  */
  57 #if defined(U64TYPE)
  58 /* use a faster implementation when quads are available */
  59 #    define PERL_DRAND48_QUAD
  60 #endif
  61
  62 #ifdef PERL_DRAND48_QUAD
  63
  64 /* U64 is only defined under PERL_CORE, but this needs to be visible
  65  * elsewhere so the definition of PerlInterpreter is complete.
  66  */
  67 typedef U64TYPE perl_drand48_t;
  68
  69 #else
  70
  71 struct PERL_DRAND48_T {
  72     U16 seed[3];
  73 };
  74
  75 typedef struct PERL_DRAND48_T perl_drand48_t;
  76
  77 #endif
  78
  79 #define PL_RANDOM_STATE_TYPE perl_drand48_t
  80
  81 #define Perl_drand48_init(seed) (Perl_drand48_init_r(&PL_random_state, (seed)))
  82 #define Perl_drand48() (Perl_drand48_r(&PL_random_state))
  83
  84 #ifdef PERL_CORE
  85 /* uses a different source of randomness to avoid interfering with the results
  86  * of rand() */
  87 #define Perl_internal_drand48() (Perl_drand48_r(&PL_internal_random_state))
  88 #endif
  89
  90 #ifdef USE_C_BACKTRACE
  91
  92 typedef struct {
  93     /* The number of frames returned. */
  94     UV frame_count;
  95     /* The total size of the Perl_c_backtrace, including this header,
  96      * the frames, and the name strings. */
  97     UV total_bytes;
  98 } Perl_c_backtrace_header;
  99
 100 typedef struct {
 101     void*  addr;  /* the program counter at this frame */
 102
 103     /* We could use Dl_info (as used by dladdr()) for many of these but
 104      * that would be naughty towards non-dlfcn systems (hi there, Win32). */
 105
 106     void*  symbol_addr; /* symbol address (hint: try symbol_addr - addr) */
 107     void*  object_base_addr;   /* base address of the shared object */
 108
 109     /* The offsets are from the beginning of the whole backtrace,
 110      * which makes the backtrace relocatable. */
 111     STRLEN object_name_offset; /* pathname of the shared object */
 112     STRLEN object_name_size;   /* length of the pathname */
 113     STRLEN symbol_name_offset; /* symbol name */
 114     STRLEN symbol_name_size;   /* length of the symbol name */
 115     STRLEN source_name_offset; /* source code file name */
 116     STRLEN source_name_size;   /* length of the source code file name */
 117     STRLEN source_line_number; /* source code line number */
 118
 119     /* OS X notes: atos(1) (more recently, "xcrun atos"), but the C
 120      * API atos() uses is unknown (private "Symbolicator" framework,
 121      * might require Objective-C even if the API would be known).
 122      * Currently we open read pipe to "xcrun atos" and parse the
 123      * output - quite disgusting.  And that won't work if the
 124      * Developer Tools isn't installed. */
 125
 126     /* FreeBSD notes: execinfo.h exists, but probably would need also
 127      * the library -lexecinfo.  BFD exists if the pkg devel/binutils
 128      * has been installed, but there seems to be a known problem that
 129      * the "bfd.h" getting installed refers to "ansidecl.h", which
 130      * doesn't get installed. */
 131
 132     /* Win32 notes: as moral equivalents of backtrace() + dladdr(),
 133      * one could possibly first use GetCurrentProcess() +
 134      * SymInitialize(), and then CaptureStackBackTrace() +
 135      * SymFromAddr(). */
 136
 137     /* Note that using the compiler optimizer easily leads into much
 138      * of this information, like the symbol names (think inlining),
 139      * and source code locations getting lost or confused.  In many
 140      * cases keeping the debug information (-g) is necessary.
 141      *
 142      * Note that for example with gcc you can do both -O and -g.
 143      *
 144      * Note, however, that on some platforms (e.g. OSX + clang (cc))
 145      * backtrace() + dladdr() works fine without -g. */
 146
 147     /* For example: the mere presence of <bfd.h> is no guarantee: e.g.
 148      * OS X has that, but BFD does not seem to work on the OSX executables.
 149      *
 150      * Another niceness would be to able to see something about
 151      * the function arguments, however gdb/lldb manage to do that. */
 152 } Perl_c_backtrace_frame;
 153
 154 typedef struct {
 155     Perl_c_backtrace_header header;
 156     Perl_c_backtrace_frame  frame_info[1];
 157     /* After the header come:
 158      * (1) header.frame_count frames
 159      * (2) frame_count times the \0-terminated strings (object_name
 160      * and so forth).  The frames contain the pointers to the starts
 161      * of these strings, and the lengths of these strings. */
 162 } Perl_c_backtrace;
 163
 164 #define Perl_free_c_backtrace(bt) Safefree(bt)
 165
 166 #endif /* USE_C_BACKTRACE */
 167
 168 /* Use a packed 32 bit constant "key" to start the handshake. The key defines
 169    ABI compatibility, and how to process the vararg list.
 170
 171    Note, some bits may be taken from INTRPSIZE (but then a simple x86 AX register
 172    can't be used to read it) and 4 bits from API version len can also be taken,
 173    since v00.00.00 is 9 bytes long. XS version length should not have any bits
 174    taken since XS_VERSION lengths can get quite long since they are user
 175    selectable. These spare bits allow for additional features for the varargs
 176    stuff or ABI compat test flags in the future.
 177 */
 178 #define HSm_APIVERLEN 0x0000001F /* perl version string won't be more than 31 chars */
 179 #define HS_APIVERLEN_MAX HSm_APIVERLEN
 180 #define HSm_XSVERLEN 0x0000FF00 /* if 0, not present, dont check, die if over 255*/
 181 #define HS_XSVERLEN_MAX 0xFF
 182 /* uses var file to set default filename for newXS_deffile to use for CvFILE */
 183 #define HSf_SETXSUBFN 0x00000020
 184 #define HSf_POPMARK 0x00000040 /* popmark mode or you must supply ax and items */
 185 #define HSf_IMP_CXT 0x00000080 /* ABI, threaded, MULTIPLICITY, pTHX_ present */
 186 #define HSm_INTRPSIZE 0xFFFF0000 /* ABI, interp struct size */
 187 /* A mask of bits in the key which must always match between a XS mod and interp.
 188    Also if all ABI bits in a key are true, skip all ABI checks, it is very
 189    the unlikely interp size will all 1 bits */
 190 /* Maybe HSm_APIVERLEN one day if Perl_xs_apiversion_bootcheck is changed to a memcmp */
 191 #define HSm_KEY_MATCH (HSm_INTRPSIZE|HSf_IMP_CXT)
 192 #define HSf_NOCHK HSm_KEY_MATCH  /* if all ABI bits are 1 in the key, dont chk */
 193
 194
 195 #define HS_GETINTERPSIZE(key) ((key) >> 16)
 196 /* if in the future "" and NULL must be separated, XSVERLEN would be 0
 197 means arg not present, 1 is empty string/null byte */
 198 /* (((key) & 0x0000FF00) >> 8) is less efficient on Visual C */
 199 #define HS_GETXSVERLEN(key) ((U8) ((key) >> 8))
 200 #define HS_GETAPIVERLEN(key) ((key) & HSm_APIVERLEN)
 201
 202 /* internal to util.h macro to create a packed handshake key, all args must be constants */
 203 /* U32 return = (U16 interpsize, bool cxt, bool setxsubfn, bool popmark,
 204    U5 (FIVE!) apiverlen, U8 xsverlen) */
 205 #define HS_KEYp(interpsize, cxt, setxsubfn, popmark, apiverlen, xsverlen) \
 206     (((interpsize)  << 16) \
 207     | ((xsverlen) > HS_XSVERLEN_MAX \
 208         ? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \
 209         : (xsverlen) << 8) \
 210     | (cBOOL(setxsubfn) ? HSf_SETXSUBFN : 0) \
 211     | (cBOOL(cxt) ? HSf_IMP_CXT : 0) \
 212     | (cBOOL(popmark) ? HSf_POPMARK : 0) \
 213     | ((apiverlen) > HS_APIVERLEN_MAX \
 214         ? (Perl_croak_nocontext("panic: handshake overflow"), HS_APIVERLEN_MAX) \
 215         : (apiverlen)))
 216 /* overflows above will optimize away unless they will execute */
 217
 218 /* public macro for core usage to create a packed handshake key but this is
 219    not public API. This more friendly version already collected all ABI info */
 220 /* U32 return = (bool setxsubfn, bool popmark, "litteral_string_api_ver",
 221    "litteral_string_xs_ver") */
 222 #ifdef MULTIPLICITY
 223 #  define HS_KEY(setxsubfn, popmark, apiver, xsver) \
 224     HS_KEYp(sizeof(PerlInterpreter), TRUE, setxsubfn, popmark, \
 225     sizeof("" apiver "")-1, sizeof("" xsver "")-1)
 226 #  define HS_CXT aTHX
 227 #else
 228 #  define HS_KEY(setxsubfn, popmark, apiver, xsver) \
 229     HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, setxsubfn, popmark, \
 230     sizeof("" apiver "")-1, sizeof("" xsver "")-1)
 231 #  define HS_CXT cv
 232 #endif
 233
 234 /*
 235 =for apidoc instr
 236 Same as L<strstr(3)>, which finds and returns a pointer to the first occurrence
 237 of the NUL-terminated substring C<little> in the NUL-terminated string C<big>,
 238 returning NULL if not found.  The terminating NUL bytes are not compared.
 239
 240 =cut
 241 */
 242
 243
 244 #define Perl_instr(haystack, needle) strstr(haystack, needle)
 245
 246 #ifdef HAS_MEMMEM
 247 #   define ninstr(big, bigend, little, lend)                                \
 248             (__ASSERT_(bigend >= big)                                       \
 249              __ASSERT_(lend >= little)                                      \
 250              (char *) memmem((big), (bigend) - (big),                       \
 251                              (little), (lend) - (little)))
 252 #else
 253 #   define ninstr(a,b,c,d) Perl_ninstr(a,b,c,d)
 254 #endif
 255
 256 #ifdef __Lynx__
 257 /* Missing proto on LynxOS */
 258 int mkstemp(char*);
 259 #endif
 260
 261 #ifdef PERL_CORE
 262 #   if defined(VMS)
 263 /* only useful for calls to our mkostemp() emulation */
 264 #       define O_VMS_DELETEONCLOSE 0x40000000
 265 #       ifdef HAS_MKOSTEMP
 266 #           error 134221 will need a new solution for VMS
 267 #       endif
 268 #   else
 269 #       define O_VMS_DELETEONCLOSE 0
 270 #   endif
 271 #endif
 272 #if defined(HAS_MKOSTEMP) && defined(PERL_CORE)
 273 #   define Perl_my_mkostemp(templte, flags) mkostemp(templte, flags)
 274 #endif
 275 #if defined(HAS_MKSTEMP) && defined(PERL_CORE)
 276 #   define Perl_my_mkstemp(templte) mkstemp(templte)
 277 #endif
 278
 279 #endif /* PERL_UTIL_H_ */
 280
 281 /*
 282  * ex: set ts=8 sts=4 sw=4 et:
 283  */