home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / ExtUtils / Miniperl.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  6.9 KB  |  268 lines
  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.  
  268.