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