add ~~x and x~~ overloads, deprecating ~~ overloads
[perl.git] / miniperlmain.c
1 /* -*- buffer-read-only: t -*-
2    !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
3    This file is built by regen/miniperlmain.pl and ExtUtils::Miniperl.
4    Any changes made here will be lost!
5  */
6
7 /*    miniperlmain.c
8  *
9  *    Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
10  *    2004, 2005, 2006, 2007, by Larry Wall and others
11  *
12  *    You may distribute under the terms of either the GNU General Public
13  *    License or the Artistic License, as specified in the README file.
14  *
15  */
16
17 /*
18  *      The Road goes ever on and on
19  *          Down from the door where it began.
20  *
21  *     [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
22  *     [Frodo on p.73 of _The Lord of the Rings_, I/iii: "Three Is Company"]
23  */
24
25 /* This file contains the main() function for the perl interpreter.
26  * Note that miniperlmain.c contains main() for the 'miniperl' binary,
27  * while perlmain.c contains main() for the 'perl' binary.
28  *
29  * Miniperl is like perl except that it does not support dynamic loading,
30  * and in fact is used to build the dynamic modules needed for the 'real'
31  * perl executable.
32  */
33
34 #ifdef OEMVS
35 #ifdef MYMALLOC
36 /* sbrk is limited to first heap segment so make it big */
37 #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
38 #else
39 #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
40 #endif
41 #endif
42
43 #define PERL_IN_MINIPERLMAIN_C
44 #include "EXTERN.h"
45 #include "perl.h"
46 #include "XSUB.h"
47
48 static void xs_init (pTHX);
49 static PerlInterpreter *my_perl;
50
51 #if defined(PERL_GLOBAL_STRUCT_PRIVATE)
52 /* The static struct perl_vars* may seem counterproductive since the
53  * whole idea PERL_GLOBAL_STRUCT_PRIVATE was to avoid statics, but note
54  * that this static is not in the shared perl library, the globals PL_Vars
55  * and PL_VarsPtr will stay away. */
56 static struct perl_vars* my_plvarsp;
57 struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
58 #endif
59
60 #ifdef NO_ENV_ARRAY_IN_MAIN
61 extern char **environ;
62 int
63 main(int argc, char **argv)
64 #else
65 int
66 main(int argc, char **argv, char **env)
67 #endif
68 {
69     int exitstatus, i;
70 #ifdef PERL_GLOBAL_STRUCT
71     struct perl_vars *my_vars = init_global_struct();
72 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
73     int veto;
74
75     my_plvarsp = my_vars;
76 #  endif
77 #endif /* PERL_GLOBAL_STRUCT */
78 #ifndef NO_ENV_ARRAY_IN_MAIN
79     PERL_UNUSED_ARG(env);
80 #endif
81 #ifndef PERL_USE_SAFE_PUTENV
82     PL_use_safe_putenv = FALSE;
83 #endif /* PERL_USE_SAFE_PUTENV */
84
85     /* if user wants control of gprof profiling off by default */
86     /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
87     PERL_GPROF_MONCONTROL(0);
88
89 #ifdef NO_ENV_ARRAY_IN_MAIN
90     PERL_SYS_INIT3(&argc,&argv,&environ);
91 #else
92     PERL_SYS_INIT3(&argc,&argv,&env);
93 #endif
94
95 #if defined(USE_ITHREADS)
96     /* XXX Ideally, this should really be happening in perl_alloc() or
97      * perl_construct() to keep libperl.a transparently fork()-safe.
98      * It is currently done here only because Apache/mod_perl have
99      * problems due to lack of a call to cancel pthread_atfork()
100      * handlers when shared objects that contain the handlers may
101      * be dlclose()d.  This forces applications that embed perl to
102      * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
103      * been called at least once before in the current process.
104      * --GSAR 2001-07-20 */
105     PTHREAD_ATFORK(Perl_atfork_lock,
106                    Perl_atfork_unlock,
107                    Perl_atfork_unlock);
108 #endif
109
110     PERL_SYS_FPU_INIT;
111
112     if (!PL_do_undump) {
113         my_perl = perl_alloc();
114         if (!my_perl)
115             exit(1);
116         perl_construct(my_perl);
117         PL_perl_destruct_level = 0;
118     }
119     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
120     exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
121     if (!exitstatus)
122         perl_run(my_perl);
123
124 #ifndef PERL_MICRO
125     /* Unregister our signal handler before destroying my_perl */
126     for (i = 1; PL_sig_name[i]; i++) {
127         if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) {
128             rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL);
129         }
130     }
131 #endif
132
133     exitstatus = perl_destruct(my_perl);
134
135     perl_free(my_perl);
136
137 #if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN)
138     /*
139      * The old environment may have been freed by perl_free()
140      * when PERL_TRACK_MEMPOOL is defined, but without having
141      * been restored by perl_destruct() before (this is only
142      * done if destruct_level > 0).
143      *
144      * It is important to have a valid environment for atexit()
145      * routines that are eventually called.
146      */
147     environ = env;
148 #endif
149
150     PERL_SYS_TERM();
151
152 #ifdef PERL_GLOBAL_STRUCT
153 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
154     veto = my_plvarsp->Gveto_cleanup;
155 #  endif
156     free_global_struct(my_vars);
157 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
158     if (!veto)
159         my_plvarsp = NULL;
160     /* Remember, functions registered with atexit() can run after this point,
161        and may access "global" variables, and hence end up calling
162        Perl_GetVarsPrivate()  */
163 #endif
164 #endif /* PERL_GLOBAL_STRUCT */
165
166     exit(exitstatus);
167 }
168
169 /* Register any extra external extensions */
170
171
172 static void
173 xs_init(pTHX)
174 {
175     dXSUB_SYS;
176     PERL_UNUSED_CONTEXT;
177 }
178
179 /* ex: set ro: */