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) || defined(__SYMBIAN32__) 32 # define PERL_FILE_IS_ABSOLUTE(f) \ 33 (*(f) == '/' \ 34 || ((f)[0] && (f)[1] == ':')) /* drive name */ 35 #else /* NEITHER DOSISH NOR SYMBIANISH */ 36 # define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') 37 #endif 38 39 /* 40 =head1 Miscellaneous Functions 41 42 =for apidoc ibcmp 43 44 This is a synonym for S<C<(! foldEQ())>> 45 46 =for apidoc ibcmp_locale 47 48 This is a synonym for S<C<(! foldEQ_locale())>> 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 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. */ 58 #if defined(U64TYPE) 59 /* use a faster implementation when quads are available */ 60 # define PERL_DRAND48_QUAD 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 */ 68 typedef U64TYPE perl_drand48_t; 69 70 #else 71 72 struct PERL_DRAND48_T { 73 U16 seed[3]; 74 }; 75 76 typedef 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)) 84 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 91 #ifdef USE_C_BACKTRACE 92 93 typedef 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 101 typedef 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 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 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 155 typedef 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 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 */ 179 #define HSm_APIVERLEN 0x0000001F /* perl version string won't be more than 31 chars */ 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 183 /* uses var file to set default filename for newXS_deffile to use for CvFILE */ 184 #define HSf_SETXSUBFN 0x00000020 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 */ 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 */ 192 #define HSm_KEY_MATCH (HSm_INTRPSIZE|HSf_IMP_CXT) 193 #define HSf_NOCHK HSm_KEY_MATCH /* if all ABI bits are 1 in the key, dont chk */ 194 195 196 #define HS_GETINTERPSIZE(key) ((key) >> 16) 197 /* if in the future "" and NULL must be separated, XSVERLEN would be 0 198 means 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 */ 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) \ 207 (((interpsize) << 16) \ 208 | ((xsverlen) > HS_XSVERLEN_MAX \ 209 ? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \ 210 : (xsverlen) << 8) \ 211 | (cBOOL(setxsubfn) ? HSf_SETXSUBFN : 0) \ 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 */ 221 /* U32 return = (bool setxsubfn, bool popmark, "litteral_string_api_ver", 222 "litteral_string_xs_ver") */ 223 #ifdef PERL_IMPLICIT_CONTEXT 224 # define HS_KEY(setxsubfn, popmark, apiver, xsver) \ 225 HS_KEYp(sizeof(PerlInterpreter), TRUE, setxsubfn, popmark, \ 226 sizeof("" apiver "")-1, sizeof("" xsver "")-1) 227 # define HS_CXT aTHX 228 #else 229 # define HS_KEY(setxsubfn, popmark, apiver, xsver) \ 230 HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, setxsubfn, popmark, \ 231 sizeof("" apiver "")-1, sizeof("" xsver "")-1) 232 # define HS_CXT cv 233 #endif 234 235 /* 236 =for apidoc instr 237 Same as L<strstr(3)>, which finds and returns a pointer to the first occurrence 238 of the NUL-terminated substring C<little> in the NUL-terminated string C<big>, 239 returning NULL if not found. The terminating NUL bytes are not compared. 240 241 =cut 242 */ 243 244 245 #define instr(haystack, needle) strstr(haystack, needle) 246 247 #ifdef HAS_MEMMEM 248 # define ninstr(big, bigend, little, lend) \ 249 ((char *) memmem((big), (bigend) - (big), \ 250 (little), (lend) - (little))) 251 #else 252 # define ninstr(a,b,c,d) Perl_ninstr(a,b,c,d) 253 #endif 254 255 #ifdef __Lynx__ 256 /* Missing proto on LynxOS */ 257 int mkstemp(char*); 258 #endif 259 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 271 #if defined(HAS_MKOSTEMP) && defined(PERL_CORE) 272 # define Perl_my_mkostemp(templte, flags) mkostemp(templte, flags) 273 #endif 274 #if defined(HAS_MKSTEMP) && defined(PERL_CORE) 275 # define Perl_my_mkstemp(templte) mkstemp(templte) 276 #endif 277 278 #endif /* PERL_UTIL_H_ */ 279 280 /* 281 * ex: set ts=8 sts=4 sw=4 et: 282 */ 283