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 = abs_path();
  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
 161 sub scandep {
 162         my ($self, $path, $tf) = @_;
 163         my $is_header = ($tf =~ /\.h$/);
 164         my $absolute = substr($tf, 0, 1) eq "/";
 165
 166         my $fullpath = abs_path($path) . "/" . $tf;
 167         # the stuff in the || () part is to pass headers which are in the CFLAGS include path
 168         # unmodified to scandep_doit
 169         my $nf = $absolute || ($is_header && $tf !~ /^\./ && ! -e $fullpath) ? $tf : $fullpath;
 170         printc("red", "[RcB] warning: $tf not found, continuing...\n"), return if !defined($nf);
 171
 172
 173         if ($nf =~ /^\// && ! $is_header) {
 174                 $nf = make_relative($this_path, $nf);
 175         }
 176         die "problem processing $self, $path, $tf" if(!defined($nf));
 177         if($nf =~ /\*/) {
 178                 my @deps = glob($nf);
 179                 for my $d(@deps) {
 180                         scandep_doit($self, $d);
 181                 }
 182         } else {
 183                 scandep_doit($self, $nf);
 184         }
 185 }
 186
 187 my $link = "";
 188 my $forcerebuild = 0;
 189 my $verbose = 0;
 190 my $step = 0;
 191 my $ignore_rcb = 0;
 192 my $mainfile = undef;
 193 my $debug_cflags = 0;
 194 my %hdrsubsts;
 195
 196 sub scanfile {
 197         my ($path, $file) = @_;
 198         my $fp;
 199         my $self = $path . "/" . $file;
 200         my $tf = "";
 201         my $skipinclude = 0;
 202
 203         $hdep{abs_path($self)} = 1;
 204         open($fp, "<", $self) or die "could not open file $self: $!";
 205         while(<$fp>) {
 206                 my $line = $_;
 207                 if ($line =~ /^\/\/RcB: (\w{3,7}) \"(.+?)\"/) {
 208                         my $command = $1;
 209                         my $arg = $2;
 210                         if($command eq "DEP") {
 211                                 next if $skipinclude;
 212                                 $tf = $arg;
 213                                 print "found RcB DEP $self -> $tf\n" if $verbose;
 214                                 scandep($self, $path, $tf);
 215                         } elsif ($command eq "LINK") {
 216                                 next if $skipinclude;
 217                                 print "found RcB LINK $self -> $arg\n" if $verbose;
 218                                 $link .= $arg . " ";
 219                         } elsif ($command eq "SKIPON") {
 220                                 $skipinclude++ if $cflags =~ /-D\Q$arg\E/;
 221                         } elsif ($command eq "SKIPOFF") {
 222                                 $skipinclude-- if $cflags =~ /-D\Q$arg\E/;
 223                         } elsif ($command eq "SKIPUON") {
 224                                 $skipinclude++ unless $cflags =~ /-D\Q$arg\E/;
 225                         } elsif ($command eq "SKIPUOFF") {
 226                                 $skipinclude-- unless $cflags =~ /-D\Q$arg\E/;
 227                         }
 228                 } elsif($line =~ /^\s*#\s*include\s+\"([\w\.\/_\-]+?)\"/) {
 229                         $tf = $1;
 230                         next if file_ext($tf) eq ".c";
 231                         if($skipinclude) {
 232                                 print "skipping $self -> $tf\n" if $verbose;
 233                                 next;
 234                         }
 235                         print "found header ref $self -> $tf\n" if $verbose;
 236                         scandep($self, $path, $tf);
 237                 } elsif($line =~ /^\s*#\s*include\s+<([\w\.\/_\-]+?)>/) {
 238                         $tf = $1;
 239                         for my $subst(keys %hdrsubsts) {
 240                                 if($tf =~ /\Q$subst\E/) {
 241                                         my $tfold = $tf;
 242                                         $tf =~ s/\Q$subst\E/$hdrsubsts{$subst}/;
 243                                         if($skipinclude) {
 244                                                 print "skipping $self -> $tf\n" if $verbose;
 245                                                 next;
 246                                         }
 247                                         print "applied header subst in $self: $tfold -> $tf\n" if $verbose;
 248                                         scandep($self, $path, $tf);
 249                                 }
 250                         }
 251                 } else {
 252
 253                         $tf = "x";
 254                 }
 255         }
 256         close $fp;
 257         push @adep, $self if $file =~ /[\w_-]+\.[c]{1}$/; #only add .c files to deps...
 258 }
 259
 260 argscan:
 261 my $arg1 = shift @ARGV or syntax;
 262 if($arg1 eq "--force") {
 263         $forcerebuild = 1;
 264         goto argscan;
 265 } elsif($arg1 eq "--verbose") {
 266         $verbose = 1;
 267         goto argscan;
 268 } elsif($arg1 eq "--new") {
 269         $ignore_rcb = 1;
 270         goto argscan;
 271 } elsif($arg1 eq "--step") {
 272         $step = 1;
 273         goto argscan;
 274 } elsif($arg1 eq "--ignore-errors") {
 275         $ignore_errors = 1;
 276         goto argscan;
 277 } elsif($arg1 eq "--debug") {
 278         $debug_cflags = 1;
 279         goto argscan;
 280 } elsif($arg1 =~ /--hdrsrc=(.*?):(.*)/) {
 281         $hdrsubsts{$1} = $2;
 282         goto argscan;
 283 } else {
 284         $mainfile = $arg1;
 285 }
 286
 287 $mainfile = shift unless defined($mainfile);
 288 syntax unless defined($mainfile);
 289
 290 my $cc;
 291 if (defined($ENV{CC})) {
 292         $cc = $ENV{CC};
 293 } else {
 294         $cc = "cc";
 295         printc "blue", "[RcB] \$CC not set, defaulting to cc\n";
 296 }
 297
 298 process_include_dirs();
 299
 300 $cflags .= $debug_cflags ? " -O0 -g3" : "";
 301
 302 my $nm;
 303 if (defined($ENV{NM})) {
 304         $nm = $ENV{NM};
 305 } else {
 306         $nm = "nm";
 307         printc "blue", "[RcB] \$NM not set, defaulting to nm\n";
 308 }
 309
 310 sub compile {
 311         my ($cmdline) = @_;
 312         printc "magenta", "[CC] ", $cmdline, "\n";
 313         my $reslt = `$cmdline 2>&1`;
 314         if($!) {
 315                 printc "red", "ERROR ", $!, "\n";
 316                 exit 1;
 317         }
 318         print $reslt;
 319         return $reslt;
 320 }
 321
 322 $link = expandarr(@ARGV) . " ";
 323
 324 my $cnd = name_wo_ext($mainfile);
 325 my $cndo = $cnd . "o";
 326 my $bin = $cnd . "out";
 327
 328 my $cfgn = name_wo_ext($mainfile) . "rcb";
 329 my $haveconfig = (-e $cfgn);
 330 if($haveconfig && !$ignore_rcb) {
 331         printc "blue", "[RcB] config file $cfgn found. trying single compile.\n";
 332         @adep = `cat $cfgn | grep "^DEP " | cut -b 5-`;
 333         my @rcb_links = `cat $cfgn | grep "^LINK" | cut -b 6-`;
 334         my $cs = expandarr(@adep);
 335         my $ls = expandarr(@rcb_links);
 336         $link = $ls if (defined($ls) && $ls ne "");
 337         my $res = compile("$cc $cflags $cs $link -o $bin $ldflags");
 338         if($res =~ /undefined reference to/) {
 339                 printc "red", "[RcB] undefined reference[s] found, switching to scan mode\n";
 340         } else {
 341                 if($?) {
 342                         printc "red", "[RcB] error. exiting.\n";
 343                 } else {
 344                         printc "green", "[RcB] success. $bin created.\n";
 345                 }
 346                 exit $?;
 347         }
 348 }
 349
 350 printc "blue",  "[RcB] scanning deps...";
 351
 352 scanfile dirname(abs_path($mainfile)), basename($mainfile);
 353
 354 printc "green",  "done\n";
 355
 356 my %obj;
 357 printc "blue",  "[RcB] compiling main file...\n";
 358 my $op = compile("$cc $cflags -c $mainfile -o $cndo");
 359 exit 1 if($op =~ /error:/g);
 360 $obj{$cndo} = 1;
 361 my %sym;
 362
 363 my $i = 0;
 364 my $success = 0;
 365 my $run = 0;
 366 my $relink = 1;
 367 my $rebuildflag = 0;
 368 my $objfail = 0;
 369
 370 my %glob_missym;
 371 my %missym;
 372 my %rebuilt;
 373 printc "blue",  "[RcB] resolving linker deps...\n";
 374 while(!$success) {
 375         my @opa;
 376         if($i + 1 >= @adep) { #last element of the array is the already build mainfile
 377                 $run++;
 378                 $i = 0;
 379         }
 380         if(!$i) {
 381                 %glob_missym = %missym, last unless $relink;
 382                 # trying to link
 383                 my %missym_old = %missym;
 384                 %missym = ();
 385                 my $ex = expandhash(\%obj);
 386                 printc "blue",  "[RcB] trying to link ...\n";
 387                 my $cmd = "$cc $cflags $ex $link -o $bin $ldflags";
 388                 printc "cyan", "[LD] ", $cmd, "\n";
 389                 @opa = `$cmd 2>&1`;
 390                 for(@opa) {
 391                         if(/undefined reference to [\'\`\"]{1}([\w\._]+)[\'\`\"]{1}/) {
 392                                 my $temp = $1;
 393                                 print if $verbose;
 394                                 $missym{$temp} = 1;
 395                         } elsif(
 396                                 /([\/\w\._\-]+): file not recognized: File format not recognized/ ||
 397                                 /architecture of input file [\'\`\"]{1}([\/\w\._\-]+)[\'\`\"]{1} is incompatible with/ ||
 398                                 /fatal error: ([\/\w\._\-]+): unsupported ELF machine number/ ||
 399                                 /ld: ([\/\w\._\-]+): Relocations in generic ELF/
 400                         ) {
 401                                 $cnd = $1;
 402                                 $i = delete $obj{$cnd};
 403                                 printc "red", "[RcB] incompatible object file $cnd, rebuilding...\n";
 404                                 print;
 405                                 $cnd =~ s/\.o/\.c/;
 406                                 $rebuildflag = 1;
 407                                 $objfail = 1;
 408                                 %missym = %missym_old;
 409                                 goto rebuild;
 410                         } elsif(
 411                         /collect2: ld returned 1 exit status/ ||
 412                         /collect2: error: ld returned 1 exit status/ ||
 413                         /In function [\'\`\"]{1}[\w_]+[\'\`\"]{1}:/ ||
 414                         /more undefined references to/
 415                         ) {
 416                         } else {
 417                                 printc "red", "[RcB] Warning: unexpected linker output!\n";
 418                         }
 419                 }
 420                 if(!scalar(keys %missym)) {
 421                         for(@opa) {print;}
 422                         $success = 1;
 423                         last;
 424                 }
 425                 $relink = 0;
 426         }
 427         $cnd = $adep[$i];
 428         goto skip unless defined $cnd;
 429         $rebuildflag = 0;
 430         rebuild:
 431         chomp($cnd);
 432         $cndo = name_wo_ext($cnd) . "o";
 433         if(($forcerebuild || $rebuildflag || ! -e $cndo) && !defined($rebuilt{$cndo})) {
 434                 my $op = compile("$cc $cflags -c $cnd -o $cndo");
 435                 if($op =~ /error:/) {
 436                         exit 1 unless($ignore_errors);
 437                 } else {
 438                         $rebuilt{$cndo} = 1;
 439                 }
 440         }
 441         @opa = `$nm -g $cndo 2>&1`;
 442         my %symhash;
 443         my $matched = 0;
 444         for(@opa) {
 445                 if(/[\da-fA-F]{8,16}\s+[TWRBCD]{1}\s+([\w_]+)/) {
 446                         my $symname = $1;
 447                         $symhash{$symname} = 1;
 448                         $matched = 1;
 449                 } elsif (/File format not recognized/) {
 450                         printc "red",  "[RcB] nm doesn't recognize the format of $cndo, rebuilding...\n";
 451                         $rebuildflag = 1;
 452                         goto rebuild;
 453                 }
 454         }
 455         if($matched){
 456                 $sym{$cndo} = \%symhash;
 457                 my $good = 0;
 458                 for(keys %missym) {
 459                         if(defined($symhash{$_})) {
 460                                 $obj{$cndo} = $i;
 461                                 $adep[$i] = undef;
 462                                 $relink = 1;
 463                                 if($objfail || $step) {
 464                                         $objfail = 0;
 465                                         $i = -1;
 466                                         printc "red", "[RcB] adding $cndo to the bunch...\n" if $step;
 467                                 }
 468                                 last;
 469                         }
 470                 }
 471         }
 472         skip:
 473         $i++;
 474 }
 475
 476 if(!$success) {
 477         printc "red", "[RcB] failed to resolve the following symbols, check your DEP tags\n";
 478         for(keys %glob_missym) {
 479                 print "$_\n";
 480         }
 481 } else {
 482         printc "green", "[RcB] success. $bin created.\n";
 483         printc "blue", "saving required dependencies to $cfgn\n";
 484         my $fh;
 485         open($fh, ">", $cfgn);
 486         for(keys %obj) {
 487                 print { $fh } "DEP ", name_wo_ext($_), "c\n";
 488         }
 489         print { $fh } "LINK ", $link, "\n" if($link);
 490         close($fh);
 491 }