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