1#!./perl -w 2package ExtUtils::Miniperl; 3use strict; 4use Exporter 'import'; 5use ExtUtils::Embed 1.31, qw(xsi_header xsi_protos xsi_body); 6 7our @EXPORT = qw(writemain); 8our $VERSION = '1.11'; 9 10# blead will run this with miniperl, hence we can't use autodie or File::Temp 11my $temp; 12 13END { 14 return if !defined $temp || !-e $temp; 15 unlink $temp or warn "Can't unlink '$temp': $!"; 16} 17 18sub writemain{ 19 my ($fh, $real); 20 21 if (ref $_[0] eq 'SCALAR') { 22 $real = ${+shift}; 23 $temp = $real; 24 $temp =~ s/(?:.c)?\z/.new/; 25 open $fh, '>', $temp 26 or die "Can't open '$temp' for writing: $!"; 27 } elsif (ref $_[0]) { 28 $fh = shift; 29 } else { 30 $fh = \*STDOUT; 31 } 32 33 my(@exts) = @_; 34 35 printf $fh <<'EOF!HEAD', xsi_header(); 36/* miniperlmain.c or perlmain.c - a generated file 37 * 38 * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, 39 * 2004, 2005, 2006, 2007, 2016 by Larry Wall and others 40 * 41 * You may distribute under the terms of either the GNU General Public 42 * License or the Artistic License, as specified in the README file. 43 * 44 */ 45 46/* 47 * The Road goes ever on and on 48 * Down from the door where it began. 49 * 50 * [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"] 51 * [Frodo on p.73 of _The Lord of the Rings_, I/iii: "Three Is Company"] 52 */ 53 54/* This file contains the main() function for the perl interpreter. 55 * Note that miniperlmain.c contains main() for the 'miniperl' binary, 56 * while perlmain.c contains main() for the 'perl' binary. The typical 57 * difference being that the latter includes Dynaloader. 58 * 59 * Miniperl is like perl except that it does not support dynamic loading, 60 * and in fact is used to build the dynamic modules needed for the 'real' 61 * perl executable. 62 * 63 * The content of the body of this generated file is mostly contained 64 * in Miniperl.pm - edit that file if you want to change anything. 65 * miniperlmain.c is generated by running regen/miniperlmain.pl, while 66 * perlmain.c is built automatically by Makefile (so the former is 67 * included in the tarball while the latter isn't). 68 */ 69 70#ifdef OEMVS 71#ifdef MYMALLOC 72/* sbrk is limited to first heap segment so make it big */ 73#pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) 74#else 75#pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) 76#endif 77#endif 78 79#define PERL_IN_MINIPERLMAIN_C 80 81/* work round bug in MakeMaker which doesn't currently (2019) supply this 82 * flag when making a statically linked perl */ 83#define PERL_CORE 1 84 85%s 86static void xs_init (pTHX); 87static PerlInterpreter *my_perl; 88 89#ifdef NO_ENV_ARRAY_IN_MAIN 90extern char **environ; 91int 92main(int argc, char **argv) 93#else 94int 95main(int argc, char **argv, char **env) 96#endif 97{ 98 int exitstatus, i; 99#ifndef NO_ENV_ARRAY_IN_MAIN 100 PERL_UNUSED_ARG(env); 101#endif 102#ifndef PERL_USE_SAFE_PUTENV 103 PL_use_safe_putenv = FALSE; 104#endif /* PERL_USE_SAFE_PUTENV */ 105 106 /* if user wants control of gprof profiling off by default */ 107 /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */ 108 PERL_GPROF_MONCONTROL(0); 109 110#ifdef NO_ENV_ARRAY_IN_MAIN 111 PERL_SYS_INIT3(&argc,&argv,&environ); 112#else 113 PERL_SYS_INIT3(&argc,&argv,&env); 114#endif 115 116#if defined(USE_ITHREADS) 117 /* XXX Ideally, this should really be happening in perl_alloc() or 118 * perl_construct() to keep libperl.a transparently fork()-safe. 119 * It is currently done here only because Apache/mod_perl have 120 * problems due to lack of a call to cancel pthread_atfork() 121 * handlers when shared objects that contain the handlers may 122 * be dlclose()d. This forces applications that embed perl to 123 * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't 124 * been called at least once before in the current process. 125 * --GSAR 2001-07-20 */ 126 PTHREAD_ATFORK(Perl_atfork_lock, 127 Perl_atfork_unlock, 128 Perl_atfork_unlock); 129#endif 130 131 PERL_SYS_FPU_INIT; 132 133 if (!PL_do_undump) { 134 my_perl = perl_alloc(); 135 if (!my_perl) 136 exit(1); 137 perl_construct(my_perl); 138 PL_perl_destruct_level = 0; 139 } 140 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 141 if (!perl_parse(my_perl, xs_init, argc, argv, (char **)NULL)) 142 perl_run(my_perl); 143 144#ifndef PERL_MICRO 145 /* Unregister our signal handler before destroying my_perl */ 146 for (i = 1; PL_sig_name[i]; i++) { 147 if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) { 148 rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL); 149 } 150 } 151#endif 152 153 exitstatus = perl_destruct(my_perl); 154 155 perl_free(my_perl); 156 157#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN) 158 /* 159 * The old environment may have been freed by perl_free() 160 * when PERL_TRACK_MEMPOOL is defined, but without having 161 * been restored by perl_destruct() before (this is only 162 * done if destruct_level > 0). 163 * 164 * It is important to have a valid environment for atexit() 165 * routines that are eventually called. 166 */ 167 environ = env; 168#endif 169 170 PERL_SYS_TERM(); 171 172 exit(exitstatus); 173} 174 175/* Register any extra external extensions */ 176 177EOF!HEAD 178 179 print $fh xsi_protos(@exts), <<'EOT', xsi_body(@exts), "}\n"; 180 181static void 182xs_init(pTHX) 183{ 184EOT 185 186 if ($real) { 187 close $fh or die "Can't close '$temp': $!"; 188 rename $temp, $real or die "Can't rename '$temp' to '$real': $!"; 189 } 190} 191 1921; 193__END__ 194 195=head1 NAME 196 197ExtUtils::Miniperl - write the C code for miniperlmain.c and perlmain.c 198 199=head1 SYNOPSIS 200 201 use ExtUtils::Miniperl; 202 writemain(@directories); 203 # or 204 writemain($fh, @directories); 205 # or 206 writemain(\$filename, @directories); 207 208=head1 DESCRIPTION 209 210C<writemain()> takes an argument list of zero or more directories 211containing archive 212libraries that relate to perl modules and should be linked into a new 213perl binary. It writes a corresponding F<miniperlmain.c> or F<perlmain.c> 214file that 215is a plain C file containing all the bootstrap code to make the 216modules associated with the libraries available from within perl. 217If the first argument to C<writemain()> is a reference to a scalar it is 218used as the filename to open for output. Any other reference is used as 219the filehandle to write to. Otherwise output defaults to C<STDOUT>. 220 221The typical usage is from within perl's own Makefile (to build 222F<perlmain.c>) or from F<regen/miniperlmain.pl> (to build miniperlmain.c). 223So under normal circumstances you won't have to deal with this module 224directly. 225 226=head1 SEE ALSO 227 228L<ExtUtils::MakeMaker> 229 230=cut 231 232# ex: set ts=8 sts=4 sw=4 et: 233