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