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