Meta::Tool::Gcc - tool for running gcc.
#!/bin/echo This is a perl module and should not be run
package Meta::Tool::Gcc;
use strict qw(vars refs subs);
use XML::DOM qw();
use Meta::Utils::System qw();
use Meta::Baseline::Arch qw();
use Meta::Utils::Unix qw();
use Meta::Utils::Output qw();
use Meta::Tool::Gcc qw();
use Meta::Utils::Options qw();
use Meta::Lang::Cpp::Libs qw();
use Meta::Utils::File::Patho qw();
use Meta::Development::Module qw();
use Error qw(:try);
our($VERSION,@ISA);
$VERSION="0.28";
@ISA=qw();
#sub BEGIN();
#sub get_path();
#sub get_version();
#sub get_dom($);
#sub link($$$$$$$$$$$$$$$$);
#sub your_proc($);
#sub compile($);
#sub TEST($);
#__DATA__
our($gcc_compiler,$gcc_path,$gpp_compiler,$gpp_path);
sub BEGIN() {
my($patho)=Meta::Utils::File::Patho->new_path();
$gcc_compiler=$patho->resolve("gcc");
$gcc_path=$patho->path_to("gcc");
$gpp_compiler=$patho->resolve("g++");
$gpp_path=$patho->path_to("g++");
#$gcc_path="/usr/bin";
}
sub get_path() {
return($gcc_path);
}
sub get_version() {
my($output)=Meta::Utils::System::system_out($gcc_compiler,["--version"]);
chop($$output);
return($$output);
}
sub get_dom($) {
my($errors)=@_;
Meta::Utils::Output::print($errors);
my($retu)=XML::DOM::Document->new();
my($el_errors)=$retu->createElement("errors");
$retu->appendChild($el_errors);
my(@lines)=split('\n',$errors);
for(my($i)=0;$i<=$#lines;$i++) {
my($curr)=$lines[$i];
# skip stupid message by the compiler
if($curr eq "cc1plus: warnings being treated as errors") {
next;
}
# skip source files (actually I do need to do something about
# that...).
if($curr=~/^In file included from /) {
next;
}
my($el_error)=$retu->createElement("error");
$el_errors->appendChild($el_error);
my($el_file)=$retu->createElement("file");
$el_error->appendChild($el_file);
my($el_line)=$retu->createElement("line");
$el_error->appendChild($el_line);
my($el_char)=$retu->createElement("char");
$el_error->appendChild($el_char);
my($el_text)=$retu->createElement("text");
$el_error->appendChild($el_text);
my(@fields)=split(':',$curr);
if($#fields!=2) {
# throw Meta::Error::Simple("what line is [".$curr."]\n");
next;
# throw Meta::Error::Simple("what kind of gcc output is [".$curr."]");
}
my($file)=$fields[0];
my($line)=$fields[1];
my($char)="unknown";
my($text)=$fields[2];
my($text_file)=$retu->createTextNode($file);
$el_file->appendChild($text_file);
my($text_line)=$retu->createTextNode($line);
$el_line->appendChild($text_line);
my($text_char)=$retu->createTextNode($char);
$el_char->appendChild($text_char);
my($text_text)=$retu->createTextNode($text);
$el_text->appendChild($text_text);
}
return($retu);
}
sub link($$$$$$$$$$$$$$$$) {
my($verb,$demo,$proc,$trg0,$trg1,$trg2,$trg3,$src0,$src1,$src2,$src3,$prm0,$prm1,$prm2,$prm3,$path)=@_;
my($module)=Meta::Development::Module->new_name("data/baseline/cook/ccxx.txt");
my($options)=Meta::Utils::Options->new_modu($module);
my($einc)=$options->get("base_cook_lang_ccxx_incl");
my($elib)=$options->get("base_cook_lang_ccxx_link");
my($targ)=$trg0;
my(@objs)=split(":",$src0);
my(@libs)=split(":",$src1);
my(@rlib)=split(":",$prm0);
my(@rpth)=split(":",$prm1);
my(@pths)=split(":",$path);
my(@args);
#$verb=1;
if($verb) {
Meta::Utils::Output::print("verb is [".$verb."]\n");
Meta::Utils::Output::print("demo is [".$demo."]\n");
Meta::Utils::Output::print("proc is [".$proc."]\n");
Meta::Utils::Output::print("trg0 is [".$trg0."]\n");
Meta::Utils::Output::print("trg1 is [".$trg1."]\n");
Meta::Utils::Output::print("trg2 is [".$trg2."]\n");
Meta::Utils::Output::print("trg3 is [".$trg3."]\n");
Meta::Utils::Output::print("src0 is [".$src0."]\n");
Meta::Utils::Output::print("src1 is [".$src1."]\n");
Meta::Utils::Output::print("src2 is [".$src2."]\n");
Meta::Utils::Output::print("src3 is [".$src3."]\n");
Meta::Utils::Output::print("prm0 is [".$prm0."]\n");
Meta::Utils::Output::print("prm1 is [".$prm1."]\n");
Meta::Utils::Output::print("prm2 is [".$prm2."]\n");
Meta::Utils::Output::print("prm3 is [".$prm3."]\n");
Meta::Utils::Output::print("path is [".$path."]\n");
Meta::Utils::Output::print("number of objs is [".$#objs."]\n");
Meta::Utils::Output::print("number of libs is [".$#libs."]\n");
Meta::Utils::Output::print("number of rlib is [".$#rlib."]\n");
Meta::Utils::Output::print("number of rpth is [".$#rpth."]\n");
Meta::Utils::Output::print("number of pths is [".$#pths."]\n");
Meta::Utils::Output::print("objs is [".join(":",@objs)."]\n");
Meta::Utils::Output::print("libs is [".join(":",@libs)."]\n");
Meta::Utils::Output::print("rlib is [".join(":",@rlib)."]\n");
Meta::Utils::Output::print("rpth is [".join(":",@rpth)."]\n");
Meta::Utils::Output::print("pths is [".join(":",@pths)."]\n");
}
my($arch)=Meta::Baseline::Arch->new();
$arch->analyze($proc);
my($cpu)=$arch->get_cpu();
my($os)=$arch->get_os();
my($os_version)=$arch->get_os_version();
my($compiler)=$arch->get_compiler();
#Meta::Utils::Output::print("compiler is [".$compiler."]\n");
my($compiler_version)=$arch->get_compiler_version();
my($flagset_primary)=$arch->get_flagset_primary();
my($flagset_secondary)=$arch->get_flagset_secondary();
my($dire)=$arch->get_dire();
my($ldir)=$arch->get_dll_directory();
# Put type specific flags here
if($flagset_primary eq "bin") {
}
if($flagset_primary eq "dll") {
push(@args,"-shared");
}
if($flagset_primary eq "lib") {
}
# lets set the program to run for the compiler wanted
my($prog)=$compiler;
# Put flagset specifics here
if($flagset_secondary eq "opt") {
push(@args,"-s");
}
if($flagset_secondary eq "dbg") {
}
if($flagset_secondary eq "prf") {
}
push(@args,"-o");
push(@args,$targ);
push(@args,@objs);
for(my($i)=0;$i<=$#pths;$i++) {
push(@args,"-L".$pths[$i]."/".$ldir);
#push(@args,"-Xlinker","-rpath","-Xlinker",$pths[$i]."/".$ldir);
}
for(my($i)=0;$i<=$#libs;$i++) {
my($clib)=$libs[$i];
my($name)=Meta::Utils::Unix::file_to_libname($clib);
push(@args,"-l".$name);
}
for(my($i)=0;$i<=$#rpth;$i++) {
push(@args,"-L".$rpth[$i]);
}
my(@elib)=split(':',$elib);
for(my($i)=0;$i<=$#elib;$i++) {
push(@args,"-L".$elib[$i]);
}
my($obje)=Meta::Lang::Cpp::Libs->new();
for(my($i)=0;$i<=$#rlib;$i++) {
my($curr)=$rlib[$i];
push(@args,"-l".$rlib[$i]);
if($obje->node_has($curr)) {
my($edges)=$obje->edge_ou($curr);
for(my($j)=0;$j<$edges->size();$j++) {
my($clib)=$edges->elem($j);
# Meta::Utils::Output::print("pushing [".$clib."]\n");
push(@args,"-l".$clib);
}
} else {
Meta::Utils::Output::print("node [".$curr."] does not exist in lib graph\n");
return(0);
}
}
if($verb) {
Meta::Utils::Output::print("prog is [".$prog."]\n");
for(my($i)=0;$i<=$#args;$i++) {
Meta::Utils::Output::print("arg [".$i."] is ".$args[$i]."\n");
}
}
my($scod)=Meta::Utils::System::system_nodie($gcc_path."/".$prog,\@args);
return($scod);
}
sub your_proc($) {
my($proc)=@_;
return(1);
}
sub compile($) {
my($buil)=@_;
my($modu)=$buil->get_modu();
my($srcx)=$buil->get_srcx();
my($targ)=$buil->get_targ();
my($path)=$buil->get_path();
my(@comps)=split('/',$targ);
my($dire)=join('/',$comps[0],$comps[1]);
# Meta::Utils::Output::print("dire is [".$dire."]\n");
my($module)=Meta::Development::Module->new_name("data/baseline/cook/ccxx.txt");
my($options)=Meta::Utils::Options->new_modu($module);
my($einc)=$options->get("base_cook_lang_ccxx_incl");
my($elib)=$options->get("base_cook_lang_ccxx_link");
# Meta::Utils::Output::print("ccxx is [".$srcx."]\n");
# Meta::Utils::Output::print("objx is [".$targ."]\n");
# Meta::Utils::Output::print("dire is [".$dire."]\n");
# Meta::Utils::Output::print("path is [".$path."]\n");
# Meta::Utils::Output::print("einc is [".$einc."]\n");
# Meta::Utils::Output::print("elib is [".$elib."]\n");
my($arch_o)=Meta::Baseline::Arch->new();
$arch_o->from_dire($dire);
my($prog)=$arch_o->get_compiler();
my($pref);
my($foun)=0;
if(!$foun) {
if($prog eq "gcc") {
$pref="cxxx";
$foun=1;
}
}
if(!$foun) {
if($prog eq "g++") {
$pref="ccxx";
$foun=1;
}
}
if(!$foun) {
throw Meta::Error::Simple("what exactly do you want me to compile ?");
}
my($os)=$arch_o->get_os();
my($cpu)=$arch_o->get_cpu();
my($compiler)=$arch_o->get_compiler();
my($compiler_version)=$arch_o->get_compiler_version();
my($type)=$arch_o->get_flagset_primary();
my($flag)=$arch_o->get_flagset_secondary();
my(@args);
push(@args,$srcx);
push(@args,"-o");
push(@args,$targ);
if($type eq "pre") {
if($prog eq "g++") {
push(@args,"-E");
if($flag eq "dbg") {
push(@args,"-DDBG_ON=1");
}
if($flag eq "opt") {
push(@args,"-DDBG_ON=0");
}
if($flag eq "prf") {
push(@args,"-DDBG_ON=0");
}
}
if($prog eq "gcc") {
push(@args,"-E");
if($flag eq "dbg") {
push(@args,"-DDBG_ON=1");
}
if($flag eq "opt") {
push(@args,"-DDBG_ON=0");
}
if($flag eq "prf") {
push(@args,"-DDBG_ON=0");
}
}
}
if($type eq "obj") {
if($prog eq "g++") {
push(@args,"-c");
push(@args,"-pipe");
push(@args,"-fPIC");
push(@args,"-fno-implicit-templates");
push(@args,"-Wall");
push(@args,"-Wpointer-arith");
push(@args,"-Wmissing-declarations");
push(@args,"-Wmissing-prototypes");
# no longer supported by gcc (as of 3.2)
# push(@args,"-Wid-clash-16");
push(@args,"-Wstrict-prototypes");
push(@args,"-Wnested-externs");
push(@args,"-Wwrite-strings");
push(@args,"-Werror");
push(@args,"-Wunknown-pragmas");
push(@args,"-ansi");
# was removed because gnomemm headers do that
# push(@args,"-Woverloaded-virtual");
# was removed bacause mysql++ headers request inlines of stuff which
# the compiler cant do (that is the meaning of the warning).
# push(@args,"-Winline");
# was removed because the Cwd library wanted rtti
# push(@args,"-fno-rtti");
# was removed bacause of the mysql++ library
# push(@args,"-fno-exceptions");
# was removed because that mysql.h has problems with it
# push(@args,"-pedantic-errors");
# was removed because it does not allow '#if [name]' when the name name
# is not defined and LEDA headers are full of those
# push(@args,"-Wundef");
# was removed bacause system headers are full of those (declaring the
# same function twice or more...).
# push(@args,"-Wredundant-decls");
if($flag eq "dbg") {
push(@args,"-DDBG_ON=1");
push(@args,"-ggdb3");
}
if($flag eq "opt") {
push(@args,"-DDBG_ON=0");
push(@args,"-O3");
push(@args,"-march=".$cpu);
}
if($flag eq "prf") {
push(@args,"-DDBG_ON=0");
push(@args,"-pg");
}
}
if($prog eq "gcc") {
push(@args,"-c");
push(@args,"-pipe");
push(@args,"-fPIC");
push(@args,"-Wall");
push(@args,"-Wstrict-prototypes");
push(@args,"-Wnested-externs");
push(@args,"-Wwrite-strings");
push(@args,"-Werror");
push(@args,"-Wunknown-pragmas");
push(@args,"-ansi");
if($flag eq "dbg") {
push(@args,"-DDBG_ON=1");
push(@args,"-ggdb3");
}
if($flag eq "opt") {
push(@args,"-DDBG_ON=0");
push(@args,"-O3");
push(@args,"-march=".$cpu);
}
if($flag eq "prf") {
push(@args,"-DDBG_ON=0");
push(@args,"-pg");
}
}
}
# now handle the include paths
my(@path)=split(':',$path);
for(my($i)=0;$i<=$#path;$i++) {
push(@args,"-I");
push(@args,$path[$i]."/".$pref);
}
my(@einc)=split(':',$einc);
for(my($i)=0;$i<=$#einc;$i++) {
push(@args,"-I");
push(@args,$einc[$i]);
}
# Meta::Utils::Output::print("ccxx is [".$srcx."]\n");
# Meta::Utils::Output::print("objx is [".$targ."]\n");
# Meta::Utils::Output::print("type is [".$type."]\n");
# Meta::Utils::Output::print("dire is [".$dire."]\n");
# Meta::Utils::Output::print("path is [".$path."]\n");
# Meta::Utils::Output::print("einc is [".$einc."]\n");
# Meta::Utils::Output::print("elib is [".$elib."]\n");
my($exe)=$gcc_path."/".$prog;
# Meta::Utils::Output::print("exe is [".$exe."]\n");
# for(my($i)=0;$i<=$#args;$i++) {
# Meta::Utils::Output::print("arg [".$i."] is [".$args[$i]."]\n");
# }
my($text);
my($scod)=Meta::Utils::System::system_err_nodie(\$text,$exe,\@args);
if(!$scod) {
Meta::Utils::Output::print("errors are [".$text."]\n");
#my($dom)=Meta::Tool::Gcc::get_dom($text);
#Meta::Utils::Output::print($dom->toString());
}
return($scod);
}
sub TEST($) {
my($context)=@_;
Meta::Utils::Output::print("path is [".&get_path()."]\n");
Meta::Utils::Output::print("version is [".&get_version()."]\n");
return(1);
}
1;
__END__