#   DIGITAL EQUIPMENT CORPORATION  CONFIDENTIAL AND PROPRIETARY
#   Last modified on Wed Jul 29 19:06:23 PDT 1992 by johnh
#        modified on Fri Dec 30 11:22:46 PST 1988 by brooks
#        modified on Tue Dec  6 13:19:05 PST 1988 by mhb
#
# trans is flag, == 0 in the parse phase, == 1 in the transformation phase
#
BEGIN {
        fmt["BOOLEAN"] = " %t";
        fmt["CHAR"] = " '%c'";
        fmt["INTEGER"] = " %d";
        fmt["REAL"] = " %f";
        fmt["LONGREAL"] = " %lf";
        fmt["Text.T"] = " \\\"%t\\\"";
        fmt["REFANY"] = " #< %x>";
    }
(trans == 0) && /PROCEDURE|OUTPUT|FEEDBACK|UPDATE/ {
        count++;
        if ( $1 ~ /[1-9]/) {     # strip off numeric suffix
            eventprio[count] = substr($1, length($1));
            $1 = substr($1, 1, length($1) - 1);
        } else { eventprio[count] = 1 }
	if ($1 == "PROCEDURE" || $1 == "OUTPUT")
	    eventstyle[count] = "OutputEvent";
	else if ($1 == "FEEDBACK")
	    eventstyle[count] = "FeedbackEvent";
	else if ($1 == "UPDATE")
	    eventstyle[count] = "UpdateEvent";
	else
	    { print "Trouble!"; exit }
	event[count] = $2;
	if (($3 == ";") || ( $3 $4 $5 == "();")) {
# Handle a proc with no arguments:
	    nargs[count] = 0;
	    argstr[count] = " ";
	    semiargstr[count] = " ";
	    argsemistr[count] = " ";
	    argnames[count] = " "; cargnames[count] = " ";
	    nonullargstr[count] = "dummy : INTEGER";
	    cargtype[count] = " "; 
	    argtype[count] = " ";
	    argformat[count] = " ";
	    spargtype[count] = " ";
	    typeformats[count] = "";
	    printfargs[count] = " ";
	} else {
# Parse arguments
	    na = 0; ap = 0;
	    for ( i = 4 ; $i != ")" ; ) {
		if ( $i != ":" ) {
		  argstr[count] = argstr[count] " " $i $(i+1);
		  na++; arg[count "." na] = $i;
		  if (na > 1) argnames[count] = argnames[count] ", ";
		  argnames[count] = argnames[count] $i;
		  if ($(i+1) == ",") i++;
		} else {
		  i++;
		  argstr[count] = argstr[count] " " $i;
		  if ($i ~ \
		    /^(BOOLEAN|CHAR|INTEGER|REAL|LONGREAL|Text\.T|REFANY)$/) 
		      {keyword = 1} 
		  else {keyword = 0}
		  fmtskip = 0; myformat = "";
		  if ($(i+1) == "[") {
		    if ($(i+2) == "]") { fmtskip = 2}
		    else if ($(i+3) == "]") {myformat = $(i+2); fmtskip = 3}
		    else {print "Formatting for type mangled"}
		  } else {print "Formatting for type missing"}
		  for ( ; ap != na ; ap++ ) {
		    argtype[count "." (ap+1)] = $i;
		    argformat[count "." (ap+1)] = myformat;
  		    cargtype[count] = cargtype[count] ", " $i;
		    a = arg[count "." (ap+1)];
      		    if (keyword > 0) {
      		      spargtype[count] = spargtype[count] " " $i;
     	  	      typeformats[count] = typeformats[count] fmt[$i];
      		      if ($i == "BOOLEAN")
      	  	        {printfargs[count] = printfargs[count] \
      		           ", TranscriptBasis.Truth[" a "] ";}
      		      else if ($i ~ /^(CHAR|INTEGER|REAL|LONGREAL|Text\.T)$/)
      		        {printfargs[count] = printfargs[count] ", " a;}
      		      else if ($i == "REFANY")
      		        {printfargs[count] = printfargs[count] \
      		           ", LOOPHOLE(" a ", INTEGER)";}
      		      else 
                        {print "Trouble with argtypes!"; exit }
		    } else {    # not a known type
		      spargtype[count] = spargtype[count] " \"" $i "\"";
      		      typeformats[count] = typeformats[count] " #<" $i " %x>";
      	              printfargs[count] = printfargs[count] \
      		           ", LOOPHOLE(" a ", INTEGER)";
		    }
		  }
		  i += fmtskip;    # skip over format
		  if ($(i+1) == ";") 
		    {i++; argstr[count] = argstr[count]  $i;}
		}
		i++;
	    }
	    cargnames[count] = ", " argnames[count];
	    nargs[count] = na;
#	    astr = substr($0, index($0, "(") + 2);
#	    argstr[count] = substr(astr, 1, index(astr, ")") - 2);
	    semiargstr[count] = "; " argstr[count];
	    argsemistr[count] = argstr[count] "; ";
	    nonullargstr[count] = argstr[count];
	    argtype[count] = substr(cargtype[count], 3);
	}
    }

