#!/usr/local/bin/perl

##################################################################
# 96/02/14 Ƿ
# 
# եʥǥեȤ./TAGSˤȤäƥեȥΥץ
# Υĥ꡼¤Ϥ롣ե˵ҤƤե
# ƵŪĴ٤
#
# Ĵ٤ץΤե̾άɸ
# ɤ߹ळȤǤΤǡե֤ʹߤץ
# Ĵ٤ tail + ȤäɸϤήᡣ
# 륵֥롼Ĵ٤ˤɸϤ call hogehoge(RET)Ȥ
#
# CALL 줿ץƵŪĴ٤ɽ롣ƽФο
# ƬɽǥȤĤ롣
##################################################################

# ޥ̾

($progname) = ($0 =~ m#([^/]+)$#);    # ޥ̾

# ǥեȻ

$tagfile = "TAGS";
$fukasa  = 0;

# ץ

require 'getopts.pl';   # ץϥ饤֥
if(! &Getopts('vt:e:f:n:')){
    select(STDERR);
    print " Usage: $progname [-v] [-t tag_file] [-e pattern] [-f file] [Fortranfile]  \n";
    exit(0);
}

$tagfile = $opt_t if $opt_t;  # TAGե
$exclude = $opt_e if $opt_e;  # ǻꤷץϥȥ졼ʤ
                              # perlɽ  -e"^sg|msgdmp"ʤɤȤǤ
$excludefile = $opt_f if $opt_f; # ̵뤹ץΥꥹȤեͿ
                     # 롣ڡޤϲԤǶڤ롣: ^sg msgdmp ^rewn
$fukasa  = $opt_n if $opt_n;  # ƤӽФο(ľܤˤϻꤹɬפʤ
                    	      # ץǤκƵƽФ˻Ȥ)
$verbose = $opt_v;            # verbose

# 

$| = 1; # Хåե󥰤ʤ

$fukasa  = $fukasa + 1; # (Ƶ)ƽФο
for ( $i = 1 ; $i < $fukasa ; $i++ ) {
    $head =~ s/^/  /;
}

$opts = "-t $tagfile" ; # ƵƽФϤץ(-nʳ)
$opts = "$opts -v" if $verbose;
$opts = "$opts -e \'$exclude\'" if $exclude;
$opts = "$opts -f $excludefile" if $excludefile;

if ($excludefile){ # ̵뤹ץΥꥹȤɤ߹$exclude˲ä
    $exclude =~ s/$/\|/ if $exclude;
    open (EXCL,"<$excludefile");
    while($line = <EXCL>) {
	if ( !($line =~ s/^\s+$//) ){
	    $line =~ s/^\s+(.*)\n/$1/;
	    $line =~ s/\s*$/\|/;
	    $line =~ s/\s+/\|/g;
	    $exclude =~ s/$/$line/;
	}
    }
    $exclude =~ s/\|$//;
}

$exclude =~ s/\^/ /g; # ץ̾Ƭϥڡǧ

# ᥤ롼

$returncalled = 0;

while(<>) {
    if (/^ *CALL\s+(\w+)/i && ( !$exclude || !/$exclude/i ) ) {
	$subprogram = $1;
	s/^ */      /;
	if ($fukasa == 1) {print "\n";}
	print "$fukasa$head$_";
	open (TAGS,"<$tagfile");
	$mitukatta  = 0;
	while($line = <TAGS>){
	    $line =~ s/,/  /;
	    $file = $1 if $line =~ /^(\S+)/;  #ե̾ϹƬ˥ڡʤ
	    if ($line =~ /\s+$subprogram/i){
		$mitukatta = 1;
	        $line =~ s/^.*$subprogram//i ;
		$line =~ /(\d+)[^\d]+/;
		print "$fukasa$head        $file:\n" if $verbose;
 		open (RECURSIVE,"tail +$1 $file | $progname $opts -n $fukasa |");
		while(<RECURSIVE>){ print $_; }
		last;
	    }
	}
	if ( $verbose && !$mitukatta ) { print "$fukasa$head      \* $subprogram not found\n";}
    }
    elsif (/^ *END$/i || $returncalled && /^ *ENTRY/i) {
	exit(0); # ENDʸޤRETURNʸθENTRYʸ줿齪
    }
    elsif (/^ *PROGRAM|^ *SUBROUTINE|^ *ENTRY/i) {
	print "$fukasa$head$_";
    }
    if (/^ *RETURN$/i) { $returncalled = 1; }
}
