/* miniperlmain.c * * Copyright (c) 1997-2003, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * */ /* * "The Road goes ever on and on, down from the door where it began." */ #ifdef OEMVS #ifdef MYMALLOC /* sbrk is limited to first heap segement so make it big */ #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) #else #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) #endif #endif #include "EXTERN.h" #define PERL_IN_MINIPERLMAIN_C #include "perl.h" static void xs_init (pTHX); static PerlInterpreter *my_perl; #if defined (__MINT__) || defined (atarist) /* The Atari operating system doesn't have a dynamic stack. The stack size is determined from this value. */ long _stksize = 64 * 1024; #endif int main(int argc, char **argv, char **env) { int exitstatus; #ifdef PERL_GLOBAL_STRUCT #define PERLVAR(var,type) /**/ #define PERLVARA(var,type) /**/ #define PERLVARI(var,type,init) PL_Vars.var = init; #define PERLVARIC(var,type,init) PL_Vars.var = init; #include "perlvars.h" #undef PERLVAR #undef PERLVARA #undef PERLVARI #undef PERLVARIC #endif /* if user wants control of gprof profiling off by default */ /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */ PERL_GPROF_MONCONTROL(0); PERL_SYS_INIT3(&argc,&argv,&env); #if defined(USE_ITHREADS) /* XXX Ideally, this should really be happening in perl_alloc() or * perl_construct() to keep libperl.a transparently fork()-safe. * It is currently done here only because Apache/mod_perl have * problems due to lack of a call to cancel pthread_atfork() * handlers when shared objects that contain the handlers may * be dlclose()d. This forces applications that embed perl to * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't * been called at least once before in the current process. * --GSAR 2001-07-20 */ PTHREAD_ATFORK(Perl_atfork_lock, Perl_atfork_unlock, Perl_atfork_unlock); #endif if (!PL_do_undump) { my_perl = perl_alloc(); if (!my_perl) exit(1); perl_construct(my_perl); PL_perl_destruct_level = 0; } PL_exit_flags |= PERL_EXIT_DESTRUCT_END; exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); if (!exitstatus) perl_run(my_perl); exitstatus = perl_destruct(my_perl); perl_free(my_perl); PERL_SYS_TERM(); exit(exitstatus); return exitstatus; } /* Register any extra external extensions */ /* Do not delete this line--writemain depends on it */ static void xs_init(pTHX) { dXSUB_SYS; }