[perl5.git] / util.h

/*    util.h
 *
 *    Copyright (C) 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004, 2005,
 *    2007, 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 VMS
#  define PERL_FILE_IS_ABSOLUTE(f) \
	(*(f) == '/'							\
	 || (strchr(f,':')						\
	     || ((*(f) == '[' || *(f) == '<')				\
		 && (isWORDCHAR((f)[1]) || strchr("$-_]>",(f)[1])))))

#else		/* !VMS */
#  if defined(WIN32) || defined(__CYGWIN__)
#    define PERL_FILE_IS_ABSOLUTE(f) \
	(*(f) == '/' || *(f) == '\\'		/* UNC/rooted path */	\
	 || ((f)[0] && (f)[1] == ':'))		/* drive name */
#  else		/* !WIN32 */
#  ifdef NETWARE
#    define PERL_FILE_IS_ABSOLUTE(f) \
	(((f)[0] && (f)[1] == ':')		/* drive name */	\
	 || ((f)[0] == '\\' && (f)[1] == '\\')	/* UNC path */	\
	 ||	((f)[3] == ':'))				/* volume name, currently only sys */
#  else		/* !NETWARE */
#    if defined(DOSISH) || defined(__SYMBIAN32__)
#      define PERL_FILE_IS_ABSOLUTE(f) \
	(*(f) == '/'							\
	 || ((f)[0] && (f)[1] == ':'))		/* drive name */
#    else	/* NEITHER DOSISH NOR SYMBIANISH */
#      define PERL_FILE_IS_ABSOLUTE(f)	(*(f) == '/')
#    endif	/* DOSISH */
#   endif	/* NETWARE */
#  endif	/* WIN32 */
#endif		/* VMS */

/*
=head1 Miscellaneous Functions

=for apidoc ibcmp

This is a synonym for (! foldEQ())

=for apidoc ibcmp_locale

This is a synonym for (! foldEQ_locale())

=cut
*/
#define ibcmp(s1, s2, len)         cBOOL(! foldEQ(s1, s2, len))
#define ibcmp_locale(s1, s2, len)  cBOOL(! foldEQ_locale(s1, s2, len))

/* outside the core, perl.h undefs HAS_QUAD if IV isn't 64-bit
   We can't swap this to HAS_QUAD, because the logic here affects the type of
   perl_drand48_t below, and that is visible outside of the core.  */
#if defined(U64TYPE) && !defined(USING_MSVC6)
/* use a faster implementation when quads are available,
 * but not with VC6 on Windows */
#    define PERL_DRAND48_QUAD
#endif

#ifdef PERL_DRAND48_QUAD

/* U64 is only defined under PERL_CORE, but this needs to be visible
 * elsewhere so the definition of PerlInterpreter is complete.
 */
typedef U64TYPE perl_drand48_t;

#else

struct PERL_DRAND48_T {
    U16 seed[3];
};

typedef struct PERL_DRAND48_T perl_drand48_t;

#endif

#define PL_RANDOM_STATE_TYPE perl_drand48_t

#define Perl_drand48_init(seed) (Perl_drand48_init_r(&PL_random_state, (seed)))
#define Perl_drand48() (Perl_drand48_r(&PL_random_state))

#ifdef USE_C_BACKTRACE

typedef struct {
    /* The number of frames returned. */
    UV frame_count;
    /* The total size of the Perl_c_backtrace, including this header,
     * the frames, and the name strings. */
    UV total_bytes;
} Perl_c_backtrace_header;