trans == 0 && /^#\(_TRANSFORM_\)$/ {	# done with declarations
	  trans = 1; next; }

# This gross expression is the complete pattern for a procedure declaration.
# It allows non-M3 variable and type names, but the compiler will catch them.
#
trans == 0 && substr($0, index($0, " ")) !~ /^ [a-zA-Z][a-zA-Z0-9]*( \( \)| \(( [a-zA-Z0-9]+ (, [a-zA-Z0-9]+ )*: [a-zA-Z0-9.]+ \[ ([a-zA-Z0-9.]+ )?\] ;)* [a-zA-Z0-9]+ (, [a-zA-Z0-9]+ )*: [a-zA-Z0-9.]+ \[ ([a-zA-Z0-9.]+ )?\] \))[ ]?;[ ]*$/ {
	  print $0 " Unexpected procedure declaration format"}


# The following code does substitutions in a template file:

trans == 1 && /^#{ *$/ {		# begin a block to be repeated
	  if ( dp == 0 ) { dp++; l = 0; blocktype = "AllEvents"; }
	  else { dp++; l++; line[l] = $0; }
	}
trans == 1 && /^#{_(OUTPUT|FEEDBACK|UPDATE) *$/ {	# begin an event block
	  if ( dp == 0 ) { 
	    dp++; l = 0; 
	    if ($0 ~ /OUTPUT/) { blocktype = "OutputEvent"; }
	    else if ($0 ~ /UPDATE/) { blocktype = "UpdateEvent"; }
	    else { blocktype = "FeedbackEvent"; }
	    next;        # Don't match any further patterns
	  } else { print "Event block must be at outer level"; }
	}
trans == 1 && /^#} */ {			# process a block
	  if ( dp == 2 ) {dp--; l++; line[l] = $0; }
	  else {
	    if ( dp != 1 ) print "Trouble with block structure";
	    dp--;
	    for ( evtno = 1 ; evtno <= count ; evtno++ ) {
	      if ( (blocktype != "AllEvents") && \
	           (blocktype != eventstyle[evtno]) ) { continue; }
	      for ( i=1 ; i <= l ; ) {
	        start = i; stop = i ; reps = 1; nexti = i+1;
		if ( line[i] ~ /^#{ *$/ ) {
		  for ( j = i; line[j] !~ /^#} *$/ ; j++ ) ;
		  start = i+1; stop = j-1; reps = nargs[evtno]; nexti = j+1;
		}
		for ( argno = 1; argno <= reps ; argno++ ) {
		  for ( j = start ; j <= stop ; j++ ) {
		    lineout = line[j];
		    if (lineout ~ /^#\| *$/ ) {
		      if (argno == reps) {break} else {continue}
		    }
		    while ( index( lineout, "#(_") != 0 ) { #do replacement
		      ind = index(lineout, "#(_");
		      head = substr(lineout, 1, ind-1);
		      tail = substr(lineout, ind);
		      ind = index(tail, "_)");
		      key = substr(tail, 1, ind+1);
		      tail = substr( tail, ind+2);
		      repl = key   #protects against bad keys
		      if ( key == "#(_EVENT_)" ) 
		        repl = event[evtno];
		      if ( key == "#(_EVENTSTYLE_)" ) 
		        repl = eventstyle[evtno];
		      if ( key == "#(_EVENTPRIO_)" ) 
		        repl = eventprio[evtno];
		      if ( key == "#(_ARGSTR_)" ) 
		        repl = argstr[evtno];
		      if ( key == "#(_NONULL_ARGSTR_)" ) 
			repl = nonullargstr[evtno];
		      if ( key == "#(_SEMI_ARGSTR_)" ) 
		        repl = semiargstr[evtno];
		      if ( key == "#(_ARGSTR_SEMI_)" ) 
		        repl = argsemistr[evtno];
		      if ( key == "#(_ARGTYPES_)" ) 
		        repl = argtype[evtno];
		      if ( key == "#(_COMMA_ARGTYPES_)" )
			repl = cargtype[evtno];
		      if ( key == "#(_SPACED_ARGTYPES_)" )
		        repl = spargtype[evtno];
		      if ( key == "#(_ARGNAMES_)" ) 
		        repl = argnames[evtno];
		      if ( key == "#(_COMMA_ARGNAMES_)" )
			repl = cargnames[evtno];
		      if ( key == "#(_TYPE_FORMATS_)" )
			repl = typeformats[evtno];
		      if ( key == "#(_PRINTF_ARGS_)" )
			repl = printfargs[evtno];
		      if ( key == "#(_ARGNAME_)" ) repl = arg[evtno "." argno];
		      if ( key == "#(_ARGTYPE_)" ) 
		        repl = argtype[evtno "." argno];
		      if ( key == "#(_ARGFMT_)" ) 
		        repl = argformat[evtno "." argno];
		      lineout = head repl tail;
		    }
		    print lineout;
		  }
		}
		i = nexti;
	      }
	    }
	  }
	}
trans == 1 && dp == 0 && ! /^#[{}] *$/
trans == 1 && dp != 0 && ! /^#[{}] *$/ {
	  l++; line[l] = $0; }