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