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: */ 180