home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 3 / AACD03.BIN / AACD / Programming / sofa / archive / SmallEiffel.lha / SmallEiffel / contrib / edb / add-line-directive next >
Encoding:
Text File  |  1999-06-05  |  8.9 KB  |  421 lines
  1. #!/usr/local/bin/perl
  2. #----------------------------------------------------------------------------- 
  3. #  add-line-directive
  4. #
  5. #     add c line directive 
  6. #          to 
  7. #     Small Eiffel generated C-code 
  8. #     (For 0.79)
  9. #----------------------------------------------------------------------------- 
  10. #    History
  11. #     Vers     Date        Coder        Description
  12. #     00-00    May 15,1997    Masato Mogaki    first version
  13. #     00-01    Aug 28,1997    Masato Mogaki    for -0.85
  14. #     00-02    Jul 09,1998    Masato Mogaki    for -0.80
  15. #     00-03    Sep 08,1998    Masato Mogaki    for -0.79
  16. #----------------------------------------------------------------------------- 
  17. # 
  18. @c = ();
  19. @h = ();
  20. $with_line_directive = 1;
  21.  
  22.  
  23. # collect source file names and options.
  24.  
  25. for ($i=0; $i<=$#ARGV;$i++) {
  26.     $s = $ARGV[$i];
  27.     if($s =~ /\.c$/) {
  28.     push(@c,$s);
  29.     } elsif($s =~ /\.h$/) {
  30.     push(@h,$s);
  31.     } elsif($s =~ /^-n$/) {
  32.     $with_line_directive = 0;
  33.     } elsif($s =~ /^c$/) {
  34.     $with_gc = 1;
  35.     }
  36. }
  37.  
  38.  
  39. #find eiffel souce file name from the lines like  p[123]="./test.e";
  40.  
  41. foreach $s (@c) {
  42.     open(IN,$s);
  43.     $se_init = 0;
  44.     while(<IN>) {
  45.     if($se_init) {
  46.         if(/^p\[(\d+)\]="(.*)";/) {
  47.         $src_name[$1] = $2;
  48.         }elsif(/^p\[(\d+)\]=p\[(\d+)\];/) {
  49.         $src_name[$1] = $src_name[$2];
  50.         }elsif(/^g\[(\d+)\]="(.*)";/) {
  51.         $se_init = -1;
  52.         }
  53.     } elsif(/^void initialize_eiffel_runtime/) {
  54.         $se_init = 1;
  55.     }
  56.     if($se_init<0) { last;  }
  57.     }
  58.     close(IN);
  59.     if($se_init<0) { last; }
  60. }
  61.  
  62. # convert header file.
  63. #   + change prototype of routines
  64. #   + change macro
  65.  
  66. foreach $s (@h) {
  67.     $o = "B/$s";
  68.     $t = "C/$s";
  69.     if(system("cmp -s $s $o")) { # $s is changed 
  70.     print STDERR "$s is changed\n";
  71.     rename($s,$o);
  72.     open(IN,$o);
  73.     open(OUT,">$t");
  74.     &convert_h;
  75.     } else {
  76.     unlink($s);
  77.     }
  78. }
  79.  
  80. # convert c source.
  81. #  remove runtime trace code
  82. #  rename routine arguments
  83. #  add line directive #line NN "source.e"
  84.  
  85. foreach $s (@c) {
  86.     $o = "B/$s";
  87.     $t = "C/$s";
  88.     if(system("cmp -s $s $o")) { # $s is changed 
  89.     print STDERR "$s is changed\n";
  90.     rename($s,$o);
  91.     open(IN,$o);
  92.     open(OUT,">$t");
  93.     &convert_c;
  94.     } else {
  95.     unlink($s);
  96.     }
  97. }
  98.  
  99. #---------------------------------------------------------------
  100. sub convert_h {
  101.     while(<IN>) {
  102.       s/(r\d+\w+\()se_dump_stack\*caller,?/$1/;
  103.       s/(X\d+\w+\()se_dump_stack\*caller,int l,int c,int f, /$1/;
  104.       print OUT $_;
  105.     }
  106.     close IN;
  107.  
  108.     print OUT "#define ci(_d,_o,_l,_c,_f) (_o)\n";
  109.     print OUT "#define error0(_m) fprintf(stderr,\"%s\\n\",_m),abort()\n";
  110.     print OUT "#define error1(_m,_l,_c,_f) error0(_m)\n";
  111.     if ($with_gc) {
  112.       print OUT "#include <gc.h>\n";
  113.       print OUT "#define malloc(n) GC_malloc(n)\n";
  114.       print OUT "#define calloc(m,n) GC_malloc((m)*(n))\n";
  115.       print OUT "#define realloc(p,n) GC_realloc((p),(n))\n";
  116.       print OUT "#define free(p) GC_free(p)\n";
  117.       print OUT "#define gc_is_off GC_dont_gc\n";
  118.       print OUT "#define gc_start() GC_gcollect()\n";
  119.     }
  120.     close OUT;
  121. }
  122.  
  123.  
  124. sub convert_c {
  125.     my($in_routine);
  126.     $in_routine = 0;
  127.     $o_count = 0;
  128.     while(<IN>) {
  129.     chomp;
  130.     if($in_routine == 0) {
  131.         if(/^(T0\*|T\d+|int|char|void|void\*) r(\d+)(\w+)\(.*\)\{$/) {
  132.         s/se_dump_stack\*caller,?//;
  133.         @body = ($_);
  134.         @lvars = ();
  135.         $in_routine = 1;
  136.         $e_fno = 0;
  137.         $e_lno = 0;
  138.         $e_local = "";
  139.         } elsif (/^(T0\*|T\d+|int|char|void|void\*) (X\d+\w+\()se_dump_stack\*caller,int l,int c,int f, /) {
  140.         s//$1 $2/;
  141.         print OUT "$_\n";
  142.         $o_count++;
  143.         $in_routine = 10;
  144.         } elsif(/^void error[01]/) {
  145.         while(<IN>) {
  146.             if(/^}/) {
  147.             last;
  148.             }
  149.         }
  150.         } elsif(/^T0\* ci/) {
  151.         while(<IN>) {
  152.             if(/^}/) {
  153.             last;
  154.             }
  155.         }
  156.         } else {
  157.             if(!/^ms\d+/) {
  158.             s/exit\([^0()]*\)/abort()/g;
  159.             s/\(&ds,?/\(/g;
  160.             s/se_trace\(\d+,\d+,\d+\);//;
  161.         }
  162.         print OUT "$_\n";
  163.         $o_count++;
  164.         }
  165.     } elsif ($in_routine == 1) {
  166.         if(/^se_dump_stack ds;/) {
  167.         if($e_local) {
  168.             $e_local .= "\n";
  169.             push(@body,$e_local);
  170.         }
  171.         $in_routine = 2;
  172.         } elsif(/^void\*\*locals\[(\d+)\];/) {
  173.         $n_local = $1;
  174.         } else {
  175.         $e_local .= $_;
  176.         }
  177.     } elsif ($in_routine == 2) {
  178.         if(/^ds\.(\w+)=(.*);/) {
  179.         my($attr,$val);
  180.         $attr = $1;
  181.         $val  = $2;
  182.         if ($attr eq "l") {
  183.             $e_lno = $val;
  184.         } elsif($attr eq "f") {
  185.             $e_fno = $val;
  186.             if($with_line_directive) {
  187.             $r_post = "<$e_fno,$e_lno>\n";
  188.             }
  189.             unshift(@body,$r_post);
  190.         }
  191.         } elsif(/^locals\[(\d+)\]=\(void\*\*\)\&(\w+);/) {
  192.         $lvars[$1] = $2;
  193.         } elsif(/^se_dst=\&ds;/) {
  194.         $in_routine = 3;
  195.         }
  196.     } elsif ($in_routine < 10) {
  197.         if(/^if\(!se_af_rlr\)\{se_af_rlr=1/) {
  198.         $in_routine++;
  199.         } elsif(/^\{static int se_af=1/) {
  200.         $in_routine++;
  201.         } elsif(/^if\(se_af\)\{/) {
  202.         $in_routine++;
  203.         } elsif($in_routine>3 && /^\}/) {
  204.         --$in_routine;
  205.         } elsif(/^se_frame_descriptor f\d+\w+=\{\"(.+ of .+)",(\d+),(\d+),\"(.*)\",\d+\};/) {
  206.         output_routine($1,$2,$3,$4);
  207.         print OUT "$_\n";
  208.                 if($with_line_directive){
  209.             print OUT "#line $o_count \"$t\"\n";
  210.             $o_count++;
  211.                 }
  212.         $in_routine = 0;
  213.         } elsif(/se_af/) {
  214.         $_ = "";
  215.         # Ignore
  216.         } else {
  217.         while(/se_trace\(\&ds,(\d+),(\d+),(\d+)\)[,;]/) {
  218.             s//<$3:$1>/;
  219.         }
  220.         while(/(X\d+\w+\()\&ds,(\d+),(\d+),(\d+),/) {
  221.             s//<$4:$2>$1/;
  222.         }
  223.         while(/ci\(\d+,([^,]+),(\d+),(\d+),(\d+)\)/) {
  224.             s//<$4:$2>$1/;
  225.         }
  226.         s/\/\*\w+\*\///g;
  227.         s/se_dst=caller;//;
  228.         s/\(&ds,?/\(/g;
  229.         if(/\S/) {
  230.             if($with_line_directive) {
  231.             s/(.+?)(<\d+:\d+>)/$2$1/;
  232.             $_ = &update_fl($_);
  233.             } else {
  234.             s/<\d+:\d+>//g;
  235.             }
  236.             push(@body,$_);
  237.         }
  238.         }
  239.     } elsif($in_routine == 10) {
  240.         if (/^se_dst=caller;$/) {
  241.         $in_routine = 0;
  242.         } elsif(/se_dump_stack ds=\*caller;/) {
  243.         # skip
  244.         } elsif(/^\{int id=vc\(C,l,c,f\)->id;/) {
  245.         print OUT "{int id=((T0*)C)->id;\n";
  246.         $o_count++;
  247.         } else {
  248.         s/\(&ds,?/\(/g;
  249.         print OUT "$_\n";
  250.         $o_count++;
  251.         }
  252.     }
  253.     }
  254.  
  255.     close(OUT);
  256.     close(IN);
  257. }
  258.  
  259. sub update_fl {
  260.     my($s) = @_;
  261.     my($fl);
  262.     while($s =~ /<(\d+):(\d+)>/) {
  263.     if($e_fno != $1 || $e_lno != $2) {
  264.         $fl = "\n<$1,$2>\n";
  265.         $e_fno = $1;
  266.         $e_lno = $2;
  267.     } else {
  268.         $fl = "";
  269.     }
  270.     $s =~ s//$fl/;
  271.     }
  272.     return $s;
  273. }
  274.  
  275. # print out
  276.  
  277. sub output_routine {
  278.     my($rout, $use_current, $nlocal, $l_desc) = @_;
  279.     %name_map = ();
  280.     if ($use_current) {
  281.       $l_desc =~ s/^%\w+%//;
  282.     }
  283.     $l_desc =~ s/%[A-Z]\d+//g;
  284.     my(@l_descs) = split(/%/,$l_desc);
  285.     $i = 0;
  286.     foreach $l (@l_descs) {
  287.       $name_map{$lvars[$i]} = "_".$l;
  288.       $i++;
  289.     }
  290.     @body = &split_lines(@body);
  291.     @body = &merge_lines(@body);
  292.     foreach $l (@body) {
  293.     $l =~ s/<\d+,\d+>//g;
  294.     $l = &replace_name($l);
  295.     print OUT $l,"\n";
  296.     $o_count++;
  297.     }
  298. }
  299.  
  300. # replace name of local variables.
  301. sub replace_name {
  302.     my ($line) = @_;
  303.     my($n,$v);
  304.  
  305.     if(!/^\#/) {
  306.     foreach $v (keys %name_map) {
  307.         $n = $name_map{$v};
  308.         $line =~ s/\b$v\b/$n/g;
  309.     }
  310.     } 
  311.     return $line;
  312. }
  313.  
  314. # split embedded line number
  315. sub split_lines {
  316.     my @lines = @_;
  317.     my (@new_lines,@ls,$l,$s);
  318.     @new_lines = ();
  319.     foreach $l (@lines) {
  320.     @ls = split(/\n/,$l);
  321.     foreach $s (@ls) {
  322.         if($s =~ /\S/) {
  323.         push(@new_lines,$s);
  324.         }
  325.     }
  326.     }
  327.     return (@new_lines);
  328. }
  329.  
  330. #-- Merge inline code to one line.
  331. sub merge_lines {
  332.     my @lines = @_;
  333.     my (@merged,@wl,$l,$ll,$last_lno,$lno);
  334.     @merged = ();
  335.     @wl = ();
  336.     $last_lno = 0;
  337.     $last_fno = -1;
  338.     while (@lines) {
  339.     $l = shift(@lines);
  340.     if($l =~ /<(\d+),(\d+)>/) {
  341.         @merged = (@merged,@wl);
  342.         $fno = $1;
  343.         $lno = $2;
  344.         $last_lno += $#wl+1;
  345.         @wl = ();
  346.  
  347.         if($fno != $last_fno || $lno < $last_lno) {
  348.         push(@merged,&source_line_directive($fno,$lno));
  349.         $last_fno = $fno;
  350.         $last_lno = $lno;
  351.         } elsif($lno > $last_lno) {
  352.         while($lno > $last_lno) {
  353.             push(@merged,"");
  354.             $last_lno++;
  355.         }
  356.         }
  357.     } elsif($l =~ /\S/) {
  358.         # Creation call (gc)
  359.         if($l =~ /^\{T\d+\*n=new\d+\(\);$/) {
  360.         $ll = '';
  361.         while($l && $l !~ /\}$/) {
  362.             $ll .= $l;
  363.             $l = shift(@lines);
  364.         }
  365.         $l = $ll . $l;
  366.  
  367.         # Creation call (-no_gc)
  368.         } elsif($l =~ /^\{T\d+\*n=malloc\(sizeof\(\*n\)\);$/) {
  369.         $ll = '';
  370.         while($l && $l !~ /\}$/) {
  371.             $ll .= $l;
  372.             $l = shift(@lines);
  373.         }
  374.         $l = $ll . $l;
  375.         
  376.         # Reverse assignment call to attribute
  377.         } elsif($l =~ /^if.NULL!=.C->_\w+..switch...T0..C->_\w+.->id. \{$/) {
  378.         $ll = pop(@wl);
  379.         do {
  380.             $ll .= $l;
  381.             $l = shift(@lines);
  382.         } until(!$l || ($l =~ /^\w+=NULL;$/));
  383.         $ll .= $l;
  384.         $l = $ll;
  385.  
  386.         # Reverse assignment call to local variable
  387.         } elsif($l =~ /^if.NULL!=.\w+..switch...T0\*.\w+.->id. \{$/) {
  388.         $ll = pop(@wl);
  389.         do {
  390.             $ll .= $l;
  391.             $l = shift(@lines);
  392.         } until(!$l || ($l =~ /^\w+=NULL;$/));
  393.         $ll .= $l;
  394.         $l = $ll;
  395.  
  396.         } elsif($l =~ /^ ?else/) {
  397.         $ll = pop(@wl);
  398.         $l = $ll.$l;
  399.  
  400.         } elsif($l =~ /^if \(fBC\d+\w+==0\)\{$/) {
  401.         do {
  402.             $ll = shift(@lines);
  403.             $l .= $ll;
  404.         } until(!$ll || ($ll =~ /^fBC\d+\w+=1;$/));
  405.  
  406.         }
  407.         push(@wl,$l);
  408.     }
  409.     }
  410.     return (@merged,@wl);
  411. }
  412.  
  413.  
  414. sub source_line_directive {
  415.     my($f,$l)= @_;
  416.     return "#line $l ".'"'.$src_name[$f].'"';
  417.     return "";
  418. }
  419. #-------- add_line_directive END 
  420.  
  421.