projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Inline / C.pm
CommitLineData
86530b38
AT		 1package Inline::C;
2$VERSION = '0.44';
3
4use strict;
5require Inline;
6use Config;
7use Data::Dumper;
8use Carp;
9use Cwd qw(cwd abs_path);
10use File::Spec;
11
12@Inline::C::ISA = qw(Inline);
13
14#==============================================================================
15# Register this module as an Inline language support module
16#==============================================================================
17sub register {
18 return {
19 language => 'C',
20 # XXX Breaking this on purpose; let's see who screams
21 # aliases => ['c'],
22 type => 'compiled',
23 suffix => $Config{dlext},
24 };
25}
26
27#==============================================================================
28# Validate the C config options
29#==============================================================================
30sub usage_validate {
31 my $key = shift;
32 return <<END;
33The value of config option '$key' must be a string or an array ref
34
35END
36}
37
38sub validate {
39 my $o = shift;
40
41 $o->{ILSM} ||= {};
42 $o->{ILSM}{XS} ||= {};
43 $o->{ILSM}{MAKEFILE} ||= {};
44 if (not $o->UNTAINT) {
45 require FindBin;
46 $o->{ILSM}{MAKEFILE}{INC} = "-I$FindBin::Bin";
47 }
48 $o->{ILSM}{AUTOWRAP} = 0 if not defined $o->{ILSM}{AUTOWRAP};
49 $o->{ILSM}{XSMODE} = 0 if not defined $o->{ILSM}{XSMODE};
50 $o->{ILSM}{AUTO_INCLUDE} ||= <<END;
51#include "EXTERN.h"
52#include "perl.h"
53#include "XSUB.h"
54#include "INLINE.h"
55END
56 $o->{ILSM}{FILTERS} ||= [];
57 $o->{STRUCT} ||= {
58 '.macros' => '',
59 '.xs' => '',
60 '.any' => 0,
61 '.all' => 0,
62 };
63
64 while (@_) {
65 my ($key, $value) = (shift, shift);
66 if ($key eq 'MAKE' or
67 $key eq 'AUTOWRAP' or
68 $key eq 'XSMODE'
69 ) {
70 $o->{ILSM}{$key} = $value;
71 next;
72 }
73 if ($key eq 'CC' or
74 $key eq 'LD') {
75 $o->{ILSM}{MAKEFILE}{$key} = $value;
76 next;
77 }
78 if ($key eq 'LIBS') {
79 $o->add_list($o->{ILSM}{MAKEFILE}, $key, $value, []);
80 next;
81 }
82 if ($key eq 'INC' or
83 $key eq 'MYEXTLIB' or
84 $key eq 'OPTIMIZE' or
85 $key eq 'CCFLAGS' or
86 $key eq 'LDDLFLAGS') {
87 $o->add_string($o->{ILSM}{MAKEFILE}, $key, $value, '');
88 next;
89 }
90 if ($key eq 'TYPEMAPS') {
91 croak "TYPEMAPS file '$value' not found"
92 unless -f $value;
93 $value = File::Spec->rel2abs($value);
94 $o->add_list($o->{ILSM}{MAKEFILE}, $key, $value, []);
95 next;
96 }
97 if ($key eq 'AUTO_INCLUDE') {
98 $o->add_text($o->{ILSM}, $key, $value, '');
99 next;
100 }
101 if ($key eq 'BOOT') {
102 $o->add_text($o->{ILSM}{XS}, $key, $value, '');
103 next;
104 }
105 if ($key eq 'PREFIX') {
106 croak "Invalid value for 'PREFIX' option"
107 unless ($value =~ /^\w*$/ and
108 $value !~ /\n/);
109 $o->{ILSM}{XS}{PREFIX} = $value;
110 next;
111 }
112 if ($key eq 'FILTERS') {
113 next if $value eq '1' or $value eq '0'; # ignore ENABLE, DISABLE
114 $value = [$value] unless ref($value) eq 'ARRAY';
115 my %filters;
116 for my $val (@$value) {
117 if (ref($val) eq 'CODE') {
118 $o->add_list($o->{ILSM}, $key, $val, []);
119 }
120 else {
121 eval { require Inline::Filters };
122 croak "'FILTERS' option requires Inline::Filters to be installed."
123 if $@;
124 %filters = Inline::Filters::get_filters($o->{API}{language})
125 unless keys %filters;
126 if (defined $filters{$val}) {
127 my $filter = Inline::Filters->new($val,
128 $filters{$val});
129 $o->add_list($o->{ILSM}, $key, $filter, []);
130 }
131 else {
132 croak "Invalid filter $val specified.";
133 }
134 }
135 }
136 next;
137 }
138 if ($key eq 'STRUCTS') {
139 # A list of struct names
140 if (ref($value) eq 'ARRAY') {
141 for my $val (@$value) {
142 croak "Invalid value for 'STRUCTS' option"
143 unless ($val =~ /^[_a-z][_0-9a-z]*$/i);
144 $o->{STRUCT}{$val}++;
145 }
146 }
147 # Enable or disable
148 elsif ($value =~ /^\d+$/) {
149 $o->{STRUCT}{'.any'} = $value;
150 }
151 # A single struct name
152 else {
153 croak "Invalid value for 'STRUCTS' option"
154 unless ($value =~ /^[_a-z][_0-9a-z]*$/i);
155 $o->{STRUCT}{$value}++;
156 }
157 eval { require Inline::Struct };
158 croak "'STRUCTS' option requires Inline::Struct to be installed."
159 if $@;
160 $o->{STRUCT}{'.any'} = 1;
161 next;
162 }
163 my $class = ref $o; # handles subclasses correctly.
164 croak "'$key' is not a valid config option for $class\n";
165 }
166}
167
168sub add_list {
169 my $o = shift;
170 my ($ref, $key, $value, $default) = @_;
171 $value = [$value] unless ref $value eq 'ARRAY';
172 for (@$value) {
173 if (defined $_) {
174 push @{$ref->{$key}}, $_;
175 }
176 else {
177 $ref->{$key} = $default;
178 }
179 }
180}
181
182sub add_string {
183 my $o = shift;
184 my ($ref, $key, $value, $default) = @_;
185 $value = [$value] unless ref $value;
186 croak usage_validate($key) unless ref($value) eq 'ARRAY';
187 for (@$value) {
188 if (defined $_) {
189 $ref->{$key} .= ' ' . $_;
190 }
191 else {
192 $ref->{$key} = $default;
193 }
194 }
195}
196
197sub add_text {
198 my $o = shift;
199 my ($ref, $key, $value, $default) = @_;
200 $value = [$value] unless ref $value;
201 croak usage_validate($key) unless ref($value) eq 'ARRAY';
202 for (@$value) {
203 if (defined $_) {
204 chomp;
205 $ref->{$key} .= $_ . "\n";
206 }
207 else {
208 $ref->{$key} = $default;
209 }
210 }
211}
212
213#==============================================================================
214# Return a small report about the C code..
215#==============================================================================
216sub info {
217 my $o = shift;
218 return <<END if $o->{ILSM}{XSMODE};
219No information is currently generated when using XSMODE.
220
221END
222 my $text = '';
223 $o->preprocess;
224 $o->parse;
225 if (defined $o->{ILSM}{parser}{data}{functions}) {
226 $text .= "The following Inline $o->{API}{language} function(s) have been successfully bound to Perl:\n";
227 my $parser = $o->{ILSM}{parser};
228 my $data = $parser->{data};
229 for my $function (sort @{$data->{functions}}) {
230 my $return_type = $data->{function}{$function}{return_type};
231 my @arg_names = @{$data->{function}{$function}{arg_names}};
232 my @arg_types = @{$data->{function}{$function}{arg_types}};
233 my @args = map {$_ . ' ' . shift @arg_names} @arg_types;
234 $text .= "\t$return_type $function(" . join(', ', @args) . ")\n";
235 }
236 }
237 else {
238 $text .= "No $o->{API}{language} functions have been successfully bound to Perl.\n\n";
239 }
240 $text .= Inline::Struct::info($o) if $o->{STRUCT}{'.any'};
241 return $text;
242}
243
244sub config {
245 my $o = shift;
246}
247
248#==============================================================================
249# Parse and compile C code
250#==============================================================================
251my $total_build_time;
252sub build {
253 my $o = shift;
254
255 if ($o->{CONFIG}{BUILD_TIMERS}) {
256 eval {require Time::HiRes};
257 croak "You need Time::HiRes for BUILD_TIMERS option:\n$@" if $@;
258 $total_build_time = Time::HiRes::time();
259 }
260 $o->call('preprocess', 'Build Prepocess');
261 $o->call('parse', 'Build Parse');
262 $o->call('write_XS', 'Build Glue 1');
263 $o->call('write_Inline_headers', 'Build Glue 2');
264 $o->call('write_Makefile_PL', 'Build Glue 3');
265 $o->call('compile', 'Build Compile');
266 if ($o->{CONFIG}{BUILD_TIMERS}) {
267 $total_build_time = Time::HiRes::time() - $total_build_time;
268 printf STDERR "Total Build Time: %5.4f secs\n", $total_build_time;
269 }
270}
271
272sub call {
273 my ($o, $method, $header, $indent) = (@_, 0);
274 my $time;
275 my $i = ' ' x $indent;
276 print STDERR "${i}Starting $header Stage\n" if $o->{CONFIG}{BUILD_NOISY};
277 $time = Time::HiRes::time()
278 if $o->{CONFIG}{BUILD_TIMERS};
279
280 $o->$method();
281
282 $time = Time::HiRes::time() - $time
283 if $o->{CONFIG}{BUILD_TIMERS};
284 print STDERR "${i}Finished $header Stage\n" if $o->{CONFIG}{BUILD_NOISY};
285 printf STDERR "${i}Time for $header Stage: %5.4f secs\n", $time
286 if $o->{CONFIG}{BUILD_TIMERS};
287 print STDERR "\n" if $o->{CONFIG}{BUILD_NOISY};
288}
289
290#==============================================================================
291# Apply any
292#==============================================================================
293sub preprocess {
294 my $o = shift;
295 return if $o->{ILSM}{parser};
296 $o->get_maps;
297 $o->get_types;
298 $o->{ILSM}{code} = $o->filter(@{$o->{ILSM}{FILTERS}});
299}
300
301#==============================================================================
302# Parse the function definition information out of the C code
303#==============================================================================
304sub parse {
305 my $o = shift;
306 return if $o->{ILSM}{parser};
307 return if $o->{ILSM}{XSMODE};
308 my $parser = $o->{ILSM}{parser} = $o->get_parser;
309 $parser->{data}{typeconv} = $o->{ILSM}{typeconv};
310 $parser->{data}{AUTOWRAP} = $o->{ILSM}{AUTOWRAP};
311 Inline::Struct::parse($o) if $o->{STRUCT}{'.any'};
312 $parser->code($o->{ILSM}{code})
313 or croak <<END;
314Bad $o->{API}{language} code passed to Inline at @{[caller(2)]}
315END
316}
317
318# Create and initialize a parser
319sub get_parser {
320 my $o = shift;
321 require Inline::C::ParseRecDescent;
322 Inline::C::ParseRecDescent::get_parser($o);
323}
324
325#==============================================================================
326# Gather the path names of all applicable typemap files.
327#==============================================================================
328sub get_maps {
329 my $o = shift;
330
331 my $typemap = '';
332 my $file;
333 $file = File::Spec->catfile($Config::Config{installprivlib},"ExtUtils","typemap");
334 $typemap = $file if -f $file;
335 $file = File::Spec->catfile($Config::Config{privlibexp} ,"ExtUtils","typemap");
336 $typemap = $file
337 if (not $typemap and -f $file);
338 warn "Can't find the default system typemap file"
339 if (not $typemap and $^W);
340
341 unshift(@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, $typemap) if $typemap;
342
343 if (not $o->UNTAINT) {
344 require FindBin;
345 $file = File::Spec->catfile($FindBin::Bin,"typemap");
346 push(@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, $file) if -f $file;
347 }
348}
349
350#==============================================================================
351# This routine parses XS typemap files to get a list of valid types to create
352# bindings to. This code is mostly hacked out of Larry Wall's xsubpp program.
353#==============================================================================
354sub get_types {
355 my (%type_kind, %proto_letter, %input_expr, %output_expr);
356 my $o = shift;
357 croak "No typemaps specified for Inline C code"
358 unless @{$o->{ILSM}{MAKEFILE}{TYPEMAPS}};
359
360 my $proto_re = "[" . quotemeta('\$%&*@;') . "]";
361 foreach my $typemap (@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}) {
362 next unless -e $typemap;
363 # skip directories, binary files etc.
364 warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
365 unless -T $typemap;
366 open(TYPEMAP, $typemap)
367 or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
368 my $mode = 'Typemap';
369 my $junk = "";
370 my $current = \$junk;
371 while (<TYPEMAP>) {
372 next if /^\s*\#/;
373 my $line_no = $. + 1;
374 if (/^INPUT\s*$/) {$mode = 'Input'; $current = \$junk; next}
375 if (/^OUTPUT\s*$/) {$mode = 'Output'; $current = \$junk; next}
376 if (/^TYPEMAP\s*$/) {$mode = 'Typemap'; $current = \$junk; next}
377 if ($mode eq 'Typemap') {
378 chomp;
379 my $line = $_;
380 TrimWhitespace($_);
381 # skip blank lines and comment lines
382 next if /^$/ or /^\#/;
383 my ($type,$kind, $proto) =
384 /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
385 warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
386 $type = TidyType($type);
387 $type_kind{$type} = $kind;
388 # prototype defaults to '$'
389 $proto = "\$" unless $proto;
390 warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
391 unless ValidProtoString($proto);
392 $proto_letter{$type} = C_string($proto);
393 }
394 elsif (/^\s/) {
395 $$current .= $_;
396 }
397 elsif ($mode eq 'Input') {
398 s/\s+$//;
399 $input_expr{$_} = '';
400 $current = \$input_expr{$_};
401 }
402 else {
403 s/\s+$//;
404 $output_expr{$_} = '';
405 $current = \$output_expr{$_};
406 }
407 }
408 close(TYPEMAP);
409 }
410
411 my %valid_types =
412 map {($_, 1)}
413 grep {defined $input_expr{$type_kind{$_}}}
414 keys %type_kind;
415
416 my %valid_rtypes =
417 map {($_, 1)}
418 (grep {defined $output_expr{$type_kind{$_}}}
419 keys %type_kind), 'void';
420
421 $o->{ILSM}{typeconv}{type_kind} = \%type_kind;
422 $o->{ILSM}{typeconv}{input_expr} = \%input_expr;
423 $o->{ILSM}{typeconv}{output_expr} = \%output_expr;
424 $o->{ILSM}{typeconv}{valid_types} = \%valid_types;
425 $o->{ILSM}{typeconv}{valid_rtypes} = \%valid_rtypes;
426}
427
428sub ValidProtoString ($) {
429 my $string = shift;
430 my $proto_re = "[" . quotemeta('\$%&*@;') . "]";
431 return ($string =~ /^$proto_re+$/) ? $string : 0;
432}
433
434sub TrimWhitespace {
435 $_[0] =~ s/^\s+|\s+$//go;
436}
437
438sub TidyType {
439 local $_ = shift;
440 s|\s*(\*+)\s*|$1|g;
441 s|(\*+)| $1 |g;
442 s|\s+| |g;
443 TrimWhitespace($_);
444 $_;
445}
446
447sub C_string ($) {
448 (my $string = shift) =~ s|\\|\\\\|g;
449 $string;
450}
451
452#==============================================================================
453# Write the XS code
454#==============================================================================
455sub write_XS {
456 my $o = shift;
457 my $modfname = $o->{API}{modfname};
458 my $module = $o->{API}{module};
459 $o->mkpath($o->{API}{build_dir});
460 open XS, "> ".File::Spec->catfile($o->{API}{build_dir},"$modfname.xs")
461 or croak $!;
462 if ($o->{ILSM}{XSMODE}) {
463 warn <<END if $^W and $o->{ILSM}{code} !~ /MODULE\s*=\s*$module\b/;
464While using Inline XSMODE, your XS code does not have a line with
465
466 MODULE = $module
467
468You should use the Inline NAME config option, and it should match the
469XS MODULE name.
470
471END
472 print XS $o->xs_code;
473 }
474 else {
475 print XS $o->xs_generate;
476 }
477 close XS;
478}
479
480#==============================================================================
481# Generate the XS glue code (piece together lots of snippets)
482#==============================================================================
483sub xs_generate {
484 my $o = shift;
485 return join '', ($o->xs_includes,
486 $o->xs_struct_macros,
487 $o->xs_code,
488 $o->xs_struct_code,
489 $o->xs_bindings,
490 $o->xs_boot,
491 );
492}
493
494sub xs_includes {
495 my $o = shift;
496 return $o->{ILSM}{AUTO_INCLUDE};
497}
498
499sub xs_struct_macros {
500 my $o = shift;
501 return $o->{STRUCT}{'.macros'};
502}
503
504sub xs_code {
505 my $o = shift;
506 return $o->{ILSM}{code};
507}
508
509sub xs_struct_code {
510 my $o = shift;
511 return $o->{STRUCT}{'.xs'};
512}
513
514sub xs_boot {
515 my $o = shift;
516 if (defined $o->{ILSM}{XS}{BOOT} and
517 $o->{ILSM}{XS}{BOOT}) {
518 return <<END;
519BOOT:
520$o->{ILSM}{XS}{BOOT}
521END
522 }
523 return '';
524}
525
526sub xs_bindings {
527 my $o = shift;
528 my ($pkg, $module) = @{$o->{API}}{qw(pkg module)};
529 my $prefix = (($o->{ILSM}{XS}{PREFIX}) ?
530 "PREFIX = $o->{ILSM}{XS}{PREFIX}" :
531 '');
532 my $XS = <<END;
533
534MODULE = $module PACKAGE = $pkg $prefix
535
536PROTOTYPES: DISABLE
537
538END
539
540 my $parser = $o->{ILSM}{parser};
541 my $data = $parser->{data};
542
543 warn("Warning. No Inline C functions bound to Perl\n" .
544 "Check your C function definition(s) for Inline compatibility\n\n")
545 if ((not defined$data->{functions}) and ($^W));
546
547 for my $function (@{$data->{functions}}) {
548 my $return_type = $data->{function}->{$function}->{return_type};
549 my @arg_names = @{$data->{function}->{$function}->{arg_names}};
550 my @arg_types = @{$data->{function}->{$function}->{arg_types}};
551
552 $XS .= join '', ("\n$return_type\n$function (",
553 join(', ', @arg_names), ")\n");
554
555 for my $arg_name (@arg_names) {
556 my $arg_type = shift @arg_types;
557 last if $arg_type eq '...';
558 $XS .= "\t$arg_type\t$arg_name\n";
559 }
560
561 my $listargs = '';
562 $listargs = pop @arg_names if (@arg_names and
563 $arg_names[-1] eq '...');
564 my $arg_name_list = join(', ', @arg_names);
565
566 if ($return_type eq 'void') {
567 $XS .= <<END;
568 PREINIT:
569 I32* temp;
570 PPCODE:
571 temp = PL_markstack_ptr++;
572 $function($arg_name_list);
573 if (PL_markstack_ptr != temp) {
574 /* truly void, because dXSARGS not invoked */
575 PL_markstack_ptr = temp;
576 XSRETURN_EMPTY; /* return empty stack */
577 }
578 /* must have used dXSARGS; list context implied */
579 return; /* assume stack size is correct */
580END
581 }
582 elsif ($listargs) {
583 $XS .= <<END;
584 PREINIT:
585 I32* temp;
586 CODE:
587 temp = PL_markstack_ptr++;
588 RETVAL = $function($arg_name_list);
589 PL_markstack_ptr = temp;
590 OUTPUT:
591 RETVAL
592END
593 }
594 }
595 $XS .= "\n";
596 return $XS;
597}
598
599#==============================================================================
600# Generate the INLINE.h file.
601#==============================================================================
602sub write_Inline_headers {
603 my $o = shift;
604
605 open HEADER, "> ".File::Spec->catfile($o->{API}{build_dir},"INLINE.h")
606 or croak;
607
608 print HEADER <<'END';
609#define Inline_Stack_Vars dXSARGS
610#define Inline_Stack_Items items
611#define Inline_Stack_Item(x) ST(x)
612#define Inline_Stack_Reset sp = mark
613#define Inline_Stack_Push(x) XPUSHs(x)
614#define Inline_Stack_Done PUTBACK
615#define Inline_Stack_Return(x) XSRETURN(x)
616#define Inline_Stack_Void XSRETURN(0)
617
618#define INLINE_STACK_VARS Inline_Stack_Vars
619#define INLINE_STACK_ITEMS Inline_Stack_Items
620#define INLINE_STACK_ITEM(x) Inline_Stack_Item(x)
621#define INLINE_STACK_RESET Inline_Stack_Reset
622#define INLINE_STACK_PUSH(x) Inline_Stack_Push(x)
623#define INLINE_STACK_DONE Inline_Stack_Done
624#define INLINE_STACK_RETURN(x) Inline_Stack_Return(x)
625#define INLINE_STACK_VOID Inline_Stack_Void
626
627#define inline_stack_vars Inline_Stack_Vars
628#define inline_stack_items Inline_Stack_Items
629#define inline_stack_item(x) Inline_Stack_Item(x)
630#define inline_stack_reset Inline_Stack_Reset
631#define inline_stack_push(x) Inline_Stack_Push(x)
632#define inline_stack_done Inline_Stack_Done
633#define inline_stack_return(x) Inline_Stack_Return(x)
634#define inline_stack_void Inline_Stack_Void
635END
636
637 close HEADER;
638}
639
640#==============================================================================
641# Generate the Makefile.PL
642#==============================================================================
643sub write_Makefile_PL {
644 my $o = shift;
645 $o->{ILSM}{xsubppargs} = '';
646 for (@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}) {
647 $o->{ILSM}{xsubppargs} .= "-typemap $_ ";
648 }
649
650 my %options = (
651 VERSION => $o->{API}{version} || '0.00',
652 %{$o->{ILSM}{MAKEFILE}},
653 NAME => $o->{API}{module},
654 );
655
656 open MF, "> ".File::Spec->catfile($o->{API}{build_dir},"Makefile.PL")
657 or croak;
658
659 print MF <<END;
660use ExtUtils::MakeMaker;
661my %options = %\{
662END
663
664 local $Data::Dumper::Terse = 1;
665 local $Data::Dumper::Indent = 1;
666 print MF Data::Dumper::Dumper(\ %options);
667
668 print MF <<END;
669\};
670WriteMakefile(\%options);
671
672# Remove the Makefile dependency. Causes problems on a few systems.
673sub MY::makefile { '' }
674END
675 close MF;
676}
677
678#==============================================================================
679# Run the build process.
680#==============================================================================
681sub compile {
682 my $o = shift;
683
684 my $build_dir = $o->{API}{build_dir};
685 my $cwd = &cwd;
686 ($cwd) = $cwd =~ /(.*)/ if $o->UNTAINT;
687
688 chdir $build_dir;
689 $o->call('makefile_pl', '"perl Makefile.PL"', 2);
690 $o->call('make', '"make"', 2);
691 $o->call('make_install', '"make install"', 2);
692 chdir $cwd;
693 $o->call('cleanup', 'Cleaning Up', 2);
694}
695
696sub makefile_pl {
697 my ($o) = @_;
698 my $perl;
699 -f ($perl = $Config::Config{perlpath})
700 or ($perl = $^X)
701 or croak "Can't locate your perl binary";
702 $o->system_call("$perl Makefile.PL", 'out.Makefile_PL');
703 $o->fix_make;
704}
705sub make {
706 my ($o) = @_;
707 my $make = $o->{ILSM}{MAKE} || $Config::Config{make}
708 or croak "Can't locate your make binary";
709 $o->system_call("$make", 'out.make');
710}
711sub make_install {
712 my ($o) = @_;
713 my $make = $o->{ILSM}{MAKE} || $Config::Config{make}
714 or croak "Can't locate your make binary";
715 $o->system_call("$make pure_install", 'out.make_install');
716}
717sub cleanup {
718 my ($o) = @_;
719 my ($modpname, $modfname, $install_lib) =
720 @{$o->{API}}{qw(modpname modfname install_lib)};
721 if ($o->{API}{cleanup}) {
722 $o->rmpath(File::Spec->catdir($o->{API}{directory},'build'),
723 $modpname);
724 my $autodir = File::Spec->catdir($install_lib,'auto',$modpname);
725 unlink (File::Spec->catfile($autodir,'.packlist'),
726 File::Spec->catfile($autodir,'$modfname.bs'),
727 File::Spec->catfile($autodir,'$modfname.exp'), #MSWin32
728 File::Spec->catfile($autodir,'$modfname.lib'), #MSWin32
729 );
730 }
731}
732
733sub system_call {
734 my ($o, $cmd, $output_file) = @_;
735 my $build_noisy =
736 defined $ENV{PERL_INLINE_BUILD_NOISY}
737 ? $ENV{PERL_INLINE_BUILD_NOISY}
738 : $o->{CONFIG}{BUILD_NOISY};
739 if (not $build_noisy) {
740 $cmd = "$cmd > $output_file 2>&1";
741 }
742 ($cmd) = $cmd =~ /(.*)/ if $o->UNTAINT;
743 system($cmd) == 0
744 or croak($o->build_error_message($cmd, $output_file, $build_noisy));
745}
746
747sub build_error_message {
748 my ($o, $cmd, $output_file, $build_noisy) = @_;
749 my $build_dir = $o->{API}{build_dir};
750 my $output = '';
751 if (not $build_noisy and
752 open(OUTPUT, $output_file)
753 ) {
754 local $/;
755 $output = <OUTPUT>;
756 close OUTPUT;
757 }
758
759 return $output . <<END;
760
761A problem was encountered while attempting to compile and install your Inline
762$o->{API}{language} code. The command that failed was:
763 $cmd
764
765The build directory was:
766$build_dir
767
768To debug the problem, cd to the build directory, and inspect the output files.
769
770END
771}
772
773#==============================================================================
774# This routine fixes problems with the MakeMaker Makefile.
775#==============================================================================
776my %fixes = (
777 INSTALLSITEARCH => 'install_lib',
778 INSTALLDIRS => 'installdirs',
779 XSUBPPARGS => 'xsubppargs',
780 INSTALLSITELIB => 'install_lib',
781 );
782
783sub fix_make {
784 use strict;
785 my (@lines, $fix);
786 my $o = shift;
787
788 $o->{ILSM}{install_lib} = $o->{API}{install_lib};
789 $o->{ILSM}{installdirs} = 'site';
790
791 open(MAKEFILE, '< Makefile')
792 or croak "Can't open Makefile for input: $!\n";
793 @lines = <MAKEFILE>;
794 close MAKEFILE;
795
796 open(MAKEFILE, '> Makefile')
797 or croak "Can't open Makefile for output: $!\n";
798 for (@lines) {
799 if (/^(\w+)\s*=\s*\S+.*$/ and
800 $fix = $fixes{$1}
801 ) {
802 print MAKEFILE "$1 = $o->{ILSM}{$fix}\n"
803 }
804 else {
805 print MAKEFILE;
806 }
807 }
808 close MAKEFILE;
809}
810
8111;
812
813__END__
Full OpenSPARC design & verification tarball including full HDL.