typedef struct {
    void*  addr;  /* the program counter at this frame */

    /* We could use Dl_info (as used by dladdr()) for many of these but
     * that would be naughty towards non-dlfcn systems (hi there, Win32). */

    void*  symbol_addr; /* symbol address (hint: try symbol_addr - addr) */
    void*  object_base_addr;   /* base address of the shared object */

    /* The offsets are from the beginning of the whole backtrace,
     * which makes the backtrace relocatable. */
    STRLEN object_name_offset; /* pathname of the shared object */
    STRLEN object_name_size;   /* length of the pathname */
    STRLEN symbol_name_offset; /* symbol name */
    STRLEN symbol_name_size;   /* length of the symbol name */
    STRLEN source_name_offset; /* source code file name */
    STRLEN source_name_size;   /* length of the source code file name */
    STRLEN source_line_number; /* source code line number */

    /* OS X notes: atos(1) (more recently, "xcrun atos"), but the C
     * API atos() uses is unknown (private "Symbolicator" framework,
     * might require Objective-C even if the API would be known).
     * Currently we open read pipe to "xcrun atos" and parse the
     * output - quite disgusting.  And that won't work if the
     * Developer Tools isn't installed. */

    /* FreeBSD notes: execinfo.h exists, but probably would need also
     * the library -lexecinfo.  BFD exists if the pkg devel/binutils
     * has been installed, but there seems to be a known problem that
     * the "bfd.h" getting installed refers to "ansidecl.h", which
     * doesn't get installed. */

    /* Win32 notes: as moral equivalents of backtrace() + dladdr(),
     * one could possibly first use GetCurrentProcess() +
     * SymInitialize(), and then CaptureStackBackTrace() +
     * SymFromAddr(). */

    /* Note that using the compiler optimizer easily leads into much
     * of this information, like the symbol names (think inlining),
     * and source code locations getting lost or confused.  In many
     * cases keeping the debug information (-g) is necessary.
     *
     * Note that for example with gcc you can do both -O and -g.
     *
     * Note, however, that on some platforms (e.g. OSX + clang (cc))
     * backtrace() + dladdr() works fine without -g. */

    /* For example: the mere presence of <bfd.h> is no guarantee: e.g.
     * OS X has that, but BFD does not seem to work on the OSX executables.
     *
     * Another niceness would be to able to see something about
     * the function arguments, however gdb/lldb manage to do that. */
} Perl_c_backtrace_frame;

typedef struct {
    Perl_c_backtrace_header header;
    Perl_c_backtrace_frame  frame_info[1];
    /* After the header come:
     * (1) header.frame_count frames
     * (2) frame_count times the \0-terminated strings (object_name
     * and so forth).  The frames contain the pointers to the starts
     * of these strings, and the lengths of these strings. */
} Perl_c_backtrace;

#define Perl_free_c_backtrace(bt) Safefree(bt)

#endif /* USE_C_BACKTRACE */

/* Use a packed 32 bit constant "key" to start the handshake. The key defines
   ABI compatibility, and how to process the vararg list.

   Note, some bits may be taken from INTRPSIZE (but then a simple x86 AX register
   can't be used to read it) and 4 bits from API version len can also be taken,
   since v00.00.00 is 9 bytes long. XS version length should not have any bits
   taken since XS_VERSION lengths can get quite long since they are user
   selectable. These spare bits allow for additional features for the varargs
   stuff or ABI compat test flags in the future.
*/
#define HSm_APIVERLEN 0x0000001F /* perl version string won't be more than 31 chars */
#define HS_APIVERLEN_MAX HSm_APIVERLEN
#define HSm_XSVERLEN 0x0000FF00 /* if 0, not present, dont check, die if over 255*/
#define HS_XSVERLEN_MAX 0xFF
/* uses var file to set default filename for newXS_deffile to use for CvFILE */
#define HSf_SETXSUBFN 0x00000020
#define HSf_POPMARK 0x00000040 /* popmark mode or you must supply ax and items */
#define HSf_IMP_CXT 0x00000080 /* ABI, threaded/PERL_IMPLICIT_CONTEXT, pTHX_ present */
#define HSm_INTRPSIZE 0xFFFF0000 /* ABI, interp struct size */
/* A mask of bits in the key which must always match between a XS mod and interp.
   Also if all ABI bits in a key are true, skip all ABI checks, it is very
   the unlikely interp size will all 1 bits */
