home *** CD-ROM | disk | FTP | other *** search
/ Chip: Windows 2000 Professional Resource Kit / W2KPRK.iso / apps / perl / ActivePerl.exe / data.z / Miniperl.pm < prev    next >
Encoding:
Perl POD Document  |  1999-10-16  |  4.0 KB  |  178 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. #include "perl.h"
  27.  
  28. static void xs_init _((void));
  29. static PerlInterpreter *my_perl;
  30.  
  31. #if defined (__MINT__) || defined (atarist)
  32. /* The Atari operating system doesn't have a dynamic stack.  The
  33.    stack size is determined from this value.  */
  34. long _stksize = 64 * 1024;
  35. #endif
  36.  
  37. int
  38. main(int argc, char **argv, char **env)
  39. {
  40.     int exitstatus;
  41.  
  42. #ifdef PERL_GLOBAL_STRUCT
  43. #define PERLVAR(var,type) /**/
  44. #define PERLVARI(var,type,init) PL_Vars.var = init;
  45. #define PERLVARIC(var,type,init) PL_Vars.var = init;
  46. #include "perlvars.h"
  47. #undef PERLVAR
  48. #undef PERLVARI
  49. #undef PERLVARIC
  50. #endif
  51.  
  52.     PERL_SYS_INIT(&argc,&argv);
  53.  
  54.     perl_init_i18nl10n(1);
  55.  
  56.     if (!PL_do_undump) {
  57.     my_perl = perl_alloc();
  58.     if (!my_perl)
  59.         exit(1);
  60.     perl_construct( my_perl );
  61.     PL_perl_destruct_level = 0;
  62.     }
  63.  
  64.     exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
  65.     if (!exitstatus) {
  66.     exitstatus = perl_run( my_perl );
  67.     }
  68.  
  69.     perl_destruct( my_perl );
  70.     perl_free( my_perl );
  71.  
  72.     PERL_SYS_TERM();
  73.  
  74.     exit( exitstatus );
  75.     return exitstatus;
  76. }
  77.  
  78. /* Register any extra external extensions */
  79.  
  80. EOF!HEAD
  81. $tail=<<'EOF!TAIL';
  82.  
  83. static void
  84. xs_init(void)
  85. {
  86. }
  87. EOF!TAIL
  88.  
  89. sub writemain{
  90.     my(@exts) = @_;
  91.  
  92.     my($pname);
  93.     my($dl) = canon('/','DynaLoader');
  94.     print $head;
  95.  
  96.     foreach $_ (@exts){
  97.     my($pname) = canon('/', $_);
  98.     my($mname, $cname);
  99.     ($mname = $pname) =~ s!/!::!g;
  100.     ($cname = $pname) =~ s!/!__!g;
  101.     print "EXTERN_C void boot_${cname} _((CV* cv));\n";
  102.     }
  103.  
  104.     my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
  105.     print $tail1;
  106.  
  107.     print "\tchar *file = __FILE__;\n";
  108.     print "\tdXSUB_SYS;\n" if $] > 5.002;
  109.  
  110.     foreach $_ (@exts){
  111.     my($pname) = canon('/', $_);
  112.     my($mname, $cname, $ccode);
  113.     ($mname = $pname) =~ s!/!::!g;
  114.     ($cname = $pname) =~ s!/!__!g;
  115.     print "\t{\n";
  116.     if ($pname eq $dl){
  117.         # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  118.         # boot_DynaLoader is called directly in DynaLoader.pm
  119.         $ccode = "\t/* DynaLoader is a special case */\n
  120. \tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
  121.         print $ccode unless $SEEN{$ccode}++;
  122.     } else {
  123.         $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
  124.         print $ccode unless $SEEN{$ccode}++;
  125.     }
  126.     print "\t}\n";
  127.     }
  128.     print $tail2;
  129. }
  130.  
  131. sub canon{
  132.     my($as, @ext) = @_;
  133.     foreach(@ext){
  134.         # might be X::Y or lib/auto/X/Y/Y.a
  135.         next if s!::!/!g;
  136.         s:^(lib|ext)/(auto/)?::;
  137.         s:/\w+\.\w+$::;
  138.     }
  139.     grep(s:/:$as:, @ext) if ($as ne '/');
  140.     @ext;
  141. }
  142.  
  143. 1;
  144. __END__
  145.  
  146. =head1 NAME
  147.  
  148. ExtUtils::Miniperl, writemain - write the C code for perlmain.c
  149.  
  150. =head1 SYNOPSIS
  151.  
  152. C<use ExtUtils::Miniperl;>
  153.  
  154. C<writemain(@directories);>
  155.  
  156. =head1 DESCRIPTION
  157.  
  158. This whole module is written when perl itself is built from a script
  159. called minimod.PL. In case you want to patch it, please patch
  160. minimod.PL in the perl distribution instead.
  161.  
  162. writemain() takes an argument list of directories containing archive
  163. libraries that relate to perl modules and should be linked into a new
  164. perl binary. It writes to STDOUT a corresponding perlmain.c file that
  165. is a plain C file containing all the bootstrap code to make the
  166. modules associated with the libraries available from within perl.
  167.  
  168. The typical usage is from within a Makefile generated by
  169. ExtUtils::MakeMaker. So under normal circumstances you won't have to
  170. deal with this module directly.
  171.  
  172. =head1 SEE ALSO
  173.  
  174. L<ExtUtils::MakeMaker>
  175.  
  176. =cut
  177.  
  178.