1 /* perl.h 2 * 3 * Copyright (c) 1987-2001, Larry Wall 4 * 5 * You may distribute under the terms of either the GNU General Public 6 * License or the Artistic License, as specified in the README file. 7 * 8 */ 9 #ifndef H_PERL 10 #define H_PERL 1 11 12 #ifdef PERL_FOR_X2P 13 /* 14 * This file is being used for x2p stuff. 15 * Above symbol is defined via -D in 'x2p/Makefile.SH' 16 * Decouple x2p stuff from some of perls more extreme eccentricities. 17 */ 18 #undef MULTIPLICITY 19 #undef USE_STDIO 20 #define USE_STDIO 21 #endif /* PERL_FOR_X2P */ 22 23 #define VOIDUSED 1 24 #include "config.h" 25 26 #if defined(USE_ITHREADS) && defined(USE_5005THREADS) 27 # include "error: USE_ITHREADS and USE_5005THREADS are incompatible" 28 #endif 29 30 /* XXX This next guard can disappear if the sources are revised 31 to use USE_5005THREADS throughout. -- A.D 1/6/2000 32 */ 33 #if defined(USE_ITHREADS) && defined(USE_THREADS) 34 # include "error: USE_ITHREADS and USE_THREADS are incompatible" 35 #endif 36 37 /* See L<perlguts/"The Perl API"> for detailed notes on 38 * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ 39 40 #ifdef USE_ITHREADS 41 # if !defined(MULTIPLICITY) && !defined(PERL_OBJECT) 42 # define MULTIPLICITY 43 # endif 44 #endif 45 46 #ifdef USE_THREADS 47 # ifndef PERL_IMPLICIT_CONTEXT 48 # define PERL_IMPLICIT_CONTEXT 49 # endif 50 #endif 51 52 #if defined(MULTIPLICITY) 53 # ifndef PERL_IMPLICIT_CONTEXT 54 # define PERL_IMPLICIT_CONTEXT 55 # endif 56 #endif 57 58 #ifdef PERL_CAPI 59 # undef PERL_OBJECT 60 # ifndef MULTIPLICITY 61 # define MULTIPLICITY 62 # endif 63 # ifndef PERL_IMPLICIT_CONTEXT 64 # define PERL_IMPLICIT_CONTEXT 65 # endif 66 # ifndef PERL_IMPLICIT_SYS 67 # define PERL_IMPLICIT_SYS 68 # endif 69 #endif 70 71 #ifdef PERL_OBJECT 72 # ifndef PERL_IMPLICIT_CONTEXT 73 # define PERL_IMPLICIT_CONTEXT 74 # endif 75 # ifndef PERL_IMPLICIT_SYS 76 # define PERL_IMPLICIT_SYS 77 # endif 78 #endif 79 80 #ifdef PERL_OBJECT 81 82 /* PERL_OBJECT explained - DickH and DougL @ ActiveState.com 83 84 Defining PERL_OBJECT turns on creation of a C++ object that 85 contains all writable core perl global variables and functions. 86 Stated another way, all necessary global variables and functions 87 are members of a big C++ object. This object's class is CPerlObj. 88 This allows a Perl Host to have multiple, independent perl 89 interpreters in the same process space. This is very important on 90 Win32 systems as the overhead of process creation is quite high -- 91 this could be even higher than the script compile and execute time 92 for small scripts. 93 94 The perl executable implementation on Win32 is composed of perl.exe 95 (the Perl Host) and perlX.dll. (the Perl Core). This allows the 96 same Perl Core to easily be embedded in other applications that use 97 the perl interpreter. 98 99 +-----------+ 100 | Perl Host | 101 +-----------+ 102 ^ 103 | 104 v 105 +-----------+ +-----------+ 106 | Perl Core |<->| Extension | 107 +-----------+ +-----------+ ... 108 109 Defining PERL_OBJECT has the following effects: 110 111 PERL CORE 112 1. CPerlObj is defined (this is the PERL_OBJECT) 113 2. all static functions that needed to access either global 114 variables or functions needed are made member functions 115 3. all writable static variables are made member variables 116 4. all global variables and functions are defined as: 117 #define var CPerlObj::PL_var 118 #define func CPerlObj::Perl_func 119 * these are in embed.h 120 This necessitated renaming some local variables and functions that 121 had the same name as a global variable or function. This was 122 probably a _good_ thing anyway. 123 124 125 EXTENSIONS 126 1. Access to global variables and perl functions is through a 127 pointer to the PERL_OBJECT. This pointer type is CPerlObj*. This is 128 made transparent to extension developers by the following macros: 129 #define var pPerl->PL_var 130 #define func pPerl->Perl_func 131 * these are done in objXSUB.h 132 This requires that the extension be compiled as C++, which means 133 that the code must be ANSI C and not K&R C. For K&R extensions, 134 please see the C API notes located in Win32/GenCAPI.pl. This script 135 creates a perlCAPI.lib that provides a K & R compatible C interface 136 to the PERL_OBJECT. 137 2. Local variables and functions cannot have the same name as perl's 138 variables or functions since the macros will redefine these. Look for 139 this if you get some strange error message and it does not look like 140 the code that you had written. This often happens with variables that 141 are local to a function. 142 143 PERL HOST 144 1. The perl host is linked with perlX.lib to get perl_alloc. This 145 function will return a pointer to CPerlObj (the PERL_OBJECT). It 146 takes pointers to the various PerlXXX_YYY interfaces (see iperlsys.h 147 for more information on this). 148 2. The perl host calls the same functions as normally would be 149 called in setting up and running a perl script, except that the 150 functions are now member functions of the PERL_OBJECT. 151 152 */ 153 154 155 class CPerlObj; 156 157 #define STATIC 158 #define CPERLscope(x) CPerlObj::x 159 #define CALL_FPTR(fptr) (aTHXo->*fptr) 160 161 #define pTHXo CPerlObj *pPerl 162 #define pTHXo_ pTHXo, 163 #define aTHXo this 164 #define aTHXo_ this, 165 #define PERL_OBJECT_THIS aTHXo 166 #define PERL_OBJECT_THIS_ aTHXo_ 167 #define dTHXoa(a) pTHXo = (CPerlObj*)a 168 #define dTHXo pTHXo = PERL_GET_THX 169 170 #define pTHXx void 171 #define pTHXx_ 172 #define aTHXx 173 #define aTHXx_ 174 175 #else /* !PERL_OBJECT */ 176 177 #ifdef PERL_IMPLICIT_CONTEXT 178 # ifdef USE_THREADS 179 struct perl_thread; 180 # define pTHX register struct perl_thread *thr 181 # define aTHX thr 182 # define dTHR dNOOP /* only backward compatibility */ 183 # define dTHXa(a) pTHX = (struct perl_thread*)a 184 # else 185 # ifndef MULTIPLICITY 186 # define MULTIPLICITY 187 # endif 188 # define pTHX register PerlInterpreter *my_perl 189 # define aTHX my_perl 190 # define dTHXa(a) pTHX = (PerlInterpreter*)a 191 # endif 192 # define dTHX pTHX = PERL_GET_THX 193 # define pTHX_ pTHX, 194 # define aTHX_ aTHX, 195 # define pTHX_1 2 196 # define pTHX_2 3 197 # define pTHX_3 4 198 # define pTHX_4 5 199 #endif 200 201 #define STATIC static 202 #define CPERLscope(x) x 203 #define CPERLarg void 204 #define CPERLarg_ 205 #define _CPERLarg 206 #define PERL_OBJECT_THIS 207 #define _PERL_OBJECT_THIS 208 #define PERL_OBJECT_THIS_ 209 #define CALL_FPTR(fptr) (*fptr) 210 211 #endif /* PERL_OBJECT */ 212 213 #define CALLRUNOPS CALL_FPTR(PL_runops) 214 #define CALLREGCOMP CALL_FPTR(PL_regcompp) 215 #define CALLREGEXEC CALL_FPTR(PL_regexecp) 216 #define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start) 217 #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string) 218 #define CALLREGFREE CALL_FPTR(PL_regfree) 219 220 #ifdef PERL_FLEXIBLE_EXCEPTIONS 221 # define CALLPROTECT CALL_FPTR(PL_protect) 222 #endif 223 224 #define NOOP (void)0 225 #define dNOOP extern int Perl___notused 226 227 #ifndef pTHX 228 # define pTHX void 229 # define pTHX_ 230 # define aTHX 231 # define aTHX_ 232 # define dTHXa(a) dNOOP 233 # define dTHX dNOOP 234 # define pTHX_1 1 235 # define pTHX_2 2 236 # define pTHX_3 3 237 # define pTHX_4 4 238 #endif 239 240 #ifndef pTHXo 241 # define pTHXo pTHX 242 # define pTHXo_ pTHX_ 243 # define aTHXo aTHX 244 # define aTHXo_ aTHX_ 245 # define dTHXo dTHX 246 # define dTHXoa(x) dTHXa(x) 247 #endif 248 249 #ifndef pTHXx 250 # define pTHXx register PerlInterpreter *my_perl 251 # define pTHXx_ pTHXx, 252 # define aTHXx my_perl 253 # define aTHXx_ aTHXx, 254 # define dTHXx dTHX 255 #endif 256 257 #undef START_EXTERN_C 258 #undef END_EXTERN_C 259 #undef EXTERN_C 260 #ifdef __cplusplus 261 # define START_EXTERN_C extern "C" { 262 # define END_EXTERN_C } 263 # define EXTERN_C extern "C" 264 #else 265 # define START_EXTERN_C 266 # define END_EXTERN_C 267 # define EXTERN_C extern 268 #endif 269 270 #ifdef OP_IN_REGISTER 271 # ifdef __GNUC__ 272 # define stringify_immed(s) #s 273 # define stringify(s) stringify_immed(s) 274 register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); 275 # endif 276 #endif 277 278 /* 279 * STMT_START { statements; } STMT_END; 280 * can be used as a single statement, as in 281 * if (x) STMT_START { ... } STMT_END; else ... 282 * 283 * Trying to select a version that gives no warnings... 284 */ 285 #if !(defined(STMT_START) && defined(STMT_END)) 286 # if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(__cplusplus) 287 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ 288 # define STMT_END ) 289 # else 290 /* Now which other defined()s do we need here ??? */ 291 # if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) 292 # define STMT_START if (1) 293 # define STMT_END else (void)0 294 # else 295 # define STMT_START do 296 # define STMT_END while (0) 297 # endif 298 # endif 299 #endif 300 301 #define WITH_THX(s) STMT_START { dTHX; s; } STMT_END 302 #define WITH_THR(s) WITH_THX(s) 303 304 /* 305 * SOFT_CAST can be used for args to prototyped functions to retain some 306 * type checking; it only casts if the compiler does not know prototypes. 307 */ 308 #if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE) 309 #define SOFT_CAST(type) 310 #else 311 #define SOFT_CAST(type) (type) 312 #endif 313 314 #ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */ 315 # define BYTEORDER 0x1234 316 #endif 317 318 /* Overall memory policy? */ 319 #ifndef CONSERVATIVE 320 # define LIBERAL 1 321 #endif 322 323 #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90 324 #define ASCIIish 325 #else 326 #undef ASCIIish 327 #endif 328 329 /* 330 * The following contortions are brought to you on behalf of all the 331 * standards, semi-standards, de facto standards, not-so-de-facto standards 332 * of the world, as well as all the other botches anyone ever thought of. 333 * The basic theory is that if we work hard enough here, the rest of the 334 * code can be a lot prettier. Well, so much for theory. Sorry, Henry... 335 */ 336 337 /* define this once if either system, instead of cluttering up the src */ 338 #if defined(MSDOS) || defined(atarist) || defined(WIN32) 339 #define DOSISH 1 340 #endif 341 342 #if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) 343 # define STANDARD_C 1 344 #endif 345 346 #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) 347 # define DONT_DECLARE_STD 1 348 #endif 349 350 #if defined(HASVOLATILE) || defined(STANDARD_C) 351 # ifdef __cplusplus 352 # define VOL // to temporarily suppress warnings 353 # else 354 # define VOL volatile 355 # endif 356 #else 357 # define VOL 358 #endif 359 360 #define TAINT (PL_tainted = TRUE) 361 #define TAINT_NOT (PL_tainted = FALSE) 362 #define TAINT_IF(c) if (c) { PL_tainted = TRUE; } 363 #define TAINT_ENV() if (PL_tainting) { taint_env(); } 364 #define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); } 365 366 /* XXX All process group stuff is handled in pp_sys.c. Should these 367 defines move there? If so, I could simplify this a lot. --AD 9/96. 368 */ 369 /* Process group stuff changed from traditional BSD to POSIX. 370 perlfunc.pod documents the traditional BSD-style syntax, so we'll 371 try to preserve that, if possible. 372 */ 373 #ifdef HAS_SETPGID 374 # define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) 375 #else 376 # if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP) 377 # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 378 # else 379 # ifdef HAS_SETPGRP2 /* DG/UX */ 380 # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 381 # endif 382 # endif 383 #endif 384 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP) 385 # define HAS_SETPGRP /* Well, effectively it does . . . */ 386 #endif 387 388 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes 389 our life easier :-) so we'll try it. 390 */ 391 #ifdef HAS_GETPGID 392 # define BSD_GETPGRP(pid) getpgid((pid)) 393 #else 394 # if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP) 395 # define BSD_GETPGRP(pid) getpgrp((pid)) 396 # else 397 # ifdef HAS_GETPGRP2 /* DG/UX */ 398 # define BSD_GETPGRP(pid) getpgrp2((pid)) 399 # endif 400 # endif 401 #endif 402 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP) 403 # define HAS_GETPGRP /* Well, effectively it does . . . */ 404 #endif 405 406 /* These are not exact synonyms, since setpgrp() and getpgrp() may 407 have different behaviors, but perl.h used to define USE_BSDPGRP 408 (prior to 5.003_05) so some extension might depend on it. 409 */ 410 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP) 411 # ifndef USE_BSDPGRP 412 # define USE_BSDPGRP 413 # endif 414 #endif 415 416 /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that 417 pthread.h must be included before all other header files. 418 */ 419 #if (defined(USE_THREADS) || defined(USE_ITHREADS)) \ 420 && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) 421 # include <pthread.h> 422 #endif 423 424 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 425 # ifndef major /* Does everyone's types.h define this? */ 426 # include <sys/types.h> 427 # endif 428 #endif 429 430 #ifdef __cplusplus 431 # ifndef I_STDARG 432 # define I_STDARG 1 433 # endif 434 #endif 435 436 #ifdef I_STDARG 437 # include <stdarg.h> 438 #else 439 # ifdef I_VARARGS 440 # include <varargs.h> 441 # endif 442 #endif 443 444 #ifdef USE_NEXT_CTYPE 445 446 #if NX_CURRENT_COMPILER_RELEASE >= 500 447 # include <bsd/ctypes.h> 448 #else 449 # if NX_CURRENT_COMPILER_RELEASE >= 400 450 # include <objc/NXCType.h> 451 # else /* NX_CURRENT_COMPILER_RELEASE < 400 */ 452 # include <appkit/NXCType.h> 453 # endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */ 454 #endif /* NX_CURRENT_COMPILER_RELEASE >= 500 */ 455 456 #else /* !USE_NEXT_CTYPE */ 457 #include <ctype.h> 458 #endif /* USE_NEXT_CTYPE */ 459 460 #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ 461 #undef METHOD 462 #endif 463 464 #ifdef I_LOCALE 465 # include <locale.h> 466 #endif 467 468 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE) 469 # define USE_LOCALE 470 # if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ 471 && defined(HAS_STRXFRM) 472 # define USE_LOCALE_COLLATE 473 # endif 474 # if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE) 475 # define USE_LOCALE_CTYPE 476 # endif 477 # if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC) 478 # define USE_LOCALE_NUMERIC 479 # endif 480 #endif /* !NO_LOCALE && HAS_SETLOCALE */ 481 482 #include <setjmp.h> 483 484 #ifdef I_SYS_PARAM 485 # ifdef PARAM_NEEDS_TYPES 486 # include <sys/types.h> 487 # endif 488 # include <sys/param.h> 489 #endif 490 491 /* Use all the "standard" definitions? */ 492 #if defined(STANDARD_C) && defined(I_STDLIB) 493 # include <stdlib.h> 494 #endif 495 496 /* If this causes problems, set i_unistd=undef in the hint file. */ 497 #ifdef I_UNISTD 498 # include <unistd.h> 499 #endif 500 501 #ifdef PERL_MICRO /* Last chance to export Perl_my_swap */ 502 # define MYSWAP 503 #endif 504 505 #if !defined(PERL_FOR_X2P) && !defined(WIN32) 506 # include "embed.h" 507 #endif 508 509 #define MEM_SIZE Size_t 510 511 #if defined(STANDARD_C) && defined(I_STDDEF) 512 # include <stddef.h> 513 # define STRUCT_OFFSET(s,m) offsetof(s,m) 514 #else 515 # define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) 516 #endif 517 518 #if defined(I_STRING) || defined(__cplusplus) 519 # include <string.h> 520 #else 521 # include <strings.h> 522 #endif 523 524 /* This comes after <stdlib.h> so we don't try to change the standard 525 * library prototypes; we'll use our own in proto.h instead. */ 526 527 #ifdef MYMALLOC 528 # ifdef PERL_POLLUTE_MALLOC 529 # ifndef PERL_EXTMALLOC_DEF 530 # define Perl_malloc malloc 531 # define Perl_calloc calloc 532 # define Perl_realloc realloc 533 # define Perl_mfree free 534 # endif 535 # else 536 # define EMBEDMYMALLOC /* for compatibility */ 537 # endif 538 Malloc_t Perl_malloc (MEM_SIZE nbytes); 539 Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size); 540 Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes); 541 /* 'mfree' rather than 'free', since there is already a 'perl_free' 542 * that causes clashes with case-insensitive linkers */ 543 Free_t Perl_mfree (Malloc_t where); 544 545 typedef struct perl_mstats perl_mstats_t; 546 547 # define safemalloc Perl_malloc 548 # define safecalloc Perl_calloc 549 # define saferealloc Perl_realloc 550 # define safefree Perl_mfree 551 #else /* MYMALLOC */ 552 # define safemalloc safesysmalloc 553 # define safecalloc safesyscalloc 554 # define saferealloc safesysrealloc 555 # define safefree safesysfree 556 #endif /* MYMALLOC */ 557 558 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr) 559 #define strchr index 560 #define strrchr rindex 561 #endif 562 563 #ifdef I_MEMORY 564 # include <memory.h> 565 #endif 566 567 #ifdef HAS_MEMCPY 568 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 569 # ifndef memcpy 570 extern char * memcpy (char*, char*, int); 571 # endif 572 # endif 573 #else 574 # ifndef memcpy 575 # ifdef HAS_BCOPY 576 # define memcpy(d,s,l) bcopy(s,d,l) 577 # else 578 # define memcpy(d,s,l) my_bcopy(s,d,l) 579 # endif 580 # endif 581 #endif /* HAS_MEMCPY */ 582 583 #ifdef HAS_MEMSET 584 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 585 # ifndef memset 586 extern char *memset (char*, int, int); 587 # endif 588 # endif 589 #else 590 # define memset(d,c,l) my_memset(d,c,l) 591 #endif /* HAS_MEMSET */ 592 593 #if !defined(HAS_MEMMOVE) && !defined(memmove) 594 # if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY) 595 # define memmove(d,s,l) bcopy(s,d,l) 596 # else 597 # if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY) 598 # define memmove(d,s,l) memcpy(d,s,l) 599 # else 600 # define memmove(d,s,l) my_bcopy(s,d,l) 601 # endif 602 # endif 603 #endif 604 605 #if defined(mips) && defined(ultrix) && !defined(__STDC__) 606 # undef HAS_MEMCMP 607 #endif 608 609 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP) 610 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 611 # ifndef memcmp 612 extern int memcmp (char*, char*, int); 613 # endif 614 # endif 615 # ifdef BUGGY_MSC 616 # pragma function(memcmp) 617 # endif 618 #else 619 # ifndef memcmp 620 # define memcmp my_memcmp 621 # endif 622 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */ 623 624 #ifndef memzero 625 # ifdef HAS_MEMSET 626 # define memzero(d,l) memset(d,0,l) 627 # else 628 # ifdef HAS_BZERO 629 # define memzero(d,l) bzero(d,l) 630 # else 631 # define memzero(d,l) my_bzero(d,l) 632 # endif 633 # endif 634 #endif 635 636 #ifndef memchr 637 # ifndef HAS_MEMCHR 638 # define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1) 639 # endif 640 #endif 641 642 #ifndef HAS_BCMP 643 # ifndef bcmp 644 # define bcmp(s1,s2,l) memcmp(s1,s2,l) 645 # endif 646 #endif /* !HAS_BCMP */ 647 648 #ifdef I_NETINET_IN 649 # include <netinet/in.h> 650 #endif 651 652 #ifdef I_ARPA_INET 653 # include <arpa/inet.h> 654 #endif 655 656 #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO) 657 /* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND 658 * (the neo-BSD seem to do this). */ 659 # undef SF_APPEND 660 #endif 661 662 #ifdef I_SYS_STAT 663 # include <sys/stat.h> 664 #endif 665 666 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives 667 like UTekV) are broken, sometimes giving false positives. Undefine 668 them here and let the code below set them to proper values. 669 670 The ghs macro stands for GreenHills Software C-1.8.5 which 671 is the C compiler for sysV88 and the various derivatives. 672 This header file bug is corrected in gcc-2.5.8 and later versions. 673 --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94. */ 674 675 #if defined(uts) || (defined(m88k) && defined(ghs)) 676 # undef S_ISDIR 677 # undef S_ISCHR 678 # undef S_ISBLK 679 # undef S_ISREG 680 # undef S_ISFIFO 681 # undef S_ISLNK 682 #endif 683 684 #ifdef I_TIME 685 # include <time.h> 686 #endif 687 688 #ifdef I_SYS_TIME 689 # ifdef I_SYS_TIME_KERNEL 690 # define KERNEL 691 # endif 692 # include <sys/time.h> 693 # ifdef I_SYS_TIME_KERNEL 694 # undef KERNEL 695 # endif 696 #endif 697 698 #if defined(HAS_TIMES) && defined(I_SYS_TIMES) 699 # include <sys/times.h> 700 #endif 701 702 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR)) 703 # undef HAS_STRERROR 704 #endif 705 706 #include <errno.h> 707 708 #if defined(WIN32) && (defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI)) 709 # define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ 710 #endif 711 712 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */ 713 # include <sys/socket.h> 714 # if defined(USE_SOCKS) && defined(I_SOCKS) 715 # if !defined(INCLUDE_PROTOTYPES) 716 # define INCLUDE_PROTOTYPES /* for <socks.h> */ 717 # define PERL_SOCKS_NEED_PROTOTYPES 718 # endif 719 # ifdef USE_THREADS 720 # define PERL_USE_THREADS /* store our value */ 721 # undef USE_THREADS 722 # endif 723 # include <socks.h> 724 # ifdef USE_THREADS 725 # undef USE_THREADS /* socks.h does this on its own */ 726 # endif 727 # ifdef PERL_USE_THREADS 728 # define USE_THREADS /* restore our value */ 729 # undef PERL_USE_THREADS 730 # endif 731 # ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */ 732 # undef INCLUDE_PROTOTYPES 733 # undef PERL_SOCKS_NEED_PROTOTYPES 734 # endif 735 # ifdef USE_64_BIT_ALL 736 # define SOCKS_64BIT_BUG /* until proven otherwise */ 737 # endif 738 # endif 739 # ifdef I_NETDB 740 # include <netdb.h> 741 # endif 742 # ifndef ENOTSOCK 743 # ifdef I_NET_ERRNO 744 # include <net/errno.h> 745 # endif 746 # endif 747 #endif 748 749 #ifdef SETERRNO 750 # undef SETERRNO /* SOCKS might have defined this */ 751 #endif 752 753 #ifdef VMS 754 # define SETERRNO(errcode,vmserrcode) \ 755 STMT_START { \ 756 set_errno(errcode); \ 757 set_vaxc_errno(vmserrcode); \ 758 } STMT_END 759 #else 760 # define SETERRNO(errcode,vmserrcode) (errno = (errcode)) 761 #endif 762 763 #ifdef USE_THREADS 764 # define ERRSV (thr->errsv) 765 # define DEFSV THREADSV(0) 766 # define SAVE_DEFSV save_threadsv(0) 767 #else 768 # define ERRSV GvSV(PL_errgv) 769 # define DEFSV GvSV(PL_defgv) 770 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 771 #endif /* USE_THREADS */ 772 773 #define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ 774 775 #ifndef errno 776 extern int errno; /* ANSI allows errno to be an lvalue expr. 777 * For example in multithreaded environments 778 * something like this might happen: 779 * extern int *_errno(void); 780 * #define errno (*_errno()) */ 781 #endif 782 783 #ifdef HAS_STRERROR 784 # ifdef VMS 785 char *strerror (int,...); 786 # else 787 #ifndef DONT_DECLARE_STD 788 char *strerror (int); 789 #endif 790 # endif 791 # ifndef Strerror 792 # define Strerror strerror 793 # endif 794 #else 795 # ifdef HAS_SYS_ERRLIST 796 extern int sys_nerr; 797 extern char *sys_errlist[]; 798 # ifndef Strerror 799 # define Strerror(e) \ 800 ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e]) 801 # endif 802 # endif 803 #endif 804 805 #ifdef I_SYS_IOCTL 806 # ifndef _IOCTL_ 807 # include <sys/ioctl.h> 808 # endif 809 #endif 810 811 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000) 812 # ifdef HAS_SOCKETPAIR 813 # undef HAS_SOCKETPAIR 814 # endif 815 # ifdef I_NDBM 816 # undef I_NDBM 817 # endif 818 #endif 819 820 #if INTSIZE == 2 821 # define htoni htons 822 # define ntohi ntohs 823 #else 824 # define htoni htonl 825 # define ntohi ntohl 826 #endif 827 828 /* Configure already sets Direntry_t */ 829 #if defined(I_DIRENT) 830 # include <dirent.h> 831 /* NeXT needs dirent + sys/dir.h */ 832 # if defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__)) 833 # include <sys/dir.h> 834 # endif 835 #else 836 # ifdef I_SYS_NDIR 837 # include <sys/ndir.h> 838 # else 839 # ifdef I_SYS_DIR 840 # ifdef hp9000s500 841 # include <ndir.h> /* may be wrong in the future */ 842 # else 843 # include <sys/dir.h> 844 # endif 845 # endif 846 # endif 847 #endif 848 849 #ifdef FPUTS_BOTCH 850 /* work around botch in SunOS 4.0.1 and 4.0.2 */ 851 # ifndef fputs 852 # define fputs(sv,fp) fprintf(fp,"%s",sv) 853 # endif 854 #endif 855 856 /* 857 * The following gobbledygook brought to you on behalf of __STDC__. 858 * (I could just use #ifndef __STDC__, but this is more bulletproof 859 * in the face of half-implementations.) 860 */ 861 862 #ifdef I_SYSMODE 863 #include <sys/mode.h> 864 #endif 865 866 #ifndef S_IFMT 867 # ifdef _S_IFMT 868 # define S_IFMT _S_IFMT 869 # else 870 # define S_IFMT 0170000 871 # endif 872 #endif 873 874 #ifndef S_ISDIR 875 # define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR) 876 #endif 877 878 #ifndef S_ISCHR 879 # define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR) 880 #endif 881 882 #ifndef S_ISBLK 883 # ifdef S_IFBLK 884 # define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK) 885 # else 886 # define S_ISBLK(m) (0) 887 # endif 888 #endif 889 890 #ifndef S_ISREG 891 # define S_ISREG(m) ((m & S_IFMT) == S_IFREG) 892 #endif 893 894 #ifndef S_ISFIFO 895 # ifdef S_IFIFO 896 # define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO) 897 # else 898 # define S_ISFIFO(m) (0) 899 # endif 900 #endif 901 902 #ifndef S_ISLNK 903 # ifdef _S_ISLNK 904 # define S_ISLNK(m) _S_ISLNK(m) 905 # else 906 # ifdef _S_IFLNK 907 # define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK) 908 # else 909 # ifdef S_IFLNK 910 # define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK) 911 # else 912 # define S_ISLNK(m) (0) 913 # endif 914 # endif 915 # endif 916 #endif 917 918 #ifndef S_ISSOCK 919 # ifdef _S_ISSOCK 920 # define S_ISSOCK(m) _S_ISSOCK(m) 921 # else 922 # ifdef _S_IFSOCK 923 # define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK) 924 # else 925 # ifdef S_IFSOCK 926 # define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK) 927 # else 928 # define S_ISSOCK(m) (0) 929 # endif 930 # endif 931 # endif 932 #endif 933 934 #ifndef S_IRUSR 935 # ifdef S_IREAD 936 # define S_IRUSR S_IREAD 937 # define S_IWUSR S_IWRITE 938 # define S_IXUSR S_IEXEC 939 # else 940 # define S_IRUSR 0400 941 # define S_IWUSR 0200 942 # define S_IXUSR 0100 943 # endif 944 #endif 945 946 #ifndef S_IRGRP 947 # ifdef S_IRUSR 948 # define S_IRGRP (S_IRUSR>>3) 949 # define S_IWGRP (S_IWUSR>>3) 950 # define S_IXGRP (S_IXUSR>>3) 951 # else 952 # define S_IRGRP 0040 953 # define S_IWGRP 0020 954 # define S_IXGRP 0010 955 # endif 956 #endif 957 958 #ifndef S_IROTH 959 # ifdef S_IRUSR 960 # define S_IROTH (S_IRUSR>>6) 961 # define S_IWOTH (S_IWUSR>>6) 962 # define S_IXOTH (S_IXUSR>>6) 963 # else 964 # define S_IROTH 0040 965 # define S_IWOTH 0020 966 # define S_IXOTH 0010 967 # endif 968 #endif 969 970 #ifndef S_ISUID 971 # define S_ISUID 04000 972 #endif 973 974 #ifndef S_ISGID 975 # define S_ISGID 02000 976 #endif 977 978 #ifndef S_IRWXU 979 # define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) 980 #endif 981 982 #ifndef S_IRWXG 983 # define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) 984 #endif 985 986 #ifndef S_IRWXO 987 # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) 988 #endif 989 990 #ifndef S_IREAD 991 # define S_IREAD S_IRUSR 992 #endif 993 994 #ifndef S_IWRITE 995 # define S_IWRITE S_IWUSR 996 #endif 997 998 #ifndef S_IEXEC 999 # define S_IEXEC S_IXUSR 1000 #endif 1001 1002 #ifdef ff_next 1003 # undef ff_next 1004 #endif 1005 1006 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr) 1007 # define SLOPPYDIVIDE 1008 #endif 1009 1010 #ifdef UV 1011 #undef UV 1012 #endif 1013 1014 /* 1015 The IV type is supposed to be long enough to hold any integral 1016 value or a pointer. 1017 --Andy Dougherty August 1996 1018 */ 1019 1020 typedef IVTYPE IV; 1021 typedef UVTYPE UV; 1022 1023 #if defined(USE_64_BIT_INT) && defined(HAS_QUAD) 1024 # if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX) 1025 # define IV_MAX INT64_MAX 1026 # define IV_MIN INT64_MIN 1027 # define UV_MAX UINT64_MAX 1028 # ifndef UINT64_MIN 1029 # define UINT64_MIN 0 1030 # endif 1031 # define UV_MIN UINT64_MIN 1032 # else 1033 # define IV_MAX PERL_QUAD_MAX 1034 # define IV_MIN PERL_QUAD_MIN 1035 # define UV_MAX PERL_UQUAD_MAX 1036 # define UV_MIN PERL_UQUAD_MIN 1037 # endif 1038 # define IV_IS_QUAD 1039 # define UV_IS_QUAD 1040 #else 1041 # if defined(INT32_MAX) && IVSIZE == 4 1042 # define IV_MAX INT32_MAX 1043 # define IV_MIN INT32_MIN 1044 # ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ 1045 # define UV_MAX UINT32_MAX 1046 # else 1047 # define UV_MAX 4294967295U 1048 # endif 1049 # ifndef UINT32_MIN 1050 # define UINT32_MIN 0 1051 # endif 1052 # define UV_MIN UINT32_MIN 1053 # else 1054 # define IV_MAX PERL_LONG_MAX 1055 # define IV_MIN PERL_LONG_MIN 1056 # define UV_MAX PERL_ULONG_MAX 1057 # define UV_MIN PERL_ULONG_MIN 1058 # endif 1059 # if IVSIZE == 8 1060 # define IV_IS_QUAD 1061 # define UV_IS_QUAD 1062 # ifndef HAS_QUAD 1063 # define HAS_QUAD 1064 # endif 1065 # else 1066 # undef IV_IS_QUAD 1067 # undef UV_IS_QUAD 1068 # undef HAS_QUAD 1069 # endif 1070 #endif 1071 1072 #define IV_DIG (BIT_DIGITS(IVSIZE * 8)) 1073 #define UV_DIG (BIT_DIGITS(UVSIZE * 8)) 1074 1075 /* 1076 * The macros INT2PTR and NUM2PTR are (despite their names) 1077 * bi-directional: they will convert int/float to or from pointers. 1078 * However the conversion to int/float are named explicitly: 1079 * PTR2IV, PTR2UV, PTR2NV. 1080 * 1081 * For int conversions we do not need two casts if pointers are 1082 * the same size as IV and UV. Otherwise we need an explicit 1083 * cast (PTRV) to avoid compiler warnings. 1084 */ 1085 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) 1086 # define PTRV UV 1087 # define INT2PTR(any,d) (any)(d) 1088 #else 1089 # if PTRSIZE == LONGSIZE 1090 # define PTRV unsigned long 1091 # else 1092 # define PTRV unsigned 1093 # endif 1094 # define INT2PTR(any,d) (any)(PTRV)(d) 1095 #endif 1096 #define NUM2PTR(any,d) (any)(PTRV)(d) 1097 #define PTR2IV(p) INT2PTR(IV,p) 1098 #define PTR2UV(p) INT2PTR(UV,p) 1099 #define PTR2NV(p) NUM2PTR(NV,p) 1100 #if PTRSIZE == LONGSIZE 1101 # define PTR2ul(p) (unsigned long)(p) 1102 #else 1103 # define PTR2ul(p) INT2PTR(unsigned long,p) 1104 #endif 1105 1106 #ifdef USE_LONG_DOUBLE 1107 # if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE 1108 # define LONG_DOUBLE_EQUALS_DOUBLE 1109 # endif 1110 # if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)) 1111 # undef USE_LONG_DOUBLE /* Ouch! */ 1112 # endif 1113 #endif 1114 1115 #ifdef OVR_DBL_DIG 1116 /* Use an overridden DBL_DIG */ 1117 # ifdef DBL_DIG 1118 # undef DBL_DIG 1119 # endif 1120 # define DBL_DIG OVR_DBL_DIG 1121 #else 1122 /* The following is all to get DBL_DIG, in order to pick a nice 1123 default value for printing floating point numbers in Gconvert. 1124 (see config.h) 1125 */ 1126 #ifdef I_LIMITS 1127 #include <limits.h> 1128 #endif 1129 #ifdef I_FLOAT 1130 #include <float.h> 1131 #endif 1132 #ifndef HAS_DBL_DIG 1133 #define DBL_DIG 15 /* A guess that works lots of places */ 1134 #endif 1135 #endif 1136 #ifdef I_FLOAT 1137 #include <float.h> 1138 #endif 1139 #ifndef HAS_DBL_DIG 1140 #define DBL_DIG 15 /* A guess that works lots of places */ 1141 #endif 1142 1143 #ifdef OVR_LDBL_DIG 1144 /* Use an overridden LDBL_DIG */ 1145 # ifdef LDBL_DIG 1146 # undef LDBL_DIG 1147 # endif 1148 # define LDBL_DIG OVR_LDBL_DIG 1149 #else 1150 /* The following is all to get LDBL_DIG, in order to pick a nice 1151 default value for printing floating point numbers in Gconvert. 1152 (see config.h) 1153 */ 1154 # ifdef I_LIMITS 1155 # include <limits.h> 1156 # endif 1157 # ifdef I_FLOAT 1158 # include <float.h> 1159 # endif 1160 # ifndef HAS_LDBL_DIG 1161 # if LONG_DOUBLESIZE == 10 1162 # define LDBL_DIG 18 /* assume IEEE */ 1163 # else 1164 # if LONG_DOUBLESIZE == 12 1165 # define LDBL_DIG 18 /* gcc? */ 1166 # else 1167 # if LONG_DOUBLESIZE == 16 1168 # define LDBL_DIG 33 /* assume IEEE */ 1169 # else 1170 # if LONG_DOUBLESIZE == DOUBLESIZE 1171 # define LDBL_DIG DBL_DIG /* bummer */ 1172 # endif 1173 # endif 1174 # endif 1175 # endif 1176 # endif 1177 #endif 1178 1179 typedef NVTYPE NV; 1180 1181 #ifdef I_IEEEFP 1182 # include <ieeefp.h> 1183 #endif 1184 1185 #ifdef USE_LONG_DOUBLE 1186 # ifdef I_SUNMATH 1187 # include <sunmath.h> 1188 # endif 1189 # define NV_DIG LDBL_DIG 1190 # ifdef LDBL_MANT_DIG 1191 # define NV_MANT_DIG LDBL_MANT_DIG 1192 # endif 1193 # ifdef LDBL_MAX 1194 # define NV_MAX LDBL_MAX 1195 # define NV_MIN LDBL_MIN 1196 # else 1197 # ifdef HUGE_VALL 1198 # define NV_MAX HUGE_VALL 1199 # else 1200 # ifdef HUGE_VAL 1201 # define NV_MAX ((NV)HUGE_VAL) 1202 # endif 1203 # endif 1204 # endif 1205 # ifdef HAS_SQRTL 1206 # define Perl_cos cosl 1207 # define Perl_sin sinl 1208 # define Perl_sqrt sqrtl 1209 # define Perl_exp expl 1210 # define Perl_log logl 1211 # define Perl_atan2 atan2l 1212 # define Perl_pow powl 1213 # define Perl_floor floorl 1214 # define Perl_fmod fmodl 1215 # endif 1216 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */ 1217 # ifdef HAS_MODFL 1218 # define Perl_modf(x,y) modfl(x,y) 1219 # else 1220 # define Perl_modf(x,y) ((long double)modf((double)(x),(double*)(y))) 1221 # endif 1222 # ifdef HAS_FREXPL 1223 # define Perl_frexp(x,y) frexpl(x,y) 1224 # else 1225 # define Perl_frexp(x,y) ((long double)frexp((double)(x),y)) 1226 # endif 1227 # ifdef HAS_ISNANL 1228 # define Perl_isnan(x) isnanl(x) 1229 # else 1230 # ifdef HAS_ISNAN 1231 # define Perl_isnan(x) isnan((double)(x)) 1232 # else 1233 # define Perl_isnan(x) ((x)!=(x)) 1234 # endif 1235 # endif 1236 #else 1237 # define NV_DIG DBL_DIG 1238 # ifdef DBL_MANT_DIG 1239 # define NV_MANT_DIG DBL_MANT_DIG 1240 # endif 1241 # ifdef DBL_MAX 1242 # define NV_MAX DBL_MAX 1243 # define NV_MIN DBL_MIN 1244 # else 1245 # ifdef HUGE_VAL 1246 # define NV_MAX HUGE_VAL 1247 # endif 1248 # endif 1249 # define Perl_cos cos 1250 # define Perl_sin sin 1251 # define Perl_sqrt sqrt 1252 # define Perl_exp exp 1253 # define Perl_log log 1254 # define Perl_atan2 atan2 1255 # define Perl_pow pow 1256 # define Perl_floor floor 1257 # define Perl_fmod fmod 1258 # define Perl_modf(x,y) modf(x,y) 1259 # define Perl_frexp(x,y) frexp(x,y) 1260 # ifdef HAS_ISNAN 1261 # define Perl_isnan(x) isnan(x) 1262 # else 1263 # define Perl_isnan(x) ((x)!=(x)) 1264 # endif 1265 #endif 1266 1267 #if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) 1268 # if !defined(Perl_atof) && defined(HAS_STRTOLD) 1269 # define Perl_atof(s) (NV)strtold(s, (char**)NULL) 1270 # endif 1271 # if !defined(Perl_atof) && defined(HAS_ATOLF) 1272 # define Perl_atof (NV)atolf 1273 # endif 1274 # if !defined(Perl_atof) && defined(PERL_SCNfldbl) 1275 # define Perl_atof PERL_SCNfldbl 1276 # define Perl_atof2(s,f) sscanf((s), "%"PERL_SCNfldbl, &(f)) 1277 # endif 1278 #endif 1279 #if !defined(Perl_atof) 1280 # define Perl_atof atof /* we assume atof being available anywhere */ 1281 #endif 1282 #if !defined(Perl_atof2) 1283 # define Perl_atof2(s,f) ((f) = (NV)Perl_atof(s)) 1284 #endif 1285 1286 /* Previously these definitions used hardcoded figures. 1287 * It is hoped these formula are more portable, although 1288 * no data one way or another is presently known to me. 1289 * The "PERL_" names are used because these calculated constants 1290 * do not meet the ANSI requirements for LONG_MAX, etc., which 1291 * need to be constants acceptable to #if - kja 1292 * define PERL_LONG_MAX 2147483647L 1293 * define PERL_LONG_MIN (-LONG_MAX - 1) 1294 * define PERL ULONG_MAX 4294967295L 1295 */ 1296 1297 #ifdef I_LIMITS /* Needed for cast_xxx() functions below. */ 1298 # include <limits.h> 1299 #else 1300 #ifdef I_VALUES 1301 # include <values.h> 1302 #endif 1303 #endif 1304 1305 /* 1306 * Try to figure out max and min values for the integral types. THE CORRECT 1307 * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE. The 1308 * following hacks are used if neither limits.h or values.h provide them: 1309 * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0 1310 * for types < int: (unsigned TYPE)~(unsigned)0 1311 * The argument to ~ must be unsigned so that later signed->unsigned 1312 * conversion can't modify the value's bit pattern (e.g. -0 -> +0), 1313 * and it must not be smaller than int because ~ does integral promotion. 1314 * <type>_MAX: (<type>) (U<type>_MAX >> 1) 1315 * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>. 1316 * The latter is a hack which happens to work on some machines but 1317 * does *not* catch any random system, or things like integer types 1318 * with NaN if that is possible. 1319 * 1320 * All of the types are explicitly cast to prevent accidental loss of 1321 * numeric range, and in the hope that they will be less likely to confuse 1322 * over-eager optimizers. 1323 * 1324 */ 1325 1326 #define PERL_UCHAR_MIN ((unsigned char)0) 1327 1328 #ifdef UCHAR_MAX 1329 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) 1330 #else 1331 # ifdef MAXUCHAR 1332 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) 1333 # else 1334 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) 1335 # endif 1336 #endif 1337 1338 /* 1339 * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be 1340 * ambiguous. It may be equivalent to (signed char) or (unsigned char) 1341 * depending on local options. Until Configure detects this (or at least 1342 * detects whether the "signed" keyword is available) the CHAR ranges 1343 * will not be included. UCHAR functions normally. 1344 * - kja 1345 */ 1346 1347 #define PERL_USHORT_MIN ((unsigned short)0) 1348 1349 #ifdef USHORT_MAX 1350 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) 1351 #else 1352 # ifdef MAXUSHORT 1353 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) 1354 # else 1355 # ifdef USHRT_MAX 1356 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) 1357 # else 1358 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) 1359 # endif 1360 # endif 1361 #endif 1362 1363 #ifdef SHORT_MAX 1364 # define PERL_SHORT_MAX ((short)SHORT_MAX) 1365 #else 1366 # ifdef MAXSHORT /* Often used in <values.h> */ 1367 # define PERL_SHORT_MAX ((short)MAXSHORT) 1368 # else 1369 # ifdef SHRT_MAX 1370 # define PERL_SHORT_MAX ((short)SHRT_MAX) 1371 # else 1372 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) 1373 # endif 1374 # endif 1375 #endif 1376 1377 #ifdef SHORT_MIN 1378 # define PERL_SHORT_MIN ((short)SHORT_MIN) 1379 #else 1380 # ifdef MINSHORT 1381 # define PERL_SHORT_MIN ((short)MINSHORT) 1382 # else 1383 # ifdef SHRT_MIN 1384 # define PERL_SHORT_MIN ((short)SHRT_MIN) 1385 # else 1386 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) 1387 # endif 1388 # endif 1389 #endif 1390 1391 #ifdef UINT_MAX 1392 # define PERL_UINT_MAX ((unsigned int)UINT_MAX) 1393 #else 1394 # ifdef MAXUINT 1395 # define PERL_UINT_MAX ((unsigned int)MAXUINT) 1396 # else 1397 # define PERL_UINT_MAX (~(unsigned int)0) 1398 # endif 1399 #endif 1400 1401 #define PERL_UINT_MIN ((unsigned int)0) 1402 1403 #ifdef INT_MAX 1404 # define PERL_INT_MAX ((int)INT_MAX) 1405 #else 1406 # ifdef MAXINT /* Often used in <values.h> */ 1407 # define PERL_INT_MAX ((int)MAXINT) 1408 # else 1409 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) 1410 # endif 1411 #endif 1412 1413 #ifdef INT_MIN 1414 # define PERL_INT_MIN ((int)INT_MIN) 1415 #else 1416 # ifdef MININT 1417 # define PERL_INT_MIN ((int)MININT) 1418 # else 1419 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) 1420 # endif 1421 #endif 1422 1423 #ifdef ULONG_MAX 1424 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) 1425 #else 1426 # ifdef MAXULONG 1427 # define PERL_ULONG_MAX ((unsigned long)MAXULONG) 1428 # else 1429 # define PERL_ULONG_MAX (~(unsigned long)0) 1430 # endif 1431 #endif 1432 1433 #define PERL_ULONG_MIN ((unsigned long)0L) 1434 1435 #ifdef LONG_MAX 1436 # define PERL_LONG_MAX ((long)LONG_MAX) 1437 #else 1438 # ifdef MAXLONG /* Often used in <values.h> */ 1439 # define PERL_LONG_MAX ((long)MAXLONG) 1440 # else 1441 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) 1442 # endif 1443 #endif 1444 1445 #ifdef LONG_MIN 1446 # define PERL_LONG_MIN ((long)LONG_MIN) 1447 #else 1448 # ifdef MINLONG 1449 # define PERL_LONG_MIN ((long)MINLONG) 1450 # else 1451 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) 1452 # endif 1453 #endif 1454 1455 #ifdef UV_IS_QUAD 1456 1457 # define PERL_UQUAD_MAX (~(UV)0) 1458 # define PERL_UQUAD_MIN ((UV)0) 1459 # define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1)) 1460 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) 1461 1462 #endif 1463 1464 struct perl_mstats { 1465 UV *nfree; 1466 UV *ntotal; 1467 IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain; 1468 IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains; 1469 IV minbucket; 1470 /* Level 1 info */ 1471 UV *bucket_mem_size; 1472 UV *bucket_available_size; 1473 UV nbuckets; 1474 }; 1475 1476 typedef MEM_SIZE STRLEN; 1477 1478 typedef struct op OP; 1479 typedef struct cop COP; 1480 typedef struct unop UNOP; 1481 typedef struct binop BINOP; 1482 typedef struct listop LISTOP; 1483 typedef struct logop LOGOP; 1484 typedef struct pmop PMOP; 1485 typedef struct svop SVOP; 1486 typedef struct padop PADOP; 1487 typedef struct pvop PVOP; 1488 typedef struct loop LOOP; 1489 1490 typedef struct interpreter PerlInterpreter; 1491 #ifdef UTS 1492 # define STRUCT_SV perl_sv /* Amdahl's <ksync.h> has struct sv */ 1493 #else 1494 # define STRUCT_SV sv 1495 #endif 1496 typedef struct STRUCT_SV SV; 1497 typedef struct av AV; 1498 typedef struct hv HV; 1499 typedef struct cv CV; 1500 typedef struct regexp REGEXP; 1501 typedef struct gp GP; 1502 typedef struct gv GV; 1503 typedef struct io IO; 1504 typedef struct context PERL_CONTEXT; 1505 typedef struct block BLOCK; 1506 1507 typedef struct magic MAGIC; 1508 typedef struct xrv XRV; 1509 typedef struct xpv XPV; 1510 typedef struct xpviv XPVIV; 1511 typedef struct xpvuv XPVUV; 1512 typedef struct xpvnv XPVNV; 1513 typedef struct xpvmg XPVMG; 1514 typedef struct xpvlv XPVLV; 1515 typedef struct xpvav XPVAV; 1516 typedef struct xpvhv XPVHV; 1517 typedef struct xpvgv XPVGV; 1518 typedef struct xpvcv XPVCV; 1519 typedef struct xpvbm XPVBM; 1520 typedef struct xpvfm XPVFM; 1521 typedef struct xpvio XPVIO; 1522 typedef struct mgvtbl MGVTBL; 1523 typedef union any ANY; 1524 typedef struct ptr_tbl_ent PTR_TBL_ENT_t; 1525 typedef struct ptr_tbl PTR_TBL_t; 1526 1527 #include "handy.h" 1528 1529 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) 1530 # if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) 1531 # define USE_64_BIT_RAWIO /* implicit */ 1532 # endif 1533 #endif 1534 1535 /* Notice the use of HAS_FSEEKO: now we are obligated to always use 1536 * fseeko/ftello if possible. Don't go #defining ftell to ftello yourself, 1537 * however, because operating systems like to do that themself. */ 1538 #ifndef FSEEKSIZE 1539 # ifdef HAS_FSEEKO 1540 # define FSEEKSIZE LSEEKSIZE 1541 # else 1542 # define FSEEKSIZE LONGSIZE 1543 # endif 1544 #endif 1545 1546 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO) 1547 # if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO) 1548 # define USE_64_BIT_STDIO /* implicit */ 1549 # endif 1550 #endif 1551 1552 #ifdef USE_64_BIT_RAWIO 1553 # ifdef HAS_OFF64_T 1554 # undef Off_t 1555 # define Off_t off64_t 1556 # undef LSEEKSIZE 1557 # define LSEEKSIZE 8 1558 # endif 1559 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that 1560 * will trigger defines like the ones below. Some 64-bit environments, 1561 * however, do not. Therefore we have to explicitly mix and match. */ 1562 # if defined(USE_OPEN64) 1563 # define open open64 1564 # endif 1565 # if defined(USE_LSEEK64) 1566 # define lseek lseek64 1567 # else 1568 # if defined(USE_LLSEEK) 1569 # define lseek llseek 1570 # endif 1571 # endif 1572 # if defined(USE_STAT64) 1573 # define stat stat64 1574 # endif 1575 # if defined(USE_FSTAT64) 1576 # define fstat fstat64 1577 # endif 1578 # if defined(USE_LSTAT64) 1579 # define lstat lstat64 1580 # endif 1581 # if defined(USE_FLOCK64) 1582 # define flock flock64 1583 # endif 1584 # if defined(USE_LOCKF64) 1585 # define lockf lockf64 1586 # endif 1587 # if defined(USE_FCNTL64) 1588 # define fcntl fcntl64 1589 # endif 1590 # if defined(USE_TRUNCATE64) 1591 # define truncate truncate64 1592 # endif 1593 # if defined(USE_FTRUNCATE64) 1594 # define ftruncate ftruncate64 1595 # endif 1596 #endif 1597 1598 #ifdef USE_64_BIT_STDIO 1599 # ifdef HAS_FPOS64_T 1600 # undef Fpos_t 1601 # define Fpos_t fpos64_t 1602 # endif 1603 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that 1604 * will trigger defines like the ones below. Some 64-bit environments, 1605 * however, do not. */ 1606 # if defined(USE_FOPEN64) 1607 # define fopen fopen64 1608 # endif 1609 # if defined(USE_FSEEK64) 1610 # define fseek fseek64 /* don't do fseeko here, see perlio.c */ 1611 # endif 1612 # if defined(USE_FTELL64) 1613 # define ftell ftell64 /* don't do ftello here, see perlio.c */ 1614 # endif 1615 # if defined(USE_FSETPOS64) 1616 # define fsetpos fsetpos64 1617 # endif 1618 # if defined(USE_FGETPOS64) 1619 # define fgetpos fgetpos64 1620 # endif 1621 # if defined(USE_TMPFILE64) 1622 # define tmpfile tmpfile64 1623 # endif 1624 # if defined(USE_FREOPEN64) 1625 # define freopen freopen64 1626 # endif 1627 #endif 1628 1629 #if defined(OS2) 1630 # include "iperlsys.h" 1631 #endif 1632 1633 #if defined(__OPEN_VM) 1634 # include "vmesa/vmesaish.h" 1635 #endif 1636 1637 #ifdef DOSISH 1638 # if defined(OS2) 1639 # include "os2ish.h" 1640 # else 1641 # include "dosish.h" 1642 # endif 1643 #else 1644 # if defined(VMS) 1645 # include "vmsish.h" 1646 # else 1647 # if defined(PLAN9) 1648 # include "./plan9/plan9ish.h" 1649 # else 1650 # if defined(MPE) 1651 # include "mpeix/mpeixish.h" 1652 # else 1653 # if defined(__VOS__) 1654 # include "vosish.h" 1655 # else 1656 # if defined(EPOC) 1657 # include "epocish.h" 1658 # else 1659 # if defined(MACOS_TRADITIONAL) 1660 # include "macos/macish.h" 1661 # ifndef NO_ENVIRON_ARRAY 1662 # define NO_ENVIRON_ARRAY 1663 # endif 1664 # else 1665 # include "unixish.h" 1666 # endif 1667 # endif 1668 # endif 1669 # endif 1670 # endif 1671 # endif 1672 #endif 1673 1674 #ifndef NO_ENVIRON_ARRAY 1675 # define USE_ENVIRON_ARRAY 1676 #endif 1677 1678 #ifdef JPL 1679 /* E.g. JPL needs to operate on a copy of the real environment. 1680 * JDK 1.2 and 1.3 seem to get upset if the original environment 1681 * is diddled with. */ 1682 # define NEED_ENVIRON_DUP_FOR_MODIFY 1683 #endif 1684 1685 #ifndef PERL_SYS_INIT3 1686 # define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp) 1687 #endif 1688 1689 #ifndef MAXPATHLEN 1690 # ifdef PATH_MAX 1691 # ifdef _POSIX_PATH_MAX 1692 # if PATH_MAX > _POSIX_PATH_MAX 1693 /* MAXPATHLEN is supposed to include the final null character, 1694 * as opposed to PATH_MAX and _POSIX_PATH_MAX. */ 1695 # define MAXPATHLEN (PATH_MAX+1) 1696 # else 1697 # define MAXPATHLEN (_POSIX_PATH_MAX+1) 1698 # endif 1699 # else 1700 # define MAXPATHLEN (PATH_MAX+1) 1701 # endif 1702 # else 1703 # ifdef _POSIX_PATH_MAX 1704 # define MAXPATHLEN (_POSIX_PATH_MAX+1) 1705 # else 1706 # define MAXPATHLEN 1024 /* Err on the large side. */ 1707 # endif 1708 # endif 1709 #endif 1710 1711 /* 1712 * USE_THREADS needs to be after unixish.h as <pthread.h> includes 1713 * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h> 1714 * this results in many functions being undeclared which bothers C++ 1715 * May make sense to have threads after "*ish.h" anyway 1716 */ 1717 1718 #if defined(USE_THREADS) || defined(USE_ITHREADS) 1719 # if defined(USE_THREADS) 1720 /* pending resolution of licensing issues, we avoid the erstwhile 1721 * atomic.h everywhere */ 1722 # define EMULATE_ATOMIC_REFCOUNTS 1723 # endif 1724 # ifdef FAKE_THREADS 1725 # include "fakethr.h" 1726 # else 1727 # ifdef WIN32 1728 # include <win32thread.h> 1729 # else 1730 # ifdef OS2 1731 # include "os2thread.h" 1732 # else 1733 # ifdef I_MACH_CTHREADS 1734 # include <mach/cthreads.h> 1735 # if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC) 1736 # define MUTEX_INIT_CALLS_MALLOC 1737 # endif 1738 typedef cthread_t perl_os_thread; 1739 typedef mutex_t perl_mutex; 1740 typedef condition_t perl_cond; 1741 typedef void * perl_key; 1742 # else /* Posix threads */ 1743 # ifdef I_PTHREAD 1744 # include <pthread.h> 1745 # endif 1746 typedef pthread_t perl_os_thread; 1747 typedef pthread_mutex_t perl_mutex; 1748 typedef pthread_cond_t perl_cond; 1749 typedef pthread_key_t perl_key; 1750 # endif /* I_MACH_CTHREADS */ 1751 # endif /* OS2 */ 1752 # endif /* WIN32 */ 1753 # endif /* FAKE_THREADS */ 1754 #endif /* USE_THREADS || USE_ITHREADS */ 1755 1756 #ifdef WIN32 1757 # include "win32.h" 1758 #endif 1759 1760 #ifdef VMS 1761 # define STATUS_NATIVE PL_statusvalue_vms 1762 # define STATUS_NATIVE_EXPORT \ 1763 (((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0)) 1764 # define STATUS_NATIVE_SET(n) \ 1765 STMT_START { \ 1766 PL_statusvalue_vms = (n); \ 1767 if ((I32)PL_statusvalue_vms == -1) \ 1768 PL_statusvalue = -1; \ 1769 else if (PL_statusvalue_vms & STS$M_SUCCESS) \ 1770 PL_statusvalue = 0; \ 1771 else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0) \ 1772 PL_statusvalue = 1 << 8; \ 1773 else \ 1774 PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \ 1775 } STMT_END 1776 # define STATUS_POSIX PL_statusvalue 1777 # ifdef VMSISH_STATUS 1778 # define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX) 1779 # else 1780 # define STATUS_CURRENT STATUS_POSIX 1781 # endif 1782 # define STATUS_POSIX_SET(n) \ 1783 STMT_START { \ 1784 PL_statusvalue = (n); \ 1785 if (PL_statusvalue != -1) { \ 1786 PL_statusvalue &= 0xFFFF; \ 1787 PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \ 1788 } \ 1789 else PL_statusvalue_vms = -1; \ 1790 } STMT_END 1791 # define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1) 1792 # define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44) 1793 #else 1794 # define STATUS_NATIVE STATUS_POSIX 1795 # define STATUS_NATIVE_EXPORT STATUS_POSIX 1796 # define STATUS_NATIVE_SET STATUS_POSIX_SET 1797 # define STATUS_POSIX PL_statusvalue 1798 # define STATUS_POSIX_SET(n) \ 1799 STMT_START { \ 1800 PL_statusvalue = (n); \ 1801 if (PL_statusvalue != -1) \ 1802 PL_statusvalue &= 0xFFFF; \ 1803 } STMT_END 1804 # define STATUS_CURRENT STATUS_POSIX 1805 # define STATUS_ALL_SUCCESS (PL_statusvalue = 0) 1806 # define STATUS_ALL_FAILURE (PL_statusvalue = 1) 1807 #endif 1808 1809 /* flags in PL_exit_flags for nature of exit() */ 1810 #define PERL_EXIT_EXPECTED 0x01 1811 1812 #ifndef MEMBER_TO_FPTR 1813 # define MEMBER_TO_FPTR(name) name 1814 #endif 1815 1816 /* format to use for version numbers in file/directory names */ 1817 /* XXX move to Configure? */ 1818 #ifndef PERL_FS_VER_FMT 1819 # define PERL_FS_VER_FMT "%d.%d.%d" 1820 #endif 1821 1822 /* This defines a way to flush all output buffers. This may be a 1823 * performance issue, so we allow people to disable it. 1824 */ 1825 #ifndef PERL_FLUSHALL_FOR_CHILD 1826 # if defined(FFLUSH_NULL) || defined(USE_SFIO) 1827 # define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL) 1828 # else 1829 # ifdef FFLUSH_ALL 1830 # define PERL_FLUSHALL_FOR_CHILD my_fflush_all() 1831 # else 1832 # define PERL_FLUSHALL_FOR_CHILD NOOP 1833 # endif 1834 # endif 1835 #endif 1836 1837 #ifndef PERL_WAIT_FOR_CHILDREN 1838 # define PERL_WAIT_FOR_CHILDREN NOOP 1839 #endif 1840 1841 /* the traditional thread-unsafe notion of "current interpreter". */ 1842 #ifndef PERL_SET_INTERP 1843 # define PERL_SET_INTERP(i) (PL_curinterp = (PerlInterpreter*)(i)) 1844 #endif 1845 1846 #ifndef PERL_GET_INTERP 1847 # define PERL_GET_INTERP (PL_curinterp) 1848 #endif 1849 1850 #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX) 1851 # ifdef USE_THREADS 1852 # define PERL_GET_THX ((struct perl_thread *)PERL_GET_CONTEXT) 1853 # else 1854 # ifdef MULTIPLICITY 1855 # define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT) 1856 # else 1857 # ifdef PERL_OBJECT 1858 # define PERL_GET_THX ((CPerlObj *)PERL_GET_CONTEXT) 1859 # endif 1860 # endif 1861 # endif 1862 # define PERL_SET_THX(t) PERL_SET_CONTEXT(t) 1863 #endif 1864 1865 #ifndef SVf 1866 # ifdef CHECK_FORMAT 1867 # define SVf "p" 1868 # else 1869 # define SVf "_" 1870 # endif 1871 #endif 1872 1873 #ifndef UVf 1874 # ifdef CHECK_FORMAT 1875 # define UVf UVuf 1876 # else 1877 # define UVf "Vu" 1878 # endif 1879 #endif 1880 1881 #ifndef VDf 1882 # ifdef CHECK_FORMAT 1883 # define VDf "p" 1884 # else 1885 # define VDf "vd" 1886 # endif 1887 #endif 1888 1889 /* Some unistd.h's give a prototype for pause() even though 1890 HAS_PAUSE ends up undefined. This causes the #define 1891 below to be rejected by the compiler. Sigh. 1892 */ 1893 #ifdef HAS_PAUSE 1894 #define Pause pause 1895 #else 1896 #define Pause() sleep((32767<<16)+32767) 1897 #endif 1898 1899 #ifndef IOCPARM_LEN 1900 # ifdef IOCPARM_MASK 1901 /* on BSDish systes we're safe */ 1902 # define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) 1903 # else 1904 /* otherwise guess at what's safe */ 1905 # define IOCPARM_LEN(x) 256 1906 # endif 1907 #endif 1908 1909 #if defined(__CYGWIN__) 1910 /* USEMYBINMODE 1911 * This symbol, if defined, indicates that the program should 1912 * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure 1913 * that a file is in "binary" mode -- that is, that no translation 1914 * of bytes occurs on read or write operations. 1915 */ 1916 # define USEMYBINMODE / **/ 1917 # define my_binmode(fp, iotype, mode) \ 1918 (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1 ? TRUE : FALSE) 1919 #endif 1920 1921 #ifdef UNION_ANY_DEFINITION 1922 UNION_ANY_DEFINITION; 1923 #else 1924 union any { 1925 void* any_ptr; 1926 I32 any_i32; 1927 IV any_iv; 1928 long any_long; 1929 void (*any_dptr) (void*); 1930 void (*any_dxptr) (pTHXo_ void*); 1931 }; 1932 #endif 1933 1934 #ifdef USE_THREADS 1935 #define ARGSproto struct perl_thread *thr 1936 #else 1937 #define ARGSproto 1938 #endif /* USE_THREADS */ 1939 1940 typedef I32 (*filter_t) (pTHXo_ int, SV *, int); 1941 1942 #define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) 1943 #define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx]) 1944 #define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters)) 1945 1946 #if !defined(OS2) 1947 # include "iperlsys.h" 1948 #endif 1949 #include "regexp.h" 1950 #include "sv.h" 1951 #include "util.h" 1952 #include "form.h" 1953 #include "gv.h" 1954 #include "cv.h" 1955 #include "opnames.h" 1956 #include "op.h" 1957 #include "cop.h" 1958 #include "av.h" 1959 #include "hv.h" 1960 #include "mg.h" 1961 #include "scope.h" 1962 #include "warnings.h" 1963 #include "utf8.h" 1964 1965 /* Current curly descriptor */ 1966 typedef struct curcur CURCUR; 1967 struct curcur { 1968 int parenfloor; /* how far back to strip paren data */ 1969 int cur; /* how many instances of scan we've matched */ 1970 int min; /* the minimal number of scans to match */ 1971 int max; /* the maximal number of scans to match */ 1972 int minmod; /* whether to work our way up or down */ 1973 regnode * scan; /* the thing to match */ 1974 regnode * next; /* what has to match after it */ 1975 char * lastloc; /* where we started matching this scan */ 1976 CURCUR * oldcc; /* current curly before we started this one */ 1977 }; 1978 1979 typedef struct _sublex_info SUBLEXINFO; 1980 struct _sublex_info { 1981 I32 super_state; /* lexer state to save */ 1982 I32 sub_inwhat; /* "lex_inwhat" to use */ 1983 OP *sub_op; /* "lex_op" to use */ 1984 char *super_bufptr; /* PL_bufptr that was */ 1985 char *super_bufend; /* PL_bufend that was */ 1986 }; 1987 1988 typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ 1989 1990 struct scan_data_t; /* Used in S_* functions in regcomp.c */ 1991 struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */ 1992 1993 typedef I32 CHECKPOINT; 1994 1995 struct ptr_tbl_ent { 1996 struct ptr_tbl_ent* next; 1997 void* oldval; 1998 void* newval; 1999 }; 2000 2001 struct ptr_tbl { 2002 struct ptr_tbl_ent** tbl_ary; 2003 UV tbl_max; 2004 UV tbl_items; 2005 }; 2006 2007 #if defined(iAPX286) || defined(M_I286) || defined(I80286) 2008 # define I286 2009 #endif 2010 2011 #if defined(htonl) && !defined(HAS_HTONL) 2012 #define HAS_HTONL 2013 #endif 2014 #if defined(htons) && !defined(HAS_HTONS) 2015 #define HAS_HTONS 2016 #endif 2017 #if defined(ntohl) && !defined(HAS_NTOHL) 2018 #define HAS_NTOHL 2019 #endif 2020 #if defined(ntohs) && !defined(HAS_NTOHS) 2021 #define HAS_NTOHS 2022 #endif 2023 #ifndef HAS_HTONL 2024 #if (BYTEORDER & 0xffff) != 0x4321 2025 #define HAS_HTONS 2026 #define HAS_HTONL 2027 #define HAS_NTOHS 2028 #define HAS_NTOHL 2029 #define MYSWAP 2030 #define htons my_swap 2031 #define htonl my_htonl 2032 #define ntohs my_swap 2033 #define ntohl my_ntohl 2034 #endif 2035 #else 2036 #if (BYTEORDER & 0xffff) == 0x4321 2037 #undef HAS_HTONS 2038 #undef HAS_HTONL 2039 #undef HAS_NTOHS 2040 #undef HAS_NTOHL 2041 #endif 2042 #endif 2043 2044 /* 2045 * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'. 2046 * -DWS 2047 */ 2048 #if BYTEORDER != 0x1234 2049 # define HAS_VTOHL 2050 # define HAS_VTOHS 2051 # define HAS_HTOVL 2052 # define HAS_HTOVS 2053 # if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 2054 # define vtohl(x) ((((x)&0xFF)<<24) \ 2055 +(((x)>>24)&0xFF) \ 2056 +(((x)&0x0000FF00)<<8) \ 2057 +(((x)&0x00FF0000)>>8) ) 2058 # define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF)) 2059 # define htovl(x) vtohl(x) 2060 # define htovs(x) vtohs(x) 2061 # endif 2062 /* otherwise default to functions in util.c */ 2063 #endif 2064 2065 #ifdef CASTNEGFLOAT 2066 #define U_S(what) ((U16)(what)) 2067 #define U_I(what) ((unsigned int)(what)) 2068 #define U_L(what) ((U32)(what)) 2069 #else 2070 #define U_S(what) ((U16)cast_ulong((NV)(what))) 2071 #define U_I(what) ((unsigned int)cast_ulong((NV)(what))) 2072 #define U_L(what) (cast_ulong((NV)(what))) 2073 #endif 2074 2075 #ifdef CASTI32 2076 #define I_32(what) ((I32)(what)) 2077 #define I_V(what) ((IV)(what)) 2078 #define U_V(what) ((UV)(what)) 2079 #else 2080 #define I_32(what) (cast_i32((NV)(what))) 2081 #define I_V(what) (cast_iv((NV)(what))) 2082 #define U_V(what) (cast_uv((NV)(what))) 2083 #endif 2084 2085 /* These do not care about the fractional part, only about the range. */ 2086 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX) 2087 #define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX) 2088 2089 /* Used with UV/IV arguments: */ 2090 /* XXXX: need to speed it up */ 2091 #define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv)) 2092 #define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv)) 2093 2094 #ifndef MAXSYSFD 2095 # define MAXSYSFD 2 2096 #endif 2097 2098 #ifndef __cplusplus 2099 Uid_t getuid (void); 2100 Uid_t geteuid (void); 2101 Gid_t getgid (void); 2102 Gid_t getegid (void); 2103 #endif 2104 2105 #ifndef Perl_debug_log 2106 # define Perl_debug_log PerlIO_stderr() 2107 #endif 2108 2109 #ifndef Perl_error_log 2110 # define Perl_error_log (PL_stderrgv \ 2111 && GvIOp(PL_stderrgv) \ 2112 && IoOFP(GvIOp(PL_stderrgv)) \ 2113 ? IoOFP(GvIOp(PL_stderrgv)) \ 2114 : PerlIO_stderr()) 2115 #endif 2116 2117 #ifdef DEBUGGING 2118 #undef YYDEBUG 2119 #define YYDEBUG 1 2120 #define DEB(a) a 2121 #define DEBUG(a) if (PL_debug) a 2122 #define DEBUG_p(a) if (PL_debug & 1) a 2123 #define DEBUG_s(a) if (PL_debug & 2) a 2124 #define DEBUG_l(a) if (PL_debug & 4) a 2125 #define DEBUG_t(a) if (PL_debug & 8) a 2126 #define DEBUG_o(a) if (PL_debug & 16) a 2127 #define DEBUG_c(a) if (PL_debug & 32) a 2128 #define DEBUG_P(a) if (PL_debug & 64) a 2129 # if defined(PERL_OBJECT) 2130 # define DEBUG_m(a) if (PL_debug & 128) a 2131 # else 2132 /* Temporarily turn off memory debugging in case the a 2133 * does memory allocation, either directly or indirectly. */ 2134 # define DEBUG_m(a) \ 2135 STMT_START { \ 2136 if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) {PL_debug&=~128; a; PL_debug|=128;} } \ 2137 } STMT_END 2138 # endif 2139 #define DEBUG_f(a) if (PL_debug & 256) a 2140 #define DEBUG_r(a) if (PL_debug & 512) a 2141 #define DEBUG_x(a) if (PL_debug & 1024) a 2142 #define DEBUG_u(a) if (PL_debug & 2048) a 2143 #define DEBUG_L(a) if (PL_debug & 4096) a 2144 #define DEBUG_H(a) if (PL_debug & 8192) a 2145 #define DEBUG_X(a) if (PL_debug & 16384) a 2146 #define DEBUG_D(a) if (PL_debug & 32768) a 2147 # ifdef USE_THREADS 2148 # define DEBUG_S(a) if (PL_debug & (1<<16)) a 2149 # else 2150 # define DEBUG_S(a) 2151 # endif 2152 #define DEBUG_T(a) if (PL_debug & (1<<17)) a 2153 #else 2154 #define DEB(a) 2155 #define DEBUG(a) 2156 #define DEBUG_p(a) 2157 #define DEBUG_s(a) 2158 #define DEBUG_l(a) 2159 #define DEBUG_t(a) 2160 #define DEBUG_o(a) 2161 #define DEBUG_c(a) 2162 #define DEBUG_P(a) 2163 #define DEBUG_m(a) 2164 #define DEBUG_f(a) 2165 #define DEBUG_r(a) 2166 #define DEBUG_x(a) 2167 #define DEBUG_u(a) 2168 #define DEBUG_S(a) 2169 #define DEBUG_H(a) 2170 #define DEBUG_X(a) 2171 #define DEBUG_D(a) 2172 #define DEBUG_S(a) 2173 #define DEBUG_T(a) 2174 #endif 2175 #define YYMAXDEPTH 300 2176 2177 #ifndef assert /* <assert.h> might have been included somehow */ 2178 #define assert(what) DEB( { \ 2179 if (!(what)) { \ 2180 Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d", \ 2181 __FILE__, __LINE__); \ 2182 PerlProc_exit(1); \ 2183 }}) 2184 #endif 2185 2186 struct ufuncs { 2187 I32 (*uf_val)(IV, SV*); 2188 I32 (*uf_set)(IV, SV*); 2189 IV uf_index; 2190 }; 2191 2192 /* Fix these up for __STDC__ */ 2193 #ifndef DONT_DECLARE_STD 2194 char *mktemp (char*); 2195 #ifndef atof 2196 double atof (const char*); 2197 #endif 2198 #endif 2199 2200 #ifndef STANDARD_C 2201 /* All of these are in stdlib.h or time.h for ANSI C */ 2202 Time_t time(); 2203 struct tm *gmtime(), *localtime(); 2204 #if defined(OEMVS) || defined(__OPEN_VM) 2205 char *(strchr)(), *(strrchr)(); 2206 char *(strcpy)(), *(strcat)(); 2207 #else 2208 char *strchr(), *strrchr(); 2209 char *strcpy(), *strcat(); 2210 #endif 2211 #endif /* ! STANDARD_C */ 2212 2213 2214 #ifdef I_MATH 2215 # include <math.h> 2216 #else 2217 START_EXTERN_C 2218 double exp (double); 2219 double log (double); 2220 double log10 (double); 2221 double sqrt (double); 2222 double frexp (double,int*); 2223 double ldexp (double,int); 2224 double modf (double,double*); 2225 double sin (double); 2226 double cos (double); 2227 double atan2 (double,double); 2228 double pow (double,double); 2229 END_EXTERN_C 2230 #endif 2231 2232 #ifndef __cplusplus 2233 # if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */ 2234 char *crypt (); /* Maybe more hosts will need the unprototyped version */ 2235 # else 2236 # if !defined(WIN32) 2237 char *crypt (const char*, const char*); 2238 # endif /* !WIN32 */ 2239 # endif /* !NeXT && !__NeXT__ */ 2240 # ifndef DONT_DECLARE_STD 2241 # ifndef getenv 2242 char *getenv (const char*); 2243 # endif /* !getenv */ 2244 # if !defined(HAS_LSEEK_PROTO) && !defined(EPOC) && !defined(__hpux) 2245 # ifdef _FILE_OFFSET_BITS 2246 # if _FILE_OFFSET_BITS == 64 2247 Off_t lseek (int,Off_t,int); 2248 # endif 2249 # endif 2250 # endif 2251 # endif /* !DONT_DECLARE_STD */ 2252 char *getlogin (void); 2253 #endif /* !__cplusplus */ 2254 2255 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ 2256 #define UNLINK unlnk 2257 I32 unlnk (char*); 2258 #else 2259 #define UNLINK PerlLIO_unlink 2260 #endif 2261 2262 #ifndef HAS_SETREUID 2263 # ifdef HAS_SETRESUID 2264 # define setreuid(r,e) setresuid(r,e,(Uid_t)-1) 2265 # define HAS_SETREUID 2266 # endif 2267 #endif 2268 #ifndef HAS_SETREGID 2269 # ifdef HAS_SETRESGID 2270 # define setregid(r,e) setresgid(r,e,(Gid_t)-1) 2271 # define HAS_SETREGID 2272 # endif 2273 #endif 2274 2275 /* Sighandler_t defined in iperlsys.h */ 2276 2277 #ifdef HAS_SIGACTION 2278 typedef struct sigaction Sigsave_t; 2279 #else 2280 typedef Sighandler_t Sigsave_t; 2281 #endif 2282 2283 #define SCAN_DEF 0 2284 #define SCAN_TR 1 2285 #define SCAN_REPL 2 2286 2287 #ifdef DEBUGGING 2288 # ifndef register 2289 # define register 2290 # endif 2291 # define PAD_SV(po) pad_sv(po) 2292 # define RUNOPS_DEFAULT Perl_runops_debug 2293 #else 2294 # define PAD_SV(po) PL_curpad[po] 2295 # define RUNOPS_DEFAULT Perl_runops_standard 2296 #endif 2297 2298 #ifdef MYMALLOC 2299 # ifdef MUTEX_INIT_CALLS_MALLOC 2300 # define MALLOC_INIT \ 2301 STMT_START { \ 2302 PL_malloc_mutex = NULL; \ 2303 MUTEX_INIT(&PL_malloc_mutex); \ 2304 } STMT_END 2305 # define MALLOC_TERM \ 2306 STMT_START { \ 2307 perl_mutex tmp = PL_malloc_mutex; \ 2308 PL_malloc_mutex = NULL; \ 2309 MUTEX_DESTROY(&tmp); \ 2310 } STMT_END 2311 # else 2312 # define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex) 2313 # define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex) 2314 # endif 2315 #else 2316 # define MALLOC_INIT 2317 # define MALLOC_TERM 2318 #endif 2319 2320 2321 typedef int (CPERLscope(*runops_proc_t)) (pTHX); 2322 typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX); 2323 2324 /* _ (for $_) must be first in the following list (DEFSV requires it) */ 2325 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" 2326 2327 /* NeXT has problems with crt0.o globals */ 2328 #if defined(__DYNAMIC__) && \ 2329 (defined(NeXT) || defined(__NeXT__) || defined(__APPLE__)) 2330 # if defined(NeXT) || defined(__NeXT) 2331 # include <mach-o/dyld.h> 2332 # define environ (*environ_pointer) 2333 EXT char *** environ_pointer; 2334 # else 2335 # if defined(__APPLE__) && defined(PERL_CORE) 2336 # include <crt_externs.h> /* for the env array */ 2337 # define environ (*_NSGetEnviron()) 2338 # endif 2339 # endif 2340 #else 2341 /* VMS and some other platforms don't use the environ array */ 2342 # ifdef USE_ENVIRON_ARRAY 2343 # if !defined(DONT_DECLARE_STD) || \ 2344 (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \ 2345 defined(__sgi) || \ 2346 defined(__DGUX) 2347 extern char ** environ; /* environment variables supplied via exec */ 2348 # endif 2349 # endif 2350 #endif 2351 2352 START_EXTERN_C 2353 2354 /* handy constants */ 2355 EXTCONST char PL_warn_uninit[] 2356 INIT("Use of uninitialized value%s%s"); 2357 EXTCONST char PL_warn_nosemi[] 2358 INIT("Semicolon seems to be missing"); 2359 EXTCONST char PL_warn_reserved[] 2360 INIT("Unquoted string \"%s\" may clash with future reserved word"); 2361 EXTCONST char PL_warn_nl[] 2362 INIT("Unsuccessful %s on filename containing newline"); 2363 EXTCONST char PL_no_wrongref[] 2364 INIT("Can't use %s ref as %s ref"); 2365 EXTCONST char PL_no_symref[] 2366 INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); 2367 EXTCONST char PL_no_usym[] 2368 INIT("Can't use an undefined value as %s reference"); 2369 EXTCONST char PL_no_aelem[] 2370 INIT("Modification of non-creatable array value attempted, subscript %d"); 2371 EXTCONST char PL_no_helem[] 2372 INIT("Modification of non-creatable hash value attempted, subscript \"%s\""); 2373 EXTCONST char PL_no_modify[] 2374 INIT("Modification of a read-only value attempted"); 2375 EXTCONST char PL_no_mem[] 2376 INIT("Out of memory!\n"); 2377 EXTCONST char PL_no_security[] 2378 INIT("Insecure dependency in %s%s"); 2379 EXTCONST char PL_no_sock_func[] 2380 INIT("Unsupported socket function \"%s\" called"); 2381 EXTCONST char PL_no_dir_func[] 2382 INIT("Unsupported directory function \"%s\" called"); 2383 EXTCONST char PL_no_func[] 2384 INIT("The %s function is unimplemented"); 2385 EXTCONST char PL_no_myglob[] 2386 INIT("\"my\" variable %s can't be in a package"); 2387 2388 EXTCONST char PL_uuemap[65] 2389 INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); 2390 2391 2392 #ifdef DOINIT 2393 EXT char *PL_sig_name[] = { SIG_NAME }; 2394 EXT int PL_sig_num[] = { SIG_NUM }; 2395 #else 2396 EXT char *PL_sig_name[]; 2397 EXT int PL_sig_num[]; 2398 #endif 2399 2400 /* fast case folding tables */ 2401 2402 #ifdef DOINIT 2403 #ifdef EBCDIC 2404 EXT unsigned char PL_fold[] = { /* fast EBCDIC case folding table */ 2405 0, 1, 2, 3, 4, 5, 6, 7, 2406 8, 9, 10, 11, 12, 13, 14, 15, 2407 16, 17, 18, 19, 20, 21, 22, 23, 2408 24, 25, 26, 27, 28, 29, 30, 31, 2409 32, 33, 34, 35, 36, 37, 38, 39, 2410 40, 41, 42, 43, 44, 45, 46, 47, 2411 48, 49, 50, 51, 52, 53, 54, 55, 2412 56, 57, 58, 59, 60, 61, 62, 63, 2413 64, 65, 66, 67, 68, 69, 70, 71, 2414 72, 73, 74, 75, 76, 77, 78, 79, 2415 80, 81, 82, 83, 84, 85, 86, 87, 2416 88, 89, 90, 91, 92, 93, 94, 95, 2417 96, 97, 98, 99, 100, 101, 102, 103, 2418 104, 105, 106, 107, 108, 109, 110, 111, 2419 112, 113, 114, 115, 116, 117, 118, 119, 2420 120, 121, 122, 123, 124, 125, 126, 127, 2421 128, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 2422 'H', 'I', 138, 139, 140, 141, 142, 143, 2423 144, 'J', 'K', 'L', 'M', 'N', 'O', 'P', 2424 'Q', 'R', 154, 155, 156, 157, 158, 159, 2425 160, 161, 'S', 'T', 'U', 'V', 'W', 'X', 2426 'Y', 'Z', 170, 171, 172, 173, 174, 175, 2427 176, 177, 178, 179, 180, 181, 182, 183, 2428 184, 185, 186, 187, 188, 189, 190, 191, 2429 192, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 2430 'h', 'i', 202, 203, 204, 205, 206, 207, 2431 208, 'j', 'k', 'l', 'm', 'n', 'o', 'p', 2432 'q', 'r', 218, 219, 220, 221, 222, 223, 2433 224, 225, 's', 't', 'u', 'v', 'w', 'x', 2434 'y', 'z', 234, 235, 236, 237, 238, 239, 2435 240, 241, 242, 243, 244, 245, 246, 247, 2436 248, 249, 250, 251, 252, 253, 254, 255 2437 }; 2438 #else /* ascii rather than ebcdic */ 2439 EXTCONST unsigned char PL_fold[] = { 2440 0, 1, 2, 3, 4, 5, 6, 7, 2441 8, 9, 10, 11, 12, 13, 14, 15, 2442 16, 17, 18, 19, 20, 21, 22, 23, 2443 24, 25, 26, 27, 28, 29, 30, 31, 2444 32, 33, 34, 35, 36, 37, 38, 39, 2445 40, 41, 42, 43, 44, 45, 46, 47, 2446 48, 49, 50, 51, 52, 53, 54, 55, 2447 56, 57, 58, 59, 60, 61, 62, 63, 2448 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 2449 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 2450 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 2451 'x', 'y', 'z', 91, 92, 93, 94, 95, 2452 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 2453 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 2454 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 2455 'X', 'Y', 'Z', 123, 124, 125, 126, 127, 2456 128, 129, 130, 131, 132, 133, 134, 135, 2457 136, 137, 138, 139, 140, 141, 142, 143, 2458 144, 145, 146, 147, 148, 149, 150, 151, 2459 152, 153, 154, 155, 156, 157, 158, 159, 2460 160, 161, 162, 163, 164, 165, 166, 167, 2461 168, 169, 170, 171, 172, 173, 174, 175, 2462 176, 177, 178, 179, 180, 181, 182, 183, 2463 184, 185, 186, 187, 188, 189, 190, 191, 2464 192, 193, 194, 195, 196, 197, 198, 199, 2465 200, 201, 202, 203, 204, 205, 206, 207, 2466 208, 209, 210, 211, 212, 213, 214, 215, 2467 216, 217, 218, 219, 220, 221, 222, 223, 2468 224, 225, 226, 227, 228, 229, 230, 231, 2469 232, 233, 234, 235, 236, 237, 238, 239, 2470 240, 241, 242, 243, 244, 245, 246, 247, 2471 248, 249, 250, 251, 252, 253, 254, 255 2472 }; 2473 #endif /* !EBCDIC */ 2474 #else 2475 EXTCONST unsigned char PL_fold[]; 2476 #endif 2477 2478 #ifdef DOINIT 2479 EXT unsigned char PL_fold_locale[] = { 2480 0, 1, 2, 3, 4, 5, 6, 7, 2481 8, 9, 10, 11, 12, 13, 14, 15, 2482 16, 17, 18, 19, 20, 21, 22, 23, 2483 24, 25, 26, 27, 28, 29, 30, 31, 2484 32, 33, 34, 35, 36, 37, 38, 39, 2485 40, 41, 42, 43, 44, 45, 46, 47, 2486 48, 49, 50, 51, 52, 53, 54, 55, 2487 56, 57, 58, 59, 60, 61, 62, 63, 2488 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 2489 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 2490 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 2491 'x', 'y', 'z', 91, 92, 93, 94, 95, 2492 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 2493 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 2494 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 2495 'X', 'Y', 'Z', 123, 124, 125, 126, 127, 2496 128, 129, 130, 131, 132, 133, 134, 135, 2497 136, 137, 138, 139, 140, 141, 142, 143, 2498 144, 145, 146, 147, 148, 149, 150, 151, 2499 152, 153, 154, 155, 156, 157, 158, 159, 2500 160, 161, 162, 163, 164, 165, 166, 167, 2501 168, 169, 170, 171, 172, 173, 174, 175, 2502 176, 177, 178, 179, 180, 181, 182, 183, 2503 184, 185, 186, 187, 188, 189, 190, 191, 2504 192, 193, 194, 195, 196, 197, 198, 199, 2505 200, 201, 202, 203, 204, 205, 206, 207, 2506 208, 209, 210, 211, 212, 213, 214, 215, 2507 216, 217, 218, 219, 220, 221, 222, 223, 2508 224, 225, 226, 227, 228, 229, 230, 231, 2509 232, 233, 234, 235, 236, 237, 238, 239, 2510 240, 241, 242, 243, 244, 245, 246, 247, 2511 248, 249, 250, 251, 252, 253, 254, 255 2512 }; 2513 #else 2514 EXT unsigned char PL_fold_locale[]; 2515 #endif 2516 2517 #ifdef DOINIT 2518 #ifdef EBCDIC 2519 EXT unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */ 2520 1, 2, 84, 151, 154, 155, 156, 157, 2521 165, 246, 250, 3, 158, 7, 18, 29, 2522 40, 51, 62, 73, 85, 96, 107, 118, 2523 129, 140, 147, 148, 149, 150, 152, 153, 2524 255, 6, 8, 9, 10, 11, 12, 13, 2525 14, 15, 24, 25, 26, 27, 28, 226, 2526 29, 30, 31, 32, 33, 43, 44, 45, 2527 46, 47, 48, 49, 50, 76, 77, 78, 2528 79, 80, 81, 82, 83, 84, 85, 86, 2529 87, 94, 95, 234, 181, 233, 187, 190, 2530 180, 96, 97, 98, 99, 100, 101, 102, 2531 104, 112, 182, 174, 236, 232, 229, 103, 2532 228, 226, 114, 115, 116, 117, 118, 119, 2533 120, 121, 122, 235, 176, 230, 194, 162, 2534 130, 131, 132, 133, 134, 135, 136, 137, 2535 138, 139, 201, 205, 163, 217, 220, 224, 2536 5, 248, 227, 244, 242, 255, 241, 231, 2537 240, 253, 16, 197, 19, 20, 21, 187, 2538 23, 169, 210, 245, 237, 249, 247, 239, 2539 168, 252, 34, 196, 36, 37, 38, 39, 2540 41, 42, 251, 254, 238, 223, 221, 213, 2541 225, 177, 52, 53, 54, 55, 56, 57, 2542 58, 59, 60, 61, 63, 64, 65, 66, 2543 67, 68, 69, 70, 71, 72, 74, 75, 2544 205, 208, 186, 202, 200, 218, 198, 179, 2545 178, 214, 88, 89, 90, 91, 92, 93, 2546 217, 166, 170, 207, 199, 209, 206, 204, 2547 160, 212, 105, 106, 108, 109, 110, 111, 2548 203, 113, 216, 215, 192, 175, 193, 243, 2549 172, 161, 123, 124, 125, 126, 127, 128, 2550 222, 219, 211, 195, 188, 193, 185, 184, 2551 191, 183, 141, 142, 143, 144, 145, 146 2552 }; 2553 #else /* ascii rather than ebcdic */ 2554 EXTCONST unsigned char PL_freq[] = { /* letter frequencies for mixed English/C */ 2555 1, 2, 84, 151, 154, 155, 156, 157, 2556 165, 246, 250, 3, 158, 7, 18, 29, 2557 40, 51, 62, 73, 85, 96, 107, 118, 2558 129, 140, 147, 148, 149, 150, 152, 153, 2559 255, 182, 224, 205, 174, 176, 180, 217, 2560 233, 232, 236, 187, 235, 228, 234, 226, 2561 222, 219, 211, 195, 188, 193, 185, 184, 2562 191, 183, 201, 229, 181, 220, 194, 162, 2563 163, 208, 186, 202, 200, 218, 198, 179, 2564 178, 214, 166, 170, 207, 199, 209, 206, 2565 204, 160, 212, 216, 215, 192, 175, 173, 2566 243, 172, 161, 190, 203, 189, 164, 230, 2567 167, 248, 227, 244, 242, 255, 241, 231, 2568 240, 253, 169, 210, 245, 237, 249, 247, 2569 239, 168, 252, 251, 254, 238, 223, 221, 2570 213, 225, 177, 197, 171, 196, 159, 4, 2571 5, 6, 8, 9, 10, 11, 12, 13, 2572 14, 15, 16, 17, 19, 20, 21, 22, 2573 23, 24, 25, 26, 27, 28, 30, 31, 2574 32, 33, 34, 35, 36, 37, 38, 39, 2575 41, 42, 43, 44, 45, 46, 47, 48, 2576 49, 50, 52, 53, 54, 55, 56, 57, 2577 58, 59, 60, 61, 63, 64, 65, 66, 2578 67, 68, 69, 70, 71, 72, 74, 75, 2579 76, 77, 78, 79, 80, 81, 82, 83, 2580 86, 87, 88, 89, 90, 91, 92, 93, 2581 94, 95, 97, 98, 99, 100, 101, 102, 2582 103, 104, 105, 106, 108, 109, 110, 111, 2583 112, 113, 114, 115, 116, 117, 119, 120, 2584 121, 122, 123, 124, 125, 126, 127, 128, 2585 130, 131, 132, 133, 134, 135, 136, 137, 2586 138, 139, 141, 142, 143, 144, 145, 146 2587 }; 2588 #endif 2589 #else 2590 EXTCONST unsigned char PL_freq[]; 2591 #endif 2592 2593 #ifdef DEBUGGING 2594 #ifdef DOINIT 2595 EXTCONST char* PL_block_type[] = { 2596 "NULL", 2597 "SUB", 2598 "EVAL", 2599 "LOOP", 2600 "SUBST", 2601 "BLOCK", 2602 }; 2603 #else 2604 EXTCONST char* PL_block_type[]; 2605 #endif 2606 #endif 2607 2608 END_EXTERN_C 2609 2610 /*****************************************************************************/ 2611 /* This lexer/parser stuff is currently global since yacc is hard to reenter */ 2612 /*****************************************************************************/ 2613 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */ 2614 2615 #include "perly.h" 2616 2617 #define LEX_NOTPARSING 11 /* borrowed from toke.c */ 2618 2619 typedef enum { 2620 XOPERATOR, 2621 XTERM, 2622 XREF, 2623 XSTATE, 2624 XBLOCK, 2625 XATTRBLOCK, 2626 XATTRTERM, 2627 XTERMBLOCK 2628 } expectation; 2629 2630 enum { /* pass one of these to get_vtbl */ 2631 want_vtbl_sv, 2632 want_vtbl_env, 2633 want_vtbl_envelem, 2634 want_vtbl_sig, 2635 want_vtbl_sigelem, 2636 want_vtbl_pack, 2637 want_vtbl_packelem, 2638 want_vtbl_dbline, 2639 want_vtbl_isa, 2640 want_vtbl_isaelem, 2641 want_vtbl_arylen, 2642 want_vtbl_glob, 2643 want_vtbl_mglob, 2644 want_vtbl_nkeys, 2645 want_vtbl_taint, 2646 want_vtbl_substr, 2647 want_vtbl_vec, 2648 want_vtbl_pos, 2649 want_vtbl_bm, 2650 want_vtbl_fm, 2651 want_vtbl_uvar, 2652 want_vtbl_defelem, 2653 want_vtbl_regexp, 2654 want_vtbl_collxfrm, 2655 want_vtbl_amagic, 2656 want_vtbl_amagicelem, 2657 #ifdef USE_THREADS 2658 want_vtbl_mutex, 2659 #endif 2660 want_vtbl_regdata, 2661 want_vtbl_regdatum, 2662 want_vtbl_backref 2663 }; 2664 2665 /* Note: the lowest 8 bits are reserved for 2666 stuffing into op->op_private */ 2667 #define HINT_PRIVATE_MASK 0x000000ff 2668 #define HINT_INTEGER 0x00000001 2669 #define HINT_STRICT_REFS 0x00000002 2670 /* #define HINT_notused4 0x00000004 */ 2671 #define HINT_BYTE 0x00000008 2672 /* #define HINT_notused10 0x00000010 */ 2673 /* Note: 20,40,80 used for NATIVE_HINTS */ 2674 2675 #define HINT_BLOCK_SCOPE 0x00000100 2676 #define HINT_STRICT_SUBS 0x00000200 2677 #define HINT_STRICT_VARS 0x00000400 2678 #define HINT_LOCALE 0x00000800 2679 2680 #define HINT_NEW_INTEGER 0x00001000 2681 #define HINT_NEW_FLOAT 0x00002000 2682 #define HINT_NEW_BINARY 0x00004000 2683 #define HINT_NEW_STRING 0x00008000 2684 #define HINT_NEW_RE 0x00010000 2685 #define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */ 2686 2687 #define HINT_RE_TAINT 0x00100000 2688 #define HINT_RE_EVAL 0x00200000 2689 2690 #define HINT_FILETEST_ACCESS 0x00400000 2691 #define HINT_UTF8 0x00800000 2692 2693 /* Various states of an input record separator SV (rs, nrs) */ 2694 #define RsSNARF(sv) (! SvOK(sv)) 2695 #define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) 2696 #define RsPARA(sv) (SvPOK(sv) && ! SvCUR(sv)) 2697 #define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) 2698 2699 /* Enable variables which are pointers to functions */ 2700 typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm); 2701 typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg, 2702 char* strend, char* strbeg, I32 minend, 2703 SV* screamer, void* data, U32 flags); 2704 typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv, 2705 char *strpos, char *strend, 2706 U32 flags, 2707 struct re_scream_pos_data_s *d); 2708 typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog); 2709 typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r); 2710 2711 typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*); 2712 typedef void (*DESTRUCTORFUNC_t) (pTHXo_ void*); 2713 typedef void (*SVFUNC_t) (pTHXo_ SV*); 2714 typedef I32 (*SVCOMPARE_t) (pTHXo_ SV*, SV*); 2715 typedef void (*XSINIT_t) (pTHXo); 2716 typedef void (*ATEXIT_t) (pTHXo_ void*); 2717 typedef void (*XSUBADDR_t) (pTHXo_ CV *); 2718 2719 /* Set up PERLVAR macros for populating structs */ 2720 #define PERLVAR(var,type) type var; 2721 #define PERLVARA(var,n,type) type var[n]; 2722 #define PERLVARI(var,type,init) type var; 2723 #define PERLVARIC(var,type,init) type var; 2724 2725 /* Interpreter exitlist entry */ 2726 typedef struct exitlistentry { 2727 void (*fn) (pTHXo_ void*); 2728 void *ptr; 2729 } PerlExitListEntry; 2730 2731 #ifdef PERL_GLOBAL_STRUCT 2732 struct perl_vars { 2733 # include "perlvars.h" 2734 }; 2735 2736 # ifdef PERL_CORE 2737 EXT struct perl_vars PL_Vars; 2738 EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); 2739 # else /* PERL_CORE */ 2740 # if !defined(__GNUC__) || !defined(WIN32) 2741 EXT 2742 # endif /* WIN32 */ 2743 struct perl_vars *PL_VarsPtr; 2744 # define PL_Vars (*((PL_VarsPtr) \ 2745 ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX)))) 2746 # endif /* PERL_CORE */ 2747 #endif /* PERL_GLOBAL_STRUCT */ 2748 2749 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) 2750 /* If we have multiple interpreters define a struct 2751 holding variables which must be per-interpreter 2752 If we don't have threads anything that would have 2753 be per-thread is per-interpreter. 2754 */ 2755 2756 struct interpreter { 2757 # ifndef USE_THREADS 2758 # include "thrdvar.h" 2759 # endif 2760 # include "intrpvar.h" 2761 /* 2762 * The following is a buffer where new variables must 2763 * be defined to maintain binary compatibility with PERL_OBJECT 2764 */ 2765 PERLVARA(object_compatibility,30, char) 2766 }; 2767 2768 #else 2769 struct interpreter { 2770 char broiled; 2771 }; 2772 #endif /* MULTIPLICITY || PERL_OBJECT */ 2773 2774 #ifdef USE_THREADS 2775 /* If we have threads define a struct with all the variables 2776 * that have to be per-thread 2777 */ 2778 2779 2780 struct perl_thread { 2781 #include "thrdvar.h" 2782 }; 2783 2784 typedef struct perl_thread *Thread; 2785 2786 #else 2787 typedef void *Thread; 2788 #endif 2789 2790 /* Done with PERLVAR macros for now ... */ 2791 #undef PERLVAR 2792 #undef PERLVARA 2793 #undef PERLVARI 2794 #undef PERLVARIC 2795 2796 #include "thread.h" 2797 #include "pp.h" 2798 2799 #ifndef PERL_CALLCONV 2800 # define PERL_CALLCONV 2801 #endif 2802 2803 #ifndef NEXT30_NO_ATTRIBUTE 2804 # ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ 2805 # ifdef __attribute__ /* Avoid possible redefinition errors */ 2806 # undef __attribute__ 2807 # endif 2808 # define __attribute__(attr) 2809 # endif 2810 #endif 2811 2812 #ifdef PERL_OBJECT 2813 # define PERL_DECL_PROT 2814 #endif 2815 2816 #undef PERL_CKDEF 2817 #undef PERL_PPDEF 2818 #define PERL_CKDEF(s) OP *s (pTHX_ OP *o); 2819 #define PERL_PPDEF(s) OP *s (pTHX); 2820 2821 #include "proto.h" 2822 2823 #ifdef PERL_OBJECT 2824 # undef PERL_DECL_PROT 2825 #endif 2826 2827 #ifndef PERL_OBJECT 2828 /* this has structure inits, so it cannot be included before here */ 2829 # include "opcode.h" 2830 #endif 2831 2832 /* The following must follow proto.h as #defines mess up syntax */ 2833 2834 #if !defined(PERL_FOR_X2P) 2835 # include "embedvar.h" 2836 #endif 2837 2838 /* Now include all the 'global' variables 2839 * If we don't have threads or multiple interpreters 2840 * these include variables that would have been their struct-s 2841 */ 2842 2843 #define PERLVAR(var,type) EXT type PL_##var; 2844 #define PERLVARA(var,n,type) EXT type PL_##var[n]; 2845 #define PERLVARI(var,type,init) EXT type PL_##var INIT(init); 2846 #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init); 2847 2848 #if !defined(MULTIPLICITY) && !defined(PERL_OBJECT) 2849 START_EXTERN_C 2850 # include "intrpvar.h" 2851 # ifndef USE_THREADS 2852 # include "thrdvar.h" 2853 # endif 2854 END_EXTERN_C 2855 #endif 2856 2857 #ifdef PERL_OBJECT 2858 # include "embed.h" 2859 2860 # ifdef DOINIT 2861 # include "INTERN.h" 2862 # else 2863 # include "EXTERN.h" 2864 # endif 2865 2866 /* this has structure inits, so it cannot be included before here */ 2867 # include "opcode.h" 2868 2869 #else 2870 # if defined(WIN32) 2871 # include "embed.h" 2872 # endif 2873 #endif /* PERL_OBJECT */ 2874 2875 #ifndef PERL_GLOBAL_STRUCT 2876 START_EXTERN_C 2877 2878 # include "perlvars.h" 2879 2880 END_EXTERN_C 2881 #endif 2882 2883 #undef PERLVAR 2884 #undef PERLVARA 2885 #undef PERLVARI 2886 #undef PERLVARIC 2887 2888 START_EXTERN_C 2889 2890 #ifdef DOINIT 2891 2892 EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get), 2893 MEMBER_TO_FPTR(Perl_magic_set), 2894 MEMBER_TO_FPTR(Perl_magic_len), 2895 0, 0}; 2896 EXT MGVTBL PL_vtbl_env = {0, MEMBER_TO_FPTR(Perl_magic_set_all_env), 2897 0, MEMBER_TO_FPTR(Perl_magic_clear_all_env), 2898 0}; 2899 EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv), 2900 0, MEMBER_TO_FPTR(Perl_magic_clearenv), 2901 0}; 2902 EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0}; 2903 EXT MGVTBL PL_vtbl_sigelem = {MEMBER_TO_FPTR(Perl_magic_getsig), 2904 MEMBER_TO_FPTR(Perl_magic_setsig), 2905 0, MEMBER_TO_FPTR(Perl_magic_clearsig), 2906 0}; 2907 EXT MGVTBL PL_vtbl_pack = {0, 0, MEMBER_TO_FPTR(Perl_magic_sizepack), MEMBER_TO_FPTR(Perl_magic_wipepack), 2908 0}; 2909 EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack), 2910 MEMBER_TO_FPTR(Perl_magic_setpack), 2911 0, MEMBER_TO_FPTR(Perl_magic_clearpack), 2912 0}; 2913 EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline), 2914 0, 0, 0}; 2915 EXT MGVTBL PL_vtbl_isa = {0, MEMBER_TO_FPTR(Perl_magic_setisa), 2916 0, MEMBER_TO_FPTR(Perl_magic_setisa), 2917 0}; 2918 EXT MGVTBL PL_vtbl_isaelem = {0, MEMBER_TO_FPTR(Perl_magic_setisa), 2919 0, 0, 0}; 2920 EXT MGVTBL PL_vtbl_arylen = {MEMBER_TO_FPTR(Perl_magic_getarylen), 2921 MEMBER_TO_FPTR(Perl_magic_setarylen), 2922 0, 0, 0}; 2923 EXT MGVTBL PL_vtbl_glob = {MEMBER_TO_FPTR(Perl_magic_getglob), 2924 MEMBER_TO_FPTR(Perl_magic_setglob), 2925 0, 0, 0}; 2926 EXT MGVTBL PL_vtbl_mglob = {0, MEMBER_TO_FPTR(Perl_magic_setmglob), 2927 0, 0, 0}; 2928 EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys), 2929 MEMBER_TO_FPTR(Perl_magic_setnkeys), 2930 0, 0, 0}; 2931 EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint),MEMBER_TO_FPTR(Perl_magic_settaint), 2932 0, 0, 0}; 2933 EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr), MEMBER_TO_FPTR(Perl_magic_setsubstr), 2934 0, 0, 0}; 2935 EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec), 2936 MEMBER_TO_FPTR(Perl_magic_setvec), 2937 0, 0, 0}; 2938 EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos), 2939 MEMBER_TO_FPTR(Perl_magic_setpos), 2940 0, 0, 0}; 2941 EXT MGVTBL PL_vtbl_bm = {0, MEMBER_TO_FPTR(Perl_magic_setbm), 2942 0, 0, 0}; 2943 EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm), 2944 0, 0, 0}; 2945 EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar), 2946 MEMBER_TO_FPTR(Perl_magic_setuvar), 2947 0, 0, 0}; 2948 #ifdef USE_THREADS 2949 EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, MEMBER_TO_FPTR(Perl_magic_mutexfree)}; 2950 #endif /* USE_THREADS */ 2951 EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),MEMBER_TO_FPTR(Perl_magic_setdefelem), 2952 0, 0, 0}; 2953 2954 EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)}; 2955 EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0}; 2956 EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get), 2957 MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0}; 2958 2959 #ifdef USE_LOCALE_COLLATE 2960 EXT MGVTBL PL_vtbl_collxfrm = {0, 2961 MEMBER_TO_FPTR(Perl_magic_setcollxfrm), 2962 0, 0, 0}; 2963 #endif 2964 2965 EXT MGVTBL PL_vtbl_amagic = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), 2966 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; 2967 EXT MGVTBL PL_vtbl_amagicelem = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), 2968 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; 2969 2970 EXT MGVTBL PL_vtbl_backref = {0, 0, 2971 0, 0, MEMBER_TO_FPTR(Perl_magic_killbackrefs)}; 2972 2973 #else /* !DOINIT */ 2974 2975 EXT MGVTBL PL_vtbl_sv; 2976 EXT MGVTBL PL_vtbl_env; 2977 EXT MGVTBL PL_vtbl_envelem; 2978 EXT MGVTBL PL_vtbl_sig; 2979 EXT MGVTBL PL_vtbl_sigelem; 2980 EXT MGVTBL PL_vtbl_pack; 2981 EXT MGVTBL PL_vtbl_packelem; 2982 EXT MGVTBL PL_vtbl_dbline; 2983 EXT MGVTBL PL_vtbl_isa; 2984 EXT MGVTBL PL_vtbl_isaelem; 2985 EXT MGVTBL PL_vtbl_arylen; 2986 EXT MGVTBL PL_vtbl_glob; 2987 EXT MGVTBL PL_vtbl_mglob; 2988 EXT MGVTBL PL_vtbl_nkeys; 2989 EXT MGVTBL PL_vtbl_taint; 2990 EXT MGVTBL PL_vtbl_substr; 2991 EXT MGVTBL PL_vtbl_vec; 2992 EXT MGVTBL PL_vtbl_pos; 2993 EXT MGVTBL PL_vtbl_bm; 2994 EXT MGVTBL PL_vtbl_fm; 2995 EXT MGVTBL PL_vtbl_uvar; 2996 2997 #ifdef USE_THREADS 2998 EXT MGVTBL PL_vtbl_mutex; 2999 #endif /* USE_THREADS */ 3000 3001 EXT MGVTBL PL_vtbl_defelem; 3002 EXT MGVTBL PL_vtbl_regexp; 3003 EXT MGVTBL PL_vtbl_regdata; 3004 EXT MGVTBL PL_vtbl_regdatum; 3005 3006 #ifdef USE_LOCALE_COLLATE 3007 EXT MGVTBL PL_vtbl_collxfrm; 3008 #endif 3009 3010 EXT MGVTBL PL_vtbl_amagic; 3011 EXT MGVTBL PL_vtbl_amagicelem; 3012 3013 EXT MGVTBL PL_vtbl_backref; 3014 3015 #endif /* !DOINIT */ 3016 3017 enum { 3018 fallback_amg, abs_amg, 3019 bool__amg, nomethod_amg, 3020 string_amg, numer_amg, 3021 add_amg, add_ass_amg, 3022 subtr_amg, subtr_ass_amg, 3023 mult_amg, mult_ass_amg, 3024 div_amg, div_ass_amg, 3025 modulo_amg, modulo_ass_amg, 3026 pow_amg, pow_ass_amg, 3027 lshift_amg, lshift_ass_amg, 3028 rshift_amg, rshift_ass_amg, 3029 band_amg, band_ass_amg, 3030 bor_amg, bor_ass_amg, 3031 bxor_amg, bxor_ass_amg, 3032 lt_amg, le_amg, 3033 gt_amg, ge_amg, 3034 eq_amg, ne_amg, 3035 ncmp_amg, scmp_amg, 3036 slt_amg, sle_amg, 3037 sgt_amg, sge_amg, 3038 seq_amg, sne_amg, 3039 not_amg, compl_amg, 3040 inc_amg, dec_amg, 3041 atan2_amg, cos_amg, 3042 sin_amg, exp_amg, 3043 log_amg, sqrt_amg, 3044 repeat_amg, repeat_ass_amg, 3045 concat_amg, concat_ass_amg, 3046 copy_amg, neg_amg, 3047 to_sv_amg, to_av_amg, 3048 to_hv_amg, to_gv_amg, 3049 to_cv_amg, iter_amg, 3050 max_amg_code 3051 /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */ 3052 }; 3053 3054 #define NofAMmeth max_amg_code 3055 3056 #ifdef DOINIT 3057 EXTCONST char * PL_AMG_names[NofAMmeth] = { 3058 "fallback", "abs", /* "fallback" should be the first. */ 3059 "bool", "nomethod", 3060 "\"\"", "0+", 3061 "+", "+=", 3062 "-", "-=", 3063 "*", "*=", 3064 "/", "/=", 3065 "%", "%=", 3066 "**", "**=", 3067 "<<", "<<=", 3068 ">>", ">>=", 3069 "&", "&=", 3070 "|", "|=", 3071 "^", "^=", 3072 "<", "<=", 3073 ">", ">=", 3074 "==", "!=", 3075 "<=>", "cmp", 3076 "lt", "le", 3077 "gt", "ge", 3078 "eq", "ne", 3079 "!", "~", 3080 "++", "--", 3081 "atan2", "cos", 3082 "sin", "exp", 3083 "log", "sqrt", 3084 "x", "x=", 3085 ".", ".=", 3086 "=", "neg", 3087 "${}", "@{}", 3088 "%{}", "*{}", 3089 "&{}", "<>", 3090 }; 3091 #else 3092 EXTCONST char * PL_AMG_names[NofAMmeth]; 3093 #endif /* def INITAMAGIC */ 3094 3095 END_EXTERN_C 3096 3097 struct am_table { 3098 long was_ok_sub; 3099 long was_ok_am; 3100 U32 flags; 3101 CV* table[NofAMmeth]; 3102 long fallback; 3103 }; 3104 struct am_table_short { 3105 long was_ok_sub; 3106 long was_ok_am; 3107 U32 flags; 3108 }; 3109 typedef struct am_table AMT; 3110 typedef struct am_table_short AMTS; 3111 3112 #define AMGfallNEVER 1 3113 #define AMGfallNO 2 3114 #define AMGfallYES 3 3115 3116 #define AMTf_AMAGIC 1 3117 #define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC) 3118 #define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC) 3119 #define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC) 3120 3121 3122 /* 3123 * some compilers like to redefine cos et alia as faster 3124 * (and less accurate?) versions called F_cos et cetera (Quidquid 3125 * latine dictum sit, altum viditur.) This trick collides with 3126 * the Perl overloading (amg). The following #defines fool both. 3127 */ 3128 3129 #ifdef _FASTMATH 3130 # ifdef atan2 3131 # define F_atan2_amg atan2_amg 3132 # endif 3133 # ifdef cos 3134 # define F_cos_amg cos_amg 3135 # endif 3136 # ifdef exp 3137 # define F_exp_amg exp_amg 3138 # endif 3139 # ifdef log 3140 # define F_log_amg log_amg 3141 # endif 3142 # ifdef pow 3143 # define F_pow_amg pow_amg 3144 # endif 3145 # ifdef sin 3146 # define F_sin_amg sin_amg 3147 # endif 3148 # ifdef sqrt 3149 # define F_sqrt_amg sqrt_amg 3150 # endif 3151 #endif /* _FASTMATH */ 3152 3153 #define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \ 3154 PERLDBf_NOOPT | PERLDBf_INTER | \ 3155 PERLDBf_SUBLINE| PERLDBf_SINGLE| \ 3156 PERLDBf_NAMEEVAL| PERLDBf_NAMEANON) 3157 /* No _NONAME, _GOTO */ 3158 #define PERLDBf_SUB 0x01 /* Debug sub enter/exit */ 3159 #define PERLDBf_LINE 0x02 /* Keep line # */ 3160 #define PERLDBf_NOOPT 0x04 /* Switch off optimizations */ 3161 #define PERLDBf_INTER 0x08 /* Preserve more data for 3162 later inspections */ 3163 #define PERLDBf_SUBLINE 0x10 /* Keep subr source lines */ 3164 #define PERLDBf_SINGLE 0x20 /* Start with single-step on */ 3165 #define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr */ 3166 #define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */ 3167 #define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */ 3168 #define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */ 3169 3170 #define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB)) 3171 #define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE)) 3172 #define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT)) 3173 #define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER)) 3174 #define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE)) 3175 #define PERLDB_SINGLE (PL_perldb && (PL_perldb & PERLDBf_SINGLE)) 3176 #define PERLDB_SUB_NN (PL_perldb && (PL_perldb & (PERLDBf_NONAME))) 3177 #define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO)) 3178 #define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL)) 3179 #define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON)) 3180 3181 3182 #ifdef USE_LOCALE_NUMERIC 3183 3184 #define SET_NUMERIC_STANDARD() \ 3185 set_numeric_standard(); 3186 3187 #define SET_NUMERIC_LOCAL() \ 3188 set_numeric_local(); 3189 3190 #define IS_NUMERIC_RADIX(s) \ 3191 ((PL_hints & HINT_LOCALE) && \ 3192 PL_numeric_radix_sv && memEQ(s, SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))) 3193 3194 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \ 3195 bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \ 3196 if (was_local) SET_NUMERIC_STANDARD(); 3197 3198 #define STORE_NUMERIC_STANDARD_SET_LOCAL() \ 3199 bool was_standard = (PL_hints & HINT_LOCALE) && PL_numeric_standard; \ 3200 if (was_standard) SET_NUMERIC_LOCAL(); 3201 3202 #define RESTORE_NUMERIC_LOCAL() \ 3203 if (was_local) SET_NUMERIC_LOCAL(); 3204 3205 #define RESTORE_NUMERIC_STANDARD() \ 3206 if (was_standard) SET_NUMERIC_STANDARD(); 3207 3208 #define Atof my_atof 3209 3210 #else /* !USE_LOCALE_NUMERIC */ 3211 3212 #define SET_NUMERIC_STANDARD() /**/ 3213 #define SET_NUMERIC_LOCAL() /**/ 3214 #define IS_NUMERIC_RADIX(c) (0) 3215 #define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/ 3216 #define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/ 3217 #define RESTORE_NUMERIC_LOCAL() /**/ 3218 #define RESTORE_NUMERIC_STANDARD() /**/ 3219 #define Atof Perl_atof 3220 3221 #endif /* !USE_LOCALE_NUMERIC */ 3222 3223 #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG 3224 # ifdef __hpux 3225 # define strtoll __strtoll /* secret handshake */ 3226 # endif 3227 # if !defined(Strtol) && defined(HAS_STRTOLL) 3228 # define Strtol strtoll 3229 # endif 3230 /* is there atoq() anywhere? */ 3231 #endif 3232 #if !defined(Strtol) && defined(HAS_STRTOL) 3233 # define Strtol strtol 3234 #endif 3235 #ifndef Atol 3236 /* It would be more fashionable to use Strtol() to define atol() 3237 * (as is done for Atoul(), see below) but for backward compatibility 3238 * we just assume atol(). */ 3239 # if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL) 3240 # define Atol atoll 3241 # else 3242 # define Atol atol 3243 # endif 3244 #endif 3245 3246 #if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG 3247 # ifdef __hpux 3248 # define strtoull __strtoull /* secret handshake */ 3249 # endif 3250 # if !defined(Strtoul) && defined(HAS_STRTOULL) 3251 # define Strtoul strtoull 3252 # endif 3253 # if !defined(Strtoul) && defined(HAS_STRTOUQ) 3254 # define Strtoul strtouq 3255 # endif 3256 /* is there atouq() anywhere? */ 3257 #endif 3258 #if !defined(Strtoul) && defined(HAS_STRTOUL) 3259 # define Strtoul strtoul 3260 #endif 3261 #ifndef Atoul 3262 # define Atoul(s) Strtoul(s, (char **)NULL, 10) 3263 #endif 3264 3265 #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE) 3266 /* 3267 * Now we have __attribute__ out of the way 3268 * Remap printf 3269 */ 3270 #undef printf 3271 #define printf PerlIO_stdoutf 3272 #endif 3273 3274 /* if these never got defined, they need defaults */ 3275 #ifndef PERL_SET_CONTEXT 3276 # define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i) 3277 #endif 3278 3279 #ifndef PERL_GET_CONTEXT 3280 # define PERL_GET_CONTEXT PERL_GET_INTERP 3281 #endif 3282 3283 #ifndef PERL_GET_THX 3284 # define PERL_GET_THX ((void*)NULL) 3285 #endif 3286 3287 #ifndef PERL_SET_THX 3288 # define PERL_SET_THX(t) NOOP 3289 #endif 3290 3291 #ifndef PERL_SCRIPT_MODE 3292 #define PERL_SCRIPT_MODE "r" 3293 #endif 3294 3295 /* 3296 * Some operating systems are stingy with stack allocation, 3297 * so perl may have to guard against stack overflow. 3298 */ 3299 #ifndef PERL_STACK_OVERFLOW_CHECK 3300 #define PERL_STACK_OVERFLOW_CHECK() NOOP 3301 #endif 3302 3303 /* 3304 * Some nonpreemptive operating systems find it convenient to 3305 * check for asynchronous conditions after each op execution. 3306 * Keep this check simple, or it may slow down execution 3307 * massively. 3308 */ 3309 #ifndef PERL_ASYNC_CHECK 3310 #define PERL_ASYNC_CHECK() NOOP 3311 #endif 3312 3313 /* 3314 * On some operating systems, a memory allocation may succeed, 3315 * but put the process too close to the system's comfort limit. 3316 * In this case, PERL_ALLOC_CHECK frees the pointer and sets 3317 * it to NULL. 3318 */ 3319 #ifndef PERL_ALLOC_CHECK 3320 #define PERL_ALLOC_CHECK(p) NOOP 3321 #endif 3322 3323 /* 3324 * nice_chunk and nice_chunk size need to be set 3325 * and queried under the protection of sv_mutex 3326 */ 3327 #define offer_nice_chunk(chunk, chunk_size) do { \ 3328 LOCK_SV_MUTEX; \ 3329 if (!PL_nice_chunk) { \ 3330 PL_nice_chunk = (char*)(chunk); \ 3331 PL_nice_chunk_size = (chunk_size); \ 3332 } \ 3333 else { \ 3334 Safefree(chunk); \ 3335 } \ 3336 UNLOCK_SV_MUTEX; \ 3337 } while (0) 3338 3339 #ifdef HAS_SEM 3340 # include <sys/ipc.h> 3341 # include <sys/sem.h> 3342 # ifndef HAS_UNION_SEMUN /* Provide the union semun. */ 3343 union semun { 3344 int val; 3345 struct semid_ds *buf; 3346 unsigned short *array; 3347 }; 3348 # endif 3349 # ifdef USE_SEMCTL_SEMUN 3350 # ifdef IRIX32_SEMUN_BROKEN_BY_GCC 3351 union gccbug_semun { 3352 int val; 3353 struct semid_ds *buf; 3354 unsigned short *array; 3355 char __dummy[5]; 3356 }; 3357 # define semun gccbug_semun 3358 # endif 3359 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) 3360 # else 3361 # ifdef USE_SEMCTL_SEMID_DS 3362 # ifdef EXTRA_F_IN_SEMUN_BUF 3363 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff) 3364 # else 3365 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf) 3366 # endif 3367 # endif 3368 # endif 3369 #endif 3370 3371 #ifdef I_FCNTL 3372 # include <fcntl.h> 3373 #endif 3374 3375 #ifdef I_SYS_FILE 3376 # include <sys/file.h> 3377 #endif 3378 3379 #ifndef O_RDONLY 3380 /* Assume UNIX defaults */ 3381 # define O_RDONLY 0000 3382 # define O_WRONLY 0001 3383 # define O_RDWR 0002 3384 # define O_CREAT 0100 3385 #endif 3386 3387 #ifndef O_BINARY 3388 # define O_BINARY 0 3389 #endif 3390 3391 #ifndef O_TEXT 3392 # define O_TEXT 0 3393 #endif 3394 3395 #ifdef IAMSUID 3396 3397 #ifdef I_SYS_STATVFS 3398 # include <sys/statvfs.h> /* for f?statvfs() */ 3399 #endif 3400 #ifdef I_SYS_MOUNT 3401 # include <sys/mount.h> /* for *BSD f?statfs() */ 3402 #endif 3403 #ifdef I_MNTENT 3404 # include <mntent.h> /* for getmntent() */ 3405 #endif 3406 #ifdef I_SYS_STATFS 3407 # include <sys/statfs.h> /* for some statfs() */ 3408 #endif 3409 #ifdef I_SYS_VFS 3410 # ifdef __sgi 3411 # define sv IRIX_sv /* kludge: IRIX has an sv of its own */ 3412 # endif 3413 # include <sys/vfs.h> /* for some statfs() */ 3414 # ifdef __sgi 3415 # undef IRIX_sv 3416 # endif 3417 #endif 3418 #ifdef I_USTAT 3419 # include <ustat.h> /* for ustat() */ 3420 #endif 3421 3422 #if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID) 3423 # define PERL_MOUNT_NOSUID MOUNT_NOSUID 3424 #endif 3425 #if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID) 3426 # define PERL_MOUNT_NOSUID MNT_NOSUID 3427 #endif 3428 #if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID) 3429 # define PERL_MOUNT_NOSUID MS_NOSUID 3430 #endif 3431 #if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID) 3432 # define PERL_MOUNT_NOSUID M_NOSUID 3433 #endif 3434 3435 #endif /* IAMSUID */ 3436 3437 #ifdef I_LIBUTIL 3438 # include <libutil.h> /* setproctitle() in some FreeBSDs */ 3439 #endif 3440 3441 #ifndef EXEC_ARGV_CAST 3442 #define EXEC_ARGV_CAST(x) x 3443 #endif 3444 3445 /* and finally... */ 3446 #define PERL_PATCHLEVEL_H_IMPLICIT 3447 #include "patchlevel.h" 3448 #undef PERL_PATCHLEVEL_H_IMPLICIT 3449 3450 /* Mention 3451 3452 NV_PRESERVES_UV 3453 3454 HAS_ICONV 3455 I_ICONV 3456 3457 HAS_MKSTEMP 3458 HAS_MKSTEMPS 3459 HAS_MKDTEMP 3460 3461 HAS_GETCWD 3462 3463 HAS_MMAP 3464 HAS_MPROTECT 3465 HAS_MSYNC 3466 HAS_MADVISE 3467 HAS_MUNMAP 3468 I_SYSMMAN 3469 Mmap_t 3470 3471 NVef 3472 NVff 3473 NVgf 3474 3475 so that Configure picks them up. */ 3476 3477 #endif /* Include guard */ 3478