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
CommitLineData
52cebf5e
EP
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
de0d1968 5use File::Spec;
8a5546a1 6use Cwd;
52cebf5e
EP
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.
8a5546a1 18$origdir = cwd;
52cebf5e
EP
19chdir dirname($0);
20$file = basename($0, '.PL');
21$file .= '.com' if $^O eq 'VMS';
22
23open OUT,">$file" or die "Can't create $file: $!";
24
25print "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
30print 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
38print OUT <<'!NO!SUBS!';
39
40use Config;
41use strict;
42use FileHandle;
43use File::Basename qw(&basename &dirname);
8a5546a1 44use Cwd;
52cebf5e
EP
45
46use Getopt::Long;
47
48$Getopt::Long::bundling_override = 1;
49$Getopt::Long::passthrough = 0;
50$Getopt::Long::ignore_case = 0;
51
ef712cf7
EP
52my $pathsep = ($Config{'osname'} eq 'MSWin32')? "\\" : "/"; # MAJOR HACK. SHOULD
53 # BE IN Config.pm
54
52cebf5e
EP
55my $options = {};
56my $_fh;
9636a016 57unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
52cebf5e
EP
58
59main();
60
61sub 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",
9636a016
GS
74 "argv:s",
75 "b",
76 "opt",
52cebf5e
EP
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--------------------------------------------------------------------------------
99Compiling $file:
100--------------------------------------------------------------------------------
101", 36 );
102 _doit($file);
103 }
104}
105
106sub _doit
107{
108 my ($file) = @_;
109
110 my ($program_ext, $module_ext) = _getRegexps();
9636a016
GS
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';
52cebf5e
EP
116
117 if (
118 (($file =~ m"@$program_ext") && ($file !~ m"@$module_ext"))
119 || (defined($options->{'prog'}) || defined($options->{'run'}))
120 )
121 {
52cebf5e
EP
122 $type = 'program';
123
9636a016
GS
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 }
52cebf5e
EP
134
135 return() if (!$obj);
136
137 }
138 elsif (($file =~ m"@$module_ext") || ($options->{'mod'}))
139 {
9636a016
GS
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 }
52cebf5e 156
52cebf5e
EP
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 {
9636a016 167 _print("Making $gentype($objfile) for $file!\n", 36 );
52cebf5e 168
9636a016 169 my $errcode = _createCode($backend, $objfile, $file);
52cebf5e
EP
170 (_print( "ERROR: In generating code for $file!\n", -1), return())
171 if ($errcode);
172
9636a016
GS
173 _print("Compiling C($obj) for $file!\n", 36 ) if (!$options->{'gen'} &&
174 !$options->{'b'});
a45b45bb 175 $errcode = _compileCode($file, $objfile, $obj)
9636a016
GS
176 if (!$options->{'gen'} &&
177 !$options->{'b'});
52cebf5e
EP
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
9636a016
GS
189 _runCode($objfile) if ($options->{'run'} && $options->{'b'});
190 _runCode($obj) if ($options->{'run'} && !$options->{'b'});
52cebf5e 191
9636a016
GS
192 _removeCode($objfile) if (($options->{'b'} &&
193 ($options->{'e'} && !$options->{'o'})) ||
194 (!$options->{'b'} &&
195 (!$options->{'sav'} ||
196 ($options->{'e'} && !$options->{'C'}))));
52cebf5e
EP
197
198 _removeCode($file) if ($options->{'e'});
199
9636a016
GS
200 _removeCode($obj) if (!$options->{'b'} &&
201 (($options->{'e'} &&
202 !$options->{'sav'} && !$options->{'o'}) ||
203 ($options->{'run'} && !$options->{'sav'})));
52cebf5e
EP
204 }
205 else
206 {
9636a016
GS
207 _print( "Making $gentype($objfile) for $file!\n", 36 );
208 my $errcode = _createCode($backend, $objfile, $file, $obj);
52cebf5e
EP
209 (_print( "ERROR: In generating code for $file!\n", -1), return())
210 if ($errcode);
211
9636a016
GS
212 _print( "Compiling C($so) for $file!\n", 36 ) if (!$options->{'gen'} &&
213 !$options->{'b'});
52cebf5e 214
9636a016
GS
215 $errcode =
216 _compileCode($file, $objfile, $obj, $so ) if (!$options->{'gen'} &&
217 !$options->{'b'});
52cebf5e
EP
218
219 (_print( "ERROR: In compiling code for $objfile!\n", -1), return())
220 if ($errcode);
221 }
222}
223
224sub _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 }
ef712cf7
EP
240 elsif (defined ($options->{'run'}))
241 {
242 $obj = "perlc$$";
243 }
52cebf5e
EP
244 else
245 {
246 ($obj = $sourceprog) =~ s"@$ext""g;
247 return(0) if (_error('equal', $obj, $sourceprog));
248 }
249 return($obj);
250}
251
252sub _createCode
253{
9636a016 254 my ( $backend, $generated_file, $file, $final_output ) = @_;
52cebf5e
EP
255 my $return;
256
257 local($") = " -I";
258
9636a016
GS
259 open(GENFILE, "> $generated_file") || die "Can't open $generated_file: $!";
260
261 if ($backend eq "Bytecode")
52cebf5e 262 {
9636a016
GS
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";
de0d1968 274 my $null=File::Spec->devnull;
a6f4eb0a 275 _print( "$^X -I@INC -MB::Stash -c $file\n", 36);
de0d1968
VB
276 my @stash=`$^X -I@INC -MB::Stash -c $file 2>$null`;
277 my $stash=$stash[-1];
ef712cf7
EP
278 chomp $stash;
279
9636a016 280 _print( "$^X -I@INC -MO=$backend,$stash $file\n", 36);
de0d1968 281 $return = _run("$^X -I@INC -MO=$backend,$stash,-o$generated_file $file", 9);
52cebf5e
EP
282 $return;
283 }
284 else # compiling a shared object
285 {
286 _print(
9636a016 287 "$^X -I@INC -MO=$backend,-m$final_output $file\n", 36);
52cebf5e 288 $return =
de0d1968 289 _run("$^X -I@INC -MO=$backend,-m$final_output,-o$generated_file $file ", 9);
52cebf5e
EP
290 $return;
291 }
292}
293
294sub _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] =
ef712cf7
EP
302 _ccharness('static', $sourceprog, "-o", $output_executable,
303 $generated_cfile);
52cebf5e
EP
304 $return[0];
305 }
306 else
307 {
308 my $object_file = $generated_cfile;
66796be0 309 $object_file =~ s"\.c$"$Config{_o}";
52cebf5e 310
66796be0 311 $return[0] = _ccharness('compile', $sourceprog, "-c", $generated_cfile);
52cebf5e
EP
312 $return[1] = _ccharness
313 (
ef712cf7 314 'dynamic',
66796be0 315 $sourceprog, "-o",
52cebf5e
EP
316 $shared_object, $object_file
317 );
318 return(1) if (grep ($_, @return));
319 return(0);
320 }
321}
322
323sub _runCode
324{
325 my ($executable) = @_;
326 _print("$executable $options->{'argv'}\n", 36);
327 _run("$executable $options->{'argv'}", -1 );
328}
329
330sub _removeCode
331{
332 my ($file) = @_;
333 unlink($file) if (-e $file);
334}
335
336sub _ccharness
337{
66796be0 338 my $type = shift;
52cebf5e
EP
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 {
66796be0
IZ
352 $libdir = "-L.. -L.";
353 $incdir = "-I.. -I.";
52cebf5e
EP
354 }
355
356 $libdir .= " -L$options->{L}" if (defined($options->{L}));
357 $incdir .= " -I$options->{L}" if (defined($options->{L}));
358
66796be0 359 my $linkargs = '';
ef712cf7
EP
360 my $dynaloader = '';
361 my $optimize = '';
362 my $flags = '';
52cebf5e 363
66796be0 364 if (!grep(/^-[cS]$/, @args))
52cebf5e 365 {
ef712cf7
EP
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}";
52cebf5e
EP
374 }
375
ef712cf7 376 my $libs = _getSharedObjects($sourceprog);
52cebf5e 377
b6fbb8a8
GS
378 my $ccflags = $Config{ccflags};
379 $ccflags .= ' -DUSEIMPORTLIB' if $Config{osname} =~ /cygwin/i;
380 my $cccmd = "$Config{cc} $ccflags $optimize $incdir "
ef712cf7 381 ."@args $dynaloader $linkargs @$libs";
52cebf5e
EP
382
383 _print ("$cccmd\n", 36);
384 _run("$cccmd", 18 );
385}
386
387sub _getSharedObjects
388{
389 my ($sourceprog) = @_;
390 my ($tmpfile, $incfile);
ef712cf7 391 my (@sharedobjects, @libraries);
52cebf5e
EP
392 local($") = " -I";
393
ef712cf7
EP
394 my ($tmpprog);
395 ($tmpprog = $sourceprog) =~ s"(.*)[\\/](.*)"$2";
396
de0d1968 397 my $tempdir= File::Spec->tmpdir;
ef712cf7 398
ef712cf7
EP
399 $tmpfile = "$tempdir/$tmpprog.tst";
400 $incfile = "$tempdir/$tmpprog.val";
52cebf5e
EP
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
ef712cf7 406 print $fd <<"EOF";
52cebf5e
EP
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();
415EOF
416
417 print $fd ( <$fd2> );
418 close($fd);
419
ef712cf7
EP
420 _print("$^X -I@INC $tmpfile\n", 36);
421 _run("$^X -I@INC $tmpfile", 9 );
52cebf5e 422
a45b45bb 423 $fd = new FileHandle ("$incfile");
52cebf5e
EP
424 my @lines = <$fd>;
425
426 unlink($tmpfile);
427 unlink($incfile);
428
429 my $line;
430 my $autolib;
431
ef712cf7
EP
432 my @return;
433
52cebf5e
EP
434 foreach $line (@lines)
435 {
436 chomp($line);
ef712cf7 437
52cebf5e
EP
438 my ($modname, $modpath) = split(':', $line);
439 my ($dir, $file) = ($modpath=~ m"(.*)[\\/]($modname)");
52cebf5e 440
ef712cf7
EP
441 if ($autolib = _lookforAuto($dir, $file)) { push(@return, $autolib); }
442 }
443 return(\@return);
52cebf5e
EP
444}
445
446sub _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
465sub _lookforAuto
466{
467 my ($dir, $file) = @_;
468
ef712cf7
EP
469 my ($relabs, $relshared);
470 my ($prefix);
52cebf5e 471 my $return;
b6fbb8a8
GS
472 my $sharedextension = $^O =~ /MSWin32|cygwin|os2/i
473 ? $Config{_a} : ".$Config{so}";
ef712cf7 474 ($prefix = $file) =~ s"(.*)\.pm"$1";
52cebf5e 475
ef712cf7 476 my ($tmp, $modname) = ($prefix =~ m"(?:(.*)[\\/]){0,1}(.*)"s);
52cebf5e 477
de0d1968 478 $relshared = "$pathsep$prefix$pathsep$modname$sharedextension";
ef712cf7
EP
479 $relabs = "$pathsep$prefix$pathsep$modname$Config{_a}";
480 # HACK . WHY DOES _a HAVE A '.'
481 # AND so HAVE NONE??
52cebf5e 482
ef712cf7
EP
483 my @searchpaths = map("$_${pathsep}auto", @INC);
484
485 my $path;
486 foreach $path (@searchpaths)
52cebf5e 487 {
ef712cf7
EP
488 if (-e ($return = "$path$relshared")) { return($return); }
489 if (-e ($return = "$path$relabs")) { return($return); }
52cebf5e 490 }
ef712cf7 491 return(undef);
52cebf5e
EP
492}
493
494sub _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
52cebf5e
EP
507 _mungeRegexp( $program_ext );
508 _mungeRegexp( $module_ext );
509
510 return($program_ext, $module_ext);
511}
512
513sub _mungeRegexp
514{
515 my ($regexp) = @_;
516
a45b45bb
GS
517 grep(s:(^|[^\\])\.:$1\x00\\.:g, @$regexp);
518 grep(s:(^|[^\x00])\\\.:$1\.:g, @$regexp);
519 grep(s:\x00::g, @$regexp);
52cebf5e
EP
520}
521
52cebf5e
EP
522sub _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"
557ERROR: '$args[0]' does not have a proper extension! Proper extensions are:
558
559 PROGRAM: $progext
560 SHARED OBJECT: $modext
561
562Use the '-prog' flag to force your files to be interpreted as programs.
563Use 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
572sub _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
9636a016
GS
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
52cebf5e
EP
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,
9636a016
GS
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
52cebf5e
EP
610 one file the names clash)\n");
611 }
612
de0d1968 613 if ($options->{'e'} && ($options->{'sav'} || $options->{'gen'}) &&
52cebf5e
EP
614 !$options->{'C'})
615 {
616 push(@errors,
617"ERROR: You need to specify where you are going to save the resulting
9636a016 618 C code when using '-sav' and '-e'. Use '-C'.\n");
52cebf5e
EP
619 }
620
621 if (($options->{'regex'} || $options->{'run'} || $options->{'o'})
622 && $options->{'gen'})
623 {
624 push(@errors,
ef712cf7 625"ERROR: The options '-regex', '-run', and '-o' are incompatible with '-gen'.
52cebf5e
EP
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
708sub _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
727sub _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)
ef712cf7
EP
740 {
741 print _interruptrun("$command");
742 }
52cebf5e 743 elsif ($doreg && $dolog)
ef712cf7
EP
744 {
745 my $text = _interruptrun($command);
746 print $_fh $text;
747 print STDERR $text;
748 }
52cebf5e 749 else
ef712cf7
EP
750 {
751 my $text = _interruptrun($command);
752 print $_fh $text;
753 }
52cebf5e
EP
754 }
755 else
756 {
ef712cf7 757 _interruptrun($command);
52cebf5e
EP
758 }
759 return($?);
760}
761
ef712cf7
EP
762sub _interruptrun
763{
764 my ($command) = @_;
de0d1968 765 my $pid = open (FD, "$command |");
ef712cf7
EP
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 =
9636a016 786 ($ENV{'PERLCC_TIMEOUT'} &&
ef712cf7
EP
787 $Config{'osname'} ne 'MSWin32' && $command =~ m"^perlc");
788 my $text;
789
790 eval
791 {
792 local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
9636a016 793 alarm($ENV{'PERLCC_TIMEOUT'}) if ($needalarm);
ef712cf7
EP
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
52cebf5e
EP
808sub _usage
809{
810 _print
811 (
812 <<"EOF"
813
814Usage: $0 <file_list>
815
9636a016
GS
816WARNING: The whole compiler suite ('perlcc' included) is considered VERY
817experimental. Use for production purposes is strongly discouraged.
818
52cebf5e
EP
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 >
ef712cf7 826 -verbose < verbose level < 1-63, or following letters 'gatfcd' >
52cebf5e
EP
827 -argv < arguments for the executables to be run via '-run' or '-e' >
828
829 Boolean flags
9636a016
GS
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'))
52cebf5e
EP
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
838EOF
839, -1
840
841 );
842 exit(255);
843}
844
845
846__END__
847
848=head1 NAME
849
850perlcc - 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'
889compiles the code inside a.p into a standalone executable, and
890perlcc A.pm will compile into a shared object, A.so, suitable for inclusion
891into a perl program via "use A".
892
893There are quite a few flags to perlcc which help with such issues as compiling
894programs in bulk, testing compiled programs for compatibility with the
895interpreter, and controlling.
896
897=head1 OPTIONS
898
899=over 4
900
901=item -L < library_directories >
902
903Adds directories in B<library_directories> to the compilation command.
904
905=item -I < include_directories >
906
907Adds directories inside B<include_directories> to the compilation command.
908
909=item -C < c_code_name >
910
9636a016
GS
911Explicitly gives the name B<c_code_name> to the generated file containing
912the C code which is to be compiled. Can only be used if compiling one file
913on the command line.
52cebf5e
EP
914
915=item -o < executable_name >
916
917Explicitly gives the name B<executable_name> to the executable which is to be
918compiled. Can only be used if compiling one file on the command line.
919
920=item -e < perl_line_to_execute>
921
922Compiles 'one liners', in the same way that B<perl -e> runs text strings at
923the command line. Default is to have the 'one liner' be compiled, and run all
924in one go (see B<-run>); giving the B<-o> flag saves the resultant executable,
925rather than throwing it away. Use '-argv' to pass arguments to the executable
926created.
927
9636a016
GS
928=item -b
929
930Generates bytecode instead of C code.
931
932=item -opt
933
934Uses 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
936switch structures and structure initializations. Many C compilers
937find it a challenge to compile the resulting output in finite amounts
938of time. Many Perl features such as C<goto LABEL> are also not
939supported by the optimized C backend. The simple C backend should
940work in more instances, but can only offer modest speed increases.
941
52cebf5e
EP
942=item -regex <rename_regex>
943
944Gives a rule B<rename_regex> - which is a legal perl regular expression - to
945create executable file names.
946
947=item -verbose <verbose_level>
948
ca24dfc6
LV
949Show exactly what steps perlcc is taking to compile your code. You can
950change the verbosity level B<verbose_level> much in the same way that
951the C<-D> switch changes perl's debugging level, by giving either a
952number which is the sum of bits you want or a list of letters
953representing what you wish to see. Here are the verbosity levels so
954far :
52cebf5e
EP
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
963If the B<-log> tag is given, the default verbose level is 63 (ie: mirroring
964all of perlcc's output to both the screen and to a log file). If no B<-log>
965tag is given, then the default verbose level is 7 (ie: outputting all of
966perlcc's output to STDERR).
967
968NOTE: Because of buffering concerns, you CANNOT shadow the output of '-run' to
969both a file, and to the screen! Suggestions are welcome on how to overcome this
970difficulty, but for now it simply does not work properly, and hence will only go
971to the screen.
972
973=item -log <logname>
974
975Opens, for append, a logfile to save some or all of the text for a given
976compile command. No rewrite version is available, so this needs to be done
977manually.
978
979=item -argv <arguments>
980
ca24dfc6 981In combination with C<-run> or C<-e>, tells perlcc to run the resulting
52cebf5e
EP
982executable with the string B<arguments> as @ARGV.
983
984=item -sav
985
986Tells perl to save the intermediate C code. Usually, this C code is the name
987of the perl code, plus '.c'; 'perlcode.p' gets generated in 'perlcode.p.c',
ca24dfc6 988for example. If used with the C<-e> operator, you need to tell perlcc where to
52cebf5e
EP
989save resulting executables.
990
991=item -gen
992
993Tells perlcc to only create the intermediate C code, and not compile the
994results. Does an implicit B<-sav>, saving the C code rather than deleting it.
995
996=item -run
997
998Immediately run the perl code that has been generated. NOTE: IF YOU GIVE THE
999B<-run> FLAG TO B<perlcc>, THEN THE REST OF @ARGV WILL BE INTERPRETED AS
1000ARGUMENTS TO THE PROGRAM THAT YOU ARE COMPILING.
1001
1002=item -prog
1003
1004Indicate that the programs at the command line are programs, and should be
1005compiled as such. B<perlcc> will automatically determine files to be
1006programs if they have B<.p>, B<.pl>, B<.bat> extensions.
1007
1008=item -mod
1009
1010Indicate that the programs at the command line are modules, and should be
1011compiled as such. B<perlcc> will automatically determine files to be
1012modules if they have the extension B<.pm>.
1013
1014=back
1015
1016=head1 ENVIRONMENT
1017
1018Most of the work of B<perlcc> is done at the command line. However, you can
1019change the heuristic which determines what is a module and what is a program.
1020As indicated above, B<perlcc> assumes that the extensions:
1021
1022.p$, .pl$, and .bat$
1023
1024indicate a perl program, and:
1025
1026.pm$
1027
1028indicate a library, for the purposes of creating executables. And furthermore,
ef712cf7 1029by default, these extensions will be replaced (and dropped) in the process of
52cebf5e
EP
1030creating an executable.
1031
1032To change the extensions which are programs, and which are modules, set the
1033environmental variables:
1034
1035PERL_SCRIPT_EXT
1036PERL_MODULE_EXT
1037
1038These two environmental variables take colon-separated, legal perl regular
1039expressions, and are used by perlcc to decide which objects are which.
1040For example:
1041
1042setenv PERL_SCRIPT_EXT '.prl$:.perl$'
1043prompt% perlcc sample.perl
1044
1045will compile the script 'sample.perl' into the executable 'sample', and
1046
1047setenv PERL_MODULE_EXT '.perlmod$:.perlmodule$'
1048
1049prompt% perlcc sample.perlmod
1050
1051will compile the module 'sample.perlmod' into the shared object
1052'sample.so'
1053
1054NOTE: the '.' in the regular expressions for PERL_SCRIPT_EXT and PERL_MODULE_EXT
1055is a literal '.', and not a wild-card. To get a true wild-card, you need to
1056backslash the '.'; as in:
1057
1058setenv PERL_SCRIPT_EXT '\.\.\.\.\.'
1059
1060which would have the effect of compiling ANYTHING (except what is in
1061PERL_MODULE_EXT) into an executable with 5 less characters in its name.
1062
9636a016
GS
1063The PERLCC_OPTS environment variable can be set to the default flags
1064that must be used by the compiler.
1065
1066The PERLCC_TIMEOUT environment variable can be set to the number of
1067seconds to wait for the backends before giving up. This is sometimes
1068necessary to avoid some compilers taking forever to compile the
1069generated output. May not work on Windows and similar platforms.
1070
52cebf5e
EP
1071=head1 FILES
1072
1073'perlcc' uses a temporary file when you use the B<-e> option to evaluate
1074text and compile it. This temporary file is 'perlc$$.p'. The temporary C code is
1075perlc$$.p.c, and the temporary executable is perlc$$.
1076
1077When you use '-run' and don't save your executable, the temporary executable is
1078perlc$$
1079
1080=head1 BUGS
1081
9636a016
GS
1082The whole compiler suite (C<perlcc> included) should be considered very
1083experimental. Use for production purposes is strongly discouraged.
1084
52cebf5e 1085perlcc currently cannot compile shared objects on Win32. This should be fixed
9636a016
GS
1086in future.
1087
1088Bugs in the various compiler backends still exist, and are perhaps too
1089numerous to list here.
52cebf5e
EP
1090
1091=cut
1092
1093!NO!SUBS!
1094
1095close OUT or die "Can't close $file: $!";
1096chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1097exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1 1098chdir $origdir;