#!/usr/local/bin/perl
#----------------------------------------------------------------------------- 
#  add-line-directive
#
#     add c line directive 
#          to 
#     Small Eiffel generated C-code 
#     (For 0.79)
#----------------------------------------------------------------------------- 
#    History
# 	Vers	 Date		Coder		Description
# 	00-00	May 15,1997	Masato Mogaki	first version
# 	00-01	Aug 28,1997	Masato Mogaki	for -0.85
# 	00-02	Jul 09,1998	Masato Mogaki	for -0.80
# 	00-03	Sep 08,1998	Masato Mogaki	for -0.79
#----------------------------------------------------------------------------- 
# 
@c = ();
@h = ();
$with_line_directive = 1;


# collect source file names and options.

for ($i=0; $i<=$#ARGV;$i++) {
    $s = $ARGV[$i];
    if($s =~ /\.c$/) {
	push(@c,$s);
    } elsif($s =~ /\.h$/) {
	push(@h,$s);
    } elsif($s =~ /^-n$/) {
	$with_line_directive = 0;
    } elsif($s =~ /^c$/) {
	$with_gc = 1;
    }
}


#find eiffel souce file name from the lines like  p[123]="./test.e";

foreach $s (@c) {
    open(IN,$s);
    $se_init = 0;
    while(<IN>) {
	if($se_init) {
	    if(/^p\[(\d+)\]="(.*)";/) {
		$src_name[$1] = $2;
	    }elsif(/^p\[(\d+)\]=p\[(\d+)\];/) {
		$src_name[$1] = $src_name[$2];
	    }elsif(/^g\[(\d+)\]="(.*)";/) {
		$se_init = -1;
	    }
	} elsif(/^void initialize_eiffel_runtime/) {
	    $se_init = 1;
	}
	if($se_init<0) { last;  }
    }
    close(IN);
    if($se_init<0) { last; }
}

# convert header file.
#   + change prototype of routines
#   + change macro

foreach $s (@h) {
    $o = "B/$s";
    $t = "C/$s";
    if(system("cmp -s $s $o")) { # $s is changed 
	print STDERR "$s is changed\n";
	rename($s,$o);
	open(IN,$o);
	open(OUT,">$t");
	&convert_h;
    } else {
	unlink($s);
    }
}

# convert c source.
#  remove runtime trace code
#  rename routine arguments
#  add line directive #line NN "source.e"

foreach $s (@c) {
    $o = "B/$s";
    $t = "C/$s";
    if(system("cmp -s $s $o")) { # $s is changed 
	print STDERR "$s is changed\n";
	rename($s,$o);
	open(IN,$o);
	open(OUT,">$t");
	&convert_c;
    } else {
	unlink($s);
    }
}

