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