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