lib/perl5/5.6.1/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 /*
  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 (!PL_do_undump) {
  58         my_perl = perl_alloc();
  59         if (!my_perl)
  60             exit(1);
  61         perl_construct(my_perl);
  62         PL_perl_destruct_level = 0;
  63     }
  64
  65     exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
  66     if (!exitstatus) {
  67         exitstatus = perl_run(my_perl);
  68     }
  69
  70     perl_destruct(my_perl);
  71     perl_free(my_perl);
  72
  73     PERL_SYS_TERM();
  74
  75     exit(exitstatus);
  76     return exitstatus;
  77 }
  78
  79 /* Register any extra external extensions */
  80
  81 EOF!HEAD
  82 $tail=<<'EOF!TAIL';
  83
  84 static void
  85 xs_init(pTHX)
  86 {
  87 }
  88 EOF!TAIL
  89
  90 sub writemain{
  91     my(@exts) = @_;
  92
  93     my($pname);
  94     my($dl) = canon('/','DynaLoader');
  95     print $head;
  96
  97     foreach $_ (@exts){
  98         my($pname) = canon('/', $_);
  99         my($mname, $cname);
 100         ($mname = $pname) =~ s!/!::!g;
 101         ($cname = $pname) =~ s!/!__!g;
 102         print "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n";
 103     }
 104
 105     my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
 106     print $tail1;
 107
 108     print "\tchar *file = __FILE__;\n";
 109     print "\tdXSUB_SYS;\n" if $] > 5.002;
 110
 111     foreach $_ (@exts){
 112         my($pname) = canon('/', $_);
 113         my($mname, $cname, $ccode);
 114         ($mname = $pname) =~ s!/!::!g;
 115         ($cname = $pname) =~ s!/!__!g;
 116         print "\t{\n";
 117         if ($pname eq $dl){
 118             # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
 119             # boot_DynaLoader is called directly in DynaLoader.pm
 120             $ccode = "\t/* DynaLoader is a special case */\n
 121 \tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
 122             print $ccode unless $SEEN{$ccode}++;
 123         } else {
 124             $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
 125             print $ccode unless $SEEN{$ccode}++;
 126         }
 127         print "\t}\n";
 128     }
 129     print $tail2;
 130 }
 131
 132 sub canon{
 133     my($as, @ext) = @_;
 134         foreach(@ext){
 135             # might be X::Y or lib/auto/X/Y/Y.a
 136                 next if s!::!/!g;
 137             s:^(lib|ext)/(auto/)?::;
 138             s:/\w+\.\w+$::;
 139         }
 140         grep(s:/:$as:, @ext) if ($as ne '/');
 141         @ext;
 142 }
 143
 144 1;
 145 __END__
 146
 147 =head1 NAME
 148
 149 ExtUtils::Miniperl, writemain - write the C code for perlmain.c
 150
 151 =head1 SYNOPSIS
 152
 153 C<use ExtUtils::Miniperl;>
 154
 155 C<writemain(@directories);>
 156
 157 =head1 DESCRIPTION
 158
 159 This whole module is written when perl itself is built from a script
 160 called minimod.PL. In case you want to patch it, please patch
 161 minimod.PL in the perl distribution instead.
 162
 163 writemain() takes an argument list of directories containing archive
 164 libraries that relate to perl modules and should be linked into a new
 165 perl binary. It writes to STDOUT a corresponding perlmain.c file that
 166 is a plain C file containing all the bootstrap code to make the
 167 modules associated with the libraries available from within perl.
 168
 169 The typical usage is from within a Makefile generated by
 170 ExtUtils::MakeMaker. So under normal circumstances you won't have to
 171 deal with this module directly.
 172
 173 =head1 SEE ALSO
 174
 175 L<ExtUtils::MakeMaker>
 176
 177 =cut
 178