lib/perl5/5.8.8/ExtUtils/Miniperl.pm

   1 # This File keeps the contents of miniperlmain.c.
   2 #
   3 # It was generated automatically by minimod.PL from the contents
   4 # of miniperlmain.c. Don't edit this file!
   5 #
   6 #       ANY CHANGES MADE HERE WILL BE LOST!
   7 #
   8
   9
  10 package ExtUtils::Miniperl;
  11 require Exporter;
  12 @ISA = qw(Exporter);
  13 @EXPORT = qw(&writemain);
  14
  15 $head= <<'EOF!HEAD';
  16 /*    miniperlmain.c
  17  *
  18  *    Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
  19  *    2004, 2005 by Larry Wall and others
  20  *
  21  *    You may distribute under the terms of either the GNU General Public
  22  *    License or the Artistic License, as specified in the README file.
  23  *
  24  */
  25
  26 /*
  27  * "The Road goes ever on and on, down from the door where it began."
  28  */
  29
  30 /* This file contains the main() function for the perl interpreter.
  31  * Note that miniperlmain.c contains main() for the 'miniperl' binary,
  32  * while perlmain.c contains main() for the 'perl' binary.
  33  *
  34  * Miniperl is like perl except that it does not support dynamic loading,
  35  * and in fact is used to build the dynamic modules needed for the 'real'
  36  * perl executable.
  37  */
  38
  39 #ifdef OEMVS
  40 #ifdef MYMALLOC
  41 /* sbrk is limited to first heap segment so make it big */
  42 #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
  43 #else
  44 #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
  45 #endif
  46 #endif
  47
  48
  49 #include "EXTERN.h"
  50 #define PERL_IN_MINIPERLMAIN_C
  51 #include "perl.h"
  52
  53 static void xs_init (pTHX);
  54 static PerlInterpreter *my_perl;
  55
  56 #if defined (__MINT__) || defined (atarist)
  57 /* The Atari operating system doesn't have a dynamic stack.  The
  58    stack size is determined from this value.  */
  59 long _stksize = 64 * 1024;
  60 #endif
  61
  62 int
  63 main(int argc, char **argv, char **env)
  64 {
  65     int exitstatus;
  66     (void)env;
  67 #ifndef PERL_USE_SAFE_PUTENV
  68     PL_use_safe_putenv = 0;
  69 #endif /* PERL_USE_SAFE_PUTENV */
  70
  71 #ifdef PERL_GLOBAL_STRUCT
  72 #define PERLVAR(var,type) /**/
  73 #define PERLVARA(var,type) /**/
  74 #define PERLVARI(var,type,init) PL_Vars.var = init;
  75 #define PERLVARIC(var,type,init) PL_Vars.var = init;
  76 #include "perlvars.h"
  77 #undef PERLVAR
  78 #undef PERLVARA
  79 #undef PERLVARI
  80 #undef PERLVARIC
  81 #endif
  82
  83     /* if user wants control of gprof profiling off by default */
  84     /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
  85     PERL_GPROF_MONCONTROL(0);
  86
  87     PERL_SYS_INIT3(&argc,&argv,&env);
  88
  89 #if defined(USE_5005THREADS) || defined(USE_ITHREADS)
  90     /* XXX Ideally, this should really be happening in perl_alloc() or
  91      * perl_construct() to keep libperl.a transparently fork()-safe.
  92      * It is currently done here only because Apache/mod_perl have
  93      * problems due to lack of a call to cancel pthread_atfork()
  94      * handlers when shared objects that contain the handlers may
  95      * be dlclose()d.  This forces applications that embed perl to
  96      * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
  97      * been called at least once before in the current process.
  98      * --GSAR 2001-07-20 */
  99     PTHREAD_ATFORK(Perl_atfork_lock,
 100                    Perl_atfork_unlock,
 101                    Perl_atfork_unlock);
 102 #endif
 103
 104     if (!PL_do_undump) {
 105         my_perl = perl_alloc();
 106         if (!my_perl)
 107             exit(1);
 108         perl_construct(my_perl);
 109         PL_perl_destruct_level = 0;
 110     }
 111     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 112     exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
 113     if (!exitstatus)
 114         perl_run(my_perl);
 115
 116     exitstatus = perl_destruct(my_perl);
 117
 118     perl_free(my_perl);
 119
 120     PERL_SYS_TERM();
 121
 122     exit(exitstatus);
 123     return exitstatus;
 124 }
 125
 126 /* Register any extra external extensions */
 127
 128 EOF!HEAD
 129 $tail=<<'EOF!TAIL';
 130
 131 static void
 132 xs_init(pTHX)
 133 {
 134 }
 135
 136 /*
 137  * Local variables:
 138  * c-indentation-style: bsd
 139  * c-basic-offset: 4
 140  * indent-tabs-mode: t
 141  * End:
 142  *
 143  * ex: set ts=8 sts=4 sw=4 noet:
 144  */
 145 EOF!TAIL
 146
 147 sub writemain{
 148     my(@exts) = @_;
 149
 150     my($pname);
 151     my($dl) = canon('/','DynaLoader');
 152     print $head;
 153
 154     foreach $_ (@exts){
 155         my($pname) = canon('/', $_);
 156         my($mname, $cname);
 157         ($mname = $pname) =~ s!/!::!g;
 158         ($cname = $pname) =~ s!/!__!g;
 159         print "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n";
 160     }
 161
 162     my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
 163     print $tail1;
 164
 165     print "\tconst char file[] = __FILE__;\n";
 166     print "\tdXSUB_SYS;\n" if $] > 5.002;
 167
 168     foreach $_ (@exts){
 169         my($pname) = canon('/', $_);
 170         my($mname, $cname, $ccode);
 171         ($mname = $pname) =~ s!/!::!g;
 172         ($cname = $pname) =~ s!/!__!g;
 173         print "\t{\n";
 174         if ($pname eq $dl){
 175             # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
 176             # boot_DynaLoader is called directly in DynaLoader.pm
 177             $ccode = "\t/* DynaLoader is a special case */\n
 178 \tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
 179             print $ccode unless $SEEN{$ccode}++;
 180         } else {
 181             $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
 182             print $ccode unless $SEEN{$ccode}++;
 183         }
 184         print "\t}\n";
 185     }
 186     print $tail2;
 187 }
 188
 189 sub canon{
 190     my($as, @ext) = @_;
 191         foreach(@ext){
 192             # might be X::Y or lib/auto/X/Y/Y.a
 193                 next if s!::!/!g;
 194             s:^(lib|ext)/(auto/)?::;
 195             s:/\w+\.\w+$::;
 196         }
 197         grep(s:/:$as:, @ext) if ($as ne '/');
 198         @ext;
 199 }
 200
 201 1;
 202 __END__
 203
 204 =head1 NAME
 205
 206 ExtUtils::Miniperl, writemain - write the C code for perlmain.c
 207
 208 =head1 SYNOPSIS
 209
 210 C<use ExtUtils::Miniperl;>
 211
 212 C<writemain(@directories);>
 213
 214 =head1 DESCRIPTION
 215
 216 This whole module is written when perl itself is built from a script
 217 called minimod.PL. In case you want to patch it, please patch
 218 minimod.PL in the perl distribution instead.
 219
 220 writemain() takes an argument list of directories containing archive
 221 libraries that relate to perl modules and should be linked into a new
 222 perl binary. It writes to STDOUT a corresponding perlmain.c file that
 223 is a plain C file containing all the bootstrap code to make the
 224 modules associated with the libraries available from within perl.
 225
 226 The typical usage is from within a Makefile generated by
 227 ExtUtils::MakeMaker. So under normal circumstances you won't have to
 228 deal with this module directly.
 229
 230 =head1 SEE ALSO
 231
 232 L<ExtUtils::MakeMaker>
 233
 234 =cut
 235