1 /* miniperlmain.c 2 * 3 * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, 4 * 2004, 2005, 2006, 2007, by Larry Wall and others 5 * 6 * You may distribute under the terms of either the GNU General Public 7 * License or the Artistic License, as specified in the README file. 8 * 9 */ 10 11 /* 12 * The Road goes ever on and on 13 * Down from the door where it began. 14 * 15 * [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"] 16 * [Frodo on p.73 of _The Lord of the Rings_, I/iii: "Three Is Company"] 17 */ 18 19 /* This file contains the main() function for the perl interpreter. 20 * Note that miniperlmain.c contains main() for the 'miniperl' binary, 21 * while perlmain.c contains main() for the 'perl' binary. 22 * 23 * Miniperl is like perl except that it does not support dynamic loading, 24 * and in fact is used to build the dynamic modules needed for the 'real' 25 * perl executable. 26 */ 27 28 #ifdef OEMVS 29 #ifdef MYMALLOC 30 /* sbrk is limited to first heap segment so make it big */ 31 #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) 32 #else 33 #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) 34 #endif 35 #endif 36 37 38 #include "EXTERN.h" 39 #define PERL_IN_MINIPERLMAIN_C 40 #include "perl.h" 41 42 static void xs_init (pTHX); 43 static PerlInterpreter *my_perl; 44 45 #if defined (atarist) 46 /* The Atari operating system doesn't have a dynamic stack. The 47 stack size is determined from this value. */ 48 long _stksize = 64 * 1024; 49 #endif 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 dVAR; 70 int exitstatus, i; 71 #ifdef PERL_GLOBAL_STRUCT 72 struct perl_vars *plvarsp = init_global_struct(); 73 # ifdef PERL_GLOBAL_STRUCT_PRIVATE 74 my_vars = my_plvarsp = plvarsp; 75 # endif 76 #endif /* PERL_GLOBAL_STRUCT */ 77 (void)env; 78 #ifndef PERL_USE_SAFE_PUTENV 79 PL_use_safe_putenv = 0; 80 #endif /* PERL_USE_SAFE_PUTENV */ 81 82 /* if user wants control of gprof profiling off by default */ 83 /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */ 84 PERL_GPROF_MONCONTROL(0); 85 86 #ifdef NO_ENV_ARRAY_IN_MAIN 87 PERL_SYS_INIT3(&argc,&argv,&environ); 88 #else 89 PERL_SYS_INIT3(&argc,&argv,&env); 90 #endif 91 92 #if defined(USE_ITHREADS) 93 /* XXX Ideally, this should really be happening in perl_alloc() or 94 * perl_construct() to keep libperl.a transparently fork()-safe. 95 * It is currently done here only because Apache/mod_perl have 96 * problems due to lack of a call to cancel pthread_atfork() 97 * handlers when shared objects that contain the handlers may 98 * be dlclose()d. This forces applications that embed perl to 99 * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't 100 * been called at least once before in the current process. 101 * --GSAR 2001-07-20 */ 102 PTHREAD_ATFORK(Perl_atfork_lock, 103 Perl_atfork_unlock, 104 Perl_atfork_unlock); 105 #endif 106 107 if (!PL_do_undump) { 108 my_perl = perl_alloc(); 109 if (!my_perl) 110 exit(1); 111 perl_construct(my_perl); 112 PL_perl_destruct_level = 0; 113 } 114 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 115 exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); 116 if (!exitstatus) 117 perl_run(my_perl); 118 119 /* Unregister our signal handler before destroying my_perl */ 120 for (i = 0; PL_sig_name[i]; i++) { 121 if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) { 122 rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL); 123 } 124 } 125 126 exitstatus = perl_destruct(my_perl); 127 128 perl_free(my_perl); 129 130 #if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN) 131 /* 132 * The old environment may have been freed by perl_free() 133 * when PERL_TRACK_MEMPOOL is defined, but without having 134 * been restored by perl_destruct() before (this is only 135 * done if destruct_level > 0). 136 * 137 * It is important to have a valid environment for atexit() 138 * routines that are eventually called. 139 */ 140 environ = env; 141 #endif 142 143 #ifdef PERL_GLOBAL_STRUCT 144 free_global_struct(plvarsp); 145 #endif /* PERL_GLOBAL_STRUCT */ 146 147 PERL_SYS_TERM(); 148 149 exit(exitstatus); 150 return exitstatus; 151 } 152 153 /* Register any extra external extensions */ 154 155 /* Do not delete this line--writemain depends on it */ 156 157 static void 158 xs_init(pTHX) 159 { 160 PERL_UNUSED_CONTEXT; 161 dXSUB_SYS; 162 } 163 164 /* 165 * Local variables: 166 * c-indentation-style: bsd 167 * c-basic-offset: 4 168 * indent-tabs-mode: t 169 * End: 170 * 171 * ex: set ts=8 sts=4 sw=4 noet: 172 */ 173