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