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	         565    {
    59			    dVAR;
    60	         565        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	         565        (void)env;
    68			#ifndef PERL_USE_SAFE_PUTENV
    69	         565        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	         565        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	         565        if (!PL_do_undump) {
    94	         565    	my_perl = perl_alloc();
    95	         565    	if (!my_perl)
    96	      ######    	    exit(1);
    97	         565    	perl_construct(my_perl);
    98	         565    	PL_perl_destruct_level = 0;
    99			    }
   100	         565        PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
   101	         565        exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
   102	         565        if (!exitstatus)
   103	         565            perl_run(my_perl);
   104			      
   105	         565        exitstatus = perl_destruct(my_perl);
   106			
   107	         565        perl_free(my_perl);
   108			
   109			#ifdef PERL_GLOBAL_STRUCT
   110			    free_global_struct(plvarsp);
   111			#endif /* PERL_GLOBAL_STRUCT */
   112			
   113	         565        PERL_SYS_TERM();
   114			
   115	         565        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	         565    {
   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			 */