home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / writemain < prev    next >
Encoding:
Text File  |  1995-11-05  |  1.8 KB  |  82 lines  |  [TEXT/MPS ]
  1. #!perl
  2. # This script takes the plain miniperlmain.c and writes out perlmain.c
  3. # which includes all the extensions.
  4. # The command line arguments name extensions to be used.
  5. #  E.g.:  miniperl writemain SDBM_File POSIX > perlmain.c
  6. #
  7.  
  8. if ($ARGV[0] eq "-runperl") {
  9.     $runperl = shift @ARGV;
  10. }
  11.  
  12. foreach (@ARGV) {
  13.     s/\.o$//; s/\.o\.PPC$//; s/\.o\.68K$//; s/\.xcoff$//;
  14.     s/ext:(.*):[^:]*/$1/ && next;
  15.     s/.*:(.*)/$1/;
  16. }
  17.  
  18. open(MAIN, "miniperlmain.c") || die "Couldn't open miniperlmain.c: $!";
  19.  
  20. while (<MAIN>) {
  21.     s/(perl_destruct_level\s+=\s+)0/${1}2/ if $runperl;
  22.     s/^main\(/run_perl\(/ if $runperl;
  23.     last if /Do not delete this line--writemain depends on it/;
  24.     print;
  25. }
  26.  
  27. if ($#ARGV > -1) {
  28.     print "    char *file = __FILE__;\n";
  29.     $ai = "";
  30.     
  31.     foreach $ext (@ARGV) {
  32.         ($mname = $ext) =~ s!/!::!g;
  33.         ($cname = $mname) =~ s!:!_!g;
  34.         
  35.         print "    {   extern void boot_${cname} _((CV* cv));\n";
  36.         
  37.         if ($ext eq "DynaLoader") {
  38.              # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  39.              # boot_DynaLoader is called directly in DynaLoader.pm
  40.              print "        newXS(\"${mname}::boot_${ext}\", boot_${cname}, file);\n";
  41.         } else {
  42.              print "        newXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
  43.         }
  44.         
  45.         if (opendir(AUTOINIT, ":ext:$ext:")) {
  46.             while ($auto = readdir(AUTOINIT)) {
  47.                 next unless ($auto =~ /^AutoInit\./i);
  48.                 open(AI, ":ext:$ext:$auto");
  49.                 if ($auto =~ /\.c$/) {
  50.                     print "    /* autoinit code from $aifile follows: */\n";
  51.                     print "    {\n";
  52.                     while (<AI>) {
  53.                         print;
  54.                     }
  55.                     print "    }\n";
  56.                 } elsif ($auto =~ /\.pl$/) {
  57.                     while (<AI>) {
  58.                         chop;
  59.                         $ai .= $_ . " ";
  60.                     }
  61.                 }
  62.             }
  63.         }
  64.         print "    }\n";
  65.     }
  66.     if ($ai ne "") {
  67.         print "    autoboot_preamble = \"BEGIN { $ai }\";\n"
  68.     }
  69. }
  70. print "}\n";
  71.  
  72. if ($runperl) {
  73.     print <<END_EXIT;
  74.  
  75. #undef exit
  76.  
  77. void (exit)(int status)
  78. {
  79.     my_exit(status);
  80. }
  81. END_EXIT
  82. }