-
Notifications
You must be signed in to change notification settings - Fork 559
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
This separates out the "shutting down" of the perl interpreter into a separate function, so that perl can be built with Emscripten's NO_EXIT_RUNTIME enabled. This keeps the interpreter running, and allows us to shut it down later, on request.
- Loading branch information
Showing
1 changed file
with
138 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,138 @@ | ||
| --- perlmain.c.orig 2018-07-15 12:10:27.207629711 +0200 | ||
| +++ perlmain.c 2018-07-15 12:11:23.051306602 +0200 | ||
| @@ -58,23 +58,16 @@ | ||
| struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; } | ||
| #endif | ||
|
|
||
| +int emperl_end_perl(); | ||
| + | ||
| #ifdef NO_ENV_ARRAY_IN_MAIN | ||
| -extern char **environ; | ||
| -int | ||
| -main(int argc, char **argv) | ||
| -#else | ||
| +#error "NO_ENV_ARRAY_IN_MAIN not supported in this configuration" | ||
| +#endif | ||
| int | ||
| main(int argc, char **argv, char **env) | ||
| -#endif | ||
| { | ||
| - int exitstatus, i; | ||
| #ifdef PERL_GLOBAL_STRUCT | ||
| - struct perl_vars *my_vars = init_global_struct(); | ||
| -# ifdef PERL_GLOBAL_STRUCT_PRIVATE | ||
| - int veto; | ||
| - | ||
| - my_plvarsp = my_vars; | ||
| -# endif | ||
| +#error "PERL_GLOBAL_STRUCT not supported in this configuration" | ||
| #endif /* PERL_GLOBAL_STRUCT */ | ||
| #ifndef NO_ENV_ARRAY_IN_MAIN | ||
| PERL_UNUSED_ARG(env); | ||
| @@ -87,25 +80,10 @@ | ||
| /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */ | ||
| PERL_GPROF_MONCONTROL(0); | ||
|
|
||
| -#ifdef NO_ENV_ARRAY_IN_MAIN | ||
| - PERL_SYS_INIT3(&argc,&argv,&environ); | ||
| -#else | ||
| PERL_SYS_INIT3(&argc,&argv,&env); | ||
| -#endif | ||
|
|
||
| #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); | ||
| +#error "USE_ITHREADS not supported in this configuration" | ||
| #endif | ||
|
|
||
| PERL_SYS_FPU_INIT; | ||
| @@ -118,8 +96,33 @@ | ||
| PL_perl_destruct_level = 0; | ||
| } | ||
| PL_exit_flags |= PERL_EXIT_DESTRUCT_END; | ||
| - if (!perl_parse(my_perl, xs_init, argc, argv, (char **)NULL)) | ||
| - perl_run(my_perl); | ||
| + if (perl_parse(my_perl, xs_init, argc, argv, (char **)NULL)) | ||
| + return emperl_end_perl(); | ||
| + if (perl_run(my_perl)) | ||
| + return emperl_end_perl(); | ||
| + | ||
| + /* Code copied from perl_destruct in perl.c */ | ||
| +#ifdef USE_PERLIO | ||
| + { | ||
| + PerlIO *stdo = PerlIO_stdout(); | ||
| + if (*stdo && PerlIO_flush(stdo)) { | ||
| + PerlIO_restore_errno(stdo); | ||
| + if (errno) | ||
| + PerlIO_printf(PerlIO_stderr(), "Unable to flush stdout: %s\n", | ||
| + Strerror(errno)); | ||
| + if (!STATUS_UNIX) | ||
| + STATUS_ALL_FAILURE; | ||
| + } | ||
| + } | ||
| +#endif | ||
| + my_fflush_all(); | ||
| + return STATUS_EXIT; | ||
| +} | ||
| + | ||
| +int | ||
| +emperl_end_perl() | ||
| +{ | ||
| + int exitstatus, i; | ||
|
|
||
| #ifndef PERL_MICRO | ||
| /* Unregister our signal handler before destroying my_perl */ | ||
| @@ -134,36 +137,15 @@ | ||
|
|
||
| perl_free(my_perl); | ||
|
|
||
| -#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN) | ||
| - /* | ||
| - * The old environment may have been freed by perl_free() | ||
| - * when PERL_TRACK_MEMPOOL is defined, but without having | ||
| - * been restored by perl_destruct() before (this is only | ||
| - * done if destruct_level > 0). | ||
| - * | ||
| - * It is important to have a valid environment for atexit() | ||
| - * routines that are eventually called. | ||
| - */ | ||
| - environ = env; | ||
| -#endif | ||
| - | ||
| PERL_SYS_TERM(); | ||
|
|
||
| -#ifdef PERL_GLOBAL_STRUCT | ||
| -# ifdef PERL_GLOBAL_STRUCT_PRIVATE | ||
| - veto = my_plvarsp->Gveto_cleanup; | ||
| -# endif | ||
| - free_global_struct(my_vars); | ||
| -# ifdef PERL_GLOBAL_STRUCT_PRIVATE | ||
| - if (!veto) | ||
| - my_plvarsp = NULL; | ||
| - /* Remember, functions registered with atexit() can run after this point, | ||
| - and may access "global" variables, and hence end up calling | ||
| - Perl_GetVarsPrivate() */ | ||
| -#endif | ||
| -#endif /* PERL_GLOBAL_STRUCT */ | ||
| - | ||
| - exit(exitstatus); | ||
| + /* When NO_EXIT_RUNTIME is set, Emscripten throws an ExitStatus exception when | ||
| + * exit() is called, so we only call it when there is a nonzero exit status. | ||
| + * As far as I can tell, Perl doesn't require exit() to be called (for example, | ||
| + * END blocks are apparently handled above, and not via atexit). */ | ||
| + if (exitstatus) | ||
| + exit(exitstatus); | ||
| + return exitstatus; | ||
| } | ||
|
|
||
| /* Register any extra external extensions */ |