klibc/klcc/klcc.in

# -*- perl -*-

use IPC::Open3;

# Standard includes
@includes = ("-I${prefix}/${KCROSS}include/arch/${ARCH}",
	     "-I${prefix}/${KCROSS}include/bits${BITSIZE}",
	     "-I${prefix}/${KCROSS}include");

# Default optimization options (for compiles without -g)
@optopt =  @OPTFLAGS;
@goptopt = ('-O');

# Standard library directories
@stdlibpath = ("-L${prefix}/${KCROSS}lib");

# Options and libraries to pass to ld; shared versus static
@staticopt = ("${prefix}/${KCROSS}lib/crt0.o");
@staticlib = ("${prefix}/${KCROSS}lib/libc.a");
@sharedopt = (@EMAIN, "${prefix}/${KCROSS}lib/interp.o");
@sharedlib = ('-R', "${prefix}/${KCROSS}lib/libc.so");

# Returns the language (-x option string) for a specific extension.
sub filename2lang($) {
    my ($file) = @_;

    return 'c' if ( $file =~ /\.c$/ );
    return 'c-header' if ( $file =~ /\.h$/ );
    return 'cpp-output' if ( $file =~ /\.i$/ );
    return 'c++-cpp-output' if ( $file =~ /\.ii$/ );
    return 'objective-c' if ( $file =~ /\.m$/ );
    return 'objc-cpp-output' if ( $file =~ /\.mi$/ );
    return 'c++' if ( $file =~/\.(cc|cp|cxx|cpp|CPP|c\+\+|C)$/ );
    return 'c++-header' if ( $file =~ /\.(hh|H)$/ );
    return 'f77' if ( $file =~ /\.(f|for|FOR)$/ );
    return 'f77-cpp-input' if ( $file =~ /\.(F|fpp|FPP)$/ );
    return 'ratfor' if ( $file =~ /\.r$/ );

    # Is this correct?
    return 'ada' if ( $file =~ /\.(ads|adb)$/ );

    return 'assembler' if ( $file =~ /\.s$/ );
    return 'assembler-with-cpp' if ( $file =~/\.S$/ );

    # Linker file; there is no option to gcc to assume something
    # is a linker file, so we make up our own...
    return 'obj';
}

# Produces a series of -x options and files
sub files_with_lang($$) {
    my($files, $flang) = @_;
    my(@as) = ();
    my($xopt) = 'none';
    my($need);

    foreach $f ( @{$files} ) {
	$need = ${$flang}{$f};

	# Skip object files
	if ( $need ne 'obj' ) {
	    unless ( $xopt eq $need || $need eq 'stdin') {
		push(@as, '-x', $need);
		$xopt = $need;
	    }
	    push(@as, $f);
	}
    }

    return @as;
}

# Convert a return value from system() to an exit() code
sub syserr($) {
    my($e) = @_;

    return ($e & 0x7f) | 0x80 if ( $e & 0xff );
    return $e >> 8;
}

# Run a program; printing out the command line if $verbose is set
sub mysystem(@) {
    print STDERR join(' ', @_), "\n" if ( $verbose );
    my $cmd = shift;
    open(INPUT, "<&STDIN");	# dup STDIN filehandle to INPUT
    my $childpid = open3("<&INPUT", ">&STDOUT", ">&STDERR", $cmd, @_);
    waitpid ($childpid, 0);
    return $?;
}

#
# Initialization
#
open(NULL, '+<', '/dev/null') or die "$0: cannot open /dev/null\n";

#
# Begin parsing options.
#

@ccopt = ();
@ldopt = ();
@libs  = ();

@files = ();			# List of files
%flang = ();			# Languages for files

# This is 'c' for compile only, 'E' for preprocess only,
# 'S' for compile to assembly.
$operation = '';		# Compile and link

# Current -x option.  If undefined, it means autodetect.
undef $lang;

$save_temps = 0;		# The -save-temps option
$verbose = 0;			# The -v option
$shared = 0;	   		# Are we compiling shared?
$debugging = 0;	   		# -g or -p option present?
$strip = 0;			# -s option present?
undef $output;			# -o option present?

