src/mk_supernovae.pl

   1 #! /usr/bin/perl
   2
   3 use strict;
   4 use Getopt::Long qw(GetOptions);
   5
   6 #open TMP,">mk_supernovae.pl.args";
   7 #map {print TMP "$_ "} @ARGV;
   8 #close TMP;
   9
  10 sub usage($) {
  11     my $ret;
  12     print "USAGE: mk_supernovae.pl [--fragile=file]* --out=file file1 file2*\n";
  13     print "  --help: show this message\n";
  14     print "  --fragile=file: specify that file is fragile and shouldn't be supernovaed\n";
  15     print "  --out=file: specify the name of the output file\n";
  16     print "elements may be separated by semi-columns (;) instead of spaces, too\n";
  17     exit $ret;
  18 }
  19
  20 my @fragile_files=undef;
  21 my $outfile=undef;
  22 my $help;
  23
  24 Getopt::Long::config('permute','no_getopt_compat', 'no_auto_abbrev');
  25 GetOptions(
  26     'help|h'                => \$help,
  27
  28     'fragile=s' =>\@fragile_files,
  29     'out=s'     =>\$outfile) or usage(1);
  30
  31 @fragile_files = split(/;/,join(';',@fragile_files));
  32 @fragile_files = split(/ /,join(' ',@fragile_files));
  33
  34 usage(0) if (defined($help));
  35 unless(defined($outfile)) {
  36     print "ERROR: No outfile defined.\n";
  37     usage(1);
  38 }
  39
  40 #print "mk_supernovae: generate $outfile\n";
  41
  42 open OUT, ">$outfile" or die "ERROR: cannot open $outfile: $!\n";
  43
  44 print OUT <<EOF
  45 #define SUPERNOVAE_MODE 1
  46 #ifndef _GNU_SOURCE
  47 #  define _GNU_SOURCE     /* for getline() with older libc */
  48 #endif
  49 #ifndef _SVID_SOURCE
  50 #  define _SVID_SOURCE    /* strdup() */
  51 #endif
  52 #ifndef _ISOC99_SOURCE
  53 #  define _ISOC99_SOURCE  /* isfinite() */
  54 #endif
  55 #ifndef _ISO_C99_SOURCE
  56 #  define _ISO_C99_SOURCE /* isfinite() */
  57 #endif
  58 #include <ctype.h>
  59 #include "portable.h"
  60 #include "xbt.h"
  61
  62 EOF
  63   ;
  64
  65 sub readfile($) {
  66     my $filename=shift;
  67     open IN,"$filename" || die "ERROR: cannot read $filename: $!\n";
  68     my $res;
  69     while (<IN>) {
  70         $res .= $_;
  71     }
  72     close IN;
  73     return $res;
  74 }
  75
  76
  77 my %fragile;
  78 map {$fragile{$_}=1} @fragile_files;
  79 my @args = split(/;/,join(';',@ARGV));
  80 @args = split(/ /,join(' ',@args));
  81 my $nbfile=0;
  82 foreach my $file (@args) {
  83     if ($fragile{$file}) {
  84         print "mk_supernovae: $file is fragile, skip it\n";
  85         next;
  86     }
  87 #       print "mk_supernovae: process $file\n";
  88     $nbfile++;
  89
  90     my $needundef=1;
  91     print OUT "/* file $file */\n";
  92     if ($file eq "xbt/log.c") {
  93         print OUT "  #define _simgrid_log_category__default &_simgrid_log_category__log\n";
  94     } else {
  95         my $ctn = readfile($file);
  96         if ($ctn =~ m/XBT_LOG_[^ ]*?DEFAULT_[^ ]*?CATEGORY/s) {
  97             my $default=$ctn;
  98             $default =~ s/.*XBT_LOG_[^ ]*?DEFAULT_[^ ]*?CATEGORY[^(]*\(([^,)]*).*$/$1/s;
  99             print OUT "  #define _simgrid_log_category__default &_simgrid_log_category__$default\n";
 100         } else {
 101             print OUT "  /* no default category in file $file */\n";
 102             $needundef = 0;
 103         }
 104     }
 105     print OUT "  #include \"$file\"\n";
 106     print OUT "  #undef _simgrid_log_category__default\n" if $needundef;
 107     print OUT "\n";
 108 }
 109 close OUT;
 110 print "mk_supernovae: $outfile contains $nbfile files inlined\n";