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