miniperlmain.c 5.11 KB
Newer Older
1 2 3 4 5 6
/* -*- buffer-read-only: t -*-
   !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
   This file is built by regen/miniperlmain.pl and ExtUtils::Miniperl.
   Any changes made here will be lost!
 */

7 8
/*    miniperlmain.c
 *
9
 *    Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
10
 *    2004, 2005, 2006, 2007, by Larry Wall and others
11 12 13 14 15 16
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 *
 */

17
/*
18 19 20 21 22
 *      The Road goes ever on and on
 *          Down from the door where it began.
 *
 *     [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
 *     [Frodo on p.73 of _The Lord of the Rings_, I/iii: "Three Is Company"]
23 24
 */

25 26 27 28 29 30 31 32 33
/* This file contains the main() function for the perl interpreter.
 * Note that miniperlmain.c contains main() for the 'miniperl' binary,
 * while perlmain.c contains main() for the 'perl' binary.
 *
 * Miniperl is like perl except that it does not support dynamic loading,
 * and in fact is used to build the dynamic modules needed for the 'real'
 * perl executable.
 */

34
#ifdef OEMVS
35
#ifdef MYMALLOC
36
/* sbrk is limited to first heap segment so make it big */
37 38 39 40
#pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
#else
#pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
#endif
41 42 43
#endif

#define PERL_IN_MINIPERLMAIN_C
44
#include "EXTERN.h"
45
#include "perl.h"
46
#include "XSUB.h"
47 48 49 50

static void xs_init (pTHX);
static PerlInterpreter *my_perl;

51 52 53 54 55 56 57 58 59 60 61 62 63 64
#if defined(PERL_GLOBAL_STRUCT_PRIVATE)
/* The static struct perl_vars* may seem counterproductive since the
 * whole idea PERL_GLOBAL_STRUCT_PRIVATE was to avoid statics, but note
 * that this static is not in the shared perl library, the globals PL_Vars
 * and PL_VarsPtr will stay away. */
static struct perl_vars* my_plvarsp;
struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
#endif

#ifdef NO_ENV_ARRAY_IN_MAIN
extern char **environ;
int
main(int argc, char **argv)
#else
65 66
int
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 74
    int veto;

75
    my_plvarsp = my_vars;
76 77
#  endif
#endif /* PERL_GLOBAL_STRUCT */
78 79 80
#ifndef NO_ENV_ARRAY_IN_MAIN
    PERL_UNUSED_ARG(env);
#endif
81
#ifndef PERL_USE_SAFE_PUTENV
82
    PL_use_safe_putenv = FALSE;
83
#endif /* PERL_USE_SAFE_PUTENV */
84

85 86 87 88
    /* if user wants control of gprof profiling off by default */
    /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
    PERL_GPROF_MONCONTROL(0);

89 90 91
#ifdef NO_ENV_ARRAY_IN_MAIN
    PERL_SYS_INIT3(&argc,&argv,&environ);
#else
92
    PERL_SYS_INIT3(&argc,&argv,&env);
93
#endif
94

95
#if defined(USE_ITHREADS)
96 97 98 99 100 101 102 103 104 105 106 107 108 109
    /* XXX Ideally, this should really be happening in perl_alloc() or
     * perl_construct() to keep libperl.a transparently fork()-safe.
     * It is currently done here only because Apache/mod_perl have
     * problems due to lack of a call to cancel pthread_atfork()
     * handlers when shared objects that contain the handlers may
     * be dlclose()d.  This forces applications that embed perl to
     * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
     * been called at least once before in the current process.
     * --GSAR 2001-07-20 */
    PTHREAD_ATFORK(Perl_atfork_lock,
                   Perl_atfork_unlock,
                   Perl_atfork_unlock);
#endif

110 111 112 113 114 115 116
    if (!PL_do_undump) {
	my_perl = perl_alloc();
	if (!my_perl)
	    exit(1);
	perl_construct(my_perl);
	PL_perl_destruct_level = 0;
    }
117
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
118
    exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
119 120
    if (!exitstatus)
        perl_run(my_perl);
121

122
#ifndef PERL_MICRO
123
    /* Unregister our signal handler before destroying my_perl */
124
    for (i = 1; PL_sig_name[i]; i++) {
125 126 127 128
	if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) {
	    rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL);
	}
    }
129
#endif
130

131
    exitstatus = perl_destruct(my_perl);
132 133 134

    perl_free(my_perl);

135 136 137 138 139 140 141 142 143 144 145 146 147
#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN)
    /*
     * The old environment may have been freed by perl_free()
     * when PERL_TRACK_MEMPOOL is defined, but without having
     * been restored by perl_destruct() before (this is only
     * done if destruct_level > 0).
     *
     * It is important to have a valid environment for atexit()
     * routines that are eventually called.
     */
    environ = env;
#endif

148 149
    PERL_SYS_TERM();

150
#ifdef PERL_GLOBAL_STRUCT
151 152 153
#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
    veto = my_plvarsp->Gveto_cleanup;
#  endif
154 155
    free_global_struct(my_vars);
#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
156 157
    if (!veto)
        my_plvarsp = NULL;
158 159 160 161
    /* Remember, functions registered with atexit() can run after this point,
       and may access "global" variables, and hence end up calling
       Perl_GetVarsPrivate()  */
#endif
162 163
#endif /* PERL_GLOBAL_STRUCT */

164 165 166 167 168 169 170 171 172 173 174
    exit(exitstatus);
    return exitstatus;
}

/* Register any extra external extensions */


static void
xs_init(pTHX)
{
    dXSUB_SYS;
175
    PERL_UNUSED_CONTEXT;
176
}
177

178
/* ex: set ro: */