X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=miniperlmain.c;h=f92ea3ee238501dec1e07ba48e01f416cdda966e;hb=05632f9aff3e990388b86286c6c58111a26f1522;hp=11635dd0dd6a8dba2d725bf497c26fa83bb72baa;hpb=0672f40ebb7f0cdf6045545c3680ba955a0cd920;p=p5sagit%2Fp5-mst-13.2.git diff --git a/miniperlmain.c b/miniperlmain.c index 11635dd..f92ea3e 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -3,7 +3,12 @@ */ #ifdef OEMVS -#pragma runopts(HEAP(1M,32K,ANYWHERE,KEEP,8K,4K)) +#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 @@ -13,7 +18,6 @@ static void xs_init (pTHX); static PerlInterpreter *my_perl; -static struct perl_thread *thr; /* XXXXXX testing */ #if defined (__MINT__) || defined (atarist) /* The Atari operating system doesn't have a dynamic stack. The @@ -28,35 +32,56 @@ main(int argc, char **argv, char **env) #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 - PERL_SYS_INIT(&argc,&argv); + /* 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_5005THREADS) || 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 ); + 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); - exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL ); - if (!exitstatus) { - exitstatus = perl_run( my_perl ); - } - - perl_destruct( my_perl ); - perl_free( my_perl ); + perl_free(my_perl); PERL_SYS_TERM(); - exit( exitstatus ); + exit(exitstatus); return exitstatus; } @@ -67,5 +92,5 @@ main(int argc, char **argv, char **env) static void xs_init(pTHX) { - dXSUB_SYS; + dXSUB_SYS; }