/* Maybe HSm_APIVERLEN one day if Perl_xs_apiversion_bootcheck is changed to a memcmp */
#define HSm_KEY_MATCH (HSm_INTRPSIZE|HSf_IMP_CXT)
#define HSf_NOCHK HSm_KEY_MATCH  /* if all ABI bits are 1 in the key, dont chk */


#define HS_GETINTERPSIZE(key) ((key) >> 16)
/* if in the future "" and NULL must be separated, XSVERLEN would be 0
means arg not present, 1 is empty string/null byte */
/* (((key) & 0x0000FF00) >> 8) is less efficient on Visual C */
#define HS_GETXSVERLEN(key) ((key) >> 8 & 0xFF)
#define HS_GETAPIVERLEN(key) ((key) & HSm_APIVERLEN)

/* internal to util.h macro to create a packed handshake key, all args must be constants */
/* U32 return = (U16 interpsize, bool cxt, bool setxsubfn, bool popmark,
   U5 (FIVE!) apiverlen, U8 xsverlen) */
#define HS_KEYp(interpsize, cxt, setxsubfn, popmark, apiverlen, xsverlen) \
    (((interpsize)  << 16) \
    | ((xsverlen) > HS_XSVERLEN_MAX \
        ? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \
        : (xsverlen) << 8) \
    | (cBOOL(setxsubfn) ? HSf_SETXSUBFN : 0) \
    | (cBOOL(cxt) ? HSf_IMP_CXT : 0) \
    | (cBOOL(popmark) ? HSf_POPMARK : 0) \
    | ((apiverlen) > HS_APIVERLEN_MAX \
        ? (Perl_croak_nocontext("panic: handshake overflow"), HS_APIVERLEN_MAX) \
        : (apiverlen)))
/* overflows above will optimize away unless they will execute */

/* public macro for core usage to create a packed handshake key but this is
   not public API. This more friendly version already collected all ABI info */
/* U32 return = (bool setxsubfn, bool popmark, "litteral_string_api_ver",
   "litteral_string_xs_ver") */
#ifdef PERL_IMPLICIT_CONTEXT
#  define HS_KEY(setxsubfn, popmark, apiver, xsver) \
    HS_KEYp(sizeof(PerlInterpreter), TRUE, setxsubfn, popmark, \
    sizeof("" apiver "")-1, sizeof("" xsver "")-1)
#  define HS_CXT aTHX
#else
#  define HS_KEY(setxsubfn, popmark, apiver, xsver) \
    HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, setxsubfn, popmark, \
    sizeof("" apiver "")-1, sizeof("" xsver "")-1)
#  define HS_CXT cv
#endif

/*
 * Local variables:
 * c-indentation-style: bsd
 * c-basic-offset: 4
 * indent-tabs-mode: nil
 * End:
 *
 * ex: set ts=8 sts=4 sw=4 et:
 */
Commit	Line	Data
a0d0e21e	1	/* util.h
a687059c	2	*
663f364b NC	3	* Copyright (C) 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004, 2005,
663f364b NC	4	* 2007, by Larry Wall and others
a687059c	5	*
d48672a2 LW	6	* You may distribute under the terms of either the GNU General Public
d48672a2 LW	7	* License or the Artistic License, as specified in the README file.
8d063cd8	8	*
8d063cd8	9	*/
57843af0 GS	10
	11	#ifdef VMS
	12	# define PERL_FILE_IS_ABSOLUTE(f) \
	13	(*(f) == '/' \
	14	\|\| (strchr(f,':') \
	15	\|\| (((f) == '[' \|\| (f) == '<') \
0eb30aeb	16	&& (isWORDCHAR((f)[1]) \|\| strchr("$-_]>",(f)[1])))))
57843af0 GS	17
57843af0 GS	18	#else /* !VMS */
546cd220	19	# if defined(WIN32) \|\| defined(__CYGWIN__)
57843af0	20	# define PERL_FILE_IS_ABSOLUTE(f) \
f2ed23b0 GS	21	((f) == '/' \|\| (f) == '\\' /* UNC/rooted path */ \
f2ed23b0 GS	22	\|\| ((f)[0] && (f)[1] == ':')) /* drive name */
57843af0	23	# else /* !WIN32 */
2986a63f JH	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 */
739a0b84	30	# if defined(DOSISH) \|\| defined(__SYMBIAN32__)
57843af0 GS	31	# define PERL_FILE_IS_ABSOLUTE(f) \
	32	(*(f) == '/' \
	33	\|\| ((f)[0] && (f)[1] == ':')) /* drive name */