while ( defined($a = shift(@ARGV)) ) {
    if ( $a !~ /^\-/ ) {
	# Not an option.  Must be a filename then.
	push(@files, $a);
	$flang{$a} = $lang || filename2lang($a);
    } elsif ( $a eq '-' ) {
	# gcc gets its input from stdin
	push(@files, $a);
	# prevent setting -x
	$flang{$a} = 'stdin'
    } elsif ( $a =~ /^-print-klibc-(.*)$/ ) {
	# This test must precede -print
	if ( defined($conf{$1}) ) {
	    print ${$conf{$1}}, "\n";
	    exit 0;
	} else {
	    die "$0: unknown option: $a\n";
	}
    } elsif ( $a =~ /^(-print|-dump|--help|--version)/ ) {
	# These share prefixes with some other options, so put this test early!
	# Pseudo-operations; just pass to gcc and don't do anything else
	push(@ccopt, $a);
	$operation = 'c' if ( $operation eq '' );
    } elsif ( $a =~ /^-Wl,(.*)$/ ) {
	# -Wl used to pass options to the linker
	push(@ldopt, split(/,/, $1));
    } elsif ( $a =~ /^-([fmwWQdO]|std=|ansi|pedantic|M[GPD]|MMD)/ ) {
	# Options to gcc
	push(@ccopt, $a);
    } elsif ( $a =~ /^-([DUI]|M[FQT])(.*)$/ ) {
	# Options to gcc, which can take either a conjoined argument
	# (-DFOO) or a disjoint argument (-D FOO)
	push(@ccopt, $a);
	push(@ccopt, shift(@ARGV)) if ( $2 eq '' );
    } elsif ( $a eq '-include' ) {
	# Options to gcc which always take a disjoint argument
	push(@ccopt, $a, shift(@ARGV));
    } elsif ( $a eq '-M' || $a eq '-MM' ) {
	# gcc options, that force preprocessing mode
	push(@ccopt, $a);
	$operation = 'E';
    } elsif ( $a eq '--param' ) {
	push(@ccopt, $a);
	push(@ccopt, shift(@ARGV));
    } elsif ( $a =~ /^-[gp]/ || $a eq '-p' ) {
	# Debugging options to gcc
	push(@ccopt, $a);
	$debugging = 1;
    } elsif ( $a eq '-v' ) {
	push(@ccopt, $a);
	$verbose = 1;
    } elsif ( $a eq '-save-temps' ) {
	push(@ccopt, $a);
	$save_temps = 1;
    } elsif ( $a =~ '^-([cSE])$' ) {
	push(@ccopt, $a);
	$operation = $1;
    } elsif ( $a eq '-shared' ) {
	$shared = 1;
    } elsif ( $a eq '-static' ) {
	$shared = 0;
    } elsif ( $a eq '-s' ) {
	$strip = 1;
    } elsif ( $a eq '-o' ) {
	$output = shift(@ARGV);
    } elsif ( $a =~ /^\-x(.*)$/ ) {
	# -x can be conjoined or disjoined
	$lang = $1;
	if ( $lang eq '' ) {
	    $lang = shift(@ARGV);
	}
    } elsif ( $a eq '-nostdinc' ) {
	push(@ccopt, $a);
	@includes = ();
    } elsif ( $a =~ /^-([lL])(.*)$/ ) {
	# Libraries
	push(@libs, $a);
	push(@libs, shift(@ARGV)) if ( $2 eq '' );
    } else {
	die "$0: unknown option: $a\n";
    }
}

if ( $debugging ) {
    @ccopt = (@REQFLAGS, @includes, @goptopt, @ccopt);
} else {
    @ccopt = (@REQFLAGS, @includes, @optopt, @ccopt);
}

