home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _e4cff1b4b426f9df5debbb95da7fa21c < prev    next >
Encoding:
Text File  |  2004-04-13  |  4.8 KB  |  194 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. /*
  17.  * "The Road goes ever on and on, down from the door where it began."
  18.  */
  19.  
  20. #ifdef OEMVS
  21. #pragma runopts(HEAP(1M,32K,ANYWHERE,KEEP,8K,4K))
  22. #endif
  23.  
  24.  
  25. #include "EXTERN.h"
  26. #define PERL_IN_MINIPERLMAIN_C
  27. #include "perl.h"
  28.  
  29. static void xs_init (pTHX);
  30. static PerlInterpreter *my_perl;
  31.  
  32. #if defined (__MINT__) || defined (atarist)
  33. /* The Atari operating system doesn't have a dynamic stack.  The
  34.    stack size is determined from this value.  */
  35. long _stksize = 64 * 1024;
  36. #endif
  37.  
  38. int
  39. main(int argc, char **argv, char **env)
  40. {
  41.     int exitstatus;
  42.  
  43. #ifdef PERL_GLOBAL_STRUCT
  44. #define PERLVAR(var,type) /**/
  45. #define PERLVARA(var,type) /**/
  46. #define PERLVARI(var,type,init) PL_Vars.var = init;
  47. #define PERLVARIC(var,type,init) PL_Vars.var = init;
  48. #include "perlvars.h"
  49. #undef PERLVAR
  50. #undef PERLVARA
  51. #undef PERLVARI
  52. #undef PERLVARIC
  53. #endif
  54.  
  55.     PERL_SYS_INIT3(&argc,&argv,&env);
  56.  
  57. #if defined(USE_THREADS) || defined(USE_ITHREADS)
  58.     /* XXX Ideally, this should really be happening in perl_alloc() or
  59.      * perl_construct() to keep libperl.a transparently fork()-safe.
  60.      * It is currently done here only because Apache/mod_perl have
  61.      * problems due to lack of a call to cancel pthread_atfork()
  62.      * handlers when shared objects that contain the handlers may
  63.      * be dlclose()d.  This forces applications that embed perl to
  64.      * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
  65.      * been called at least once before in the current process.
  66.      * --GSAR 2001-07-20 */
  67.     PTHREAD_ATFORK(Perl_atfork_lock,
  68.                    Perl_atfork_unlock,
  69.                    Perl_atfork_unlock);
  70. #endif
  71.  
  72.     if (!PL_do_undump) {
  73.     my_perl = perl_alloc();
  74.     if (!my_perl)
  75.         exit(1);
  76.     perl_construct(my_perl);
  77.     PL_perl_destruct_level = 0;
  78.     }
  79.  
  80.     exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
  81.     if (!exitstatus) {
  82.     exitstatus = perl_run(my_perl);
  83.     }
  84.  
  85.     perl_destruct(my_perl);
  86.     perl_free(my_perl);
  87.  
  88.     PERL_SYS_TERM();
  89.  
  90.     exit(exitstatus);
  91.     return exitstatus;
  92. }
  93.  
  94. /* Register any extra external extensions */
  95.  
  96. EOF!HEAD
  97. $tail=<<'EOF!TAIL';
  98.  
  99. static void
  100. xs_init(pTHX)
  101. {
  102. }
  103. EOF!TAIL
  104.  
  105. sub writemain{
  106.     my(@exts) = @_;
  107.  
  108.     my($pname);
  109.     my($dl) = canon('/','DynaLoader');
  110.     print $head;
  111.  
  112.     foreach $_ (@exts){
  113.     my($pname) = canon('/', $_);
  114.     my($mname, $cname);
  115.     ($mname = $pname) =~ s!/!::!g;
  116.     ($cname = $pname) =~ s!/!__!g;
  117.         print "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n";
  118.     }
  119.  
  120.     my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
  121.     print $tail1;
  122.  
  123.     print "\tchar *file = __FILE__;\n";
  124.     print "\tdXSUB_SYS;\n" if $] > 5.002;
  125.  
  126.     foreach $_ (@exts){
  127.     my($pname) = canon('/', $_);
  128.     my($mname, $cname, $ccode);
  129.     ($mname = $pname) =~ s!/!::!g;
  130.     ($cname = $pname) =~ s!/!__!g;
  131.     print "\t{\n";
  132.     if ($pname eq $dl){
  133.         # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  134.         # boot_DynaLoader is called directly in DynaLoader.pm
  135.         $ccode = "\t/* DynaLoader is a special case */\n
  136. \tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
  137.         print $ccode unless $SEEN{$ccode}++;
  138.     } else {
  139.         $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
  140.         print $ccode unless $SEEN{$ccode}++;
  141.     }
  142.     print "\t}\n";
  143.     }
  144.     print $tail2;
  145. }
  146.  
  147. sub canon{
  148.     my($as, @ext) = @_;
  149.     foreach(@ext){
  150.         # might be X::Y or lib/auto/X/Y/Y.a
  151.         next if s!::!/!g;
  152.         s:^(lib|ext)/(auto/)?::;
  153.         s:/\w+\.\w+$::;
  154.     }
  155.     grep(s:/:$as:, @ext) if ($as ne '/');
  156.     @ext;
  157. }
  158.  
  159. 1;
  160. __END__
  161.  
  162. =head1 NAME
  163.  
  164. ExtUtils::Miniperl, writemain - write the C code for perlmain.c
  165.  
  166. =head1 SYNOPSIS
  167.  
  168. C<use ExtUtils::Miniperl;>
  169.  
  170. C<writemain(@directories);>
  171.  
  172. =head1 DESCRIPTION
  173.  
  174. This whole module is written when perl itself is built from a script
  175. called minimod.PL. In case you want to patch it, please patch
  176. minimod.PL in the perl distribution instead.
  177.  
  178. writemain() takes an argument list of directories containing archive
  179. libraries that relate to perl modules and should be linked into a new
  180. perl binary. It writes to STDOUT a corresponding perlmain.c file that
  181. is a plain C file containing all the bootstrap code to make the
  182. modules associated with the libraries available from within perl.
  183.  
  184. The typical usage is from within a Makefile generated by
  185. ExtUtils::MakeMaker. So under normal circumstances you won't have to
  186. deal with this module directly.
  187.  
  188. =head1 SEE ALSO
  189.  
  190. L<ExtUtils::MakeMaker>
  191.  
  192. =cut
  193.  
  194.