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 # we only process english messages
  10 $ENV{LC_MESSAGES} = "C";
  11 $ENV{LC_ALL} = "C";
  12
  13 my $this_path = undef;
  14 my $cflags = defined($ENV{CFLAGS}) ? $ENV{CFLAGS} : "";
  15 my $ldflags = defined($ENV{LDFLAGS}) ? $ENV{LDFLAGS} : "";
  16
  17 sub min { my ($a, $b) = @_; return $a < $b ? $a : $b; }
  18
  19 sub syntax {
  20         die "syntax: $0 [--new --force --verbose --step --ignore-errors] mainfile.c [-lc -lm -lncurses]\n" .
  21         "--new will ignore an existing .rcb file and rescan the deps\n" .
  22         "--force will force a complete rebuild despite object file presence.\n" .
  23         "--verbose will print the complete linker output and other info\n" .
  24         "--debug adds -O0 -g3 to CFLAGS\n" .
  25         "--step will add one dependency after another, to help finding hidden deps\n" .
  26         "--hdrsrc=ulz:../lib/include replace <ulz> in header inclusion with \"../lib/include\"\n" .
  27         "  this redirects rcb header lookup so rcb tags can point to the right dir.\n";
  28 }
  29
  30 sub expandarr {
  31         my $res = "";
  32         while(@_) {
  33                 my $x = shift;
  34                 chomp($x);
  35                 $res .= "$x ";
  36         }
  37         return $res;
  38 }
  39
  40 sub expandhash {
  41         my $res = "";
  42         my $h = shift;
  43         for my $x(keys %$h) {
  44                 chomp($x);
  45                 $res .= "$x ";
  46         }
  47         return $res;
  48 }
  49
  50 sub name_wo_ext {
  51         my $x = shift;
  52         my $l = length($x);
  53         $l-- while($l && substr($x, $l, 1) ne ".");
  54         return substr($x, 0, $l + 1) if($l);
  55         return "";
  56 }
  57
  58 sub file_ext {
  59         my $x = shift;
  60         my $l = length($x);
  61         $l-- while($l && substr($x, $l, 1) ne ".");
  62         return substr($x, $l) if($l);
  63         return "";
  64 }
  65
  66 my $colors = {
  67         "default" => 98,
  68         "white" => 97,
  69         "cyan" => 96,
  70         "magenta" => 95,
  71         "blue" => 94,
  72         "yellow" => 93,
  73         "green" => 92,
  74         "red" => 91,
  75         "gray" => 90,
  76         "end" => 0
  77 };
  78 my $colstr = "\033[%dm";
  79
  80 my %hdep;
  81 my @adep;
  82 my @includedirs;
  83
  84 sub process_include_dirs {
  85         my @p = split / /, $cflags;
  86         my $i;
  87         push @includedirs, ""; # empty entry for the first iteration in scandep_doit
  88         for($i = 0; $i < scalar(@p); $i++) {
  89                 if($p[$i] eq "-I") {
  90                         $i++;
  91                         push @includedirs, $p[$i];
  92                 } elsif($p[$i] =~ /^\-I(.+)/) {
  93                         push @includedirs, $1;
  94                 }
  95         }
  96 }
  97
  98 sub printc {
  99         my $color = shift;
 100         printf $colstr, $colors->{$color};
 101         for my $x(@_) {
 102                 print $x;
 103         }
 104         printf $colstr, $colors->{"end"};
 105 }
 106
 107 my $ignore_errors = 0;
 108
 109 sub scandep_doit {
 110         my ($self, $na) = @_;
 111         my $is_header = ($na =~ /\.h$/);
 112         for my $i (@includedirs) {
 113                 my $delim = ($i eq "") ? "" : "/";
 114                 my $nf = $i . $delim . $na;
 115                 my $np = dirname($nf);
 116                 my $nb = basename($nf);
 117                 if(!defined($hdep{abs_path($nf)})) {
 118                         if(-e $nf) {
 119                                 scanfile($np, $nb);
 120                                 return;
 121                         }
 122                 } else {
 123                         return;
 124                 }
 125                 last unless $is_header;
 126         }
 127         printc("red", "failed to find dependency $na referenced from $self!\n");
 128         die unless $is_header || $ignore_errors;
 129 }
 130
 131 sub make_relative {
 132         my ($basepath, $relpath) = @_;
 133         #print "$basepath ::: $relpath\n";
 134         die "both path's must start with /" if(substr($basepath, 0, 1) ne "/" || substr($relpath, 0, 1) ne "/");
 135         $basepath .= "/" if($basepath !~ /\/$/ && -d $basepath);
 136         $relpath .= "/" if($relpath !~ /\/$/ && -d $relpath);
 137         my $l = 0;
 138         my $l2 = 0;
 139         my $sl = 0;
 140         my $min = min(length($basepath), length($relpath));
 141         $l++ while($l < $min && substr($basepath, $l, 1) eq substr($relpath, $l, 1));
 142         if($l != 0) {
 143                 $l-- if($l < $min && substr($basepath, $l, 1) eq "/");
 144                 $l-- while(substr($basepath, $l, 1) ne "/");
 145         }
 146         $l++ if substr($relpath, $l, 1) eq "/";
 147         my $res = substr($relpath, $l);
 148         $l2 = $l;
 149         while($l2 < length($basepath)) {
 150                 $sl++ if substr($basepath, $l2, 1) eq "/";
 151                 $l2++;
 152         }
 153         my $i;
 154         for ($i = 0; $i < $sl; $i++) {
 155                 $res = "../" . $res;
 156         }
 157         return $res;
 158 }
 159
 160 my $verbose = 0;
 161
 162 sub scandep {
 163         my ($self, $path, $tf) = @_;
 164         my $is_header = ($tf =~ /\.h$/);
 165         my $absolute = substr($tf, 0, 1) eq "/";
 166
 167         my $fullpath = abs_path($path) . "/" . $tf;
 168         print "scanning $fullpath...\n" if $verbose;
 169         # the stuff in the || () part is to pass headers which are in the CFLAGS include path
 170         # unmodified to scandep_doit
 171         my $nf = $absolute || ($is_header && $tf !~ /^\./ && ! -e $fullpath) ? $tf : $fullpath;
 172         printc("red", "[RcB] warning: $tf not found, continuing...\n"), return if !defined($nf);
 173
 174         if ($nf =~ /^\// && ! $is_header) {
 175                 $nf = make_relative($this_path, $nf);
 176         }
 177         die "problem processing $self, $path, $tf" if(!defined($nf));
 178         if($nf =~ /\*/) {
 179                 my @deps = glob($nf);
 180                 for my $d(@deps) {
 181                         scandep_doit($self, $d);
 182                 }
 183         } else {
 184                 scandep_doit($self, $nf);
 185         }
 186 }
 187
 188 my $link = "";
 189 my $rcb_cflags = "";
 190 my $forcerebuild = 0;
 191 my $step = 0;
 192 my $ignore_rcb = 0;
 193 my $mainfile = undef;
 194 my $debug_cflags = 0;
 195 my %hdrsubsts;
 196
 197 sub scanfile {
 198         my ($path, $file) = @_;
 199         my $fp;
 200         my $self = $path . "/" . $file;
 201         my $tf = "";
 202         my $skipinclude = 0;
 203
 204         printf "scanfile: %s\n", abs_path($self) if($verbose);
 205         $hdep{abs_path($self)} = 1;
 206         open($fp, "<", $self) or die "could not open file $self: $!";
 207         while(<$fp>) {
 208                 my $line = $_;
 209                 if ($line =~ /^\/\/RcB: (\w{3,7}) \"(.+?)\"/) {
 210                         my $command = $1;
 211                         my $arg = $2;
 212                         if($command eq "DEP") {
 213                                 next if $skipinclude;
 214                                 $tf = $arg;
 215                                 print "found RcB DEP $self -> $tf\n" if $verbose;
 216                                 scandep($self, $path, $tf);
 217                         } elsif ($command eq "LINK") {
 218                                 next if $skipinclude;
 219                                 print "found RcB LINK $self -> $arg\n" if $verbose;
 220                                 $link .= $arg . " ";
 221                         } elsif ($command eq "CFLAGS") {
 222                                 next if $skipinclude;
 223                                 print "found RcB CFLAGS $self -> $arg\n" if $verbose;
 224                                 $rcb_cflags .= " " . $arg;
 225                                 $cflags .= " " . $arg;
 226                         } elsif ($command eq "SKIPON") {
 227                                 $skipinclude++ if $cflags =~ /-D\Q$arg\E/;
 228                         } elsif ($command eq "SKIPOFF") {
 229                                 $skipinclude-- if $cflags =~ /-D\Q$arg\E/;
 230                         } elsif ($command eq "SKIPUON") {
 231                                 $skipinclude++ unless $cflags =~ /-D\Q$arg\E/;
 232                         } elsif ($command eq "SKIPUOFF") {
 233                                 $skipinclude-- unless $cflags =~ /-D\Q$arg\E/;
 234                         }
 235                 } elsif($line =~ /^\s*#\s*include\s+\"([\w\.\/_\-]+?)\"/) {
 236                         $tf = $1;
 237                         next if file_ext($tf) eq ".c";
 238                         if($skipinclude) {
 239                                 print "skipping $self -> $tf\n" if $verbose;
 240                                 next;
 241                         }
 242                         print "found header ref $self -> $tf\n" if $verbose;
 243                         scandep($self, $path, $tf);
 244                 } elsif($line =~ /^\s*#\s*include\s+<([\w\.\/_\-]+?)>/) {
 245                         $tf = $1;
 246                         for my $subst(keys %hdrsubsts) {
 247                                 if($tf =~ /\Q$subst\E/) {
 248                                         my $tfold = $tf;
 249                                         $tf =~ s/\Q$subst\E/$hdrsubsts{$subst}/;
 250                                         if($skipinclude) {
 251                                                 print "skipping $self -> $tf\n" if $verbose;
 252                                                 next;
 253                                         }
 254                                         print "applied header subst in $self: $tfold -> $tf\n" if $verbose;
 255                                         scandep($self, $path, $tf);
 256                                 }
 257                         }
 258                 } else {
 259
 260                         $tf = "x";
 261                 }
 262         }
 263         close $fp;
 264         push @adep, $self if $file =~ /[\w_-]+\.[c]{1}$/; #only add .c files to deps...
 265 }
 266
 267 argscan:
 268 my $arg1 = shift @ARGV or syntax;
 269 if($arg1 eq "--force") {
 270         $forcerebuild = 1;
 271         goto argscan;
 272 } elsif($arg1 eq "--verbose") {
 273         $verbose = 1;
 274         goto argscan;
 275 } elsif($arg1 eq "--new") {
 276         $ignore_rcb = 1;
 277         goto argscan;
 278 } elsif($arg1 eq "--step") {
 279         $step = 1;
 280         goto argscan;
 281 } elsif($arg1 eq "--ignore-errors") {
 282         $ignore_errors = 1;
 283         goto argscan;
 284 } elsif($arg1 eq "--debug") {
 285         $debug_cflags = 1;
 286         goto argscan;
 287 } elsif($arg1 =~ /--hdrsrc=(.*?):(.*)/) {
 288         $hdrsubsts{$1} = $2;
 289         goto argscan;
 290 } else {
 291         $mainfile = $arg1;
 292 }
 293
 294 $mainfile = shift unless defined($mainfile);
 295 syntax unless defined($mainfile);
 296 my $rind;
 297 $rind = rindex($mainfile,'/');
 298 if($rind >0) {
 299         chdir(substr($mainfile, 0, $rind));
 300         $mainfile = substr($mainfile, $rind+1);
 301 }
 302 $this_path = abs_path();
 303
 304 my $cc;
 305 if (defined($ENV{CC})) {
 306         $cc = $ENV{CC};
 307 } else {
 308         $cc = "cc";
 309         printc "blue", "[RcB] \$CC not set, defaulting to cc\n";
 310 }
 311
 312 process_include_dirs();
 313
 314 $cflags .= $debug_cflags ? " -O0 -g3" : "";
 315
 316 my $nm;
 317 if (defined($ENV{NM})) {
 318         $nm = $ENV{NM};
 319 } else {
 320         $nm = "nm";
 321         printc "blue", "[RcB] \$NM not set, defaulting to nm\n";
 322 }
 323
 324 sub compile {
 325         my ($cmdline) = @_;
 326         printc "magenta", "[CC] ", $cmdline, "\n";
 327         my $reslt = `$cmdline 2>&1`;
 328         if($!) {
 329                 printc "red", "ERROR ", $!, "\n";
 330                 exit 1;
 331         }
 332         print $reslt;
 333         return $reslt;
 334 }
 335
 336 $link = expandarr(@ARGV) . " ";
 337
 338 my $cnd = name_wo_ext($mainfile);
 339 my $cndo = $cnd . "o";
 340 my $bin = $cnd . "out";
 341
 342 my $cfgn = name_wo_ext($mainfile) . "rcb";
 343 my $haveconfig = (-e $cfgn);
 344 if($haveconfig && !$ignore_rcb) {
 345         printc "blue", "[RcB] config file $cfgn found. trying single compile.\n";
 346         @adep = `cat $cfgn | grep "^DEP " | cut -b 5-`;
 347         my @rcb_links = `cat $cfgn | grep "^LINK" | cut -b 6-`;
 348         my @rcb_cfgs = `cat $cfgn | grep "^CFLAGS" | cut -b 8-`;
 349         my $cs = expandarr(@adep);
 350         my $ls = expandarr(@rcb_links);
 351         my $cfs = expandarr(@rcb_cfgs);
 352         $link = $ls if (defined($ls) && $ls ne "");
 353         my $res = compile("$cc $cflags $cfs $cs $link -o $bin $ldflags");
 354         if($res =~ /undefined reference to/ || $res =~ /undefined symbol/) {
 355                 printc "red", "[RcB] undefined reference[s] found, switching to scan mode\n";
 356         } else {
 357                 if($?) {
 358                         printc "red", "[RcB] error. exiting.\n";
 359                 } else {
 360                         printc "green", "[RcB] success. $bin created.\n";
 361                 }
 362                 exit $?;
 363         }
 364 }
 365
 366 printc "blue",  "[RcB] scanning deps...";
 367
 368 scanfile dirname(abs_path($mainfile)), basename($mainfile);
 369
 370 printc "green",  "done\n";
 371
 372 my %obj;
 373 printc "blue",  "[RcB] compiling main file...\n";
 374 my $op = compile("$cc $cflags -c $mainfile -o $cndo");
 375 exit 1 if($op =~ /error:/g);
 376 $obj{$cndo} = 1;
 377 my %sym;
 378
 379 my $i = 0;
 380 my $success = 0;
 381 my $run = 0;
 382 my $relink = 1;
 383 my $rebuildflag = 0;
 384 my $objfail = 0;
 385
 386 my %glob_missym;
 387 my %missym;
 388 my %rebuilt;
 389 printc "blue",  "[RcB] resolving linker deps...\n";
 390 while(!$success) {
 391         my @opa;
 392         if($i + 1 >= @adep) { #last element of the array is the already build mainfile
 393                 $run++;
 394                 $i = 0;
 395         }
 396         if(!$i) {
 397                 %glob_missym = %missym, last unless $relink;
 398                 # trying to link
 399                 my %missym_old = %missym;
 400                 %missym = ();
 401                 my $ex = expandhash(\%obj);
 402                 printc "blue",  "[RcB] trying to link ...\n";
 403                 my $cmd = "$cc $cflags $ex $link -o $bin $ldflags";
 404                 printc "cyan", "[LD] ", $cmd, "\n";
 405                 @opa = `$cmd 2>&1`;
 406                 for(@opa) {
 407                         if(
 408                         /undefined reference to [\'\`\"]{1}([\w\._]+)[\'\`\"]{1}/ ||
 409                         /undefined symbol [\']{1}([\w\._]+)[\']{1}/
 410                         ) {
 411                                 my $temp = $1;
 412                                 print if $verbose;
 413                                 $missym{$temp} = 1;
 414                         } elsif(
 415                                 /([\/\w\._\-]+): file not recognized: File format not recognized/ ||
 416                                 /architecture of input file [\'\`\"]{1}([\/\w\._\-]+)[\'\`\"]{1} is incompatible with/ ||
 417                                 /fatal error: ([\/\w\._\-]+): unsupported ELF machine number/ ||
 418                                 /ld: ([\/\w\._\-]+): Relocations in generic ELF/
 419                         ) {
 420                                 $cnd = $1;
 421                                 $i = delete $obj{$cnd};
 422                                 printc "red", "[RcB] incompatible object file $cnd, rebuilding...\n";
 423                                 print;
 424                                 $cnd =~ s/\.o/\.c/;
 425                                 $rebuildflag = 1;
 426                                 $objfail = 1;
 427                                 %missym = %missym_old;
 428                                 goto rebuild;
 429                         } elsif(
 430                         /collect2: ld returned 1 exit status/ ||
 431                         /collect2: error: ld returned 1 exit status/ ||
 432                         /error: linker command failed with exit code 1/ ||
 433                         /In function [\'\`\"]{1}[\w_]+[\'\`\"]{1}:/ ||
 434                         /more undefined references to/
 435                         ) {
 436                         } else {
 437                                 printc "red", "[RcB] Warning: unexpected linker output!\n";
 438                                 print;
 439                         }
 440                 }
 441                 if(!scalar(keys %missym)) {
 442                         for(@opa) {print;}
 443                         $success = 1;
 444                         last;
 445                 }
 446                 $relink = 0;
 447         }
 448         $cnd = $adep[$i];
 449         goto skip unless defined $cnd;
 450         $rebuildflag = 0;
 451         rebuild:
 452         chomp($cnd);
 453         $cndo = name_wo_ext($cnd) . "o";
 454         if(($forcerebuild || $rebuildflag || ! -e $cndo) && !defined($rebuilt{$cndo})) {
 455                 my $op = compile("$cc $cflags -c $cnd -o $cndo");
 456                 if($op =~ /error:/) {
 457                         exit 1 unless($ignore_errors);
 458                 } else {
 459                         $rebuilt{$cndo} = 1;
 460                 }
 461         }
 462         @opa = `$nm -g $cndo 2>&1`;
 463         my %symhash;
 464         my $matched = 0;
 465         for(@opa) {
 466                 if(/[\da-fA-F]{8,16}\s+[TWRBCD]{1}\s+([\w_]+)/) {
 467                         my $symname = $1;
 468                         $symhash{$symname} = 1;
 469                         $matched = 1;
 470                 } elsif (/File format not recognized/) {
 471                         printc "red",  "[RcB] nm doesn't recognize the format of $cndo, rebuilding...\n";
 472                         $rebuildflag = 1;
 473                         goto rebuild;
 474                 }
 475         }
 476         if($matched){
 477                 $sym{$cndo} = \%symhash;
 478                 my $good = 0;
 479                 for(keys %missym) {
 480                         if(defined($symhash{$_})) {
 481                                 $obj{$cndo} = $i;
 482                                 $adep[$i] = undef;
 483                                 $relink = 1;
 484                                 if($objfail || $step) {
 485                                         $objfail = 0;
 486                                         $i = -1;
 487                                         printc "red", "[RcB] adding $cndo to the bunch...\n" if $step;
 488                                 }
 489                                 last;
 490                         }
 491                 }
 492         }
 493         skip:
 494         $i++;
 495 }
 496
 497 if(!$success) {
 498         printc "red", "[RcB] failed to resolve the following symbols, check your DEP tags\n";
 499         for(keys %glob_missym) {
 500                 print "$_\n";
 501         }
 502 } else {
 503         printc "green", "[RcB] success. $bin created.\n";
 504         printc "blue", "saving required dependencies to $cfgn\n";
 505         my $fh;
 506         open($fh, ">", $cfgn);
 507         for(keys %obj) {
 508                 print { $fh } "DEP ", name_wo_ext($_), "c\n";
 509         }
 510         print { $fh } "LINK ", $link, "\n" if($link ne "");
 511         print { $fh } "CFLAGS ", $rcb_cflags, "\n" if ($rcb_cflags ne "");
 512         close($fh);
 513 }