if ( $operation ne '' ) {
    # Just run gcc with the appropriate options
    @outopt = ('-o', $output) if ( defined($output) );
    $rv = mysystem($CC, @ccopt, @outopt, files_with_lang(\@files, \%flang));
} else {
    if ( scalar(@files) == 0 ) {
	die "$0: No input files!\n";
    }

    @outopt = ('-o', $output || 'a.out');

    @objs = ();
    @rmobjs = ();

    foreach $f ( @files ) {
	if ( $flang{$f} eq 'obj' ) {
	    push(@objs, $f);
	} else {
	    $fo = $f;
	    $fo =~ s/\.[^\/.]+$/\.o/;

	    die if ( $f eq $fo ); # safety check

	    push(@objs, $fo);
	    push(@rmobjs, $fo) unless ( $save_temps );

	    $rv = mysystem($CC, @ccopt, '-c', '-o', $fo, '-x', $flang{$f}, $f);

	    if ( $rv ) {
		unlink(@rmobjs);
		exit syserr($rv);
	    }
	}
    }

    # Get the libgcc pathname for the *current* gcc
    open(LIBGCC, '-|', $CC, @ccopt, '-print-libgcc-file-name')
	or die "$0: cannot get libgcc filename\n";
    $libgcc = <LIBGCC>;
    chomp $libgcc;
    close(LIBGCC);

    if ( $shared ) {
	$rv = mysystem($LD, @LDFLAGS, @sharedopt, @ldopt, @outopt, @objs,
		       @libs, @stdlibpath, '--start-group', @sharedlib,
		       $libgcc, '--end-group');
    } else {
	$rv = mysystem($LD, @LDFLAGS, @staticopt, @ldopt, @outopt, @objs,
		       @libs, @stdlibpath, '--start-group', @staticlib,
		       $libgcc, '--end-group');
    }

    unlink(@rmobjs);

    if ( $strip && !$rv ) {
	$rv = mysystem($STRIP, @STRIPFLAGS, $output);
    }
}

