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