This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ad2543afb31b20aff2fc35e69ceb1f9208622bbd
[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 $cccmd = "$Config{cc} $Config{ccflags} $optimize $incdir "
379                 ."@args $dynaloader $linkargs @$libs";
380
381     _print ("$cccmd\n", 36);
382     _run("$cccmd", 18 );
383 }
384
385 sub _getSharedObjects
386 {
387     my ($sourceprog) = @_;
388     my ($tmpfile, $incfile);
389     my (@sharedobjects, @libraries);
390     local($") = " -I";
391
392     my ($tmpprog);
393     ($tmpprog = $sourceprog) =~ s"(.*)[\\/](.*)"$2";
394
395     my $tempdir= File::Spec->tmpdir;
396
397     $tmpfile = "$tempdir/$tmpprog.tst";
398     $incfile = "$tempdir/$tmpprog.val";
399
400     my $fd = new FileHandle("> $tmpfile") || die "Couldn't open $tmpfile!\n";
401     my $fd2 = 
402         new FileHandle("$sourceprog") || die "Couldn't open $sourceprog!\n";
403
404     print $fd <<"EOF";
405         use FileHandle;
406         my \$fh3  = new FileHandle("> $incfile") 
407                                         || die "Couldn't open $incfile\\n";
408
409         my \$key;
410         foreach \$key (keys(\%INC)) { print \$fh3 "\$key:\$INC{\$key}\\n"; }
411         close(\$fh3);
412         exit();
413 EOF
414
415     print $fd (   <$fd2>    );
416     close($fd);
417
418     _print("$^X -I@INC $tmpfile\n", 36);
419     _run("$^X -I@INC $tmpfile", 9 );
420
421     $fd = new FileHandle ("$incfile"); 
422     my @lines = <$fd>;    
423
424     unlink($tmpfile);
425     unlink($incfile);
426
427     my $line;
428     my $autolib;
429
430     my @return;
431
432     foreach $line (@lines) 
433     {
434         chomp($line);
435
436         my ($modname, $modpath) = split(':', $line);
437         my ($dir, $file) = ($modpath=~ m"(.*)[\\/]($modname)");
438
439         if ($autolib = _lookforAuto($dir, $file)) { push(@return, $autolib); }
440     }
441     return(\@return);
442 }
443
444 sub _maketempfile
445 {
446     my $return;
447
448 #    if ($Config{'osname'} eq 'MSWin32') 
449 #            { $return = "C:\\TEMP\\comp$$.p"; }
450 #    else
451 #            { $return = "/tmp/comp$$.p"; }
452
453     $return = "comp$$.p"; 
454
455     my $fd = new FileHandle( "> $return") || die "Couldn't open $return!\n";
456     print $fd $options->{'e'};
457     close($fd);
458
459     return($return);
460 }
461     
462     
463 sub _lookforAuto
464 {
465     my ($dir, $file) = @_;    
466
467     my ($relabs, $relshared);
468     my ($prefix);
469     my $return;
470     my $sharedextension=$^O eq 'MSWin32' ? '.lib':$Config{so};
471     ($prefix = $file) =~ s"(.*)\.pm"$1";
472
473     my ($tmp, $modname) = ($prefix =~ m"(?:(.*)[\\/]){0,1}(.*)"s);
474
475     $relshared = "$pathsep$prefix$pathsep$modname$sharedextension";
476     $relabs    = "$pathsep$prefix$pathsep$modname$Config{_a}";
477                                                # HACK . WHY DOES _a HAVE A '.'
478                                                # AND so HAVE NONE??
479
480     my @searchpaths =   map("$_${pathsep}auto", @INC);
481     
482     my $path;
483     foreach $path (@searchpaths)
484     {
485         if (-e ($return = "$path$relshared")) { return($return); } 
486         if (-e ($return = "$path$relabs"))    { return($return); }
487     }
488    return(undef);
489 }
490
491 sub _getRegexps    # make the appropriate regexps for making executables, 
492 {                  # shared libs
493
494     my ($program_ext, $module_ext) = ([],[]); 
495
496
497     @$program_ext = ($ENV{PERL_SCRIPT_EXT})? split(':', $ENV{PERL_SCRIPT_EXT}) :
498                                             ('.p$', '.pl$', '.bat$');
499
500
501     @$module_ext  = ($ENV{PERL_MODULE_EXT})? split(':', $ENV{PERL_MODULE_EXT}) :
502                                             ('.pm$');
503
504     _mungeRegexp( $program_ext );
505     _mungeRegexp( $module_ext  );    
506
507     return($program_ext, $module_ext);
508 }
509
510 sub _mungeRegexp
511 {
512     my ($regexp) = @_;
513
514     grep(s:(^|[^\\])\.:$1\x00\\.:g, @$regexp);
515     grep(s:(^|[^\x00])\\\.:$1\.:g,  @$regexp);
516     grep(s:\x00::g,                 @$regexp);
517 }
518
519 sub _error
520 {
521     my ($type, @args) = @_;
522
523     if ($type eq 'equal')
524     {
525             
526         if ($args[0] eq $args[1])
527         {
528             _print ("ERROR: The object file '$args[0]' does not generate a legitimate executable file! Skipping!\n", -1);
529             return(1);
530         }
531     }
532     elsif ($type eq 'badeval')
533     {
534         if ($args[0])
535         {
536             _print ("ERROR: $args[0]\n", -1);
537             return(1);
538         }
539     }
540     elsif ($type eq 'noextension')
541     {
542         my $progext = join(',', @{$args[1]});
543         my $modext  = join(',', @{$args[2]});
544
545         $progext =~ s"\\""g;
546         $modext  =~ s"\\""g;
547
548         $progext =~ s"\$""g;
549         $modext  =~ s"\$""g;
550
551         _print 
552         (
553 "
554 ERROR: '$args[0]' does not have a proper extension! Proper extensions are:
555
556     PROGRAM:       $progext 
557     SHARED OBJECT: $modext
558
559 Use the '-prog' flag to force your files to be interpreted as programs.
560 Use the '-mod' flag to force your files to be interpreted as modules.
561 ", -1
562         );
563         return(1);
564     }
565
566     return(0);
567 }
568
569 sub _checkopts
570 {
571     my @errors;
572     local($") = "\n";
573
574     if ($options->{'log'})
575     {
576         $_fh = new FileHandle(">> $options->{'log'}") || push(@errors, "ERROR: Couldn't open $options->{'log'}\n");
577     }
578
579     if ($options->{'b'} && $options->{'c'})
580     {
581         push(@errors,
582 "ERROR: The '-b' and '-c' options are incompatible. The '-c' option specifies
583        a name for the intermediate C code but '-b' generates byte code
584        directly.\n");
585     }
586     if ($options->{'b'} && ($options->{'sav'} || $options->{'gen'}))
587     {
588         push(@errors,
589 "ERROR: The '-sav' and '-gen' options are incompatible with the '-b' option.
590        They ask for intermediate C code to be saved by '-b' generates byte
591        code directly.\n");
592     }
593
594     if (($options->{'c'}) && (@ARGV > 1) && ($options->{'sav'} ))
595     {
596         push(@errors, 
597 "ERROR: The '-sav' and '-C' options are incompatible when you have more than 
598        one input file! ('-C' explicitly names resulting C code, '-sav' saves it,
599        and hence, with more than one file, the c code will be overwritten for 
600        each file that you compile)\n");
601     }
602     if (($options->{'o'}) && (@ARGV > 1))
603     {
604         push(@errors, 
605 "ERROR: The '-o' option is incompatible when you have more than one input 
606        file! (-o explicitly names the resulting file, hence, with more than 
607        one file the names clash)\n");
608     }
609
610     if ($options->{'e'} && ($options->{'sav'} || $options->{'gen'}) &&
611                                                             !$options->{'C'})
612     {
613         push(@errors, 
614 "ERROR: You need to specify where you are going to save the resulting 
615        C code when using '-sav' and '-e'. Use '-C'.\n");
616     }
617
618     if (($options->{'regex'} || $options->{'run'} || $options->{'o'}) 
619                                                     && $options->{'gen'})
620     {
621         push(@errors, 
622 "ERROR: The options '-regex', '-run', and '-o' are incompatible with '-gen'. 
623        '-gen' says to stop at C generation, and the other three modify the 
624        compilation and/or running process!\n");
625     }
626
627     if ($options->{'run'} && $options->{'mod'})
628     {
629         push(@errors, 
630 "ERROR: Can't run modules that you are compiling! '-run' and '-mod' are 
631        incompatible!\n"); 
632     }
633
634     if ($options->{'e'} && @ARGV)
635     {
636         push (@errors, 
637 "ERROR: The option '-e' needs to be all by itself without any other 
638        file arguments!\n");
639     }
640     if ($options->{'e'} && !($options->{'o'} || $options->{'run'}))
641     {
642         $options->{'run'} = 1;
643     }
644
645     if (!defined($options->{'verbose'})) 
646     { 
647         $options->{'verbose'} = ($options->{'log'})? 64 : 7; 
648     }
649
650     my $verbose_error;
651
652     if ($options->{'verbose'} =~ m"[^tagfcd]" && 
653             !( $options->{'verbose'} eq '0' || 
654                 ($options->{'verbose'} < 64 && $options->{'verbose'} > 0)))
655     {
656         $verbose_error = 1;
657         push(@errors, 
658 "ERROR: Illegal verbosity level.  Needs to have either the letters 
659        't','a','g','f','c', or 'd' in it or be between 0 and 63, inclusive.\n");
660     }
661
662     $options->{'verbose'} = ($options->{'verbose'} =~ m"[tagfcd]")? 
663                             ($options->{'verbose'} =~ m"d") * 32 +     
664                             ($options->{'verbose'} =~ m"c") * 16 +     
665                             ($options->{'verbose'} =~ m"f") * 8     +     
666                             ($options->{'verbose'} =~ m"t") * 4     +     
667                             ($options->{'verbose'} =~ m"a") * 2     +     
668                             ($options->{'verbose'} =~ m"g") * 1     
669                                                     : $options->{'verbose'};
670
671     if     (!$verbose_error && (    $options->{'log'} && 
672                                 !(
673                                     ($options->{'verbose'} & 8)   || 
674                                     ($options->{'verbose'} & 16)  || 
675                                     ($options->{'verbose'} & 32 ) 
676                                 )
677                             )
678         )
679     {
680         push(@errors, 
681 "ERROR: The verbosity level '$options->{'verbose'}' does not output anything 
682        to a logfile, and you specified '-log'!\n");
683     } # }
684
685     if     (!$verbose_error && (    !$options->{'log'} && 
686                                 (
687                                     ($options->{'verbose'} & 8)   || 
688                                     ($options->{'verbose'} & 16)  || 
689                                     ($options->{'verbose'} & 32)  || 
690                                     ($options->{'verbose'} & 64)
691                                 )
692                             )
693         )
694     {
695         push(@errors, 
696 "ERROR: The verbosity level '$options->{'verbose'}' requires that you also 
697        specify a logfile via '-log'\n");
698     } # }
699
700
701     (_print( "\n". join("\n", @errors), -1), return(0)) if (@errors);
702     return(1);
703 }
704
705 sub _print
706 {
707     my ($text, $flag ) = @_;
708     
709     my $logflag = int($flag/8) * 8;
710     my $regflag = $flag % 8;
711
712     if ($flag == -1 || ($flag & $options->{'verbose'}))
713     {
714         my $dolog = ((($logflag & $options->{'verbose'}) || $flag == -1) 
715                                                         && $options->{'log'}); 
716
717         my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
718         
719         if ($doreg) { print( STDERR $text ); }
720         if ($dolog) { print $_fh $text; }
721     }
722 }
723
724 sub _run
725 {
726     my ($command, $flag) = @_;
727
728     my $logflag = ($flag != -1)? int($flag/8) * 8 : 0;
729     my $regflag = $flag % 8;
730
731     if ($flag == -1 || ($flag & $options->{'verbose'}))
732     {
733         my $dolog = ($logflag & $options->{'verbose'} && $options->{'log'});
734         my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
735
736         if ($doreg && !$dolog) 
737         {
738             print _interruptrun("$command");
739         }
740         elsif ($doreg && $dolog) 
741         { 
742             my $text = _interruptrun($command); 
743             print $_fh $text; 
744             print STDERR $text;
745         }
746         else 
747         { 
748             my $text = _interruptrun($command);
749             print $_fh $text; 
750         }
751     }
752     else 
753     {
754         _interruptrun($command);
755     }
756     return($?);
757 }
758
759 sub _interruptrun
760 {
761     my ($command) = @_;
762     my $pid = open (FD, "$command  |");
763
764     local($SIG{HUP}) = sub { 
765 #       kill 9, $pid + 1;  
766 #       HACK... 2>&1 doesn't propogate
767 #       kill, comment out for quick and dirty
768 #       process killing of child.
769
770         kill 9, $pid;  
771         exit(); 
772     };
773     local($SIG{INT}) = sub { 
774 #       kill 9, $pid + 1;  
775 #       HACK... 2>&1 doesn't propogate
776 #       kill, comment out for quick and dirty
777 #       process killing of child.
778         kill 9, $pid; 
779         exit(); 
780     }; 
781
782     my $needalarm = 
783             ($ENV{'PERLCC_TIMEOUT'} && 
784                     $Config{'osname'} ne 'MSWin32' && $command =~ m"^perlc");
785     my $text;
786
787     eval
788     {
789         local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
790         alarm($ENV{'PERLCC_TIMEOUT'}) if ($needalarm);
791         $text = join('', <FD>); 
792         alarm(0) if ($needalarm);
793     };
794
795     if ($@) 
796     { 
797         eval { kill 'HUP', $pid; };
798         _print("SYSTEM TIMEOUT (infinite loop?)\n", 36); 
799     }
800         
801     close(FD);
802     return($text);
803 }
804
805 sub _usage
806 {
807     _print
808     ( 
809     <<"EOF"
810
811 Usage: $0 <file_list> 
812
813 WARNING: The whole compiler suite ('perlcc' included) is considered VERY
814 experimental.  Use for production purposes is strongly discouraged.
815
816     Flags with arguments
817         -L       < extra library dirs for installation (form of 'dir1:dir2') >
818         -I       < extra include dirs for installation (form of 'dir1:dir2') >
819         -C       < explicit name of resulting C code > 
820         -o       < explicit name of resulting executable >
821         -e       < to compile 'one liners'. Need executable name (-o) or '-run'>
822         -regex   < rename regex, -regex 's/\.p/\.exe/' compiles a.p to a.exe >
823         -verbose < verbose level < 1-63, or following letters 'gatfcd' >
824         -argv    < arguments for the executables to be run via '-run' or '-e' > 
825
826     Boolean flags
827         -b       ( to generate byte code )
828         -opt     ( to generated optimised C code. May not work in some cases. )
829         -gen     ( to just generate the C code. Implies '-sav' )
830         -sav     ( to save intermediate C code, (and executables with '-run'))
831         -run     ( to run the compiled program on the fly, as were interpreted.)
832         -prog    ( to indicate that the files on command line are programs )
833         -mod     ( to indicate that the files on command line are modules  )
834
835 EOF
836 , -1
837
838     );
839     exit(255);
840 }
841
842
843 __END__
844
845 =head1 NAME
846
847 perlcc - frontend for perl compiler
848
849 =head1 SYNOPSIS
850
851     %prompt  perlcc a.p        # compiles into executable 'a'
852
853     %prompt  perlcc A.pm       # compile into 'A.so'
854
855     %prompt  perlcc a.p -o execute  # compiles 'a.p' into 'execute'.
856
857     %prompt  perlcc a.p -o execute -run # compiles 'a.p' into execute, runs on
858                                         # the fly
859
860     %prompt  perlcc a.p -o execute -run -argv 'arg1 arg2 arg3' 
861                                         # compiles into execute, runs with 
862                                         # arg1 arg2 arg3 as @ARGV
863
864     %prompt perlcc a.p b.p c.p -regex 's/\.p/\.exe'
865                                         # compiles into 'a.exe','b.exe','c.exe'.
866
867     %prompt perlcc a.p -log compilelog  # compiles into 'a', saves compilation
868                                         # info into compilelog, as well
869                                         # as mirroring to screen
870
871     %prompt perlcc a.p -log compilelog -verbose cdf 
872                                         # compiles into 'a', saves compilation
873                                         # info into compilelog, being silent
874                                         # on screen.
875
876     %prompt perlcc a.p -C a.c -gen      # generates C code (into a.c) and 
877                                         # stops without compile.
878
879     %prompt perlcc a.p -L ../lib a.c 
880                                         # Compiles with the perl libraries 
881                                         # inside ../lib included.
882
883 =head1 DESCRIPTION
884
885 'perlcc' is the frontend into the perl compiler. Typing 'perlcc a.p'
886 compiles the code inside a.p into a standalone executable, and 
887 perlcc A.pm will compile into a shared object, A.so, suitable for inclusion 
888 into a perl program via "use A".
889
890 There are quite a few flags to perlcc which help with such issues as compiling 
891 programs in bulk, testing compiled programs for compatibility with the 
892 interpreter, and controlling.
893
894 =head1 OPTIONS 
895
896 =over 4
897
898 =item -L < library_directories >
899
900 Adds directories in B<library_directories> to the compilation command.
901
902 =item -I  < include_directories > 
903
904 Adds directories inside B<include_directories> to the compilation command.
905
906 =item -C   < c_code_name > 
907
908 Explicitly gives the name B<c_code_name> to the generated file containing
909 the C code which is to be compiled. Can only be used if compiling one file
910 on the command line.
911
912 =item -o   < executable_name >
913
914 Explicitly gives the name B<executable_name> to the executable which is to be
915 compiled. Can only be used if compiling one file on the command line.
916
917 =item -e   < perl_line_to_execute>
918
919 Compiles 'one liners', in the same way that B<perl -e> runs text strings at 
920 the command line. Default is to have the 'one liner' be compiled, and run all
921 in one go (see B<-run>); giving the B<-o> flag saves the resultant executable, 
922 rather than throwing it away. Use '-argv' to pass arguments to the executable
923 created.
924
925 =item -b
926
927 Generates bytecode instead of C code.
928
929 =item -opt
930
931 Uses the optimized C backend (C<B::CC>)rather than the simple C backend
932 (C<B::C>).  Beware that the optimized C backend creates very large
933 switch structures and structure initializations.  Many C compilers
934 find it a challenge to compile the resulting output in finite amounts
935 of time.  Many Perl features such as C<goto LABEL> are also not
936 supported by the optimized C backend.  The simple C backend should
937 work in more instances, but can only offer modest speed increases.
938
939 =item -regex   <rename_regex>
940
941 Gives a rule B<rename_regex> - which is a legal perl regular expression - to 
942 create executable file names.
943
944 =item -verbose <verbose_level>
945
946 Show exactly what steps perlcc is taking to compile your code. You can
947 change the verbosity level B<verbose_level> much in the same way that
948 the C<-D> switch changes perl's debugging level, by giving either a
949 number which is the sum of bits you want or a list of letters
950 representing what you wish to see. Here are the verbosity levels so
951 far :
952
953     Bit 1(g):      Code Generation Errors to STDERR
954     Bit 2(a):      Compilation Errors to STDERR
955     Bit 4(t):      Descriptive text to STDERR 
956     Bit 8(f):      Code Generation Errors to file (B<-log> flag needed)
957     Bit 16(c):     Compilation Errors to file (B<-log> flag needed)
958     Bit 32(d):     Descriptive text to file (B<-log> flag needed) 
959
960 If the B<-log> tag is given, the default verbose level is 63 (ie: mirroring 
961 all of perlcc's output to both the screen and to a log file). If no B<-log>
962 tag is given, then the default verbose level is 7 (ie: outputting all of 
963 perlcc's output to STDERR).
964
965 NOTE: Because of buffering concerns, you CANNOT shadow the output of '-run' to
966 both a file, and to the screen! Suggestions are welcome on how to overcome this
967 difficulty, but for now it simply does not work properly, and hence will only go
968 to the screen.
969
970 =item -log <logname>
971
972 Opens, for append, a logfile to save some or all of the text for a given 
973 compile command. No rewrite version is available, so this needs to be done 
974 manually.
975
976 =item -argv <arguments>
977
978 In combination with C<-run> or C<-e>, tells perlcc to run the resulting 
979 executable with the string B<arguments> as @ARGV.
980
981 =item -sav
982
983 Tells perl to save the intermediate C code. Usually, this C code is the name
984 of the perl code, plus '.c'; 'perlcode.p' gets generated in 'perlcode.p.c',
985 for example. If used with the C<-e> operator, you need to tell perlcc where to 
986 save resulting executables.
987
988 =item -gen
989
990 Tells perlcc to only create the intermediate C code, and not compile the 
991 results. Does an implicit B<-sav>, saving the C code rather than deleting it.
992
993 =item -run
994
995 Immediately run the perl code that has been generated. NOTE: IF YOU GIVE THE 
996 B<-run> FLAG TO B<perlcc>, THEN THE REST OF @ARGV WILL BE INTERPRETED AS 
997 ARGUMENTS TO THE PROGRAM THAT YOU ARE COMPILING.
998
999 =item -prog
1000
1001 Indicate that the programs at the command line are programs, and should be
1002 compiled as such. B<perlcc> will automatically determine files to be 
1003 programs if they have B<.p>, B<.pl>, B<.bat> extensions.
1004
1005 =item -mod
1006
1007 Indicate that the programs at the command line are modules, and should be
1008 compiled as such. B<perlcc> will automatically determine files to be 
1009 modules if they have the extension B<.pm>.
1010
1011 =back
1012
1013 =head1 ENVIRONMENT
1014
1015 Most of the work of B<perlcc> is done at the command line. However, you can 
1016 change the heuristic which determines what is a module and what is a program.
1017 As indicated above, B<perlcc> assumes that the extensions:
1018
1019 .p$, .pl$, and .bat$
1020
1021 indicate a perl program, and:
1022
1023 .pm$
1024
1025 indicate a library, for the purposes of creating executables. And furthermore,
1026 by default, these extensions will be replaced (and dropped) in the process of 
1027 creating an executable. 
1028
1029 To change the extensions which are programs, and which are modules, set the
1030 environmental variables:
1031
1032 PERL_SCRIPT_EXT
1033 PERL_MODULE_EXT
1034
1035 These two environmental variables take colon-separated, legal perl regular 
1036 expressions, and are used by perlcc to decide which objects are which. 
1037 For example:
1038
1039 setenv PERL_SCRIPT_EXT  '.prl$:.perl$'
1040 prompt%   perlcc sample.perl
1041
1042 will compile the script 'sample.perl' into the executable 'sample', and
1043
1044 setenv PERL_MODULE_EXT  '.perlmod$:.perlmodule$'
1045
1046 prompt%   perlcc sample.perlmod
1047
1048 will  compile the module 'sample.perlmod' into the shared object 
1049 'sample.so'
1050
1051 NOTE: the '.' in the regular expressions for PERL_SCRIPT_EXT and PERL_MODULE_EXT
1052 is a literal '.', and not a wild-card. To get a true wild-card, you need to 
1053 backslash the '.'; as in:
1054
1055 setenv PERL_SCRIPT_EXT '\.\.\.\.\.'
1056
1057 which would have the effect of compiling ANYTHING (except what is in 
1058 PERL_MODULE_EXT) into an executable with 5 less characters in its name.
1059
1060 The PERLCC_OPTS environment variable can be set to the default flags
1061 that must be used by the compiler.
1062
1063 The PERLCC_TIMEOUT environment variable can be set to the number of
1064 seconds to wait for the backends before giving up.  This is sometimes
1065 necessary to avoid some compilers taking forever to compile the
1066 generated output.  May not work on Windows and similar platforms.
1067
1068 =head1 FILES
1069
1070 'perlcc' uses a temporary file when you use the B<-e> option to evaluate 
1071 text and compile it. This temporary file is 'perlc$$.p'. The temporary C code is
1072 perlc$$.p.c, and the temporary executable is perlc$$.
1073
1074 When you use '-run' and don't save your executable, the temporary executable is
1075 perlc$$
1076
1077 =head1 BUGS
1078
1079 The whole compiler suite (C<perlcc> included) should be considered very
1080 experimental.  Use for production purposes is strongly discouraged.
1081
1082 perlcc currently cannot compile shared objects on Win32. This should be fixed
1083 in future.
1084
1085 Bugs in the various compiler backends still exist, and are perhaps too
1086 numerous to list here.
1087
1088 =cut
1089
1090 !NO!SUBS!
1091
1092 close OUT or die "Can't close $file: $!";
1093 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1094 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
1095 chdir $origdir;