739a0b84	34	# else /* NEITHER DOSISH NOR SYMBIANISH */
e37778c2	35	# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/')
57843af0	36	# endif /* DOSISH */
2986a63f	37	# endif /* NETWARE */
57843af0 GS	38	# endif /* WIN32 */
57843af0 GS	39	#endif /* VMS */
e9a8c099 MHM	40
e9a8c099 MHM	41	/*
dcccc8ff KW	42	=head1 Miscellaneous Functions
dcccc8ff KW	43
e6226b18 KW	44	=for apidoc ibcmp
	45
	46	This is a synonym for (! foldEQ())
	47
	48	=for apidoc ibcmp_locale
	49
	50	This is a synonym for (! 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
cb4d37a7 NC	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. */
9ea40801	60	#if defined(U64TYPE) && !defined(USING_MSVC6)
63835f79 SH	61	/* use a faster implementation when quads are available,
	62	* but not with VC6 on Windows */
	63	# define PERL_DRAND48_QUAD
3be8f094 TC	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))
e6226b18	87
470dd224 JH	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
0762e42f JH	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
470dd224 JH	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
db6e00bd DD	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	*/
9a189793	176	#define HSm_APIVERLEN 0x0000001F /* perl version string won't be more than 31 chars */
db6e00bd DD	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
9a189793 DD	180	/* uses var file to set default filename for newXS_deffile to use for CvFILE */
9a189793 DD	181	#define HSf_SETXSUBFN 0x00000020
db6e00bd DD	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 */
9a189793 DD	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 */
db6e00bd	189	#define HSm_KEY_MATCH (HSm_INTRPSIZE\|HSf_IMP_CXT)
9a189793	190	#define HSf_NOCHK HSm_KEY_MATCH /* if all ABI bits are 1 in the key, dont chk */
db6e00bd DD	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 */
9a189793 DD	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) \
db6e00bd DD	204	(((interpsize) << 16) \
	205	\| ((xsverlen) > HS_XSVERLEN_MAX \
	206	? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \
	207	: (xsverlen) << 8) \
9a189793	208	\| (cBOOL(setxsubfn) ? HSf_SETXSUBFN : 0) \
db6e00bd DD	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 */
9a189793 DD	218	/* U32 return = (bool setxsubfn, bool popmark, "litteral_string_api_ver",
9a189793 DD	219	"litteral_string_xs_ver") */
db6e00bd	220	#ifdef PERL_IMPLICIT_CONTEXT
9a189793 DD	221	# define HS_KEY(setxsubfn, popmark, apiver, xsver) \
9a189793 DD	222	HS_KEYp(sizeof(PerlInterpreter), TRUE, setxsubfn, popmark, \
db6e00bd DD	223	sizeof("" apiver "")-1, sizeof("" xsver "")-1)
	224	# define HS_CXT aTHX
	225	#else
9a189793 DD	226	# define HS_KEY(setxsubfn, popmark, apiver, xsver) \
9a189793 DD	227	HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, setxsubfn, popmark, \
db6e00bd DD	228	sizeof("" apiver "")-1, sizeof("" xsver "")-1)
	229	# define HS_CXT cv
	230	#endif
	231
e6226b18	232	/*
e9a8c099 MHM	233	* Local variables:
	234	* c-indentation-style: bsd
	235	* c-basic-offset: 4
14d04a33	236	* indent-tabs-mode: nil
e9a8c099 MHM	237	* End:
e9a8c099 MHM	238	*
14d04a33	239	* ex: set ts=8 sts=4 sw=4 et:
e9a8c099	240	*/