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