#---------------------------------------------------------------
sub convert_h {
    while(<IN>) {
      s/(r\d+\w+\()se_dump_stack\*caller,?/$1/;
      s/(X\d+\w+\()se_dump_stack\*caller,int l,int c,int f, /$1/;
      print OUT $_;
    }
    close IN;

    print OUT "#define ci(_d,_o,_l,_c,_f) (_o)\n";
    print OUT "#define error0(_m) fprintf(stderr,\"%s\\n\",_m),abort()\n";
    print OUT "#define error1(_m,_l,_c,_f) error0(_m)\n";
    if ($with_gc) {
      print OUT "#include <gc.h>\n";
      print OUT "#define malloc(n) GC_malloc(n)\n";
      print OUT "#define calloc(m,n) GC_malloc((m)*(n))\n";
      print OUT "#define realloc(p,n) GC_realloc((p),(n))\n";
      print OUT "#define free(p) GC_free(p)\n";
      print OUT "#define gc_is_off GC_dont_gc\n";
      print OUT "#define gc_start() GC_gcollect()\n";
    }
    close OUT;
}


sub convert_c {
    my($in_routine);
    $in_routine = 0;
    $o_count = 0;
    while(<IN>) {
	chomp;
	if($in_routine == 0) {
	    if(/^(T0\*|T\d+|int|char|void|void\*) r(\d+)(\w+)\(.*\)\{$/) {
		s/se_dump_stack\*caller,?//;
		@body = ($_);
		@lvars = ();
		$in_routine = 1;
		$e_fno = 0;
		$e_lno = 0;
		$e_local = "";
	    } elsif (/^(T0\*|T\d+|int|char|void|void\*) (X\d+\w+\()se_dump_stack\*caller,int l,int c,int f, /) {
		s//$1 $2/;
		print OUT "$_\n";
		$o_count++;
		$in_routine = 10;
	    } elsif(/^void error[01]/) {
		while(<IN>) {
		    if(/^}/) {
			last;
		    }
		}
	    } elsif(/^T0\* ci/) {
		while(<IN>) {
		    if(/^}/) {
			last;
		    }
		}
	    } else {
	        if(!/^ms\d+/) {
		    s/exit\([^0()]*\)/abort()/g;
		    s/\(&ds,?/\(/g;
		    s/se_trace\(\d+,\d+,\d+\);//;
		}
		print OUT "$_\n";
		$o_count++;
	    }
	} elsif ($in_routine == 1) {
	    if(/^se_dump_stack ds;/) {
		if($e_local) {
		    $e_local .= "\n";
		    push(@body,$e_local);
		}
		$in_routine = 2;
	    } elsif(/^void\*\*locals\[(\d+)\];/) {
		$n_local = $1;
	    } else {
		$e_local .= $_;
	    }
	} elsif ($in_routine == 2) {
	    if(/^ds\.(\w+)=(.*);/) {
		my($attr,$val);
		$attr = $1;
		$val  = $2;
		if ($attr eq "l") {
		    $e_lno = $val;
		} elsif($attr eq "f") {
		    $e_fno = $val;
		    if($with_line_directive) {
			$r_post = "<$e_fno,$e_lno>\n";
		    }
		    unshift(@body,$r_post);
		}
	    } elsif(/^locals\[(\d+)\]=\(void\*\*\)\&(\w+);/) {
		$lvars[$1] = $2;
	    } elsif(/^se_dst=\&ds;/) {
		$in_routine = 3;
	    }
	} elsif ($in_routine < 10) {
	    if(/^if\(!se_af_rlr\)\{se_af_rlr=1/) {
		$in_routine++;
	    } elsif(/^\{static int se_af=1/) {
		$in_routine++;
	    } elsif(/^if\(se_af\)\{/) {
		$in_routine++;
	    } elsif($in_routine>3 && /^\}/) {
		--$in_routine;
	    } elsif(/^se_frame_descriptor f\d+\w+=\{\"(.+ of .+)",(\d+),(\d+),\"(.*)\",\d+\};/) {
		output_routine($1,$2,$3,$4);
		print OUT "$_\n";
                if($with_line_directive){
		    print OUT "#line $o_count \"$t\"\n";
		    $o_count++;
                }
		$in_routine = 0;
	    } elsif(/se_af/) {
		$_ = "";
		# Ignore
	    } else {
		while(/se_trace\(\&ds,(\d+),(\d+),(\d+)\)[,;]/) {
		    s//<$3:$1>/;
		}
		while(/(X\d+\w+\()\&ds,(\d+),(\d+),(\d+),/) {
		    s//<$4:$2>$1/;
		}
		while(/ci\(\d+,([^,]+),(\d+),(\d+),(\d+)\)/) {
		    s//<$4:$2>$1/;
		}
		s/\/\*\w+\*\///g;
		s/se_dst=caller;//;
		s/\(&ds,?/\(/g;
		if(/\S/) {
		    if($with_line_directive) {
			s/(.+?)(<\d+:\d+>)/$2$1/;
			$_ = &update_fl($_);
		    } else {
			s/<\d+:\d+>//g;
		    }
		    push(@body,$_);
		}
	    }
	} elsif($in_routine == 10) {
	    if (/^se_dst=caller;$/) {
		$in_routine = 0;
	    } elsif(/se_dump_stack ds=\*caller;/) {
		# skip
	    } elsif(/^\{int id=vc\(C,l,c,f\)->id;/) {
		print OUT "{int id=((T0*)C)->id;\n";
		$o_count++;
	    } else {
		s/\(&ds,?/\(/g;
		print OUT "$_\n";
		$o_count++;
	    }
	}
    }

    close(OUT);
    close(IN);
}

sub update_fl {
    my($s) = @_;
    my($fl);
    while($s =~ /<(\d+):(\d+)>/) {
	if($e_fno != $1 || $e_lno != $2) {
	    $fl = "\n<$1,$2>\n";
	    $e_fno = $1;
	    $e_lno = $2;
	} else {
	    $fl = "";
	}
	$s =~ s//$fl/;
    }
    return $s;
}

# print out

sub output_routine {
    my($rout, $use_current, $nlocal, $l_desc) = @_;
    %name_map = ();
    if ($use_current) {
      $l_desc =~ s/^%\w+%//;
    }
    $l_desc =~ s/%[A-Z]\d+//g;
    my(@l_descs) = split(/%/,$l_desc);
    $i = 0;
    foreach $l (@l_descs) {
      $name_map{$lvars[$i]} = "_".$l;
      $i++;
    }
    @body = &split_lines(@body);
    @body = &merge_lines(@body);
    foreach $l (@body) {
	$l =~ s/<\d+,\d+>//g;
	$l = &replace_name($l);
	print OUT $l,"\n";
	$o_count++;
    }
}

# replace name of local variables.
sub replace_name {
    my ($line) = @_;
    my($n,$v);

    if(!/^\#/) {
	foreach $v (keys %name_map) {
	    $n = $name_map{$v};
	    $line =~ s/\b$v\b/$n/g;
	}
    } 
    return $line;
}

# split embedded line number
sub split_lines {
    my @lines = @_;
    my (@new_lines,@ls,$l,$s);
    @new_lines = ();
    foreach $l (@lines) {
	@ls = split(/\n/,$l);
	foreach $s (@ls) {
	    if($s =~ /\S/) {
		push(@new_lines,$s);
	    }
	}
    }
    return (@new_lines);
}

#-- Merge inline code to one line.
sub merge_lines {
    my @lines = @_;
    my (@merged,@wl,$l,$ll,$last_lno,$lno);
    @merged = ();
    @wl = ();
    $last_lno = 0;
    $last_fno = -1;
    while (@lines) {
	$l = shift(@lines);
	if($l =~ /<(\d+),(\d+)>/) {
	    @merged = (@merged,@wl);
	    $fno = $1;
	    $lno = $2;
	    $last_lno += $#wl+1;
	    @wl = ();

	    if($fno != $last_fno || $lno < $last_lno) {
		push(@merged,&source_line_directive($fno,$lno));
		$last_fno = $fno;
		$last_lno = $lno;
	    } elsif($lno > $last_lno) {
		while($lno > $last_lno) {
		    push(@merged,"");
		    $last_lno++;
		}
	    }
	} elsif($l =~ /\S/) {
	    # Creation call (gc)
	    if($l =~ /^\{T\d+\*n=new\d+\(\);$/) {
		$ll = '';
		while($l && $l !~ /\}$/) {
		    $ll .= $l;
		    $l = shift(@lines);
		}
		$l = $ll . $l;

	    # Creation call (-no_gc)
	    } elsif($l =~ /^\{T\d+\*n=malloc\(sizeof\(\*n\)\);$/) {
		$ll = '';
		while($l && $l !~ /\}$/) {
		    $ll .= $l;
		    $l = shift(@lines);
		}
		$l = $ll . $l;
		
	    # Reverse assignment call to attribute
	    } elsif($l =~ /^if.NULL!=.C->_\w+..switch...T0..C->_\w+.->id. \{$/) {
		$ll = pop(@wl);
		do {
		    $ll .= $l;
		    $l = shift(@lines);
		} until(!$l || ($l =~ /^\w+=NULL;$/));
		$ll .= $l;
		$l = $ll;

	    # Reverse assignment call to local variable
	    } elsif($l =~ /^if.NULL!=.\w+..switch...T0\*.\w+.->id. \{$/) {
		$ll = pop(@wl);
		do {
		    $ll .= $l;
		    $l = shift(@lines);
		} until(!$l || ($l =~ /^\w+=NULL;$/));
		$ll .= $l;
		$l = $ll;

	    } elsif($l =~ /^ ?else/) {
		$ll = pop(@wl);
		$l = $ll.$l;

	    } elsif($l =~ /^if \(fBC\d+\w+==0\)\{$/) {
		do {
		    $ll = shift(@lines);
		    $l .= $ll;
		} until(!$ll || ($ll =~ /^fBC\d+\w+=1;$/));

	    }
	    push(@wl,$l);
	}
    }
    return (@merged,@wl);
}


sub source_line_directive {
    my($f,$l)= @_;
    return "#line $l ".'"'.$src_name[$f].'"';
    return "";
}
#-------- add_line_directive END 

