1 /* perl.h 2 * 3 * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 4 * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 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 H_PERL 12 #define H_PERL 1 13 14 #ifdef PERL_FOR_X2P 15 /* 16 * This file is being used for x2p stuff. 17 * Above symbol is defined via -D in 'x2p/Makefile.SH' 18 * Decouple x2p stuff from some of perls more extreme eccentricities. 19 */ 20 #undef MULTIPLICITY 21 #undef USE_STDIO 22 #define USE_STDIO 23 #endif /* PERL_FOR_X2P */ 24 25 #if defined(DGUX) 26 #include <sys/fcntl.h> 27 #endif 28 29 #ifdef VOIDUSED 30 # undef VOIDUSED 31 #endif 32 #define VOIDUSED 1 33 34 #ifdef PERL_MICRO 35 # include "uconfig.h" 36 #else 37 # ifndef USE_CROSS_COMPILE 38 # include "config.h" 39 # else 40 # include "xconfig.h" 41 # endif 42 #endif 43 44 /* See L<perlguts/"The Perl API"> for detailed notes on 45 * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ 46 47 /* Note that from here --> to <-- the same logic is 48 * repeated in makedef.pl, so be certain to update 49 * both places when editing. */ 50 51 #ifdef PERL_IMPLICIT_SYS 52 /* PERL_IMPLICIT_SYS implies PerlMemShared != PerlMem 53 so use slab allocator to avoid lots of MUTEX overhead 54 */ 55 # ifndef PL_OP_SLAB_ALLOC 56 # define PL_OP_SLAB_ALLOC 57 # endif 58 #endif 59 60 #ifdef USE_ITHREADS 61 # if !defined(MULTIPLICITY) 62 # define MULTIPLICITY 63 # endif 64 #endif 65 66 #ifdef PERL_GLOBAL_STRUCT_PRIVATE 67 # ifndef PERL_GLOBAL_STRUCT 68 # define PERL_GLOBAL_STRUCT 69 # endif 70 #endif 71 72 #ifdef PERL_GLOBAL_STRUCT 73 # ifndef MULTIPLICITY 74 # define MULTIPLICITY 75 # endif 76 #endif 77 78 #ifdef MULTIPLICITY 79 # ifndef PERL_IMPLICIT_CONTEXT 80 # define PERL_IMPLICIT_CONTEXT 81 # endif 82 #endif 83 84 /* undef WIN32 when building on Cygwin (for libwin32) - gph */ 85 #ifdef __CYGWIN__ 86 # undef WIN32 87 # undef _WIN32 88 #endif 89 90 #if defined(__SYMBIAN32__) || (defined(__VC32__) && defined(WINS)) 91 # ifndef SYMBIAN 92 # define SYMBIAN 93 # endif 94 #endif 95 96 #ifdef __SYMBIAN32__ 97 # include "symbian/symbian_proto.h" 98 #endif 99 100 /* Any stack-challenged places. The limit varies (and often 101 * is configurable), but using more than a kilobyte of stack 102 * is usually dubious in these systems. */ 103 #if defined(EPOC) || defined(__SYMBIAN32__) 104 /* EPOC/Symbian: need to work around the SDK features. * 105 * On WINS: MS VC5 generates calls to _chkstk, * 106 * if a "large" stack frame is allocated. * 107 * gcc on MARM does not generate calls like these. */ 108 # define USE_HEAP_INSTEAD_OF_STACK 109 #endif 110 111 #/* Use the reentrant APIs like localtime_r and getpwent_r */ 112 /* Win32 has naturally threadsafe libraries, no need to use any _r variants. */ 113 #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN) 114 # define USE_REENTRANT_API 115 #endif 116 117 /* <--- here ends the logic shared by perl.h and makedef.pl */ 118 119 /* 120 * PERL_DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned) 121 * (The -DPERL_DARWIN comes from the hints/darwin.sh.) 122 * __bsdi__ for BSD/OS 123 */ 124 #if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(PERL_DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44) 125 # ifndef BSDish 126 # define BSDish 127 # endif 128 #endif 129 130 #undef START_EXTERN_C 131 #undef END_EXTERN_C 132 #undef EXTERN_C 133 #ifdef __cplusplus 134 # define START_EXTERN_C extern "C" { 135 # define END_EXTERN_C } 136 # define EXTERN_C extern "C" 137 #else 138 # define START_EXTERN_C 139 # define END_EXTERN_C 140 # define EXTERN_C extern 141 #endif 142 143 #ifdef PERL_GLOBAL_STRUCT 144 # ifndef PERL_GET_VARS 145 # ifdef PERL_GLOBAL_STRUCT_PRIVATE 146 EXTERN_C struct perl_vars* Perl_GetVarsPrivate(); 147 # define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */ 148 # ifndef PERLIO_FUNCS_CONST 149 # define PERLIO_FUNCS_CONST /* Can't have these lying around. */ 150 # endif 151 # else 152 # define PERL_GET_VARS() PL_VarsPtr 153 # endif 154 # endif 155 #endif 156 157 #define pVAR register struct perl_vars* my_vars PERL_UNUSED_DECL 158 159 #ifdef PERL_GLOBAL_STRUCT 160 # define dVAR pVAR = (struct perl_vars*)PERL_GET_VARS() 161 #else 162 # define dVAR dNOOP 163 #endif 164 165 #ifdef PERL_IMPLICIT_CONTEXT 166 # ifndef MULTIPLICITY 167 # define MULTIPLICITY 168 # endif 169 # define tTHX PerlInterpreter* 170 # define pTHX register tTHX my_perl PERL_UNUSED_DECL 171 # define aTHX my_perl 172 # ifdef PERL_GLOBAL_STRUCT 173 # define dTHXa(a) dVAR; pTHX = (tTHX)a 174 # else 175 # define dTHXa(a) pTHX = (tTHX)a 176 # endif 177 # ifdef PERL_GLOBAL_STRUCT 178 # define dTHX dVAR; pTHX = PERL_GET_THX 179 # else 180 # define dTHX pTHX = PERL_GET_THX 181 # endif 182 # define pTHX_ pTHX, 183 # define aTHX_ aTHX, 184 # define pTHX_1 2 185 # define pTHX_2 3 186 # define pTHX_3 4 187 # define pTHX_4 5 188 # define pTHX_5 6 189 # define pTHX_6 7 190 # define pTHX_7 8 191 # define pTHX_8 9 192 # define pTHX_9 10 193 # if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL) 194 # define PERL_TRACK_MEMPOOL 195 # endif 196 #else 197 # undef PERL_TRACK_MEMPOOL 198 #endif 199 200 #define STATIC static 201 #define CPERLscope(x) x 202 #define CPERLarg void 203 #define CPERLarg_ 204 #define _CPERLarg 205 #define PERL_OBJECT_THIS 206 #define _PERL_OBJECT_THIS 207 #define PERL_OBJECT_THIS_ 208 #define CALL_FPTR(fptr) (*fptr) 209 210 #define CALLRUNOPS CALL_FPTR(PL_runops) 211 212 #define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags)) 213 214 #define CALLREGCOMP_ENG(prog, sv, flags) \ 215 CALL_FPTR(((prog)->comp))(aTHX_ sv, flags) 216 #define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \ 217 CALL_FPTR(RX_ENGINE(prog)->exec)(aTHX_ (prog),(stringarg),(strend), \ 218 (strbeg),(minend),(screamer),(data),(flags)) 219 #define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \ 220 CALL_FPTR(RX_ENGINE(prog)->intuit)(aTHX_ (prog), (sv), (strpos), \ 221 (strend),(flags),(data)) 222 #define CALLREG_INTUIT_STRING(prog) \ 223 CALL_FPTR(RX_ENGINE(prog)->checkstr)(aTHX_ (prog)) 224 225 #define CALLREGFREE(prog) \ 226 Perl_pregfree(aTHX_ (prog)) 227 228 #define CALLREGFREE_PVT(prog) \ 229 if(prog) CALL_FPTR(RX_ENGINE(prog)->free)(aTHX_ (prog)) 230 231 #define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \ 232 CALL_FPTR(RX_ENGINE(rx)->numbered_buff_FETCH)(aTHX_ (rx),(paren),(usesv)) 233 234 #define CALLREG_NUMBUF_STORE(rx,paren,value) \ 235 CALL_FPTR(RX_ENGINE(rx)->numbered_buff_STORE)(aTHX_ (rx),(paren),(value)) 236 237 #define CALLREG_NUMBUF_LENGTH(rx,sv,paren) \ 238 CALL_FPTR(RX_ENGINE(rx)->numbered_buff_LENGTH)(aTHX_ (rx),(sv),(paren)) 239 240 #define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \ 241 CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH)) 242 243 #define CALLREG_NAMED_BUFF_STORE(rx, key, value, flags) \ 244 CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE)) 245 246 #define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \ 247 CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE)) 248 249 #define CALLREG_NAMED_BUFF_CLEAR(rx, flags) \ 250 CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR)) 251 252 #define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \ 253 CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS)) 254 255 #define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \ 256 CALL_FPTR(RX_ENGINE(rx)->named_buff_iter)(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY)) 257 258 #define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \ 259 CALL_FPTR(RX_ENGINE(rx)->named_buff_iter)(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY)) 260 261 #define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \ 262 CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR)) 263 264 #define CALLREG_NAMED_BUFF_COUNT(rx) \ 265 CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT) 266 267 #define CALLREG_NAMED_BUFF_ALL(rx, flags) \ 268 CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, flags) 269 270 #define CALLREG_PACKAGE(rx) \ 271 CALL_FPTR(RX_ENGINE(rx)->qr_package)(aTHX_ (rx)) 272 273 #if defined(USE_ITHREADS) 274 #define CALLREGDUPE(prog,param) \ 275 Perl_re_dup(aTHX_ (prog),(param)) 276 277 #define CALLREGDUPE_PVT(prog,param) \ 278 (prog ? CALL_FPTR(RX_ENGINE(prog)->dupe)(aTHX_ (prog),(param)) \ 279 : (REGEXP *)NULL) 280 #endif 281 282 283 284 285 286 /* 287 * Because of backward compatibility reasons the PERL_UNUSED_DECL 288 * cannot be changed from postfix to PERL_UNUSED_DECL(x). Sigh. 289 * 290 * Note that there are C compilers such as MetroWerks CodeWarrior 291 * which do not have an "inlined" way (like the gcc __attribute__) of 292 * marking unused variables (they need e.g. a #pragma) and therefore 293 * cpp macros like PERL_UNUSED_DECL cannot work for this purpose, even 294 * if it were PERL_UNUSED_DECL(x), which it cannot be (see above). 295 * 296 */ 297 298 #if defined(__SYMBIAN32__) && defined(__GNUC__) 299 # ifdef __cplusplus 300 # define PERL_UNUSED_DECL 301 # else 302 # define PERL_UNUSED_DECL __attribute__((unused)) 303 # endif 304 #endif 305 306 #ifndef PERL_UNUSED_DECL 307 # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus) 308 # define PERL_UNUSED_DECL __attribute__unused__ 309 # else 310 # define PERL_UNUSED_DECL 311 # endif 312 #endif 313 314 /* gcc -Wall: 315 * for silencing unused variables that are actually used most of the time, 316 * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs 317 */ 318 #ifndef PERL_UNUSED_ARG 319 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ 320 # include <note.h> 321 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) 322 # else 323 # define PERL_UNUSED_ARG(x) ((void)x) 324 # endif 325 #endif 326 #ifndef PERL_UNUSED_VAR 327 # define PERL_UNUSED_VAR(x) ((void)x) 328 #endif 329 330 #ifdef USE_ITHREADS 331 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) 332 #else 333 # define PERL_UNUSED_CONTEXT 334 #endif 335 336 #define NOOP /*EMPTY*/(void)0 337 #if !defined(HASATTRIBUTE_UNUSED) && defined(__cplusplus) 338 #define dNOOP /*EMPTY*/(void)0 /* Older g++ has no __attribute((unused))__ */ 339 #else 340 #define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL 341 #endif 342 343 #ifndef pTHX 344 /* Don't bother defining tTHX and sTHX; using them outside 345 * code guarded by PERL_IMPLICIT_CONTEXT is an error. 346 */ 347 # define pTHX void 348 # define pTHX_ 349 # define aTHX 350 # define aTHX_ 351 # define dTHXa(a) dNOOP 352 # define dTHX dNOOP 353 # define pTHX_1 1 354 # define pTHX_2 2 355 # define pTHX_3 3 356 # define pTHX_4 4 357 # define pTHX_5 5 358 # define pTHX_6 6 359 # define pTHX_7 7 360 # define pTHX_8 8 361 # define pTHX_9 9 362 #endif 363 364 #ifndef dVAR 365 # define dVAR dNOOP 366 #endif 367 368 /* these are only defined for compatibility; should not be used internally */ 369 #if !defined(pTHXo) && !defined(PERL_CORE) 370 # define pTHXo pTHX 371 # define pTHXo_ pTHX_ 372 # define aTHXo aTHX 373 # define aTHXo_ aTHX_ 374 # define dTHXo dTHX 375 # define dTHXoa(x) dTHXa(x) 376 #endif 377 378 #ifndef pTHXx 379 # define pTHXx register PerlInterpreter *my_perl 380 # define pTHXx_ pTHXx, 381 # define aTHXx my_perl 382 # define aTHXx_ aTHXx, 383 # define dTHXx dTHX 384 #endif 385 386 /* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation) 387 * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...). 388 * dTHXs is therefore needed for all functions using PerlIO_foo(). */ 389 #ifdef PERL_IMPLICIT_SYS 390 # ifdef PERL_GLOBAL_STRUCT_PRIVATE 391 # define dTHXs dVAR; dTHX 392 # else 393 # define dTHXs dTHX 394 # endif 395 #else 396 # ifdef PERL_GLOBAL_STRUCT_PRIVATE 397 # define dTHXs dVAR 398 # else 399 # define dTHXs dNOOP 400 # endif 401 #endif 402 403 /* Some platforms require marking function declarations 404 * for them to be exportable. Used in perlio.h, proto.h 405 * is handled either by the makedef.pl or by defining the 406 * PERL_CALLCONV to be something special. See also the 407 * definition of XS() in XSUB.h. */ 408 #ifndef PERL_EXPORT_C 409 # ifdef __cplusplus 410 # define PERL_EXPORT_C extern "C" 411 # else 412 # define PERL_EXPORT_C extern 413 # endif 414 #endif 415 #ifndef PERL_XS_EXPORT_C 416 # ifdef __cplusplus 417 # define PERL_XS_EXPORT_C extern "C" 418 # else 419 # define PERL_XS_EXPORT_C 420 # endif 421 #endif 422 423 #ifdef OP_IN_REGISTER 424 # ifdef __GNUC__ 425 # define stringify_immed(s) #s 426 # define stringify(s) stringify_immed(s) 427 register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); 428 # endif 429 #endif 430 431 /* gcc (-ansi) -pedantic doesn't allow gcc statement expressions, 432 * g++ allows them but seems to have problems with them 433 * (insane errors ensue). 434 * g++ does not give insane errors now (RMB 2008-01-30, gcc 4.2.2). 435 */ 436 #if defined(PERL_GCC_PEDANTIC) || \ 437 (defined(__GNUC__) && defined(__cplusplus) && \ 438 ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 2)))) 439 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN 440 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN 441 # endif 442 #endif 443 444 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) 445 # ifndef PERL_USE_GCC_BRACE_GROUPS 446 # define PERL_USE_GCC_BRACE_GROUPS 447 # endif 448 #endif 449 450 /* 451 * STMT_START { statements; } STMT_END; 452 * can be used as a single statement, as in 453 * if (x) STMT_START { ... } STMT_END; else ... 454 * 455 * Trying to select a version that gives no warnings... 456 */ 457 #if !(defined(STMT_START) && defined(STMT_END)) 458 # ifdef PERL_USE_GCC_BRACE_GROUPS 459 # define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */ 460 # define STMT_END ) 461 # else 462 /* Now which other defined()s do we need here ??? */ 463 # if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) 464 # define STMT_START if (1) 465 # define STMT_END else (void)0 466 # else 467 # define STMT_START do 468 # define STMT_END while (0) 469 # endif 470 # endif 471 #endif 472 473 #define WITH_THX(s) STMT_START { dTHX; s; } STMT_END 474 #define WITH_THR(s) WITH_THX(s) 475 476 #ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */ 477 # define BYTEORDER 0x1234 478 #endif 479 480 /* Overall memory policy? */ 481 #ifndef CONSERVATIVE 482 # define LIBERAL 1 483 #endif 484 485 #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90 486 #define ASCIIish 487 #else 488 #undef ASCIIish 489 #endif 490 491 /* 492 * The following contortions are brought to you on behalf of all the 493 * standards, semi-standards, de facto standards, not-so-de-facto standards 494 * of the world, as well as all the other botches anyone ever thought of. 495 * The basic theory is that if we work hard enough here, the rest of the 496 * code can be a lot prettier. Well, so much for theory. Sorry, Henry... 497 */ 498 499 /* define this once if either system, instead of cluttering up the src */ 500 #if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(NETWARE) 501 #define DOSISH 1 502 #endif 503 504 #if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(EPOC) || defined(NETWARE) || defined(__SYMBIAN32__) 505 # define STANDARD_C 1 506 #endif 507 508 #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined(EPOC) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO) 509 # define DONT_DECLARE_STD 1 510 #endif 511 512 #if defined(HASVOLATILE) || defined(STANDARD_C) 513 # define VOL volatile 514 #else 515 # define VOL 516 #endif 517 518 #define TAINT (PL_tainted = TRUE) 519 #define TAINT_NOT (PL_tainted = FALSE) 520 #define TAINT_IF(c) if (c) { PL_tainted = TRUE; } 521 #define TAINT_ENV() if (PL_tainting) { taint_env(); } 522 #define TAINT_PROPER(s) if (PL_tainting) { taint_proper(NULL, s); } 523 524 /* XXX All process group stuff is handled in pp_sys.c. Should these 525 defines move there? If so, I could simplify this a lot. --AD 9/96. 526 */ 527 /* Process group stuff changed from traditional BSD to POSIX. 528 perlfunc.pod documents the traditional BSD-style syntax, so we'll 529 try to preserve that, if possible. 530 */ 531 #ifdef HAS_SETPGID 532 # define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) 533 #else 534 # if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP) 535 # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 536 # else 537 # ifdef HAS_SETPGRP2 /* DG/UX */ 538 # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 539 # endif 540 # endif 541 #endif 542 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP) 543 # define HAS_SETPGRP /* Well, effectively it does . . . */ 544 #endif 545 546 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes 547 our life easier :-) so we'll try it. 548 */ 549 #ifdef HAS_GETPGID 550 # define BSD_GETPGRP(pid) getpgid((pid)) 551 #else 552 # if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP) 553 # define BSD_GETPGRP(pid) getpgrp((pid)) 554 # else 555 # ifdef HAS_GETPGRP2 /* DG/UX */ 556 # define BSD_GETPGRP(pid) getpgrp2((pid)) 557 # endif 558 # endif 559 #endif 560 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP) 561 # define HAS_GETPGRP /* Well, effectively it does . . . */ 562 #endif 563 564 /* These are not exact synonyms, since setpgrp() and getpgrp() may 565 have different behaviors, but perl.h used to define USE_BSDPGRP 566 (prior to 5.003_05) so some extension might depend on it. 567 */ 568 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP) 569 # ifndef USE_BSDPGRP 570 # define USE_BSDPGRP 571 # endif 572 #endif 573 574 /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that 575 pthread.h must be included before all other header files. 576 */ 577 #if defined(USE_ITHREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) 578 # include <pthread.h> 579 #endif 580 581 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 582 # ifndef major /* Does everyone's types.h define this? */ 583 # include <sys/types.h> 584 # endif 585 #endif 586 587 #ifdef __cplusplus 588 # ifndef I_STDARG 589 # define I_STDARG 1 590 # endif 591 #endif 592 593 #ifdef I_STDARG 594 # include <stdarg.h> 595 #else 596 # ifdef I_VARARGS 597 # include <varargs.h> 598 # endif 599 #endif 600 601 #ifdef USE_NEXT_CTYPE 602 603 #if NX_CURRENT_COMPILER_RELEASE >= 500 604 # include <bsd/ctypes.h> 605 #else 606 # if NX_CURRENT_COMPILER_RELEASE >= 400 607 # include <objc/NXCType.h> 608 # else /* NX_CURRENT_COMPILER_RELEASE < 400 */ 609 # include <appkit/NXCType.h> 610 # endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */ 611 #endif /* NX_CURRENT_COMPILER_RELEASE >= 500 */ 612 613 #else /* !USE_NEXT_CTYPE */ 614 #include <ctype.h> 615 #endif /* USE_NEXT_CTYPE */ 616 617 #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ 618 #undef METHOD 619 #endif 620 621 #ifdef PERL_MICRO 622 # define NO_LOCALE 623 #endif 624 625 #ifdef I_LOCALE 626 # include <locale.h> 627 #endif 628 629 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE) 630 # define USE_LOCALE 631 # if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ 632 && defined(HAS_STRXFRM) 633 # define USE_LOCALE_COLLATE 634 # endif 635 # if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE) 636 # define USE_LOCALE_CTYPE 637 # endif 638 # if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC) 639 # define USE_LOCALE_NUMERIC 640 # endif 641 #endif /* !NO_LOCALE && HAS_SETLOCALE */ 642 643 #include <setjmp.h> 644 645 #ifdef I_SYS_PARAM 646 # ifdef PARAM_NEEDS_TYPES 647 # include <sys/types.h> 648 # endif 649 # include <sys/param.h> 650 #endif 651 652 /* Use all the "standard" definitions? */ 653 #if defined(STANDARD_C) && defined(I_STDLIB) 654 # include <stdlib.h> 655 #endif 656 657 /* If this causes problems, set i_unistd=undef in the hint file. */ 658 #ifdef I_UNISTD 659 # include <unistd.h> 660 #endif 661 662 /* for WCOREDUMP */ 663 #ifdef I_SYS_WAIT 664 # include <sys/wait.h> 665 #endif 666 667 #ifdef __SYMBIAN32__ 668 # undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */ 669 #endif 670 671 #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO) 672 EXTERN_C int syscall(int, ...); 673 #endif 674 675 #if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) && !defined(PERL_MICRO) 676 EXTERN_C int usleep(unsigned int); 677 #endif 678 679 /* Funky places that do not have socket stuff. */ 680 #if defined(__LIBCATAMOUNT__) 681 # define MYSWAP 682 #endif 683 684 #ifdef PERL_MICRO /* Last chance to export Perl_my_swap */ 685 # define MYSWAP 686 #endif 687 688 #ifdef PERL_CORE 689 690 /* macros for correct constant construction */ 691 # if INTSIZE >= 2 692 # define U16_CONST(x) ((U16)x##U) 693 # else 694 # define U16_CONST(x) ((U16)x##UL) 695 # endif 696 697 # if INTSIZE >= 4 698 # define U32_CONST(x) ((U32)x##U) 699 # else 700 # define U32_CONST(x) ((U32)x##UL) 701 # endif 702 703 # ifdef HAS_QUAD 704 # if INTSIZE >= 8 705 # define U64_CONST(x) ((U64)x##U) 706 # elif LONGSIZE >= 8 707 # define U64_CONST(x) ((U64)x##UL) 708 # elif QUADKIND == QUAD_IS_LONG_LONG 709 # define U64_CONST(x) ((U64)x##ULL) 710 # else /* best guess we can make */ 711 # define U64_CONST(x) ((U64)x##UL) 712 # endif 713 # endif 714 715 /* byte-swapping functions for big-/little-endian conversion */ 716 # define _swab_16_(x) ((U16)( \ 717 (((U16)(x) & U16_CONST(0x00ff)) << 8) | \ 718 (((U16)(x) & U16_CONST(0xff00)) >> 8) )) 719 720 # define _swab_32_(x) ((U32)( \ 721 (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \ 722 (((U32)(x) & U32_CONST(0x0000ff00)) << 8) | \ 723 (((U32)(x) & U32_CONST(0x00ff0000)) >> 8) | \ 724 (((U32)(x) & U32_CONST(0xff000000)) >> 24) )) 725 726 # ifdef HAS_QUAD 727 # define _swab_64_(x) ((U64)( \ 728 (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \ 729 (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \ 730 (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \ 731 (((U64)(x) & U64_CONST(0x00000000ff000000)) << 8) | \ 732 (((U64)(x) & U64_CONST(0x000000ff00000000)) >> 8) | \ 733 (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \ 734 (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \ 735 (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) )) 736 # endif 737 738 /*----------------------------------------------------------------------------*/ 739 # if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 /* little-endian */ 740 /*----------------------------------------------------------------------------*/ 741 # define my_htole16(x) (x) 742 # define my_letoh16(x) (x) 743 # define my_htole32(x) (x) 744 # define my_letoh32(x) (x) 745 # define my_htobe16(x) _swab_16_(x) 746 # define my_betoh16(x) _swab_16_(x) 747 # define my_htobe32(x) _swab_32_(x) 748 # define my_betoh32(x) _swab_32_(x) 749 # ifdef HAS_QUAD 750 # define my_htole64(x) (x) 751 # define my_letoh64(x) (x) 752 # define my_htobe64(x) _swab_64_(x) 753 # define my_betoh64(x) _swab_64_(x) 754 # endif 755 # define my_htoles(x) (x) 756 # define my_letohs(x) (x) 757 # define my_htolei(x) (x) 758 # define my_letohi(x) (x) 759 # define my_htolel(x) (x) 760 # define my_letohl(x) (x) 761 # if SHORTSIZE == 1 762 # define my_htobes(x) (x) 763 # define my_betohs(x) (x) 764 # elif SHORTSIZE == 2 765 # define my_htobes(x) _swab_16_(x) 766 # define my_betohs(x) _swab_16_(x) 767 # elif SHORTSIZE == 4 768 # define my_htobes(x) _swab_32_(x) 769 # define my_betohs(x) _swab_32_(x) 770 # elif SHORTSIZE == 8 771 # define my_htobes(x) _swab_64_(x) 772 # define my_betohs(x) _swab_64_(x) 773 # else 774 # define PERL_NEED_MY_HTOBES 775 # define PERL_NEED_MY_BETOHS 776 # endif 777 # if INTSIZE == 1 778 # define my_htobei(x) (x) 779 # define my_betohi(x) (x) 780 # elif INTSIZE == 2 781 # define my_htobei(x) _swab_16_(x) 782 # define my_betohi(x) _swab_16_(x) 783 # elif INTSIZE == 4 784 # define my_htobei(x) _swab_32_(x) 785 # define my_betohi(x) _swab_32_(x) 786 # elif INTSIZE == 8 787 # define my_htobei(x) _swab_64_(x) 788 # define my_betohi(x) _swab_64_(x) 789 # else 790 # define PERL_NEED_MY_HTOBEI 791 # define PERL_NEED_MY_BETOHI 792 # endif 793 # if LONGSIZE == 1 794 # define my_htobel(x) (x) 795 # define my_betohl(x) (x) 796 # elif LONGSIZE == 2 797 # define my_htobel(x) _swab_16_(x) 798 # define my_betohl(x) _swab_16_(x) 799 # elif LONGSIZE == 4 800 # define my_htobel(x) _swab_32_(x) 801 # define my_betohl(x) _swab_32_(x) 802 # elif LONGSIZE == 8 803 # define my_htobel(x) _swab_64_(x) 804 # define my_betohl(x) _swab_64_(x) 805 # else 806 # define PERL_NEED_MY_HTOBEL 807 # define PERL_NEED_MY_BETOHL 808 # endif 809 # define my_htolen(p,n) NOOP 810 # define my_letohn(p,n) NOOP 811 # define my_htoben(p,n) my_swabn(p,n) 812 # define my_betohn(p,n) my_swabn(p,n) 813 /*----------------------------------------------------------------------------*/ 814 # elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 /* big-endian */ 815 /*----------------------------------------------------------------------------*/ 816 # define my_htobe16(x) (x) 817 # define my_betoh16(x) (x) 818 # define my_htobe32(x) (x) 819 # define my_betoh32(x) (x) 820 # define my_htole16(x) _swab_16_(x) 821 # define my_letoh16(x) _swab_16_(x) 822 # define my_htole32(x) _swab_32_(x) 823 # define my_letoh32(x) _swab_32_(x) 824 # ifdef HAS_QUAD 825 # define my_htobe64(x) (x) 826 # define my_betoh64(x) (x) 827 # define my_htole64(x) _swab_64_(x) 828 # define my_letoh64(x) _swab_64_(x) 829 # endif 830 # define my_htobes(x) (x) 831 # define my_betohs(x) (x) 832 # define my_htobei(x) (x) 833 # define my_betohi(x) (x) 834 # define my_htobel(x) (x) 835 # define my_betohl(x) (x) 836 # if SHORTSIZE == 1 837 # define my_htoles(x) (x) 838 # define my_letohs(x) (x) 839 # elif SHORTSIZE == 2 840 # define my_htoles(x) _swab_16_(x) 841 # define my_letohs(x) _swab_16_(x) 842 # elif SHORTSIZE == 4 843 # define my_htoles(x) _swab_32_(x) 844 # define my_letohs(x) _swab_32_(x) 845 # elif SHORTSIZE == 8 846 # define my_htoles(x) _swab_64_(x) 847 # define my_letohs(x) _swab_64_(x) 848 # else 849 # define PERL_NEED_MY_HTOLES 850 # define PERL_NEED_MY_LETOHS 851 # endif 852 # if INTSIZE == 1 853 # define my_htolei(x) (x) 854 # define my_letohi(x) (x) 855 # elif INTSIZE == 2 856 # define my_htolei(x) _swab_16_(x) 857 # define my_letohi(x) _swab_16_(x) 858 # elif INTSIZE == 4 859 # define my_htolei(x) _swab_32_(x) 860 # define my_letohi(x) _swab_32_(x) 861 # elif INTSIZE == 8 862 # define my_htolei(x) _swab_64_(x) 863 # define my_letohi(x) _swab_64_(x) 864 # else 865 # define PERL_NEED_MY_HTOLEI 866 # define PERL_NEED_MY_LETOHI 867 # endif 868 # if LONGSIZE == 1 869 # define my_htolel(x) (x) 870 # define my_letohl(x) (x) 871 # elif LONGSIZE == 2 872 # define my_htolel(x) _swab_16_(x) 873 # define my_letohl(x) _swab_16_(x) 874 # elif LONGSIZE == 4 875 # define my_htolel(x) _swab_32_(x) 876 # define my_letohl(x) _swab_32_(x) 877 # elif LONGSIZE == 8 878 # define my_htolel(x) _swab_64_(x) 879 # define my_letohl(x) _swab_64_(x) 880 # else 881 # define PERL_NEED_MY_HTOLEL 882 # define PERL_NEED_MY_LETOHL 883 # endif 884 # define my_htolen(p,n) my_swabn(p,n) 885 # define my_letohn(p,n) my_swabn(p,n) 886 # define my_htoben(p,n) NOOP 887 # define my_betohn(p,n) NOOP 888 /*----------------------------------------------------------------------------*/ 889 # else /* all other byte-orders */ 890 /*----------------------------------------------------------------------------*/ 891 # define PERL_NEED_MY_HTOLE16 892 # define PERL_NEED_MY_LETOH16 893 # define PERL_NEED_MY_HTOBE16 894 # define PERL_NEED_MY_BETOH16 895 # define PERL_NEED_MY_HTOLE32 896 # define PERL_NEED_MY_LETOH32 897 # define PERL_NEED_MY_HTOBE32 898 # define PERL_NEED_MY_BETOH32 899 # ifdef HAS_QUAD 900 # define PERL_NEED_MY_HTOLE64 901 # define PERL_NEED_MY_LETOH64 902 # define PERL_NEED_MY_HTOBE64 903 # define PERL_NEED_MY_BETOH64 904 # endif 905 # define PERL_NEED_MY_HTOLES 906 # define PERL_NEED_MY_LETOHS 907 # define PERL_NEED_MY_HTOBES 908 # define PERL_NEED_MY_BETOHS 909 # define PERL_NEED_MY_HTOLEI 910 # define PERL_NEED_MY_LETOHI 911 # define PERL_NEED_MY_HTOBEI 912 # define PERL_NEED_MY_BETOHI 913 # define PERL_NEED_MY_HTOLEL 914 # define PERL_NEED_MY_LETOHL 915 # define PERL_NEED_MY_HTOBEL 916 # define PERL_NEED_MY_BETOHL 917 /*----------------------------------------------------------------------------*/ 918 # endif /* end of byte-order macros */ 919 /*----------------------------------------------------------------------------*/ 920 921 /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster, 922 at least on FreeBSD. YMMV, so experiment. */ 923 #ifndef PERL_ARENA_SIZE 924 #define PERL_ARENA_SIZE 4080 925 #endif 926 927 /* Maximum level of recursion */ 928 #ifndef PERL_SUB_DEPTH_WARN 929 #define PERL_SUB_DEPTH_WARN 100 930 #endif 931 932 #endif /* PERL_CORE */ 933 934 /* We no longer default to creating a new SV for GvSV. 935 Do this before embed. */ 936 #ifndef PERL_CREATE_GVSV 937 # ifndef PERL_DONT_CREATE_GVSV 938 # define PERL_DONT_CREATE_GVSV 939 # endif 940 #endif 941 942 #if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME) 943 #define PERL_USES_PL_PIDSTATUS 944 #endif 945 946 #if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) 947 #define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION 948 #endif 949 950 /* Cannot include embed.h here on Win32 as win32.h has not 951 yet been included and defines some config variables e.g. HAVE_INTERP_INTERN 952 */ 953 #if !defined(PERL_FOR_X2P) && !(defined(WIN32)||defined(VMS)) 954 # include "embed.h" 955 # ifndef PERL_MAD 956 # undef op_getmad 957 # define op_getmad(arg,pegop,slot) NOOP 958 # endif 959 #endif 960 961 #define MEM_SIZE Size_t 962 963 /* Round all values passed to malloc up, by default to a multiple of 964 sizeof(size_t) 965 */ 966 #ifndef PERL_STRLEN_ROUNDUP_QUANTUM 967 #define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size 968 #endif 969 970 #if defined(STANDARD_C) && defined(I_STDDEF) 971 # include <stddef.h> 972 # define STRUCT_OFFSET(s,m) offsetof(s,m) 973 #else 974 # define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) 975 #endif 976 977 #ifndef __SYMBIAN32__ 978 # if defined(I_STRING) || defined(__cplusplus) 979 # include <string.h> 980 # else 981 # include <strings.h> 982 # endif 983 #endif 984 985 /* This comes after <stdlib.h> so we don't try to change the standard 986 * library prototypes; we'll use our own in proto.h instead. */ 987 988 #ifdef MYMALLOC 989 # ifdef PERL_POLLUTE_MALLOC 990 # ifndef PERL_EXTMALLOC_DEF 991 # define Perl_malloc malloc 992 # define Perl_calloc calloc 993 # define Perl_realloc realloc 994 # define Perl_mfree free 995 # endif 996 # else 997 # define EMBEDMYMALLOC /* for compatibility */ 998 # endif 999 1000 # define safemalloc Perl_malloc 1001 # define safecalloc Perl_calloc 1002 # define saferealloc Perl_realloc 1003 # define safefree Perl_mfree 1004 # define CHECK_MALLOC_TOO_LATE_FOR_(code) STMT_START { \ 1005 if (!PL_tainting && MallocCfg_ptr[MallocCfg_cfg_env_read]) \ 1006 code; \ 1007 } STMT_END 1008 # define CHECK_MALLOC_TOO_LATE_FOR(ch) \ 1009 CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch)) 1010 # define panic_write2(s) write(2, s, strlen(s)) 1011 # define CHECK_MALLOC_TAINT(newval) \ 1012 CHECK_MALLOC_TOO_LATE_FOR_( \ 1013 if (newval) { \ 1014 panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\ 1015 exit(1); }) 1016 # define MALLOC_CHECK_TAINT(argc,argv,env) STMT_START { \ 1017 if (doing_taint(argc,argv,env)) { \ 1018 MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \ 1019 }} STMT_END; 1020 #else /* MYMALLOC */ 1021 # define safemalloc safesysmalloc 1022 # define safecalloc safesyscalloc 1023 # define saferealloc safesysrealloc 1024 # define safefree safesysfree 1025 # define CHECK_MALLOC_TOO_LATE_FOR(ch) ((void)0) 1026 # define CHECK_MALLOC_TAINT(newval) ((void)0) 1027 # define MALLOC_CHECK_TAINT(argc,argv,env) 1028 #endif /* MYMALLOC */ 1029 1030 /* diag_listed_as: "-T" is on the #! line, it must also be used on the command line */ 1031 #define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what) 1032 #define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "") 1033 #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") 1034 #define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) 1035 1036 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr) 1037 #define strchr index 1038 #define strrchr rindex 1039 #endif 1040 1041 #ifdef I_MEMORY 1042 # include <memory.h> 1043 #endif 1044 1045 #ifdef HAS_MEMCPY 1046 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 1047 # ifndef memcpy 1048 extern char * memcpy (char*, char*, int); 1049 # endif 1050 # endif 1051 #else 1052 # ifndef memcpy 1053 # ifdef HAS_BCOPY 1054 # define memcpy(d,s,l) bcopy(s,d,l) 1055 # else 1056 # define memcpy(d,s,l) my_bcopy(s,d,l) 1057 # endif 1058 # endif 1059 #endif /* HAS_MEMCPY */ 1060 1061 #ifdef HAS_MEMSET 1062 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 1063 # ifndef memset 1064 extern char *memset (char*, int, int); 1065 # endif 1066 # endif 1067 #else 1068 # undef memset 1069 # define memset(d,c,l) my_memset(d,c,l) 1070 #endif /* HAS_MEMSET */ 1071 1072 #if !defined(HAS_MEMMOVE) && !defined(memmove) 1073 # if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY) 1074 # define memmove(d,s,l) bcopy(s,d,l) 1075 # else 1076 # if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY) 1077 # define memmove(d,s,l) memcpy(d,s,l) 1078 # else 1079 # define memmove(d,s,l) my_bcopy(s,d,l) 1080 # endif 1081 # endif 1082 #endif 1083 1084 #if defined(mips) && defined(ultrix) && !defined(__STDC__) 1085 # undef HAS_MEMCMP 1086 #endif 1087 1088 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP) 1089 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 1090 # ifndef memcmp 1091 extern int memcmp (char*, char*, int); 1092 # endif 1093 # endif 1094 # ifdef BUGGY_MSC 1095 # pragma function(memcmp) 1096 # endif 1097 #else 1098 # ifndef memcmp 1099 # define memcmp my_memcmp 1100 # endif 1101 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */ 1102 1103 #ifndef memzero 1104 # ifdef HAS_MEMSET 1105 # define memzero(d,l) memset(d,0,l) 1106 # else 1107 # ifdef HAS_BZERO 1108 # define memzero(d,l) bzero(d,l) 1109 # else 1110 # define memzero(d,l) my_bzero(d,l) 1111 # endif 1112 # endif 1113 #endif 1114 1115 #ifndef PERL_MICRO 1116 #ifndef memchr 1117 # ifndef HAS_MEMCHR 1118 # define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1) 1119 # endif 1120 #endif 1121 #endif 1122 1123 #ifndef HAS_BCMP 1124 # ifndef bcmp 1125 # define bcmp(s1,s2,l) memcmp(s1,s2,l) 1126 # endif 1127 #endif /* !HAS_BCMP */ 1128 1129 #ifdef I_NETINET_IN 1130 # include <netinet/in.h> 1131 #endif 1132 1133 #ifdef I_ARPA_INET 1134 # include <arpa/inet.h> 1135 #endif 1136 1137 #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO) 1138 /* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND 1139 * (the neo-BSD seem to do this). */ 1140 # undef SF_APPEND 1141 #endif 1142 1143 #ifdef I_SYS_STAT 1144 # include <sys/stat.h> 1145 #endif 1146 1147 /* Microsoft VC's sys/stat.h defines all S_Ixxx macros except S_IFIFO. 1148 This definition should ideally go into win32/win32.h, but S_IFIFO is 1149 used later here in perl.h before win32/win32.h is being included. */ 1150 #if !defined(S_IFIFO) && defined(_S_IFIFO) 1151 # define S_IFIFO _S_IFIFO 1152 #endif 1153 1154 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives 1155 like UTekV) are broken, sometimes giving false positives. Undefine 1156 them here and let the code below set them to proper values. 1157 1158 The ghs macro stands for GreenHills Software C-1.8.5 which 1159 is the C compiler for sysV88 and the various derivatives. 1160 This header file bug is corrected in gcc-2.5.8 and later versions. 1161 --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94. */ 1162 1163 #if defined(uts) || (defined(m88k) && defined(ghs)) 1164 # undef S_ISDIR 1165 # undef S_ISCHR 1166 # undef S_ISBLK 1167 # undef S_ISREG 1168 # undef S_ISFIFO 1169 # undef S_ISLNK 1170 #endif 1171 1172 #ifdef I_TIME 1173 # include <time.h> 1174 #endif 1175 1176 #ifdef I_SYS_TIME 1177 # ifdef I_SYS_TIME_KERNEL 1178 # define KERNEL 1179 # endif 1180 # include <sys/time.h> 1181 # ifdef I_SYS_TIME_KERNEL 1182 # undef KERNEL 1183 # endif 1184 #endif 1185 1186 #if defined(HAS_TIMES) && defined(I_SYS_TIMES) 1187 # include <sys/times.h> 1188 #endif 1189 1190 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR)) 1191 # undef HAS_STRERROR 1192 #endif 1193 1194 #include <errno.h> 1195 1196 #if defined(WIN32) && defined(PERL_IMPLICIT_SYS) 1197 # define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ 1198 #endif 1199 1200 /* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one. 1201 * This is important for using IPv6. 1202 * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be 1203 * a bad idea since it breaks send() and recv(). */ 1204 #if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X) 1205 # define _SOCKADDR_LEN 1206 #endif 1207 1208 #if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */ 1209 # include <sys/socket.h> 1210 # if defined(USE_SOCKS) && defined(I_SOCKS) 1211 # if !defined(INCLUDE_PROTOTYPES) 1212 # define INCLUDE_PROTOTYPES /* for <socks.h> */ 1213 # define PERL_SOCKS_NEED_PROTOTYPES 1214 # endif 1215 # include <socks.h> 1216 # ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */ 1217 # undef INCLUDE_PROTOTYPES 1218 # undef PERL_SOCKS_NEED_PROTOTYPES 1219 # endif 1220 # endif 1221 # ifdef I_NETDB 1222 # ifdef NETWARE 1223 # include<stdio.h> 1224 # endif 1225 # include <netdb.h> 1226 # endif 1227 # ifndef ENOTSOCK 1228 # ifdef I_NET_ERRNO 1229 # include <net/errno.h> 1230 # endif 1231 # endif 1232 #endif 1233 1234 /* sockatmark() is so new (2001) that many places might have it hidden 1235 * behind some -D_BLAH_BLAH_SOURCE guard. The __THROW magic is required 1236 * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */ 1237 #if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO) 1238 # if defined(__THROW) && defined(__GLIBC__) 1239 int sockatmark(int) __THROW; 1240 # else 1241 int sockatmark(int); 1242 # endif 1243 #endif 1244 1245 #if defined(__osf__) && defined(__cplusplus) && !defined(_XOPEN_SOURCE_EXTENDED) /* Tru64 "cxx" (C++), see hints/dec_osf.sh for why the _XOPEN_SOURCE_EXTENDED cannot be defined. */ 1246 EXTERN_C int fchdir(int); 1247 EXTERN_C int flock(int, int); 1248 EXTERN_C int fseeko(FILE *, off_t, int); 1249 EXTERN_C off_t ftello(FILE *); 1250 #endif 1251 1252 #if defined(__SUNPRO_CC) /* SUNWspro CC (C++) */ 1253 EXTERN_C char *crypt(const char *, const char *); 1254 EXTERN_C char **environ; 1255 #endif 1256 1257 #if defined(__cplusplus) 1258 # if defined(__OpenBSD__) || defined(__FreeBSD__) || defined(__NetBSD__) 1259 EXTERN_C char **environ; 1260 # elif defined(__CYGWIN__) 1261 EXTERN_C char *crypt(const char *, const char *); 1262 #endif 1263 #endif 1264 1265 #ifdef SETERRNO 1266 # undef SETERRNO /* SOCKS might have defined this */ 1267 #endif 1268 1269 #ifdef VMS 1270 # define SETERRNO(errcode,vmserrcode) \ 1271 STMT_START { \ 1272 set_errno(errcode); \ 1273 set_vaxc_errno(vmserrcode); \ 1274 } STMT_END 1275 # define dSAVEDERRNO int saved_errno; unsigned saved_vms_errno 1276 # define dSAVE_ERRNO int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno 1277 # define SAVE_ERRNO ( saved_errno = errno, saved_vms_errno = vaxc$errno ) 1278 # define RESTORE_ERRNO SETERRNO(saved_errno, saved_vms_errno) 1279 1280 # define LIB_INVARG LIB$_INVARG 1281 # define RMS_DIR RMS$_DIR 1282 # define RMS_FAC RMS$_FAC 1283 # define RMS_FEX RMS$_FEX 1284 # define RMS_FNF RMS$_FNF 1285 # define RMS_IFI RMS$_IFI 1286 # define RMS_ISI RMS$_ISI 1287 # define RMS_PRV RMS$_PRV 1288 # define SS_ACCVIO SS$_ACCVIO 1289 # define SS_DEVOFFLINE SS$_DEVOFFLINE 1290 # define SS_IVCHAN SS$_IVCHAN 1291 # define SS_NORMAL SS$_NORMAL 1292 #else 1293 # define SETERRNO(errcode,vmserrcode) (errno = (errcode)) 1294 # define dSAVEDERRNO int saved_errno 1295 # define dSAVE_ERRNO int saved_errno = errno 1296 # define SAVE_ERRNO (saved_errno = errno) 1297 # define RESTORE_ERRNO (errno = saved_errno) 1298 1299 # define LIB_INVARG 0 1300 # define RMS_DIR 0 1301 # define RMS_FAC 0 1302 # define RMS_FEX 0 1303 # define RMS_FNF 0 1304 # define RMS_IFI 0 1305 # define RMS_ISI 0 1306 # define RMS_PRV 0 1307 # define SS_ACCVIO 0 1308 # define SS_DEVOFFLINE 0 1309 # define SS_IVCHAN 0 1310 # define SS_NORMAL 0 1311 #endif 1312 1313 #define ERRSV GvSVn(PL_errgv) 1314 1315 #define CLEAR_ERRSV() STMT_START { \ 1316 if (!GvSV(PL_errgv)) { \ 1317 sv_setpvs(GvSV(gv_add_by_type(PL_errgv, SVt_PV)), ""); \ 1318 } else if (SvREADONLY(GvSV(PL_errgv))) { \ 1319 SvREFCNT_dec(GvSV(PL_errgv)); \ 1320 GvSV(PL_errgv) = newSVpvs(""); \ 1321 } else { \ 1322 SV *const errsv = GvSV(PL_errgv); \ 1323 sv_setpvs(errsv, ""); \ 1324 if (SvMAGICAL(errsv)) { \ 1325 mg_free(errsv); \ 1326 } \ 1327 SvPOK_only(errsv); \ 1328 } \ 1329 } STMT_END 1330 1331 1332 #ifdef PERL_CORE 1333 # define DEFSV (0 + GvSVn(PL_defgv)) 1334 #else 1335 # define DEFSV GvSVn(PL_defgv) 1336 #endif 1337 #define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) 1338 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 1339 1340 #define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ 1341 1342 #ifndef errno 1343 extern int errno; /* ANSI allows errno to be an lvalue expr. 1344 * For example in multithreaded environments 1345 * something like this might happen: 1346 * extern int *_errno(void); 1347 * #define errno (*_errno()) */ 1348 #endif 1349 1350 #ifdef HAS_STRERROR 1351 # ifdef VMS 1352 char *strerror (int,...); 1353 # else 1354 #ifndef DONT_DECLARE_STD 1355 char *strerror (int); 1356 #endif 1357 # endif 1358 # ifndef Strerror 1359 # define Strerror strerror 1360 # endif 1361 #else 1362 # ifdef HAS_SYS_ERRLIST 1363 extern int sys_nerr; 1364 extern char *sys_errlist[]; 1365 # ifndef Strerror 1366 # define Strerror(e) \ 1367 ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e]) 1368 # endif 1369 # endif 1370 #endif 1371 1372 #ifdef I_SYS_IOCTL 1373 # ifndef _IOCTL_ 1374 # include <sys/ioctl.h> 1375 # endif 1376 #endif 1377 1378 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000) 1379 # ifdef HAS_SOCKETPAIR 1380 # undef HAS_SOCKETPAIR 1381 # endif 1382 # ifdef I_NDBM 1383 # undef I_NDBM 1384 # endif 1385 #endif 1386 1387 #ifndef HAS_SOCKETPAIR 1388 # ifdef HAS_SOCKET 1389 # define socketpair Perl_my_socketpair 1390 # endif 1391 #endif 1392 1393 #if INTSIZE == 2 1394 # define htoni htons 1395 # define ntohi ntohs 1396 #else 1397 # define htoni htonl 1398 # define ntohi ntohl 1399 #endif 1400 1401 /* Configure already sets Direntry_t */ 1402 #if defined(I_DIRENT) 1403 # include <dirent.h> 1404 /* NeXT needs dirent + sys/dir.h */ 1405 # if defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__)) 1406 # include <sys/dir.h> 1407 # endif 1408 #else 1409 # ifdef I_SYS_NDIR 1410 # include <sys/ndir.h> 1411 # else 1412 # ifdef I_SYS_DIR 1413 # ifdef hp9000s500 1414 # include <ndir.h> /* may be wrong in the future */ 1415 # else 1416 # include <sys/dir.h> 1417 # endif 1418 # endif 1419 # endif 1420 #endif 1421 1422 #ifdef PERL_MICRO 1423 # ifndef DIR 1424 # define DIR void 1425 # endif 1426 #endif 1427 1428 #ifdef FPUTS_BOTCH 1429 /* work around botch in SunOS 4.0.1 and 4.0.2 */ 1430 # ifndef fputs 1431 # define fputs(sv,fp) fprintf(fp,"%s",sv) 1432 # endif 1433 #endif 1434 1435 /* 1436 * The following gobbledygook brought to you on behalf of __STDC__. 1437 * (I could just use #ifndef __STDC__, but this is more bulletproof 1438 * in the face of half-implementations.) 1439 */ 1440 1441 #if defined(I_SYSMODE) && !defined(PERL_MICRO) 1442 #include <sys/mode.h> 1443 #endif 1444 1445 #ifndef S_IFMT 1446 # ifdef _S_IFMT 1447 # define S_IFMT _S_IFMT 1448 # else 1449 # define S_IFMT 0170000 1450 # endif 1451 #endif 1452 1453 #ifndef S_ISDIR 1454 # define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR) 1455 #endif 1456 1457 #ifndef S_ISCHR 1458 # define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR) 1459 #endif 1460 1461 #ifndef S_ISBLK 1462 # ifdef S_IFBLK 1463 # define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK) 1464 # else 1465 # define S_ISBLK(m) (0) 1466 # endif 1467 #endif 1468 1469 #ifndef S_ISREG 1470 # define S_ISREG(m) ((m & S_IFMT) == S_IFREG) 1471 #endif 1472 1473 #ifndef S_ISFIFO 1474 # ifdef S_IFIFO 1475 # define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO) 1476 # else 1477 # define S_ISFIFO(m) (0) 1478 # endif 1479 #endif 1480 1481 #ifndef S_ISLNK 1482 # ifdef _S_ISLNK 1483 # define S_ISLNK(m) _S_ISLNK(m) 1484 # else 1485 # ifdef _S_IFLNK 1486 # define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK) 1487 # else 1488 # ifdef S_IFLNK 1489 # define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK) 1490 # else 1491 # define S_ISLNK(m) (0) 1492 # endif 1493 # endif 1494 # endif 1495 #endif 1496 1497 #ifndef S_ISSOCK 1498 # ifdef _S_ISSOCK 1499 # define S_ISSOCK(m) _S_ISSOCK(m) 1500 # else 1501 # ifdef _S_IFSOCK 1502 # define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK) 1503 # else 1504 # ifdef S_IFSOCK 1505 # define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK) 1506 # else 1507 # define S_ISSOCK(m) (0) 1508 # endif 1509 # endif 1510 # endif 1511 #endif 1512 1513 #ifndef S_IRUSR 1514 # ifdef S_IREAD 1515 # define S_IRUSR S_IREAD 1516 # define S_IWUSR S_IWRITE 1517 # define S_IXUSR S_IEXEC 1518 # else 1519 # define S_IRUSR 0400 1520 # define S_IWUSR 0200 1521 # define S_IXUSR 0100 1522 # endif 1523 #endif 1524 1525 #ifndef S_IRGRP 1526 # ifdef S_IRUSR 1527 # define S_IRGRP (S_IRUSR>>3) 1528 # define S_IWGRP (S_IWUSR>>3) 1529 # define S_IXGRP (S_IXUSR>>3) 1530 # else 1531 # define S_IRGRP 0040 1532 # define S_IWGRP 0020 1533 # define S_IXGRP 0010 1534 # endif 1535 #endif 1536 1537 #ifndef S_IROTH 1538 # ifdef S_IRUSR 1539 # define S_IROTH (S_IRUSR>>6) 1540 # define S_IWOTH (S_IWUSR>>6) 1541 # define S_IXOTH (S_IXUSR>>6) 1542 # else 1543 # define S_IROTH 0040 1544 # define S_IWOTH 0020 1545 # define S_IXOTH 0010 1546 # endif 1547 #endif 1548 1549 #ifndef S_ISUID 1550 # define S_ISUID 04000 1551 #endif 1552 1553 #ifndef S_ISGID 1554 # define S_ISGID 02000 1555 #endif 1556 1557 #ifndef S_IRWXU 1558 # define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) 1559 #endif 1560 1561 #ifndef S_IRWXG 1562 # define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) 1563 #endif 1564 1565 #ifndef S_IRWXO 1566 # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) 1567 #endif 1568 1569 /* BeOS 5.0 and Haiku R1 seem to define S_IREAD and S_IWRITE in <posix/fcntl.h> 1570 * which would get included through <sys/file.h >, but that is 3000 1571 * lines in the future. --jhi */ 1572 1573 #if !defined(S_IREAD) && !(defined(__BEOS__) || defined(__HAIKU__)) 1574 # define S_IREAD S_IRUSR 1575 #endif 1576 1577 #if !defined(S_IWRITE) && !(defined(__BEOS__) || defined(__HAIKU__)) 1578 # define S_IWRITE S_IWUSR 1579 #endif 1580 1581 #ifndef S_IEXEC 1582 # define S_IEXEC S_IXUSR 1583 #endif 1584 1585 #ifdef ff_next 1586 # undef ff_next 1587 #endif 1588 1589 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr) 1590 # define SLOPPYDIVIDE 1591 #endif 1592 1593 #ifdef UV 1594 #undef UV 1595 #endif 1596 1597 #ifdef SPRINTF_E_BUG 1598 # define sprintf UTS_sprintf_wrap 1599 #endif 1600 1601 /* For the times when you want the return value of sprintf, and you want it 1602 to be the length. Can't have a thread variable passed in, because C89 has 1603 no varargs macros. 1604 */ 1605 #ifdef SPRINTF_RETURNS_STRLEN 1606 # define my_sprintf sprintf 1607 #else 1608 # define my_sprintf Perl_my_sprintf 1609 #endif 1610 1611 /* 1612 * If we have v?snprintf() and the C99 variadic macros, we can just 1613 * use just the v?snprintf(). It is nice to try to trap the buffer 1614 * overflow, however, so if we are DEBUGGING, and we cannot use the 1615 * gcc statement expressions, then use the function wrappers which try 1616 * to trap the overflow. If we can use the gcc statement expressions, 1617 * we can try that even with the version that uses the C99 variadic 1618 * macros. 1619 */ 1620 1621 /* Note that we do not check against snprintf()/vsnprintf() returning 1622 * negative values because that is non-standard behaviour and we use 1623 * snprintf/vsnprintf only iff HAS_VSNPRINTF has been defined, and 1624 * that should be true only if the snprintf()/vsnprintf() are true 1625 * to the standard. */ 1626 1627 #if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) 1628 # ifdef PERL_USE_GCC_BRACE_GROUPS 1629 # define my_snprintf(buffer, len, ...) ({ int __len__ = snprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: snprintf buffer overflow"); __len__; }) 1630 # define PERL_MY_SNPRINTF_GUARDED 1631 # else 1632 # define my_snprintf(buffer, len, ...) snprintf(buffer, len, __VA_ARGS__) 1633 # endif 1634 #else 1635 # define my_snprintf Perl_my_snprintf 1636 # define PERL_MY_SNPRINTF_GUARDED 1637 #endif 1638 1639 #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) 1640 # ifdef PERL_USE_GCC_BRACE_GROUPS 1641 # define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; }) 1642 # define PERL_MY_VSNPRINTF_GUARDED 1643 # else 1644 # define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__) 1645 # endif 1646 #else 1647 # define my_vsnprintf Perl_my_vsnprintf 1648 # define PERL_MY_VSNPRINTF_GUARDED 1649 #endif 1650 1651 #ifdef HAS_STRLCAT 1652 # define my_strlcat strlcat 1653 #else 1654 # define my_strlcat Perl_my_strlcat 1655 #endif 1656 1657 #ifdef HAS_STRLCPY 1658 # define my_strlcpy strlcpy 1659 #else 1660 # define my_strlcpy Perl_my_strlcpy 1661 #endif 1662 1663 /* Configure gets this right but the UTS compiler gets it wrong. 1664 -- Hal Morris <hom00@utsglobal.com> */ 1665 #ifdef UTS 1666 # undef UVTYPE 1667 # define UVTYPE unsigned 1668 #endif 1669 1670 /* 1671 The IV type is supposed to be long enough to hold any integral 1672 value or a pointer. 1673 --Andy Dougherty August 1996 1674 */ 1675 1676 typedef IVTYPE IV; 1677 typedef UVTYPE UV; 1678 1679 #if defined(USE_64_BIT_INT) && defined(HAS_QUAD) 1680 # if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX) 1681 # define IV_MAX INT64_MAX 1682 # define IV_MIN INT64_MIN 1683 # define UV_MAX UINT64_MAX 1684 # ifndef UINT64_MIN 1685 # define UINT64_MIN 0 1686 # endif 1687 # define UV_MIN UINT64_MIN 1688 # else 1689 # define IV_MAX PERL_QUAD_MAX 1690 # define IV_MIN PERL_QUAD_MIN 1691 # define UV_MAX PERL_UQUAD_MAX 1692 # define UV_MIN PERL_UQUAD_MIN 1693 # endif 1694 # define IV_IS_QUAD 1695 # define UV_IS_QUAD 1696 #else 1697 # if defined(INT32_MAX) && IVSIZE == 4 1698 # define IV_MAX INT32_MAX 1699 # define IV_MIN INT32_MIN 1700 # ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ 1701 # define UV_MAX UINT32_MAX 1702 # else 1703 # define UV_MAX 4294967295U 1704 # endif 1705 # ifndef UINT32_MIN 1706 # define UINT32_MIN 0 1707 # endif 1708 # define UV_MIN UINT32_MIN 1709 # else 1710 # define IV_MAX PERL_LONG_MAX 1711 # define IV_MIN PERL_LONG_MIN 1712 # define UV_MAX PERL_ULONG_MAX 1713 # define UV_MIN PERL_ULONG_MIN 1714 # endif 1715 # if IVSIZE == 8 1716 # define IV_IS_QUAD 1717 # define UV_IS_QUAD 1718 # ifndef HAS_QUAD 1719 # define HAS_QUAD 1720 # endif 1721 # else 1722 # undef IV_IS_QUAD 1723 # undef UV_IS_QUAD 1724 # undef HAS_QUAD 1725 # endif 1726 #endif 1727 1728 #ifndef HAS_QUAD 1729 # undef PERL_NEED_MY_HTOLE64 1730 # undef PERL_NEED_MY_LETOH64 1731 # undef PERL_NEED_MY_HTOBE64 1732 # undef PERL_NEED_MY_BETOH64 1733 #endif 1734 1735 #if defined(uts) || defined(UTS) 1736 # undef UV_MAX 1737 # define UV_MAX (4294967295u) 1738 #endif 1739 1740 #define IV_DIG (BIT_DIGITS(IVSIZE * 8)) 1741 #define UV_DIG (BIT_DIGITS(UVSIZE * 8)) 1742 1743 #ifndef NO_PERL_PRESERVE_IVUV 1744 #define PERL_PRESERVE_IVUV /* We like our integers to stay integers. */ 1745 #endif 1746 1747 /* 1748 * The macros INT2PTR and NUM2PTR are (despite their names) 1749 * bi-directional: they will convert int/float to or from pointers. 1750 * However the conversion to int/float are named explicitly: 1751 * PTR2IV, PTR2UV, PTR2NV. 1752 * 1753 * For int conversions we do not need two casts if pointers are 1754 * the same size as IV and UV. Otherwise we need an explicit 1755 * cast (PTRV) to avoid compiler warnings. 1756 */ 1757 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) 1758 # define PTRV UV 1759 # define INT2PTR(any,d) (any)(d) 1760 #else 1761 # if PTRSIZE == LONGSIZE 1762 # define PTRV unsigned long 1763 # define PTR2ul(p) (unsigned long)(p) 1764 # else 1765 # define PTRV unsigned 1766 # endif 1767 #endif 1768 1769 #ifndef INT2PTR 1770 # define INT2PTR(any,d) (any)(PTRV)(d) 1771 #endif 1772 1773 #ifndef PTR2ul 1774 # define PTR2ul(p) INT2PTR(unsigned long,p) 1775 #endif 1776 1777 #define NUM2PTR(any,d) (any)(PTRV)(d) 1778 #define PTR2IV(p) INT2PTR(IV,p) 1779 #define PTR2UV(p) INT2PTR(UV,p) 1780 #define PTR2NV(p) NUM2PTR(NV,p) 1781 #define PTR2nat(p) (PTRV)(p) /* pointer to integer of PTRSIZE */ 1782 1783 /* According to strict ANSI C89 one cannot freely cast between 1784 * data pointers and function (code) pointers. There are at least 1785 * two ways around this. One (used below) is to do two casts, 1786 * first the other pointer to an (unsigned) integer, and then 1787 * the integer to the other pointer. The other way would be 1788 * to use unions to "overlay" the pointers. For an example of 1789 * the latter technique, see union dirpu in struct xpvio in sv.h. 1790 * The only feasible use is probably temporarily storing 1791 * function pointers in a data pointer (such as a void pointer). */ 1792 1793 #define DPTR2FPTR(t,p) ((t)PTR2nat(p)) /* data pointer to function pointer */ 1794 #define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */ 1795 1796 #ifdef USE_LONG_DOUBLE 1797 # if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE 1798 # define LONG_DOUBLE_EQUALS_DOUBLE 1799 # endif 1800 # if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)) 1801 # undef USE_LONG_DOUBLE /* Ouch! */ 1802 # endif 1803 #endif 1804 1805 #ifdef OVR_DBL_DIG 1806 /* Use an overridden DBL_DIG */ 1807 # ifdef DBL_DIG 1808 # undef DBL_DIG 1809 # endif 1810 # define DBL_DIG OVR_DBL_DIG 1811 #else 1812 /* The following is all to get DBL_DIG, in order to pick a nice 1813 default value for printing floating point numbers in Gconvert 1814 (see config.h). (It also has other uses, such as figuring out if 1815 a given precision of printing can be done with a double instead of 1816 a long double - Allen). 1817 */ 1818 #ifdef I_LIMITS 1819 #include <limits.h> 1820 #endif 1821 #ifdef I_FLOAT 1822 #include <float.h> 1823 #endif 1824 #ifndef HAS_DBL_DIG 1825 #define DBL_DIG 15 /* A guess that works lots of places */ 1826 #endif 1827 #endif 1828 1829 #ifdef OVR_LDBL_DIG 1830 /* Use an overridden LDBL_DIG */ 1831 # ifdef LDBL_DIG 1832 # undef LDBL_DIG 1833 # endif 1834 # define LDBL_DIG OVR_LDBL_DIG 1835 #else 1836 /* The following is all to get LDBL_DIG, in order to pick a nice 1837 default value for printing floating point numbers in Gconvert. 1838 (see config.h) 1839 */ 1840 # ifdef I_LIMITS 1841 # include <limits.h> 1842 # endif 1843 # ifdef I_FLOAT 1844 # include <float.h> 1845 # endif 1846 # ifndef HAS_LDBL_DIG 1847 # if LONG_DOUBLESIZE == 10 1848 # define LDBL_DIG 18 /* assume IEEE */ 1849 # else 1850 # if LONG_DOUBLESIZE == 12 1851 # define LDBL_DIG 18 /* gcc? */ 1852 # else 1853 # if LONG_DOUBLESIZE == 16 1854 # define LDBL_DIG 33 /* assume IEEE */ 1855 # else 1856 # if LONG_DOUBLESIZE == DOUBLESIZE 1857 # define LDBL_DIG DBL_DIG /* bummer */ 1858 # endif 1859 # endif 1860 # endif 1861 # endif 1862 # endif 1863 #endif 1864 1865 /* 1866 * This is for making sure we have a good DBL_MAX value, if possible, 1867 * either for usage as NV_MAX or for usage in figuring out if we can 1868 * fit a given long double into a double, if bug-fixing makes it 1869 * necessary to do so. - Allen <allens@cpan.org> 1870 */ 1871 1872 #ifdef I_LIMITS 1873 # include <limits.h> 1874 #endif 1875 1876 #ifdef I_VALUES 1877 # if !(defined(DBL_MIN) && defined(DBL_MAX) && defined(I_LIMITS)) 1878 # include <values.h> 1879 # if defined(MAXDOUBLE) && !defined(DBL_MAX) 1880 # define DBL_MAX MAXDOUBLE 1881 # endif 1882 # if defined(MINDOUBLE) && !defined(DBL_MIN) 1883 # define DBL_MIN MINDOUBLE 1884 # endif 1885 # endif 1886 #endif /* defined(I_VALUES) */ 1887 1888 typedef NVTYPE NV; 1889 1890 #ifdef I_IEEEFP 1891 # include <ieeefp.h> 1892 #endif 1893 1894 #ifdef USE_LONG_DOUBLE 1895 # ifdef I_SUNMATH 1896 # include <sunmath.h> 1897 # endif 1898 # define NV_DIG LDBL_DIG 1899 # ifdef LDBL_MANT_DIG 1900 # define NV_MANT_DIG LDBL_MANT_DIG 1901 # endif 1902 # ifdef LDBL_MIN 1903 # define NV_MIN LDBL_MIN 1904 # endif 1905 # ifdef LDBL_MAX 1906 # define NV_MAX LDBL_MAX 1907 # endif 1908 # ifdef LDBL_MIN_10_EXP 1909 # define NV_MIN_10_EXP LDBL_MIN_10_EXP 1910 # endif 1911 # ifdef LDBL_MAX_10_EXP 1912 # define NV_MAX_10_EXP LDBL_MAX_10_EXP 1913 # endif 1914 # ifdef LDBL_EPSILON 1915 # define NV_EPSILON LDBL_EPSILON 1916 # endif 1917 # ifdef LDBL_MAX 1918 # define NV_MAX LDBL_MAX 1919 /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */ 1920 # else 1921 # ifdef HUGE_VALL 1922 # define NV_MAX HUGE_VALL 1923 # else 1924 # ifdef HUGE_VAL 1925 # define NV_MAX ((NV)HUGE_VAL) 1926 # endif 1927 # endif 1928 # endif 1929 # ifdef HAS_SQRTL 1930 # define Perl_cos cosl 1931 # define Perl_sin sinl 1932 # define Perl_sqrt sqrtl 1933 # define Perl_exp expl 1934 # define Perl_log logl 1935 # define Perl_atan2 atan2l 1936 # define Perl_pow powl 1937 # define Perl_floor floorl 1938 # define Perl_ceil ceill 1939 # define Perl_fmod fmodl 1940 # endif 1941 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */ 1942 # ifdef HAS_MODFL 1943 # define Perl_modf(x,y) modfl(x,y) 1944 /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no 1945 prototype in <math.h> */ 1946 # ifndef HAS_MODFL_PROTO 1947 EXTERN_C long double modfl(long double, long double *); 1948 # endif 1949 # else 1950 # if defined(HAS_AINTL) && defined(HAS_COPYSIGNL) 1951 extern long double Perl_my_modfl(long double x, long double *ip); 1952 # define Perl_modf(x,y) Perl_my_modfl(x,y) 1953 # endif 1954 # endif 1955 # ifdef HAS_FREXPL 1956 # define Perl_frexp(x,y) frexpl(x,y) 1957 # else 1958 # if defined(HAS_ILOGBL) && defined(HAS_SCALBNL) 1959 extern long double Perl_my_frexpl(long double x, int *e); 1960 # define Perl_frexp(x,y) Perl_my_frexpl(x,y) 1961 # endif 1962 # endif 1963 # ifndef Perl_isnan 1964 # ifdef HAS_ISNANL 1965 # define Perl_isnan(x) isnanl(x) 1966 # endif 1967 # endif 1968 # ifndef Perl_isinf 1969 # ifdef HAS_FINITEL 1970 # define Perl_isinf(x) !(finitel(x)||Perl_isnan(x)) 1971 # endif 1972 # endif 1973 #else 1974 # define NV_DIG DBL_DIG 1975 # ifdef DBL_MANT_DIG 1976 # define NV_MANT_DIG DBL_MANT_DIG 1977 # endif 1978 # ifdef DBL_MIN 1979 # define NV_MIN DBL_MIN 1980 # endif 1981 # ifdef DBL_MAX 1982 # define NV_MAX DBL_MAX 1983 # endif 1984 # ifdef DBL_MIN_10_EXP 1985 # define NV_MIN_10_EXP DBL_MIN_10_EXP 1986 # endif 1987 # ifdef DBL_MAX_10_EXP 1988 # define NV_MAX_10_EXP DBL_MAX_10_EXP 1989 # endif 1990 # ifdef DBL_EPSILON 1991 # define NV_EPSILON DBL_EPSILON 1992 # endif 1993 # ifdef DBL_MAX /* XXX Does DBL_MAX imply having DBL_MIN? */ 1994 # define NV_MAX DBL_MAX 1995 # define NV_MIN DBL_MIN 1996 # else 1997 # ifdef HUGE_VAL 1998 # define NV_MAX HUGE_VAL 1999 # endif 2000 # endif 2001 # define Perl_cos cos 2002 # define Perl_sin sin 2003 # define Perl_sqrt sqrt 2004 # define Perl_exp exp 2005 # define Perl_log log 2006 # define Perl_atan2 atan2 2007 # define Perl_pow pow 2008 # define Perl_floor floor 2009 # define Perl_ceil ceil 2010 # define Perl_fmod fmod 2011 # define Perl_modf(x,y) modf(x,y) 2012 # define Perl_frexp(x,y) frexp(x,y) 2013 #endif 2014 2015 /* rumor has it that Win32 has _fpclass() */ 2016 2017 /* SGI has fpclassl... but not with the same result values, 2018 * and it's via a typedef (not via #define), so will need to redo Configure 2019 * to use. Not worth the trouble, IMO, at least until the below is used 2020 * more places. Also has fp_class_l, BTW, via fp_class.h. Feel free to check 2021 * with me for the SGI manpages, SGI testing, etcetera, if you want to 2022 * try getting this to work with IRIX. - Allen <allens@cpan.org> */ 2023 2024 #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) 2025 # ifdef I_IEEFP 2026 # include <ieeefp.h> 2027 # endif 2028 # ifdef I_FP 2029 # include <fp.h> 2030 # endif 2031 # if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL) 2032 # define Perl_fp_class() fpclassl(x) 2033 # else 2034 # define Perl_fp_class() fpclass(x) 2035 # endif 2036 # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN) 2037 # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN) 2038 # define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_CLASS_SNAN||Perl_fp_class(x)==FP_CLASS_QNAN) 2039 # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF) 2040 # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF) 2041 # define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_CLASS_NINF||Perl_fp_class(x)==FP_CLASS_PINF) 2042 # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM) 2043 # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM) 2044 # define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_CLASS_NNORM||Perl_fp_class(x)==FP_CLASS_PNORM) 2045 # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM) 2046 # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM) 2047 # define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM||Perl_fp_class(x)==FP_CLASS_PDENORM) 2048 # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO) 2049 # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO) 2050 # define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_CLASS_NZERO||Perl_fp_class(x)==FP_CLASS_PZERO) 2051 #endif 2052 2053 #if !defined(Perl_fp_class) && defined(HAS_FP_CLASS) && !defined(PERL_MICRO) 2054 # include <math.h> 2055 # if !defined(FP_SNAN) && defined(I_FP_CLASS) 2056 # include <fp_class.h> 2057 # endif 2058 # define Perl_fp_class(x) fp_class(x) 2059 # define Perl_fp_class_snan(x) (fp_class(x)==FP_SNAN) 2060 # define Perl_fp_class_qnan(x) (fp_class(x)==FP_QNAN) 2061 # define Perl_fp_class_nan(x) (fp_class(x)==FP_SNAN||fp_class(x)==FP_QNAN) 2062 # define Perl_fp_class_ninf(x) (fp_class(x)==FP_NEG_INF) 2063 # define Perl_fp_class_pinf(x) (fp_class(x)==FP_POS_INF) 2064 # define Perl_fp_class_inf(x) (fp_class(x)==FP_NEG_INF||fp_class(x)==FP_POS_INF) 2065 # define Perl_fp_class_nnorm(x) (fp_class(x)==FP_NEG_NORM) 2066 # define Perl_fp_class_pnorm(x) (fp_class(x)==FP_POS_NORM) 2067 # define Perl_fp_class_norm(x) (fp_class(x)==FP_NEG_NORM||fp_class(x)==FP_POS_NORM) 2068 # define Perl_fp_class_ndenorm(x) (fp_class(x)==FP_NEG_DENORM) 2069 # define Perl_fp_class_pdenorm(x) (fp_class(x)==FP_POS_DENORM) 2070 # define Perl_fp_class_denorm(x) (fp_class(x)==FP_NEG_DENORM||fp_class(x)==FP_POS_DENORM) 2071 # define Perl_fp_class_nzero(x) (fp_class(x)==FP_NEG_ZERO) 2072 # define Perl_fp_class_pzero(x) (fp_class(x)==FP_POS_ZERO) 2073 # define Perl_fp_class_zero(x) (fp_class(x)==FP_NEG_ZERO||fp_class(x)==FP_POS_ZERO) 2074 #endif 2075 2076 #if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY) 2077 # include <math.h> 2078 # define Perl_fp_class(x) fpclassify(x) 2079 # define Perl_fp_class_nan(x) (fp_classify(x)==FP_SNAN||fp_classify(x)==FP_QNAN) 2080 # define Perl_fp_class_inf(x) (fp_classify(x)==FP_INFINITE) 2081 # define Perl_fp_class_norm(x) (fp_classify(x)==FP_NORMAL) 2082 # define Perl_fp_class_denorm(x) (fp_classify(x)==FP_SUBNORMAL) 2083 # define Perl_fp_class_zero(x) (fp_classify(x)==FP_ZERO) 2084 #endif 2085 2086 #if !defined(Perl_fp_class) && defined(HAS_CLASS) 2087 # include <math.h> 2088 # ifndef _cplusplus 2089 # define Perl_fp_class(x) class(x) 2090 # else 2091 # define Perl_fp_class(x) _class(x) 2092 # endif 2093 # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) 2094 # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) 2095 # define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_SNAN||Perl_fp_class(x)==FP_QNAN) 2096 # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) 2097 # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) 2098 # define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_MINUS_INF||Perl_fp_class(x)==FP_PLUS_INF) 2099 # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) 2100 # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) 2101 # define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_MINUS_NORM||Perl_fp_class(x)==FP_PLUS_NORM) 2102 # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) 2103 # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) 2104 # define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM||Perl_fp_class(x)==FP_PLUS_DENORM) 2105 # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) 2106 # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) 2107 # define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_MINUS_ZERO||Perl_fp_class(x)==FP_PLUS_ZERO) 2108 #endif 2109 2110 /* rumor has it that Win32 has _isnan() */ 2111 2112 #ifndef Perl_isnan 2113 # ifdef HAS_ISNAN 2114 # define Perl_isnan(x) isnan((NV)x) 2115 # else 2116 # ifdef Perl_fp_class_nan 2117 # define Perl_isnan(x) Perl_fp_class_nan(x) 2118 # else 2119 # ifdef HAS_UNORDERED 2120 # define Perl_isnan(x) unordered((x), 0.0) 2121 # else 2122 # define Perl_isnan(x) ((x)!=(x)) 2123 # endif 2124 # endif 2125 # endif 2126 #endif 2127 2128 #ifdef UNDER_CE 2129 int isnan(double d); 2130 #endif 2131 2132 #ifndef Perl_isinf 2133 # ifdef HAS_ISINF 2134 # define Perl_isinf(x) isinf((NV)x) 2135 # else 2136 # ifdef Perl_fp_class_inf 2137 # define Perl_isinf(x) Perl_fp_class_inf(x) 2138 # else 2139 # define Perl_isinf(x) ((x)==NV_INF) 2140 # endif 2141 # endif 2142 #endif 2143 2144 #ifndef Perl_isfinite 2145 # ifdef HAS_FINITE 2146 # define Perl_isfinite(x) finite((NV)x) 2147 # else 2148 # ifdef HAS_ISFINITE 2149 # define Perl_isfinite(x) isfinite(x) 2150 # else 2151 # ifdef Perl_fp_class_finite 2152 # define Perl_isfinite(x) Perl_fp_class_finite(x) 2153 # else 2154 # define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x)) 2155 # endif 2156 # endif 2157 # endif 2158 #endif 2159 2160 /* The default is to use Perl's own atof() implementation (in numeric.c). 2161 * Usually that is the one to use but for some platforms (e.g. UNICOS) 2162 * it is however best to use the native implementation of atof. 2163 * You can experiment with using your native one by -DUSE_PERL_ATOF=0. 2164 * Some good tests to try out with either setting are t/base/num.t, 2165 * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles 2166 * you may need to be using a different function than atof! */ 2167 2168 #ifndef USE_PERL_ATOF 2169 # ifndef _UNICOS 2170 # define USE_PERL_ATOF 2171 # endif 2172 #else 2173 # if USE_PERL_ATOF == 0 2174 # undef USE_PERL_ATOF 2175 # endif 2176 #endif 2177 2178 #ifdef USE_PERL_ATOF 2179 # define Perl_atof(s) Perl_my_atof(s) 2180 # define Perl_atof2(s, n) Perl_my_atof2(aTHX_ (s), &(n)) 2181 #else 2182 # define Perl_atof(s) (NV)atof(s) 2183 # define Perl_atof2(s, n) ((n) = atof(s)) 2184 #endif 2185 2186 /* Previously these definitions used hardcoded figures. 2187 * It is hoped these formula are more portable, although 2188 * no data one way or another is presently known to me. 2189 * The "PERL_" names are used because these calculated constants 2190 * do not meet the ANSI requirements for LONG_MAX, etc., which 2191 * need to be constants acceptable to #if - kja 2192 * define PERL_LONG_MAX 2147483647L 2193 * define PERL_LONG_MIN (-LONG_MAX - 1) 2194 * define PERL ULONG_MAX 4294967295L 2195 */ 2196 2197 #ifdef I_LIMITS /* Needed for cast_xxx() functions below. */ 2198 # include <limits.h> 2199 #endif 2200 /* Included values.h above if necessary; still including limits.h down here, 2201 * despite doing above, because math.h might have overriden... XXX - Allen */ 2202 2203 /* 2204 * Try to figure out max and min values for the integral types. THE CORRECT 2205 * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE. The 2206 * following hacks are used if neither limits.h or values.h provide them: 2207 * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0 2208 * for types < int: (unsigned TYPE)~(unsigned)0 2209 * The argument to ~ must be unsigned so that later signed->unsigned 2210 * conversion can't modify the value's bit pattern (e.g. -0 -> +0), 2211 * and it must not be smaller than int because ~ does integral promotion. 2212 * <type>_MAX: (<type>) (U<type>_MAX >> 1) 2213 * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>. 2214 * The latter is a hack which happens to work on some machines but 2215 * does *not* catch any random system, or things like integer types 2216 * with NaN if that is possible. 2217 * 2218 * All of the types are explicitly cast to prevent accidental loss of 2219 * numeric range, and in the hope that they will be less likely to confuse 2220 * over-eager optimizers. 2221 * 2222 */ 2223 2224 #define PERL_UCHAR_MIN ((unsigned char)0) 2225 2226 #ifdef UCHAR_MAX 2227 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) 2228 #else 2229 # ifdef MAXUCHAR 2230 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) 2231 # else 2232 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) 2233 # endif 2234 #endif 2235 2236 /* 2237 * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be 2238 * ambiguous. It may be equivalent to (signed char) or (unsigned char) 2239 * depending on local options. Until Configure detects this (or at least 2240 * detects whether the "signed" keyword is available) the CHAR ranges 2241 * will not be included. UCHAR functions normally. 2242 * - kja 2243 */ 2244 2245 #define PERL_USHORT_MIN ((unsigned short)0) 2246 2247 #ifdef USHORT_MAX 2248 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) 2249 #else 2250 # ifdef MAXUSHORT 2251 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) 2252 # else 2253 # ifdef USHRT_MAX 2254 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) 2255 # else 2256 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) 2257 # endif 2258 # endif 2259 #endif 2260 2261 #ifdef SHORT_MAX 2262 # define PERL_SHORT_MAX ((short)SHORT_MAX) 2263 #else 2264 # ifdef MAXSHORT /* Often used in <values.h> */ 2265 # define PERL_SHORT_MAX ((short)MAXSHORT) 2266 # else 2267 # ifdef SHRT_MAX 2268 # define PERL_SHORT_MAX ((short)SHRT_MAX) 2269 # else 2270 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) 2271 # endif 2272 # endif 2273 #endif 2274 2275 #ifdef SHORT_MIN 2276 # define PERL_SHORT_MIN ((short)SHORT_MIN) 2277 #else 2278 # ifdef MINSHORT 2279 # define PERL_SHORT_MIN ((short)MINSHORT) 2280 # else 2281 # ifdef SHRT_MIN 2282 # define PERL_SHORT_MIN ((short)SHRT_MIN) 2283 # else 2284 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) 2285 # endif 2286 # endif 2287 #endif 2288 2289 #ifdef UINT_MAX 2290 # define PERL_UINT_MAX ((unsigned int)UINT_MAX) 2291 #else 2292 # ifdef MAXUINT 2293 # define PERL_UINT_MAX ((unsigned int)MAXUINT) 2294 # else 2295 # define PERL_UINT_MAX (~(unsigned int)0) 2296 # endif 2297 #endif 2298 2299 #define PERL_UINT_MIN ((unsigned int)0) 2300 2301 #ifdef INT_MAX 2302 # define PERL_INT_MAX ((int)INT_MAX) 2303 #else 2304 # ifdef MAXINT /* Often used in <values.h> */ 2305 # define PERL_INT_MAX ((int)MAXINT) 2306 # else 2307 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) 2308 # endif 2309 #endif 2310 2311 #ifdef INT_MIN 2312 # define PERL_INT_MIN ((int)INT_MIN) 2313 #else 2314 # ifdef MININT 2315 # define PERL_INT_MIN ((int)MININT) 2316 # else 2317 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) 2318 # endif 2319 #endif 2320 2321 #ifdef ULONG_MAX 2322 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) 2323 #else 2324 # ifdef MAXULONG 2325 # define PERL_ULONG_MAX ((unsigned long)MAXULONG) 2326 # else 2327 # define PERL_ULONG_MAX (~(unsigned long)0) 2328 # endif 2329 #endif 2330 2331 #define PERL_ULONG_MIN ((unsigned long)0L) 2332 2333 #ifdef LONG_MAX 2334 # define PERL_LONG_MAX ((long)LONG_MAX) 2335 #else 2336 # ifdef MAXLONG /* Often used in <values.h> */ 2337 # define PERL_LONG_MAX ((long)MAXLONG) 2338 # else 2339 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) 2340 # endif 2341 #endif 2342 2343 #ifdef LONG_MIN 2344 # define PERL_LONG_MIN ((long)LONG_MIN) 2345 #else 2346 # ifdef MINLONG 2347 # define PERL_LONG_MIN ((long)MINLONG) 2348 # else 2349 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) 2350 # endif 2351 #endif 2352 2353 #ifdef UV_IS_QUAD 2354 2355 # define PERL_UQUAD_MAX (~(UV)0) 2356 # define PERL_UQUAD_MIN ((UV)0) 2357 # define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1)) 2358 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) 2359 2360 #endif 2361 2362 #ifdef MYMALLOC 2363 # include "malloc_ctl.h" 2364 #endif 2365 2366 struct RExC_state_t; 2367 struct _reg_trie_data; 2368 2369 typedef MEM_SIZE STRLEN; 2370 2371 #ifdef PERL_MAD 2372 typedef struct token TOKEN; 2373 typedef struct madprop MADPROP; 2374 typedef struct nexttoken NEXTTOKE; 2375 #endif 2376 typedef struct op OP; 2377 typedef struct cop COP; 2378 typedef struct unop UNOP; 2379 typedef struct binop BINOP; 2380 typedef struct listop LISTOP; 2381 typedef struct logop LOGOP; 2382 typedef struct pmop PMOP; 2383 typedef struct svop SVOP; 2384 typedef struct padop PADOP; 2385 typedef struct pvop PVOP; 2386 typedef struct loop LOOP; 2387 2388 typedef struct interpreter PerlInterpreter; 2389 2390 /* Amdahl's <ksync.h> has struct sv */ 2391 /* SGI's <sys/sema.h> has struct sv */ 2392 #if defined(UTS) || defined(__sgi) 2393 # define STRUCT_SV perl_sv 2394 #else 2395 # define STRUCT_SV sv 2396 #endif 2397 typedef struct STRUCT_SV SV; 2398 typedef struct av AV; 2399 typedef struct hv HV; 2400 typedef struct cv CV; 2401 typedef struct regexp ORANGE; /* This is the body structure. */ 2402 typedef struct p5rx REGEXP; 2403 typedef struct gp GP; 2404 typedef struct gv GV; 2405 typedef struct io IO; 2406 typedef struct context PERL_CONTEXT; 2407 typedef struct block BLOCK; 2408 2409 typedef struct magic MAGIC; 2410 typedef struct xpv XPV; 2411 typedef struct xpviv XPVIV; 2412 typedef struct xpvuv XPVUV; 2413 typedef struct xpvnv XPVNV; 2414 typedef struct xpvmg XPVMG; 2415 typedef struct xpvlv XPVLV; 2416 typedef struct xpvav XPVAV; 2417 typedef struct xpvhv XPVHV; 2418 typedef struct xpvgv XPVGV; 2419 typedef struct xpvcv XPVCV; 2420 typedef struct xpvbm XPVBM; 2421 typedef struct xpvfm XPVFM; 2422 typedef struct xpvio XPVIO; 2423 typedef struct mgvtbl MGVTBL; 2424 typedef union any ANY; 2425 typedef struct ptr_tbl_ent PTR_TBL_ENT_t; 2426 typedef struct ptr_tbl PTR_TBL_t; 2427 typedef struct clone_params CLONE_PARAMS; 2428 2429 #include "handy.h" 2430 2431 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) 2432 # if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) 2433 # define USE_64_BIT_RAWIO /* implicit */ 2434 # endif 2435 #endif 2436 2437 /* Notice the use of HAS_FSEEKO: now we are obligated to always use 2438 * fseeko/ftello if possible. Don't go #defining ftell to ftello yourself, 2439 * however, because operating systems like to do that themself. */ 2440 #ifndef FSEEKSIZE 2441 # ifdef HAS_FSEEKO 2442 # define FSEEKSIZE LSEEKSIZE 2443 # else 2444 # define FSEEKSIZE LONGSIZE 2445 # endif 2446 #endif 2447 2448 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO) 2449 # if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO) 2450 # define USE_64_BIT_STDIO /* implicit */ 2451 # endif 2452 #endif 2453 2454 #ifdef USE_64_BIT_RAWIO 2455 # ifdef HAS_OFF64_T 2456 # undef Off_t 2457 # define Off_t off64_t 2458 # undef LSEEKSIZE 2459 # define LSEEKSIZE 8 2460 # endif 2461 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that 2462 * will trigger defines like the ones below. Some 64-bit environments, 2463 * however, do not. Therefore we have to explicitly mix and match. */ 2464 # if defined(USE_OPEN64) 2465 # define open open64 2466 # endif 2467 # if defined(USE_LSEEK64) 2468 # define lseek lseek64 2469 # else 2470 # if defined(USE_LLSEEK) 2471 # define lseek llseek 2472 # endif 2473 # endif 2474 # if defined(USE_STAT64) 2475 # define stat stat64 2476 # endif 2477 # if defined(USE_FSTAT64) 2478 # define fstat fstat64 2479 # endif 2480 # if defined(USE_LSTAT64) 2481 # define lstat lstat64 2482 # endif 2483 # if defined(USE_FLOCK64) 2484 # define flock flock64 2485 # endif 2486 # if defined(USE_LOCKF64) 2487 # define lockf lockf64 2488 # endif 2489 # if defined(USE_FCNTL64) 2490 # define fcntl fcntl64 2491 # endif 2492 # if defined(USE_TRUNCATE64) 2493 # define truncate truncate64 2494 # endif 2495 # if defined(USE_FTRUNCATE64) 2496 # define ftruncate ftruncate64 2497 # endif 2498 #endif 2499 2500 #ifdef USE_64_BIT_STDIO 2501 # ifdef HAS_FPOS64_T 2502 # undef Fpos_t 2503 # define Fpos_t fpos64_t 2504 # endif 2505 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that 2506 * will trigger defines like the ones below. Some 64-bit environments, 2507 * however, do not. */ 2508 # if defined(USE_FOPEN64) 2509 # define fopen fopen64 2510 # endif 2511 # if defined(USE_FSEEK64) 2512 # define fseek fseek64 /* don't do fseeko here, see perlio.c */ 2513 # endif 2514 # if defined(USE_FTELL64) 2515 # define ftell ftell64 /* don't do ftello here, see perlio.c */ 2516 # endif 2517 # if defined(USE_FSETPOS64) 2518 # define fsetpos fsetpos64 2519 # endif 2520 # if defined(USE_FGETPOS64) 2521 # define fgetpos fgetpos64 2522 # endif 2523 # if defined(USE_TMPFILE64) 2524 # define tmpfile tmpfile64 2525 # endif 2526 # if defined(USE_FREOPEN64) 2527 # define freopen freopen64 2528 # endif 2529 #endif 2530 2531 #if defined(OS2) 2532 # include "iperlsys.h" 2533 #endif 2534 2535 #if defined(__OPEN_VM) 2536 # include "vmesa/vmesaish.h" 2537 # define ISHISH "vmesa" 2538 #endif 2539 2540 #ifdef DOSISH 2541 # if defined(OS2) 2542 # include "os2ish.h" 2543 # else 2544 # include "dosish.h" 2545 # endif 2546 # define ISHISH "dos" 2547 #endif 2548 2549 #if defined(VMS) 2550 # include "vmsish.h" 2551 # include "embed.h" 2552 # ifndef PERL_MAD 2553 # undef op_getmad 2554 # define op_getmad(arg,pegop,slot) NOOP 2555 # endif 2556 # define ISHISH "vms" 2557 #endif 2558 2559 #if defined(PLAN9) 2560 # include "./plan9/plan9ish.h" 2561 # define ISHISH "plan9" 2562 #endif 2563 2564 #if defined(MPE) 2565 # include "mpeix/mpeixish.h" 2566 # define ISHISH "mpeix" 2567 #endif 2568 2569 #if defined(__VOS__) 2570 # ifdef __GNUC__ 2571 # include "./vos/vosish.h" 2572 # else 2573 # include "vos/vosish.h" 2574 # endif 2575 # define ISHISH "vos" 2576 #endif 2577 2578 #if defined(EPOC) 2579 # include "epocish.h" 2580 # define ISHISH "epoc" 2581 #endif 2582 2583 #ifdef __SYMBIAN32__ 2584 # include "symbian/symbianish.h" 2585 # include "embed.h" 2586 # ifndef PERL_MAD 2587 # undef op_getmad 2588 # define op_getmad(arg,pegop,slot) NOOP 2589 # endif 2590 # define ISHISH "symbian" 2591 #endif 2592 2593 2594 #if defined(__HAIKU__) 2595 # include "haiku/haikuish.h" 2596 # define ISHISH "haiku" 2597 #elif defined(__BEOS__) 2598 # include "beos/beosish.h" 2599 # define ISHISH "beos" 2600 #endif 2601 2602 #ifndef ISHISH 2603 # include "unixish.h" 2604 # define ISHISH "unix" 2605 #endif 2606 2607 /* NSIG logic from Configure --> */ 2608 /* Strange style to avoid deeply-nested #if/#else/#endif */ 2609 #ifndef NSIG 2610 # ifdef _NSIG 2611 # define NSIG (_NSIG) 2612 # endif 2613 #endif 2614 2615 #ifndef NSIG 2616 # ifdef SIGMAX 2617 # define NSIG (SIGMAX+1) 2618 # endif 2619 #endif 2620 2621 #ifndef NSIG 2622 # ifdef SIG_MAX 2623 # define NSIG (SIG_MAX+1) 2624 # endif 2625 #endif 2626 2627 #ifndef NSIG 2628 # ifdef _SIG_MAX 2629 # define NSIG (_SIG_MAX+1) 2630 # endif 2631 #endif 2632 2633 #ifndef NSIG 2634 # ifdef MAXSIG 2635 # define NSIG (MAXSIG+1) 2636 # endif 2637 #endif 2638 2639 #ifndef NSIG 2640 # ifdef MAX_SIG 2641 # define NSIG (MAX_SIG+1) 2642 # endif 2643 #endif 2644 2645 #ifndef NSIG 2646 # ifdef SIGARRAYSIZE 2647 # define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */ 2648 # endif 2649 #endif 2650 2651 #ifndef NSIG 2652 # ifdef _sys_nsig 2653 # define NSIG (_sys_nsig) /* Solaris 2.5 */ 2654 # endif 2655 #endif 2656 2657 /* Default to some arbitrary number that's big enough to get most 2658 of the common signals. 2659 */ 2660 #ifndef NSIG 2661 # define NSIG 50 2662 #endif 2663 /* <-- NSIG logic from Configure */ 2664 2665 #ifndef NO_ENVIRON_ARRAY 2666 # define USE_ENVIRON_ARRAY 2667 #endif 2668 2669 /* 2670 * initialise to avoid floating-point exceptions from overflow, etc 2671 */ 2672 #ifndef PERL_FPU_INIT 2673 # ifdef HAS_FPSETMASK 2674 # if HAS_FLOATINGPOINT_H 2675 # include <floatingpoint.h> 2676 # endif 2677 /* Some operating systems have this as a macro, which in turn expands to a comma 2678 expression, and the last sub-expression is something that gets calculated, 2679 and then they have the gall to warn that a value computed is not used. Hence 2680 cast to void. */ 2681 # define PERL_FPU_INIT (void)fpsetmask(0) 2682 # else 2683 # if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO) 2684 # define PERL_FPU_INIT PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN) 2685 # define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe); 2686 # define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); } 2687 # else 2688 # define PERL_FPU_INIT 2689 2690 # endif 2691 # endif 2692 #endif 2693 #ifndef PERL_FPU_PRE_EXEC 2694 # define PERL_FPU_PRE_EXEC { 2695 # define PERL_FPU_POST_EXEC } 2696 #endif 2697 2698 #ifndef PERL_SYS_INIT3_BODY 2699 # define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp) 2700 #endif 2701 2702 /* 2703 =for apidoc Am|void|PERL_SYS_INIT|int argc|char** argv 2704 Provides system-specific tune up of the C runtime environment necessary to 2705 run Perl interpreters. This should be called only once, before creating 2706 any Perl interpreters. 2707 2708 =for apidoc Am|void|PERL_SYS_INIT3|int argc|char** argv|char** env 2709 Provides system-specific tune up of the C runtime environment necessary to 2710 run Perl interpreters. This should be called only once, before creating 2711 any Perl interpreters. 2712 2713 =for apidoc Am|void|PERL_SYS_TERM| 2714 Provides system-specific clean up of the C runtime environment after 2715 running Perl interpreters. This should be called only once, after 2716 freeing any remaining Perl interpreters. 2717 2718 =cut 2719 */ 2720 2721 #define PERL_SYS_INIT(argc, argv) Perl_sys_init(argc, argv) 2722 #define PERL_SYS_INIT3(argc, argv, env) Perl_sys_init3(argc, argv, env) 2723 #define PERL_SYS_TERM() Perl_sys_term() 2724 2725 #ifndef PERL_WRITE_MSG_TO_CONSOLE 2726 # define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) PerlIO_write(io, msg, len) 2727 #endif 2728 2729 #ifndef MAXPATHLEN 2730 # ifdef PATH_MAX 2731 # ifdef _POSIX_PATH_MAX 2732 # if PATH_MAX > _POSIX_PATH_MAX 2733 /* POSIX 1990 (and pre) was ambiguous about whether PATH_MAX 2734 * included the null byte or not. Later amendments of POSIX, 2735 * XPG4, the Austin Group, and the Single UNIX Specification 2736 * all explicitly include the null byte in the PATH_MAX. 2737 * Ditto for _POSIX_PATH_MAX. */ 2738 # define MAXPATHLEN PATH_MAX 2739 # else 2740 # define MAXPATHLEN _POSIX_PATH_MAX 2741 # endif 2742 # else 2743 # define MAXPATHLEN (PATH_MAX+1) 2744 # endif 2745 # else 2746 # ifdef _POSIX_PATH_MAX 2747 # define MAXPATHLEN _POSIX_PATH_MAX 2748 # else 2749 # define MAXPATHLEN 1024 /* Err on the large side. */ 2750 # endif 2751 # endif 2752 #endif 2753 2754 /* In case Configure was not used (we are using a "canned config" 2755 * such as Win32, or a cross-compilation setup, for example) try going 2756 * by the gcc major and minor versions. One useful URL is 2757 * http://www.ohse.de/uwe/articles/gcc-attributes.html, 2758 * but contrary to this information warn_unused_result seems 2759 * not to be in gcc 3.3.5, at least. --jhi 2760 * Also, when building extensions with an installed perl, this allows 2761 * the user to upgrade gcc and get the right attributes, rather than 2762 * relying on the list generated at Configure time. --AD 2763 * Set these up now otherwise we get confused when some of the <*thread.h> 2764 * includes below indirectly pull in <perlio.h> (which needs to know if we 2765 * have HASATTRIBUTE_FORMAT). 2766 */ 2767 2768 #ifndef PERL_MICRO 2769 #if defined __GNUC__ && !defined(__INTEL_COMPILER) 2770 # if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */ 2771 # define HASATTRIBUTE_DEPRECATED 2772 # endif 2773 # if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */ 2774 # define HASATTRIBUTE_FORMAT 2775 # if defined __MINGW32__ 2776 # define PRINTF_FORMAT_NULL_OK 2777 # endif 2778 # endif 2779 # if __GNUC__ >= 3 /* 3.0 -> */ 2780 # define HASATTRIBUTE_MALLOC 2781 # endif 2782 # if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */ 2783 # define HASATTRIBUTE_NONNULL 2784 # endif 2785 # if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */ 2786 # define HASATTRIBUTE_NORETURN 2787 # endif 2788 # if __GNUC__ >= 3 /* gcc 3.0 -> */ 2789 # define HASATTRIBUTE_PURE 2790 # endif 2791 # if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ 2792 # define HASATTRIBUTE_UNUSED 2793 # endif 2794 # if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus) 2795 # define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ 2796 # endif 2797 # if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ 2798 # define HASATTRIBUTE_WARN_UNUSED_RESULT 2799 # endif 2800 #endif 2801 #endif /* #ifndef PERL_MICRO */ 2802 2803 /* USE_5005THREADS needs to be after unixish.h as <pthread.h> includes 2804 * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h> 2805 * this results in many functions being undeclared which bothers C++ 2806 * May make sense to have threads after "*ish.h" anyway 2807 */ 2808 2809 #if defined(USE_ITHREADS) 2810 # ifdef NETWARE 2811 # include <nw5thread.h> 2812 # else 2813 # ifdef FAKE_THREADS 2814 # include "fakethr.h" 2815 # else 2816 # ifdef WIN32 2817 # include <win32thread.h> 2818 # else 2819 # ifdef OS2 2820 # include "os2thread.h" 2821 # else 2822 # ifdef I_MACH_CTHREADS 2823 # include <mach/cthreads.h> 2824 # if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC) 2825 # define MUTEX_INIT_CALLS_MALLOC 2826 # endif 2827 typedef cthread_t perl_os_thread; 2828 typedef mutex_t perl_mutex; 2829 typedef condition_t perl_cond; 2830 typedef void * perl_key; 2831 # else /* Posix threads */ 2832 # ifdef I_PTHREAD 2833 # include <pthread.h> 2834 # endif 2835 typedef pthread_t perl_os_thread; 2836 typedef pthread_mutex_t perl_mutex; 2837 typedef pthread_cond_t perl_cond; 2838 typedef pthread_key_t perl_key; 2839 # endif /* I_MACH_CTHREADS */ 2840 # endif /* OS2 */ 2841 # endif /* WIN32 */ 2842 # endif /* FAKE_THREADS */ 2843 #endif /* NETWARE */ 2844 #endif /* USE_ITHREADS */ 2845 2846 #if defined(WIN32) 2847 # include "win32.h" 2848 #endif 2849 2850 #ifdef NETWARE 2851 # include "netware.h" 2852 #endif 2853 2854 #define STATUS_UNIX PL_statusvalue 2855 #ifdef VMS 2856 # define STATUS_NATIVE PL_statusvalue_vms 2857 /* 2858 * vaxc$errno is only guaranteed to be valid if errno == EVMSERR, otherwise 2859 * its contents can not be trusted. Unfortunately, Perl seems to check 2860 * it on exit, so it when PL_statusvalue_vms is updated, vaxc$errno should 2861 * be updated also. 2862 */ 2863 # include <stsdef.h> 2864 # include <ssdef.h> 2865 /* Presume this because if VMS changes it, it will require a new 2866 * set of APIs for waiting on children for binary compatibility. 2867 */ 2868 # define child_offset_bits (8) 2869 # ifndef C_FAC_POSIX 2870 # define C_FAC_POSIX 0x35A000 2871 # endif 2872 2873 /* STATUS_EXIT - validates and returns a NATIVE exit status code for the 2874 * platform from the existing UNIX or Native status values. 2875 */ 2876 2877 # define STATUS_EXIT \ 2878 (((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \ 2879 (VMSISH_HUSHED ? STS$M_INHIB_MSG : 0)) 2880 2881 2882 /* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the child 2883 * exit code and shifts the UNIX value over the correct number of bits to 2884 * be a child status. Usually the number of bits is 8, but that could be 2885 * platform dependent. The NATIVE status code is presumed to have either 2886 * from a child process. 2887 */ 2888 2889 /* This is complicated. The child processes return a true native VMS 2890 status which must be saved. But there is an assumption in Perl that 2891 the UNIX child status has some relationship to errno values, so 2892 Perl tries to translate it to text in some of the tests. 2893 In order to get the string translation correct, for the error, errno 2894 must be EVMSERR, but that generates a different text message 2895 than what the test programs are expecting. So an errno value must 2896 be derived from the native status value when an error occurs. 2897 That will hide the true native status message. With this version of 2898 perl, the true native child status can always be retrieved so that 2899 is not a problem. But in this case, Pl_statusvalue and errno may 2900 have different values in them. 2901 */ 2902 2903 # define STATUS_NATIVE_CHILD_SET(n) \ 2904 STMT_START { \ 2905 I32 evalue = (I32)n; \ 2906 if (evalue == EVMSERR) { \ 2907 PL_statusvalue_vms = vaxc$errno; \ 2908 PL_statusvalue = evalue; \ 2909 } else { \ 2910 PL_statusvalue_vms = evalue; \ 2911 if (evalue == -1) { \ 2912 PL_statusvalue = -1; \ 2913 PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \ 2914 } else \ 2915 PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \ 2916 set_vaxc_errno(evalue); \ 2917 if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \ 2918 set_errno(EVMSERR); \ 2919 else set_errno(Perl_vms_status_to_unix(evalue, 0)); \ 2920 PL_statusvalue = PL_statusvalue << child_offset_bits; \ 2921 } \ 2922 } STMT_END 2923 2924 # ifdef VMSISH_STATUS 2925 # define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX) 2926 # else 2927 # define STATUS_CURRENT STATUS_UNIX 2928 # endif 2929 2930 /* STATUS_UNIX_SET - takes a UNIX/POSIX errno value and attempts to update 2931 * the NATIVE status to an equivalent value. Can not be used to translate 2932 * exit code values as exit code values are not guaranteed to have any 2933 * relationship at all to errno values. 2934 * This is used when Perl is forcing errno to have a specific value. 2935 */ 2936 # define STATUS_UNIX_SET(n) \ 2937 STMT_START { \ 2938 I32 evalue = (I32)n; \ 2939 PL_statusvalue = evalue; \ 2940 if (PL_statusvalue != -1) { \ 2941 if (PL_statusvalue != EVMSERR) { \ 2942 PL_statusvalue &= 0xFFFF; \ 2943 if (MY_POSIX_EXIT) \ 2944 PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\ 2945 else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \ 2946 } \ 2947 else { \ 2948 PL_statusvalue_vms = vaxc$errno; \ 2949 } \ 2950 } \ 2951 else PL_statusvalue_vms = SS$_ABORT; \ 2952 set_vaxc_errno(PL_statusvalue_vms); \ 2953 } STMT_END 2954 2955 /* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets 2956 * the NATIVE error status based on it. 2957 * 2958 * When in the default mode to comply with the Perl VMS documentation, 2959 * 0 is a success and any other code sets the NATIVE status to a failure 2960 * code of SS$_ABORT. 2961 * 2962 * In the new POSIX EXIT mode, native status will be set so that the 2963 * actual exit code will can be retrieved by the calling program or 2964 * shell. 2965 * 2966 * If the exit code is not clearly a UNIX parent or child exit status, 2967 * it will be passed through as a VMS status. 2968 */ 2969 2970 # define STATUS_UNIX_EXIT_SET(n) \ 2971 STMT_START { \ 2972 I32 evalue = (I32)n; \ 2973 PL_statusvalue = evalue; \ 2974 if (MY_POSIX_EXIT) { \ 2975 if (evalue <= 0xFF00) { \ 2976 if (evalue > 0xFF) \ 2977 evalue = (evalue >> child_offset_bits) & 0xFF; \ 2978 PL_statusvalue_vms = \ 2979 (C_FAC_POSIX | (evalue << 3 ) | \ 2980 ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \ 2981 } else /* forgive them Perl, for they have sinned */ \ 2982 PL_statusvalue_vms = evalue; \ 2983 } else { \ 2984 if (evalue == 0) \ 2985 PL_statusvalue_vms = SS$_NORMAL; \ 2986 else if (evalue <= 0xFF00) \ 2987 PL_statusvalue_vms = SS$_ABORT; \ 2988 else { /* forgive them Perl, for they have sinned */ \ 2989 if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \ 2990 else PL_statusvalue_vms = vaxc$errno; \ 2991 /* And obviously used a VMS status value instead of UNIX */ \ 2992 PL_statusvalue = EVMSERR; \ 2993 } \ 2994 set_vaxc_errno(PL_statusvalue_vms); \ 2995 } \ 2996 } STMT_END 2997 2998 2999 /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code 3000 * and sets the NATIVE error status based on it. This special case 3001 * is needed to maintain compatibility with past VMS behavior. 3002 * 3003 * In the default mode on VMS, this number is passed through as 3004 * both the NATIVE and UNIX status. Which makes it different 3005 * that the STATUS_UNIX_EXIT_SET. 3006 * 3007 * In the new POSIX EXIT mode, native status will be set so that the 3008 * actual exit code will can be retrieved by the calling program or 3009 * shell. 3010 * 3011 * A POSIX exit code is from 0 to 255. If the exit code is higher 3012 * than this, it needs to be assumed that it is a VMS exit code and 3013 * passed through. 3014 */ 3015 3016 # define STATUS_EXIT_SET(n) \ 3017 STMT_START { \ 3018 I32 evalue = (I32)n; \ 3019 PL_statusvalue = evalue; \ 3020 if (MY_POSIX_EXIT) \ 3021 if (evalue > 255) PL_statusvalue_vms = evalue; else { \ 3022 PL_statusvalue_vms = \ 3023 (C_FAC_POSIX | (evalue << 3 ) | \ 3024 ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \ 3025 else \ 3026 PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \ 3027 set_vaxc_errno(PL_statusvalue_vms); \ 3028 } STMT_END 3029 3030 3031 /* This macro forces a success status */ 3032 # define STATUS_ALL_SUCCESS \ 3033 (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL) 3034 3035 /* This macro forces a failure status */ 3036 # define STATUS_ALL_FAILURE (PL_statusvalue = 1, \ 3037 vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \ 3038 (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT) 3039 3040 #else 3041 # define STATUS_NATIVE PL_statusvalue_posix 3042 # if defined(WCOREDUMP) 3043 # define STATUS_NATIVE_CHILD_SET(n) \ 3044 STMT_START { \ 3045 PL_statusvalue_posix = (n); \ 3046 if (PL_statusvalue_posix == -1) \ 3047 PL_statusvalue = -1; \ 3048 else { \ 3049 PL_statusvalue = \ 3050 (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \ 3051 (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0) | \ 3052 (WIFSIGNALED(PL_statusvalue_posix) && WCOREDUMP(PL_statusvalue_posix) ? 0x80 : 0); \ 3053 } \ 3054 } STMT_END 3055 # elif defined(WIFEXITED) 3056 # define STATUS_NATIVE_CHILD_SET(n) \ 3057 STMT_START { \ 3058 PL_statusvalue_posix = (n); \ 3059 if (PL_statusvalue_posix == -1) \ 3060 PL_statusvalue = -1; \ 3061 else { \ 3062 PL_statusvalue = \ 3063 (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \ 3064 (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0); \ 3065 } \ 3066 } STMT_END 3067 # else 3068 # define STATUS_NATIVE_CHILD_SET(n) \ 3069 STMT_START { \ 3070 PL_statusvalue_posix = (n); \ 3071 if (PL_statusvalue_posix == -1) \ 3072 PL_statusvalue = -1; \ 3073 else { \ 3074 PL_statusvalue = \ 3075 PL_statusvalue_posix & 0xFFFF; \ 3076 } \ 3077 } STMT_END 3078 # endif 3079 # define STATUS_UNIX_SET(n) \ 3080 STMT_START { \ 3081 PL_statusvalue = (n); \ 3082 if (PL_statusvalue != -1) \ 3083 PL_statusvalue &= 0xFFFF; \ 3084 } STMT_END 3085 # define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n) 3086 # define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n) 3087 # define STATUS_CURRENT STATUS_UNIX 3088 # define STATUS_EXIT STATUS_UNIX 3089 # define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) 3090 # define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1) 3091 #endif 3092 3093 /* flags in PL_exit_flags for nature of exit() */ 3094 #define PERL_EXIT_EXPECTED 0x01 3095 #define PERL_EXIT_DESTRUCT_END 0x02 /* Run END in perl_destruct */ 3096 3097 #ifndef MEMBER_TO_FPTR 3098 # define MEMBER_TO_FPTR(name) name 3099 #endif 3100 3101 #ifndef PERL_CORE 3102 /* format to use for version numbers in file/directory names */ 3103 /* XXX move to Configure? */ 3104 /* This was only ever used for the current version, and that can be done at 3105 compile time, as PERL_FS_VERSION, so should we just delete it? */ 3106 # ifndef PERL_FS_VER_FMT 3107 # define PERL_FS_VER_FMT "%d.%d.%d" 3108 # endif 3109 #endif 3110 3111 #ifndef PERL_FS_VERSION 3112 # define PERL_FS_VERSION PERL_VERSION_STRING 3113 #endif 3114 3115 /* This defines a way to flush all output buffers. This may be a 3116 * performance issue, so we allow people to disable it. Also, if 3117 * we are using stdio, there are broken implementations of fflush(NULL) 3118 * out there, Solaris being the most prominent. 3119 */ 3120 #ifndef PERL_FLUSHALL_FOR_CHILD 3121 # if defined(USE_PERLIO) || defined(FFLUSH_NULL) || defined(USE_SFIO) 3122 # define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL) 3123 # else 3124 # ifdef FFLUSH_ALL 3125 # define PERL_FLUSHALL_FOR_CHILD my_fflush_all() 3126 # else 3127 # define PERL_FLUSHALL_FOR_CHILD NOOP 3128 # endif 3129 # endif 3130 #endif 3131 3132 #ifndef PERL_WAIT_FOR_CHILDREN 3133 # define PERL_WAIT_FOR_CHILDREN NOOP 3134 #endif 3135 3136 /* the traditional thread-unsafe notion of "current interpreter". */ 3137 #ifndef PERL_SET_INTERP 3138 # define PERL_SET_INTERP(i) (PL_curinterp = (PerlInterpreter*)(i)) 3139 #endif 3140 3141 #ifndef PERL_GET_INTERP 3142 # define PERL_GET_INTERP (PL_curinterp) 3143 #endif 3144 3145 #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX) 3146 # ifdef MULTIPLICITY 3147 # define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT) 3148 # endif 3149 # define PERL_SET_THX(t) PERL_SET_CONTEXT(t) 3150 #endif 3151 3152 /* 3153 This replaces the previous %_ "hack" by the "%p" hacks. 3154 All that is required is that the perl source does not 3155 use "%-p" or "%-<number>p" or "%<number>p" formats. 3156 These formats will still work in perl code. 3157 See comments in sv.c for futher details. 3158 3159 Robin Barker 2005-07-14 3160 3161 No longer use %1p for VDf = %vd. RMB 2007-10-19 3162 */ 3163 3164 #ifndef SVf_ 3165 # define SVf_(n) "-" STRINGIFY(n) "p" 3166 #endif 3167 3168 #ifndef SVf 3169 # define SVf "-p" 3170 #endif 3171 3172 #ifndef SVf32 3173 # define SVf32 SVf_(32) 3174 #endif 3175 3176 #ifndef SVf256 3177 # define SVf256 SVf_(256) 3178 #endif 3179 3180 #define SVfARG(p) ((void*)(p)) 3181 3182 #ifdef PERL_CORE 3183 /* not used; but needed for backward compatibilty with XS code? - RMB */ 3184 # undef VDf 3185 #else 3186 # ifndef VDf 3187 # define VDf "vd" 3188 # endif 3189 #endif 3190 3191 #ifdef PERL_CORE 3192 /* not used; but needed for backward compatibilty with XS code? - RMB */ 3193 # undef UVf 3194 #else 3195 # ifndef UVf 3196 # define UVf UVuf 3197 # endif 3198 #endif 3199 3200 #if !defined(PERL_CORE) && !defined(PERL_NO_SHORT_NAMES) 3201 # if defined(PERL_IMPLICIT_CONTEXT) 3202 # define pmflag(a,b) Perl_pmflag(aTHX_ a,b) 3203 # else 3204 # define pmflag Perl_pmflag 3205 # endif 3206 #endif 3207 3208 #ifdef HASATTRIBUTE_DEPRECATED 3209 # define __attribute__deprecated__ __attribute__((deprecated)) 3210 #endif 3211 #ifdef HASATTRIBUTE_FORMAT 3212 # define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) 3213 #endif 3214 #ifdef HASATTRIBUTE_MALLOC 3215 # define __attribute__malloc__ __attribute__((__malloc__)) 3216 #endif 3217 #ifdef HASATTRIBUTE_NONNULL 3218 # define __attribute__nonnull__(a) __attribute__((nonnull(a))) 3219 #endif 3220 #ifdef HASATTRIBUTE_NORETURN 3221 # define __attribute__noreturn__ __attribute__((noreturn)) 3222 #endif 3223 #ifdef HASATTRIBUTE_PURE 3224 # define __attribute__pure__ __attribute__((pure)) 3225 #endif 3226 #ifdef HASATTRIBUTE_UNUSED 3227 # define __attribute__unused__ __attribute__((unused)) 3228 #endif 3229 #ifdef HASATTRIBUTE_WARN_UNUSED_RESULT 3230 # define __attribute__warn_unused_result__ __attribute__((warn_unused_result)) 3231 #endif 3232 3233 /* If we haven't defined the attributes yet, define them to blank. */ 3234 #ifndef __attribute__deprecated__ 3235 # define __attribute__deprecated__ 3236 #endif 3237 #ifndef __attribute__format__ 3238 # define __attribute__format__(x,y,z) 3239 #endif 3240 #ifndef __attribute__malloc__ 3241 # define __attribute__malloc__ 3242 #endif 3243 #ifndef __attribute__nonnull__ 3244 # define __attribute__nonnull__(a) 3245 #endif 3246 #ifndef __attribute__noreturn__ 3247 # define __attribute__noreturn__ 3248 #endif 3249 #ifndef __attribute__pure__ 3250 # define __attribute__pure__ 3251 #endif 3252 #ifndef __attribute__unused__ 3253 # define __attribute__unused__ 3254 #endif 3255 #ifndef __attribute__warn_unused_result__ 3256 # define __attribute__warn_unused_result__ 3257 #endif 3258 3259 /* For functions that are marked as __attribute__noreturn__, it's not 3260 appropriate to call return. In either case, include the lint directive. 3261 */ 3262 #ifdef HASATTRIBUTE_NORETURN 3263 # define NORETURN_FUNCTION_END /* NOTREACHED */ 3264 #else 3265 # define NORETURN_FUNCTION_END /* NOTREACHED */ return 0 3266 #endif 3267 3268 /* Some OS warn on NULL format to printf */ 3269 #ifdef PRINTF_FORMAT_NULL_OK 3270 # define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z) 3271 #else 3272 # define __attribute__format__null_ok__(x,y,z) 3273 #endif 3274 3275 #ifdef HAS_BUILTIN_EXPECT 3276 # define EXPECT(expr,val) __builtin_expect(expr,val) 3277 #else 3278 # define EXPECT(expr,val) (expr) 3279 #endif 3280 #define LIKELY(cond) EXPECT(cond,1) 3281 #define UNLIKELY(cond) EXPECT(cond,0) 3282 #ifdef HAS_BUILTIN_CHOOSE_EXPR 3283 /* placeholder */ 3284 #endif 3285 3286 /* Some unistd.h's give a prototype for pause() even though 3287 HAS_PAUSE ends up undefined. This causes the #define 3288 below to be rejected by the compiler. Sigh. 3289 */ 3290 #ifdef HAS_PAUSE 3291 #define Pause pause 3292 #else 3293 #define Pause() sleep((32767<<16)+32767) 3294 #endif 3295 3296 #ifndef IOCPARM_LEN 3297 # ifdef IOCPARM_MASK 3298 /* on BSDish systems we're safe */ 3299 # define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) 3300 # else 3301 # if defined(_IOC_SIZE) && defined(__GLIBC__) 3302 /* on Linux systems we're safe; except when we're not [perl #38223] */ 3303 # define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x)) 3304 # else 3305 /* otherwise guess at what's safe */ 3306 # define IOCPARM_LEN(x) 256 3307 # endif 3308 # endif 3309 #endif 3310 3311 #if defined(__CYGWIN__) 3312 /* USEMYBINMODE 3313 * This symbol, if defined, indicates that the program should 3314 * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure 3315 * that a file is in "binary" mode -- that is, that no translation 3316 * of bytes occurs on read or write operations. 3317 */ 3318 # define USEMYBINMODE /**/ 3319 # include <io.h> /* for setmode() prototype */ 3320 # define my_binmode(fp, iotype, mode) \ 3321 (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE) 3322 #endif 3323 3324 #ifdef __CYGWIN__ 3325 void init_os_extras(void); 3326 #endif 3327 3328 #ifdef UNION_ANY_DEFINITION 3329 UNION_ANY_DEFINITION; 3330 #else 3331 union any { 3332 void* any_ptr; 3333 I32 any_i32; 3334 IV any_iv; 3335 long any_long; 3336 bool any_bool; 3337 void (*any_dptr) (void*); 3338 void (*any_dxptr) (pTHX_ void*); 3339 }; 3340 #endif 3341 3342 typedef I32 (*filter_t) (pTHX_ int, SV *, int); 3343 3344 #define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) 3345 #define FILTER_DATA(idx) \ 3346 (PL_parser ? AvARRAY(PL_parser->rsfp_filters)[idx] : NULL) 3347 #define FILTER_ISREADER(idx) \ 3348 (PL_parser && PL_parser->rsfp_filters \ 3349 && idx >= AvFILLp(PL_parser->rsfp_filters)) 3350 #define PERL_FILTER_EXISTS(i) \ 3351 (PL_parser && PL_parser->rsfp_filters \ 3352 && (i) <= av_len(PL_parser->rsfp_filters)) 3353 3354 #if defined(_AIX) && !defined(_AIX43) 3355 #if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE) 3356 /* We cannot include <crypt.h> to get the struct crypt_data 3357 * because of setkey prototype problems when threading */ 3358 typedef struct crypt_data { /* straight from /usr/include/crypt.h */ 3359 /* From OSF, Not needed in AIX 3360 char C[28], D[28]; 3361 */ 3362 char E[48]; 3363 char KS[16][48]; 3364 char block[66]; 3365 char iobuf[16]; 3366 } CRYPTD; 3367 #endif /* threading */ 3368 #endif /* AIX */ 3369 3370 #if !defined(OS2) 3371 # include "iperlsys.h" 3372 #endif 3373 3374 #ifdef __LIBCATAMOUNT__ 3375 #undef HAS_PASSWD /* unixish.h but not unixish enough. */ 3376 #undef HAS_GROUP 3377 #define FAKE_BIT_BUCKET 3378 #endif 3379 3380 /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0. 3381 * Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT* 3382 * defined by Configure, despite their names being similar to the 3383 * other defines like USE_ITHREADS. Configure in fact knows nothing 3384 * about the randomised hashes. Therefore to enable/disable the hash 3385 * randomisation defines use the Configure -Accflags=... instead. */ 3386 #if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT) 3387 # define USE_HASH_SEED 3388 #endif 3389 3390 /* Win32 defines a type 'WORD' in windef.h. This conflicts with the enumerator 3391 * 'WORD' defined in perly.h. The yytokentype enum is only a debugging aid, so 3392 * it's not really needed. 3393 */ 3394 #if defined(WIN32) 3395 # define YYTOKENTYPE 3396 #endif 3397 #include "perly.h" 3398 3399 #ifdef PERL_MAD 3400 struct nexttoken { 3401 YYSTYPE next_val; /* value of next token, if any */ 3402 I32 next_type; /* type of next token */ 3403 MADPROP *next_mad; /* everything else about that token */ 3404 }; 3405 #endif 3406 3407 /* macros to define bit-fields in structs. */ 3408 #ifndef PERL_BITFIELD8 3409 # define PERL_BITFIELD8 unsigned 3410 #endif 3411 #ifndef PERL_BITFIELD16 3412 # define PERL_BITFIELD16 unsigned 3413 #endif 3414 #ifndef PERL_BITFIELD32 3415 # define PERL_BITFIELD32 unsigned 3416 #endif 3417 3418 #include "sv.h" 3419 #include "regexp.h" 3420 #include "util.h" 3421 #include "form.h" 3422 #include "gv.h" 3423 #include "pad.h" 3424 #include "cv.h" 3425 #include "opnames.h" 3426 #include "op.h" 3427 #include "hv.h" 3428 #include "cop.h" 3429 #include "av.h" 3430 #include "mg.h" 3431 #include "scope.h" 3432 #include "warnings.h" 3433 #include "utf8.h" 3434 3435 /* defined in sv.c, but also used in [ach]v.c */ 3436 #undef _XPV_HEAD 3437 #undef _XPVMG_HEAD 3438 #undef _XPVCV_COMMON 3439 3440 typedef struct _sublex_info SUBLEXINFO; 3441 struct _sublex_info { 3442 U8 super_state; /* lexer state to save */ 3443 U16 sub_inwhat; /* "lex_inwhat" to use */ 3444 OP *sub_op; /* "lex_op" to use */ 3445 char *super_bufptr; /* PL_parser->bufptr that was */ 3446 char *super_bufend; /* PL_parser->bufend that was */ 3447 }; 3448 3449 #include "parser.h" 3450 3451 typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ 3452 3453 struct scan_data_t; /* Used in S_* functions in regcomp.c */ 3454 struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */ 3455 3456 /* Keep next first in this structure, because sv_free_arenas take 3457 advantage of this to share code between the pte arenas and the SV 3458 body arenas */ 3459 struct ptr_tbl_ent { 3460 struct ptr_tbl_ent* next; 3461 const void* oldval; 3462 void* newval; 3463 }; 3464 3465 struct ptr_tbl { 3466 struct ptr_tbl_ent** tbl_ary; 3467 UV tbl_max; 3468 UV tbl_items; 3469 }; 3470 3471 #if defined(iAPX286) || defined(M_I286) || defined(I80286) 3472 # define I286 3473 #endif 3474 3475 #if defined(htonl) && !defined(HAS_HTONL) 3476 #define HAS_HTONL 3477 #endif 3478 #if defined(htons) && !defined(HAS_HTONS) 3479 #define HAS_HTONS 3480 #endif 3481 #if defined(ntohl) && !defined(HAS_NTOHL) 3482 #define HAS_NTOHL 3483 #endif 3484 #if defined(ntohs) && !defined(HAS_NTOHS) 3485 #define HAS_NTOHS 3486 #endif 3487 #ifndef HAS_HTONL 3488 #if (BYTEORDER & 0xffff) != 0x4321 3489 #define HAS_HTONS 3490 #define HAS_HTONL 3491 #define HAS_NTOHS 3492 #define HAS_NTOHL 3493 #define MYSWAP 3494 #define htons my_swap 3495 #define htonl my_htonl 3496 #define ntohs my_swap 3497 #define ntohl my_ntohl 3498 #endif 3499 #else 3500 #if (BYTEORDER & 0xffff) == 0x4321 3501 #undef HAS_HTONS 3502 #undef HAS_HTONL 3503 #undef HAS_NTOHS 3504 #undef HAS_NTOHL 3505 #endif 3506 #endif 3507 3508 /* 3509 * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'. 3510 * -DWS 3511 */ 3512 #if BYTEORDER != 0x1234 3513 # define HAS_VTOHL 3514 # define HAS_VTOHS 3515 # define HAS_HTOVL 3516 # define HAS_HTOVS 3517 # if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 3518 # define vtohl(x) ((((x)&0xFF)<<24) \ 3519 +(((x)>>24)&0xFF) \ 3520 +(((x)&0x0000FF00)<<8) \ 3521 +(((x)&0x00FF0000)>>8) ) 3522 # define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF)) 3523 # define htovl(x) vtohl(x) 3524 # define htovs(x) vtohs(x) 3525 # endif 3526 /* otherwise default to functions in util.c */ 3527 #ifndef htovs 3528 short htovs(short n); 3529 short vtohs(short n); 3530 long htovl(long n); 3531 long vtohl(long n); 3532 #endif 3533 #endif 3534 3535 /* *MAX Plus 1. A floating point value. 3536 Hopefully expressed in a way that dodgy floating point can't mess up. 3537 >> 2 rather than 1, so that value is safely less than I32_MAX after 1 3538 is added to it 3539 May find that some broken compiler will want the value cast to I32. 3540 [after the shift, as signed >> may not be as secure as unsigned >>] 3541 */ 3542 #define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1))) 3543 #define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2))) 3544 /* For compilers that can't correctly cast NVs over 0x7FFFFFFF (or 3545 0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV) 3546 may be greater than sizeof(IV), so don't assume that half max UV is max IV. 3547 */ 3548 #define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2))) 3549 3550 #define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2))) 3551 #define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1))) 3552 #define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2))) 3553 3554 /* This may look like unnecessary jumping through hoops, but converting 3555 out of range floating point values to integers *is* undefined behaviour, 3556 and it is starting to bite. 3557 */ 3558 #ifndef CAST_INLINE 3559 #define I_32(what) (cast_i32((NV)(what))) 3560 #define U_32(what) (cast_ulong((NV)(what))) 3561 #define I_V(what) (cast_iv((NV)(what))) 3562 #define U_V(what) (cast_uv((NV)(what))) 3563 #else 3564 #define I_32(n) ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \ 3565 : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \ 3566 : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */))) 3567 #define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \ 3568 : ((n) < U32_MAX_P1 ? (U32) (n) \ 3569 : ((n) > 0 ? U32_MAX : 0 /* NaN */))) 3570 #define I_V(n) ((n) < IV_MAX_P1 ? ((n) < IV_MIN ? IV_MIN : (IV) (n)) \ 3571 : ((n) < UV_MAX_P1 ? (IV)(UV) (n) \ 3572 : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */))) 3573 #define U_V(n) ((n) < 0.0 ? ((n) < IV_MIN ? (UV) IV_MIN : (UV)(IV) (n)) \ 3574 : ((n) < UV_MAX_P1 ? (UV) (n) \ 3575 : ((n) > 0 ? UV_MAX : 0 /* NaN */))) 3576 #endif 3577 3578 #define U_S(what) ((U16)U_32(what)) 3579 #define U_I(what) ((unsigned int)U_32(what)) 3580 #define U_L(what) U_32(what) 3581 3582 #ifdef HAS_SIGNBIT 3583 # define Perl_signbit signbit 3584 #endif 3585 3586 /* These do not care about the fractional part, only about the range. */ 3587 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX) 3588 #define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX) 3589 3590 /* Used with UV/IV arguments: */ 3591 /* XXXX: need to speed it up */ 3592 #define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv)) 3593 #define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv)) 3594 3595 #ifndef MAXSYSFD 3596 # define MAXSYSFD 2 3597 #endif 3598 3599 #ifndef __cplusplus 3600 #if !(defined(UNDER_CE) || defined(SYMBIAN)) 3601 Uid_t getuid (void); 3602 Uid_t geteuid (void); 3603 Gid_t getgid (void); 3604 Gid_t getegid (void); 3605 #endif 3606 #endif 3607 3608 #ifndef Perl_debug_log 3609 # define Perl_debug_log PerlIO_stderr() 3610 #endif 3611 3612 #ifndef Perl_error_log 3613 # define Perl_error_log (PL_stderrgv \ 3614 && isGV(PL_stderrgv) \ 3615 && GvIOp(PL_stderrgv) \ 3616 && IoOFP(GvIOp(PL_stderrgv)) \ 3617 ? IoOFP(GvIOp(PL_stderrgv)) \ 3618 : PerlIO_stderr()) 3619 #endif 3620 3621 3622 #define DEBUG_p_FLAG 0x00000001 /* 1 */ 3623 #define DEBUG_s_FLAG 0x00000002 /* 2 */ 3624 #define DEBUG_l_FLAG 0x00000004 /* 4 */ 3625 #define DEBUG_t_FLAG 0x00000008 /* 8 */ 3626 #define DEBUG_o_FLAG 0x00000010 /* 16 */ 3627 #define DEBUG_c_FLAG 0x00000020 /* 32 */ 3628 #define DEBUG_P_FLAG 0x00000040 /* 64 */ 3629 #define DEBUG_m_FLAG 0x00000080 /* 128 */ 3630 #define DEBUG_f_FLAG 0x00000100 /* 256 */ 3631 #define DEBUG_r_FLAG 0x00000200 /* 512 */ 3632 #define DEBUG_x_FLAG 0x00000400 /* 1024 */ 3633 #define DEBUG_u_FLAG 0x00000800 /* 2048 */ 3634 /* U is reserved for Unofficial, exploratory hacking */ 3635 #define DEBUG_U_FLAG 0x00001000 /* 4096 */ 3636 #define DEBUG_H_FLAG 0x00002000 /* 8192 */ 3637 #define DEBUG_X_FLAG 0x00004000 /* 16384 */ 3638 #define DEBUG_D_FLAG 0x00008000 /* 32768 */ 3639 /* 0x00010000 is unused, used to be S */ 3640 #define DEBUG_T_FLAG 0x00020000 /* 131072 */ 3641 #define DEBUG_R_FLAG 0x00040000 /* 262144 */ 3642 #define DEBUG_J_FLAG 0x00080000 /* 524288 */ 3643 #define DEBUG_v_FLAG 0x00100000 /*1048576 */ 3644 #define DEBUG_C_FLAG 0x00200000 /*2097152 */ 3645 #define DEBUG_A_FLAG 0x00400000 /*4194304 */ 3646 #define DEBUG_q_FLAG 0x00800000 /*8388608 */ 3647 #define DEBUG_M_FLAG 0x01000000 /*16777216*/ 3648 #define DEBUG_B_FLAG 0x02000000 /*33554432*/ 3649 #define DEBUG_MASK 0x03FEEFFF /* mask of all the standard flags */ 3650 3651 #define DEBUG_DB_RECURSE_FLAG 0x40000000 3652 #define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal 3653 that something was done? */ 3654 3655 # define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG) 3656 # define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG) 3657 # define DEBUG_l_TEST_ (PL_debug & DEBUG_l_FLAG) 3658 # define DEBUG_t_TEST_ (PL_debug & DEBUG_t_FLAG) 3659 # define DEBUG_o_TEST_ (PL_debug & DEBUG_o_FLAG) 3660 # define DEBUG_c_TEST_ (PL_debug & DEBUG_c_FLAG) 3661 # define DEBUG_P_TEST_ (PL_debug & DEBUG_P_FLAG) 3662 # define DEBUG_m_TEST_ (PL_debug & DEBUG_m_FLAG) 3663 # define DEBUG_f_TEST_ (PL_debug & DEBUG_f_FLAG) 3664 # define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG) 3665 # define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG) 3666 # define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG) 3667 # define DEBUG_U_TEST_ (PL_debug & DEBUG_U_FLAG) 3668 # define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG) 3669 # define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG) 3670 # define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG) 3671 # define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG) 3672 # define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG) 3673 # define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG) 3674 # define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG) 3675 # define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG) 3676 # define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG) 3677 # define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG) 3678 # define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG) 3679 # define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG) 3680 # define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_) 3681 # define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_) 3682 3683 #ifdef DEBUGGING 3684 3685 # define DEBUG_p_TEST DEBUG_p_TEST_ 3686 # define DEBUG_s_TEST DEBUG_s_TEST_ 3687 # define DEBUG_l_TEST DEBUG_l_TEST_ 3688 # define DEBUG_t_TEST DEBUG_t_TEST_ 3689 # define DEBUG_o_TEST DEBUG_o_TEST_ 3690 # define DEBUG_c_TEST DEBUG_c_TEST_ 3691 # define DEBUG_P_TEST DEBUG_P_TEST_ 3692 # define DEBUG_m_TEST DEBUG_m_TEST_ 3693 # define DEBUG_f_TEST DEBUG_f_TEST_ 3694 # define DEBUG_r_TEST DEBUG_r_TEST_ 3695 # define DEBUG_x_TEST DEBUG_x_TEST_ 3696 # define DEBUG_u_TEST DEBUG_u_TEST_ 3697 # define DEBUG_U_TEST DEBUG_U_TEST_ 3698 # define DEBUG_H_TEST DEBUG_H_TEST_ 3699 # define DEBUG_X_TEST DEBUG_X_TEST_ 3700 # define DEBUG_D_TEST DEBUG_D_TEST_ 3701 # define DEBUG_T_TEST DEBUG_T_TEST_ 3702 # define DEBUG_R_TEST DEBUG_R_TEST_ 3703 # define DEBUG_J_TEST DEBUG_J_TEST_ 3704 # define DEBUG_v_TEST DEBUG_v_TEST_ 3705 # define DEBUG_C_TEST DEBUG_C_TEST_ 3706 # define DEBUG_A_TEST DEBUG_A_TEST_ 3707 # define DEBUG_q_TEST DEBUG_q_TEST_ 3708 # define DEBUG_M_TEST DEBUG_M_TEST_ 3709 # define DEBUG_B_TEST DEBUG_B_TEST_ 3710 # define DEBUG_Xv_TEST DEBUG_Xv_TEST_ 3711 # define DEBUG_Uv_TEST DEBUG_Uv_TEST_ 3712 3713 # define PERL_DEB(a) a 3714 # define PERL_DEBUG(a) if (PL_debug) a 3715 # define DEBUG_p(a) if (DEBUG_p_TEST) a 3716 # define DEBUG_s(a) if (DEBUG_s_TEST) a 3717 # define DEBUG_l(a) if (DEBUG_l_TEST) a 3718 # define DEBUG_t(a) if (DEBUG_t_TEST) a 3719 # define DEBUG_o(a) if (DEBUG_o_TEST) a 3720 # define DEBUG_c(a) if (DEBUG_c_TEST) a 3721 # define DEBUG_P(a) if (DEBUG_P_TEST) a 3722 3723 /* Temporarily turn off memory debugging in case the a 3724 * does memory allocation, either directly or indirectly. */ 3725 # define DEBUG_m(a) \ 3726 STMT_START { \ 3727 if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \ 3728 } STMT_END 3729 3730 # define DEBUG__(t, a) \ 3731 STMT_START { \ 3732 if (t) STMT_START {a;} STMT_END; \ 3733 } STMT_END 3734 3735 # define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a) 3736 #ifndef PERL_EXT_RE_BUILD 3737 # define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) 3738 #else 3739 # define DEBUG_r(a) STMT_START {a;} STMT_END 3740 #endif /* PERL_EXT_RE_BUILD */ 3741 # define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a) 3742 # define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a) 3743 # define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a) 3744 # define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a) 3745 # define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a) 3746 # define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a) 3747 # define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a) 3748 # define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a) 3749 3750 # define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a) 3751 # define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a) 3752 # define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a) 3753 # define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a) 3754 # define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a) 3755 # define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a) 3756 # define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a) 3757 # define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a) 3758 3759 #else /* DEBUGGING */ 3760 3761 # define DEBUG_p_TEST (0) 3762 # define DEBUG_s_TEST (0) 3763 # define DEBUG_l_TEST (0) 3764 # define DEBUG_t_TEST (0) 3765 # define DEBUG_o_TEST (0) 3766 # define DEBUG_c_TEST (0) 3767 # define DEBUG_P_TEST (0) 3768 # define DEBUG_m_TEST (0) 3769 # define DEBUG_f_TEST (0) 3770 # define DEBUG_r_TEST (0) 3771 # define DEBUG_x_TEST (0) 3772 # define DEBUG_u_TEST (0) 3773 # define DEBUG_U_TEST (0) 3774 # define DEBUG_H_TEST (0) 3775 # define DEBUG_X_TEST (0) 3776 # define DEBUG_D_TEST (0) 3777 # define DEBUG_T_TEST (0) 3778 # define DEBUG_R_TEST (0) 3779 # define DEBUG_J_TEST (0) 3780 # define DEBUG_v_TEST (0) 3781 # define DEBUG_C_TEST (0) 3782 # define DEBUG_A_TEST (0) 3783 # define DEBUG_q_TEST (0) 3784 # define DEBUG_M_TEST (0) 3785 # define DEBUG_B_TEST (0) 3786 # define DEBUG_Xv_TEST (0) 3787 # define DEBUG_Uv_TEST (0) 3788 3789 # define PERL_DEB(a) 3790 # define PERL_DEBUG(a) 3791 # define DEBUG_p(a) 3792 # define DEBUG_s(a) 3793 # define DEBUG_l(a) 3794 # define DEBUG_t(a) 3795 # define DEBUG_o(a) 3796 # define DEBUG_c(a) 3797 # define DEBUG_P(a) 3798 # define DEBUG_m(a) 3799 # define DEBUG_f(a) 3800 # define DEBUG_r(a) 3801 # define DEBUG_x(a) 3802 # define DEBUG_u(a) 3803 # define DEBUG_U(a) 3804 # define DEBUG_H(a) 3805 # define DEBUG_X(a) 3806 # define DEBUG_D(a) 3807 # define DEBUG_T(a) 3808 # define DEBUG_R(a) 3809 # define DEBUG_v(a) 3810 # define DEBUG_C(a) 3811 # define DEBUG_A(a) 3812 # define DEBUG_q(a) 3813 # define DEBUG_M(a) 3814 # define DEBUG_B(a) 3815 # define DEBUG_Xv(a) 3816 # define DEBUG_Uv(a) 3817 #endif /* DEBUGGING */ 3818 3819 3820 #define DEBUG_SCOPE(where) \ 3821 DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n", \ 3822 where, (long)PL_scopestack_ix, __FILE__, __LINE__))); 3823 3824 3825 3826 3827 /* These constants should be used in preference to raw characters 3828 * when using magic. Note that some perl guts still assume 3829 * certain character properties of these constants, namely that 3830 * isUPPER() and toLOWER() may do useful mappings. 3831 * 3832 * Update the magic_names table in dump.c when adding/amending these 3833 */ 3834 3835 #define PERL_MAGIC_sv '\0' /* Special scalar variable */ 3836 #define PERL_MAGIC_overload 'A' /* %OVERLOAD hash */ 3837 #define PERL_MAGIC_overload_elem 'a' /* %OVERLOAD hash element */ 3838 #define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */ 3839 #define PERL_MAGIC_bm 'B' /* Boyer-Moore (fast string search) */ 3840 #define PERL_MAGIC_regdata 'D' /* Regex match position data 3841 (@+ and @- vars) */ 3842 #define PERL_MAGIC_regdatum 'd' /* Regex match position data element */ 3843 #define PERL_MAGIC_env 'E' /* %ENV hash */ 3844 #define PERL_MAGIC_envelem 'e' /* %ENV hash element */ 3845 #define PERL_MAGIC_fm 'f' /* Formline ('compiled' format) */ 3846 #define PERL_MAGIC_regex_global 'g' /* m//g target / study()ed string */ 3847 #define PERL_MAGIC_hints 'H' /* %^H hash */ 3848 #define PERL_MAGIC_hintselem 'h' /* %^H hash element */ 3849 #define PERL_MAGIC_isa 'I' /* @ISA array */ 3850 #define PERL_MAGIC_isaelem 'i' /* @ISA array element */ 3851 #define PERL_MAGIC_nkeys 'k' /* scalar(keys()) lvalue */ 3852 #define PERL_MAGIC_dbfile 'L' /* Debugger %_<filename */ 3853 #define PERL_MAGIC_dbline 'l' /* Debugger %_<filename element */ 3854 #define PERL_MAGIC_shared 'N' /* Shared between threads */ 3855 #define PERL_MAGIC_shared_scalar 'n' /* Shared between threads */ 3856 #define PERL_MAGIC_collxfrm 'o' /* Locale transformation */ 3857 #define PERL_MAGIC_tied 'P' /* Tied array or hash */ 3858 #define PERL_MAGIC_tiedelem 'p' /* Tied array or hash element */ 3859 #define PERL_MAGIC_tiedscalar 'q' /* Tied scalar or handle */ 3860 #define PERL_MAGIC_qr 'r' /* precompiled qr// regex */ 3861 #define PERL_MAGIC_sig 'S' /* %SIG hash */ 3862 #define PERL_MAGIC_sigelem 's' /* %SIG hash element */ 3863 #define PERL_MAGIC_taint 't' /* Taintedness */ 3864 #define PERL_MAGIC_uvar 'U' /* Available for use by extensions */ 3865 #define PERL_MAGIC_uvar_elem 'u' /* Reserved for use by extensions */ 3866 #define PERL_MAGIC_vec 'v' /* vec() lvalue */ 3867 #define PERL_MAGIC_vstring 'V' /* SV was vstring literal */ 3868 #define PERL_MAGIC_utf8 'w' /* Cached UTF-8 information */ 3869 #define PERL_MAGIC_substr 'x' /* substr() lvalue */ 3870 #define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable / 3871 smart parameter vivification */ 3872 #define PERL_MAGIC_arylen '#' /* Array length ($#ary) */ 3873 #define PERL_MAGIC_pos '.' /* pos() lvalue */ 3874 #define PERL_MAGIC_backref '<' /* for weak ref data */ 3875 #define PERL_MAGIC_symtab ':' /* extra data for symbol tables */ 3876 #define PERL_MAGIC_rhash '%' /* extra data for restricted hashes */ 3877 #define PERL_MAGIC_arylen_p '@' /* to move arylen out of XPVAV */ 3878 #define PERL_MAGIC_ext '~' /* Available for use by extensions */ 3879 3880 #if defined(DEBUGGING) && defined(I_ASSERT) 3881 # include <assert.h> 3882 #endif 3883 3884 /* Keep the old croak based assert for those who want it, and as a fallback if 3885 the platform is so heretically non-ANSI that it can't assert. */ 3886 3887 #define Perl_assert(what) PERL_DEB( \ 3888 ((what) ? ((void) 0) : \ 3889 (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \ 3890 "\", line %d", STRINGIFY(what), __LINE__), \ 3891 (void) 0))) 3892 3893 #ifndef assert 3894 # define assert(what) Perl_assert(what) 3895 #endif 3896 3897 struct ufuncs { 3898 I32 (*uf_val)(pTHX_ IV, SV*); 3899 I32 (*uf_set)(pTHX_ IV, SV*); 3900 IV uf_index; 3901 }; 3902 3903 /* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context. 3904 * XS code wanting to be backward compatible can do something 3905 * like the following: 3906 3907 #ifndef PERL_MG_UFUNC 3908 #define PERL_MG_UFUNC(name,ix,sv) I32 name(IV ix, SV *sv) 3909 #endif 3910 3911 static PERL_MG_UFUNC(foo_get, index, val) 3912 { 3913 sv_setsv(val, ...); 3914 return TRUE; 3915 } 3916 3917 -- Doug MacEachern 3918 3919 */ 3920 3921 #ifndef PERL_MG_UFUNC 3922 #define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv) 3923 #endif 3924 3925 /* Fix these up for __STDC__ */ 3926 #ifndef DONT_DECLARE_STD 3927 char *mktemp (char*); 3928 #ifndef atof 3929 double atof (const char*); 3930 #endif 3931 #endif 3932 3933 #ifndef STANDARD_C 3934 /* All of these are in stdlib.h or time.h for ANSI C */ 3935 Time_t time(); 3936 struct tm *gmtime(), *localtime(); 3937 #if defined(OEMVS) || defined(__OPEN_VM) 3938 char *(strchr)(), *(strrchr)(); 3939 char *(strcpy)(), *(strcat)(); 3940 #else 3941 char *strchr(), *strrchr(); 3942 char *strcpy(), *strcat(); 3943 #endif 3944 #endif /* ! STANDARD_C */ 3945 3946 3947 #ifdef I_MATH 3948 # include <math.h> 3949 #else 3950 START_EXTERN_C 3951 double exp (double); 3952 double log (double); 3953 double log10 (double); 3954 double sqrt (double); 3955 double frexp (double,int*); 3956 double ldexp (double,int); 3957 double modf (double,double*); 3958 double sin (double); 3959 double cos (double); 3960 double atan2 (double,double); 3961 double pow (double,double); 3962 END_EXTERN_C 3963 #endif 3964 3965 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY) 3966 # define NV_INF LDBL_INFINITY 3967 #endif 3968 #if !defined(NV_INF) && defined(DBL_INFINITY) 3969 # define NV_INF (NV)DBL_INFINITY 3970 #endif 3971 #if !defined(NV_INF) && defined(INFINITY) 3972 # define NV_INF (NV)INFINITY 3973 #endif 3974 #if !defined(NV_INF) && defined(INF) 3975 # define NV_INF (NV)INF 3976 #endif 3977 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(HUGE_VALL) 3978 # define NV_INF (NV)HUGE_VALL 3979 #endif 3980 #if !defined(NV_INF) && defined(HUGE_VAL) 3981 # define NV_INF (NV)HUGE_VAL 3982 #endif 3983 3984 #if !defined(NV_NAN) && defined(USE_LONG_DOUBLE) 3985 # if !defined(NV_NAN) && defined(LDBL_NAN) 3986 # define NV_NAN LDBL_NAN 3987 # endif 3988 # if !defined(NV_NAN) && defined(LDBL_QNAN) 3989 # define NV_NAN LDBL_QNAN 3990 # endif 3991 # if !defined(NV_NAN) && defined(LDBL_SNAN) 3992 # define NV_NAN LDBL_SNAN 3993 # endif 3994 #endif 3995 #if !defined(NV_NAN) && defined(DBL_NAN) 3996 # define NV_NAN (NV)DBL_NAN 3997 #endif 3998 #if !defined(NV_NAN) && defined(DBL_QNAN) 3999 # define NV_NAN (NV)DBL_QNAN 4000 #endif 4001 #if !defined(NV_NAN) && defined(DBL_SNAN) 4002 # define NV_NAN (NV)DBL_SNAN 4003 #endif 4004 #if !defined(NV_NAN) && defined(QNAN) 4005 # define NV_NAN (NV)QNAN 4006 #endif 4007 #if !defined(NV_NAN) && defined(SNAN) 4008 # define NV_NAN (NV)SNAN 4009 #endif 4010 #if !defined(NV_NAN) && defined(NAN) 4011 # define NV_NAN (NV)NAN 4012 #endif 4013 4014 #ifndef __cplusplus 4015 # if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */ 4016 char *crypt (); /* Maybe more hosts will need the unprototyped version */ 4017 # else 4018 # if !defined(WIN32) && !defined(VMS) 4019 #ifndef crypt 4020 char *crypt (const char*, const char*); 4021 #endif 4022 # endif /* !WIN32 */ 4023 # endif /* !NeXT && !__NeXT__ */ 4024 # ifndef DONT_DECLARE_STD 4025 # ifndef getenv 4026 char *getenv (const char*); 4027 # endif /* !getenv */ 4028 # if !defined(HAS_LSEEK_PROTO) && !defined(EPOC) && !defined(__hpux) 4029 # ifdef _FILE_OFFSET_BITS 4030 # if _FILE_OFFSET_BITS == 64 4031 Off_t lseek (int,Off_t,int); 4032 # endif 4033 # endif 4034 # endif 4035 # endif /* !DONT_DECLARE_STD */ 4036 #ifndef getlogin 4037 char *getlogin (void); 4038 #endif 4039 #endif /* !__cplusplus */ 4040 4041 /* Fixme on VMS. This needs to be a run-time, not build time options */ 4042 /* Also rename() is affected by this */ 4043 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ 4044 #define UNLINK unlnk 4045 I32 unlnk (pTHX_ const char*); 4046 #else 4047 #define UNLINK PerlLIO_unlink 4048 #endif 4049 4050 /* some versions of glibc are missing the setresuid() proto */ 4051 #if defined(HAS_SETRESUID) && !defined(HAS_SETRESUID_PROTO) 4052 int setresuid(uid_t ruid, uid_t euid, uid_t suid); 4053 #endif 4054 /* some versions of glibc are missing the setresgid() proto */ 4055 #if defined(HAS_SETRESGID) && !defined(HAS_SETRESGID_PROTO) 4056 int setresgid(gid_t rgid, gid_t egid, gid_t sgid); 4057 #endif 4058 4059 #ifndef HAS_SETREUID 4060 # ifdef HAS_SETRESUID 4061 # define setreuid(r,e) setresuid(r,e,(Uid_t)-1) 4062 # define HAS_SETREUID 4063 # endif 4064 #endif 4065 #ifndef HAS_SETREGID 4066 # ifdef HAS_SETRESGID 4067 # define setregid(r,e) setresgid(r,e,(Gid_t)-1) 4068 # define HAS_SETREGID 4069 # endif 4070 #endif 4071 4072 /* Sighandler_t defined in iperlsys.h */ 4073 4074 #ifdef HAS_SIGACTION 4075 typedef struct sigaction Sigsave_t; 4076 #else 4077 typedef Sighandler_t Sigsave_t; 4078 #endif 4079 4080 #define SCAN_DEF 0 4081 #define SCAN_TR 1 4082 #define SCAN_REPL 2 4083 4084 #ifdef DEBUGGING 4085 # ifndef register 4086 # define register 4087 # endif 4088 # define RUNOPS_DEFAULT Perl_runops_debug 4089 #else 4090 # define RUNOPS_DEFAULT Perl_runops_standard 4091 #endif 4092 4093 #ifdef USE_PERLIO 4094 EXTERN_C void PerlIO_teardown(void); 4095 # ifdef USE_ITHREADS 4096 # define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex) 4097 # define PERLIO_TERM \ 4098 STMT_START { \ 4099 PerlIO_teardown(); \ 4100 MUTEX_DESTROY(&PL_perlio_mutex);\ 4101 } STMT_END 4102 # else 4103 # define PERLIO_INIT 4104 # define PERLIO_TERM PerlIO_teardown() 4105 # endif 4106 #else 4107 # define PERLIO_INIT 4108 # define PERLIO_TERM 4109 #endif 4110 4111 #ifdef MYMALLOC 4112 # ifdef MUTEX_INIT_CALLS_MALLOC 4113 # define MALLOC_INIT \ 4114 STMT_START { \ 4115 PL_malloc_mutex = NULL; \ 4116 MUTEX_INIT(&PL_malloc_mutex); \ 4117 } STMT_END 4118 # define MALLOC_TERM \ 4119 STMT_START { \ 4120 perl_mutex tmp = PL_malloc_mutex; \ 4121 PL_malloc_mutex = NULL; \ 4122 MUTEX_DESTROY(&tmp); \ 4123 } STMT_END 4124 # else 4125 # define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex) 4126 # define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex) 4127 # endif 4128 #else 4129 # define MALLOC_INIT 4130 # define MALLOC_TERM 4131 #endif 4132 4133 #if defined(PERL_IMPLICIT_CONTEXT) 4134 4135 struct perl_memory_debug_header; 4136 struct perl_memory_debug_header { 4137 tTHX interpreter; 4138 # ifdef PERL_POISON 4139 MEM_SIZE size; 4140 # endif 4141 struct perl_memory_debug_header *prev; 4142 struct perl_memory_debug_header *next; 4143 }; 4144 4145 # define sTHX (sizeof(struct perl_memory_debug_header) + \ 4146 (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \ 4147 %MEM_ALIGNBYTES) % MEM_ALIGNBYTES) 4148 4149 #else 4150 # define sTHX 0 4151 #endif 4152 4153 #ifdef PERL_TRACK_MEMPOOL 4154 # define INIT_TRACK_MEMPOOL(header, interp) \ 4155 STMT_START { \ 4156 (header).interpreter = (interp); \ 4157 (header).prev = (header).next = &(header); \ 4158 } STMT_END 4159 # else 4160 # define INIT_TRACK_MEMPOOL(header, interp) 4161 #endif 4162 4163 #ifdef I_MALLOCMALLOC 4164 /* Needed for malloc_size(), malloc_good_size() on some systems */ 4165 # include <malloc/malloc.h> 4166 #endif 4167 4168 #ifdef MYMALLOC 4169 # define Perl_safesysmalloc_size(where) Perl_malloced_size(where) 4170 #else 4171 # ifdef HAS_MALLOC_SIZE 4172 # ifdef PERL_TRACK_MEMPOOL 4173 # define Perl_safesysmalloc_size(where) \ 4174 (malloc_size(((char *)(where)) - sTHX) - sTHX) 4175 # else 4176 # define Perl_safesysmalloc_size(where) malloc_size(where) 4177 # endif 4178 # endif 4179 # ifdef HAS_MALLOC_GOOD_SIZE 4180 # ifdef PERL_TRACK_MEMPOOL 4181 # define Perl_malloc_good_size(how_much) \ 4182 (malloc_good_size((how_much) + sTHX) - sTHX) 4183 # else 4184 # define Perl_malloc_good_size(how_much) malloc_good_size(how_much) 4185 # endif 4186 # else 4187 /* Having this as the identity operation makes some code simpler. */ 4188 # define Perl_malloc_good_size(how_much) (how_much) 4189 # endif 4190 #endif 4191 4192 typedef int (CPERLscope(*runops_proc_t)) (pTHX); 4193 typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv); 4194 typedef int (CPERLscope(*thrhook_proc_t)) (pTHX); 4195 typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX); 4196 typedef bool (CPERLscope(*destroyable_proc_t)) (pTHX_ SV *sv); 4197 4198 /* _ (for $_) must be first in the following list (DEFSV requires it) */ 4199 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" 4200 4201 /* NeXT has problems with crt0.o globals */ 4202 #if defined(__DYNAMIC__) && \ 4203 (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN)) 4204 # if defined(NeXT) || defined(__NeXT) 4205 # include <mach-o/dyld.h> 4206 # define environ (*environ_pointer) 4207 EXT char *** environ_pointer; 4208 # else 4209 # if defined(PERL_DARWIN) && defined(PERL_CORE) 4210 # include <crt_externs.h> /* for the env array */ 4211 # define environ (*_NSGetEnviron()) 4212 # endif 4213 # endif 4214 #else 4215 /* VMS and some other platforms don't use the environ array */ 4216 # ifdef USE_ENVIRON_ARRAY 4217 # if !defined(DONT_DECLARE_STD) || \ 4218 (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \ 4219 defined(__sgi) || \ 4220 defined(__DGUX) 4221 extern char ** environ; /* environment variables supplied via exec */ 4222 # endif 4223 # endif 4224 #endif 4225 4226 START_EXTERN_C 4227 4228 /* handy constants */ 4229 EXTCONST char PL_warn_uninit[] 4230 INIT("Use of uninitialized value%s%s%s"); 4231 EXTCONST char PL_warn_nosemi[] 4232 INIT("Semicolon seems to be missing"); 4233 EXTCONST char PL_warn_reserved[] 4234 INIT("Unquoted string \"%s\" may clash with future reserved word"); 4235 EXTCONST char PL_warn_nl[] 4236 INIT("Unsuccessful %s on filename containing newline"); 4237 EXTCONST char PL_no_wrongref[] 4238 INIT("Can't use %s ref as %s ref"); 4239 /* The core no longer needs these here. If you require the string constant, 4240 please inline a copy into your own code. */ 4241 EXTCONST char PL_no_symref[] __attribute__deprecated__ 4242 INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); 4243 EXTCONST char PL_no_symref_sv[] __attribute__deprecated__ 4244 INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use"); 4245 EXTCONST char PL_no_usym[] 4246 INIT("Can't use an undefined value as %s reference"); 4247 EXTCONST char PL_no_aelem[] 4248 INIT("Modification of non-creatable array value attempted, subscript %d"); 4249 EXTCONST char PL_no_helem_sv[] 4250 INIT("Modification of non-creatable hash value attempted, subscript \"%"SVf"\""); 4251 EXTCONST char PL_no_modify[] 4252 INIT("Modification of a read-only value attempted"); 4253 EXTCONST char PL_no_mem[] 4254 INIT("Out of memory!\n"); 4255 EXTCONST char PL_no_security[] 4256 INIT("Insecure dependency in %s%s"); 4257 EXTCONST char PL_no_sock_func[] 4258 INIT("Unsupported socket function \"%s\" called"); 4259 EXTCONST char PL_no_dir_func[] 4260 INIT("Unsupported directory function \"%s\" called"); 4261 EXTCONST char PL_no_func[] 4262 INIT("The %s function is unimplemented"); 4263 EXTCONST char PL_no_myglob[] 4264 INIT("\"%s\" variable %s can't be in a package"); 4265 EXTCONST char PL_no_localize_ref[] 4266 INIT("Can't localize through a reference"); 4267 EXTCONST char PL_memory_wrap[] 4268 INIT("panic: memory wrap"); 4269 4270 #ifdef CSH 4271 EXTCONST char PL_cshname[] 4272 INIT(CSH); 4273 # define PL_cshlen (sizeof(CSH "") - 1) 4274 #endif 4275 4276 EXTCONST char PL_uuemap[65] 4277 INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); 4278 4279 #ifdef DOINIT 4280 EXTCONST char PL_uudmap[256] = 4281 #include "uudmap.h" 4282 ; 4283 EXTCONST char PL_bitcount[256] = 4284 # include "bitcount.h" 4285 ; 4286 EXTCONST char* const PL_sig_name[] = { SIG_NAME }; 4287 EXTCONST int PL_sig_num[] = { SIG_NUM }; 4288 #else 4289 EXTCONST char PL_uudmap[256]; 4290 EXTCONST char PL_bitcount[256]; 4291 EXTCONST char* const PL_sig_name[]; 4292 EXTCONST int PL_sig_num[]; 4293 #endif 4294 4295 /* fast conversion and case folding tables */ 4296 4297 #ifdef DOINIT 4298 #ifdef EBCDIC 4299 EXTCONST unsigned char PL_fold[] = { /* fast EBCDIC case folding table */ 4300 0, 1, 2, 3, 4, 5, 6, 7, 4301 8, 9, 10, 11, 12, 13, 14, 15, 4302 16, 17, 18, 19, 20, 21, 22, 23, 4303 24, 25, 26, 27, 28, 29, 30, 31, 4304 32, 33, 34, 35, 36, 37, 38, 39, 4305 40, 41, 42, 43, 44, 45, 46, 47, 4306 48, 49, 50, 51, 52, 53, 54, 55, 4307 56, 57, 58, 59, 60, 61, 62, 63, 4308 64, 65, 66, 67, 68, 69, 70, 71, 4309 72, 73, 74, 75, 76, 77, 78, 79, 4310 80, 81, 82, 83, 84, 85, 86, 87, 4311 88, 89, 90, 91, 92, 93, 94, 95, 4312 96, 97, 98, 99, 100, 101, 102, 103, 4313 104, 105, 106, 107, 108, 109, 110, 111, 4314 112, 113, 114, 115, 116, 117, 118, 119, 4315 120, 121, 122, 123, 124, 125, 126, 127, 4316 128, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 4317 'H', 'I', 138, 139, 140, 141, 142, 143, 4318 144, 'J', 'K', 'L', 'M', 'N', 'O', 'P', 4319 'Q', 'R', 154, 155, 156, 157, 158, 159, 4320 160, 161, 'S', 'T', 'U', 'V', 'W', 'X', 4321 'Y', 'Z', 170, 171, 172, 173, 174, 175, 4322 176, 177, 178, 179, 180, 181, 182, 183, 4323 184, 185, 186, 187, 188, 189, 190, 191, 4324 192, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 4325 'h', 'i', 202, 203, 204, 205, 206, 207, 4326 208, 'j', 'k', 'l', 'm', 'n', 'o', 'p', 4327 'q', 'r', 218, 219, 220, 221, 222, 223, 4328 224, 225, 's', 't', 'u', 'v', 'w', 'x', 4329 'y', 'z', 234, 235, 236, 237, 238, 239, 4330 240, 241, 242, 243, 244, 245, 246, 247, 4331 248, 249, 250, 251, 252, 253, 254, 255 4332 }; 4333 #else /* ascii rather than ebcdic */ 4334 EXTCONST unsigned char PL_fold[] = { 4335 0, 1, 2, 3, 4, 5, 6, 7, 4336 8, 9, 10, 11, 12, 13, 14, 15, 4337 16, 17, 18, 19, 20, 21, 22, 23, 4338 24, 25, 26, 27, 28, 29, 30, 31, 4339 32, 33, 34, 35, 36, 37, 38, 39, 4340 40, 41, 42, 43, 44, 45, 46, 47, 4341 48, 49, 50, 51, 52, 53, 54, 55, 4342 56, 57, 58, 59, 60, 61, 62, 63, 4343 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 4344 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 4345 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 4346 'x', 'y', 'z', 91, 92, 93, 94, 95, 4347 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 4348 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 4349 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 4350 'X', 'Y', 'Z', 123, 124, 125, 126, 127, 4351 128, 129, 130, 131, 132, 133, 134, 135, 4352 136, 137, 138, 139, 140, 141, 142, 143, 4353 144, 145, 146, 147, 148, 149, 150, 151, 4354 152, 153, 154, 155, 156, 157, 158, 159, 4355 160, 161, 162, 163, 164, 165, 166, 167, 4356 168, 169, 170, 171, 172, 173, 174, 175, 4357 176, 177, 178, 179, 180, 181, 182, 183, 4358 184, 185, 186, 187, 188, 189, 190, 191, 4359 192, 193, 194, 195, 196, 197, 198, 199, 4360 200, 201, 202, 203, 204, 205, 206, 207, 4361 208, 209, 210, 211, 212, 213, 214, 215, 4362 216, 217, 218, 219, 220, 221, 222, 223, 4363 224, 225, 226, 227, 228, 229, 230, 231, 4364 232, 233, 234, 235, 236, 237, 238, 239, 4365 240, 241, 242, 243, 244, 245, 246, 247, 4366 248, 249, 250, 251, 252, 253, 254, 255 4367 }; 4368 #endif /* !EBCDIC, but still in DOINIT */ 4369 4370 /* If these tables are accessed through ebcdic, the access will be converted to 4371 * latin1 first */ 4372 EXTCONST unsigned char PL_latin1_lc[] = { /* lowercasing */ 4373 0, 1, 2, 3, 4, 5, 6, 7, 4374 8, 9, 10, 11, 12, 13, 14, 15, 4375 16, 17, 18, 19, 20, 21, 22, 23, 4376 24, 25, 26, 27, 28, 29, 30, 31, 4377 32, 33, 34, 35, 36, 37, 38, 39, 4378 40, 41, 42, 43, 44, 45, 46, 47, 4379 48, 49, 50, 51, 52, 53, 54, 55, 4380 56, 57, 58, 59, 60, 61, 62, 63, 4381 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 4382 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 4383 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 4384 'x', 'y', 'z', 91, 92, 93, 94, 95, 4385 96, 97, 98, 99, 100, 101, 102, 103, 4386 104, 105, 106, 107, 108, 109, 110, 111, 4387 112, 113, 114, 115, 116, 117, 118, 119, 4388 120, 121, 122, 123, 124, 125, 126, 127, 4389 128, 129, 130, 131, 132, 133, 134, 135, 4390 136, 137, 138, 139, 140, 141, 142, 143, 4391 144, 145, 146, 147, 148, 149, 150, 151, 4392 152, 153, 154, 155, 156, 157, 158, 159, 4393 160, 161, 162, 163, 164, 165, 166, 167, 4394 168, 169, 170, 171, 172, 173, 174, 175, 4395 176, 177, 178, 179, 180, 181, 182, 183, 4396 184, 185, 186, 187, 188, 189, 190, 191, 4397 192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32, 4398 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32, 4399 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215, 4400 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223, 4401 224, 225, 226, 227, 228, 229, 230, 231, 4402 232, 233, 234, 235, 236, 237, 238, 239, 4403 240, 241, 242, 243, 244, 245, 246, 247, 4404 248, 249, 250, 251, 252, 253, 254, 255 4405 }; 4406 4407 /* upper and title case of latin1 characters, modified so that the three tricky 4408 * ones are mapped to 255 (which is one of the three) */ 4409 EXTCONST unsigned char PL_mod_latin1_uc[] = { 4410 0, 1, 2, 3, 4, 5, 6, 7, 4411 8, 9, 10, 11, 12, 13, 14, 15, 4412 16, 17, 18, 19, 20, 21, 22, 23, 4413 24, 25, 26, 27, 28, 29, 30, 31, 4414 32, 33, 34, 35, 36, 37, 38, 39, 4415 40, 41, 42, 43, 44, 45, 46, 47, 4416 48, 49, 50, 51, 52, 53, 54, 55, 4417 56, 57, 58, 59, 60, 61, 62, 63, 4418 64, 65, 66, 67, 68, 69, 70, 71, 4419 72, 73, 74, 75, 76, 77, 78, 79, 4420 80, 81, 82, 83, 84, 85, 86, 87, 4421 88, 89, 90, 91, 92, 93, 94, 95, 4422 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 4423 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 4424 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 4425 'X', 'Y', 'Z', 123, 124, 125, 126, 127, 4426 128, 129, 130, 131, 132, 133, 134, 135, 4427 136, 137, 138, 139, 140, 141, 142, 143, 4428 144, 145, 146, 147, 148, 149, 150, 151, 4429 152, 153, 154, 155, 156, 157, 158, 159, 4430 160, 161, 162, 163, 164, 165, 166, 167, 4431 168, 169, 170, 171, 172, 173, 174, 175, 4432 176, 177, 178, 179, 180, 255 /*micro*/, 182, 183, 4433 184, 185, 186, 187, 188, 189, 190, 191, 4434 192, 193, 194, 195, 196, 197, 198, 199, 4435 200, 201, 202, 203, 204, 205, 206, 207, 4436 208, 209, 210, 211, 212, 213, 214, 215, 4437 216, 217, 218, 219, 220, 221, 222, 255 /*sharp s*/, 4438 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32, 4439 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32, 4440 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247, 4441 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255 4442 }; 4443 #else /* ! DOINIT */ 4444 EXTCONST unsigned char PL_fold[]; 4445 EXTCONST unsigned char PL_mod_latin1_uc[]; 4446 EXTCONST unsigned char PL_latin1_lc[]; 4447 #endif 4448 4449 #ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */ 4450 #ifdef DOINIT 4451 EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */ 4452 0, 1, 2, 3, 4, 5, 6, 7, 4453 8, 9, 10, 11, 12, 13, 14, 15, 4454 16, 17, 18, 19, 20, 21, 22, 23, 4455 24, 25, 26, 27, 28, 29, 30, 31, 4456 32, 33, 34, 35, 36, 37, 38, 39, 4457 40, 41, 42, 43, 44, 45, 46, 47, 4458 48, 49, 50, 51, 52, 53, 54, 55, 4459 56, 57, 58, 59, 60, 61, 62, 63, 4460 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 4461 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 4462 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 4463 'x', 'y', 'z', 91, 92, 93, 94, 95, 4464 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 4465 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 4466 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 4467 'X', 'Y', 'Z', 123, 124, 125, 126, 127, 4468 128, 129, 130, 131, 132, 133, 134, 135, 4469 136, 137, 138, 139, 140, 141, 142, 143, 4470 144, 145, 146, 147, 148, 149, 150, 151, 4471 152, 153, 154, 155, 156, 157, 158, 159, 4472 160, 161, 162, 163, 164, 165, 166, 167, 4473 168, 169, 170, 171, 172, 173, 174, 175, 4474 176, 177, 178, 179, 180, 181, 182, 183, 4475 184, 185, 186, 187, 188, 189, 190, 191, 4476 192, 193, 194, 195, 196, 197, 198, 199, 4477 200, 201, 202, 203, 204, 205, 206, 207, 4478 208, 209, 210, 211, 212, 213, 214, 215, 4479 216, 217, 218, 219, 220, 221, 222, 223, 4480 224, 225, 226, 227, 228, 229, 230, 231, 4481 232, 233, 234, 235, 236, 237, 238, 239, 4482 240, 241, 242, 243, 244, 245, 246, 247, 4483 248, 249, 250, 251, 252, 253, 254, 255 4484 }; 4485 #else 4486 EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */ 4487 #endif 4488 #endif /* !PERL_GLOBAL_STRUCT */ 4489 4490 #ifdef DOINIT 4491 #ifdef EBCDIC 4492 EXTCONST unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */ 4493 1, 2, 84, 151, 154, 155, 156, 157, 4494 165, 246, 250, 3, 158, 7, 18, 29, 4495 40, 51, 62, 73, 85, 96, 107, 118, 4496 129, 140, 147, 148, 149, 150, 152, 153, 4497 255, 6, 8, 9, 10, 11, 12, 13, 4498 14, 15, 24, 25, 26, 27, 28, 226, 4499 29, 30, 31, 32, 33, 43, 44, 45, 4500 46, 47, 48, 49, 50, 76, 77, 78, 4501 79, 80, 81, 82, 83, 84, 85, 86, 4502 87, 94, 95, 234, 181, 233, 187, 190, 4503 180, 96, 97, 98, 99, 100, 101, 102, 4504 104, 112, 182, 174, 236, 232, 229, 103, 4505 228, 226, 114, 115, 116, 117, 118, 119, 4506 120, 121, 122, 235, 176, 230, 194, 162, 4507 130, 131, 132, 133, 134, 135, 136, 137, 4508 138, 139, 201, 205, 163, 217, 220, 224, 4509 5, 248, 227, 244, 242, 255, 241, 231, 4510 240, 253, 16, 197, 19, 20, 21, 187, 4511 23, 169, 210, 245, 237, 249, 247, 239, 4512 168, 252, 34, 196, 36, 37, 38, 39, 4513 41, 42, 251, 254, 238, 223, 221, 213, 4514 225, 177, 52, 53, 54, 55, 56, 57, 4515 58, 59, 60, 61, 63, 64, 65, 66, 4516 67, 68, 69, 70, 71, 72, 74, 75, 4517 205, 208, 186, 202, 200, 218, 198, 179, 4518 178, 214, 88, 89, 90, 91, 92, 93, 4519 217, 166, 170, 207, 199, 209, 206, 204, 4520 160, 212, 105, 106, 108, 109, 110, 111, 4521 203, 113, 216, 215, 192, 175, 193, 243, 4522 172, 161, 123, 124, 125, 126, 127, 128, 4523 222, 219, 211, 195, 188, 193, 185, 184, 4524 191, 183, 141, 142, 143, 144, 145, 146 4525 }; 4526 #else /* ascii rather than ebcdic */ 4527 EXTCONST unsigned char PL_freq[] = { /* letter frequencies for mixed English/C */ 4528 1, 2, 84, 151, 154, 155, 156, 157, 4529 165, 246, 250, 3, 158, 7, 18, 29, 4530 40, 51, 62, 73, 85, 96, 107, 118, 4531 129, 140, 147, 148, 149, 150, 152, 153, 4532 255, 182, 224, 205, 174, 176, 180, 217, 4533 233, 232, 236, 187, 235, 228, 234, 226, 4534 222, 219, 211, 195, 188, 193, 185, 184, 4535 191, 183, 201, 229, 181, 220, 194, 162, 4536 163, 208, 186, 202, 200, 218, 198, 179, 4537 178, 214, 166, 170, 207, 199, 209, 206, 4538 204, 160, 212, 216, 215, 192, 175, 173, 4539 243, 172, 161, 190, 203, 189, 164, 230, 4540 167, 248, 227, 244, 242, 255, 241, 231, 4541 240, 253, 169, 210, 245, 237, 249, 247, 4542 239, 168, 252, 251, 254, 238, 223, 221, 4543 213, 225, 177, 197, 171, 196, 159, 4, 4544 5, 6, 8, 9, 10, 11, 12, 13, 4545 14, 15, 16, 17, 19, 20, 21, 22, 4546 23, 24, 25, 26, 27, 28, 30, 31, 4547 32, 33, 34, 35, 36, 37, 38, 39, 4548 41, 42, 43, 44, 45, 46, 47, 48, 4549 49, 50, 52, 53, 54, 55, 56, 57, 4550 58, 59, 60, 61, 63, 64, 65, 66, 4551 67, 68, 69, 70, 71, 72, 74, 75, 4552 76, 77, 78, 79, 80, 81, 82, 83, 4553 86, 87, 88, 89, 90, 91, 92, 93, 4554 94, 95, 97, 98, 99, 100, 101, 102, 4555 103, 104, 105, 106, 108, 109, 110, 111, 4556 112, 113, 114, 115, 116, 117, 119, 120, 4557 121, 122, 123, 124, 125, 126, 127, 128, 4558 130, 131, 132, 133, 134, 135, 136, 137, 4559 138, 139, 141, 142, 143, 144, 145, 146 4560 }; 4561 #endif 4562 #else 4563 EXTCONST unsigned char PL_freq[]; 4564 #endif 4565 4566 #ifdef DEBUGGING 4567 #ifdef DOINIT 4568 EXTCONST char* const PL_block_type[] = { 4569 "NULL", 4570 "WHEN", 4571 "BLOCK", 4572 "GIVEN", 4573 "LOOP_FOR", 4574 "LOOP_PLAIN", 4575 "LOOP_LAZYSV", 4576 "LOOP_LAZYIV", 4577 "SUB", 4578 "FORMAT", 4579 "EVAL", 4580 "SUBST" 4581 }; 4582 #else 4583 EXTCONST char* PL_block_type[]; 4584 #endif 4585 #endif 4586 4587 /* These are all the compile time options that affect binary compatibility. 4588 Other compile time options that are binary compatible are in perl.c 4589 Both are combined for the output of perl -V 4590 However, this string will be embedded in any shared perl library, which will 4591 allow us add a comparison check in perlmain.c in the near future. */ 4592 #ifdef DOINIT 4593 EXTCONST char PL_bincompat_options[] = 4594 # ifdef DEBUG_LEAKING_SCALARS 4595 " DEBUG_LEAKING_SCALARS" 4596 # endif 4597 # ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP 4598 " DEBUG_LEAKING_SCALARS_FORK_DUMP" 4599 # endif 4600 # ifdef FAKE_THREADS 4601 " FAKE_THREADS" 4602 # endif 4603 # ifdef MULTIPLICITY 4604 " MULTIPLICITY" 4605 # endif 4606 # ifdef MYMALLOC 4607 " MYMALLOC" 4608 # endif 4609 # ifdef PERL_DEBUG_READONLY_OPS 4610 " PERL_DEBUG_READONLY_OPS" 4611 # endif 4612 # ifdef PERL_GLOBAL_STRUCT 4613 " PERL_GLOBAL_STRUCT" 4614 # endif 4615 # ifdef PERL_IMPLICIT_CONTEXT 4616 " PERL_IMPLICIT_CONTEXT" 4617 # endif 4618 # ifdef PERL_IMPLICIT_SYS 4619 " PERL_IMPLICIT_SYS" 4620 # endif 4621 # ifdef PERL_MAD 4622 " PERL_MAD" 4623 # endif 4624 # ifdef PERL_NEED_APPCTX 4625 " PERL_NEED_APPCTX" 4626 # endif 4627 # ifdef PERL_NEED_TIMESBASE 4628 " PERL_NEED_TIMESBASE" 4629 # endif 4630 # ifdef PERL_OLD_COPY_ON_WRITE 4631 " PERL_OLD_COPY_ON_WRITE" 4632 # endif 4633 # ifdef PERL_POISON 4634 " PERL_POISON" 4635 # endif 4636 # ifdef PERL_TRACK_MEMPOOL 4637 " PERL_TRACK_MEMPOOL" 4638 # endif 4639 # ifdef PERL_USES_PL_PIDSTATUS 4640 " PERL_USES_PL_PIDSTATUS" 4641 # endif 4642 # ifdef PL_OP_SLAB_ALLOC 4643 " PL_OP_SLAB_ALLOC" 4644 # endif 4645 # ifdef THREADS_HAVE_PIDS 4646 " THREADS_HAVE_PIDS" 4647 # endif 4648 # ifdef USE_64_BIT_ALL 4649 " USE_64_BIT_ALL" 4650 # endif 4651 # ifdef USE_64_BIT_INT 4652 " USE_64_BIT_INT" 4653 # endif 4654 # ifdef USE_IEEE 4655 " USE_IEEE" 4656 # endif 4657 # ifdef USE_ITHREADS 4658 " USE_ITHREADS" 4659 # endif 4660 # ifdef USE_LARGE_FILES 4661 " USE_LARGE_FILES" 4662 # endif 4663 # ifdef USE_LONG_DOUBLE 4664 " USE_LONG_DOUBLE" 4665 # endif 4666 # ifdef USE_PERLIO 4667 " USE_PERLIO" 4668 # endif 4669 # ifdef USE_REENTRANT_API 4670 " USE_REENTRANT_API" 4671 # endif 4672 # ifdef USE_SFIO 4673 " USE_SFIO" 4674 # endif 4675 # ifdef USE_SOCKS 4676 " USE_SOCKS" 4677 # endif 4678 # ifdef VMS_DO_SOCKETS 4679 " VMS_DO_SOCKETS" 4680 # ifdef DECCRTL_SOCKETS 4681 " DECCRTL_SOCKETS" 4682 # endif 4683 # endif 4684 # ifdef VMS_WE_ARE_CASE_SENSITIVE 4685 " VMS_SYMBOL_CASE_AS_IS" 4686 # endif 4687 ""; 4688 #else 4689 EXTCONST char PL_bincompat_options[]; 4690 #endif 4691 4692 END_EXTERN_C 4693 4694 /*****************************************************************************/ 4695 /* This lexer/parser stuff is currently global since yacc is hard to reenter */ 4696 /*****************************************************************************/ 4697 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */ 4698 4699 #ifdef __Lynx__ 4700 /* LynxOS defines these in scsi.h which is included via ioctl.h */ 4701 #ifdef FORMAT 4702 #undef FORMAT 4703 #endif 4704 #ifdef SPACE 4705 #undef SPACE 4706 #endif 4707 #endif 4708 4709 #define LEX_NOTPARSING 11 /* borrowed from toke.c */ 4710 4711 typedef enum { 4712 XOPERATOR, 4713 XTERM, 4714 XREF, 4715 XSTATE, 4716 XBLOCK, 4717 XATTRBLOCK, 4718 XATTRTERM, 4719 XTERMBLOCK, 4720 XTERMORDORDOR /* evil hack */ 4721 /* update exp_name[] in toke.c if adding to this enum */ 4722 } expectation; 4723 4724 enum { /* pass one of these to get_vtbl */ 4725 want_vtbl_sv, 4726 want_vtbl_env, 4727 want_vtbl_envelem, 4728 want_vtbl_sig, 4729 want_vtbl_sigelem, 4730 want_vtbl_pack, 4731 want_vtbl_packelem, 4732 want_vtbl_dbline, 4733 want_vtbl_isa, 4734 want_vtbl_isaelem, 4735 want_vtbl_arylen, 4736 want_vtbl_glob, 4737 want_vtbl_mglob, 4738 want_vtbl_nkeys, 4739 want_vtbl_taint, 4740 want_vtbl_substr, 4741 want_vtbl_vec, 4742 want_vtbl_pos, 4743 want_vtbl_bm, 4744 want_vtbl_fm, 4745 want_vtbl_uvar, 4746 want_vtbl_defelem, 4747 want_vtbl_regexp, 4748 want_vtbl_collxfrm, 4749 want_vtbl_amagic, 4750 want_vtbl_amagicelem, 4751 want_vtbl_regdata, 4752 want_vtbl_regdatum, 4753 want_vtbl_backref, 4754 want_vtbl_utf8, 4755 want_vtbl_symtab, 4756 want_vtbl_arylen_p, 4757 want_vtbl_hintselem, 4758 want_vtbl_hints 4759 }; 4760 4761 4762 /* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer 4763 special and there is no need for HINT_PRIVATE_MASK for COPs 4764 However, bitops store HINT_INTEGER in their op_private. */ 4765 #define HINT_INTEGER 0x00000001 /* integer pragma */ 4766 #define HINT_STRICT_REFS 0x00000002 /* strict pragma */ 4767 #define HINT_LOCALE 0x00000004 /* locale pragma */ 4768 #define HINT_BYTES 0x00000008 /* bytes pragma */ 4769 #define HINT_ARYBASE 0x00000010 /* $[ is non-zero */ 4770 /* Note: 20,40,80 used for NATIVE_HINTS */ 4771 /* currently defined by vms/vmsish.h */ 4772 4773 #define HINT_BLOCK_SCOPE 0x00000100 4774 #define HINT_STRICT_SUBS 0x00000200 /* strict pragma */ 4775 #define HINT_STRICT_VARS 0x00000400 /* strict pragma */ 4776 #define HINT_UNI_8_BIT 0x00000800 /* unicode_strings feature */ 4777 4778 /* The HINT_NEW_* constants are used by the overload pragma */ 4779 #define HINT_NEW_INTEGER 0x00001000 4780 #define HINT_NEW_FLOAT 0x00002000 4781 #define HINT_NEW_BINARY 0x00004000 4782 #define HINT_NEW_STRING 0x00008000 4783 #define HINT_NEW_RE 0x00010000 4784 #define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */ 4785 #define HINT_LEXICAL_IO_IN 0x00040000 /* ${^OPEN} is set for input */ 4786 #define HINT_LEXICAL_IO_OUT 0x00080000 /* ${^OPEN} is set for output */ 4787 4788 #define HINT_RE_TAINT 0x00100000 /* re pragma */ 4789 #define HINT_RE_EVAL 0x00200000 /* re pragma */ 4790 4791 #define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */ 4792 #define HINT_UTF8 0x00800000 /* utf8 pragma */ 4793 4794 #define HINT_NO_AMAGIC 0x01000000 /* overloading pragma */ 4795 4796 /* The following are stored in $^H{sort}, not in PL_hints */ 4797 #define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */ 4798 #define HINT_SORT_QUICKSORT 0x00000001 4799 #define HINT_SORT_MERGESORT 0x00000002 4800 #define HINT_SORT_STABLE 0x00000100 /* sort styles (currently one) */ 4801 4802 /* Various states of the input record separator SV (rs) */ 4803 #define RsSNARF(sv) (! SvOK(sv)) 4804 #define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) 4805 #define RsPARA(sv) (SvPOK(sv) && ! SvCUR(sv)) 4806 #define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) 4807 4808 /* A struct for keeping various DEBUGGING related stuff, 4809 * neatly packed. Currently only scratch variables for 4810 * constructing debug output are included. Needed always, 4811 * not just when DEBUGGING, though, because of the re extension. c*/ 4812 struct perl_debug_pad { 4813 SV pad[3]; 4814 }; 4815 4816 #define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i]) 4817 #define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, \ 4818 (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \ 4819 PERL_DEBUG_PAD(i)) 4820 4821 /* Enable variables which are pointers to functions */ 4822 typedef void (CPERLscope(*peep_t))(pTHX_ OP* o); 4823 typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm); 4824 typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg, 4825 char* strend, char* strbeg, I32 minend, 4826 SV* screamer, void* data, U32 flags); 4827 typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv, 4828 char *strpos, char *strend, 4829 U32 flags, 4830 re_scream_pos_data *d); 4831 typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog); 4832 typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r); 4833 typedef regexp*(CPERLscope(*regdupe_t)) (pTHX_ const regexp* r, CLONE_PARAMS *param); 4834 4835 typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*); 4836 typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*); 4837 typedef void (*SVFUNC_t) (pTHX_ SV* const); 4838 typedef I32 (*SVCOMPARE_t) (pTHX_ SV* const, SV* const); 4839 typedef void (*XSINIT_t) (pTHX); 4840 typedef void (*ATEXIT_t) (pTHX_ void*); 4841 typedef void (*XSUBADDR_t) (pTHX_ CV *); 4842 4843 /* Set up PERLVAR macros for populating structs */ 4844 #define PERLVAR(var,type) type var; 4845 #define PERLVARA(var,n,type) type var[n]; 4846 #define PERLVARI(var,type,init) type var; 4847 #define PERLVARIC(var,type,init) type var; 4848 #define PERLVARISC(var,init) const char var[sizeof(init)]; 4849 4850 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); 4851 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); 4852 typedef void(CPERLscope(*Perl_ophook_t))(pTHX_ OP*); 4853 typedef int (CPERLscope(*Perl_keyword_plugin_t))(pTHX_ char*, STRLEN, OP**); 4854 4855 #define KEYWORD_PLUGIN_DECLINE 0 4856 #define KEYWORD_PLUGIN_STMT 1 4857 #define KEYWORD_PLUGIN_EXPR 2 4858 4859 /* Interpreter exitlist entry */ 4860 typedef struct exitlistentry { 4861 void (*fn) (pTHX_ void*); 4862 void *ptr; 4863 } PerlExitListEntry; 4864 4865 /* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */ 4866 /* These have to be before perlvars.h */ 4867 #if !defined(HAS_SIGACTION) && defined(VMS) 4868 # define FAKE_PERSISTENT_SIGNAL_HANDLERS 4869 #endif 4870 /* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */ 4871 #if defined(KILL_BY_SIGPRC) 4872 # define FAKE_DEFAULT_SIGNAL_HANDLERS 4873 #endif 4874 4875 #define PERL_PATCHLEVEL_H_IMPLICIT 4876 #include "patchlevel.h" 4877 #undef PERL_PATCHLEVEL_H_IMPLICIT 4878 4879 #define PERL_VERSION_STRING STRINGIFY(PERL_REVISION) "." \ 4880 STRINGIFY(PERL_VERSION) "." \ 4881 STRINGIFY(PERL_SUBVERSION) 4882 4883 #ifdef PERL_GLOBAL_STRUCT 4884 struct perl_vars { 4885 # include "perlvars.h" 4886 }; 4887 4888 # ifdef PERL_CORE 4889 # ifndef PERL_GLOBAL_STRUCT_PRIVATE 4890 EXT struct perl_vars PL_Vars; 4891 EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); 4892 # undef PERL_GET_VARS 4893 # define PERL_GET_VARS() PL_VarsPtr 4894 # endif /* !PERL_GLOBAL_STRUCT_PRIVATE */ 4895 # else /* PERL_CORE */ 4896 # if !defined(__GNUC__) || !defined(WIN32) 4897 EXT 4898 # endif /* WIN32 */ 4899 struct perl_vars *PL_VarsPtr; 4900 # define PL_Vars (*((PL_VarsPtr) \ 4901 ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX)))) 4902 # endif /* PERL_CORE */ 4903 #endif /* PERL_GLOBAL_STRUCT */ 4904 4905 #if defined(MULTIPLICITY) 4906 /* If we have multiple interpreters define a struct 4907 holding variables which must be per-interpreter 4908 If we don't have threads anything that would have 4909 be per-thread is per-interpreter. 4910 */ 4911 4912 struct interpreter { 4913 # include "intrpvar.h" 4914 }; 4915 4916 #else 4917 struct interpreter { 4918 char broiled; 4919 }; 4920 #endif /* MULTIPLICITY */ 4921 4922 /* Done with PERLVAR macros for now ... */ 4923 #undef PERLVAR 4924 #undef PERLVARA 4925 #undef PERLVARI 4926 #undef PERLVARIC 4927 #undef PERLVARISC 4928 4929 struct tempsym; /* defined in pp_pack.c */ 4930 4931 #include "thread.h" 4932 #include "pp.h" 4933 4934 #ifndef PERL_CALLCONV 4935 # ifdef __cplusplus 4936 # define PERL_CALLCONV extern "C" 4937 # else 4938 # define PERL_CALLCONV 4939 # endif 4940 #endif 4941 #undef PERL_CKDEF 4942 #undef PERL_PPDEF 4943 #define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); 4944 #define PERL_PPDEF(s) PERL_CALLCONV OP *s (pTHX); 4945 4946 #include "proto.h" 4947 4948 /* this has structure inits, so it cannot be included before here */ 4949 #include "opcode.h" 4950 4951 /* The following must follow proto.h as #defines mess up syntax */ 4952 4953 #if !defined(PERL_FOR_X2P) 4954 # include "embedvar.h" 4955 #endif 4956 #ifndef PERL_MAD 4957 # undef PL_madskills 4958 # undef PL_xmlfp 4959 # define PL_madskills 0 4960 # define PL_xmlfp 0 4961 #endif 4962 4963 /* Now include all the 'global' variables 4964 * If we don't have threads or multiple interpreters 4965 * these include variables that would have been their struct-s 4966 */ 4967 4968 #define PERLVAR(var,type) EXT type PL_##var; 4969 #define PERLVARA(var,n,type) EXT type PL_##var[n]; 4970 #define PERLVARI(var,type,init) EXT type PL_##var INIT(init); 4971 #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init); 4972 #define PERLVARISC(var,init) EXTCONST char PL_##var[sizeof(init)] INIT(init); 4973 4974 #if !defined(MULTIPLICITY) 4975 START_EXTERN_C 4976 # include "intrpvar.h" 4977 END_EXTERN_C 4978 #endif 4979 4980 #ifdef PERL_CORE 4981 /* All core uses now exterminated. Ensure no zombies can return: */ 4982 # undef PL_na 4983 #endif 4984 4985 #if defined(WIN32) 4986 /* Now all the config stuff is setup we can include embed.h */ 4987 # include "embed.h" 4988 # ifndef PERL_MAD 4989 # undef op_getmad 4990 # define op_getmad(arg,pegop,slot) NOOP 4991 # endif 4992 #endif 4993 4994 #ifndef PERL_GLOBAL_STRUCT 4995 START_EXTERN_C 4996 4997 # include "perlvars.h" 4998 4999 END_EXTERN_C 5000 #endif 5001 5002 #undef PERLVAR 5003 #undef PERLVARA 5004 #undef PERLVARI 5005 #undef PERLVARIC 5006 5007 START_EXTERN_C 5008 5009 /* PERL_GLOBAL_STRUCT_PRIVATE wants to keep global data like the 5010 * magic vtables const, but this is incompatible with SWIG which 5011 * does want to modify the vtables. */ 5012 #ifdef PERL_GLOBAL_STRUCT_PRIVATE 5013 # define EXT_MGVTBL EXTCONST MGVTBL 5014 #else 5015 # define EXT_MGVTBL EXT MGVTBL 5016 #endif 5017 5018 #ifdef DOINIT 5019 # define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var = {a,b,c,d,e,f,g,h} 5020 /* Like MGVTBL_SET but with the get magic having a const MG* */ 5021 # define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var \ 5022 = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g,h} 5023 #else 5024 # define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var 5025 # define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var 5026 #endif 5027 5028 /* These all need to be 0, not NULL, as NULL can be (void*)0, which is a 5029 * pointer to data, whereas we're assigning pointers to functions, which are 5030 * not the same beast. ANSI doesn't allow the assignment from one to the other. 5031 * (although most, but not all, compilers are prepared to do it) 5032 */ 5033 MGVTBL_SET( 5034 PL_vtbl_sv, 5035 MEMBER_TO_FPTR(Perl_magic_get), 5036 MEMBER_TO_FPTR(Perl_magic_set), 5037 MEMBER_TO_FPTR(Perl_magic_len), 5038 0, 5039 0, 5040 0, 5041 0, 5042 0 5043 ); 5044 5045 MGVTBL_SET( 5046 PL_vtbl_env, 5047 0, 5048 MEMBER_TO_FPTR(Perl_magic_set_all_env), 5049 0, 5050 MEMBER_TO_FPTR(Perl_magic_clear_all_env), 5051 0, 5052 0, 5053 0, 5054 0 5055 ); 5056 5057 MGVTBL_SET( 5058 PL_vtbl_envelem, 5059 0, 5060 MEMBER_TO_FPTR(Perl_magic_setenv), 5061 0, 5062 MEMBER_TO_FPTR(Perl_magic_clearenv), 5063 0, 5064 0, 5065 0, 5066 0 5067 ); 5068 5069 MGVTBL_SET( 5070 PL_vtbl_sig, 5071 0, 5072 0, 5073 0, 5074 0, 5075 0, 5076 0, 5077 0, 5078 0 5079 ); 5080 5081 #ifdef PERL_MICRO 5082 MGVTBL_SET( 5083 PL_vtbl_sigelem, 5084 0, 5085 0, 5086 0, 5087 0, 5088 0, 5089 0, 5090 0, 5091 0 5092 ); 5093 5094 #else 5095 MGVTBL_SET( 5096 PL_vtbl_sigelem, 5097 MEMBER_TO_FPTR(Perl_magic_getsig), 5098 MEMBER_TO_FPTR(Perl_magic_setsig), 5099 0, 5100 MEMBER_TO_FPTR(Perl_magic_clearsig), 5101 0, 5102 0, 5103 0, 5104 0 5105 ); 5106 #endif 5107 5108 MGVTBL_SET( 5109 PL_vtbl_pack, 5110 0, 5111 0, 5112 MEMBER_TO_FPTR(Perl_magic_sizepack), 5113 MEMBER_TO_FPTR(Perl_magic_wipepack), 5114 0, 5115 0, 5116 0, 5117 0 5118 ); 5119 5120 MGVTBL_SET( 5121 PL_vtbl_packelem, 5122 MEMBER_TO_FPTR(Perl_magic_getpack), 5123 MEMBER_TO_FPTR(Perl_magic_setpack), 5124 0, 5125 MEMBER_TO_FPTR(Perl_magic_clearpack), 5126 0, 5127 0, 5128 0, 5129 0 5130 ); 5131 5132 MGVTBL_SET( 5133 PL_vtbl_dbline, 5134 0, 5135 MEMBER_TO_FPTR(Perl_magic_setdbline), 5136 0, 5137 0, 5138 0, 5139 0, 5140 0, 5141 0 5142 ); 5143 5144 MGVTBL_SET( 5145 PL_vtbl_isa, 5146 0, 5147 MEMBER_TO_FPTR(Perl_magic_setisa), 5148 0, 5149 MEMBER_TO_FPTR(Perl_magic_clearisa), 5150 0, 5151 0, 5152 0, 5153 0 5154 ); 5155 5156 MGVTBL_SET( 5157 PL_vtbl_isaelem, 5158 0, 5159 MEMBER_TO_FPTR(Perl_magic_setisa), 5160 0, 5161 0, 5162 0, 5163 0, 5164 0, 5165 0 5166 ); 5167 5168 MGVTBL_SET_CONST_MAGIC_GET( 5169 PL_vtbl_arylen, 5170 MEMBER_TO_FPTR(Perl_magic_getarylen), 5171 MEMBER_TO_FPTR(Perl_magic_setarylen), 5172 0, 5173 0, 5174 0, 5175 0, 5176 0, 5177 0 5178 ); 5179 5180 MGVTBL_SET( 5181 PL_vtbl_arylen_p, 5182 0, 5183 0, 5184 0, 5185 0, 5186 MEMBER_TO_FPTR(Perl_magic_freearylen_p), 5187 0, 5188 0, 5189 0 5190 ); 5191 5192 MGVTBL_SET( 5193 PL_vtbl_mglob, 5194 0, 5195 MEMBER_TO_FPTR(Perl_magic_setmglob), 5196 0, 5197 0, 5198 0, 5199 0, 5200 0, 5201 0 5202 ); 5203 5204 MGVTBL_SET( 5205 PL_vtbl_nkeys, 5206 MEMBER_TO_FPTR(Perl_magic_getnkeys), 5207 MEMBER_TO_FPTR(Perl_magic_setnkeys), 5208 0, 5209 0, 5210 0, 5211 0, 5212 0, 5213 0 5214 ); 5215 5216 MGVTBL_SET( 5217 PL_vtbl_taint, 5218 MEMBER_TO_FPTR(Perl_magic_gettaint), 5219 MEMBER_TO_FPTR(Perl_magic_settaint), 5220 0, 5221 0, 5222 0, 5223 0, 5224 0, 5225 0 5226 ); 5227 5228 MGVTBL_SET( 5229 PL_vtbl_substr, 5230 MEMBER_TO_FPTR(Perl_magic_getsubstr), 5231 MEMBER_TO_FPTR(Perl_magic_setsubstr), 5232 0, 5233 0, 5234 0, 5235 0, 5236 0, 5237 0 5238 ); 5239 5240 MGVTBL_SET( 5241 PL_vtbl_vec, 5242 MEMBER_TO_FPTR(Perl_magic_getvec), 5243 MEMBER_TO_FPTR(Perl_magic_setvec), 5244 0, 5245 0, 5246 0, 5247 0, 5248 0, 5249 0 5250 ); 5251 5252 MGVTBL_SET( 5253 PL_vtbl_pos, 5254 MEMBER_TO_FPTR(Perl_magic_getpos), 5255 MEMBER_TO_FPTR(Perl_magic_setpos), 5256 0, 5257 0, 5258 0, 5259 0, 5260 0, 5261 0 5262 ); 5263 5264 MGVTBL_SET( 5265 PL_vtbl_bm, 5266 0, 5267 MEMBER_TO_FPTR(Perl_magic_setregexp), 5268 0, 5269 0, 5270 0, 5271 0, 5272 0, 5273 0 5274 ); 5275 5276 MGVTBL_SET( 5277 PL_vtbl_fm, 5278 0, 5279 MEMBER_TO_FPTR(Perl_magic_setregexp), 5280 0, 5281 0, 5282 0, 5283 0, 5284 0, 5285 0 5286 ); 5287 5288 MGVTBL_SET( 5289 PL_vtbl_uvar, 5290 MEMBER_TO_FPTR(Perl_magic_getuvar), 5291 MEMBER_TO_FPTR(Perl_magic_setuvar), 5292 0, 5293 0, 5294 0, 5295 0, 5296 0, 5297 0 5298 ); 5299 5300 MGVTBL_SET( 5301 PL_vtbl_defelem, 5302 MEMBER_TO_FPTR(Perl_magic_getdefelem), 5303 MEMBER_TO_FPTR(Perl_magic_setdefelem), 5304 0, 5305 0, 5306 0, 5307 0, 5308 0, 5309 0 5310 ); 5311 5312 MGVTBL_SET( 5313 PL_vtbl_regexp, 5314 0, 5315 MEMBER_TO_FPTR(Perl_magic_setregexp), 5316 0, 5317 0, 5318 0, 5319 0, 5320 0, 5321 0 5322 ); 5323 5324 MGVTBL_SET( 5325 PL_vtbl_regdata, 5326 0, 5327 0, 5328 MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 5329 0, 5330 0, 5331 0, 5332 0, 5333 0 5334 ); 5335 5336 MGVTBL_SET( 5337 PL_vtbl_regdatum, 5338 MEMBER_TO_FPTR(Perl_magic_regdatum_get), 5339 MEMBER_TO_FPTR(Perl_magic_regdatum_set), 5340 0, 5341 0, 5342 0, 5343 0, 5344 0, 5345 0 5346 ); 5347 5348 MGVTBL_SET( 5349 PL_vtbl_amagic, 5350 0, 5351 MEMBER_TO_FPTR(Perl_magic_setamagic), 5352 0, 5353 0, 5354 MEMBER_TO_FPTR(Perl_magic_setamagic), 5355 0, 5356 0, 5357 0 5358 ); 5359 5360 MGVTBL_SET( 5361 PL_vtbl_amagicelem, 5362 0, 5363 MEMBER_TO_FPTR(Perl_magic_setamagic), 5364 0, 5365 0, 5366 MEMBER_TO_FPTR(Perl_magic_setamagic), 5367 0, 5368 0, 5369 0 5370 ); 5371 5372 MGVTBL_SET( 5373 PL_vtbl_backref, 5374 0, 5375 0, 5376 0, 5377 0, 5378 MEMBER_TO_FPTR(Perl_magic_killbackrefs), 5379 0, 5380 0, 5381 0 5382 ); 5383 5384 MGVTBL_SET( 5385 PL_vtbl_ovrld, 5386 0, 5387 0, 5388 0, 5389 0, 5390 MEMBER_TO_FPTR(Perl_magic_freeovrld), 5391 0, 5392 0, 5393 0 5394 ); 5395 5396 MGVTBL_SET( 5397 PL_vtbl_utf8, 5398 0, 5399 MEMBER_TO_FPTR(Perl_magic_setutf8), 5400 0, 5401 0, 5402 0, 5403 0, 5404 0, 5405 0 5406 ); 5407 #ifdef USE_LOCALE_COLLATE 5408 MGVTBL_SET( 5409 PL_vtbl_collxfrm, 5410 0, 5411 MEMBER_TO_FPTR(Perl_magic_setcollxfrm), 5412 0, 5413 0, 5414 0, 5415 0, 5416 0, 5417 0 5418 ); 5419 #endif 5420 5421 MGVTBL_SET( 5422 PL_vtbl_hintselem, 5423 0, 5424 MEMBER_TO_FPTR(Perl_magic_sethint), 5425 0, 5426 MEMBER_TO_FPTR(Perl_magic_clearhint), 5427 0, 5428 0, 5429 0, 5430 0 5431 ); 5432 5433 MGVTBL_SET( 5434 PL_vtbl_hints, 5435 0, 5436 0, 5437 0, 5438 MEMBER_TO_FPTR(Perl_magic_clearhints), 5439 0, 5440 0, 5441 0, 5442 0 5443 ); 5444 5445 #include "overload.h" 5446 5447 END_EXTERN_C 5448 5449 struct am_table { 5450 U32 flags; 5451 U32 was_ok_sub; 5452 long was_ok_am; 5453 long fallback; 5454 CV* table[NofAMmeth]; 5455 }; 5456 struct am_table_short { 5457 U32 flags; 5458 U32 was_ok_sub; 5459 long was_ok_am; 5460 }; 5461 typedef struct am_table AMT; 5462 typedef struct am_table_short AMTS; 5463 5464 #define AMGfallNEVER 1 5465 #define AMGfallNO 2 5466 #define AMGfallYES 3 5467 5468 #define AMTf_AMAGIC 1 5469 #define AMTf_OVERLOADED 2 5470 #define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC) 5471 #define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC) 5472 #define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC) 5473 #define AMT_OVERLOADED(amt) ((amt)->flags & AMTf_OVERLOADED) 5474 #define AMT_OVERLOADED_on(amt) ((amt)->flags |= AMTf_OVERLOADED) 5475 #define AMT_OVERLOADED_off(amt) ((amt)->flags &= ~AMTf_OVERLOADED) 5476 5477 #define StashHANDLER(stash,meth) gv_handler((stash),CAT2(meth,_amg)) 5478 5479 /* 5480 * some compilers like to redefine cos et alia as faster 5481 * (and less accurate?) versions called F_cos et cetera (Quidquid 5482 * latine dictum sit, altum viditur.) This trick collides with 5483 * the Perl overloading (amg). The following #defines fool both. 5484 */ 5485 5486 #ifdef _FASTMATH 5487 # ifdef atan2 5488 # define F_atan2_amg atan2_amg 5489 # endif 5490 # ifdef cos 5491 # define F_cos_amg cos_amg 5492 # endif 5493 # ifdef exp 5494 # define F_exp_amg exp_amg 5495 # endif 5496 # ifdef log 5497 # define F_log_amg log_amg 5498 # endif 5499 # ifdef pow 5500 # define F_pow_amg pow_amg 5501 # endif 5502 # ifdef sin 5503 # define F_sin_amg sin_amg 5504 # endif 5505 # ifdef sqrt 5506 # define F_sqrt_amg sqrt_amg 5507 # endif 5508 #endif /* _FASTMATH */ 5509 5510 #define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \ 5511 PERLDBf_NOOPT | PERLDBf_INTER | \ 5512 PERLDBf_SUBLINE| PERLDBf_SINGLE| \ 5513 PERLDBf_NAMEEVAL| PERLDBf_NAMEANON | \ 5514 PERLDBf_SAVESRC) 5515 /* No _NONAME, _GOTO */ 5516 #define PERLDBf_SUB 0x01 /* Debug sub enter/exit */ 5517 #define PERLDBf_LINE 0x02 /* Keep line # */ 5518 #define PERLDBf_NOOPT 0x04 /* Switch off optimizations */ 5519 #define PERLDBf_INTER 0x08 /* Preserve more data for 5520 later inspections */ 5521 #define PERLDBf_SUBLINE 0x10 /* Keep subr source lines */ 5522 #define PERLDBf_SINGLE 0x20 /* Start with single-step on */ 5523 #define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr */ 5524 #define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */ 5525 #define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */ 5526 #define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */ 5527 #define PERLDBf_SAVESRC 0x400 /* Save source lines into @{"_<$filename"} */ 5528 #define PERLDBf_SAVESRC_NOSUBS 0x800 /* Including evals that generate no subrouties */ 5529 #define PERLDBf_SAVESRC_INVALID 0x1000 /* Save source that did not compile */ 5530 5531 #define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB)) 5532 #define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE)) 5533 #define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT)) 5534 #define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER)) 5535 #define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE)) 5536 #define PERLDB_SINGLE (PL_perldb && (PL_perldb & PERLDBf_SINGLE)) 5537 #define PERLDB_SUB_NN (PL_perldb && (PL_perldb & (PERLDBf_NONAME))) 5538 #define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO)) 5539 #define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL)) 5540 #define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON)) 5541 #define PERLDB_SAVESRC (PL_perldb && (PL_perldb & PERLDBf_SAVESRC)) 5542 #define PERLDB_SAVESRC_NOSUBS (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS)) 5543 #define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID)) 5544 5545 #ifdef USE_LOCALE_NUMERIC 5546 5547 #define SET_NUMERIC_STANDARD() \ 5548 set_numeric_standard(); 5549 5550 #define SET_NUMERIC_LOCAL() \ 5551 set_numeric_local(); 5552 5553 #define IN_LOCALE_RUNTIME (CopHINTS_get(PL_curcop) & HINT_LOCALE) 5554 #define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) 5555 5556 #define IN_LOCALE \ 5557 (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) 5558 5559 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \ 5560 bool was_local = PL_numeric_local && IN_LOCALE; \ 5561 if (was_local) SET_NUMERIC_STANDARD(); 5562 5563 #define STORE_NUMERIC_STANDARD_SET_LOCAL() \ 5564 bool was_standard = PL_numeric_standard && IN_LOCALE; \ 5565 if (was_standard) SET_NUMERIC_LOCAL(); 5566 5567 #define RESTORE_NUMERIC_LOCAL() \ 5568 if (was_local) SET_NUMERIC_LOCAL(); 5569 5570 #define RESTORE_NUMERIC_STANDARD() \ 5571 if (was_standard) SET_NUMERIC_STANDARD(); 5572 5573 #define Atof my_atof 5574 5575 #else /* !USE_LOCALE_NUMERIC */ 5576 5577 #define SET_NUMERIC_STANDARD() /**/ 5578 #define SET_NUMERIC_LOCAL() /**/ 5579 #define IS_NUMERIC_RADIX(a, b) (0) 5580 #define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/ 5581 #define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/ 5582 #define RESTORE_NUMERIC_LOCAL() /**/ 5583 #define RESTORE_NUMERIC_STANDARD() /**/ 5584 #define Atof my_atof 5585 #define IN_LOCALE_RUNTIME 0 5586 5587 #endif /* !USE_LOCALE_NUMERIC */ 5588 5589 #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG 5590 # ifdef __hpux 5591 # define strtoll __strtoll /* secret handshake */ 5592 # endif 5593 # ifdef WIN64 5594 # define strtoll _strtoi64 /* secret handshake */ 5595 # endif 5596 # if !defined(Strtol) && defined(HAS_STRTOLL) 5597 # define Strtol strtoll 5598 # endif 5599 # if !defined(Strtol) && defined(HAS_STRTOQ) 5600 # define Strtol strtoq 5601 # endif 5602 /* is there atoq() anywhere? */ 5603 #endif 5604 #if !defined(Strtol) && defined(HAS_STRTOL) 5605 # define Strtol strtol 5606 #endif 5607 #ifndef Atol 5608 /* It would be more fashionable to use Strtol() to define atol() 5609 * (as is done for Atoul(), see below) but for backward compatibility 5610 * we just assume atol(). */ 5611 # if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL) 5612 # ifdef WIN64 5613 # define atoll _atoi64 /* secret handshake */ 5614 # endif 5615 # define Atol atoll 5616 # else 5617 # define Atol atol 5618 # endif 5619 #endif 5620 5621 #if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG 5622 # ifdef __hpux 5623 # define strtoull __strtoull /* secret handshake */ 5624 # endif 5625 # ifdef WIN64 5626 # define strtoull _strtoui64 /* secret handshake */ 5627 # endif 5628 # if !defined(Strtoul) && defined(HAS_STRTOULL) 5629 # define Strtoul strtoull 5630 # endif 5631 # if !defined(Strtoul) && defined(HAS_STRTOUQ) 5632 # define Strtoul strtouq 5633 # endif 5634 /* is there atouq() anywhere? */ 5635 #endif 5636 #if !defined(Strtoul) && defined(HAS_STRTOUL) 5637 # define Strtoul strtoul 5638 #endif 5639 #if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */ 5640 # define Strtoul(s, e, b) strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b)) 5641 #endif 5642 #ifndef Atoul 5643 # define Atoul(s) Strtoul(s, NULL, 10) 5644 #endif 5645 5646 5647 /* if these never got defined, they need defaults */ 5648 #ifndef PERL_SET_CONTEXT 5649 # define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i) 5650 #endif 5651 5652 #ifndef PERL_GET_CONTEXT 5653 # define PERL_GET_CONTEXT PERL_GET_INTERP 5654 #endif 5655 5656 #ifndef PERL_GET_THX 5657 # define PERL_GET_THX ((void*)NULL) 5658 #endif 5659 5660 #ifndef PERL_SET_THX 5661 # define PERL_SET_THX(t) NOOP 5662 #endif 5663 5664 #ifndef PERL_SCRIPT_MODE 5665 #define PERL_SCRIPT_MODE "r" 5666 #endif 5667 5668 /* 5669 * Some operating systems are stingy with stack allocation, 5670 * so perl may have to guard against stack overflow. 5671 */ 5672 #ifndef PERL_STACK_OVERFLOW_CHECK 5673 #define PERL_STACK_OVERFLOW_CHECK() NOOP 5674 #endif 5675 5676 /* 5677 * Some nonpreemptive operating systems find it convenient to 5678 * check for asynchronous conditions after each op execution. 5679 * Keep this check simple, or it may slow down execution 5680 * massively. 5681 */ 5682 5683 #ifndef PERL_MICRO 5684 # ifndef PERL_ASYNC_CHECK 5685 # define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals() 5686 # endif 5687 #endif 5688 5689 #ifndef PERL_ASYNC_CHECK 5690 # define PERL_ASYNC_CHECK() NOOP 5691 #endif 5692 5693 /* 5694 * On some operating systems, a memory allocation may succeed, 5695 * but put the process too close to the system's comfort limit. 5696 * In this case, PERL_ALLOC_CHECK frees the pointer and sets 5697 * it to NULL. 5698 */ 5699 #ifndef PERL_ALLOC_CHECK 5700 #define PERL_ALLOC_CHECK(p) NOOP 5701 #endif 5702 5703 #ifdef HAS_SEM 5704 # include <sys/ipc.h> 5705 # include <sys/sem.h> 5706 # ifndef HAS_UNION_SEMUN /* Provide the union semun. */ 5707 union semun { 5708 int val; 5709 struct semid_ds *buf; 5710 unsigned short *array; 5711 }; 5712 # endif 5713 # ifdef USE_SEMCTL_SEMUN 5714 # ifdef IRIX32_SEMUN_BROKEN_BY_GCC 5715 union gccbug_semun { 5716 int val; 5717 struct semid_ds *buf; 5718 unsigned short *array; 5719 char __dummy[5]; 5720 }; 5721 # define semun gccbug_semun 5722 # endif 5723 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) 5724 # else 5725 # ifdef USE_SEMCTL_SEMID_DS 5726 # ifdef EXTRA_F_IN_SEMUN_BUF 5727 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff) 5728 # else 5729 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf) 5730 # endif 5731 # endif 5732 # endif 5733 #endif 5734 5735 /* 5736 * Boilerplate macros for initializing and accessing interpreter-local 5737 * data from C. All statics in extensions should be reworked to use 5738 * this, if you want to make the extension thread-safe. See 5739 * ext/XS/APItest/APItest.xs for an example of the use of these macros, 5740 * and perlxs.pod for more. 5741 * 5742 * Code that uses these macros is responsible for the following: 5743 * 1. #define MY_CXT_KEY to a unique string, e.g. 5744 * "DynaLoader::_guts" XS_VERSION 5745 * XXX in the current implementation, this string is ignored. 5746 * 2. Declare a typedef named my_cxt_t that is a structure that contains 5747 * all the data that needs to be interpreter-local. 5748 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 5749 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 5750 * (typically put in the BOOT: section). 5751 * 5. Use the members of the my_cxt_t structure everywhere as 5752 * MY_CXT.member. 5753 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 5754 * access MY_CXT. 5755 */ 5756 5757 #if defined(PERL_IMPLICIT_CONTEXT) 5758 5759 #ifdef PERL_GLOBAL_STRUCT_PRIVATE 5760 5761 /* This must appear in all extensions that define a my_cxt_t structure, 5762 * right after the definition (i.e. at file scope). The non-threads 5763 * case below uses it to declare the data as static. */ 5764 #define START_MY_CXT 5765 #define MY_CXT_INDEX Perl_my_cxt_index(aTHX_ MY_CXT_KEY) 5766 5767 /* Creates and zeroes the per-interpreter data. 5768 * (We allocate my_cxtp in a Perl SV so that it will be released when 5769 * the interpreter goes away.) */ 5770 #define MY_CXT_INIT \ 5771 my_cxt_t *my_cxtp = \ 5772 (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_KEY, sizeof(my_cxt_t)) 5773 #define MY_CXT_INIT_INTERP(my_perl) \ 5774 my_cxt_t *my_cxtp = \ 5775 (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_KEY, sizeof(my_cxt_t)) 5776 5777 /* This declaration should be used within all functions that use the 5778 * interpreter-local data. */ 5779 #define dMY_CXT \ 5780 my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[MY_CXT_INDEX] 5781 #define dMY_CXT_INTERP(my_perl) \ 5782 my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[MY_CXT_INDEX] 5783 5784 /* Clones the per-interpreter data. */ 5785 #define MY_CXT_CLONE \ 5786 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 5787 Copy(PL_my_cxt_list[MY_CXT_INDEX], my_cxtp, 1, my_cxt_t);\ 5788 PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp \ 5789 5790 #else /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */ 5791 5792 /* This must appear in all extensions that define a my_cxt_t structure, 5793 * right after the definition (i.e. at file scope). The non-threads 5794 * case below uses it to declare the data as static. */ 5795 #define START_MY_CXT static int my_cxt_index = -1; 5796 5797 /* This declaration should be used within all functions that use the 5798 * interpreter-local data. */ 5799 #define dMY_CXT \ 5800 my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[my_cxt_index] 5801 #define dMY_CXT_INTERP(my_perl) \ 5802 my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[my_cxt_index] 5803 5804 /* Creates and zeroes the per-interpreter data. 5805 * (We allocate my_cxtp in a Perl SV so that it will be released when 5806 * the interpreter goes away.) */ 5807 #define MY_CXT_INIT \ 5808 my_cxt_t *my_cxtp = \ 5809 (my_cxt_t*)Perl_my_cxt_init(aTHX_ &my_cxt_index, sizeof(my_cxt_t)) 5810 #define MY_CXT_INIT_INTERP(my_perl) \ 5811 my_cxt_t *my_cxtp = \ 5812 (my_cxt_t*)Perl_my_cxt_init(my_perl, &my_cxt_index, sizeof(my_cxt_t)) 5813 5814 /* Clones the per-interpreter data. */ 5815 #define MY_CXT_CLONE \ 5816 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 5817 Copy(PL_my_cxt_list[my_cxt_index], my_cxtp, 1, my_cxt_t);\ 5818 PL_my_cxt_list[my_cxt_index] = my_cxtp \ 5819 5820 #endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */ 5821 5822 /* This macro must be used to access members of the my_cxt_t structure. 5823 * e.g. MYCXT.some_data */ 5824 #define MY_CXT (*my_cxtp) 5825 5826 /* Judicious use of these macros can reduce the number of times dMY_CXT 5827 * is used. Use is similar to pTHX, aTHX etc. */ 5828 #define pMY_CXT my_cxt_t *my_cxtp 5829 #define pMY_CXT_ pMY_CXT, 5830 #define _pMY_CXT ,pMY_CXT 5831 #define aMY_CXT my_cxtp 5832 #define aMY_CXT_ aMY_CXT, 5833 #define _aMY_CXT ,aMY_CXT 5834 5835 #else /* PERL_IMPLICIT_CONTEXT */ 5836 5837 #define START_MY_CXT static my_cxt_t my_cxt; 5838 #define dMY_CXT_SV dNOOP 5839 #define dMY_CXT dNOOP 5840 #define dMY_CXT_INTERP(my_perl) dNOOP 5841 #define MY_CXT_INIT NOOP 5842 #define MY_CXT_CLONE NOOP 5843 #define MY_CXT my_cxt 5844 5845 #define pMY_CXT void 5846 #define pMY_CXT_ 5847 #define _pMY_CXT 5848 #define aMY_CXT 5849 #define aMY_CXT_ 5850 #define _aMY_CXT 5851 5852 #endif /* !defined(PERL_IMPLICIT_CONTEXT) */ 5853 5854 #ifdef I_FCNTL 5855 # include <fcntl.h> 5856 #endif 5857 5858 #ifdef __Lynx__ 5859 # include <fcntl.h> 5860 #endif 5861 5862 #ifdef I_SYS_FILE 5863 # include <sys/file.h> 5864 #endif 5865 5866 #if defined(HAS_FLOCK) && !defined(HAS_FLOCK_PROTO) 5867 int flock(int fd, int op); 5868 #endif 5869 5870 #ifndef O_RDONLY 5871 /* Assume UNIX defaults */ 5872 # define O_RDONLY 0000 5873 # define O_WRONLY 0001 5874 # define O_RDWR 0002 5875 # define O_CREAT 0100 5876 #endif 5877 5878 #ifndef O_BINARY 5879 # define O_BINARY 0 5880 #endif 5881 5882 #ifndef O_TEXT 5883 # define O_TEXT 0 5884 #endif 5885 5886 #if O_TEXT != O_BINARY 5887 /* If you have different O_TEXT and O_BINARY and you are a CLRF shop, 5888 * that is, you are somehow DOSish. */ 5889 # if defined(__BEOS__) || defined(__HAIKU__) || defined(__VOS__) || \ 5890 defined(__CYGWIN__) 5891 /* BeOS/Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; 5892 * BeOS/Haiku is always UNIXoid (LF), not DOSish (CRLF). */ 5893 /* VOS has O_TEXT != O_BINARY, and they have effect, 5894 * but VOS always uses LF, never CRLF. */ 5895 /* If you have O_TEXT different from your O_BINARY but you still are 5896 * not a CRLF shop. */ 5897 # undef PERLIO_USING_CRLF 5898 # else 5899 /* If you really are DOSish. */ 5900 # define PERLIO_USING_CRLF 1 5901 # endif 5902 #endif 5903 5904 #ifdef I_LIBUTIL 5905 # include <libutil.h> /* setproctitle() in some FreeBSDs */ 5906 #endif 5907 5908 #ifndef EXEC_ARGV_CAST 5909 #define EXEC_ARGV_CAST(x) (char **)x 5910 #endif 5911 5912 #define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not 5913 int). value returned in pointed- 5914 to UV */ 5915 #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */ 5916 #define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation */ 5917 #define IS_NUMBER_NEG 0x08 /* leading minus sign */ 5918 #define IS_NUMBER_INFINITY 0x10 /* this is big */ 5919 #define IS_NUMBER_NAN 0x20 /* this is not */ 5920 5921 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) 5922 5923 /* Input flags: */ 5924 #define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ in numbers */ 5925 #define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x in hex etc */ 5926 #define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */ 5927 /* Output flags: */ 5928 #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */ 5929 5930 /* to let user control profiling */ 5931 #ifdef PERL_GPROF_CONTROL 5932 extern void moncontrol(int); 5933 #define PERL_GPROF_MONCONTROL(x) moncontrol(x) 5934 #else 5935 #define PERL_GPROF_MONCONTROL(x) 5936 #endif 5937 5938 #ifdef UNDER_CE 5939 #include "wince.h" 5940 #endif 5941 5942 /* ISO 6429 NEL - C1 control NExt Line */ 5943 /* See http://www.unicode.org/unicode/reports/tr13/ */ 5944 #ifdef EBCDIC /* In EBCDIC NEL is just an alias for LF */ 5945 # if '^' == 95 /* CP 1047: MVS OpenEdition - OS/390 - z/OS */ 5946 # define NEXT_LINE_CHAR 0x15 5947 # else /* CDRA */ 5948 # define NEXT_LINE_CHAR 0x25 5949 # endif 5950 #else 5951 # define NEXT_LINE_CHAR 0x85 5952 #endif 5953 5954 /* The UTF-8 bytes of the Unicode LS and PS, U+2028 and U+2029 */ 5955 #define UNICODE_LINE_SEPA_0 0xE2 5956 #define UNICODE_LINE_SEPA_1 0x80 5957 #define UNICODE_LINE_SEPA_2 0xA8 5958 #define UNICODE_PARA_SEPA_0 0xE2 5959 #define UNICODE_PARA_SEPA_1 0x80 5960 #define UNICODE_PARA_SEPA_2 0xA9 5961 5962 #ifndef PIPESOCK_MODE 5963 # define PIPESOCK_MODE 5964 #endif 5965 5966 #ifndef SOCKET_OPEN_MODE 5967 # define SOCKET_OPEN_MODE PIPESOCK_MODE 5968 #endif 5969 5970 #ifndef PIPE_OPEN_MODE 5971 # define PIPE_OPEN_MODE PIPESOCK_MODE 5972 #endif 5973 5974 #define PERL_MAGIC_UTF8_CACHESIZE 2 5975 5976 #define PERL_UNICODE_STDIN_FLAG 0x0001 5977 #define PERL_UNICODE_STDOUT_FLAG 0x0002 5978 #define PERL_UNICODE_STDERR_FLAG 0x0004 5979 #define PERL_UNICODE_IN_FLAG 0x0008 5980 #define PERL_UNICODE_OUT_FLAG 0x0010 5981 #define PERL_UNICODE_ARGV_FLAG 0x0020 5982 #define PERL_UNICODE_LOCALE_FLAG 0x0040 5983 #define PERL_UNICODE_WIDESYSCALLS_FLAG 0x0080 /* for Sarathy */ 5984 #define PERL_UNICODE_UTF8CACHEASSERT_FLAG 0x0100 5985 5986 #define PERL_UNICODE_STD_FLAG \ 5987 (PERL_UNICODE_STDIN_FLAG | \ 5988 PERL_UNICODE_STDOUT_FLAG | \ 5989 PERL_UNICODE_STDERR_FLAG) 5990 5991 #define PERL_UNICODE_INOUT_FLAG \ 5992 (PERL_UNICODE_IN_FLAG | \ 5993 PERL_UNICODE_OUT_FLAG) 5994 5995 #define PERL_UNICODE_DEFAULT_FLAGS \ 5996 (PERL_UNICODE_STD_FLAG | \ 5997 PERL_UNICODE_INOUT_FLAG | \ 5998 PERL_UNICODE_LOCALE_FLAG) 5999 6000 #define PERL_UNICODE_ALL_FLAGS 0x01ff 6001 6002 #define PERL_UNICODE_STDIN 'I' 6003 #define PERL_UNICODE_STDOUT 'O' 6004 #define PERL_UNICODE_STDERR 'E' 6005 #define PERL_UNICODE_STD 'S' 6006 #define PERL_UNICODE_IN 'i' 6007 #define PERL_UNICODE_OUT 'o' 6008 #define PERL_UNICODE_INOUT 'D' 6009 #define PERL_UNICODE_ARGV 'A' 6010 #define PERL_UNICODE_LOCALE 'L' 6011 #define PERL_UNICODE_WIDESYSCALLS 'W' 6012 #define PERL_UNICODE_UTF8CACHEASSERT 'a' 6013 6014 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001 6015 6016 /* From sigaction(2) (FreeBSD man page): 6017 * | Signal routines normally execute with the signal that 6018 * | caused their invocation blocked, but other signals may 6019 * | yet occur. 6020 * Emulation of this behavior (from within Perl) is enabled 6021 * by defining PERL_BLOCK_SIGNALS. 6022 */ 6023 #define PERL_BLOCK_SIGNALS 6024 6025 #if defined(HAS_SIGPROCMASK) && defined(PERL_BLOCK_SIGNALS) 6026 # define PERL_BLOCKSIG_ADD(set,sig) \ 6027 sigset_t set; sigemptyset(&(set)); sigaddset(&(set), sig) 6028 # define PERL_BLOCKSIG_BLOCK(set) \ 6029 sigprocmask(SIG_BLOCK, &(set), NULL) 6030 # define PERL_BLOCKSIG_UNBLOCK(set) \ 6031 sigprocmask(SIG_UNBLOCK, &(set), NULL) 6032 #endif /* HAS_SIGPROCMASK && PERL_BLOCK_SIGNALS */ 6033 6034 /* How about the old style of sigblock()? */ 6035 6036 #ifndef PERL_BLOCKSIG_ADD 6037 # define PERL_BLOCKSIG_ADD(set, sig) NOOP 6038 #endif 6039 #ifndef PERL_BLOCKSIG_BLOCK 6040 # define PERL_BLOCKSIG_BLOCK(set) NOOP 6041 #endif 6042 #ifndef PERL_BLOCKSIG_UNBLOCK 6043 # define PERL_BLOCKSIG_UNBLOCK(set) NOOP 6044 #endif 6045 6046 /* Use instead of abs() since abs() forces its argument to be an int, 6047 * but also beware since this evaluates its argument twice, so no x++. */ 6048 #define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) 6049 6050 #if defined(__DECC) && defined(__osf__) 6051 #pragma message disable (mainparm) /* Perl uses the envp in main(). */ 6052 #endif 6053 6054 #define do_open(g, n, l, a, rm, rp, sf) \ 6055 do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0) 6056 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION 6057 # define do_exec(cmd) do_exec3(cmd,0,0) 6058 #endif 6059 #ifdef OS2 6060 # define do_aexec Perl_do_aexec 6061 #else 6062 # define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0) 6063 #endif 6064 6065 #if defined(OEMVS) 6066 #define NO_ENV_ARRAY_IN_MAIN 6067 #endif 6068 6069 /* These are used by Perl_pv_escape() and Perl_pv_pretty() 6070 * are here so that they are available throughout the core 6071 * NOTE that even though some are for _escape and some for _pretty 6072 * there must not be any clashes as the flags from _pretty are 6073 * passed straight through to _escape. 6074 */ 6075 6076 #define PERL_PV_ESCAPE_QUOTE 0x0001 6077 #define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE 6078 6079 #define PERL_PV_PRETTY_ELLIPSES 0x0002 6080 #define PERL_PV_PRETTY_LTGT 0x0004 6081 6082 #define PERL_PV_ESCAPE_FIRSTCHAR 0x0008 6083 6084 #define PERL_PV_ESCAPE_UNI 0x0100 6085 #define PERL_PV_ESCAPE_UNI_DETECT 0x0200 6086 6087 #define PERL_PV_ESCAPE_ALL 0x1000 6088 #define PERL_PV_ESCAPE_NOBACKSLASH 0x2000 6089 #define PERL_PV_ESCAPE_NOCLEAR 0x4000 6090 #define PERL_PV_ESCAPE_RE 0x8000 6091 6092 #define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR 6093 6094 /* used by pv_display in dump.c*/ 6095 #define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE 6096 #define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE 6097 6098 /* 6099 6100 (KEEP THIS LAST IN perl.h!) 6101 6102 Mention 6103 6104 NV_PRESERVES_UV 6105 6106 HAS_MKSTEMP 6107 HAS_MKSTEMPS 6108 HAS_MKDTEMP 6109 6110 HAS_GETCWD 6111 6112 HAS_MMAP 6113 HAS_MPROTECT 6114 HAS_MSYNC 6115 HAS_MADVISE 6116 HAS_MUNMAP 6117 I_SYSMMAN 6118 Mmap_t 6119 6120 NVef 6121 NVff 6122 NVgf 6123 6124 HAS_UALARM 6125 HAS_USLEEP 6126 6127 HAS_SETITIMER 6128 HAS_GETITIMER 6129 6130 HAS_SENDMSG 6131 HAS_RECVMSG 6132 HAS_READV 6133 HAS_WRITEV 6134 I_SYSUIO 6135 HAS_STRUCT_MSGHDR 6136 HAS_STRUCT_CMSGHDR 6137 6138 HAS_NL_LANGINFO 6139 6140 HAS_DIRFD 6141 6142 so that Configure picks them up. 6143 6144 (KEEP THIS LAST IN perl.h!) 6145 6146 */ 6147 6148 #endif /* Include guard */ 6149 6150 /* 6151 * Local variables: 6152 * c-indentation-style: bsd 6153 * c-basic-offset: 4 6154 * indent-tabs-mode: t 6155 * End: 6156 * 6157 * ex: set ts=8 sts=4 sw=4 noet: 6158 */ 6159