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