exit syserr($rv);
1	niro	532	# -- perl --
2
3			use IPC::Open3;
4
5			# Standard includes
6			@includes = ("-I${prefix}/${KCROSS}include/arch/${ARCH}",
7			"-I${prefix}/${KCROSS}include/bits${BITSIZE}",
8			"-I${prefix}/${KCROSS}include");
9
10			# Default optimization options (for compiles without -g)
11			@optopt = @OPTFLAGS;
12			@goptopt = ('-O');
13
14			# Standard library directories
15			@stdlibpath = ("-L${prefix}/${KCROSS}lib");
16
17			# Options and libraries to pass to ld; shared versus static
18			@staticopt = ("${prefix}/${KCROSS}lib/crt0.o");
19			@staticlib = ("${prefix}/${KCROSS}lib/libc.a");
20			@sharedopt = (@EMAIN, "${prefix}/${KCROSS}lib/interp.o");
21			@sharedlib = ('-R', "${prefix}/${KCROSS}lib/libc.so");
22
23			# Returns the language (-x option string) for a specific extension.
24			sub filename2lang($) {
25			my ($file) = @_;
26
27			return 'c' if ( $file =~ /\.c$/ );
28			return 'c-header' if ( $file =~ /\.h$/ );
29			return 'cpp-output' if ( $file =~ /\.i$/ );
30			return 'c++-cpp-output' if ( $file =~ /\.ii$/ );
31			return 'objective-c' if ( $file =~ /\.m$/ );
32			return 'objc-cpp-output' if ( $file =~ /\.mi$/ );
33			return 'c++' if ( $file =~/\.(cc\|cp\|cxx\|cpp\|CPP\|c\+\+\|C)$/ );
34			return 'c++-header' if ( $file =~ /\.(hh\|H)$/ );
35			return 'f77' if ( $file =~ /\.(f\|for\|FOR)$/ );
36			return 'f77-cpp-input' if ( $file =~ /\.(F\|fpp\|FPP)$/ );
37			return 'ratfor' if ( $file =~ /\.r$/ );
38
39			# Is this correct?
40			return 'ada' if ( $file =~ /\.(ads\|adb)$/ );
41
42			return 'assembler' if ( $file =~ /\.s$/ );
43			return 'assembler-with-cpp' if ( $file =~/\.S$/ );
44
45			# Linker file; there is no option to gcc to assume something
46			# is a linker file, so we make up our own...
47			return 'obj';
48			}
49
50			# Produces a series of -x options and files
51			sub files_with_lang($$) {
52			my($files, $flang) = @_;
53			my(@as) = ();
54			my($xopt) = 'none';
55			my($need);
56
57			foreach $f ( @{$files} ) {
58			$need = ${$flang}{$f};
59
60			# Skip object files
61			if ( $need ne 'obj' ) {
62			unless ( $xopt eq $need \|\| $need eq 'stdin') {
63			push(@as, '-x', $need);
64			$xopt = $need;
65			}
66			push(@as, $f);
67			}
68			}
69
70			return @as;
71			}
72
73			# Convert a return value from system() to an exit() code
74			sub syserr($) {
75			my($e) = @_;
76
77			return ($e & 0x7f) \| 0x80 if ( $e & 0xff );
78			return $e >> 8;
79			}
80
81			# Run a program; printing out the command line if $verbose is set
82			sub mysystem(@) {
83			print STDERR join(' ', @_), "\n" if ( $verbose );
84			my $cmd = shift;
85			open(INPUT, "<&STDIN"); # dup STDIN filehandle to INPUT
86			my $childpid = open3("<&INPUT", ">&STDOUT", ">&STDERR", $cmd, @_);
87			waitpid ($childpid, 0);
88			return $?;
89			}
90
91			#
92			# Initialization
93			#
94			open(NULL, '+<', '/dev/null') or die "$0: cannot open /dev/null\n";
95
96			#
97			# Begin parsing options.
98			#
99
100			@ccopt = ();
101			@ldopt = ();
102			@libs = ();
103
104			@files = (); # List of files
105			%flang = (); # Languages for files
106
107			# This is 'c' for compile only, 'E' for preprocess only,
108			# 'S' for compile to assembly.
109			$operation = ''; # Compile and link
110
111			# Current -x option. If undefined, it means autodetect.
112			undef $lang;
113
114			$save_temps = 0; # The -save-temps option
115			$verbose = 0; # The -v option
116			$shared = 0; # Are we compiling shared?
117			$debugging = 0; # -g or -p option present?
118			$strip = 0; # -s option present?
119			undef $output; # -o option present?
120
121			while ( defined($a = shift(@ARGV)) ) {
122			if ( $a !~ /^\-/ ) {
123			# Not an option. Must be a filename then.
124			push(@files, $a);
125			$flang{$a} = $lang \|\| filename2lang($a);
126			} elsif ( $a eq '-' ) {
127			# gcc gets its input from stdin
128			push(@files, $a);
129			# prevent setting -x
130			$flang{$a} = 'stdin'
131			} elsif ( $a =~ /^-print-klibc-(.*)$/ ) {
132			# This test must precede -print
133			if ( defined($conf{$1}) ) {
134			print ${$conf{$1}}, "\n";
135			exit 0;
136			} else {
137			die "$0: unknown option: $a\n";
138			}
139			} elsif ( $a =~ /^(-print\|-dump\|--help\|--version)/ ) {
140			# These share prefixes with some other options, so put this test early!
141			# Pseudo-operations; just pass to gcc and don't do anything else
142			push(@ccopt, $a);
143			$operation = 'c' if ( $operation eq '' );
144			} elsif ( $a =~ /^-Wl,(.*)$/ ) {
145			# -Wl used to pass options to the linker
146			push(@ldopt, split(/,/, $1));
147			} elsif ( $a =~ /^-([fmwWQdO]\|std=\|ansi\|pedantic\|M[GPD]\|MMD)/ ) {
148			# Options to gcc
149			push(@ccopt, $a);
150			} elsif ( $a =~ /^-([DUI]\|M[FQT])(.*)$/ ) {
151			# Options to gcc, which can take either a conjoined argument
152			# (-DFOO) or a disjoint argument (-D FOO)
153			push(@ccopt, $a);
154			push(@ccopt, shift(@ARGV)) if ( $2 eq '' );
155			} elsif ( $a eq '-include' ) {
156			# Options to gcc which always take a disjoint argument
157			push(@ccopt, $a, shift(@ARGV));
158			} elsif ( $a eq '-M' \|\| $a eq '-MM' ) {
159			# gcc options, that force preprocessing mode
160			push(@ccopt, $a);
161			$operation = 'E';
162	niro	1297	} elsif ( $a eq '--param' ) {
163			push(@ccopt, $a);
164			push(@ccopt, shift(@ARGV));
165	niro	532	} elsif ( $a =~ /^-[gp]/ \|\| $a eq '-p' ) {
166			# Debugging options to gcc
167			push(@ccopt, $a);
168			$debugging = 1;
169			} elsif ( $a eq '-v' ) {
170			push(@ccopt, $a);
171			$verbose = 1;
172			} elsif ( $a eq '-save-temps' ) {
173			push(@ccopt, $a);
174			$save_temps = 1;
175			} elsif ( $a =~ '^-([cSE])$' ) {
176			push(@ccopt, $a);
177			$operation = $1;
178			} elsif ( $a eq '-shared' ) {
179			$shared = 1;
180			} elsif ( $a eq '-static' ) {
181			$shared = 0;
182			} elsif ( $a eq '-s' ) {
183			$strip = 1;
184			} elsif ( $a eq '-o' ) {
185			$output = shift(@ARGV);
186			} elsif ( $a =~ /^\-x(.*)$/ ) {
187			# -x can be conjoined or disjoined
188			$lang = $1;
189			if ( $lang eq '' ) {
190			$lang = shift(@ARGV);
191			}
192			} elsif ( $a eq '-nostdinc' ) {
193			push(@ccopt, $a);
194			@includes = ();
195			} elsif ( $a =~ /^-([lL])(.*)$/ ) {
196			# Libraries
197			push(@libs, $a);
198			push(@libs, shift(@ARGV)) if ( $2 eq '' );
199			} else {
200			die "$0: unknown option: $a\n";
201			}
202			}
203
204			if ( $debugging ) {
205			@ccopt = (@REQFLAGS, @includes, @goptopt, @ccopt);
206			} else {
207			@ccopt = (@REQFLAGS, @includes, @optopt, @ccopt);
208			}
209
210			if ( $operation ne '' ) {
211			# Just run gcc with the appropriate options
212			@outopt = ('-o', $output) if ( defined($output) );
213			$rv = mysystem($CC, @ccopt, @outopt, files_with_lang(\@files, \%flang));
214			} else {
215			if ( scalar(@files) == 0 ) {
216			die "$0: No input files!\n";
217			}
218
219			@outopt = ('-o', $output \|\| 'a.out');
220
221			@objs = ();
222			@rmobjs = ();
223
224			foreach $f ( @files ) {
225			if ( $flang{$f} eq 'obj' ) {
226			push(@objs, $f);
227			} else {
228			$fo = $f;
229			$fo =~ s/\.[^\/.]+$/\.o/;
230
231			die if ( $f eq $fo ); # safety check
232
233			push(@objs, $fo);
234			push(@rmobjs, $fo) unless ( $save_temps );
235
236			$rv = mysystem($CC, @ccopt, '-c', '-o', $fo, '-x', $flang{$f}, $f);
237
238			if ( $rv ) {
239			unlink(@rmobjs);
240			exit syserr($rv);
241			}
242			}
243			}
244
245			# Get the libgcc pathname for the current gcc
246			open(LIBGCC, '-\|', $CC, @ccopt, '-print-libgcc-file-name')
247			or die "$0: cannot get libgcc filename\n";
248			$libgcc = <LIBGCC>;
249			chomp $libgcc;
250			close(LIBGCC);
251
252			if ( $shared ) {
253			$rv = mysystem($LD, @LDFLAGS, @sharedopt, @ldopt, @outopt, @objs,
254			@libs, @stdlibpath, '--start-group', @sharedlib,
255			$libgcc, '--end-group');
256			} else {
257			$rv = mysystem($LD, @LDFLAGS, @staticopt, @ldopt, @outopt, @objs,
258			@libs, @stdlibpath, '--start-group', @staticlib,
259			$libgcc, '--end-group');
260			}
261
262			unlink(@rmobjs);
263
264			if ( $strip && !$rv ) {
265			$rv = mysystem($STRIP, @STRIPFLAGS, $output);
266			}
267			}
268
269			exit syserr($rv);