rcb.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use File::Basename;
   6 use Cwd 'abs_path';
   7 #use Data::Dump qw(dump);
   8
   9 my $this_path = abs_path();
  10
  11 sub syntax {
  12         die "syntax: $0 [--new --force --verbose --step --ignore-errors] mainfile.c [-lc -lm -lncurses]\n" .
  13         "--new will ignore an existing .rcb file and rescan the deps\n" .
  14         "--force will force a complete rebuild despite object file presence.\n" .
  15         "--verbose will print the complete linker output and other info\n" .
  16         "--step will add one dependency after another, to help finding hidden deps\n";
  17 }
  18
  19 sub expandarr {
  20         my $res = "";
  21         while(@_) {
  22                 my $x = shift;
  23                 chomp($x);
  24                 $res .= "$x ";
  25         }
  26         return $res;
  27 }
  28
  29 sub expandhash {
  30         my $res = "";
  31         my $h = shift;
  32         for my $x(keys %$h) {
  33                 chomp($x);
  34                 $res .= "$x ";
  35         }
  36         return $res;
  37 }
  38
  39 sub name_wo_ext {
  40         my $x = shift;
  41         my $l = length($x);
  42         $l-- while($l && substr($x, $l, 1) ne ".");
  43         return substr($x, 0, $l + 1) if($l);
  44         return "";
  45 }
  46
  47 my $colors = {
  48         "default" => 98,
  49         "white" => 97,
  50         "cyan" => 96,
  51         "magenta" => 95,
  52         "blue" => 94,
  53         "yellow" => 93,
  54         "green" => 92,
  55         "red" => 91,
  56         "gray" => 90,
  57         "end" => 0
  58 };
  59 my $colstr = "\033[%dm";
  60
  61 my %hdep;
  62 my @adep;
  63
  64 sub printc {
  65         my $color = shift;
  66         printf $colstr, $colors->{$color};
  67         for my $x(@_) {
  68                 print $x;
  69         }
  70         printf $colstr, $colors->{"end"};
  71 }
  72
  73 sub scandep_doit {
  74         my ($self, $nf) = @_;
  75         my $np = dirname($nf);
  76         my $nb = basename($nf);
  77         if(!defined($hdep{$nf})) {
  78                 if(! -e $nf) {
  79                         printc("red", "failed to find dependency $nf referenced from $self!\n");
  80                         die unless $nf =~ /\.h$/;
  81                 } else {
  82                         scanfile($np, $nb);
  83                 }
  84         }
  85 }
  86
  87 sub make_relative {
  88         my ($basepath, $relpath) = @_;
  89         #print "$basepath ::: $relpath\n";
  90         die "both path's must start with /" if(substr($basepath, 0, 1) ne "/" || substr($relpath, 0, 1) ne "/");
  91         $basepath .= "/" if($basepath !~ /\/$/ && -d $basepath);
  92         $relpath .= "/" if($relpath !~ /\/$/ && -d $relpath);
  93         my $l = 0;
  94         my $l2 = 0;
  95         my $sl = 0;
  96         $l++ while(substr($basepath, $l, 1) eq substr($relpath, $l, 1));
  97         if($l != 0) {
  98                 $l-- while(substr($basepath, $l, 1) ne "/");
  99         }
 100         $l++ if substr($relpath, $l, 1) eq "/";
 101         my $res = substr($relpath, $l);
 102         $l2 = $l;
 103         while($l2 < length($basepath)) {
 104                 $sl++ if substr($basepath, $l2, 1) eq "/";
 105                 $l2++;
 106         }
 107         my $i;
 108         for ($i = 0; $i < $sl; $i++) {
 109                 $res = "../" . $res;
 110         }
 111         return $res;
 112 }
 113
 114
 115 sub scandep {
 116         my ($self, $path, $tf) = @_;
 117         my $absolute = substr($tf, 0, 1) eq "/";
 118
 119         my $nf = $absolute ? $tf : abs_path($path) . "/" . $tf;
 120         printc("red", "[RcB] warning: $tf not found, continuing...\n"), return if !defined($nf);
 121
 122
 123         if ($nf =~ /^\// && $nf !~ /\.h$/) {
 124                 $nf = make_relative($this_path, $nf);
 125         }
 126         die "problem processing $self, $path, $tf" if(!defined($nf));
 127         if($nf =~ /\*/) {
 128                 my @deps = glob($nf);
 129                 for my $d(@deps) {
 130                         scandep_doit($self, $d);
 131                 }
 132         } else {
 133                 scandep_doit($self, $nf);
 134         }
 135 }
 136
 137 my $link = "";
 138 my $forcerebuild = 0;
 139 my $verbose = 0;
 140 my $step = 0;
 141 my $ignore_rcb = 0;
 142 my $mainfile = undef;
 143 my $ignore_errors = 0;
 144 my $debug_cflags = 0;
 145
 146 sub scanfile {
 147         my ($path, $file) = @_;
 148         my $fp;
 149         my $self = $path . "/" . $file;
 150         my $tf = "";
 151
 152         $hdep{$self} = 1;
 153         open($fp, "<", $self) or die "could not open file $self: $!";
 154         while(<$fp>) {
 155                 my $line = $_;
 156                 if ($line =~ /^\/\/RcB: (\w{3,6}) \"(.+?)\"/) {
 157                         my $command = $1;
 158                         my $arg = $2;
 159                         if($command eq "DEP") {
 160                                 $tf = $arg;
 161                                 print "found RcB DEP $tf : $self\n" if $verbose;
 162                                 scandep($self, $path, $tf);
 163                         } elsif ($command eq "LINK") {
 164                                 print "found RcB LINK $arg\n" if $verbose;
 165                                 $link .= $arg . " ";
 166                         }
 167                 } elsif($line =~ /^\s*#\s*include\s+\"([\w\.\/_\-]+?)\"/) {
 168                         $tf = $1;
 169                         scandep($self, $path, $tf);
 170                 } else {
 171
 172                         $tf = "x";
 173                 }
 174         }
 175         close $fp;
 176         push @adep, $self if $file =~ /[\w_-]+\.[c]{1}$/; #only add .c files to deps...
 177 }
 178
 179 argscan:
 180 my $arg1 = shift @ARGV or syntax;
 181 if($arg1 eq "--force") {
 182         $forcerebuild = 1;
 183         goto argscan;
 184 } elsif($arg1 eq "--verbose") {
 185         $verbose = 1;
 186         goto argscan;
 187 } elsif($arg1 eq "--new") {
 188         $ignore_rcb = 1;
 189         goto argscan;
 190 } elsif($arg1 eq "--step") {
 191         $step = 1;
 192         goto argscan;
 193 } elsif($arg1 eq "--ignore-errors") {
 194         $ignore_errors = 1;
 195         goto argscan;
 196 } elsif($arg1 eq "--debug") {
 197         $debug_cflags = 1;
 198         goto argscan;
 199 } else {
 200         $mainfile = $arg1;
 201 }
 202
 203 $mainfile = shift unless defined($mainfile);
 204 syntax unless defined($mainfile);
 205
 206 my $cc;
 207 if (defined($ENV{CC})) {
 208         $cc = $ENV{CC};
 209 } else {
 210         $cc = "cc";
 211         printc "blue", "[RcB] \$CC not set, defaulting to cc\n";
 212 }
 213
 214 my $cflags = defined($ENV{CFLAGS}) ? $ENV{CFLAGS} : "";
 215 $cflags .= $debug_cflags ? "-O0 -g" : "";
 216
 217 my $nm;
 218 if (defined($ENV{NM})) {
 219         $nm = $ENV{NM};
 220 } else {
 221         $nm = "nm";
 222         printc "blue", "[RcB] \$NM not set, defaulting to nm\n";
 223 }
 224
 225 sub compile {
 226         my ($cmdline) = @_;
 227         printc "magenta", "[CC] ", $cmdline, "\n";
 228         my $reslt = `$cmdline 2>&1`;
 229         if($!) {
 230                 printc "red", "ERROR ", $!, "\n";
 231                 exit 1;
 232         }
 233         print $reslt;
 234         return $reslt;
 235 }
 236
 237 $link = expandarr(@ARGV) . " ";
 238
 239 my $cnd = name_wo_ext($mainfile);
 240 my $cndo = $cnd . "o";
 241 my $bin = $cnd . "out";
 242
 243 my $cfgn = name_wo_ext($mainfile) . "rcb";
 244 my $haveconfig = (-e $cfgn);
 245 if($haveconfig && !$ignore_rcb) {
 246         printc "blue", "[RcB] config file found. trying single compile.\n";
 247         @adep = `cat $cfgn | grep "^DEP " | cut -b 5-`;
 248         my @rcb_links = `cat $cfgn | grep "^LINK" | cut -b 6-`;
 249         my $cs = expandarr(@adep);
 250         my $ls = expandarr(@rcb_links);
 251         $link = $ls if (defined($ls) && $ls ne "");
 252         my $res = compile("$cc $cflags $cs $link -o $bin");
 253         if($res =~ /undefined reference to/) {
 254                 printc "red", "[RcB] undefined reference[s] found, switching to scan mode\n";
 255         } else {
 256                 if($?) {
 257                         printc "red", "[RcB] error. exiting.\n";
 258                 } else {
 259                         printc "green", "[RcB] success. $bin created.\n";
 260                 }
 261                 exit $?;
 262         }
 263 }
 264
 265 printc "blue",  "[RcB] scanning deps...";
 266
 267 scanfile dirname(abs_path($mainfile)), basename($mainfile);
 268
 269 printc "green",  "done\n";
 270
 271 my %obj;
 272 printc "blue",  "[RcB] compiling main file...\n";
 273 my $op = compile("$cc $cflags -c $mainfile -o $cndo");
 274 exit 1 if($op =~ /error:/g);
 275 $obj{$cndo} = 1;
 276 my %sym;
 277
 278 my $i = 0;
 279 my $success = 0;
 280 my $run = 0;
 281 my $relink = 1;
 282 my $rebuildflag = 0;
 283 my $objfail = 0;
 284
 285 my %glob_missym;
 286 my %missym;
 287 my %rebuilt;
 288 printc "blue",  "[RcB] resolving linker deps...\n";
 289 while(!$success) {
 290         my @opa;
 291         if($i + 1 >= @adep) { #last element of the array is the already build mainfile
 292                 $run++;
 293                 $i = 0;
 294         }
 295         if(!$i) {
 296                 %glob_missym = %missym, last unless $relink;
 297                 # trying to link
 298                 my %missym_old = %missym;
 299                 %missym = ();
 300                 my $ex = expandhash(\%obj);
 301                 printc "blue",  "[RcB] trying to link ...\n";
 302                 my $cmd = "$cc $cflags $ex $link -o $bin";
 303                 printc "cyan", "[LD] ", $cmd, "\n";
 304                 @opa = `$cmd 2>&1`;
 305                 for(@opa) {
 306                         if(/undefined reference to [\'\`\"]{1}([\w\._]+)[\'\`\"]{1}/) {
 307                                 my $temp = $1;
 308                                 print if $verbose;
 309                                 $missym{$temp} = 1;
 310                         } elsif(
 311                                 /([\/\w\._\-]+): file not recognized: File format not recognized/ ||
 312                                 /architecture of input file [\'\`\"]{1}([\/\w\._\-]+)[\'\`\"]{1} is incompatible with/ ||
 313                                 /fatal error: ([\/\w\._\-]+): unsupported ELF machine number/ ||
 314                                 /ld: ([\/\w\._\-]+): Relocations in generic ELF/
 315                         ) {
 316                                 $cnd = $1;
 317                                 $i = delete $obj{$cnd};
 318                                 printc "red", "[RcB] incompatible object file $cnd, rebuilding...\n";
 319                                 print;
 320                                 $cnd =~ s/\.o/\.c/;
 321                                 $rebuildflag = 1;
 322                                 $objfail = 1;
 323                                 %missym = %missym_old;
 324                                 goto rebuild;
 325                         } elsif(
 326                         /collect2: ld returned 1 exit status/ ||
 327                         /In function [\'\`\"]{1}[\w_]+[\'\`\"]{1}:/ ||
 328                         /more undefined references to/
 329                         ) {
 330                         } else {
 331                                 printc "red", "[RcB] FATAL: unexpected linker output!\n";
 332                                 print;
 333                                 exit 1;
 334                         }
 335                 }
 336                 if(!scalar(keys %missym)) {
 337                         for(@opa) {print;}
 338                         $success = 1;
 339                         last;
 340                 }
 341                 $relink = 0;
 342         }
 343         $cnd = $adep[$i];
 344         goto skip unless defined $cnd;
 345         $rebuildflag = 0;
 346         rebuild:
 347         chomp($cnd);
 348         $cndo = name_wo_ext($cnd) . "o";
 349         if(($forcerebuild || $rebuildflag || ! -e $cndo) && !defined($rebuilt{$cndo})) {
 350                 my $op = compile("$cc $cflags -c $cnd -o $cndo");
 351                 if($op =~ /error:/) {
 352                         exit 1 unless($ignore_errors);
 353                 } else {
 354                         $rebuilt{$cndo} = 1;
 355                 }
 356         }
 357         @opa = `$nm -g $cndo 2>&1`;
 358         my %symhash;
 359         my $matched = 0;
 360         for(@opa) {
 361                 if(/[\da-fA-F]{8,16}\s+[TWRBCD]{1}\s+([\w_]+)/) {
 362                         my $symname = $1;
 363                         $symhash{$symname} = 1;
 364                         $matched = 1;
 365                 } elsif (/File format not recognized/) {
 366                         printc "red",  "[RcB] nm doesn't recognize the format of $cndo, rebuilding...\n";
 367                         $rebuildflag = 1;
 368                         goto rebuild;
 369                 }
 370         }
 371         if($matched){
 372                 $sym{$cndo} = \%symhash;
 373                 my $good = 0;
 374                 for(keys %missym) {
 375                         if(defined($symhash{$_})) {
 376                                 $obj{$cndo} = $i;
 377                                 $adep[$i] = undef;
 378                                 $relink = 1;
 379                                 if($objfail || $step) {
 380                                         $objfail = 0;
 381                                         $i = -1;
 382                                         printc "red", "[RcB] adding $cndo to the bunch...\n" if $step;
 383                                 }
 384                                 last;
 385                         }
 386                 }
 387         }
 388         skip:
 389         $i++;
 390 }
 391
 392 if(!$success) {
 393         printc "red", "[RcB] failed to resolve the following symbols, check your DEP tags\n";
 394         for(keys %glob_missym) {
 395                 print "$_\n";
 396         }
 397 } else {
 398         printc "green", "[RcB] success. $bin created.\n";
 399         printc "blue", "saving required dependencies to $cfgn\n";
 400         my $fh;
 401         open($fh, ">", $cfgn);
 402         for(keys %obj) {
 403                 print { $fh } "DEP ", name_wo_ext($_), "c\n";
 404         }
 405         print { $fh } "LINK ", $link, "\n" if($link);
 406         close($fh);
 407 }