[Summary view] [Print] [Text view]

   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, 2006, 2007, 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  #if defined(PERL_GLOBAL_STRUCT_PRIVATE)
  63  /* The static struct perl_vars* may seem counterproductive since the
  64   * whole idea PERL_GLOBAL_STRUCT_PRIVATE was to avoid statics, but note
  65   * that this static is not in the shared perl library, the globals PL_Vars
  66   * and PL_VarsPtr will stay away. */
  67  static struct perl_vars* my_plvarsp;
  68  struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
  69  #endif
  70  
  71  #ifdef NO_ENV_ARRAY_IN_MAIN
  72  extern char **environ;
  73  int
  74  main(int argc, char **argv)
  75  #else
  76  int
  77  main(int argc, char **argv, char **env)
  78  #endif
  79  {
  80      dVAR;
  81      int exitstatus;
  82  #ifdef PERL_GLOBAL_STRUCT
  83      struct perl_vars *plvarsp = init_global_struct();
  84  #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
  85      my_vars = my_plvarsp = plvarsp;
  86  #  endif
  87  #endif /* PERL_GLOBAL_STRUCT */
  88      (void)env;
  89  #ifndef PERL_USE_SAFE_PUTENV
  90      PL_use_safe_putenv = 0;
  91  #endif /* PERL_USE_SAFE_PUTENV */
  92  
  93      /* if user wants control of gprof profiling off by default */
  94      /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
  95      PERL_GPROF_MONCONTROL(0);
  96  
  97  #ifdef NO_ENV_ARRAY_IN_MAIN
  98      PERL_SYS_INIT3(&argc,&argv,&environ);
  99  #else
 100      PERL_SYS_INIT3(&argc,&argv,&env);
 101  #endif
 102  
 103  #if defined(USE_ITHREADS)
 104      /* XXX Ideally, this should really be happening in perl_alloc() or
 105       * perl_construct() to keep libperl.a transparently fork()-safe.
 106       * It is currently done here only because Apache/mod_perl have
 107       * problems due to lack of a call to cancel pthread_atfork()
 108       * handlers when shared objects that contain the handlers may
 109       * be dlclose()d.  This forces applications that embed perl to
 110       * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
 111       * been called at least once before in the current process.
 112       * --GSAR 2001-07-20 */
 113      PTHREAD_ATFORK(Perl_atfork_lock,
 114                     Perl_atfork_unlock,
 115                     Perl_atfork_unlock);
 116  #endif
 117  
 118      if (!PL_do_undump) {
 119      my_perl = perl_alloc();
 120      if (!my_perl)
 121          exit(1);
 122      perl_construct(my_perl);
 123      PL_perl_destruct_level = 0;
 124      }
 125      PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 126      exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
 127      if (!exitstatus)
 128          perl_run(my_perl);
 129  
 130      exitstatus = perl_destruct(my_perl);
 131  
 132      perl_free(my_perl);
 133  
 134  #if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN)
 135      /*
 136       * The old environment may have been freed by perl_free()
 137       * when PERL_TRACK_MEMPOOL is defined, but without having
 138       * been restored by perl_destruct() before (this is only
 139       * done if destruct_level > 0).
 140       *
 141       * It is important to have a valid environment for atexit()
 142       * routines that are eventually called.
 143       */
 144      environ = env;
 145  #endif
 146  
 147  #ifdef PERL_GLOBAL_STRUCT
 148      free_global_struct(plvarsp);
 149  #endif /* PERL_GLOBAL_STRUCT */
 150  
 151      PERL_SYS_TERM();
 152  
 153      exit(exitstatus);
 154      return exitstatus;
 155  }
 156  
 157  /* Register any extra external extensions */
 158  
 159  EOF!HEAD
 160  $tail=<<'EOF!TAIL';
 161  
 162  static void
 163  xs_init(pTHX)
 164  {
 165      PERL_UNUSED_CONTEXT;
 166  }
 167  
 168  /*
 169   * Local variables:
 170   * c-indentation-style: bsd
 171   * c-basic-offset: 4
 172   * indent-tabs-mode: t
 173   * End:
 174   *
 175   * ex: set ts=8 sts=4 sw=4 noet:
 176   */
 177  EOF!TAIL
 178  
 179  sub writemain{
 180      my(@exts) = @_;
 181  
 182      my($pname);
 183      my($dl) = canon('/','DynaLoader');
 184      print $head;
 185  
 186      foreach $_ (@exts){
 187      my($pname) = canon('/', $_);
 188      my($mname, $cname);
 189      ($mname = $pname) =~ s!/!::!g;
 190      ($cname = $pname) =~ s!/!__!g;
 191          print "EXTERN_C void boot_$cname} (pTHX_ CV* cv);\n";
 192      }
 193  
 194      my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
 195      print $tail1;
 196  
 197      print "\tconst char file[] = __FILE__;\n";
 198      print "\tdXSUB_SYS;\n" if $] > 5.002;
 199  
 200      foreach $_ (@exts){
 201      my($pname) = canon('/', $_);
 202      my($mname, $cname, $ccode);
 203      ($mname = $pname) =~ s!/!::!g;
 204      ($cname = $pname) =~ s!/!__!g;
 205      print "\t{\n";
 206      if ($pname eq $dl){
 207          # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
 208          # boot_DynaLoader is called directly in DynaLoader.pm
 209          $ccode = "\t/* DynaLoader is a special case */\n
 210  \tnewXS(\"$mname}::boot_$cname}\", boot_$cname}, file);\n";
 211          print $ccode unless $SEEN{$ccode}++;
 212      } else {
 213          $ccode = "\tnewXS(\"$mname}::bootstrap\", boot_$cname}, file);\n";
 214          print $ccode unless $SEEN{$ccode}++;
 215      }
 216      print "\t}\n";
 217      }
 218      print $tail2;
 219  }
 220  
 221  sub canon{
 222      my($as, @ext) = @_;
 223      foreach(@ext){
 224          # might be X::Y or lib/auto/X/Y/Y.a
 225          next if s!::!/!g;
 226          s:^(lib|ext)/(auto/)?::;
 227          s:/\w+\.\w+$::;
 228      }
 229      grep(s:/:$as:, @ext) if ($as ne '/');
 230      @ext;
 231  }
 232  
 233  1;
 234  __END__
 235  
 236  =head1 NAME
 237  
 238  ExtUtils::Miniperl, writemain - write the C code for perlmain.c
 239  
 240  =head1 SYNOPSIS
 241  
 242  C<use ExtUtils::Miniperl;>
 243  
 244  C<writemain(@directories);>
 245  
 246  =head1 DESCRIPTION
 247  
 248  This whole module is written when perl itself is built from a script
 249  called minimod.PL. In case you want to patch it, please patch
 250  minimod.PL in the perl distribution instead.
 251  
 252  writemain() takes an argument list of directories containing archive
 253  libraries that relate to perl modules and should be linked into a new
 254  perl binary. It writes to STDOUT a corresponding perlmain.c file that
 255  is a plain C file containing all the bootstrap code to make the
 256  modules associated with the libraries available from within perl.
 257  
 258  The typical usage is from within a Makefile generated by
 259  ExtUtils::MakeMaker. So under normal circumstances you won't have to
 260  deal with this module directly.
 261  
 262  =head1 SEE ALSO
 263  
 264  L<ExtUtils::MakeMaker>
 265  
 266  =cut
 267