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