src/mk_supernovae.pl

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