miniperlmain.c

   1 /*    miniperlmain.c
   2  *
   3  *    Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
   4  *    2004, 2005 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 int
  57 main(int argc, char **argv, char **env)
  58 {
  59     dVAR;
  60     int exitstatus;
  61 #ifdef PERL_GLOBAL_STRUCT
  62     struct perl_vars *plvarsp = init_global_struct();
  63 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
  64     my_vars = my_plvarsp = plvarsp;
  65 #  endif
  66 #endif /* PERL_GLOBAL_STRUCT */
  67     (void)env;
  68 #ifndef PERL_USE_SAFE_PUTENV
  69     PL_use_safe_putenv = 0;
  70 #endif /* PERL_USE_SAFE_PUTENV */
  71
  72     /* if user wants control of gprof profiling off by default */
  73     /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
  74     PERL_GPROF_MONCONTROL(0);
  75
  76     PERL_SYS_INIT3(&argc,&argv,&env);
  77
  78 #if defined(USE_ITHREADS)
  79     /* XXX Ideally, this should really be happening in perl_alloc() or
  80      * perl_construct() to keep libperl.a transparently fork()-safe.
  81      * It is currently done here only because Apache/mod_perl have
  82      * problems due to lack of a call to cancel pthread_atfork()
  83      * handlers when shared objects that contain the handlers may
  84      * be dlclose()d.  This forces applications that embed perl to
  85      * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
  86      * been called at least once before in the current process.
  87      * --GSAR 2001-07-20 */
  88     PTHREAD_ATFORK(Perl_atfork_lock,
  89                    Perl_atfork_unlock,
  90                    Perl_atfork_unlock);
  91 #endif
  92
  93     if (!PL_do_undump) {
  94         my_perl = perl_alloc();
  95         if (!my_perl)
  96             exit(1);
  97         perl_construct(my_perl);
  98         PL_perl_destruct_level = 0;
  99     }
 100     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 101     exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
 102     if (!exitstatus)
 103         perl_run(my_perl);
 104
 105     exitstatus = perl_destruct(my_perl);
 106
 107     perl_free(my_perl);
 108
 109 #ifdef PERL_GLOBAL_STRUCT
 110     free_global_struct(plvarsp);
 111 #endif /* PERL_GLOBAL_STRUCT */
 112
 113     PERL_SYS_TERM();
 114
 115     exit(exitstatus);
 116     return exitstatus;
 117 }
 118
 119 /* Register any extra external extensions */
 120
 121 /* Do not delete this line--writemain depends on it */
 122
 123 static void
 124 xs_init(pTHX)
 125 {
 126     dXSUB_SYS;
 127 }
 128
 129 /*
 130  * Local variables:
 131  * c-indentation-style: bsd
 132  * c-basic-offset: 4
 133  * indent-tabs-mode: t
 134  * End:
 135  *
 136  * ex: set ts=8 sts=4 sw=4 noet:
 137  */