Commit | Line | Data |
---|---|---|
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 */ | |
822c8b4d | 31 | #elif defined(DOSISH) |
d1f9b933 | 32 | # define PERL_FILE_IS_ABSOLUTE(f) \ |
57843af0 GS |
33 | (*(f) == '/' \ |
34 | || ((f)[0] && (f)[1] == ':')) /* drive name */ | |
822c8b4d | 35 | #else /* NOT DOSISH */ |
d1f9b933 AC |
36 | # define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') |
37 | #endif | |
e9a8c099 MHM |
38 | |
39 | /* | |
3f620621 | 40 | =for apidoc_section $string |
dcccc8ff | 41 | |
e6226b18 KW |
42 | =for apidoc ibcmp |
43 | ||
61b16eb9 | 44 | This is a synonym for S<C<(! foldEQ())>> |
e6226b18 KW |
45 | |
46 | =for apidoc ibcmp_locale | |
47 | ||
61b16eb9 | 48 | This is a synonym for S<C<(! foldEQ_locale())>> |
e6226b18 | 49 | |
1c4bbd05 KW |
50 | =for apidoc ibcmp_utf8 |
51 | ||
52 | This is a synonym for S<C<(! foldEQ_utf8())>> | |
53 | ||
e6226b18 KW |
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)) | |
1c4bbd05 KW |
58 | #define ibcmp_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ |
59 | cBOOL(! foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2)) | |
e6226b18 | 60 | |
cb4d37a7 NC |
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. */ | |
7adf2470 SH |
64 | #if defined(U64TYPE) |
65 | /* use a faster implementation when quads are available */ | |
63835f79 | 66 | # define PERL_DRAND48_QUAD |
3be8f094 TC |
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 | */ | |
74 | typedef U64TYPE perl_drand48_t; | |
75 | ||
76 | #else | |
77 | ||
78 | struct PERL_DRAND48_T { | |
79 | U16 seed[3]; | |
80 | }; | |
81 | ||
82 | typedef 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)) | |
e6226b18 | 90 | |
f26b33bd TC |
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 | ||
470dd224 JH |
97 | #ifdef USE_C_BACKTRACE |
98 | ||
99 | typedef 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 | ||
107 | typedef 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 | ||
0762e42f JH |
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 | ||
470dd224 JH |
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 | ||
161 | typedef 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 | ||
db6e00bd DD |
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 | */ | |
9a189793 | 185 | #define HSm_APIVERLEN 0x0000001F /* perl version string won't be more than 31 chars */ |
db6e00bd DD |
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 | |
9a189793 DD |
189 | /* uses var file to set default filename for newXS_deffile to use for CvFILE */ |
190 | #define HSf_SETXSUBFN 0x00000020 | |
db6e00bd DD |
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 */ | |
9a189793 DD |
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 */ | |
db6e00bd | 198 | #define HSm_KEY_MATCH (HSm_INTRPSIZE|HSf_IMP_CXT) |
9a189793 | 199 | #define HSf_NOCHK HSm_KEY_MATCH /* if all ABI bits are 1 in the key, dont chk */ |
db6e00bd DD |
200 | |
201 | ||
202 | #define HS_GETINTERPSIZE(key) ((key) >> 16) | |
203 | /* if in the future "" and NULL must be separated, XSVERLEN would be 0 | |
204 | means 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 */ | |
9a189793 DD |
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) \ | |
db6e00bd DD |
213 | (((interpsize) << 16) \ |
214 | | ((xsverlen) > HS_XSVERLEN_MAX \ | |
215 | ? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \ | |
216 | : (xsverlen) << 8) \ | |
9a189793 | 217 | | (cBOOL(setxsubfn) ? HSf_SETXSUBFN : 0) \ |
db6e00bd DD |
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 */ | |
9a189793 DD |
227 | /* U32 return = (bool setxsubfn, bool popmark, "litteral_string_api_ver", |
228 | "litteral_string_xs_ver") */ | |
db6e00bd | 229 | #ifdef PERL_IMPLICIT_CONTEXT |
9a189793 DD |
230 | # define HS_KEY(setxsubfn, popmark, apiver, xsver) \ |
231 | HS_KEYp(sizeof(PerlInterpreter), TRUE, setxsubfn, popmark, \ | |
db6e00bd DD |
232 | sizeof("" apiver "")-1, sizeof("" xsver "")-1) |
233 | # define HS_CXT aTHX | |
234 | #else | |
9a189793 DD |
235 | # define HS_KEY(setxsubfn, popmark, apiver, xsver) \ |
236 | HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, setxsubfn, popmark, \ | |
db6e00bd DD |
237 | sizeof("" apiver "")-1, sizeof("" xsver "")-1) |
238 | # define HS_CXT cv | |
239 | #endif | |
240 | ||
fa39cb42 KW |
241 | /* |
242 | =for apidoc instr | |
243 | Same as L<strstr(3)>, which finds and returns a pointer to the first occurrence | |
244 | of the NUL-terminated substring C<little> in the NUL-terminated string C<big>, | |
245 | returning NULL if not found. The terminating NUL bytes are not compared. | |
246 | ||
247 | =cut | |
248 | */ | |
249 | ||
250 | ||
4e528812 | 251 | #define instr(haystack, needle) strstr((char *) haystack, (char *) needle) |
4ee010a8 | 252 | |
b8070b07 KW |
253 | #ifdef HAS_MEMMEM |
254 | # define ninstr(big, bigend, little, lend) \ | |
45d67106 KW |
255 | ((char *) memmem((big), (bigend) - (big), \ |
256 | (little), (lend) - (little))) | |
54c193ae KW |
257 | #else |
258 | # define ninstr(a,b,c,d) Perl_ninstr(a,b,c,d) | |
b8070b07 KW |
259 | #endif |
260 | ||
d333cbeb Z |
261 | #ifdef __Lynx__ |
262 | /* Missing proto on LynxOS */ | |
263 | int mkstemp(char*); | |
264 | #endif | |
265 | ||
74b421cc TC |
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 | |
2517ba99 Z |
277 | #if defined(HAS_MKOSTEMP) && defined(PERL_CORE) |
278 | # define Perl_my_mkostemp(templte, flags) mkostemp(templte, flags) | |
279 | #endif | |
e48855bd TC |
280 | #if defined(HAS_MKSTEMP) && defined(PERL_CORE) |
281 | # define Perl_my_mkstemp(templte) mkstemp(templte) | |
282 | #endif | |
283 | ||
28922db9 DM |
284 | #endif /* PERL_UTIL_H_ */ |
285 | ||
e6226b18 | 286 | /* |
14d04a33 | 287 | * ex: set ts=8 sts=4 sw=4 et: |
e9a8c099 | 288 | */ |