This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
support cygwin and other platforms that link to import libraries
[perl5.git] / utils / perlcc.PL
1 #!/usr/local/bin/perl
2  
3 use Config;
4 use File::Basename qw(&basename &dirname);
5 use File::Spec;
6 use Cwd;
7  
8 # List explicitly here the variables you want Configure to
9 # generate.  Metaconfig only looks for shell variables, so you
10 # have to mention them as if they were shell variables, not
11 # %Config entries.  Thus you write
12 #  $startperl
13 # to ensure Configure will look for $Config{startperl}.
14 # Wanted:  $archlibexp
15  
16 # This forces PL files to create target in same directory as PL file.
17 # This is so that make depend always knows where to find PL derivatives.
18 $origdir = cwd;
19 chdir dirname($0);
20 $file = basename($0, '.PL');
21 $file .= '.com' if $^O eq 'VMS';
22  
23 open OUT,">$file" or die "Can't create $file: $!";
24  
25 print "Extracting $file (with variable substitutions)\n";
26  
27 # In this section, perl variables will be expanded during extraction.
28 # You can use $Config{...} to use Configure variables.
29  
30 print OUT <<"!GROK!THIS!";
31 $Config{startperl}
32     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
33     if \$running_under_some_shell;
34 !GROK!THIS!
35  
36 # In the following, perl variables are not expanded during extraction.
37  
38 print OUT <<'!NO!SUBS!';
39
40 use Config;
41 use strict;
42 use FileHandle;
43 use File::Basename qw(&basename &dirname);
44 use Cwd;
45
46 use Getopt::Long;
47
48 $Getopt::Long::bundling_override = 1;
49 $Getopt::Long::passthrough = 0;
50 $Getopt::Long::ignore_case = 0;
51
52 my $pathsep = ($Config{'osname'} eq 'MSWin32')? "\\" : "/"; # MAJOR HACK. SHOULD
53                                                             # BE IN Config.pm
54
55 my $options = {};
56 my $_fh;
57 unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
58
59 main();
60
61 sub main
62 {
63
64     GetOptions
65             (
66             $options,   "L:s",
67                         "I:s",
68                         "C:s",
69                         "o:s",
70                         "e:s",
71                         "regex:s",
72                         "verbose:s",
73                         "log:s",
74                         "argv:s",
75                         "b",
76                         "opt",
77                         "gen",
78                         "sav",
79                         "run",
80                         "prog",
81                         "mod"
82             );
83
84
85     my $key;
86
87     local($") = "|";
88
89     _usage() if (!_checkopts());
90     push(@ARGV, _maketempfile()) if ($options->{'e'});
91
92     _usage() if (!@ARGV);
93                 
94     my $file;
95     foreach $file (@ARGV)
96     {
97         _print("
98 --------------------------------------------------------------------------------
99 Compiling $file:
100 --------------------------------------------------------------------------------
101 ", 36 );
102         _doit($file);
103     }
104 }
105         
106 sub _doit
107 {
108     my ($file) = @_;
109
110     my ($program_ext, $module_ext) = _getRegexps();
111     my ($obj, $objfile, $so, $type, $backend, $gentype);
112
113     $backend = $options->{'b'} ? 'Bytecode' : $options->{'opt'} ? 'CC' : 'C';
114
115     $gentype = $options->{'b'} ? 'Bytecode' : 'C';
116
117     if  (
118             (($file =~ m"@$program_ext") && ($file !~ m"@$module_ext"))
119             || (defined($options->{'prog'}) || defined($options->{'run'}))
120         )
121     {
122         $type = 'program';
123
124         if ($options->{'b'})
125         {
126             $obj = $objfile = $options->{'o'} ? $options->{'o'} : "${file}c";
127         }
128         else
129         {
130             $objfile = $options->{'C'} ? $options->{'C'} : "$file.c";
131             $obj = $options->{'o'} ? $options->{'o'}
132                                    : _getExecutable( $file,$program_ext);
133         }
134
135         return() if (!$obj);
136
137     }
138     elsif (($file =~ m"@$module_ext") || ($options->{'mod'}))
139     {
140         $type = 'module';
141
142         if ($options->{'b'})
143         {
144             $obj = $objfile = $options->{'o'} ? $options->{'o'} : "${file}c";
145         }
146         else
147         {
148             die "Shared objects are not supported on Win32 yet!!!!\n"
149                                           if ($Config{'osname'} eq 'MSWin32');
150
151             $objfile = $options->{'C'} ? $options->{'C'} : "$file.c";
152             $obj = $options->{'o'} ? $options->{'o'}
153                                    : _getExecutable($file, $module_ext);
154             $so = "$obj.$Config{so}";
155         }
156
157         return() if (!$obj);
158     }
159     else
160     {
161         _error("noextension", $file, $program_ext, $module_ext);
162         return();
163     }
164
165     if ($type eq 'program')
166     {
167         _print("Making $gentype($objfile) for $file!\n", 36 );
168
169         my $errcode = _createCode($backend, $objfile, $file);
170         (_print( "ERROR: In generating code for $file!\n", -1), return()) 
171                                                                 if ($errcode);
172
173         _print("Compiling C($obj) for $file!\n", 36 ) if (!$options->{'gen'} &&
174                                                           !$options->{'b'});
175         $errcode = _compileCode($file, $objfile, $obj) 
176                                             if (!$options->{'gen'} &&
177                                                 !$options->{'b'});
178
179         if ($errcode)
180                 {
181                         _print( "ERROR: In compiling code for $objfile !\n", -1);
182                         my $ofile = File::Basename::basename($objfile);
183                         $ofile =~ s"\.c$"\.o"s;
184                         
185                         _removeCode("$ofile"); 
186                         return()
187                 }
188     
189         _runCode($objfile) if ($options->{'run'} && $options->{'b'});
190         _runCode($obj) if ($options->{'run'} && !$options->{'b'});
191
192         _removeCode($objfile) if (($options->{'b'} &&
193                                    ($options->{'e'} && !$options->{'o'})) ||
194                                   (!$options->{'b'} &&
195                                    (!$options->{'sav'} || 
196                                     ($options->{'e'} && !$options->{'C'}))));
197
198         _removeCode($file) if ($options->{'e'}); 
199
200         _removeCode($obj) if (!$options->{'b'} &&
201                               (($options->{'e'} &&
202                                 !$options->{'sav'} && !$options->{'o'}) ||
203                                ($options->{'run'} && !$options->{'sav'})));
204     }
205     else
206     {
207         _print( "Making $gentype($objfile) for $file!\n", 36 );
208         my $errcode = _createCode($backend, $objfile, $file, $obj);
209         (_print( "ERROR: In generating code for $file!\n", -1), return()) 
210                                                                 if ($errcode);
211     
212         _print( "Compiling C($so) for $file!\n", 36 ) if (!$options->{'gen'} &&
213                                                           !$options->{'b'});
214
215         $errcode = 
216             _compileCode($file, $objfile, $obj, $so ) if (!$options->{'gen'} &&
217                                                           !$options->{'b'});
218
219         (_print( "ERROR: In compiling code for $objfile!\n", -1), return()) 
220                                                                 if ($errcode);
221     }
222 }
223
224 sub _getExecutable
225 {
226     my ($sourceprog, $ext) = @_;
227     my ($obj);
228
229     if (defined($options->{'regex'}))
230     {
231         eval("(\$obj = \$sourceprog) =~ $options->{'regex'}");
232         return(0) if (_error('badeval', $@));
233         return(0) if (_error('equal', $obj, $sourceprog));
234     }
235     elsif (defined ($options->{'ext'}))
236     {
237         ($obj = $sourceprog) =~ s"@$ext"$options->{ext}"g;        
238         return(0) if (_error('equal', $obj, $sourceprog));
239     }
240     elsif (defined ($options->{'run'}))
241     {
242             $obj = "perlc$$";
243     }
244     else
245     {
246         ($obj = $sourceprog) =~ s"@$ext""g;
247         return(0) if (_error('equal', $obj, $sourceprog));
248     }
249     return($obj);
250 }
251
252 sub _createCode
253 {
254     my ( $backend, $generated_file, $file, $final_output ) = @_;
255     my $return;
256
257     local($") = " -I";
258
259     open(GENFILE, "> $generated_file") || die "Can't open $generated_file: $!";
260
261     if ($backend eq "Bytecode")
262     {
263         require ByteLoader;
264
265         print GENFILE "#!$^X\n" if @_ == 3;
266         print GENFILE "use ByteLoader $ByteLoader::VERSION;\n";
267     }
268
269     close(GENFILE);
270
271     if (@_ == 3)                                   # compiling a program   
272     {
273         chmod $generated_file, 0777 & ~umask if $backend eq "Bytecode";
274         my $null=File::Spec->devnull;
275         _print( "$^X -I@INC -MB::Stash -c  $file\n", 36);
276         my @stash=`$^X -I@INC -MB::Stash -c  $file 2>$null`;
277         my $stash=$stash[-1];
278         chomp $stash;
279
280         _print( "$^X -I@INC -MO=$backend,$stash $file\n", 36);
281         $return =  _run("$^X -I@INC -MO=$backend,$stash,-o$generated_file $file", 9);
282         $return;
283     }
284     else                                           # compiling a shared object
285     {            
286         _print( 
287             "$^X -I@INC -MO=$backend,-m$final_output $file\n", 36);
288         $return = 
289         _run("$^X -I@INC -MO=$backend,-m$final_output,-o$generated_file $file  ", 9);
290         $return;
291     }
292 }
293
294 sub _compileCode
295 {
296     my ($sourceprog, $generated_cfile, $output_executable, $shared_object) = @_;
297     my @return;
298
299     if (@_ == 3)                            # just compiling a program 
300     {
301         $return[0] = 
302         _ccharness('static', $sourceprog, "-o", $output_executable,
303                    $generated_cfile);  
304         $return[0];
305     }
306     else
307     {
308         my $object_file = $generated_cfile;
309         $object_file =~ s"\.c$"$Config{_o}";   
310
311         $return[0] = _ccharness('compile', $sourceprog, "-c", $generated_cfile);
312         $return[1] = _ccharness
313                             (
314                                 'dynamic', 
315                                 $sourceprog, "-o", 
316                                 $shared_object, $object_file 
317                             );
318         return(1) if (grep ($_, @return));
319         return(0);
320     }
321 }
322
323 sub _runCode
324 {
325     my ($executable) = @_;
326     _print("$executable $options->{'argv'}\n", 36);
327     _run("$executable $options->{'argv'}", -1 );
328 }
329
330 sub _removeCode
331 {
332     my ($file) = @_;
333     unlink($file) if (-e $file);
334 }
335
336 sub _ccharness
337 {
338     my $type = shift;
339     my (@args) = @_;
340     local($") = " ";
341
342     my $sourceprog = shift(@args);
343     my ($libdir, $incdir);
344
345     if (-d "$Config{installarchlib}/CORE")
346     {
347         $libdir = "-L$Config{installarchlib}/CORE";
348         $incdir = "-I$Config{installarchlib}/CORE";
349     }
350     else
351     {
352         $libdir = "-L.. -L."; 
353         $incdir = "-I.. -I.";
354     }
355
356     $libdir .= " -L$options->{L}" if (defined($options->{L}));
357     $incdir .= " -I$options->{L}" if (defined($options->{L}));
358
359     my $linkargs = '';
360     my $dynaloader = '';
361     my $optimize = '';
362     my $flags = '';
363
364     if (!grep(/^-[cS]$/, @args))
365     {
366         my $lperl = $^O eq 'os2' ? '-llibperl' 
367            : $^O eq 'MSWin32' ? "$Config{archlibexp}\\CORE\\perl.lib"
368            : '-lperl';
369
370         $optimize = $Config{'optimize'} =~ /-O\d/ ? '' : $Config{'optimize'};
371
372         $flags = $type eq 'dynamic' ? $Config{lddlflags} : $Config{ldflags};
373         $linkargs = "$flags $libdir $lperl @Config{libs}";
374     }
375
376     my $libs = _getSharedObjects($sourceprog);
377
378     my $ccflags = $Config{ccflags};
379     $ccflags .= ' -DUSEIMPORTLIB' if $Config{osname} =~ /cygwin/i;
380     my $cccmd = "$Config{cc} $ccflags $optimize $incdir "
381                 ."@args $dynaloader $linkargs @$libs";
382
383     _print ("$cccmd\n", 36);
384     _run("$cccmd", 18 );
385 }
386
387 sub _getSharedObjects
388 {
389     my ($sourceprog) = @_;
390     my ($tmpfile, $incfile);
391     my (@sharedobjects, @libraries);
392     local($") = " -I";
393
394     my ($tmpprog);
395     ($tmpprog = $sourceprog) =~ s"(.*)[\\/](.*)"$2";
396
397     my $tempdir= File::Spec->tmpdir;
398
399     $tmpfile = "$tempdir/$tmpprog.tst";
400     $incfile = "$tempdir/$tmpprog.val";
401
402     my $fd = new FileHandle("> $tmpfile") || die "Couldn't open $tmpfile!\n";
403     my $fd2 = 
404         new FileHandle("$sourceprog") || die "Couldn't open $sourceprog!\n";
405
406     print $fd <<"EOF";
407         use FileHandle;
408         my \$fh3  = new FileHandle("> $incfile") 
409                                         || die "Couldn't open $incfile\\n";
410
411         my \$key;
412         foreach \$key (keys(\%INC)) { print \$fh3 "\$key:\$INC{\$key}\\n"; }
413         close(\$fh3);
414         exit();
415 EOF
416
417     print $fd (   <$fd2>    );
418     close($fd);
419
420     _print("$^X -I@INC $tmpfile\n", 36);
421     _run("$^X -I@INC $tmpfile", 9 );
422
423     $fd = new FileHandle ("$incfile"); 
424     my @lines = <$fd>;    
425
426     unlink($tmpfile);
427     unlink($incfile);
428
429     my $line;
430     my $autolib;
431
432     my @return;
433
434     foreach $line (@lines) 
435     {
436         chomp($line);
437
438         my ($modname, $modpath) = split(':', $line);
439         my ($dir, $file) = ($modpath=~ m"(.*)[\\/]($modname)");
440
441         if ($autolib = _lookforAuto($dir, $file)) { push(@return, $autolib); }
442     }
443     return(\@return);
444 }
445
446 sub _maketempfile
447 {
448     my $return;
449
450 #    if ($Config{'osname'} eq 'MSWin32') 
451 #            { $return = "C:\\TEMP\\comp$$.p"; }
452 #    else
453 #            { $return = "/tmp/comp$$.p"; }
454
455     $return = "comp$$.p"; 
456
457     my $fd = new FileHandle( "> $return") || die "Couldn't open $return!\n";
458     print $fd $options->{'e'};
459     close($fd);
460
461     return($return);
462 }
463     
464     
465 sub _lookforAuto
466 {
467     my ($dir, $file) = @_;    
468
469     my ($relabs, $relshared);
470     my ($prefix);
471     my $return;
472     my $sharedextension = $^O =~ /MSWin32|cygwin|os2/i
473                           ? $Config{_a} : ".$Config{so}";
474     ($prefix = $file) =~ s"(.*)\.pm"$1";
475
476     my ($tmp, $modname) = ($prefix =~ m"(?:(.*)[\\/]){0,1}(.*)"s);
477
478     $relshared = "$pathsep$prefix$pathsep$modname$sharedextension";
479     $relabs    = "$pathsep$prefix$pathsep$modname$Config{_a}";
480                                                # HACK . WHY DOES _a HAVE A '.'
481                                                # AND so HAVE NONE??
482
483     my @searchpaths =   map("$_${pathsep}auto", @INC);
484     
485     my $path;
486     foreach $path (@searchpaths)
487     {
488         if (-e ($return = "$path$relshared")) { return($return); } 
489         if (-e ($return = "$path$relabs"))    { return($return); }
490     }
491    return(undef);
492 }
493
494 sub _getRegexps    # make the appropriate regexps for making executables, 
495 {                  # shared libs
496
497     my ($program_ext, $module_ext) = ([],[]); 
498
499
500     @$program_ext = ($ENV{PERL_SCRIPT_EXT})? split(':', $ENV{PERL_SCRIPT_EXT}) :
501                                             ('.p$', '.pl$', '.bat$');
502
503
504     @$module_ext  = ($ENV{PERL_MODULE_EXT})? split(':', $ENV{PERL_MODULE_EXT}) :
505                                             ('.pm$');
506
507     _mungeRegexp( $program_ext );
508     _mungeRegexp( $module_ext  );    
509
510     return($program_ext, $module_ext);
511 }
512
513 sub _mungeRegexp
514 {
515     my ($regexp) = @_;
516
517     grep(s:(^|[^\\])\.:$1\x00\\.:g, @$regexp);
518     grep(s:(^|[^\x00])\\\.:$1\.:g,  @$regexp);
519     grep(s:\x00::g,                 @$regexp);
520 }
521
522 sub _error
523 {
524     my ($type, @args) = @_;
525
526     if ($type eq 'equal')
527     {
528             
529         if ($args[0] eq $args[1])
530         {
531             _print ("ERROR: The object file '$args[0]' does not generate a legitimate executable file! Skipping!\n", -1);
532             return(1);
533         }
534     }
535     elsif ($type eq 'badeval')
536     {
537         if ($args[0])
538         {
539             _print ("ERROR: $args[0]\n", -1);
540             return(1);
541         }
542     }
543     elsif ($type eq 'noextension')
544     {
545         my $progext = join(',', @{$args[1]});
546         my $modext  = join(',', @{$args[2]});
547
548         $progext =~ s"\\""g;
549         $modext  =~ s"\\""g;
550
551         $progext =~ s"\$""g;
552         $modext  =~ s"\$""g;
553
554         _print 
555         (
556 "
557 ERROR: '$args[0]' does not have a proper extension! Proper extensions are:
558
559     PROGRAM:       $progext 
560     SHARED OBJECT: $modext
561
562 Use the '-prog' flag to force your files to be interpreted as programs.
563 Use the '-mod' flag to force your files to be interpreted as modules.
564 ", -1
565         );
566         return(1);
567     }
568
569     return(0);
570 }
571
572 sub _checkopts
573 {
574     my @errors;
575     local($") = "\n";
576
577     if ($options->{'log'})
578     {
579         $_fh = new FileHandle(">> $options->{'log'}") || push(@errors, "ERROR: Couldn't open $options->{'log'}\n");
580     }
581
582     if ($options->{'b'} && $options->{'c'})
583     {
584         push(@errors,
585 "ERROR: The '-b' and '-c' options are incompatible. The '-c' option specifies
586        a name for the intermediate C code but '-b' generates byte code
587        directly.\n");
588     }
589     if ($options->{'b'} && ($options->{'sav'} || $options->{'gen'}))
590     {
591         push(@errors,
592 "ERROR: The '-sav' and '-gen' options are incompatible with the '-b' option.
593        They ask for intermediate C code to be saved by '-b' generates byte
594        code directly.\n");
595     }
596
597     if (($options->{'c'}) && (@ARGV > 1) && ($options->{'sav'} ))
598     {
599         push(@errors, 
600 "ERROR: The '-sav' and '-C' options are incompatible when you have more than 
601        one input file! ('-C' explicitly names resulting C code, '-sav' saves it,
602        and hence, with more than one file, the c code will be overwritten for 
603        each file that you compile)\n");
604     }
605     if (($options->{'o'}) && (@ARGV > 1))
606     {
607         push(@errors, 
608 "ERROR: The '-o' option is incompatible when you have more than one input 
609        file! (-o explicitly names the resulting file, hence, with more than 
610        one file the names clash)\n");
611     }
612
613     if ($options->{'e'} && ($options->{'sav'} || $options->{'gen'}) &&
614                                                             !$options->{'C'})
615     {
616         push(@errors, 
617 "ERROR: You need to specify where you are going to save the resulting 
618        C code when using '-sav' and '-e'. Use '-C'.\n");
619     }
620
621     if (($options->{'regex'} || $options->{'run'} || $options->{'o'}) 
622                                                     && $options->{'gen'})
623     {
624         push(@errors, 
625 "ERROR: The options '-regex', '-run', and '-o' are incompatible with '-gen'. 
626        '-gen' says to stop at C generation, and the other three modify the 
627        compilation and/or running process!\n");
628     }
629
630     if ($options->{'run'} && $options->{'mod'})
631     {
632         push(@errors, 
633 "ERROR: Can't run modules that you are compiling! '-run' and '-mod' are 
634        incompatible!\n"); 
635     }
636
637     if ($options->{'e'} && @ARGV)
638     {
639         push (@errors, 
640 "ERROR: The option '-e' needs to be all by itself without any other 
641        file arguments!\n");
642     }
643     if ($options->{'e'} && !($options->{'o'} || $options->{'run'}))
644     {
645         $options->{'run'} = 1;
646     }
647
648     if (!defined($options->{'verbose'})) 
649     { 
650         $options->{'verbose'} = ($options->{'log'})? 64 : 7; 
651     }
652
653     my $verbose_error;
654
655     if ($options->{'verbose'} =~ m"[^tagfcd]" && 
656             !( $options->{'verbose'} eq '0' || 
657                 ($options->{'verbose'} < 64 && $options->{'verbose'} > 0)))
658     {
659         $verbose_error = 1;
660         push(@errors, 
661 "ERROR: Illegal verbosity level.  Needs to have either the letters 
662        't','a','g','f','c', or 'd' in it or be between 0 and 63, inclusive.\n");
663     }
664
665     $options->{'verbose'} = ($options->{'verbose'} =~ m"[tagfcd]")? 
666                             ($options->{'verbose'} =~ m"d") * 32 +     
667                             ($options->{'verbose'} =~ m"c") * 16 +     
668                             ($options->{'verbose'} =~ m"f") * 8     +     
669                             ($options->{'verbose'} =~ m"t") * 4     +     
670                             ($options->{'verbose'} =~ m"a") * 2     +     
671                             ($options->{'verbose'} =~ m"g") * 1     
672                                                     : $options->{'verbose'};
673
674     if     (!$verbose_error && (    $options->{'log'} && 
675                                 !(
676                                     ($options->{'verbose'} & 8)   || 
677                                     ($options->{'verbose'} & 16)  || 
678                                     ($options->{'verbose'} & 32 ) 
679                                 )
680                             )
681         )
682     {
683         push(@errors, 
684 "ERROR: The verbosity level '$options->{'verbose'}' does not output anything 
685        to a logfile, and you specified '-log'!\n");
686     } # }
687
688     if     (!$verbose_error && (    !$options->{'log'} && 
689                                 (
690                                     ($options->{'verbose'} & 8)   || 
691                                     ($options->{'verbose'} & 16)  || 
692                                     ($options->{'verbose'} & 32)  || 
693                                     ($options->{'verbose'} & 64)
694                                 )
695                             )
696         )
697     {
698         push(@errors, 
699 "ERROR: The verbosity level '$options->{'verbose'}' requires that you also 
700        specify a logfile via '-log'\n");
701     } # }
702
703
704     (_print( "\n". join("\n", @errors), -1), return(0)) if (@errors);
705     return(1);
706 }
707
708 sub _print
709 {
710     my ($text, $flag ) = @_;
711     
712     my $logflag = int($flag/8) * 8;
713     my $regflag = $flag % 8;
714
715     if ($flag == -1 || ($flag & $options->{'verbose'}))
716     {
717         my $dolog = ((($logflag & $options->{'verbose'}) || $flag == -1) 
718                                                         && $options->{'log'}); 
719
720         my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
721         
722         if ($doreg) { print( STDERR $text ); }
723         if ($dolog) { print $_fh $text; }
724     }
725 }
726
727 sub _run
728 {
729     my ($command, $flag) = @_;
730
731     my $logflag = ($flag != -1)? int($flag/8) * 8 : 0;
732     my $regflag = $flag % 8;
733
734     if ($flag == -1 || ($flag & $options->{'verbose'}))
735     {
736         my $dolog = ($logflag & $options->{'verbose'} && $options->{'log'});
737         my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
738
739         if ($doreg && !$dolog) 
740         {
741             print _interruptrun("$command");
742         }
743         elsif ($doreg && $dolog) 
744         { 
745             my $text = _interruptrun($command); 
746             print $_fh $text; 
747             print STDERR $text;
748         }
749         else 
750         { 
751             my $text = _interruptrun($command);
752             print $_fh $text; 
753         }
754     }
755     else 
756     {
757         _interruptrun($command);
758     }
759     return($?);
760 }
761
762 sub _interruptrun
763 {
764     my ($command) = @_;
765     my $pid = open (FD, "$command  |");
766
767     local($SIG{HUP}) = sub { 
768 #       kill 9, $pid + 1;  
769 #       HACK... 2>&1 doesn't propogate
770 #       kill, comment out for quick and dirty
771 #       process killing of child.
772
773         kill 9, $pid;  
774         exit(); 
775     };
776     local($SIG{INT}) = sub { 
777 #       kill 9, $pid + 1;  
778 #       HACK... 2>&1 doesn't propogate
779 #       kill, comment out for quick and dirty
780 #       process killing of child.
781         kill 9, $pid; 
782         exit(); 
783     }; 
784
785     my $needalarm = 
786             ($ENV{'PERLCC_TIMEOUT'} && 
787                     $Config{'osname'} ne 'MSWin32' && $command =~ m"^perlc");
788     my $text;
789
790     eval
791     {
792         local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
793         alarm($ENV{'PERLCC_TIMEOUT'}) if ($needalarm);
794         $text = join('', <FD>); 
795         alarm(0) if ($needalarm);
796     };
797
798     if ($@) 
799     { 
800         eval { kill 'HUP', $pid; };
801         _print("SYSTEM TIMEOUT (infinite loop?)\n", 36); 
802     }
803         
804     close(FD);
805     return($text);
806 }
807
808 sub _usage
809 {
810     _print
811     ( 
812     <<"EOF"
813
814 Usage: $0 <file_list> 
815
816 WARNING: The whole compiler suite ('perlcc' included) is considered VERY
817 experimental.  Use for production purposes is strongly discouraged.
818
819     Flags with arguments
820         -L       < extra library dirs for installation (form of 'dir1:dir2') >
821         -I       < extra include dirs for installation (form of 'dir1:dir2') >
822         -C       < explicit name of resulting C code > 
823         -o       < explicit name of resulting executable >
824         -e       < to compile 'one liners'. Need executable name (-o) or '-run'>
825         -regex   < rename regex, -regex 's/\.p/\.exe/' compiles a.p to a.exe >
826         -verbose < verbose level < 1-63, or following letters 'gatfcd' >
827         -argv    < arguments for the executables to be run via '-run' or '-e' > 
828
829     Boolean flags
830         -b       ( to generate byte code )
831         -opt     ( to generated optimised C code. May not work in some cases. )
832         -gen     ( to just generate the C code. Implies '-sav' )
833         -sav     ( to save intermediate C code, (and executables with '-run'))
834         -run     ( to run the compiled program on the fly, as were interpreted.)
835         -prog    ( to indicate that the files on command line are programs )
836         -mod     ( to indicate that the files on command line are modules  )
837
838 EOF
839 , -1
840
841     );
842     exit(255);
843 }
844
845
846 __END__
847
848 =head1 NAME
849
850 perlcc - frontend for perl compiler
851
852 =head1 SYNOPSIS
853
854     %prompt  perlcc a.p        # compiles into executable 'a'
855
856     %prompt  perlcc A.pm       # compile into 'A.so'
857
858     %prompt  perlcc a.p -o execute  # compiles 'a.p' into 'execute'.
859
860     %prompt  perlcc a.p -o execute -run # compiles 'a.p' into execute, runs on
861                                         # the fly
862
863     %prompt  perlcc a.p -o execute -run -argv 'arg1 arg2 arg3' 
864                                         # compiles into execute, runs with 
865                                         # arg1 arg2 arg3 as @ARGV
866
867     %prompt perlcc a.p b.p c.p -regex 's/\.p/\.exe'
868                                         # compiles into 'a.exe','b.exe','c.exe'.
869
870     %prompt perlcc a.p -log compilelog  # compiles into 'a', saves compilation
871                                         # info into compilelog, as well
872                                         # as mirroring to screen
873
874     %prompt perlcc a.p -log compilelog -verbose cdf 
875                                         # compiles into 'a', saves compilation
876                                         # info into compilelog, being silent
877                                         # on screen.
878
879     %prompt perlcc a.p -C a.c -gen      # generates C code (into a.c) and 
880                                         # stops without compile.
881
882     %prompt perlcc a.p -L ../lib a.c 
883                                         # Compiles with the perl libraries 
884                                         # inside ../lib included.
885
886 =head1 DESCRIPTION
887
888 'perlcc' is the frontend into the perl compiler. Typing 'perlcc a.p'
889 compiles the code inside a.p into a standalone executable, and 
890 perlcc A.pm will compile into a shared object, A.so, suitable for inclusion 
891 into a perl program via "use A".
892
893 There are quite a few flags to perlcc which help with such issues as compiling 
894 programs in bulk, testing compiled programs for compatibility with the 
895 interpreter, and controlling.
896
897 =head1 OPTIONS 
898
899 =over 4
900
901 =item -L < library_directories >
902
903 Adds directories in B<library_directories> to the compilation command.
904
905 =item -I  < include_directories > 
906
907 Adds directories inside B<include_directories> to the compilation command.
908
909 =item -C   < c_code_name > 
910
911 Explicitly gives the name B<c_code_name> to the generated file containing
912 the C code which is to be compiled. Can only be used if compiling one file
913 on the command line.
914
915 =item -o   < executable_name >
916
917 Explicitly gives the name B<executable_name> to the executable which is to be
918 compiled. Can only be used if compiling one file on the command line.
919
920 =item -e   < perl_line_to_execute>
921
922 Compiles 'one liners', in the same way that B<perl -e> runs text strings at 
923 the command line. Default is to have the 'one liner' be compiled, and run all
924 in one go (see B<-run>); giving the B<-o> flag saves the resultant executable, 
925 rather than throwing it away. Use '-argv' to pass arguments to the executable
926 created.
927
928 =item -b
929
930 Generates bytecode instead of C code.
931
932 =item -opt
933
934 Uses the optimized C backend (C<B::CC>)rather than the simple C backend
935 (C<B::C>).  Beware that the optimized C backend creates very large
936 switch structures and structure initializations.  Many C compilers
937 find it a challenge to compile the resulting output in finite amounts
938 of time.  Many Perl features such as C<goto LABEL> are also not
939 supported by the optimized C backend.  The simple C backend should
940 work in more instances, but can only offer modest speed increases.
941
942 =item -regex   <rename_regex>
943
944 Gives a rule B<rename_regex> - which is a legal perl regular expression - to 
945 create executable file names.
946
947 =item -verbose <verbose_level>
948
949 Show exactly what steps perlcc is taking to compile your code. You can
950 change the verbosity level B<verbose_level> much in the same way that
951 the C<-D> switch changes perl's debugging level, by giving either a
952 number which is the sum of bits you want or a list of letters
953 representing what you wish to see. Here are the verbosity levels so
954 far :
955
956     Bit 1(g):      Code Generation Errors to STDERR
957     Bit 2(a):      Compilation Errors to STDERR
958     Bit 4(t):      Descriptive text to STDERR 
959     Bit 8(f):      Code Generation Errors to file (B<-log> flag needed)
960     Bit 16(c):     Compilation Errors to file (B<-log> flag needed)
961     Bit 32(d):     Descriptive text to file (B<-log> flag needed) 
962
963 If the B<-log> tag is given, the default verbose level is 63 (ie: mirroring 
964 all of perlcc's output to both the screen and to a log file). If no B<-log>
965 tag is given, then the default verbose level is 7 (ie: outputting all of 
966 perlcc's output to STDERR).
967
968 NOTE: Because of buffering concerns, you CANNOT shadow the output of '-run' to
969 both a file, and to the screen! Suggestions are welcome on how to overcome this
970 difficulty, but for now it simply does not work properly, and hence will only go
971 to the screen.
972
973 =item -log <logname>
974
975 Opens, for append, a logfile to save some or all of the text for a given 
976 compile command. No rewrite version is available, so this needs to be done 
977 manually.
978
979 =item -argv <arguments>
980
981 In combination with C<-run> or C<-e>, tells perlcc to run the resulting 
982 executable with the string B<arguments> as @ARGV.
983
984 =item -sav
985
986 Tells perl to save the intermediate C code. Usually, this C code is the name
987 of the perl code, plus '.c'; 'perlcode.p' gets generated in 'perlcode.p.c',
988 for example. If used with the C<-e> operator, you need to tell perlcc where to 
989 save resulting executables.
990
991 =item -gen
992
993 Tells perlcc to only create the intermediate C code, and not compile the 
994 results. Does an implicit B<-sav>, saving the C code rather than deleting it.
995
996 =item -run
997
998 Immediately run the perl code that has been generated. NOTE: IF YOU GIVE THE 
999 B<-run> FLAG TO B<perlcc>, THEN THE REST OF @ARGV WILL BE INTERPRETED AS 
1000 ARGUMENTS TO THE PROGRAM THAT YOU ARE COMPILING.
1001
1002 =item -prog
1003
1004 Indicate that the programs at the command line are programs, and should be
1005 compiled as such. B<perlcc> will automatically determine files to be 
1006 programs if they have B<.p>, B<.pl>, B<.bat> extensions.
1007
1008 =item -mod
1009
1010 Indicate that the programs at the command line are modules, and should be
1011 compiled as such. B<perlcc> will automatically determine files to be 
1012 modules if they have the extension B<.pm>.
1013
1014 =back
1015
1016 =head1 ENVIRONMENT
1017
1018 Most of the work of B<perlcc> is done at the command line. However, you can 
1019 change the heuristic which determines what is a module and what is a program.
1020 As indicated above, B<perlcc> assumes that the extensions:
1021
1022 .p$, .pl$, and .bat$
1023
1024 indicate a perl program, and:
1025
1026 .pm$
1027
1028 indicate a library, for the purposes of creating executables. And furthermore,
1029 by default, these extensions will be replaced (and dropped) in the process of 
1030 creating an executable. 
1031
1032 To change the extensions which are programs, and which are modules, set the
1033 environmental variables:
1034
1035 PERL_SCRIPT_EXT
1036 PERL_MODULE_EXT
1037
1038 These two environmental variables take colon-separated, legal perl regular 
1039 expressions, and are used by perlcc to decide which objects are which. 
1040 For example:
1041
1042 setenv PERL_SCRIPT_EXT  '.prl$:.perl$'
1043 prompt%   perlcc sample.perl
1044
1045 will compile the script 'sample.perl' into the executable 'sample', and
1046
1047 setenv PERL_MODULE_EXT  '.perlmod$:.perlmodule$'
1048
1049 prompt%   perlcc sample.perlmod
1050
1051 will  compile the module 'sample.perlmod' into the shared object 
1052 'sample.so'
1053
1054 NOTE: the '.' in the regular expressions for PERL_SCRIPT_EXT and PERL_MODULE_EXT
1055 is a literal '.', and not a wild-card. To get a true wild-card, you need to 
1056 backslash the '.'; as in:
1057
1058 setenv PERL_SCRIPT_EXT '\.\.\.\.\.'
1059
1060 which would have the effect of compiling ANYTHING (except what is in 
1061 PERL_MODULE_EXT) into an executable with 5 less characters in its name.
1062
1063 The PERLCC_OPTS environment variable can be set to the default flags
1064 that must be used by the compiler.
1065
1066 The PERLCC_TIMEOUT environment variable can be set to the number of
1067 seconds to wait for the backends before giving up.  This is sometimes
1068 necessary to avoid some compilers taking forever to compile the
1069 generated output.  May not work on Windows and similar platforms.
1070
1071 =head1 FILES
1072
1073 'perlcc' uses a temporary file when you use the B<-e> option to evaluate 
1074 text and compile it. This temporary file is 'perlc$$.p'. The temporary C code is
1075 perlc$$.p.c, and the temporary executable is perlc$$.
1076
1077 When you use '-run' and don't save your executable, the temporary executable is
1078 perlc$$
1079
1080 =head1 BUGS
1081
1082 The whole compiler suite (C<perlcc> included) should be considered very
1083 experimental.  Use for production purposes is strongly discouraged.
1084
1085 perlcc currently cannot compile shared objects on Win32. This should be fixed
1086 in future.
1087
1088 Bugs in the various compiler backends still exist, and are perhaps too
1089 numerous to list here.
1090
1091 =cut
1092
1093 !NO!SUBS!
1094
1095 close OUT or die "Can't close $file: $!";
1096 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1097 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
1098 chdir $origdir;