Mercurial > repo
comparison perl-5.22.2/util.h @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
8044:711c038a7dce | 8045:a16537d2fe07 |
---|---|
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 #ifdef VMS | |
12 # define PERL_FILE_IS_ABSOLUTE(f) \ | |
13 (*(f) == '/' \ | |
14 || (strchr(f,':') \ | |
15 || ((*(f) == '[' || *(f) == '<') \ | |
16 && (isWORDCHAR((f)[1]) || strchr("$-_]>",(f)[1]))))) | |
17 | |
18 #else /* !VMS */ | |
19 # if defined(WIN32) || defined(__CYGWIN__) | |
20 # define PERL_FILE_IS_ABSOLUTE(f) \ | |
21 (*(f) == '/' || *(f) == '\\' /* UNC/rooted path */ \ | |
22 || ((f)[0] && (f)[1] == ':')) /* drive name */ | |
23 # else /* !WIN32 */ | |
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 */ | |
30 # if defined(DOSISH) || defined(__SYMBIAN32__) | |
31 # define PERL_FILE_IS_ABSOLUTE(f) \ | |
32 (*(f) == '/' \ | |
33 || ((f)[0] && (f)[1] == ':')) /* drive name */ | |
34 # else /* NEITHER DOSISH NOR SYMBIANISH */ | |
35 # define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') | |
36 # endif /* DOSISH */ | |
37 # endif /* NETWARE */ | |
38 # endif /* WIN32 */ | |
39 #endif /* VMS */ | |
40 | |
41 /* | |
42 =head1 Miscellaneous Functions | |
43 | |
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 | |
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. */ | |
60 #if defined(U64TYPE) && !defined(USING_MSVC6) | |
61 /* use a faster implementation when quads are available, | |
62 * but not with VC6 on Windows */ | |
63 # define PERL_DRAND48_QUAD | |
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)) | |
87 | |
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 | |
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 | |
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 | |
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 */ | |
176 #define HSm_APIVERLEN 0x0000001F /* perl version string won't be more than 31 chars */ | |
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 | |
180 /* uses var file to set default filename for newXS_deffile to use for CvFILE */ | |
181 #define HSf_SETXSUBFN 0x00000020 | |
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 */ | |
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 */ | |
189 #define HSm_KEY_MATCH (HSm_INTRPSIZE|HSf_IMP_CXT) | |
190 #define HSf_NOCHK HSm_KEY_MATCH /* if all ABI bits are 1 in the key, dont chk */ | |
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 */ | |
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) \ | |
204 (((interpsize) << 16) \ | |
205 | ((xsverlen) > HS_XSVERLEN_MAX \ | |
206 ? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \ | |
207 : (xsverlen) << 8) \ | |
208 | (cBOOL(setxsubfn) ? HSf_SETXSUBFN : 0) \ | |
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 */ | |
218 /* U32 return = (bool setxsubfn, bool popmark, "litteral_string_api_ver", | |
219 "litteral_string_xs_ver") */ | |
220 #ifdef PERL_IMPLICIT_CONTEXT | |
221 # define HS_KEY(setxsubfn, popmark, apiver, xsver) \ | |
222 HS_KEYp(sizeof(PerlInterpreter), TRUE, setxsubfn, popmark, \ | |
223 sizeof("" apiver "")-1, sizeof("" xsver "")-1) | |
224 # define HS_CXT aTHX | |
225 #else | |
226 # define HS_KEY(setxsubfn, popmark, apiver, xsver) \ | |
227 HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, setxsubfn, popmark, \ | |
228 sizeof("" apiver "")-1, sizeof("" xsver "")-1) | |
229 # define HS_CXT cv | |
230 #endif | |
231 | |
232 /* | |
233 * ex: set ts=8 sts=4 sw=4 et: | |
234 */ |