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, down from the door where it began." 13 */ 14 15 /* This file contains the main() function for the perl interpreter. 16 * Note that miniperlmain.c contains main() for the 'miniperl' binary, 17 * while perlmain.c contains main() for the 'perl' binary. 18 * 19 * Miniperl is like perl except that it does not support dynamic loading, 20 * and in fact is used to build the dynamic modules needed for the 'real' 21 * perl executable. 22 */ 23 24 #ifdef OEMVS 25 #ifdef MYMALLOC 26 /* sbrk is limited to first heap segment so make it big */ 27 #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) 28 #else 29 #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) 30 #endif 31 #endif 32 33 34 #include "EXTERN.h" 35 #define PERL_IN_MINIPERLMAIN_C 36 #include "perl.h" 37 38 static void xs_init (pTHX); 39 static PerlInterpreter *my_perl; 40 41 #if defined (__MINT__) || defined (atarist) 42 /* The Atari operating system doesn't have a dynamic stack. The 43 stack size is determined from this value. */ 44 long _stksize = 64 * 1024; 45 #endif 46 47 #if defined(PERL_GLOBAL_STRUCT_PRIVATE) 48 /* The static struct perl_vars* may seem counterproductive since the 49 * whole idea PERL_GLOBAL_STRUCT_PRIVATE was to avoid statics, but note 50 * that this static is not in the shared perl library, the globals PL_Vars 51 * and PL_VarsPtr will stay away. */ 52 static struct perl_vars* my_plvarsp; 53 struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; } 54 #endif 55 56 #ifdef NO_ENV_ARRAY_IN_MAIN 57 extern char **environ; 58 int 59 main(int argc, char **argv) 60 #else 61 int 62 main(int argc, char **argv, char **env) 63 #endif 64 { 65 dVAR; 66 int exitstatus; 67 #ifdef PERL_GLOBAL_STRUCT 68 struct perl_vars *plvarsp = init_global_struct(); 69 # ifdef PERL_GLOBAL_STRUCT_PRIVATE 70 my_vars = my_plvarsp = plvarsp; 71 # endif 72 #endif /* PERL_GLOBAL_STRUCT */ 73 (void)env; 74 #ifndef PERL_USE_SAFE_PUTENV 75 PL_use_safe_putenv = 0; 76 #endif /* PERL_USE_SAFE_PUTENV */ 77 78 /* if user wants control of gprof profiling off by default */ 79 /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */ 80 PERL_GPROF_MONCONTROL(0); 81 82 #ifdef NO_ENV_ARRAY_IN_MAIN 83 PERL_SYS_INIT3(&argc,&argv,&environ); 84 #else 85 PERL_SYS_INIT3(&argc,&argv,&env); 86 #endif 87 88 #if defined(USE_ITHREADS) 89 /* XXX Ideally, this should really be happening in perl_alloc() or 90 * perl_construct() to keep libperl.a transparently fork()-safe. 91 * It is currently done here only because Apache/mod_perl have 92 * problems due to lack of a call to cancel pthread_atfork() 93 * handlers when shared objects that contain the handlers may 94 * be dlclose()d. This forces applications that embed perl to 95 * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't 96 * been called at least once before in the current process. 97 * --GSAR 2001-07-20 */ 98 PTHREAD_ATFORK(Perl_atfork_lock, 99 Perl_atfork_unlock, 100 Perl_atfork_unlock); 101 #endif 102 103 if (!PL_do_undump) { 104 my_perl = perl_alloc(); 105 if (!my_perl) 106 exit(1); 107 perl_construct(my_perl); 108 PL_perl_destruct_level = 0; 109 } 110 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 111 exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); 112 if (!exitstatus) 113 perl_run(my_perl); 114 115 exitstatus = perl_destruct(my_perl); 116 117 perl_free(my_perl); 118 119 #if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN) 120 /* 121 * The old environment may have been freed by perl_free() 122 * when PERL_TRACK_MEMPOOL is defined, but without having 123 * been restored by perl_destruct() before (this is only 124 * done if destruct_level > 0). 125 * 126 * It is important to have a valid environment for atexit() 127 * routines that are eventually called. 128 */ 129 environ = env; 130 #endif 131 132 #ifdef PERL_GLOBAL_STRUCT 133 free_global_struct(plvarsp); 134 #endif /* PERL_GLOBAL_STRUCT */ 135 136 PERL_SYS_TERM(); 137 138 exit(exitstatus); 139 return exitstatus; 140 } 141 142 /* Register any extra external extensions */ 143 144 /* Do not delete this line--writemain depends on it */ 145 146 static void 147 xs_init(pTHX) 148 { 149 PERL_UNUSED_CONTEXT; 150 dXSUB_SYS; 151 } 152 153 /* 154 * Local variables: 155 * c-indentation-style: bsd 156 * c-basic-offset: 4 157 * indent-tabs-mode: t 158 * End: 159 * 160 * ex: set ts=8 sts=4 sw=4 noet: 161 */ 162