This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[PATCH 5.004_65] Config_65-02-03.diff: SunOS and Solaris hints
[perl5.git] / perl.h
1 /*    perl.h
2  *
3  *    Copyright (c) 1987-1997, 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 #define OVERLOAD
12
13 #ifdef PERL_FOR_X2P
14 /*
15  * This file is being used for x2p stuff. 
16  * Above symbol is defined via -D in 'x2p/Makefile.SH'
17  * Decouple x2p stuff from some of perls more extreme eccentricities. 
18  */
19 #undef EMBED
20 #undef NO_EMBED
21 #define NO_EMBED
22 #undef MULTIPLICITY
23 #undef USE_STDIO
24 #define USE_STDIO
25 #endif /* PERL_FOR_X2P */
26
27 #define VOIDUSED 1
28 #include "config.h"
29
30 #include "embed.h"
31
32 #undef START_EXTERN_C
33 #undef END_EXTERN_C
34 #undef EXTERN_C
35 #ifdef __cplusplus
36 #  define START_EXTERN_C extern "C" {
37 #  define END_EXTERN_C }
38 #  define EXTERN_C extern "C"
39 #else
40 #  define START_EXTERN_C 
41 #  define END_EXTERN_C 
42 #  define EXTERN_C
43 #endif
44
45 #ifdef OP_IN_REGISTER
46 #  ifdef __GNUC__
47 #    define stringify_immed(s) #s
48 #    define stringify(s) stringify_immed(s)
49 #ifdef EMBED
50 register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
51 #else
52 register struct op *op asm(stringify(OP_IN_REGISTER));
53 #endif
54 #  endif
55 #endif
56
57 /*
58  * STMT_START { statements; } STMT_END;
59  * can be used as a single statement, as in
60  * if (x) STMT_START { ... } STMT_END; else ...
61  *
62  * Trying to select a version that gives no warnings...
63  */
64 #if !(defined(STMT_START) && defined(STMT_END))
65 # if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(__cplusplus)
66 #   define STMT_START   (void)( /* gcc supports ``({ STATEMENTS; })'' */
67 #   define STMT_END     )
68 # else
69    /* Now which other defined()s do we need here ??? */
70 #  if (VOIDFLAGS) && (defined(sun) || defined(__sun__))
71 #   define STMT_START   if (1)
72 #   define STMT_END     else (void)0
73 #  else
74 #   define STMT_START   do
75 #   define STMT_END     while (0)
76 #  endif
77 # endif
78 #endif
79
80 #define NOOP (void)0
81
82 #define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
83
84 /*
85  * SOFT_CAST can be used for args to prototyped functions to retain some
86  * type checking; it only casts if the compiler does not know prototypes.
87  */
88 #if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
89 #define SOFT_CAST(type) 
90 #else
91 #define SOFT_CAST(type) (type)
92 #endif
93
94 #ifndef BYTEORDER  /* Should never happen -- byteorder is in config.h */
95 #   define BYTEORDER 0x1234
96 #endif
97
98 /* Overall memory policy? */
99 #ifndef CONSERVATIVE
100 #   define LIBERAL 1
101 #endif
102
103 /*
104  * The following contortions are brought to you on behalf of all the
105  * standards, semi-standards, de facto standards, not-so-de-facto standards
106  * of the world, as well as all the other botches anyone ever thought of.
107  * The basic theory is that if we work hard enough here, the rest of the
108  * code can be a lot prettier.  Well, so much for theory.  Sorry, Henry...
109  */
110
111 /* define this once if either system, instead of cluttering up the src */
112 #if defined(MSDOS) || defined(atarist) || defined(WIN32)
113 #define DOSISH 1
114 #endif
115
116 #if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
117 # define STANDARD_C 1
118 #endif
119
120 #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX)
121 # define DONT_DECLARE_STD 1
122 #endif
123
124 #if defined(HASVOLATILE) || defined(STANDARD_C)
125 #   ifdef __cplusplus
126 #       define VOL              // to temporarily suppress warnings
127 #   else
128 #       define VOL volatile
129 #   endif
130 #else
131 #   define VOL
132 #endif
133
134 #define TAINT           (tainted = TRUE)
135 #define TAINT_NOT       (tainted = FALSE)
136 #define TAINT_IF(c)     if (c) { tainted = TRUE; }
137 #define TAINT_ENV()     if (tainting) { taint_env(); }
138 #define TAINT_PROPER(s) if (tainting) { taint_proper(no_security, s); }
139
140 /* XXX All process group stuff is handled in pp_sys.c.  Should these 
141    defines move there?  If so, I could simplify this a lot. --AD  9/96.
142 */
143 /* Process group stuff changed from traditional BSD to POSIX.
144    perlfunc.pod documents the traditional BSD-style syntax, so we'll
145    try to preserve that, if possible.
146 */
147 #ifdef HAS_SETPGID
148 #  define BSD_SETPGRP(pid, pgrp)        setpgid((pid), (pgrp))
149 #else
150 #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
151 #    define BSD_SETPGRP(pid, pgrp)      setpgrp((pid), (pgrp))
152 #  else
153 #    ifdef HAS_SETPGRP2  /* DG/UX */
154 #      define BSD_SETPGRP(pid, pgrp)    setpgrp2((pid), (pgrp))
155 #    endif
156 #  endif
157 #endif
158 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
159 #  define HAS_SETPGRP  /* Well, effectively it does . . . */
160 #endif
161
162 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
163     our life easier :-) so we'll try it.
164 */
165 #ifdef HAS_GETPGID
166 #  define BSD_GETPGRP(pid)              getpgid((pid))
167 #else
168 #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
169 #    define BSD_GETPGRP(pid)            getpgrp((pid))
170 #  else
171 #    ifdef HAS_GETPGRP2  /* DG/UX */
172 #      define BSD_GETPGRP(pid)          getpgrp2((pid))
173 #    endif
174 #  endif
175 #endif
176 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
177 #  define HAS_GETPGRP  /* Well, effectively it does . . . */
178 #endif
179
180 /* These are not exact synonyms, since setpgrp() and getpgrp() may 
181    have different behaviors, but perl.h used to define USE_BSDPGRP
182    (prior to 5.003_05) so some extension might depend on it.
183 */
184 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
185 #  ifndef USE_BSDPGRP
186 #    define USE_BSDPGRP
187 #  endif
188 #endif
189
190 #ifndef _TYPES_         /* If types.h defines this it's easy. */
191 #   ifndef major                /* Does everyone's types.h define this? */
192 #       include <sys/types.h>
193 #   endif
194 #endif
195
196 #ifdef __cplusplus
197 #  ifndef I_STDARG
198 #    define I_STDARG 1
199 #  endif
200 #endif
201
202 #ifdef I_STDARG
203 #  include <stdarg.h>
204 #else
205 #  ifdef I_VARARGS
206 #    include <varargs.h>
207 #  endif
208 #endif
209
210 #include "perlio.h"
211 #include "perllio.h"
212 #include "perlsock.h"
213 #include "perlproc.h"
214 #include "perlenv.h"
215 #include "perldir.h"
216
217 #ifdef USE_NEXT_CTYPE
218
219 #if NX_CURRENT_COMPILER_RELEASE >= 400
220 #include <objc/NXCType.h>
221 #else /*  NX_CURRENT_COMPILER_RELEASE < 400 */
222 #include <appkit/NXCType.h>
223 #endif /*  NX_CURRENT_COMPILER_RELEASE >= 400 */
224
225 #else /* !USE_NEXT_CTYPE */
226 #include <ctype.h>
227 #endif /* USE_NEXT_CTYPE */
228
229 #ifdef METHOD   /* Defined by OSF/1 v3.0 by ctype.h */
230 #undef METHOD
231 #endif
232
233 #ifdef I_LOCALE
234 #   include <locale.h>
235 #endif
236
237 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
238 #   define USE_LOCALE
239 #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
240        && defined(HAS_STRXFRM)
241 #       define USE_LOCALE_COLLATE
242 #   endif
243 #   if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE)
244 #       define USE_LOCALE_CTYPE
245 #   endif
246 #   if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
247 #       define USE_LOCALE_NUMERIC
248 #   endif
249 #endif /* !NO_LOCALE && HAS_SETLOCALE */
250
251 #include <setjmp.h>
252
253 #ifdef I_SYS_PARAM
254 #   ifdef PARAM_NEEDS_TYPES
255 #       include <sys/types.h>
256 #   endif
257 #   include <sys/param.h>
258 #endif
259
260
261 /* Use all the "standard" definitions? */
262 #if defined(STANDARD_C) && defined(I_STDLIB)
263 #   include <stdlib.h>
264 #endif
265
266 #define MEM_SIZE Size_t
267
268 /* This comes after <stdlib.h> so we don't try to change the standard
269  * library prototypes; we'll use our own in proto.h instead. */
270
271 #ifdef MYMALLOC
272
273 #   ifdef HIDEMYMALLOC
274 #       define malloc  Mymalloc
275 #       define calloc  Mycalloc
276 #       define realloc Myremalloc
277 #       define free    Myfree
278 Malloc_t Mymalloc _((MEM_SIZE nbytes));
279 Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size));
280 Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes));
281 Free_t   Myfree _((Malloc_t where));
282 #   endif
283 #   ifdef EMBEDMYMALLOC
284 #       define malloc  Perl_malloc
285 #       define calloc  Perl_calloc
286 #       define realloc Perl_realloc
287 #       define free    Perl_free
288 Malloc_t Perl_malloc _((MEM_SIZE nbytes));
289 Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size));
290 Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes));
291 Free_t   Perl_free _((Malloc_t where));
292 #   endif
293
294 #   undef safemalloc
295 #   undef safecalloc
296 #   undef saferealloc
297 #   undef safefree
298 #   define safemalloc  malloc
299 #   define safecalloc  calloc
300 #   define saferealloc realloc
301 #   define safefree    free
302
303 #endif /* MYMALLOC */
304
305 #if defined(STANDARD_C) && defined(I_STDDEF)
306 #   include <stddef.h>
307 #   define STRUCT_OFFSET(s,m)  offsetof(s,m)
308 #else
309 #   define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
310 #endif
311
312 #if defined(I_STRING) || defined(__cplusplus)
313 #   include <string.h>
314 #else
315 #   include <strings.h>
316 #endif
317
318 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
319 #define strchr index
320 #define strrchr rindex
321 #endif
322
323 #ifdef I_MEMORY
324 #  include <memory.h>
325 #endif
326
327 #ifdef HAS_MEMCPY
328 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
329 #    ifndef memcpy
330         extern char * memcpy _((char*, char*, int));
331 #    endif
332 #  endif
333 #else
334 #   ifndef memcpy
335 #       ifdef HAS_BCOPY
336 #           define memcpy(d,s,l) bcopy(s,d,l)
337 #       else
338 #           define memcpy(d,s,l) my_bcopy(s,d,l)
339 #       endif
340 #   endif
341 #endif /* HAS_MEMCPY */
342
343 #ifdef HAS_MEMSET
344 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
345 #    ifndef memset
346         extern char *memset _((char*, int, int));
347 #    endif
348 #  endif
349 #else
350 #  define memset(d,c,l) my_memset(d,c,l)
351 #endif /* HAS_MEMSET */
352
353 #if !defined(HAS_MEMMOVE) && !defined(memmove)
354 #   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
355 #       define memmove(d,s,l) bcopy(s,d,l)
356 #   else
357 #       if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
358 #           define memmove(d,s,l) memcpy(d,s,l)
359 #       else
360 #           define memmove(d,s,l) my_bcopy(s,d,l)
361 #       endif
362 #   endif
363 #endif
364
365 #if defined(mips) && defined(ultrix) && !defined(__STDC__)
366 #   undef HAS_MEMCMP
367 #endif
368
369 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
370 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
371 #    ifndef memcmp
372         extern int memcmp _((char*, char*, int));
373 #    endif
374 #  endif
375 #  ifdef BUGGY_MSC
376   #  pragma function(memcmp)
377 #  endif
378 #else
379 #   ifndef memcmp
380 #       define memcmp   my_memcmp
381 #   endif
382 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
383
384 #ifndef memzero
385 #   ifdef HAS_MEMSET
386 #       define memzero(d,l) memset(d,0,l)
387 #   else
388 #       ifdef HAS_BZERO
389 #           define memzero(d,l) bzero(d,l)
390 #       else
391 #           define memzero(d,l) my_bzero(d,l)
392 #       endif
393 #   endif
394 #endif
395
396 #ifndef HAS_BCMP
397 #   ifndef bcmp
398 #       define bcmp(s1,s2,l) memcmp(s1,s2,l)
399 #   endif
400 #endif /* !HAS_BCMP */
401
402 #ifdef I_NETINET_IN
403 #   include <netinet/in.h>
404 #endif
405
406 #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
407 /* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
408  * (the neo-BSD seem to do this).  */
409 #   undef SF_APPEND
410 #endif
411
412 #ifdef I_SYS_STAT
413 #   include <sys/stat.h>
414 #endif
415
416 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
417    like UTekV) are broken, sometimes giving false positives.  Undefine
418    them here and let the code below set them to proper values.
419
420    The ghs macro stands for GreenHills Software C-1.8.5 which
421    is the C compiler for sysV88 and the various derivatives.
422    This header file bug is corrected in gcc-2.5.8 and later versions.
423    --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94.  */
424
425 #if defined(uts) || (defined(m88k) && defined(ghs))
426 #   undef S_ISDIR
427 #   undef S_ISCHR
428 #   undef S_ISBLK
429 #   undef S_ISREG
430 #   undef S_ISFIFO
431 #   undef S_ISLNK
432 #endif
433
434 #ifdef I_TIME
435 #   include <time.h>
436 #endif
437
438 #ifdef I_SYS_TIME
439 #   ifdef I_SYS_TIME_KERNEL
440 #       define KERNEL
441 #   endif
442 #   include <sys/time.h>
443 #   ifdef I_SYS_TIME_KERNEL
444 #       undef KERNEL
445 #   endif
446 #endif
447
448 #if defined(HAS_TIMES) && defined(I_SYS_TIMES)
449 #    include <sys/times.h>
450 #endif
451
452 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
453 #   undef HAS_STRERROR
454 #endif
455
456 #ifndef HAS_MKFIFO
457 #  ifndef mkfifo
458 #    define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
459 #  endif
460 #endif /* !HAS_MKFIFO */
461
462 #include <errno.h>
463 #ifdef HAS_SOCKET
464 #   ifdef I_NET_ERRNO
465 #     include <net/errno.h>
466 #   endif
467 #endif
468
469 #ifdef VMS
470 #   define SETERRNO(errcode,vmserrcode) \
471         STMT_START {                    \
472             set_errno(errcode);         \
473             set_vaxc_errno(vmserrcode); \
474         } STMT_END
475 #else
476 #   define SETERRNO(errcode,vmserrcode) errno = (errcode)
477 #endif
478
479 #ifdef USE_THREADS
480 #  define ERRSV (thr->errsv)
481 #  define ERRHV (thr->errhv)
482 #  define DEFSV THREADSV(0)
483 #  define SAVE_DEFSV save_threadsv(0)
484 #else
485 #  define ERRSV GvSV(errgv)
486 #  define ERRHV GvHV(errgv)
487 #  define DEFSV GvSV(defgv)
488 #  define SAVE_DEFSV SAVESPTR(GvSV(defgv))
489 #endif /* USE_THREADS */
490
491 #ifndef errno
492         extern int errno;     /* ANSI allows errno to be an lvalue expr */
493 #endif
494
495 #ifdef HAS_STRERROR
496 #       ifdef VMS
497         char *strerror _((int,...));
498 #       else
499 #ifndef DONT_DECLARE_STD
500         char *strerror _((int));
501 #endif
502 #       endif
503 #       ifndef Strerror
504 #           define Strerror strerror
505 #       endif
506 #else
507 #    ifdef HAS_SYS_ERRLIST
508         extern int sys_nerr;
509         extern char *sys_errlist[];
510 #       ifndef Strerror
511 #           define Strerror(e) \
512                 ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
513 #       endif
514 #   endif
515 #endif
516
517 #ifdef I_SYS_IOCTL
518 #   ifndef _IOCTL_
519 #       include <sys/ioctl.h>
520 #   endif
521 #endif
522
523 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
524 #   ifdef HAS_SOCKETPAIR
525 #       undef HAS_SOCKETPAIR
526 #   endif
527 #   ifdef I_NDBM
528 #       undef I_NDBM
529 #   endif
530 #endif
531
532 #if INTSIZE == 2
533 #   define htoni htons
534 #   define ntohi ntohs
535 #else
536 #   define htoni htonl
537 #   define ntohi ntohl
538 #endif
539
540 /* Configure already sets Direntry_t */
541 #if defined(I_DIRENT)
542 #   include <dirent.h>
543 #   if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
544 #       include <sys/dir.h>
545 #   endif
546 #else
547 #   ifdef I_SYS_NDIR
548 #       include <sys/ndir.h>
549 #   else
550 #       ifdef I_SYS_DIR
551 #           ifdef hp9000s500
552 #               include <ndir.h>        /* may be wrong in the future */
553 #           else
554 #               include <sys/dir.h>
555 #           endif
556 #       endif
557 #   endif
558 #endif
559
560 #ifdef FPUTS_BOTCH
561 /* work around botch in SunOS 4.0.1 and 4.0.2 */
562 #   ifndef fputs
563 #       define fputs(sv,fp) fprintf(fp,"%s",sv)
564 #   endif
565 #endif
566
567 /*
568  * The following gobbledygook brought to you on behalf of __STDC__.
569  * (I could just use #ifndef __STDC__, but this is more bulletproof
570  * in the face of half-implementations.)
571  */
572
573 #ifndef S_IFMT
574 #   ifdef _S_IFMT
575 #       define S_IFMT _S_IFMT
576 #   else
577 #       define S_IFMT 0170000
578 #   endif
579 #endif
580
581 #ifndef S_ISDIR
582 #   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
583 #endif
584
585 #ifndef S_ISCHR
586 #   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
587 #endif
588
589 #ifndef S_ISBLK
590 #   ifdef S_IFBLK
591 #       define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
592 #   else
593 #       define S_ISBLK(m) (0)
594 #   endif
595 #endif
596
597 #ifndef S_ISREG
598 #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
599 #endif
600
601 #ifndef S_ISFIFO
602 #   ifdef S_IFIFO
603 #       define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
604 #   else
605 #       define S_ISFIFO(m) (0)
606 #   endif
607 #endif
608
609 #ifndef S_ISLNK
610 #   ifdef _S_ISLNK
611 #       define S_ISLNK(m) _S_ISLNK(m)
612 #   else
613 #       ifdef _S_IFLNK
614 #           define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
615 #       else
616 #           ifdef S_IFLNK
617 #               define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
618 #           else
619 #               define S_ISLNK(m) (0)
620 #           endif
621 #       endif
622 #   endif
623 #endif
624
625 #ifndef S_ISSOCK
626 #   ifdef _S_ISSOCK
627 #       define S_ISSOCK(m) _S_ISSOCK(m)
628 #   else
629 #       ifdef _S_IFSOCK
630 #           define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
631 #       else
632 #           ifdef S_IFSOCK
633 #               define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
634 #           else
635 #               define S_ISSOCK(m) (0)
636 #           endif
637 #       endif
638 #   endif
639 #endif
640
641 #ifndef S_IRUSR
642 #   ifdef S_IREAD
643 #       define S_IRUSR S_IREAD
644 #       define S_IWUSR S_IWRITE
645 #       define S_IXUSR S_IEXEC
646 #   else
647 #       define S_IRUSR 0400
648 #       define S_IWUSR 0200
649 #       define S_IXUSR 0100
650 #   endif
651 #   define S_IRGRP (S_IRUSR>>3)
652 #   define S_IWGRP (S_IWUSR>>3)
653 #   define S_IXGRP (S_IXUSR>>3)
654 #   define S_IROTH (S_IRUSR>>6)
655 #   define S_IWOTH (S_IWUSR>>6)
656 #   define S_IXOTH (S_IXUSR>>6)
657 #endif
658
659 #ifndef S_ISUID
660 #   define S_ISUID 04000
661 #endif
662
663 #ifndef S_ISGID
664 #   define S_ISGID 02000
665 #endif
666
667 #ifdef ff_next
668 #   undef ff_next
669 #endif
670
671 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
672 #   define SLOPPYDIVIDE
673 #endif
674
675 #ifdef UV
676 #undef UV
677 #endif
678
679 /*  XXX QUAD stuff is not currently supported on most systems.
680     Specifically, perl internals don't support long long.  Among
681     the many problems is that some compilers support long long,
682     but the underlying library functions (such as sprintf) don't.
683     Some things do work (such as quad pack/unpack on convex);
684     also some systems use long long for the fpos_t typedef.  That
685     seems to work too.
686
687     The IV type is supposed to be long enough to hold any integral
688     value or a pointer.
689     --Andy Dougherty    August 1996
690 */
691
692 #ifdef cray
693 #   define Quad_t int
694 #else
695 #   ifdef convex
696 #       define Quad_t long long
697 #   else
698 #       if LONGSIZE == 8
699 #           define Quad_t long
700 #       endif
701 #   endif
702 #endif
703
704 /* XXX Experimental set-up for long long.  Just add -DUSE_LONG_LONG
705    to your ccflags.  --Andy Dougherty   4/1998
706 */
707 #ifdef USE_LONG_LONG
708 #  if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
709 #    define Quad_t long long
710 #  endif
711 #endif
712
713 #ifdef Quad_t
714 #   define HAS_QUAD
715     typedef Quad_t IV;
716     typedef unsigned Quad_t UV;
717 #   define IV_MAX PERL_QUAD_MAX
718 #   define IV_MIN PERL_QUAD_MIN
719 #   define UV_MAX PERL_UQUAD_MAX
720 #   define UV_MIN PERL_UQUAD_MIN
721 #else
722     typedef long IV;
723     typedef unsigned long UV;
724 #   define IV_MAX PERL_LONG_MAX
725 #   define IV_MIN PERL_LONG_MIN
726 #   define UV_MAX PERL_ULONG_MAX
727 #   define UV_MIN PERL_ULONG_MIN
728 #endif
729
730 /* Previously these definitions used hardcoded figures. 
731  * It is hoped these formula are more portable, although
732  * no data one way or another is presently known to me.
733  * The "PERL_" names are used because these calculated constants
734  * do not meet the ANSI requirements for LONG_MAX, etc., which
735  * need to be constants acceptable to #if - kja
736  *    define PERL_LONG_MAX        2147483647L
737  *    define PERL_LONG_MIN        (-LONG_MAX - 1)
738  *    define PERL ULONG_MAX       4294967295L
739  */
740
741 #ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
742 #  include <limits.h>
743 #else
744 #ifdef I_VALUES
745 #  include <values.h>
746 #endif
747 #endif
748
749 /*
750  * Try to figure out max and min values for the integral types.  THE CORRECT
751  * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE.  The
752  * following hacks are used if neither limits.h or values.h provide them:
753  * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
754  *              for types <  int:  (unsigned TYPE)~(unsigned)0
755  *      The argument to ~ must be unsigned so that later signed->unsigned
756  *      conversion can't modify the value's bit pattern (e.g. -0 -> +0),
757  *      and it must not be smaller than int because ~ does integral promotion.
758  * <type>_MAX: (<type>) (U<type>_MAX >> 1)
759  * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
760  *      The latter is a hack which happens to work on some machines but
761  *      does *not* catch any random system, or things like integer types
762  *      with NaN if that is possible.
763  *
764  * All of the types are explicitly cast to prevent accidental loss of
765  * numeric range, and in the hope that they will be less likely to confuse
766  * over-eager optimizers.
767  *
768  */
769
770 #define PERL_UCHAR_MIN ((unsigned char)0)
771
772 #ifdef UCHAR_MAX
773 #  define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
774 #else
775 #  ifdef MAXUCHAR
776 #    define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
777 #  else
778 #    define PERL_UCHAR_MAX       ((unsigned char)~(unsigned)0)
779 #  endif
780 #endif
781  
782 /*
783  * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
784  * ambiguous. It may be equivalent to (signed char) or (unsigned char)
785  * depending on local options. Until Configure detects this (or at least
786  * detects whether the "signed" keyword is available) the CHAR ranges
787  * will not be included. UCHAR functions normally.
788  *                                                           - kja
789  */
790
791 #define PERL_USHORT_MIN ((unsigned short)0)
792
793 #ifdef USHORT_MAX
794 #  define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
795 #else
796 #  ifdef MAXUSHORT
797 #    define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
798 #  else
799 #    ifdef USHRT_MAX
800 #      define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
801 #    else
802 #      define PERL_USHORT_MAX       ((unsigned short)~(unsigned)0)
803 #    endif
804 #  endif
805 #endif
806
807 #ifdef SHORT_MAX
808 #  define PERL_SHORT_MAX ((short)SHORT_MAX)
809 #else
810 #  ifdef MAXSHORT    /* Often used in <values.h> */
811 #    define PERL_SHORT_MAX ((short)MAXSHORT)
812 #  else
813 #    ifdef SHRT_MAX
814 #      define PERL_SHORT_MAX ((short)SHRT_MAX)
815 #    else
816 #      define PERL_SHORT_MAX      ((short) (PERL_USHORT_MAX >> 1))
817 #    endif
818 #  endif
819 #endif
820
821 #ifdef SHORT_MIN
822 #  define PERL_SHORT_MIN ((short)SHORT_MIN)
823 #else
824 #  ifdef MINSHORT
825 #    define PERL_SHORT_MIN ((short)MINSHORT)
826 #  else
827 #    ifdef SHRT_MIN
828 #      define PERL_SHORT_MIN ((short)SHRT_MIN)
829 #    else
830 #      define PERL_SHORT_MIN        (-PERL_SHORT_MAX - ((3 & -1) == 3))
831 #    endif
832 #  endif
833 #endif
834
835 #ifdef UINT_MAX
836 #  define PERL_UINT_MAX ((unsigned int)UINT_MAX)
837 #else
838 #  ifdef MAXUINT
839 #    define PERL_UINT_MAX ((unsigned int)MAXUINT)
840 #  else
841 #    define PERL_UINT_MAX       (~(unsigned int)0)
842 #  endif
843 #endif
844
845 #define PERL_UINT_MIN ((unsigned int)0)
846
847 #ifdef INT_MAX
848 #  define PERL_INT_MAX ((int)INT_MAX)
849 #else
850 #  ifdef MAXINT    /* Often used in <values.h> */
851 #    define PERL_INT_MAX ((int)MAXINT)
852 #  else
853 #    define PERL_INT_MAX        ((int)(PERL_UINT_MAX >> 1))
854 #  endif
855 #endif
856
857 #ifdef INT_MIN
858 #  define PERL_INT_MIN ((int)INT_MIN)
859 #else
860 #  ifdef MININT
861 #    define PERL_INT_MIN ((int)MININT)
862 #  else
863 #    define PERL_INT_MIN        (-PERL_INT_MAX - ((3 & -1) == 3))
864 #  endif
865 #endif
866
867 #ifdef ULONG_MAX
868 #  define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
869 #else
870 #  ifdef MAXULONG
871 #    define PERL_ULONG_MAX ((unsigned long)MAXULONG)
872 #  else
873 #    define PERL_ULONG_MAX       (~(unsigned long)0)
874 #  endif
875 #endif
876
877 #define PERL_ULONG_MIN ((unsigned long)0L)
878
879 #ifdef LONG_MAX
880 #  define PERL_LONG_MAX ((long)LONG_MAX)
881 #else
882 #  ifdef MAXLONG    /* Often used in <values.h> */
883 #    define PERL_LONG_MAX ((long)MAXLONG)
884 #  else
885 #    define PERL_LONG_MAX        ((long) (PERL_ULONG_MAX >> 1))
886 #  endif
887 #endif
888
889 #ifdef LONG_MIN
890 #  define PERL_LONG_MIN ((long)LONG_MIN)
891 #else
892 #  ifdef MINLONG
893 #    define PERL_LONG_MIN ((long)MINLONG)
894 #  else
895 #    define PERL_LONG_MIN        (-PERL_LONG_MAX - ((3 & -1) == 3))
896 #  endif
897 #endif
898
899 #ifdef HAS_QUAD
900
901 #  ifdef UQUAD_MAX
902 #    define PERL_UQUAD_MAX ((UV)UQUAD_MAX)
903 #  else
904 #    define PERL_UQUAD_MAX      (~(UV)0)
905 #  endif
906
907 #  define PERL_UQUAD_MIN ((UV)0)
908
909 #  ifdef QUAD_MAX
910 #    define PERL_QUAD_MAX ((IV)QUAD_MAX)
911 #  else
912 #    define PERL_QUAD_MAX       ((IV) (PERL_UQUAD_MAX >> 1))
913 #  endif
914
915 #  ifdef QUAD_MIN
916 #    define PERL_QUAD_MIN ((IV)QUAD_MIN)
917 #  else
918 #    define PERL_QUAD_MIN       (-PERL_QUAD_MAX - ((3 & -1) == 3))
919 #  endif
920
921 #endif
922
923 typedef MEM_SIZE STRLEN;
924
925 typedef struct op OP;
926 typedef struct cop COP;
927 typedef struct unop UNOP;
928 typedef struct binop BINOP;
929 typedef struct listop LISTOP;
930 typedef struct logop LOGOP;
931 typedef struct condop CONDOP;
932 typedef struct pmop PMOP;
933 typedef struct svop SVOP;
934 typedef struct gvop GVOP;
935 typedef struct pvop PVOP;
936 typedef struct loop LOOP;
937
938 typedef struct Outrec Outrec;
939 typedef struct interpreter PerlInterpreter;
940 #ifndef __BORLANDC__
941 typedef struct ff FF;           /* XXX not defined anywhere, should go? */
942 #endif
943 typedef struct sv SV;
944 typedef struct av AV;
945 typedef struct hv HV;
946 typedef struct cv CV;
947 typedef struct regexp REGEXP;
948 typedef struct gp GP;
949 typedef struct gv GV;
950 typedef struct io IO;
951 typedef struct context PERL_CONTEXT;
952 typedef struct block BLOCK;
953
954 typedef struct magic MAGIC;
955 typedef struct xrv XRV;
956 typedef struct xpv XPV;
957 typedef struct xpviv XPVIV;
958 typedef struct xpvuv XPVUV;
959 typedef struct xpvnv XPVNV;
960 typedef struct xpvmg XPVMG;
961 typedef struct xpvlv XPVLV;
962 typedef struct xpvav XPVAV;
963 typedef struct xpvhv XPVHV;
964 typedef struct xpvgv XPVGV;
965 typedef struct xpvcv XPVCV;
966 typedef struct xpvbm XPVBM;
967 typedef struct xpvfm XPVFM;
968 typedef struct xpvio XPVIO;
969 typedef struct mgvtbl MGVTBL;
970 typedef union any ANY;
971
972 #include "handy.h"
973
974 typedef I32 (*filter_t) _((int, SV *, int));
975 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
976 #define FILTER_DATA(idx)           (AvARRAY(rsfp_filters)[idx])
977 #define FILTER_ISREADER(idx)       (idx >= AvFILLp(rsfp_filters))
978
979 #ifdef DOSISH
980 # if defined(OS2)
981 #   include "os2ish.h"
982 # else
983 #   include "dosish.h"
984 # endif
985 #else
986 # if defined(VMS)
987 #   include "vmsish.h"
988 # else
989 #   if defined(PLAN9)
990 #     include "./plan9/plan9ish.h"
991 #   else
992 #     include "unixish.h"
993 #   endif
994 # endif
995 #endif         
996
997 /* 
998  * USE_THREADS needs to be after unixish.h as <pthread.h> includes
999  * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
1000  * this results in many functions being undeclared which bothers C++
1001  * May make sense to have threads after "*ish.h" anyway
1002  */
1003
1004 #ifdef USE_THREADS
1005 #  ifdef FAKE_THREADS
1006 #    include "fakethr.h"
1007 #  else
1008 #    ifdef WIN32
1009 #      include <win32thread.h>
1010 #    else
1011 #      ifdef OS2
1012 #        include "os2thread.h"
1013 #      else
1014 #        include <pthread.h>
1015 typedef pthread_t perl_os_thread;
1016 typedef pthread_mutex_t perl_mutex;
1017 typedef pthread_cond_t perl_cond;
1018 typedef pthread_key_t perl_key;
1019 #      endif /* OS2 */
1020 #    endif /* WIN32 */
1021 #  endif /* FAKE_THREADS */
1022 #endif /* USE_THREADS */
1023
1024
1025   
1026 #ifdef VMS
1027 #   define STATUS_NATIVE        statusvalue_vms
1028 #   define STATUS_NATIVE_EXPORT \
1029         ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms)
1030 #   define STATUS_NATIVE_SET(n)                                         \
1031         STMT_START {                                                    \
1032             statusvalue_vms = (n);                                      \
1033             if ((I32)statusvalue_vms == -1)                             \
1034                 statusvalue = -1;                                       \
1035             else if (statusvalue_vms & STS$M_SUCCESS)                   \
1036                 statusvalue = 0;                                        \
1037             else if ((statusvalue_vms & STS$M_SEVERITY) == 0)           \
1038                 statusvalue = 1 << 8;                                   \
1039             else                                                        \
1040                 statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8;  \
1041         } STMT_END
1042 #   define STATUS_POSIX statusvalue
1043 #   ifdef VMSISH_STATUS
1044 #       define STATUS_CURRENT   (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
1045 #   else
1046 #       define STATUS_CURRENT   STATUS_POSIX
1047 #   endif
1048 #   define STATUS_POSIX_SET(n)                          \
1049         STMT_START {                                    \
1050             statusvalue = (n);                          \
1051             if (statusvalue != -1) {                    \
1052                 statusvalue &= 0xFFFF;                  \
1053                 statusvalue_vms = statusvalue ? 44 : 1; \
1054             }                                           \
1055             else statusvalue_vms = -1;                  \
1056         } STMT_END
1057 #   define STATUS_ALL_SUCCESS   (statusvalue = 0, statusvalue_vms = 1)
1058 #   define STATUS_ALL_FAILURE   (statusvalue = 1, statusvalue_vms = 44)
1059 #else
1060 #   define STATUS_NATIVE        STATUS_POSIX
1061 #   define STATUS_NATIVE_EXPORT STATUS_POSIX
1062 #   define STATUS_NATIVE_SET    STATUS_POSIX_SET
1063 #   define STATUS_POSIX         statusvalue
1064 #   define STATUS_POSIX_SET(n)          \
1065         STMT_START {                    \
1066             statusvalue = (n);          \
1067             if (statusvalue != -1)      \
1068                 statusvalue &= 0xFFFF;  \
1069         } STMT_END
1070 #   define STATUS_CURRENT STATUS_POSIX
1071 #   define STATUS_ALL_SUCCESS   (statusvalue = 0)
1072 #   define STATUS_ALL_FAILURE   (statusvalue = 1)
1073 #endif
1074
1075 /* Some unistd.h's give a prototype for pause() even though
1076    HAS_PAUSE ends up undefined.  This causes the #define
1077    below to be rejected by the compmiler.  Sigh.
1078 */
1079 #ifdef HAS_PAUSE
1080 #define Pause   pause
1081 #else
1082 #define Pause() sleep((32767<<16)+32767)
1083 #endif
1084
1085 #ifndef IOCPARM_LEN
1086 #   ifdef IOCPARM_MASK
1087         /* on BSDish systes we're safe */
1088 #       define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
1089 #   else
1090         /* otherwise guess at what's safe */
1091 #       define IOCPARM_LEN(x)   256
1092 #   endif
1093 #endif
1094
1095 union any {
1096     void*       any_ptr;
1097     I32         any_i32;
1098     IV          any_iv;
1099     long        any_long;
1100     void        (*any_dptr) _((void*));
1101 };
1102
1103 #ifdef USE_THREADS
1104 #define ARGSproto struct perl_thread *thr
1105 #else
1106 #define ARGSproto void
1107 #endif /* USE_THREADS */
1108
1109 /* Work around some cygwin32 problems with importing global symbols */
1110 #if defined(CYGWIN32) && defined(DLLIMPORT) 
1111 #   include "cw32imp.h"
1112 #endif
1113
1114 #include "regexp.h"
1115 #include "sv.h"
1116 #include "util.h"
1117 #include "form.h"
1118 #include "gv.h"
1119 #include "cv.h"
1120 #include "opcode.h"
1121 #include "op.h"
1122 #include "cop.h"
1123 #include "av.h"
1124 #include "hv.h"
1125 #include "mg.h"
1126 #include "scope.h"
1127 #include "bytecode.h"
1128 #include "byterun.h"
1129
1130 /* work around some libPW problems */
1131 #ifdef DOINIT
1132 EXT char Error[1];
1133 #endif
1134
1135 #if defined(iAPX286) || defined(M_I286) || defined(I80286)
1136 #   define I286
1137 #endif
1138
1139 #if defined(htonl) && !defined(HAS_HTONL)
1140 #define HAS_HTONL
1141 #endif
1142 #if defined(htons) && !defined(HAS_HTONS)
1143 #define HAS_HTONS
1144 #endif
1145 #if defined(ntohl) && !defined(HAS_NTOHL)
1146 #define HAS_NTOHL
1147 #endif
1148 #if defined(ntohs) && !defined(HAS_NTOHS)
1149 #define HAS_NTOHS
1150 #endif
1151 #ifndef HAS_HTONL
1152 #if (BYTEORDER & 0xffff) != 0x4321
1153 #define HAS_HTONS
1154 #define HAS_HTONL
1155 #define HAS_NTOHS
1156 #define HAS_NTOHL
1157 #define MYSWAP
1158 #define htons my_swap
1159 #define htonl my_htonl
1160 #define ntohs my_swap
1161 #define ntohl my_ntohl
1162 #endif
1163 #else
1164 #if (BYTEORDER & 0xffff) == 0x4321
1165 #undef HAS_HTONS
1166 #undef HAS_HTONL
1167 #undef HAS_NTOHS
1168 #undef HAS_NTOHL
1169 #endif
1170 #endif
1171
1172 /*
1173  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
1174  * -DWS
1175  */
1176 #if BYTEORDER != 0x1234
1177 # define HAS_VTOHL
1178 # define HAS_VTOHS
1179 # define HAS_HTOVL
1180 # define HAS_HTOVS
1181 # if BYTEORDER == 0x4321
1182 #  define vtohl(x)      ((((x)&0xFF)<<24)       \
1183                         +(((x)>>24)&0xFF)       \
1184                         +(((x)&0x0000FF00)<<8)  \
1185                         +(((x)&0x00FF0000)>>8)  )
1186 #  define vtohs(x)      ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
1187 #  define htovl(x)      vtohl(x)
1188 #  define htovs(x)      vtohs(x)
1189 # endif
1190         /* otherwise default to functions in util.c */
1191 #endif
1192
1193 #ifdef CASTNEGFLOAT
1194 #define U_S(what) ((U16)(what))
1195 #define U_I(what) ((unsigned int)(what))
1196 #define U_L(what) ((U32)(what))
1197 #else
1198 EXTERN_C U32 cast_ulong _((double));
1199 #define U_S(what) ((U16)cast_ulong((double)(what)))
1200 #define U_I(what) ((unsigned int)cast_ulong((double)(what)))
1201 #define U_L(what) (cast_ulong((double)(what)))
1202 #endif
1203
1204 #ifdef CASTI32
1205 #define I_32(what) ((I32)(what))
1206 #define I_V(what) ((IV)(what))
1207 #define U_V(what) ((UV)(what))
1208 #else
1209 START_EXTERN_C
1210 I32 cast_i32 _((double));
1211 IV cast_iv _((double));
1212 UV cast_uv _((double));
1213 END_EXTERN_C
1214 #define I_32(what) (cast_i32((double)(what)))
1215 #define I_V(what) (cast_iv((double)(what)))
1216 #define U_V(what) (cast_uv((double)(what)))
1217 #endif
1218
1219 struct Outrec {
1220     I32         o_lines;
1221     char        *o_str;
1222     U32         o_len;
1223 };
1224
1225 #ifndef MAXSYSFD
1226 #   define MAXSYSFD 2
1227 #endif
1228
1229 #ifndef TMPPATH
1230 #  define TMPPATH "/tmp/perl-eXXXXXX"
1231 #endif
1232
1233 #ifndef __cplusplus
1234 Uid_t getuid _((void));
1235 Uid_t geteuid _((void));
1236 Gid_t getgid _((void));
1237 Gid_t getegid _((void));
1238 #endif
1239
1240 #ifdef DEBUGGING
1241 #ifndef Perl_debug_log
1242 #define Perl_debug_log  PerlIO_stderr()
1243 #endif
1244 #define YYDEBUG 1
1245 #define DEB(a)                          a
1246 #define DEBUG(a)   if (debug)           a
1247 #define DEBUG_p(a) if (debug & 1)       a
1248 #define DEBUG_s(a) if (debug & 2)       a
1249 #define DEBUG_l(a) if (debug & 4)       a
1250 #define DEBUG_t(a) if (debug & 8)       a
1251 #define DEBUG_o(a) if (debug & 16)      a
1252 #define DEBUG_c(a) if (debug & 32)      a
1253 #define DEBUG_P(a) if (debug & 64)      a
1254 #define DEBUG_m(a) if (curinterp && debug & 128)        a
1255 #define DEBUG_f(a) if (debug & 256)     a
1256 #define DEBUG_r(a) if (debug & 512)     a
1257 #define DEBUG_x(a) if (debug & 1024)    a
1258 #define DEBUG_u(a) if (debug & 2048)    a
1259 #define DEBUG_L(a) if (debug & 4096)    a
1260 #define DEBUG_H(a) if (debug & 8192)    a
1261 #define DEBUG_X(a) if (debug & 16384)   a
1262 #define DEBUG_D(a) if (debug & 32768)   a
1263 #else
1264 #define DEB(a)
1265 #define DEBUG(a)
1266 #define DEBUG_p(a)
1267 #define DEBUG_s(a)
1268 #define DEBUG_l(a)
1269 #define DEBUG_t(a)
1270 #define DEBUG_o(a)
1271 #define DEBUG_c(a)
1272 #define DEBUG_P(a)
1273 #define DEBUG_m(a)
1274 #define DEBUG_f(a)
1275 #define DEBUG_r(a)
1276 #define DEBUG_x(a)
1277 #define DEBUG_u(a)
1278 #define DEBUG_L(a)
1279 #define DEBUG_H(a)
1280 #define DEBUG_X(a)
1281 #define DEBUG_D(a)
1282 #endif
1283 #define YYMAXDEPTH 300
1284
1285 #ifndef assert  /* <assert.h> might have been included somehow */
1286 #define assert(what)    DEB( {                                          \
1287         if (!(what)) {                                                  \
1288             croak("Assertion failed: file \"%s\", line %d",             \
1289                 __FILE__, __LINE__);                                    \
1290             PerlProc_exit(1);                                                   \
1291         }})
1292 #endif
1293
1294 struct ufuncs {
1295     I32 (*uf_val)_((IV, SV*));
1296     I32 (*uf_set)_((IV, SV*));
1297     IV uf_index;
1298 };
1299
1300 /* Fix these up for __STDC__ */
1301 #ifndef DONT_DECLARE_STD
1302 char *mktemp _((char*));
1303 double atof _((const char*));
1304 #endif
1305
1306 #ifndef STANDARD_C
1307 /* All of these are in stdlib.h or time.h for ANSI C */
1308 Time_t time();
1309 struct tm *gmtime(), *localtime();
1310 char *strchr(), *strrchr();
1311 char *strcpy(), *strcat();
1312 #endif /* ! STANDARD_C */
1313
1314
1315 #ifdef I_MATH
1316 #    include <math.h>
1317 #else
1318 START_EXTERN_C
1319             double exp _((double));
1320             double log _((double));
1321             double log10 _((double));
1322             double sqrt _((double));
1323             double frexp _((double,int*));
1324             double ldexp _((double,int));
1325             double modf _((double,double*));
1326             double sin _((double));
1327             double cos _((double));
1328             double atan2 _((double,double));
1329             double pow _((double,double));
1330 END_EXTERN_C
1331 #endif
1332
1333 #ifndef __cplusplus
1334 #  ifdef __NeXT__ /* or whatever catches all NeXTs */
1335 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
1336 #  else
1337 #    if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
1338 char *crypt _((const char*, const char*));
1339 #    endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
1340 #  endif /* !__NeXT__ */
1341 #  ifndef DONT_DECLARE_STD
1342 #    ifndef getenv
1343 char *getenv _((const char*));
1344 #    endif /* !getenv */
1345 Off_t lseek _((int,Off_t,int));
1346 #  endif /* !DONT_DECLARE_STD */
1347 char *getlogin _((void));
1348 #endif /* !__cplusplus */
1349
1350 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
1351 #define UNLINK unlnk
1352 I32 unlnk _((char*));
1353 #else
1354 #define UNLINK unlink
1355 #endif
1356
1357 #ifndef HAS_SETREUID
1358 #  ifdef HAS_SETRESUID
1359 #    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
1360 #    define HAS_SETREUID
1361 #  endif
1362 #endif
1363 #ifndef HAS_SETREGID
1364 #  ifdef HAS_SETRESGID
1365 #    define setregid(r,e) setresgid(r,e,(Gid_t)-1)
1366 #    define HAS_SETREGID
1367 #  endif
1368 #endif
1369
1370 typedef Signal_t (*Sighandler_t) _((int));
1371
1372 #ifdef HAS_SIGACTION
1373 typedef struct sigaction Sigsave_t;
1374 #else
1375 typedef Sighandler_t Sigsave_t;
1376 #endif
1377
1378 #define SCAN_DEF 0
1379 #define SCAN_TR 1
1380 #define SCAN_REPL 2
1381
1382 #ifdef DEBUGGING
1383 # ifndef register
1384 #  define register
1385 # endif
1386 # define PAD_SV(po) pad_sv(po)
1387 # define RUNOPS_DEFAULT runops_debug
1388 #else
1389 # define PAD_SV(po) curpad[po]
1390 # define RUNOPS_DEFAULT runops_standard
1391 #endif
1392
1393 #ifdef MYMALLOC
1394 #  define MALLOC_INIT MUTEX_INIT(&malloc_mutex)
1395 #  define MALLOC_TERM MUTEX_DESTROY(&malloc_mutex)
1396 #else
1397 #  define MALLOC_INIT
1398 #  define MALLOC_TERM
1399 #endif
1400
1401
1402 /*
1403  * These need prototyping here because <proto.h> isn't
1404  * included until after runops is initialised.
1405  */
1406
1407 typedef int runops_proc_t _((void));
1408 int runops_standard _((void));
1409 #ifdef DEBUGGING
1410 int runops_debug _((void));
1411 #endif
1412
1413 /* _ (for $_) must be first in the following list (DEFSV requires it) */
1414 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
1415
1416 /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
1417 #if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
1418 #if !defined(DONT_DECLARE_STD) \
1419         || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \
1420         || defined(__sgi) || defined(__DGUX)
1421 extern char **  environ;        /* environment variables supplied via exec */
1422 #endif
1423 #else
1424 #  if defined(NeXT) && defined(__DYNAMIC__)
1425
1426 #  include <mach-o/dyld.h>
1427 EXT char *** environ_pointer;
1428 #  define environ (*environ_pointer)
1429 #  endif
1430 #endif /* environ processing */
1431
1432
1433 /* for tmp use in stupid debuggers */
1434 EXT int *       di;
1435 EXT short *     ds;
1436 EXT char *      dc;
1437
1438 /* handy constants */
1439 EXTCONST char warn_uninit[]
1440   INIT("Use of uninitialized value");
1441 EXTCONST char warn_nosemi[]
1442   INIT("Semicolon seems to be missing");
1443 EXTCONST char warn_reserved[]
1444   INIT("Unquoted string \"%s\" may clash with future reserved word");
1445 EXTCONST char warn_nl[]
1446   INIT("Unsuccessful %s on filename containing newline");
1447 EXTCONST char no_wrongref[]
1448   INIT("Can't use %s ref as %s ref");
1449 EXTCONST char no_symref[]
1450   INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
1451 EXTCONST char no_usym[]
1452   INIT("Can't use an undefined value as %s reference");
1453 EXTCONST char no_aelem[]
1454   INIT("Modification of non-creatable array value attempted, subscript %d");
1455 EXTCONST char no_helem[]
1456   INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
1457 EXTCONST char no_modify[]
1458   INIT("Modification of a read-only value attempted");
1459 EXTCONST char no_mem[]
1460   INIT("Out of memory!\n");
1461 EXTCONST char no_security[]
1462   INIT("Insecure dependency in %s%s");
1463 EXTCONST char no_sock_func[]
1464   INIT("Unsupported socket function \"%s\" called");
1465 EXTCONST char no_dir_func[]
1466   INIT("Unsupported directory function \"%s\" called");
1467 EXTCONST char no_func[]
1468   INIT("The %s function is unimplemented");
1469 EXTCONST char no_myglob[]
1470   INIT("\"my\" variable %s can't be in a package");
1471
1472 #ifdef DOINIT
1473 EXT char *sig_name[] = { SIG_NAME };
1474 EXT int   sig_num[]  = { SIG_NUM };
1475 EXT SV  * psig_ptr[sizeof(sig_num)/sizeof(*sig_num)];
1476 EXT SV  * psig_name[sizeof(sig_num)/sizeof(*sig_num)];
1477 #else
1478 EXT char *sig_name[];
1479 EXT int   sig_num[];
1480 EXT SV  * psig_ptr[];
1481 EXT SV  * psig_name[];
1482 #endif
1483
1484 /* fast case folding tables */
1485
1486 #ifdef DOINIT
1487 EXTCONST  unsigned char fold[] = {
1488         0,      1,      2,      3,      4,      5,      6,      7,
1489         8,      9,      10,     11,     12,     13,     14,     15,
1490         16,     17,     18,     19,     20,     21,     22,     23,
1491         24,     25,     26,     27,     28,     29,     30,     31,
1492         32,     33,     34,     35,     36,     37,     38,     39,
1493         40,     41,     42,     43,     44,     45,     46,     47,
1494         48,     49,     50,     51,     52,     53,     54,     55,
1495         56,     57,     58,     59,     60,     61,     62,     63,
1496         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
1497         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
1498         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
1499         'x',    'y',    'z',    91,     92,     93,     94,     95,
1500         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
1501         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
1502         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
1503         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
1504         128,    129,    130,    131,    132,    133,    134,    135,
1505         136,    137,    138,    139,    140,    141,    142,    143,
1506         144,    145,    146,    147,    148,    149,    150,    151,
1507         152,    153,    154,    155,    156,    157,    158,    159,
1508         160,    161,    162,    163,    164,    165,    166,    167,
1509         168,    169,    170,    171,    172,    173,    174,    175,
1510         176,    177,    178,    179,    180,    181,    182,    183,
1511         184,    185,    186,    187,    188,    189,    190,    191,
1512         192,    193,    194,    195,    196,    197,    198,    199,
1513         200,    201,    202,    203,    204,    205,    206,    207,
1514         208,    209,    210,    211,    212,    213,    214,    215,
1515         216,    217,    218,    219,    220,    221,    222,    223,    
1516         224,    225,    226,    227,    228,    229,    230,    231,
1517         232,    233,    234,    235,    236,    237,    238,    239,
1518         240,    241,    242,    243,    244,    245,    246,    247,
1519         248,    249,    250,    251,    252,    253,    254,    255
1520 };
1521 #else
1522 EXTCONST unsigned char fold[];
1523 #endif
1524
1525 #ifdef DOINIT
1526 EXT unsigned char fold_locale[] = {
1527         0,      1,      2,      3,      4,      5,      6,      7,
1528         8,      9,      10,     11,     12,     13,     14,     15,
1529         16,     17,     18,     19,     20,     21,     22,     23,
1530         24,     25,     26,     27,     28,     29,     30,     31,
1531         32,     33,     34,     35,     36,     37,     38,     39,
1532         40,     41,     42,     43,     44,     45,     46,     47,
1533         48,     49,     50,     51,     52,     53,     54,     55,
1534         56,     57,     58,     59,     60,     61,     62,     63,
1535         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
1536         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
1537         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
1538         'x',    'y',    'z',    91,     92,     93,     94,     95,
1539         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
1540         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
1541         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
1542         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
1543         128,    129,    130,    131,    132,    133,    134,    135,
1544         136,    137,    138,    139,    140,    141,    142,    143,
1545         144,    145,    146,    147,    148,    149,    150,    151,
1546         152,    153,    154,    155,    156,    157,    158,    159,
1547         160,    161,    162,    163,    164,    165,    166,    167,
1548         168,    169,    170,    171,    172,    173,    174,    175,
1549         176,    177,    178,    179,    180,    181,    182,    183,
1550         184,    185,    186,    187,    188,    189,    190,    191,
1551         192,    193,    194,    195,    196,    197,    198,    199,
1552         200,    201,    202,    203,    204,    205,    206,    207,
1553         208,    209,    210,    211,    212,    213,    214,    215,
1554         216,    217,    218,    219,    220,    221,    222,    223,    
1555         224,    225,    226,    227,    228,    229,    230,    231,
1556         232,    233,    234,    235,    236,    237,    238,    239,
1557         240,    241,    242,    243,    244,    245,    246,    247,
1558         248,    249,    250,    251,    252,    253,    254,    255
1559 };
1560 #else
1561 EXT unsigned char fold_locale[];
1562 #endif
1563
1564 #ifdef DOINIT
1565 EXTCONST unsigned char freq[] = {       /* letter frequencies for mixed English/C */
1566         1,      2,      84,     151,    154,    155,    156,    157,
1567         165,    246,    250,    3,      158,    7,      18,     29,
1568         40,     51,     62,     73,     85,     96,     107,    118,
1569         129,    140,    147,    148,    149,    150,    152,    153,
1570         255,    182,    224,    205,    174,    176,    180,    217,
1571         233,    232,    236,    187,    235,    228,    234,    226,
1572         222,    219,    211,    195,    188,    193,    185,    184,
1573         191,    183,    201,    229,    181,    220,    194,    162,
1574         163,    208,    186,    202,    200,    218,    198,    179,
1575         178,    214,    166,    170,    207,    199,    209,    206,
1576         204,    160,    212,    216,    215,    192,    175,    173,
1577         243,    172,    161,    190,    203,    189,    164,    230,
1578         167,    248,    227,    244,    242,    255,    241,    231,
1579         240,    253,    169,    210,    245,    237,    249,    247,
1580         239,    168,    252,    251,    254,    238,    223,    221,
1581         213,    225,    177,    197,    171,    196,    159,    4,
1582         5,      6,      8,      9,      10,     11,     12,     13,
1583         14,     15,     16,     17,     19,     20,     21,     22,
1584         23,     24,     25,     26,     27,     28,     30,     31,
1585         32,     33,     34,     35,     36,     37,     38,     39,
1586         41,     42,     43,     44,     45,     46,     47,     48,
1587         49,     50,     52,     53,     54,     55,     56,     57,
1588         58,     59,     60,     61,     63,     64,     65,     66,
1589         67,     68,     69,     70,     71,     72,     74,     75,
1590         76,     77,     78,     79,     80,     81,     82,     83,
1591         86,     87,     88,     89,     90,     91,     92,     93,
1592         94,     95,     97,     98,     99,     100,    101,    102,
1593         103,    104,    105,    106,    108,    109,    110,    111,
1594         112,    113,    114,    115,    116,    117,    119,    120,
1595         121,    122,    123,    124,    125,    126,    127,    128,
1596         130,    131,    132,    133,    134,    135,    136,    137,
1597         138,    139,    141,    142,    143,    144,    145,    146
1598 };
1599 #else
1600 EXTCONST unsigned char freq[];
1601 #endif
1602
1603 #ifdef DEBUGGING
1604 #ifdef DOINIT
1605 EXTCONST char* block_type[] = {
1606         "NULL",
1607         "SUB",
1608         "EVAL",
1609         "LOOP",
1610         "SUBST",
1611         "BLOCK",
1612 };
1613 #else
1614 EXTCONST char* block_type[];
1615 #endif
1616 #endif
1617
1618 /*****************************************************************************/
1619 /* This lexer/parser stuff is currently global since yacc is hard to reenter */
1620 /*****************************************************************************/
1621 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
1622
1623 #include "perly.h"
1624
1625 #define LEX_NOTPARSING          11      /* borrowed from toke.c */
1626
1627 typedef enum {
1628     XOPERATOR,
1629     XTERM,
1630     XREF,
1631     XSTATE,
1632     XBLOCK,
1633     XTERMBLOCK
1634 } expectation;
1635
1636
1637                                 /* Note: the lowest 8 bits are reserved for
1638                                    stuffing into op->op_private */
1639 #define HINT_INTEGER            0x00000001
1640 #define HINT_STRICT_REFS        0x00000002
1641
1642 #define HINT_BLOCK_SCOPE        0x00000100
1643 #define HINT_STRICT_SUBS        0x00000200
1644 #define HINT_STRICT_VARS        0x00000400
1645 #define HINT_LOCALE             0x00000800
1646
1647 /* Various states of an input record separator SV (rs, nrs) */
1648 #define RsSNARF(sv)   (! SvOK(sv))
1649 #define RsSIMPLE(sv)  (SvOK(sv) && SvCUR(sv))
1650 #define RsPARA(sv)    (SvOK(sv) && ! SvCUR(sv))
1651
1652 /* Set up PERLVAR macros for populating structs */
1653 #define PERLVAR(var,type) type var;
1654 #define PERLVARI(var,type,init) type var;
1655 #define PERLVARIC(var,type,init) type var;
1656
1657 /* Interpreter exitlist entry */
1658 typedef struct exitlistentry {
1659     void (*fn) _((void*));
1660     void *ptr;
1661 } PerlExitListEntry;
1662
1663 #ifdef PERL_GLOBAL_STRUCT
1664 struct perl_vars {
1665 #include "perlvars.h"
1666 };
1667
1668 #ifdef PERL_CORE
1669 EXT struct perl_vars Perl_Vars;
1670 EXT struct perl_vars *Perl_VarsPtr INIT(&Perl_Vars);
1671 #else
1672 #if !defined(__GNUC__) || !defined(WIN32)
1673 EXT
1674 #endif
1675 struct perl_vars *Perl_VarsPtr;
1676 #define Perl_Vars (*((Perl_VarsPtr) ? Perl_VarsPtr : (Perl_VarsPtr =  Perl_GetVars())))
1677 #endif
1678 #endif /* PERL_GLOBAL_STRUCT */
1679
1680 #ifdef MULTIPLICITY
1681 /* If we have multiple interpreters define a struct 
1682    holding variables which must be per-interpreter
1683    If we don't have threads anything that would have 
1684    be per-thread is per-interpreter.
1685 */
1686
1687 struct interpreter {
1688 #ifndef USE_THREADS
1689 #include "thrdvar.h"
1690 #endif
1691 #include "intrpvar.h"
1692 };
1693
1694 #else
1695 struct interpreter {
1696     char broiled;
1697 };
1698 #endif
1699
1700 #ifdef USE_THREADS
1701 /* If we have threads define a struct with all the variables
1702  * that have to be per-thread
1703  */
1704
1705
1706 struct perl_thread {
1707 #include "thrdvar.h"
1708 };
1709
1710 typedef struct perl_thread *Thread;
1711
1712 #else
1713 typedef void *Thread;
1714 #endif
1715
1716 /* Done with PERLVAR macros for now ... */
1717 #undef PERLVAR
1718 #undef PERLVARI
1719 #undef PERLVARIC
1720
1721 #include "thread.h"
1722 #include "pp.h"
1723 #include "proto.h"
1724
1725 #ifdef EMBED
1726 #define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr)
1727 #define Perl_sv_setptrref(rv,ptr) Perl_sv_setref_iv(rv,Nullch,(IV)ptr)
1728 #else
1729 #define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
1730 #define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
1731 #endif
1732
1733 /* The following must follow proto.h as #defines mess up syntax */
1734
1735 #include "embedvar.h"
1736
1737 /* Now include all the 'global' variables 
1738  * If we don't have threads or multiple interpreters
1739  * these include variables that would have been their struct-s 
1740  */
1741
1742 #define PERLVAR(var,type) EXT type var;
1743 #define PERLVARI(var,type,init) EXT type var INIT(init);
1744 #define PERLVARIC(var,type,init) EXTCONST type var INIT(init);
1745
1746 #ifndef PERL_GLOBAL_STRUCT
1747 #include "perlvars.h"
1748 #endif
1749
1750 #ifndef MULTIPLICITY
1751
1752 #ifndef USE_THREADS
1753 #include "thrdvar.h"
1754 #endif
1755
1756 #include "intrpvar.h"
1757 #endif
1758
1759
1760 #undef PERLVAR
1761 #undef PERLVARI
1762 #undef PERLVARIC
1763
1764 #if defined(HASATTRIBUTE) && defined(WIN32)
1765 /*
1766  * This provides a layer of functions and macros to ensure extensions will
1767  * get to use the same RTL functions as the core.
1768  * It has to go here or #define of printf messes up __attribute__
1769  * stuff in proto.h  
1770  */
1771 #  include <win32iop.h>
1772 #endif  /* WIN32 */
1773
1774 #ifdef DOINIT
1775
1776 EXT MGVTBL vtbl_sv =    {magic_get,
1777                                 magic_set,
1778                                         magic_len,
1779                                                 0,      0};
1780 EXT MGVTBL vtbl_env =   {0,     magic_set_all_env,
1781                                 0,      magic_clear_all_env,
1782                                                         0};
1783 EXT MGVTBL vtbl_envelem =       {0,     magic_setenv,
1784                                         0,      magic_clearenv,
1785                                                         0};
1786 EXT MGVTBL vtbl_sig =   {0,     0,               0, 0, 0};
1787 EXT MGVTBL vtbl_sigelem =       {magic_getsig,
1788                                         magic_setsig,
1789                                         0,      magic_clearsig,
1790                                                         0};
1791 EXT MGVTBL vtbl_pack =  {0,     0,      magic_sizepack, magic_wipepack,
1792                                                         0};
1793 EXT MGVTBL vtbl_packelem =      {magic_getpack,
1794                                 magic_setpack,
1795                                         0,      magic_clearpack,
1796                                                         0};
1797 EXT MGVTBL vtbl_dbline =        {0,     magic_setdbline,
1798                                         0,      0,      0};
1799 EXT MGVTBL vtbl_isa =   {0,     magic_setisa,
1800                                         0,      magic_setisa,
1801                                                         0};
1802 EXT MGVTBL vtbl_isaelem =       {0,     magic_setisa,
1803                                         0,      0,      0};
1804 EXT MGVTBL vtbl_arylen =        {magic_getarylen,
1805                                 magic_setarylen,
1806                                         0,      0,      0};
1807 EXT MGVTBL vtbl_glob =  {magic_getglob,
1808                                 magic_setglob,
1809                                         0,      0,      0};
1810 EXT MGVTBL vtbl_mglob = {0,     magic_setmglob,
1811                                         0,      0,      0};
1812 EXT MGVTBL vtbl_nkeys = {magic_getnkeys,
1813                                 magic_setnkeys,
1814                                         0,      0,      0};
1815 EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint,
1816                                         0,      0,      0};
1817 EXT MGVTBL vtbl_substr =        {magic_getsubstr, magic_setsubstr,
1818                                         0,      0,      0};
1819 EXT MGVTBL vtbl_vec =   {magic_getvec,
1820                                 magic_setvec,
1821                                         0,      0,      0};
1822 EXT MGVTBL vtbl_pos =   {magic_getpos,
1823                                 magic_setpos,
1824                                         0,      0,      0};
1825 EXT MGVTBL vtbl_bm =    {0,     magic_setbm,
1826                                         0,      0,      0};
1827 EXT MGVTBL vtbl_fm =    {0,     magic_setfm,
1828                                         0,      0,      0};
1829 EXT MGVTBL vtbl_uvar =  {magic_getuvar,
1830                                 magic_setuvar,
1831                                         0,      0,      0};
1832 #ifdef USE_THREADS
1833 EXT MGVTBL vtbl_mutex = {0,     0,      0,      0,      magic_mutexfree};
1834 #endif /* USE_THREADS */
1835 EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
1836                                         0,      0,      magic_freedefelem};
1837
1838 EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp};
1839
1840 #ifdef USE_LOCALE_COLLATE
1841 EXT MGVTBL vtbl_collxfrm = {0,
1842                                 magic_setcollxfrm,
1843                                         0,      0,      0};
1844 #endif
1845
1846 #ifdef OVERLOAD
1847 EXT MGVTBL vtbl_amagic =       {0,     magic_setamagic,
1848                                         0,      0,      magic_setamagic};
1849 EXT MGVTBL vtbl_amagicelem =   {0,     magic_setamagic,
1850                                         0,      0,      magic_setamagic};
1851 #endif /* OVERLOAD */
1852
1853 #else /* !DOINIT */
1854
1855 EXT MGVTBL vtbl_sv;
1856 EXT MGVTBL vtbl_env;
1857 EXT MGVTBL vtbl_envelem;
1858 EXT MGVTBL vtbl_sig;
1859 EXT MGVTBL vtbl_sigelem;
1860 EXT MGVTBL vtbl_pack;
1861 EXT MGVTBL vtbl_packelem;
1862 EXT MGVTBL vtbl_dbline;
1863 EXT MGVTBL vtbl_isa;
1864 EXT MGVTBL vtbl_isaelem;
1865 EXT MGVTBL vtbl_arylen;
1866 EXT MGVTBL vtbl_glob;
1867 EXT MGVTBL vtbl_mglob;
1868 EXT MGVTBL vtbl_nkeys;
1869 EXT MGVTBL vtbl_taint;
1870 EXT MGVTBL vtbl_substr;
1871 EXT MGVTBL vtbl_vec;
1872 EXT MGVTBL vtbl_pos;
1873 EXT MGVTBL vtbl_bm;
1874 EXT MGVTBL vtbl_fm;
1875 EXT MGVTBL vtbl_uvar;
1876
1877 #ifdef USE_THREADS
1878 EXT MGVTBL vtbl_mutex;
1879 #endif /* USE_THREADS */
1880
1881 EXT MGVTBL vtbl_defelem;
1882 EXT MGVTBL vtbl_regexp;
1883
1884 #ifdef USE_LOCALE_COLLATE
1885 EXT MGVTBL vtbl_collxfrm;
1886 #endif
1887
1888 #ifdef OVERLOAD
1889 EXT MGVTBL vtbl_amagic;
1890 EXT MGVTBL vtbl_amagicelem;
1891 #endif /* OVERLOAD */
1892
1893 #endif /* !DOINIT */
1894
1895 #ifdef OVERLOAD
1896
1897 #define NofAMmeth 58
1898 #ifdef DOINIT
1899 EXTCONST char * AMG_names[NofAMmeth] = {
1900   "fallback",   "abs",                  /* "fallback" should be the first. */
1901   "bool",       "nomethod",
1902   "\"\"",       "0+",
1903   "+",          "+=",
1904   "-",          "-=",
1905   "*",          "*=",
1906   "/",          "/=",
1907   "%",          "%=",
1908   "**",         "**=",
1909   "<<",         "<<=",
1910   ">>",         ">>=",
1911   "&",          "&=",
1912   "|",          "|=",
1913   "^",          "^=",
1914   "<",          "<=",
1915   ">",          ">=",
1916   "==",         "!=",
1917   "<=>",        "cmp",
1918   "lt",         "le",
1919   "gt",         "ge",
1920   "eq",         "ne",
1921   "!",          "~",
1922   "++",         "--",
1923   "atan2",      "cos",
1924   "sin",        "exp",
1925   "log",        "sqrt",
1926   "x",          "x=",
1927   ".",          ".=",
1928   "=",          "neg"
1929 };
1930 #else
1931 EXTCONST char * AMG_names[NofAMmeth];
1932 #endif /* def INITAMAGIC */
1933
1934 struct am_table {
1935   long was_ok_sub;
1936   long was_ok_am;
1937   U32 flags;
1938   CV* table[NofAMmeth];
1939   long fallback;
1940 };
1941 struct am_table_short {
1942   long was_ok_sub;
1943   long was_ok_am;
1944   U32 flags;
1945 };
1946 typedef struct am_table AMT;
1947 typedef struct am_table_short AMTS;
1948
1949 #define AMGfallNEVER    1
1950 #define AMGfallNO       2
1951 #define AMGfallYES      3
1952
1953 #define AMTf_AMAGIC             1
1954 #define AMT_AMAGIC(amt)         ((amt)->flags & AMTf_AMAGIC)
1955 #define AMT_AMAGIC_on(amt)      ((amt)->flags |= AMTf_AMAGIC)
1956 #define AMT_AMAGIC_off(amt)     ((amt)->flags &= ~AMTf_AMAGIC)
1957
1958 enum {
1959   fallback_amg, abs_amg,
1960   bool__amg,    nomethod_amg,
1961   string_amg,   numer_amg,
1962   add_amg,      add_ass_amg,
1963   subtr_amg,    subtr_ass_amg,
1964   mult_amg,     mult_ass_amg,
1965   div_amg,      div_ass_amg,
1966   mod_amg,      mod_ass_amg,
1967   pow_amg,      pow_ass_amg,
1968   lshift_amg,   lshift_ass_amg,
1969   rshift_amg,   rshift_ass_amg,
1970   band_amg,     band_ass_amg,
1971   bor_amg,      bor_ass_amg,
1972   bxor_amg,     bxor_ass_amg,
1973   lt_amg,       le_amg,
1974   gt_amg,       ge_amg,
1975   eq_amg,       ne_amg,
1976   ncmp_amg,     scmp_amg,
1977   slt_amg,      sle_amg,
1978   sgt_amg,      sge_amg,
1979   seq_amg,      sne_amg,
1980   not_amg,      compl_amg,
1981   inc_amg,      dec_amg,
1982   atan2_amg,    cos_amg,
1983   sin_amg,      exp_amg,
1984   log_amg,      sqrt_amg,
1985   repeat_amg,   repeat_ass_amg,
1986   concat_amg,   concat_ass_amg,
1987   copy_amg,     neg_amg
1988 };
1989
1990 /*
1991  * some compilers like to redefine cos et alia as faster
1992  * (and less accurate?) versions called F_cos et cetera (Quidquid
1993  * latine dictum sit, altum viditur.)  This trick collides with
1994  * the Perl overloading (amg).  The following #defines fool both.
1995  */
1996
1997 #ifdef _FASTMATH
1998 #   ifdef atan2
1999 #       define F_atan2_amg  atan2_amg
2000 #   endif
2001 #   ifdef cos
2002 #       define F_cos_amg    cos_amg
2003 #   endif
2004 #   ifdef exp
2005 #       define F_exp_amg    exp_amg
2006 #   endif
2007 #   ifdef log
2008 #       define F_log_amg    log_amg
2009 #   endif
2010 #   ifdef pow
2011 #       define F_pow_amg    pow_amg
2012 #   endif
2013 #   ifdef sin
2014 #       define F_sin_amg    sin_amg
2015 #   endif
2016 #   ifdef sqrt
2017 #       define F_sqrt_amg   sqrt_amg
2018 #   endif
2019 #endif /* _FASTMATH */
2020
2021 #endif /* OVERLOAD */
2022
2023 #define PERLDB_ALL      0x3f            /* No _NONAME, _GOTO */
2024 #define PERLDBf_SUB     0x01            /* Debug sub enter/exit. */
2025 #define PERLDBf_LINE    0x02            /* Keep line #. */
2026 #define PERLDBf_NOOPT   0x04            /* Switch off optimizations. */
2027 #define PERLDBf_INTER   0x08            /* Preserve more data for
2028                                            later inspections.  */
2029 #define PERLDBf_SUBLINE 0x10            /* Keep subr source lines. */
2030 #define PERLDBf_SINGLE  0x20            /* Start with single-step on. */
2031 #define PERLDBf_NONAME  0x40            /* For _SUB: no name of the subr. */
2032 #define PERLDBf_GOTO    0x80            /* Report goto: call DB::goto. */
2033
2034 #define PERLDB_SUB      (perldb && (perldb & PERLDBf_SUB))
2035 #define PERLDB_LINE     (perldb && (perldb & PERLDBf_LINE))
2036 #define PERLDB_NOOPT    (perldb && (perldb & PERLDBf_NOOPT))
2037 #define PERLDB_INTER    (perldb && (perldb & PERLDBf_INTER))
2038 #define PERLDB_SUBLINE  (perldb && (perldb & PERLDBf_SUBLINE))
2039 #define PERLDB_SINGLE   (perldb && (perldb & PERLDBf_SINGLE))
2040 #define PERLDB_SUB_NN   (perldb && (perldb & (PERLDBf_NONAME)))
2041 #define PERLDB_GOTO     (perldb && (perldb & PERLDBf_GOTO))
2042
2043
2044 #ifdef USE_LOCALE_NUMERIC
2045
2046 #define SET_NUMERIC_STANDARD() \
2047     STMT_START {                                \
2048         if (! numeric_standard)                 \
2049             perl_set_numeric_standard();        \
2050     } STMT_END
2051
2052 #define SET_NUMERIC_LOCAL() \
2053     STMT_START {                                \
2054         if (! numeric_local)                    \
2055             perl_set_numeric_local();           \
2056     } STMT_END
2057
2058 #else /* !USE_LOCALE_NUMERIC */
2059
2060 #define SET_NUMERIC_STANDARD()  /**/
2061 #define SET_NUMERIC_LOCAL()     /**/
2062
2063 #endif /* !USE_LOCALE_NUMERIC */
2064
2065 #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
2066 /* 
2067  * Now we have __attribute__ out of the way 
2068  * Remap printf 
2069  */
2070 #define printf PerlIO_stdoutf
2071 #endif
2072
2073 #ifndef PERL_SCRIPT_MODE
2074 #define PERL_SCRIPT_MODE "r"
2075 #endif
2076
2077 /*
2078  * nice_chunk and nice_chunk size need to be set
2079  * and queried under the protection of sv_mutex
2080  */
2081 #define offer_nice_chunk(chunk, chunk_size) do {        \
2082         LOCK_SV_MUTEX;                                  \
2083         if (!nice_chunk) {                              \
2084             nice_chunk = (char*)(chunk);                \
2085             nice_chunk_size = (chunk_size);             \
2086         }                                               \
2087         else {                                          \
2088             Safefree(chunk);                            \
2089         }                                               \
2090         UNLOCK_SV_MUTEX;                                \
2091     } while (0)
2092
2093 #ifdef HAS_SEM
2094 #   include <sys/ipc.h>
2095 #   include <sys/sem.h>
2096 #   ifndef HAS_UNION_SEMUN      /* Provide the union semun. */
2097     union semun {
2098         int val;
2099         struct semid_ds *buf;
2100         unsigned short *array;
2101     };
2102 #   endif
2103 #   ifdef USE_SEMCTL_SEMUN
2104 #       define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
2105 #   else
2106 #       ifdef USE_SEMCTL_SEMID_DS
2107 #           define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
2108 #       endif
2109 #   endif
2110 #   ifndef Semctl       /* Place our bets on the semun horse. */
2111 #       define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
2112 #   endif
2113 #endif
2114
2115 #endif /* Include guard */