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