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