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