File: prod.web

package info (click to toggle)
fweb 1.62-6
links: PTS
area: main
in suites: potato
size: 4,656 kB
ctags: 5,149
sloc: ansic: 41,947; makefile: 383; sh: 166
file content (6175 lines) | stat: -rw-r--r-- 124,659 bytes
parent folder | download | duplicates (9)
@z --- prod.web ---

FWEB version 1.62 (September 25, 1998)

Based on version 0.5 of S. Levy's CWEB [copyright (C) 1987 Princeton University]

@x-----------------------------------------------------------------------------

\Title{PROD.WEB} % Productions for the FWEAVE processor.

@c

@* INTRODUCTION.
In order to accomodate memory-starved personal computers, the productions
have been split off from the main part of \FWEAVE.

@d _PROD_h

@A 
@<Possibly split into parts@>@;

@<Include files@>@;
@<Typedef declarations@>@;
@<Prototypes@>@;
@<Global variables@>@;

/* For PC's, the file is split into two compilable parts using the
compiler-line macro |part|, which must equal either~1 or~2. */
#if(part != 2)
	@<Part 1@>@;
#endif /* Part 1 */

#if(part != 1)
	@<Part 2@>@;
#endif /* Part 2 */

@I typedefs.hweb

@
@<Include...@>=
#include "map.h"

@ The function prototypes must appear before the global variables.
@<Proto...@>=

#include "p_type.h"

@I xrefs.hweb
@I tokens.hweb

@* PARSING.  The most intricate part of \.{WEAVE} is its mechanism for
converting \cee-like code into \TeX\ code, and we might as well plunge into
this aspect of the program now. A ``bottom up'' approach is used to parse
the \cee-like material, since \.{WEAVE} must deal with fragmentary
constructions whose overall ``part of speech'' is not known.

At the lowest level, the input is represented as a sequence of entities
that we shall call {\it scraps}, where each scrap of information consists
of two parts, its {\it category} and its {\it translation}. The category is
essentially a syntactic class, and the translation is a token list that
represents \TeX\ code. Rules of syntax and semantics tell us how to combine
adjacent scraps into larger ones, and if we are lucky an entire \cee\ text
that starts out as hundreds of small scraps will join together into one
gigantic scrap whose translation is the desired \TeX\ code. If we are
unlucky, we will be left with several scraps that don't combine; their
translations will simply be output, one by one.

The combination rules are given as context-sensitive productions that are
applied from left to right. Suppose that we are currently working on the
sequence of scraps $s_1\,s_2\ldots s_n$. We try first to find the longest
production that applies to an initial substring $s_1\,s_2\ldots\,$; but if
no such productions exist, we find to find the longest production
applicable to the next substring $s_2\,s_3\ldots\,$; and if that fails, we
try to match $s_3\,s_4\ldots\,$, etc.

A production applies if the category codes have a given pattern. For
example, one of the productions is $$\hbox{|expr| |binop| |expr| $\RA$
|expr|}$$ and it means that three consecutive scraps whose respective
categories are |expr|, |binop|, and |expr| are con\-verted to one scraps
whose category is |expr|.  The scraps are simply concatenated.  The case of
$$\hbox{|expr| |comma| |expr| $\RA$ |expr|}$$ is only slightly more
complicated: here the resulting |expr| scrap consists not only of the three
original scraps, but also of the tokens~|opt| and~9 between the |comma| and
the following |expr|.  In the \TeX\ file, this will specify an additional
thin space after the comma, followed by an optional line break with penalty~90.

At each opportunity the longest possible production is applied: for
example, if the current sequence of scraps is |struct_like| |expr| |lbrace|
this is transformed into a |struct_hd| by rule~31, but if the sequence is
|struct_like| |expr| followed by anything other than |lbrace| only two
scraps are used (by rule~32) to form an |int_like|.

@I ccodes.hweb

@ For debugging, we need to append a newline to the output of certain
routines so the output gets flushed.

@d DFLUSH if(dflush) puts("");

@<Glob...@>=

IN_PROD boolean dflush PSET(NO); // Turn this on from debugger.

@ The following function symbolically prints out a category. (In using the
|OUT1| macro, we take advantage of the fact that the \.{\#}~operator does
not put a second set of quotes around a string. By enclosing the |name|
arguments in quotes, we keep \FWEAVE\ from getting confused about the part
of speech under discussion; it's not used to seeing a reserved word in the
location of an argument.)

@m OUT(cs) case cs: printf(#*cs); @~ break@;
@m OUT1(cs,name) case cs: printf(#*name); @~ break@;

@<Part 1@>=
#ifdef DEBUG

@[SRTN 
prn_cat FCN((c))
	eight_bits c C1("Category.")@;
{
  switch(c) 
	{
	OUT1(language_scrap,"@@L");
	OUT(expr);
	OUT1(exp_op,"^^");
	OUT1(_EXPR,$_EXPR); @~ OUT1(EXPR_,$EXPR_); @~ OUT1(_EXPR_,$_EXPR_);
	OUT(new_like);
	OUT(stmt);
	OUT(decl);
	OUT(decl_hd);
	OUT1(Decl_hd,$Decl_hd);
	OUT(struct_hd);
	OUT(functn);
	OUT(fn_decl);
	OUT(fcn_hd);
	OUT1(else_like,"else");
	OUT1(ELSE_like,ELSE);
	OUT(if_hd);
	OUT(IF_top);
	OUT(else_hd);
	OUT(for_hd);
	OUT(unop);
	OUT1(UNOP,$UNOP_ @e);
	OUT(binop);
	OUT1(BINOP,@e $_BINOP_ @e);
	OUT(unorbinop);
	OUT1(semi,";");
	OUT1(colon,":");
	OUT1(comma,`,`);
	OUT1(COMMA,@e $_COMMA_ @e);
	OUT1(question,"?");
	OUT(tag);
	OUT(cast);
	OUT1(lpar,"(");
	OUT1(rpar,")");
	OUT1(lbracket,"[");
	OUT1(rbracket,"]");
	OUT1(lbrace,"{");
	OUT1(rbrace,"}");
	OUT(common_hd);
	OUT(read_hd);
	OUT1(slash_like,"slash");
	OUT1(private_like, "private");
	OUT(slashes);
	OUT1(lproc,"#{");
	OUT(LPROC);
	OUT1(rproc,"#}");
	OUT1(ignore_scrap,"ignore");

	OUT1(define_like,define);
	OUT(no_order);
	OUT1(do_like,"do");
	OUT1(while_do, "while");
	OUT1(Rdo_like,Rdo);
	OUT1(if_like,"if");
	OUT1(IF_like,IF);
	OUT1(for_like,"for");
	OUT1(program_like,program);
	OUT1(int_like,int);
	OUT(modifier);
	OUT1(huge_like,"huge");
	OUT1(CASE_like,CASE);
	OUT1(case_like,"case");
	OUT1(sizeof_like,sizeof @e);
	OUT1(op_like,"op");
	OUT1(proc_like,"proc");
	OUT1(class_like,"class");
	OUT1(struct_like,"struct");
	OUT1(typedef_like,"typedef");
	OUT1(imp_reserved,"imp_rsrvd");
	OUT1(extern_like,"extern");
	OUT1(common_like,common);
	OUT1(read_like,read);
	OUT1(entry_like,entry);
	OUT1(implicit_like,implicit);
	OUT(implicit_hd);
	OUT(built_in);
	OUT1(endif_like,endif);
	OUT1(end_like,end);
	OUT1(END_like,END);
	OUT(END_stmt);
	OUT1(go_like,go);
	OUT1(newline,"\n");
	OUT(label);
	OUT(space);
	OUT1(until_like,until);
	OUT(template);
	OUT(langle);
	OUT(rangle);
	OUT(tstart);
	OUT(tlist);
	OUT(namespace);
	OUT(virtual);
	OUT1(reference,ref);
	OUT1(kill_newlines, killnl);

	OUT1(0,zero);
	default: printf("UNKNOWN(%i)", c); @~ break;
	}

DFLUSH;
}

#endif /* |DEBUG| */

@I output.hweb

@ Here is a table of all the productions. The reader can best get a feel for
@^productions, table of@>
how they work by trying them out by hand on small examples; no amount of
explanation will be as effective as watching the rules in action.  Parsing
can also be watched by debugging with~`\.{@@2}' or by using the
command-line option ``\.{-2}''.  [Please see file
\.{examples/prod.web}.]

@i scraps.hweb

@ This dummy module keeps \FTANGLE\ from complaining. (It's needed only by
\FWEAVE.)


@<Rest of |trans_plus| union@>=

@ The following functions prints a token list. It is intended to be called
from the debugger.

@<Part 1@>=
#ifdef DEBUG

SRTN 
prn_text FCN((p))
	text_pointer p C1("The token list.")@;
{
  token_pointer j; /* index into |tok_mem| */
  sixteen_bits r; /* remainder of token after the flag has been stripped off */

  if (p>=text_ptr) 
	printf("BAD");
  else for (j=*p; j<*(p+1); j++) 
	{
	    r = (sixteen_bits)(*j % id_flag);

	    switch (*j/id_flag) 
		{
      case 1: printf("\\\\{"); prn_id((name_dir+r)); printf("}"); break;
	/* |id_flag| */
      case 2: printf("\\&{"); prn_id((name_dir+r)); printf("}"); break;
	/* |res_flag| */
      case 3: printf("<"); prn_id((name_dir+r)); printf(">"); break;
        /* |mod_flag| */
      case 4: printf("[[%d]]",r); break; /* |tok_flag| */
      case 5: printf("|[[%d]]|",r); break; /* |inner_tok_flag| */
      default: @<Print token |r| in symbolic form@>;
		}
	  }

DFLUSH;
}

SRTN
prn_trans FCN((p))
	scrap_pointer p C1("")@;
{
prn_text(indirect(p->trans));
}

#endif /* |DEBUG| */

@ 
@<Print token |r|...@>=

switch (r) 
	{
  case math_bin: printf("\\mathbin}"); @~ break;
  case math_rel: printf("\\mathrel}"); @~ break;
  case big_cancel: printf("[ccancel]"); @~ break;
  case cancel: printf("[cancel]"); @~ break;
  case indent: printf("[indent]"); @~ break;
  case outdent: printf("[outdent]"); @~ break;
  case backup: printf("[backup]"); @~ break;
  case opt: printf("[opt]"); @~ break;
  case break_space: printf("[break]"); @~ break;
  case force: printf("[force]"); @~ break;
  case big_force: printf("[fforce]"); @~ break;
  case end_translation: printf("[quit]"); @~ break;
  default: putxchar(XCHR(r));
	}

@ The production rules listed above are embedded directly into the
\.{WEAVE} program, since it is easier to do this than to write an
interpretive system that would handle production systems in general.
Several macros are defined here so that the program for each production is
fairly short.

All of our productions conform to the general notion that some~|k|
consecutive scraps starting at some position~|j| are to be replaced by a
single scrap of some category~|c| whose translations is composed from the
translations of the disappearing scraps. After this production has been
applied, the production pointer~|pp| should change by an amount~|d|. Such a
production can be represented by the quadruple |(j,k,c,d)|. For example,
the production `|expr@,comma@,expr| $\RA$ |expr|' would be represented by
`|(pp,3,expr,-2)|'; in this case the pointer |pp| should decrease by~2
after the production has been applied, because some productions with |expr|
in their second or third positions might now match, but no productions have
|expr| in the fourth position of their left-hand sides. Note that the value
of~|d| is determined by the whole collection of productions, not by an
individual one.  The determination of~|d| has been done by hand in each
case, based on the full set of productions but not on the grammar of the
language or on the rules for constructing the initial scraps.

We also attach a serial number of each production, so that additional
information is available when debugging. For example, the program below
contains the statement `|REDUCE(pp,3,expr,-2,4)|' when it implements the
production just mentioned.

Before calling |reduce|, the program should have appended the tokens of the
new translation to the |tok_mem| array. We commonly want to append copies
of several existing translations, and macros are defined to simplify these
common cases. For example, |b_app2(pp)| will append the translations of
two consecutive scraps, |pp->trans| and |(pp+1)->trans|, to the current
token list. If the entire new translation is formed in this way, we write
`|SQUASH(j,k,c,d)|' instead of `|REDUCE(j,k,c,d)|'. For example,
`|SQUASH(pp,3,expr,-2,3)|' is an abbreviation for `|b_app3(pp);
REDUCE(pp,3,math,-2,3)|'.

The code below is an exact translation of the production rules into~C
using such macros, and the reader should have no difficulty understanding
the format by comparing the code with the symbolic productions as they were
listed earlier.

To understand the routines that append tokens or scraps in detail, we must
discuss the concept of \It{mathness}. This is used to determine how to
enclose things in dollar signs---i.e., what things should be treated in
math mode. 

Routines such as |app| or |app_str| append stuff to the list without
changing the mathness.

Routines such as |b_app| or |b_app1| (the 'b' stands for 'big')
provisionally change the mathness depending on what's come before and
what's being appended.

Three flags handle the mathness. |cur_mathness| is the mathness at this
point in the construction. |ini_mathness| is the initial mathness of the
stuff that's been appended so far. |last_mathness| is the mathness of the
last stuff that's been appended. (|cur_mathness| and |last_mathness| appear
to be redundant, but we're not changing the code right now.)

The next macros \It{big\_appn} append $n$~consective tokens.

@D b_app2(a) b_app1(a); @~ b_app1(a+1)
@D b_app3(a) b_app2(a); @~ b_app1(a+2)
@D b_app4(a) b_app3(a); @~ b_app1(a+3)

@<Global...@>=

IN_PROD int cur_mathness, ini_mathness, last_mathness;

@ Append an entire string, converting to |ASCII| if necessary. (Don't
change the mathness.)

@<Part 1@>=@[

SRTN 
app_str FCN((s))
	CONST outer_char HUGE *s C1("String to be appended.")@;
{ 
while (*s) 
	app(XORD(*(s++)));
}

/* Append a string that's already Ascii. */
SRTN 
app_ASCII_str FCN((s))
	CONST ASCII HUGE *s C1("")@;
{
while(*s) 
	app(*s++);
}

@ Append a token, possibly changing the mathness.

@<Part 1@>=@[

SRTN 
b_app FCN((a))
	Token a C1("Token to be appended.")@;
{
if (a==@' ' || (a>=big_cancel && a<=big_force))
	{/* Appending a non-math token, including a space. */
	if (cur_mathness ==maybe_math) 
		ini_mathness=no_math;
	else if (cur_mathness==yes_math) 
		{
#ifdef DBGM
		app(@'4');
#endif	
		app(@'$'); // End math mode.
		}

	cur_mathness=last_mathness=no_math;
	}
else 
	{ /* Append a math token. (Tokens can't be |maybe_math|.) */
	if (cur_mathness==maybe_math) 
		ini_mathness=yes_math;
	else if (cur_mathness==no_math) 
		{
		app(@'$'); // Begin math mode.
#ifdef DBGM
		app(@'3');
#endif
		}

	cur_mathness=last_mathness=yes_math;
}

app(a);
}

@ Append an entire scrap, possibly changing the mathness. The mathness for
scraps is stored in an |eight_bits| in the form |4*last_mathness +
ini_mathness|. 

@d INI_MATHNESS(p) ((p)->mathness % 4) 
	/* Left boundary (|ini_mathness|) of the current scrap. */
@d LAST_MATHNESS(p) ((p)->mathness / 4)
		/* Right boundary (|last_mathness|) */

@<Part 1@>=@[

SRTN 
b_app1 FCN((a))
	scrap_pointer a C1("Scrap to be appended.")@;
{
switch(INI_MATHNESS(a))
	{ 
  case no_math:
	    if (cur_mathness==maybe_math) 
		ini_mathness = no_math;
	    else if (cur_mathness==yes_math) 
		{
#ifdef DBGM
		app(@'2');
#endif
		APP_STR("$"); /* End math mode. (The braces take care of
ending the math part with something like a~$+$.) */
		}
	
	    cur_mathness = last_mathness = LAST_MATHNESS(a);
	    break;

  case yes_math:
	    if (cur_mathness==maybe_math) 
		ini_mathness=yes_math;
	    else if (cur_mathness==no_math) 
		{
		APP_STR("$"); /* Begin math mode.  (The braces take care
of beginning the math part with something like a~$+$.) */
#ifdef DBGM
		app(@'1');
#endif
		}

	    cur_mathness = last_mathness = LAST_MATHNESS(a);
	    break;

  case maybe_math: 
	break; // No changes in mathness.
	  }

app(a->trans + tok_flag - tok_start);
}

@ Let us consider the big switch for productions now, before looking at its
context. We want to design the program so that this switch works, so we
might as well not keep ourselves in suspense about exactly what code needs
to be provided with a proper environment.

\Ratfor\ and \Fortran\ are treated as two dialects of the same language,
because almost all of the rules are the same. The most important exception
is in the \&{if} statements.

The first thing we do is to process any language scrap.  Such scraps begin
with |begin_language|, then the language number as the next token.  We use
that token to reset the language.

If it's not a language scrap, we gobble up any |ignore_scrap|. For reasons
that are now obscure, we regress by $-2$ after that. This doesn't work
quite right; the logic of some of the |if| statements gets screwed up if
there's a comment in the wrong place.

@<Match a production at |pp|, or increase |pp| if there is no match@>= 
{
if(cat0 == language_scrap)
	{
	language = lan_enum(get_language(pp->trans)); /* Get language from
language~\#. */
	ini0_language(); // Reset params like |auto_semi|.
	SQUASH(pp,1,ignore_scrap,-1,0);
	}
else if(cat1==ignore_scrap) SQUASH(pp,2,cat0,-2,0);//Gobble an |ignore_scrap|.
@% else if(cat0==ignore_scrap) SQUASH(pp,2,cat1,0,0); // Screws language cmd.
else switch(language)
		{
   	   case NO_LANGUAGE:
		CONFUSION("match production",
			"Language hasn't been defined yet");

	   case C: 
	   case C_PLUS_PLUS:
		C_productions();
		break;

	   case RATFOR:
	   case RATFOR_90:
		if(!RAT_OK("(translate)"))
			CONFUSION("match production",
				"Language shouldn't be Ratfor here");

	   case FORTRAN:
	   case FORTRAN_90:		
		R_productions();
		break;

	   case LITERAL:
		V_productions();
		break;

	   case TEX:
		X_productions();
		break;

	   case NUWEB_OFF:
	   case NUWEB_ON:
		CONFUSION("match a production","Invalid language");
		}

pp++; // if no match was found, we move to the right and try again.
}

@ 
@<Part 1@>=@[
int 
get_language FCN((xp))
	text_pointer xp C1("")@;
{
token_pointer tp,tp1;

tp = *xp;
tp1 = *(xp+1) - 1; /* The |-1| is because we should always have the
	combination |begin_language| followed by the language number. */

while(tp < tp1)
	if(*tp++ == begin_language) return *tp;

return CONFUSION("get_language",
	"Can't find |begin_language| token in language_scrap");
}

@* PRODUCTIONS for C. The productions have been made into individual
functions to accomodate memory-starved pc's.

@<Part 1@>=@[

SRTN 
C_productions(VOID)
{
switch (pp->cat) 
    {
    case ignore_scrap:  @<CASES for |ignore_scrap| (C)@>@; break;
    case built_in: @<CASES for |built_in| (R)@>@; @~ break;
    case expr: @<CASES for |expr| (C)@>@; @~ break;
    case exp_op: @<CASES for |exp_op| (R)@>@; @~ break;
    case _EXPR: @<CASES for |_EXPR| (C)@>@; @~ break;
    case _EXPR_: @<CASES for |_EXPR_| (C)@>@; @~ break;
    case EXPR_: @<CASES for |EXPR_| (C)@>@; @~ break;
    case new_like: @<CASES for |new_like| (C)@>@; @~ break;
    case lpar: @<CASES for |lpar| (C)@>@; @~ break;
    case lbracket: @<CASES for |lbracket| (C)@>@; @~ break;
    case rbracket: @<CASES for |rbracket| (C)@>@; @~ break;
    case question: @<CASES for |question| (C)@>@; @~ break;
    case unop: @<CASES for |unop| (C)@>@; @~ break;
    case UNOP: @<CASES for |UNOP| (C)@>@; @~ break;
    case unorbinop: @<CASES for |unorbinop| (C)@>@; @~ break;
    case binop: @<CASES for |binop| (C)@>@; @~ break;
    case BINOP: @<CASES for |BINOP| (C)@>@; @~ break;
    case COMMA: @<CASES for |COMMA| (C)@>@; @~ break;
    case cast: @<CASES for |cast| (C)@>@; @~ break;
    case sizeof_like: @<CASES for |sizeof_like| (C)@>@; @~ break;
    case int_like: @<CASES for |int_like| (C)@>@; @~ break;
    case extern_like: @<CASES for |extern_like| (C)@>@; @~ break;
    case modifier: @<CASES for |modifier| (C)@>@; @~ break;
    case huge_like: @<CASES for |huge_like| (C)@>@; @~ break;
    case decl_hd: @<CASES for |decl_hd| (C)@>@; @~ break;
    case decl: @<CASES for |decl| (C)@>@; @~ break;
    case typedef_like: @<CASES for |typedef_like| (C)@>@; @~ break;
    case imp_reserved: @<CASES for |imp_reserved| (C)@>@; @~ break;
    case op_like: @<CASES for |op_like| (C)@>@; @~ break;
    case class_like: @<CASES for |class_like| (C)@>@; @~ break;
    case struct_like: @<CASES for |struct_like| (C)@>@; @~ break;
    case struct_hd: @<CASES for |struct_hd| (C)@>@; @~ break;
    case fn_decl: @<CASES for |fn_decl| (C)@>@; @~ break;
    case functn: @<CASES for |functn| (C)@>@; @~ break;
    case lbrace: @<CASES for |lbrace| (C)@>@; @~ break;
    case do_like: @<CASES for |do_like| (C)@>@; @~ break;
    case while_do: @<CASES for |while_do| (C)@>@; @~ break;
    case if_like: @<CASES for |if_like| (C)@>@; @~ break;
    case IF_like: @<CASES for |IF_like| (C)@>@; @~ break;
    case IF_top: @<CASES for |IF_top| (C)@>@; @~ break;
    case for_like: @<CASES for |for_like| (C)@>@; @~ break;
    case for_hd: @<CASES for |for_hd| (C)@>@; @~ break;
    case else_like: @<CASES for |else_like| (C)@>@; @~ break;
@#if(0)
    case ELSE_like: @<CASES for |ELSE_like| (C)@>@; @~ break;
@#endif
    case if_hd: @<CASES for |if_hd| (C)@>@; @~ break;
    case else_hd: @<CASES for |else_hd| (C)@>@; @~ break;
    case case_like: @<CASES for |case_like| (C)@>@; @~ break;
    case stmt: @<CASES for |stmt| (C)@>@; @~ break;
    case tag: @<CASES for |tag| (C)@>@; @~ break;
    case semi: @<CASES for |semi| (C)@>@; @~ break;
    case lproc: @<CASES for |lproc| (C)@>@; @~ break;
    case LPROC: @<CASES for |LPROC| (C)@>@; @~ break;
    case space: @<CASES for |space| (C)@>@; @~ break;

    case template: @<CASES for |template| (C++)@>@; @~ break;
    case langle: @<CASES for |langle| (C++)@>@; @~ break;
    case rangle: @<CASES for |rangle| (C++)@>@; @~ break;
    case tstart: @<CASES for |tstart| (C++)@>@; @~ break;
    case tlist: @<CASES for |tlist| (C++)@>@; @~ break;

    case virtual: @<CASES for |virtual| (C++)@>@; @~ break;
    case reference: @<CASES for |reference| (C++)@>@; @~ break;
    case namespace: @<CASES for |namespace| (C++)@>@; @~ break;

    case kill_newlines:  @<CASES for |kill_newlines| (C++)@>@; @~ break;
  }
}

@ In~C, new specifier names can be defined via |typedef|, and we want
to make the parser recognize future ocurrences of the identifier thus
defined as specifiers.  This is done by the procedure |make_reserved|,
which changes the |ilk| of the relevant identifier. (One difficulty with
this solution is that it is implemented in phase~2, so if one uses an
identifier before it is actually |typedef|'d, it won't typeset properly. In
these cases, an explicit~\.{@@f} is required as well.)

The original \CWEB\ design of |make_reserved| didn't handle a situation such as
|typedef int (*I)()|, because |I|~was inside parentheses. The procedure has
been augmented to handle this situation by following the indirection chain
to the bitter end.

@<Part 1@>=@[

SRTN 
make_reserved FCN((p)) /* Make the first identifier in |p->trans| like
				|int| */ 
	scrap_pointer p C1("")@;
{
sixteen_bits tok_value = first_id(p->trans); 
	// The first identifier, plus its flag.
name_pointer pname = name_dir + tok_value - id_flag;

if(!tok_value || tok_value==@'(') 
	return; // Emergency return; no	identifier found.

if(DEFINED_TYPE(pname) == M_MACRO || DEFINED_TYPE(pname) == D_MACRO)
	return; // Don't |typedef| macro names.

/* Change categories of all future occurrences of the identifier. */
  for (; p<=scrp_ptr; p++) 
	{
	    if (p->cat==expr) 
		{
	        if (**(p->trans)==tok_value) 
			{
			p->cat=int_like;
			**(p->trans)+=res_flag-id_flag; // Mark as reserved.
		        }
		}
	  }

pname->ilk = int_like;
pname->reserved_word |= (boolean)language;

if(mark_defined.typedef_name)
	{
	pname->defined_in(language) = module_count;
	SET_TYPE(pname,TYPEDEF_NAME);
	}
}

@ This function hunts through a translation until it finds the first
identifier, if there is one.

@d FIRST_ID(p) ( ((tok0=first_id(p->trans)) && tok0!=@'(') ? name_dir + tok0 -
		id_flag : name_dir) 	 // Ptr to actual id.

@<Glob...@>=

IN_PROD sixteen_bits tok0;

@ This function considers a token list between~|pk| and~|pk1|; it returns
the first (flagged) identifier token it finds, or 0~if there's none.
Because each component of the token list may itself be a token list, this
routine is called recursively.

@<Part 1@>=@[

sixteen_bits 
first_id FCN((t))
	text_pointer t C1("Pointer to start of token list")@;
{
token_pointer pk = *t; // Start of end.
token_pointer pk1 = *(t+1); // End of list.
sixteen_bits tok_value; // Current element.

for(; pk < pk1; pk++)
	{
	tok_value = *pk;

	if(tok_value > inner_tok_flag) tok_value -= (inner_tok_flag -
tok_flag); 

	if(tok_value <= tok_flag)
		{ // It's an ordinary (non-flagged) token.
		if( tok_value >= id_flag && tok_value < res_flag)
			return tok_value; // Found identifier.
		else if(tok_value == @'(') return tok_value; // STOP!!!
		}
	else
		{ // Flagged token; use indirection.
	 	t = tok_start + (int)(tok_value - tok_flag); /* Flagged token
corresponds to a |text_pointer|; |*t|~points to beginning of translation. */
		tok_value = first_id(t);// Check that translation recursively. 
		if(tok_value) return tok_value;
		}
	}

return 0; // Really couldn't find anything!
}

@ In the following situations we want to mark the occurrence of an
identifier as a definition: when |make_reserved| has just been used; after
a specifier, as in |char **argv|; before a colon, as in |found:|; and in
the declaration of a function, as in |main(){@t\dots@>;}|.  This is
accomplished by the invocation of |make_underlined| at appropriate times.
Since, in the declaration of a function, we only find out that the
identifier is being defined after it has been swallowed up by an |expr|, we
must hunt through an indirection chain.

@<Part 1@>=@[

name_pointer 
make_underlined FCN((p)) /* underline the entry for the first
				identifier in |p->trans| */ 
	scrap_pointer p C1("")@;
{
  sixteen_bits tok_value; /* the name of this identifier, plus its flag */

  tok_value=**(p->trans);

  if (tok_value>inner_tok_flag) tok_value-=(inner_tok_flag-tok_flag);

  if (tok_value>tok_flag) {
	do 
		{ /* Follow an indirection chain to a real identifier. {\bf
Watch the 16-bit arithmetic!} */
		tok_value=**(tok_start +
				(int)(tok_value-tok_flag));  /* {\bf Don't
remove the parens!} */
		}
	while(tok_value > tok_flag);

    if (tok_value<id_flag || tok_value>=res_flag) return NULL; /* shouldn't
happen */ 

    xref_switch=def_flag; underline_xref(tok_value-id_flag+name_dir);
  }

  if (tok_value<id_flag || tok_value>=res_flag) return NULL; 
	// shouldn't happen!

  xref_switch=def_flag; return underline_xref(tok_value-id_flag+name_dir);
}

@ We cannot use |new_xref| to underline a cross-reference at this point
because this would just make a new cross-reference at the end of the list.
We actually have to search through the list for the existing
cross-reference.

@<Part 1@>=@[

name_pointer 
underline_xref FCN((p))
	name_pointer p C1("")@;
{
  xref_pointer q = (xref_pointer)p->xref; /* Pointer to cross-reference
being examined */ 
  xref_pointer r; /* Temporary pointer for permuting cross-references */
  sixteen_bits m; /* Cross-reference value to be installed */
  sixteen_bits n; /* Cross-reference value being examined */
extern boolean strt_off;

  if (no_xref || (strt_off && !index_hidden)) 
	return p;

  xref_switch = def_flag;
  m = (sixteen_bits)(module_count + xref_switch);

  while (q != xmem) 
	{
	    n=q->num;

	    if (n==m) return p;	/* Same status; need to do nothing. */
	    else if (m==n+def_flag) /* Module numbers match; update to
				defined. */ 
		{
		q->num=m; return p;
		 }
	    else if (n>=def_flag && n<m) break;

	    q=q->xlink;
	  }

@<Insert new cross-reference at |q|, not at beginning of list@>;

return p;
}

@ Record the module at which an identifier was defined. A global variable
distinguishes between |INNER| and |OUTER| modes.

@<Glob...@>=

IN_PROD PARSING_MODE translate_mode; // Set by |translate|.

@
@<Part 1@>=@[

SRTN 
defined_at FCN((p))
	name_pointer p C1("")@;
{
extern boolean ok_to_define;

if(ok_to_define && translate_mode==OUTER && p > name_dir) 
	{
	sixteen_bits mod_defined = p->defined_in(language);

	if(mod_defined && mod_defined != module_count && language!=C_PLUS_PLUS)
		{
		if(msg_level >= WARNINGS)
		 {
		printf("\n! (FWEAVE):  Implicit phase 2 declaration of `");
		prn_id(p);
		printf("' at %s \
repeats or conflicts with declaration at %s.\n",
			(char *)MOD_TRANS(module_count), 
			(char *)MOD_TRANS(mod_defined));
		mfree();
		 }
		mark_harmless;
		}
	else if(mark_defined.fcn_name)
		{
		p->defined_in(language) = module_count;
		SET_TYPE(p,FUNCTION_NAME);
		}
	}
}

@ We get to this module only when the identifier is one letter long, so it
didn't get a non-underlined entry during phase one.  But it may have got
some explicitly underlined entries in later modules, so in order to
preserve the numerical order of the entries in the index, we have to insert
the new cross-reference not at the beginning of the list (namely, at
|p->xref|), but rather right before~|q|.

@<Insert new cross-reference at |q|...@>=

  append_xref(0); /* This number doesn't matter */
  xref_ptr->xlink = (xref_pointer)p->xref;
 r = xref_ptr; p->xref = (ASCII *)xref_ptr;

  while (r->xlink!=q) {r->num=r->xlink->num; r=r->xlink;}

  r->num=m; /* Everything from |q| on is left undisturbed */

@ Now comes the code that tries to match each production that starts with a
particular type of scrap. Whenever a match is discovered, the |squash| or
|reduce| procedures will cause the appropriate action to be performed,
followed by |goto found|.

@D cat0 pp->cat
@D cat1 (pp+1)->cat
@D cat2 (pp+2)->cat
@D cat3 (pp+3)->cat
@D cat4 (pp+4)->cat
@D cat5 (pp+5)->cat

@d indent_force b_app(indent); @~ b_app(force)@;

/* Append $m$~things, followed by a space, followed by $n$~things. */
@m PP_PP(m,n) b_app##m(pp); @~ b_app(@' '); @~ b_app##n(pp+m)@;

@<CASES for |ignore_scrap| (C)@>=

#if FCN_CALLS
	C_ignore_scrap();
#else
	@<Cases for |ignore_scrap| (C)@>@;
#endif

@
@<Part 1@>=

#if FCN_CALLS
	@[SRTN C_ignore_scrap(VOID)
		{
		@<Cases for |ignore_scrap| (C)@>@;
		}
#endif

@
@<Cases for |ignore_scrap| (C)@>=
{
switch(cat1)
	{
   case stmt:
   case functn:
	SQUASH(pp,2,cat1,0,1);
	break;
	}
}

@ Ordinary expressions.
@<CASES for |expr| (C)@>=
#if FCN_CALLS
	C_expr();
#else
	@<Cases for |expr| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_expr(VOID)
		{
		@<Cases for |expr| (C)@>@;
		}
#endif

@

@d OPT9	APP_SPACE; app(opt); app(@'9')@;

@<Cases for |expr| (C)@>=
{
if (cat1==lbrace || ((!Cpp) && cat1==int_like))
	{ /* ``|f(x) {}|'' or ``|f(x) float x;|'' (old-style) */
	defined_at(make_underlined(pp)); /* Recognized function name;
remember current module number. */
	in_function = YES;
	SQUASH(pp, 1, fn_decl, 0, 111); 
	}
else if (cat1==unop) 
	SQUASH(pp,2,expr,-2,2); /* ``|x--|'' */
else if (cat1==binop)
	{
	if(cat2==expr) 
		SQUASH(pp,3,expr,-2,3); /* ``|x + y|'' */
	else if(cat2==decl_hd)
		SQUASH(pp, 3, tstart, 0, 6061); 
			/* Trap for ``|@c++ A<int>|'', with |A| undefined. */
	}
else if (cat1==unorbinop && cat2==expr)
	{
	sixteen_bits *s = *(pp+1)->trans;
	b_app1(pp);

/* If the translation of the next scrap begins with an escape character, we
assume we're seeing \.{\\amp}. */
	if( (s[0] == (sixteen_bits)@'\\') && s[1] == (sixteen_bits)@'a'
			&& s[2] == (sixteen_bits)@'m')
		{
		APP_SPACE; b_app1(pp+1); @~ APP_SPACE; /* ``|x & y|'' */
		}
	else b_app1(pp+1); /* ``|x*y|'' */

	b_app1(pp+2);
	REDUCE(pp,3,expr,-2,3000);
	}
else if (cat1==comma)
	{
	if((cat2==expr || cat2==int_like)) /* ``|x,y|'' or ``|x,char|''  */
		{
		b_app2(pp);
		OPT9;
		b_app1(pp+2); REDUCE(pp,3,cat2,-2,4);
		}
	else if(cat2==space)
		SQUASH(pp, 3, expr, -2, 88); // Macros.
	}
else if (cat1==expr) 
	SQUASH(pp,2,expr,-2,5); /* ``|f(x)|'' */
else if (cat1==semi) 
	SQUASH(pp,2,stmt,-1,6); /* ``|x;|'' */
else if (cat1==colon)  /* ``|label:|'' */
	{
	if(!Cpp || in_function)
		{ /* Ordinary C tag. */
		make_underlined (pp);  /* Label name. */
		SQUASH(pp,2,tag,0,7);
		}
	else if(cat2==expr || cat2==int_like) 
		{ /* Put the spaces in explicitly in case we're not in math
mode at the time. */
		b_app1(pp); @~ b_app(@' '); @~ b_app1(pp+1); @~ b_app(@' '); 
@~ b_app1(pp+2);		
		REDUCE(pp,3,expr,-2,701); 
			/* \Cpp: ``|@c++ derived() : base()|'' */
		}
	}
else if(cat1==space) 
	SQUASH(pp,2,expr,-2,8); /* For use in macros. */
}

@ The next several cases are for symbols that are formatted like operators.
These need to get explicit spaces to set them off from their surroundings.

@<Bracket with spaces@>=

APP_SPACE; @~ b_app1(pp); @~ APP_SPACE;

@ Name as unary operator: ``\.{\$UNOP\_\ }''.
@<CASES for |UNOP| (C)@>=
#if FCN_CALLS
	C_UNOP();
#else
	@<Cases for |UNOP| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_UNOP(VOID)
		{
		@<Cases for |UNOP| (C)@>@;
		}
#endif

@
@<Cases for |UNOP| (C)@>=
{
b_app1(pp); @~ APP_SPACE;
REDUCE(pp,1,unop,-1,4443);
}

@ Name as binary operator: ``\.{\ \$\_BINOP\_\ }''.
@<CASES for |BINOP| (C)@>=
#if FCN_CALLS
	C_BINOP();
#else
	@<Cases for |BINOP| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_BINOP(VOID)
		{
		@<Cases for |BINOP| (C)@>@;
		}
#endif

@
@<Cases for |BINOP| (C)@>=
{
@<Bracket with spaces@>;
REDUCE(pp,1,binop,-1,4444);
}

@ Name as comma: ``\.{\ \$\_COMMA\_\ }''.
@<CASES for |COMMA| (C)@>=
#if FCN_CALLS
	C_COMMA();
#else
	@<Cases for |COMMA| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_COMMA(VOID)
		{
		@<Cases for |COMMA| (C)@>@;
		}
#endif

@
@<Cases for |COMMA| (C)@>=
{
@<Bracket with spaces@>;
REDUCE(pp,1,comma,-1,4445);
}

@ Expression with space to left: ``\.{\ \$\_EXPR}''.
@<CASES for |_EXPR| (C)@>=
#if FCN_CALLS
	C__E();
#else
	@<Cases for |_EXPR| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C__E(VOID)
		{
		@<Cases for |_EXPR| (C)@>@;
		}
#endif

@
@<Cases for |_EXPR| (C)@>=
{
APP_SPACE; @~ b_app1(pp);
REDUCE(pp,1,expr,-2,4446);
}

@ Expression with spaces on both sides: ``\.{\ \$\_EXPR\_\ }''.
@<CASES for |_EXPR_| (C)@>=
#if FCN_CALLS
	C__E_();
#else
	@<Cases for |_EXPR_| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C__E_(VOID)
		{
		@<Cases for |_EXPR_| (C)@>@;
		}
#endif

@
@<Cases for |_EXPR_| (C)@>=
{
@<Bracket with spaces@>;
REDUCE(pp,1,expr,-2,4447);
}

@ Expression with space to right: ``\.{\$EXPR\_\ }''.
@<CASES for |EXPR_| (C)@>=
#if FCN_CALLS
	C_E_();
#else
	@<Cases for |EXPR_| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_E_(VOID)
		{
		@<Cases for |EXPR_| (C)@>@;
		}
#endif

@
@<Cases for |EXPR_| (C)@>=
{
b_app1(pp); @~ APP_SPACE;
REDUCE(pp,1,expr,-2,4448);
}

@ There are right and wrong ways of inserting a real space. What we want to
do is to insert the macro \.{\\\ } (which works either in or out of math mode)
without changing the mathness.

@d APP_SPACE APP_STR("\\ ")

@ The next stuff handles C~preprocessing (not very well).
@<Glob...@>=

IN_PROD boolean active_space PSET(NO);
IN_PROD boolean in_LPROC PSET(NO);
IN_PROD boolean expanded_lproc PSET(NO);

@ In \Cpp, the syntax for |new| and |delete| is unusual.
@<CASES for |new_like| (C)@>=
#if FCN_CALLS
	C_new_like();
#else
	@<Cases for |new_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_new_like(VOID)
		{
		@<Cases for |new_like| (C)@>@;
		}
#endif

@
@<Cases for |new_like| (C)@>=
{
if(cat1==lbracket && cat2==rbracket)
	{ /* |@c++ delete [] expr| */
	PP_PP(1, 1); @~@<Append thickspace@>; @~ b_app1(pp+2);
	b_app(@' ');
	REDUCE(pp, 3, expr, -2, 910);
	}
else if(cat1==decl_hd || cat1==expr)
	{ /* \Cpp: |@c++ new int| or |@c++ new class(20)| */
	PP_PP(1,1);
	if(cat1==decl_hd) 
		{
		OUTDENT;
		}
	REDUCE(pp,2,expr,-2,909);
	}
}

@ The \CWEB\ code didn't work right here. The present attempt is a mess.

@<CASES for |lproc| (C)@>=
#if FCN_CALLS
	C_lproc();
#else
	@<Cases for |lproc| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_lproc(VOID)
		{
		@<Cases for |lproc| (C)@>@;
		}
#endif

@ |lproc| signals the beginning of a preprocessor statement.  |rproc|
signals the end.

@<Glob...@>=

extern boolean did_arg;

@
@<Cases for |lproc| (C)@>=
{
expanded_lproc = YES;

if(!in_LPROC) 
	active_space = YES;

if(cat1==define_like) 
	make_underlined(pp+3); /* ``\.{\#\ define\ M}'' */

if (cat1==else_like || cat1==if_like ||cat1==define_like)
	SQUASH(pp, 2, lproc, 0, 10); /* ``\.{\#\ define}'' $\to$
``\.{\#define}'' */
else if (cat1==rproc)
	{
	expanded_lproc = active_space = in_LPROC = NO;
	SQUASH(pp, 2, ignore_scrap, -1, 11); 
	}
else if(cat1==expr) 
#if 0
	SQUASH(pp, 1, LPROC, 0, 12); /* ``|#if(0)|'' (??) */
#endif
	{
	PP_PP(1, 1);

	if(cat2==lpar)
		did_arg = NO;
	else
		{
		b_app(@' ');  /* ``|#define x|'' */
		did_arg = YES;
		}

	REDUCE(pp, 2, LPROC, 0, 12);
	}
else if (cat1==space)
	{ 
	if(cat2==lpar)
		SQUASH(pp, 1, lproc, PLUS 2, 1332); // \.{if\ (x)}
/* Following stuff for \&{\#define}.  
Absorb the identifier: ``\&{\#define M}'' */  
	else if(cat3==lpar) 
		SQUASH(pp,1,lproc,PLUS 3,1333); /* Expand the parens. */
	else if(cat3==expr) 
		SQUASH(pp,4,LPROC,0,13); /* |expr| should be
			``|()|''; get them too. */ 
	else if(cat3==space || cat3==ignore_scrap || cat3==rproc) 
		SQUASH(pp,3,LPROC,0,14); /* Just the identifier. */ 
	}
expanded_lproc = NO;
}

@ 
@<CASES for |LPROC| (C)@>=
#if FCN_CALLS
	C_LPRC();
#else
	@<Cases for |LPROC| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_LPRC(VOID)
		{
		@<Cases for |LPROC| (C)@>@;
		}
#endif

@
@<Cases for |LPROC| (C)@>=
{
active_space = NO; in_LPROC = YES;

if(cat1==space) 
	{
	b_app1(pp);
	b_app(@' ');
	REDUCE(pp, 2, LPROC, 0, 20);
	}
else if(!did_arg && cat1==expr)
	{
	SQUASH(pp, 2, LPROC, 0, 24);
	did_arg = YES;
	}
else if(cat1==rproc) 
	{
	in_LPROC = NO;
	SQUASH(pp, 2, ignore_scrap, -1, 21);
	}
else if(cat2==rproc)
	{
	in_LPROC = NO;
	SQUASH(pp, 3, ignore_scrap, -1, 22);
	}

#if(0)
	if(cat3==lpar && cat4==expr && cat5==rpar)
	  if (cat2==rproc) 
		{
		    b_app1(pp); b_app(@' '); b_app2(pp+1);
		    REDUCE(pp,3,ignore_scrap,-1,53);
		  }
	  else if (cat2==expr && cat3==rproc) 
		{ 
	    b_app1(pp); b_app(@' '); b_app1(pp+1); b_app(@' ');
	    b_app2(pp+2); REDUCE(pp,4,ignore_scrap,-1,53);
		}
#endif
}

@
@<CASES for |space| (C)@>=
#if FCN_CALLS
	C_space();
#else
	@<Cases for |space| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_space(VOID)
		{
		@<Cases for |space| (C)@>@;
		}
#endif

@
@<Cases for |space| (C)@>=
{
if(active_space)
	{
	if(expanded_lproc) 
		SQUASH(pp,1,space,-1,5336);
	else 
		SQUASH(pp,1,space,1,5335);
	}
else 
	REDUCE(pp,1,ignore_scrap,-1,5334);
}

@ 
@<CASES for |question| (C)@>=
#if FCN_CALLS
	C_question();
#else
	@<Cases for |question| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_question(VOID)
		{
		@<Cases for |question| (C)@>@;
		}
#endif

@
@<Cases for |question| (C)@>=
{
if (cat1==expr && cat2==colon) SQUASH(pp,3,binop,-2,30); /* ``|i==1 ? YES :
					NO|'' */
}

@ 
@<CASES for |int_like| (C)@>=
#if FCN_CALLS
	C_int_like();
#else
	@<Cases for |int_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_int_like(VOID)
		{
		@<Cases for |int_like| (C)@>@;
		}
#endif

@
@<Cases for |int_like| (C)@>=
{
if(cat1==unop)
	{
	if(cat2==expr || cat2==int_like) 
		SQUASH(pp,3,expr,-2,35); /* \Cpp: |@c++ class::f| or
			constructor: |@c++ class::class| */ 
	else if(cat2==op_like) 
		SQUASH(pp,1,int_like,PLUS 2,36); /* \Cpp: Expand |@c++ operator|
			construction. */ 
	}
else if (cat1==int_like|| cat1==struct_like)
	{ /* ``|extern int|'' or ``|@c++ typedef int bool|''. */
	PP_PP(1,1);
	REDUCE(pp,2,cat1,0,40);
	}	
else if(cat1==reference)
	SQUASH(pp, 2, int_like, -2, 43); // |@c++ int &ref;|
else if (cat1==expr || cat1==unorbinop || cat1==semi)
	{ /* ``|int i|'' or ``|int *|'' */ 
	b_app1(pp); 

	if(cat1!=semi) 
		app(@'~'); 

#if 0
	INDENT; /* Start long declaration. (Note: Whenever we leave
			|decl_hd|, we must |OUTDENT|.) */ 
#endif

	REDUCE(pp,1,decl_hd,-1,41);
	}
else if(cat1==comma) 
	{
	b_app1(pp);
#if 0
	INDENT;
#endif
	REDUCE(pp,1,decl_hd,-2,42); /* Function prototype: |int,|. */ 
	}
else if(cat1==rpar)
	{
	b_app1(pp);
#if 0
	INDENT;
#endif
	REDUCE(pp,1,decl_hd,-2,502);
	}
else if(Cpp && cat1==lpar && !in_prototype)
	{ // The \Cpp\ is a KLUDGE. Consider ``|int (*f)()|''.
	b_app1(pp);
	@<Append thinspace@>@;
	REDUCE(pp,1,expr,-2,5021); /* \Cpp\ constructor: ``|@c++ base()|'';
					or ``|@c++ int(x)|''. */
	}
else if(cat1==binop && cat2==expr)
	SQUASH(pp,3,int_like,-2,5022); /* \Cpp\ initializer: |@c++ base = 0| */
else if(cat1 == langle)
	SQUASH(pp, 1, int_like, PLUS 1, 5997); // |@c++ int<24>|
else if(cat1 == rangle)
	{
	b_app1(pp);
#if 0
	INDENT;
#endif
	REDUCE(pp,1,decl_hd,-2,5998);
	}
else if(cat1 == class_like)
	{ // \Cpp:  |@c++ friend class|.
	PP_PP(1,1);
	REDUCE(pp, 2, class_like, 0, 5995);
	}	
else if(cat1 == tlist)
	SQUASH(pp, 2, int_like, -2, 5999);
else if(cat1 == namespace)
	{ /* |@c++ using namespace| */
	PP_PP(1,1);
	REDUCE(pp, 2, namespace, 0, 5996);
	}
}

@ We need a special case for |extern|, because of constructions like |@c+
extern "C"| in \Cpp.

@<CASES for |extern_like| (C)@>=
#if FCN_CALLS
	C_ext_like();
#else
	@<Cases for |extern_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_ext_like(VOID)
		{
		@<Cases for |extern_like| (C)@>@;
		}
#endif

@
@<Cases for |extern_like| (C)@>=
{
if(Cpp &&cat1==expr)
	{ /* |@c++ extern "C"| */
	PP_PP(1,1);
	if(cat2==lbrace || cat2==kill_newlines)
		REDUCE(pp, 2, fn_decl, 0, 5025); // ``|@c++ extern "C" {}|''.
	else
		REDUCE(pp, 2, int_like, 0, 5023); 
			// ``|@c++ extern "C" int fcn();|''
	}
else 
	SQUASH(pp,1,int_like,0,5024);
}

@ A case related but not identical to |int_like| is |modifier|, which is
used for things like |const| and |volatile|. The difficulty is that it may
come first in the declaration, but it need not. Compare |const char c| and
|char const c|; also |char *const p| and |const char *p|.

@<CASES for |modifier| (C)@>=
#if FCN_CALLS
	C_modifier();
#else
	@<Cases for |modifier| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_modifier(VOID)
		{
		@<Cases for |modifier| (C)@>@;
		}
#endif

@
@<Cases for |modifier| (C)@>=
{
if(cat1==int_like || cat1==struct_like || cat1==class_like)
	SQUASH(pp, 1, cat1, -2, 503);
else if(pp == lo_ptr)
	SQUASH(pp, 1, expr, 0, 5040);
else if(cat1==comma || cat1==semi || cat1==lbrace || cat1==kill_newlines)
	SQUASH(pp, 1, _EXPR, 0, 5042); 
		/* |@c++ int f() const, g();| or @c++ int f() const;| or
			|@c++ int f() const {}|. */
else
	SQUASH(pp, 1, EXPR_, 0, 5041);
}

@ Personal computers have a strange syntax with the |HUGE| operator.  We
must deal with declarations such as |char HUGE *p;|.
@<CASES for |huge_like| (C)@>=
#if FCN_CALLS
	C_huge_like();
#else
	@<Cases for |huge_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_huge_like(VOID)
		{
		@<Cases for |huge_like| (C)@>@;
		}
#endif

@
@<Cases for |huge_like| (C)@>=
{
if(cat1==unorbinop) 
	{
	b_app1(pp); @~ APP_SPACE; @~ b_app1(pp+1);
	REDUCE(pp,2,unorbinop,-1,505);
	}
}

@ 
@<CASES for |virtual| (C++)@>=
#if FCN_CALLS
	C_virtual();
#else
	@<Cases for |virtual| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_virtual(VOID)
		{
		@<Cases for |virtual| (C++)@>@;
		}
#endif

@
@<Cases for |virtual| (C++)@>=
{
b_app1(pp);

if(cat1==unop) 
	APP_SPACE; // |@c++ virtual ~base();|

REDUCE(pp,1,int_like,0,506);
}

@ 
@<CASES for |reference| (C++)@>=
#if FCN_CALLS
	C_reference();
#else
	@<Cases for |reference| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_reference(VOID)
		{
		@<Cases for |reference| (C++)@>@;
		}
#endif

@ If we can't figure out that an ampersand is a reference, treat it just
like an asterisk.
@<Cases for |reference| (C++)@>=
{
SQUASH(pp, 1, unorbinop, -1, 507);
}

@ With the advent of ANSI~C, we have to deal with function prototypes,
which look very much like casts. 

@d INDENT if(!indented)
		{
		b_app(indent);
		indented = YES;
		}

@d OUTDENT if(indented)
		{
		b_app(outdent);
		indented = NO;
		}

@<Glob...@>=

IN_PROD int in_prototype PSET(NO); 
	// This is used as a numerical counter.
IN_PROD int indented PSET(NO);

@ For \Cpp, it becomes necessary to know whether one is inside or outside
of a function.

@<Glob...@>=

IN_PROD boolean in_function PSET(NO);

@ A |decl_hd| is something like ``|int i|''.

@<CASES for |decl_hd| (C)@>=
#if FCN_CALLS
	C_decl_hd();
#else
	@<Cases for |decl_hd| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_decl_hd(VOID)
		{
		@<Cases for |decl_hd| (C)@>@;
		}
#endif

@
@<Cases for |decl_hd| (C)@>=
{
if(cat1==rpar) 
	{
	if((pp-1)->cat==lpar) 
		SQUASH(pp,1,decl_hd,-1,4990); // ``|(int i)|''.
	else if((pp-2)->cat==decl_hd) 
		SQUASH(pp,1,decl_hd,-2,4991); // ``|(int i, int j)|''.
	else if((pp-3)->cat==decl_hd)
		SQUASH(pp, 1, decl_hd, -3, 4992);
	}
else if(cat1==decl_hd) 
	SQUASH(pp,2,decl_hd,0,50); // ``|(int,int)|''
else if(cat1==comma)
	{
	if(cat2==decl_hd)
		{ /* For function prototype. */
		b_app2(pp); @~ OPT9;
		b_app1(pp+2);
		REDUCE(pp,3,decl_hd,0,501);
		}
	else if(cat2==ignore_scrap && cat3==decl_hd)
		{ /* For function prototype with comment. */
		b_app2(pp); @~ OPT9;
		b_app2(pp+2);
		REDUCE(pp,4,decl_hd,0,504);
		}
#if 0
	else if(Cpp && (cat2==decl || cat2==stmt))
		SQUASH(pp, 3, stmt, -2, 508); 
			/* ``|@c++ for(int i=0, int j=0;;)|'' or ``|@c++
				for(int i=0, int j=0, int k=0;;)|''. */
#endif
	else
	{ /* ``|int i,|'' */
	if(cat2==ignore_scrap && (cat3==int_like || cat3==struct_like ||
			cat3==modifier) ) 
		{/* Function prototype, with intervening comment. */
		b_app1(pp);
		if((pp-3)->cat != decl_hd && (pp-2)->cat != decl_hd
				&& cat3 != modifier)
			in_prototype++;
		REDUCE(pp,1,decl_hd,PLUS 3,5221);
		}
	else if(cat2==int_like || cat2==struct_like || cat2==modifier) 
		{ /* Function prototype. */ 
		b_app1(pp);
		if((pp-3)->cat != decl_hd && (pp-2)->cat != decl_hd
				&& cat2 != modifier)
			in_prototype++; /* The |modifier| clause is to
prevent a situation like |(int, const int)| from thinking it's two levels
of prototypes. */
		REDUCE(pp,1,decl_hd,PLUS 2,52);
		}
	else 
		{  /* Expecting list of something. */
		b_app2(pp); app(@'~');

#if 0
		if(Cpp)
			REDUCE(pp, 2, decl_hd, -2, 540); 
				// ``|@c++ int i=0, int j=0|'' (e.g., in |for|)
		else
#endif
			REDUCE(pp,2,decl_hd,-1,54); // ``|int i,j|''
		}
	}
	}
else if (cat1==unorbinop)
	{ /* ``|int **p|'' */
	b_app1(pp); 
	b_app(@'{'); 
	b_app1(pp+1); 
	b_app(@'}');
	REDUCE(pp,2,decl_hd,-1,55);
	}
else if (cat1==expr) 
	{ /* ``|int i|'' or ``|int i, j|'' */
	make_underlined(pp+1);
	SQUASH(pp,2,decl_hd,-1,56);  /* The |-1| is to pick up a left
					paren for function prototype. */
	}
else if ((cat1==binop||cat1==colon
||cat1==expr	/* (for initializations) */
) && cat2==expr && (cat3==comma || cat3==semi || cat3==rpar))
#if 0
	if(cat1==binop)
		{
		PP_PP(1,2);
		REDUCE(pp,3,decl_hd,-1,5660);
		}
	else 
#endif
		SQUASH(pp,3,decl_hd,-1,5661);
else if(cat1==int_like && (cat2==unop || cat2==langle))
	SQUASH(pp, 1, decl_hd, PLUS 1, 5662); 
	/* \Cpp:  ``|@c++ void *int::fcn()|'' or ``|@c++ void
		*int<int>::fcn()|'' */
else if (cat1==lbrace || (cat1==int_like && 
	((pp-1)->trans == NULL || **(pp-1)->trans != @'('))) /*
Recognize beginning of function: ``|float f() {}|'' or ``|float f(x) float
x|'' */ 
	{
	b_app1(pp);
#if 0
	OUTDENT;
#endif
	in_function = YES;
	defined_at(FIRST_ID(pp));
	REDUCE(pp,1,fn_decl,0,58); 
	}
else if (cat1==semi)
	{ /* ``|int i;|'' */
	b_app2(pp);
#if 0
	OUTDENT; /* Finish long declaration. */
#endif
#if 0
	if(Cpp)
		REDUCE(pp, 2, decl, -2, 594); 
			// ``|@c++ for(int i=0, int j=0;;)|''
	else
#endif
		REDUCE(pp,2,decl,-1,59);
	}
else if(Cpp && cat1==int_like && cat2==unop)
	SQUASH(pp,1,decl_hd,PLUS 1,590); /* \Cpp: |@c++ void *class::f| */
else if(Cpp && cat1 == rangle)
	SQUASH(pp, 1, decl_hd, -2, 591); /* \Cpp:  end of template. */
else if(Cpp && cat1 == struct_like)
	SQUASH(pp, 2, decl_hd, -1, 593); 
		/* \Cpp: |@c++ template<class C1, class C2>|. */
}

@ A |decl| is a |decl_hd| followed by a semicolon---i.e., a complete
statement. 

@<CASES for |decl| (C)@>=
#if FCN_CALLS
	C_decl();
#else
	@<Cases for |decl| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_decl(VOID)
		{
		@<Cases for |decl| (C)@>@;
		}
#endif

@
@<Cases for |decl| (C)@>=
{
if(Cpp)
	{
	if(cat1==functn)
		{
		b_app1(pp); @~ b_app(big_force);
		b_app1(pp+1);
		REDUCE(pp,2,functn,-1,61);
		}
	else 
		SQUASH(pp,1,stmt,-1,611); // E.g., ``|@c++ for(int i=0;;)|''
	}
else
	{
	if (cat1==decl)
		{ /* ``|int i; float x;|'' */
		b_app1(pp); @~ b_app(force);
		b_app1(pp+1);
		REDUCE(pp,2,decl,-1,60);
		}
	else if (cat1==stmt || cat1==functn)
		{  /* ``|int i; x=0;|'' or ``|int i; f(){}|'' */
		b_app1(pp); @~ b_app(big_force); 
		b_app1(pp+1); 
		REDUCE(pp,2,cat1,-1,61);
		}
	}
}

@ A |fn_decl| is the beginning of a function.

@<CASES for |fn_decl| (C)@>=
#if FCN_CALLS
	C_fn_decl();
#else
	@<Cases for |fn_decl| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_fn_decl(VOID)
		{
		@<Cases for |fn_decl| (C)@>@;
		}
#endif

@
@<Cases for |fn_decl| (C)@>=
{
if(cat1 == semi && Cpp)
	{ /* |@c++ using namespace X;| */
	b_app2(pp);
	REDUCE(pp, 2, stmt, -1, 72);
	}
else if (cat1==decl)
	{ /* ``|f(x) float x;|'' */
	b_app1(pp); 
	b_app(indent); @~ indent_force;
		b_app1(pp+1); /* Accrete old-style declarations. */
	b_app(outdent); @~ b_app(outdent);
	REDUCE(pp,2,fn_decl,0,70);
	}
else if (cat1==stmt) 
	{ /* ``|f(){}|'' */
#if(0)
	b_app(backup); /* Beginning of function. */
#endif
	b_app1(pp); @~ b_app(force); 
	b_app(indent);
		b_app1(pp+1); /* Function body */
	b_app(outdent);
	in_function = kill_nl = NO;
	REDUCE(pp,2,functn,-1,71);
	}
}

@ Deal with a complete function. Handle ``|f(){} g(){}|'' or ``|f(){}
extern int i;|''. 
@<CASES for |functn| (C)@>=
#if FCN_CALLS
	C_functn();
#else
	@<Cases for |functn| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_functn(VOID)
		{
		@<Cases for |functn| (C)@>@;
		}
#endif

@ The |stmt| clause takes care of \Cpp\ constructions like |@c++ try{}
catch(){}|. 
@<Cases for |functn| (C)@>=
{
if (cat1==functn || cat1==decl || cat1==stmt) 
	{
	b_app1(pp); @~ b_app(big_force); 
	b_app1(pp+1); REDUCE(pp,2,cat1,-1,80); /* |-1| for \Cpp */
	}
}

@ Handle syntaxes like ``|typedef int I;|'' or ``|typedef int
(**f[])();|''.
@<CASES for |typedef_like| (C)@>=
#if FCN_CALLS
	C_typedef_like();
#else
	@<Cases for |typedef_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_typedef_like(VOID)
		{
		@<Cases for |typedef_like| (C)@>@;
		}
#endif

@
@<Glob...@>=

IN_PROD boolean typedefing PSET(NO); // Are we inside a |typedef|?

@
@<Cases for |typedef_like| (C)@>=
{
if (cat1==decl_hd && (cat2==expr || cat2 == int_like))
	{
	make_underlined(pp+2); make_reserved(pp+2); /* NEEDS TO BE IMPROVED! */
	b_app2(pp+1);
	REDUCE(pp+1,2,decl_hd,0,90);
	}
else if(cat1==decl)
	{
	PP_PP(1,1);
	REDUCE(pp,2,decl,-1,91);
	}
else if(cat1==semi)
	SQUASH(pp, 2, stmt, -1, 94); 
		/* ``|typedef|''. */
else if(cat1==stmt)
	{
	PP_PP(1,1);
	REDUCE(pp, 2, stmt, -1, 95);  
		/* ``|typedef int I[3]|''. (|I| is defined in first pass.) */
	}
	
}

@ 
@<CASES for |imp_reserved| (C)@>=
#if FCN_CALLS
	C_imp_reserved();
#else
	@<Cases for |imp_reserved| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_imp_reserved(VOID)
		{
		@<Cases for |imp_reserved| (C)@>@;
		}
#endif

@ The special type |imp_reserved| is needed for forward referencing, but
when it's encountered within a |typedef| it should be interpreted as an
expression. 
@<Cases for |imp_reserved| (C)@>=
{
if(typedefing) SQUASH(pp,1,expr,-2,92);
else SQUASH(pp,1,int_like,-2,93);
}

@ In \Cpp, operator overloading has a somewhat unusual syntax, in that
constructions like |operator -=| plays the role of a function name.

@d MAX_OP_TOKENS 5 /* Maximum \# of tokens that could conceivably make up
	the function name. */

@<CASES for |op_like| (C)@>=
#if FCN_CALLS
	C_op_like();
#else
	@<Cases for |op_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_op_like(VOID)
		{
		@<Cases for |op_like| (C)@>@;
		}
#endif

@
@<Cases for |op_like| (C)@>=
{
short n; 
 // The actual number of tokens that make up the effective function name. 

if((cat1==lpar && cat2==rpar) || (cat1==lbracket && cat2==rbracket))
	{ /* |@c++ operator ()()|  is a special case because it begins with
left paren.  |@c++ operator []()| is handled as a special case because we
now have the categories |lbracket| and |rbracket|, and |lbracket| doesn't
regress when it's reduced to |lpar|. */
	APP_STR("\\Woperator");
	b_app(@'{');
	b_app1(pp+1); // |lpar| or |lbracket|
	@<Append thinspace@>@;
	b_app1(pp+2); // |rpar| or |rbracket|
	b_app(@'}');
	n = 3;
	}
else
	{ /* We'll search for the obligatory left paren that indicates the
argument list. */
	scrap_pointer q;
	int k; /* Counter. */

/* If the paren is missing, we could end up appending the entire rest of
the code, so we limit the search. */
	for(q = pp+1; q <= scrp_ptr && q-pp <= MAX_OP_TOKENS; q++)
		if(q->cat == lpar) 
			break;

	n = (q->cat == lpar) ? PTR_DIFF(short, q, pp) : 0;

/* Append all the tokens between |operator| and left paren. */
	if(n > 0)
		{
		text_pointer xp;
		token_pointer tp,tp1;

#if 0
		b_app1(pp); // |@c++ operator|; really \.{\\Woperator}.
		b_app(@'{'); /* Braces prevent possible spurious blanks
before the left paren. */
#endif
		APP_STR("\\Woperator");
		b_app(@'{');

		id_first = id_loc = mod_text + 1;

		for(k=1; k<n; k++)
			{
			b_app1(pp+k);

			xp = indirect((pp+k)->trans);
			tp = *xp;
			tp1 = *(xp+1);
			while(tp < tp1)
				*id_loc++ = (ASCII)(*tp++);
			}

		underline_xref(id_lookup(id_first,id_loc,0));

		b_app(@'}');
		}
	}

if(n > 0) 
	REDUCE(pp, n, expr, -2, 6666);
else
	{
	APP_STR("\\Woperatoro");
	REDUCE(pp, 1, expr, -2, 6668);
	}		
}
	
@ |@c++ class| is almost like |struct|, but it has to reserve the class name.
(Note that it might have been declared earlier, hence the |int_like| option.)

@<CASES for |class_like| (C)@>=
#if FCN_CALLS
	C_class_like();
#else
	@<Cases for |class_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_class_like(VOID)
		{
		@<Cases for |class_like| (C)@>@;
		}
#endif

@
@<Cases for |class_like| (C)@>=
{
if(cat1==expr || cat1==int_like)
	{ /* \Cpp: |@c++ class A| */
	make_underlined(pp+1); @~ make_reserved(pp+1);

	PP_PP(1,1);

	if((pp-1)->cat == tstart || (pp-1)->cat == decl_hd 
			|| (pp-1)->cat == lpar)
		REDUCE(pp, 2, decl_hd, -1, 8998);
	else
		REDUCE(pp, 2, struct_like, 0, 8999);
	}
else if(cat1==lbrace)
	SQUASH(pp, 1, struct_like, 0, 8987); 
		// |@c++ class{}| or |@c++ struct{}|.
}

@ Deal with beginning of a structure.

@<CASES for |struct_like| (C)@>=
#if FCN_CALLS
	C_struct_like();
#else
	@<Cases for |struct_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_struct_like(VOID)
		{
		@<Cases for |struct_like| (C)@>@;
		}
#endif

@
@c++
@f base int
@f derived int
@<Cases for |struct_like| (C)@>=
{
if (cat1==lbrace)
	{  /* ``|struct {int i;} S;|'' or \Cpp: ``|@c++ class A{int i;};|'' */
	b_app1(pp); @~ indent_force;	
	b_app1(pp+1); REDUCE(pp,2,struct_hd,0,100);
	}
else if (cat1==expr) 
	{ /* Structure name: ``|struct s|'' */
	if (cat2==lbrace) /* ``|struct s {}|'' */
		{
/* In \Cpp, this construction defines a new type. */
		if(Cpp) 
			{make_underlined(pp+1); @~ make_reserved(pp+1);}

		PP_PP(1,1);
		indent_force;
		b_app1(pp+2);
		REDUCE(pp,3,struct_hd,0,101);
		}
	  else 
		{ /* ``|struct s ss|'' */
		PP_PP(1, 1);
		REDUCE(pp,2,int_like,-1,102);
		}
	}
else if(cat1==colon && cat2==int_like && Cpp)
	{ /* |@c++ class A: base| */
	if(cat3==langle)
		SQUASH(pp, 1, struct_like, PLUS 3, 1023);
	else
		{
		b_app1(pp); @~ b_app(@' '); @~ b_app1(pp+1); @~ b_app(@' '); @~
			b_app1(pp+2);
		REDUCE(pp,3,struct_like,0,1021);
		}
	}
else if(cat1==comma && cat2==int_like && Cpp)
	{ /* |@c++ class A: base, base | */
	if(cat3==langle)
		SQUASH(pp, 1, struct_like, PLUS 3, 1024);
	else
		{
		PP_PP(2, 1);
		REDUCE(pp,3,struct_like,0,1022);
		}
	}
else if(cat1==tlist)
	SQUASH(pp, 2, struct_like, 0, 1025); // \Cpp: |@c++ class A<int>|.
else if(cat1==semi) 
	SQUASH(pp,2,decl,-1,103); /* \Cpp: |@c++ class base;| */
else if(cat1 == rangle)
	SQUASH(pp, 1, decl_hd, -2, 592); /* \Cpp:  end of template. */
}

@ Handle ``|enum{red,yellow}|;''.
@<CASES for |struct_hd| (C)@>=
#if FCN_CALLS
	C_str_hd();
#else
	@<Cases for |struct_hd| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_str_hd(VOID)
		{
		@<Cases for |struct_hd| (C)@>@;
		}
#endif

@
@<Cases for |struct_hd| (C)@>=
{
if ((cat1==decl || cat1==stmt
 || cat1==expr /*  (For enum) */
 || cat1==functn /* \Cpp */
) && cat2==rbrace) 
	{
	b_app1(pp); /* ``|struct {|'' */
	@<Append a body@>@;
	b_app1(pp+2); /* ``|}|'' */
	b_app(outdent); 
@#if 0
	b_app(break_space);
@#endif
	REDUCE(pp,3,int_like,-1,110);
	}
else if(cat1==rbrace)
	{
	b_app1(pp); @~ @<Append thin...@>@; b_app1(pp+1);
	b_app(outdent);
	REDUCE(pp,2,int_like,-1,1101);
	}
}

@ 
@<CASES for |lpar| (C)@>=
#if FCN_CALLS
	C_lpar();
#else
	@<Cases for |lpar| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_lpar(VOID)
		{
		@<Cases for |lpar| (C)@>@;
		}
#endif

@
@<Cases for |lpar| (C)@>=
{
if (cat2==rpar && (cat1==expr || cat1==unorbinop)) 
	SQUASH(pp,3,expr,-2,120); /* ``|(x)|''  or ``|(*)|''*/
else if (cat1==rpar) 
	{ /* ``|()|''. This looks better with a bit of extra space between
		the parens. */ 
	  b_app1(pp); @~ @<Append thickspace@>; @~ b_app1(pp+1);
	  REDUCE(pp,2,expr,-2,121);
	}
else if ((cat1==decl_hd) && cat2==rpar)
	{ /* Function prototype or cast, like ``|typedef (*T)|'' where |T|
		was |typedef|d on the first pass. */
	b_app3(pp);

	OUTDENT;

	if(in_prototype) 
		in_prototype--;

	REDUCE(pp,3,cast,-1,122);
	}
else if (cat1==stmt)
	{ /* ``|for(x;y;z)|'' */
	b_app2(pp); b_app(@' '); REDUCE(pp,2,lpar,0,123);
	}
else if(cat1==for_like && cat2==rpar) 
	SQUASH(pp,3,expr,-2,1201); /* Macros: |(for)| */ 
}

@ 
@<CASES for |lbracket| (C)@>=
#if FCN_CALLS
	C_lbracket();
#else
	@<Cases for |lbracket| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_lbracket(VOID)
		{
		@<Cases for |lbracket| (C)@>@;
		}
#endif

@
@<Cases for |lbracket| (C)@>=
{
if(active_brackets)
	{
	b_app(@'\\');
	APP_STR("WXA{");
	}
else b_app1(pp);

REDUCE(pp,1,lpar,0,5000);
}

@ 
@<CASES for |rbracket| (C)@>=
#if FCN_CALLS
	C_rbracket();
#else
	@<Cases for |rbracket| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_rbracket(VOID)
		{
		@<Cases for |rbracket| (C)@>@;
		}
#endif

@
@<Cases for |rbracket| (C)@>=
{
if(active_brackets) 
	{
	text_pointer t = indirect(pp->trans);

	if(**t == @']') **t = @'}';
	}

b_app1(pp);

REDUCE(pp,1,rpar,-5,5001);
}

@
@<CASES for |kill_newlines| (C++)@>=
#if FCN_CALLS
	C_killnl();
#else
	@<Cases for |kill_newlines| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_killnl(VOID)
		{
		@<Cases for |kill_newlines| (C++)@>@;
		}
#endif

@ The |kill_nl| flag is intended to make prettier short functions for such
things as simple \Cpp\ constructors.  The scrap of ilk |kill_newlines| is
appended by \.{@@\{}.

@<Glob...@>=
IN_PROD boolean kill_nl PSET(NO);

@
@<Append a |force| or thinspace@>=
{
if(kill_nl)
	@<Append thinspace@>@;
else
	b_app(force);
}

@
@<Cases for |kill_newlines| (C++)@>=
{
kill_nl = YES;
SQUASH(pp, 1, lbrace, -2, 8888);
}

@ 
@<CASES for |lbrace| (C)@>=
#if FCN_CALLS
	C_lbrace();
#else
	@<Cases for |lbrace| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_lbrace(VOID)
		{
		@<Cases for |lbrace| (C)@>@;
		}
#endif

@
@<Cases for |lbrace| (C)@>=
{
if (cat1==rbrace)  /* ``|{}|'' */
	{
	b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1); 
	REDUCE(pp,2,stmt,-1,130);
	}
else if ((cat1==stmt || cat1==decl || cat1==functn) && cat2==rbrace)  
	/* ``|{x;}|''  or \dots\ or \Cpp:  |@c++ main(){try{}catch(){}}| */
	{
	b_app(force);
	b_app1(pp);  /* ``|{|'' */

	@<Append a body@>@;

	b_app1(pp+2); /* ``|}|'' */

	REDUCE(pp,3,stmt,-1,131);
	}
else if (cat1==expr) 
	{
	if (cat2==rbrace) 
		SQUASH(pp,3,expr,-2,132); /* ``|enum{red}|'' */
	else if (cat2==comma && cat3==rbrace) 
		SQUASH(pp,4,expr,-2,132);
	}
}

@
@<Append a body@>=
{
@<Append a |force| or thinspace@>@;

b_app1(pp+1); /* Body */

@<Append a |force| or thinspace@>@;

kill_nl = NO;
}

@ 
@<CASES for |unop| (C)@>=
#if FCN_CALLS
	C__unop();
#else
	@<Cases for |unop| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C__unop(VOID)
		{
		@<Cases for |unop| (C)@>@;
		}
#endif

@
@<Cases for |unop| (C)@>=
{
if (cat1==expr) 
	SQUASH(pp,2,expr,-2,140); /* ``|!x|'' or ``|++x|'' */
else if(cat1==int_like) 
	SQUASH(pp,2,int_like,0,141); /* \Cpp\ destructor:
			``|@c++ ~base|'' */ 
}

@ 
@<CASES for |unorbinop| (C)@>=
#if FCN_CALLS
	C_unorbinop();
#else
	@<Cases for |unorbinop| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_unorbinop(VOID)
		{
		@<Cases for |unorbinop| (C)@>@;
		}
#endif

@
@<Cases for |unorbinop| (C)@>=
{
if(cat1==expr || (cat1==int_like && !(cat2 == lpar || cat2 == unop)) )
	{  /* ``|*p|'' or ``|&x|''; ``|typedef
		(*T)|'' where |T| was |typedef|d on the first pass.  Not
\Cpp:  ``|@c++ x + int(i)|'' or ``|@c++ x + base::y|''. */
	b_app(@'{'); @~b_app1(pp); @~ b_app(@'}'); 
	b_app1(pp+1); 
	REDUCE(pp,2,cat1,-2,150);
	}
else if (cat1==binop) 
	@<Reduce cases like |*=|@>@;
}

@
@<Reduce cases like |*=|@>=
{
  b_app(math_bin); 
b_app1(pp); 
b_app(@'{'); @~ b_app1(pp+1); @~ b_app(@'}');
  b_app(@'}'); /* End |math_bin| */
  REDUCE(pp,2,binop,-1,151);
}

@ 
@<CASES for |cast| (C)@>=
#if FCN_CALLS
	C_cast();
#else
	@<Cases for |cast| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_cast(VOID)
		{
		@<Cases for |cast| (C)@>@;
		}
#endif

@
@<Cases for |cast| (C)@>=
{
if (cat1==expr)  /* ``|(int *)p|'' */
	{
	b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1); 
	REDUCE(pp,2,expr,-2,160);
	}
else if(cat1 == unorbinop || cat1 == reference)
	SQUASH(pp, 1, cast, PLUS 1, 162); // ``|(int *)&prms|''.
else 
	SQUASH(pp,1,expr,-2,161); // Turn function prototype into expression.
}

@ 
@<CASES for |sizeof_like| (C)@>=
#if FCN_CALLS
	C_sizeof_like();
#else
	@<Cases for |sizeof_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_sizeof_like(VOID)
		{
		@<Cases for |sizeof_like| (C)@>@;
		}
#endif

@
@<Cases for |sizeof_like| (C)@>=
{
if (cat1==cast) 
	SQUASH(pp,2,expr,-2,170); /* ``|sizeof (int *)|'' */
else if (cat1==expr) 
	SQUASH(pp,2,expr,-2,171); /* ``|sizeof(x)|'' */
}

@ 
@<CASES for |binop| (C)@>=
#if FCN_CALLS
	C__binop();
#else
	@<Cases for |binop| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C__binop(VOID)
		{
		@<Cases for |binop| (C)@>@;
		}
#endif

@
@<Cases for |binop| (C)@>=
{
if (cat1==binop) 
	@<Reduce cases like |+=|@>@; /* ``|+=|'' */
else if(cat1==space)
	{
	b_app1(pp); // We eat the space in this macro situation.
	REDUCE(pp, 2, binop, -1, 181); // |#if(a == b)|.
	}
else if(Cpp && cat1==decl_hd)
	SQUASH(pp, 2, tstart, 0, 6063);
		/* Trap for ``|@c++ A<int>|'', with |A| undefined.  See
			also Rule 6061. */
}

@
@<Reduce cases like |+=|@>=
{
  b_app(math_bin); b_app1(pp); 
b_app(@'{'); @~ b_app1(pp+1); @~ b_app(@'}');
  b_app(@'}'); /* End |math_bin| */
  REDUCE(pp,2,binop,-1,180);
}

@ 
@<CASES for |do_like| (C)@>=
#if FCN_CALLS
	C_do_like();
#else
	@<Cases for |do_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_do_like(VOID)
		{
		@<Cases for |do_like| (C)@>@;
		}
#endif

@
@<Cases for |do_like| (C)@>=
{
if (cat1==stmt)
	if(cat2==for_like)
		{
		cat2 = while_do;
		SQUASH(pp, 1, do_like, PLUS 2, 191);
		}
	else if(cat2==expr && cat3==semi)
		{ /* ``|do {} while(flag);|'' */
		b_app1(pp); // ``\&{do}''
		indent_force;
		   b_app1(pp+1); // stmt 
		b_app(outdent);
		b_app(force);
		b_app2(pp+2); // ``\&{while}\dots''
		REDUCE(pp,4,stmt,-1,190);
		}
	}

@
@<CASES for |while_do| (C)@>=
#if FCN_CALLS
	C_wh_do();
#else
	@<Cases for |while_do| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_wh_do(VOID)
		{
		@<Cases for |while_do| (C)@>@;
		}
#endif

@
@<Cases for |while_do| (C)@>=
{
b_app1(pp);
@<Append thinspace@>;
REDUCE(pp, 1, expr, 0, 192);
}

@ Identifiers that are |for_like| must in normal usage be followed by a
parenthesized expression. However, since they might be used in isolation in
a macro argument, we allow a default possibility.

@<CASES for |for_like| (C)@>=
#if FCN_CALLS
	C_for_like();
#else
	@<Cases for |for_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_for_like(VOID)
		{
		@<Cases for |for_like| (C)@>@;
		}
#endif

@
@<Cases for |for_like| (C)@>=
{
if (cat1==expr)
	{ /* ``\&{for}\dots'' */
	b_app1(pp); @~ @<Append thinspace@>;  @~ b_app1(pp+1); 
	b_app(@' '); // Unnecessary?  (Space at end of |for| line?)

	if(cat2==semi)
		{ /* ``|for(;;);|'' */
		if(!auto_semi || (auto_semi && cat3==semi))
			{
			indent_force;
			b_app1(pp+2); // Semi on separate line.
			b_app(outdent);
			REDUCE(pp,3,stmt,-2,200); /*  The $-2$ is for the
\&{do} case. Also get here from Ratfor's \&{until}. */ 
			}
		else 
			REDUCE(pp,3,for_hd,0,2011); // Eat the |auto_semi|.
		}
	else 
		REDUCE(pp,2,for_hd,0,201); // Eat the arguments.
	}
else if(cat1 != lpar) 
	SQUASH(pp,1,expr,0,2010); // Default possiblity.
}

@ 
@<CASES for |for_hd| (C)@>=
#if FCN_CALLS
	C_forhd();
#else
	@<Cases for |for_hd| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_forhd(VOID)
		{
		@<Cases for |for_hd| (C)@>@;
		}
#endif

@
@<Cases for |for_hd| (C)@>=
{
if (cat1==stmt)
	{ /* ``|for(;;) x;|'' */
	b_app1(pp); 
	indent_force;
	   b_app1(pp+1);
	b_app(outdent);
	REDUCE(pp,2,stmt,-1,210);
	}
}

@ Begin an \&{if} statement by just absorbing the argument in parentheses.
We check to see if there's a comment coming up, and set a flag. We have to
do that here because |ignore_scrap| is digested before the big switch.

@<CASES for |if_like| (C)@>=
#if FCN_CALLS
	C_if_like();
#else
	@<Cases for |if_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_if_like(VOID)
		{
		@<Cases for |if_like| (C)@>@;
		}
#endif

@
@<Cases for |if_like| (C)@>=
{
if (cat1==lpar && cat2==expr && cat3==rpar) /* ``|if(x)|'' */
	{
	  b_app1(pp); @<Append thinspace@>;  b_app3(pp+1); 
#if(0)
	cmnt_after_IF = (cat4==ignore_scrap); /* Comment coming up? */
#endif
	REDUCE(pp,4,IF_like,0,220);
	}
}

@ We need a flag to tell us whether a comment (really, |ignore_scrap|)
follows an |if(x)| construction. If so, we'll put even simple statements on
the next line, properly indented. (Not working yet!)

@<Glob...@>=

@#if(0)
	IN_PROD cmnt_after_IF PSET(NO);
@#endif

@ Attach |stmt| to |if(x)|. Statements get indented on next line. 
If there's no \&{else} following, we're done.

@<CASES for |IF_like| (C)@>=
#if FCN_CALLS
	C_IF();
#else
	@<Cases for |IF_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_IF(VOID)
		{
		@<Cases for |IF_like| (C)@>@;
		}
#endif

@
@<Cases for |IF_like| (C)@>=
{
if(cat1==stmt
	|| cat1==lbrace || cat1==if_like || cat1==for_like || cat1==do_like
		|| cat1==Rdo_like
#if(0)
 || cmnt_after_IF
#endif
		)
	SQUASH(pp,1,if_hd,0,230); // |if_hd| does the indenting.
#if(0)
else if(cat1==stmt) 
	{ /* Attach simple statement. */
	PP_PP(1,1);
	REDUCE(pp,2,IF_top,-1,231);
	}
#endif
}

@ The purpose here is to take a complete statement and indent it on the
next line. 
@<CASES for |if_hd| (C)@>=
#if FCN_CALLS
	C_if_hd();
#else
	@<Cases for |if_hd| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_if_hd(VOID)
		{
		@<Cases for |if_hd| (C)@>@;
		}
#endif

@
@<Cases for |if_hd| (C)@>=
{
if (cat1==stmt) /* ``|if(x) {}|'' */
	{
	b_app1(pp); /* ``|if(x)|'' */
	indent_force;
	 b_app1(pp+1); /* ``|{}|'' */
	b_app(outdent);
	REDUCE(pp,2,IF_top,-1,233);
	}
else if(cat1==IF_top && cat2==else_like) 
	SQUASH(pp,1,if_hd,2,234);
}

@
@<CASES for |else_hd| (C)@>=
#if FCN_CALLS
	C_els_hd();
#else
	@<Cases for |else_hd| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_els_hd(VOID)
		{
		@<Cases for |else_hd| (C)@>@;
		}
#endif

@
@<Cases for |else_hd| (C)@>=
{
if (cat1==stmt) /* ``|if(x) {}|'' */
	{
	b_app1(pp); /* ``|if(x)|'' */
	indent_force;
	 b_app1(pp+1); /* ``|{}|'' */
	b_app(outdent);
	REDUCE(pp,2,ELSE_like,-1,241);
	}
}

@ 
@<CASES for |else_like| (C)@>=
#if FCN_CALLS
	C_else();
#else
	@<Cases for |else_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_else(VOID)
		{
		@<Cases for |else_like| (C)@>@;
		}
#endif

@
@<Cases for |else_like| (C)@>=
{
if(cat1==if_like) /* ``|else if|'' */
	{
	PP_PP(1,1);
	REDUCE(pp,2,if_like,0,235);
	}
else if(cat1==stmt || cat1==lbrace || cat1==for_like || cat1==do_like)
	SQUASH(pp,1,else_hd,0,236); /* ``|else {}|'' */
#if 0 /* The following puts simple statement on same line. */
else if(cat1==stmt) /* ``|else z;|'' */
	{
	PP_PP(1,1);
	REDUCE(pp,2,ELSE_like,-1,237);
	}
#endif
}

@ This is commented out above.
@<CASES for |ELSE_like| (C)@>=
#if FCN_CALLS
	C_ELS();
#else
	@<Cases for |ELSE_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_ELS(VOID)
		{
		@<Cases for |ELSE_like| (C)@>@;
		}
#endif

@
@<Cases for |ELSE_like| (C)@>=

@
@<CASES for |IF_top| (C)@>=
#if FCN_CALLS
	C_IF_top();
#else
	@<Cases for |IF_top| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_IF_top(VOID)
		{
		@<Cases for |IF_top| (C)@>@;
		}
#endif

@
@<Cases for |IF_top| (C)@>=
{
if(cat1==else_like || cat1==else_hd || cat1==space) 
	SQUASH(pp,1,IF_top,1,242); /* Expand ahead. */ 
else if(cat1==IF_top)
	{
	b_app1(pp); /* \&{if}\dots */
	b_app(force);
	b_app1(pp+1); /* \&{else if}\dots */
	REDUCE(pp,2,IF_top,-1,238);
	}
else if(cat1==ELSE_like)
	{
	b_app1(pp); /* \&{if} */
	b_app(force);
	b_app1(pp+1); /* \&{else} */
	REDUCE(pp,2,stmt,-1,239);
	}
else if(cat1==IF_like && (cat2==expr || cat2==stmt))
	SQUASH(pp,1,IF_top,1,241);
else 
	SQUASH(pp,1,stmt,-1,240);
}

@ 
@<CASES for |stmt| (C)@>=
#if FCN_CALLS
	C_stmt();
#else
	@<Cases for |stmt| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_stmt(VOID)
		{
		@<Cases for |stmt| (C)@>@;
		}
#endif

@
@<Cases for |stmt| (C)@>=
{
if (cat1==stmt || (Cpp && cat1==decl)) /* ``|x; y;|'' */
	{
	b_app1(pp); 

	@<Append a |force| or thinspace@>@;

	b_app1(pp+1); 

	REDUCE(pp,2,stmt,-1,250);
	}
else if (cat1==functn)
	{
	b_app1(pp); @~ b_app(big_force);
	b_app1(pp+1);
	REDUCE(pp,2,stmt,-1,251);
	}
}

@ 
@<CASES for |case_like| (C)@>=
#if FCN_CALLS
	C_case_like();
#else
	@<Cases for |case_like| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_case_like(VOID)
		{
		@<Cases for |case_like| (C)@>@;
		}
#endif

@
@<Cases for |case_like| (C)@>=
{
if (cat1==semi) 
	SQUASH(pp,2,stmt,-1,260); /* |return;| */
else if (cat1==colon) 
	SQUASH(pp,2,tag,-1,261); /* |default:| or \Cpp: |@c++ public:| */
else if (cat1==expr) 
	{
	  if (cat2==semi) /* |return x;| */
		{
		PP_PP(1,2);
		REDUCE(pp,3,stmt,-1,262);
		}
	  else if (cat2==colon)  /* |case one:| */
		{
		PP_PP(1,2);
		REDUCE(pp,3,tag,-1,263);
		}
	}
else if(cat1==int_like)
	{ /* \Cpp: |@c++ public base| */
	PP_PP(1,1);
	REDUCE(pp,2,int_like,-2,264);
	}
}

@ 
@<CASES for |tag| (C)@>=
#if FCN_CALLS
	C_tag();
#else
	@<Cases for |tag| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_tag(VOID)
		{
		@<Cases for |tag| (C)@>@;
		}
#endif

@
@<Cases for |tag| (C)@>=
{
if (cat1==tag) /* ``|case one: case two:|'' */
	{
	  b_app1(pp); 
	  b_app(force);
	  b_app(backup);
	  b_app1(pp+1); REDUCE(pp,2,tag,-1,270);
	}
else if (cat1==stmt || cat1==decl || cat1==functn) /* ``|case one:
		break;|'' or \Cpp: ``|@c++ public: int constructor();|''  */
	{
	b_app(big_force); 
	b_app(backup); @~ b_app1(pp); @~ b_app(force);
	b_app1(pp+1); 
	REDUCE(pp,2,cat1,-1,271);
	}
}

@ To help distinguish a null statement, we preface the semicolon by a space.
@<CASES for |semi| (C)@>=
#if FCN_CALLS
	C_semi();
#else
	@<Cases for |semi| (C)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_semi(VOID)
		{
		@<Cases for |semi| (C)@>@;
		}
#endif

@
@<Cases for |semi| (C)@>=
{
b_app(@' '); @~ b_app1(pp); 
REDUCE(pp,1,stmt,-1,280);
}

@
@<CASES for |template| (C++)@>=
#if FCN_CALLS
	C_template();
#else
	@<Cases for |template| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_template(VOID)
		{
		@<Cases for |template| (C++)@>@;
		}
#endif

@
@<Cases for |template| (C++)@>=
{
if(cat1 == langle)
	SQUASH(pp, 1, template, PLUS 1, 6000);
else if(cat1 == tlist)
	{
	PP_PP(1, 1); @~ b_app(force);
	REDUCE(pp, 2, int_like, 0, 6001);
	}
}

@
@<CASES for |langle| (C++)@>=
#if FCN_CALLS
	C_langle();
#else
	@<Cases for |langle| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_langle(VOID)
		{
		@<Cases for |langle| (C++)@>@;
		}
#endif

@ If the |langle| isn't grabbed up by |template|, it's just an ordinary
binary operator.
@<Cases for |langle| (C++)@>=
{
if((pp-1)->cat == template || (pp-1)->cat == int_like || (pp-1)->cat ==
		struct_like) 
	{
	b_app(@'\\');
	APP_STR("WLA "); // \.{\\WLA} $\equiv$ `$\WLA$'.
	REDUCE(pp, 1, tstart, 0, 6050); // Begining of template parameter list.
	}
else if(cat1 == decl_hd && cat2 == rangle)
	{
	b_app(@'\\');
	APP_STR("WLA ");
	b_app1(pp+1);
	b_app(@'\\');
	APP_STR("WRA ");
	REDUCE(pp, 3, expr, -1, 6053); // |@c++ f<int, int>|.
	}
else if(cat1 == int_like)
	SQUASH(pp, 1, langle, PLUS 1, 6054); // |@c++ f<int>|.
else
	SQUASH(pp, 1, binop, -1, 6051);
}

@
@<CASES for |rangle| (C++)@>=
#if FCN_CALLS
	C_rangle();
#else
	@<Cases for |rangle| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_rangle(VOID)
		{
		@<Cases for |rangle| (C++)@>@;
		}
#endif

@ If the |rangle| isn't grabbed up by |template|, it's just an ordinary
binary operator.
@<Cases for |rangle| (C++)@>=
{
if((pp-1)->cat == decl_hd)
	SQUASH(pp, 1, rangle, -2, 6055);
else
	SQUASH(pp, 1, binop, -1, 6052);
}

@
@<CASES for |tstart| (C++)@>=
#if FCN_CALLS
	C_tstart();
#else
	@<Cases for |tstart| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_tstart(VOID)
		{
		@<Cases for |tstart| (C++)@>@;
		}
#endif

@
@<Cases for |tstart| (C++)@>=
{
if(cat2 == rangle && (cat1==int_like || cat1==decl_hd || cat1==expr 
		|| cat1==unorbinop))
	{
	b_app2(pp);
	b_app(@'\\');
	APP_STR("WRA "); // Closing of template.
	OUTDENT;
	REDUCE(pp, 3, tlist, -1, 6060);
	}
}

@
@<CASES for |tlist| (C++)@>=
#if FCN_CALLS
	C_tlist();
#else
	@<Cases for |tlist| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_tlist(VOID)
		{
		@<Cases for |tlist| (C++)@>@;
		}
#endif

@
@<Cases for |tlist| (C++)@>=

@
@<CASES for |namespace| (C++)@>=
#if FCN_CALLS
	C_namespace();
#else
	@<Cases for |namespace| (C++)@>@;
#endif

@
@<Part 1@>=
#if FCN_CALLS
	@[SRTN C_namespace(VOID)
		{
		@<Cases for |namespace| (C++)@>@;
		}
#endif

@
@<Cases for |namespace| (C++)@>=
{
if(cat1==expr || cat1==int_like)
	{ /* \Cpp: |@c++ namespace A| */
	make_underlined(pp+1); @~ make_reserved(pp+1);

	PP_PP(1,1);

	REDUCE(pp, 2, fn_decl, 0, 7901);
	}
else if(cat1==lbrace)
	SQUASH(pp, 1, fn_decl, 0, 7902); // |@c++ namespace{}|
}

@
@<Glob...@>=

IN_PROD boolean forward_exp PSET(NO);

@* PRODUCTIONS for RATFOR and FORTRAN.
Note that in some cases we use the C~rules for \RATFOR\ as well.

@<Part 2@>=@[

SRTN 
R_productions(VOID)
{
switch (pp->cat) 
    {
    case ignore_scrap:  @<CASES for |ignore_scrap| (C)@>@; break;
    case expr: @<CASES for |expr| (R)@>@; @~ break;
    case key_wd: @<CASES for |key_wd| (R)@>@; @~ break;
    case exp_op: @<CASES for |exp_op| (R)@>@; @~ break;
    case _EXPR: @<CASES for |_EXPR| (C)@>@; @~ break;
    case _EXPR_: @<CASES for |_EXPR_| (C)@>@; @~ break;
    case EXPR_: @<CASES for |EXPR_| (C)@>@; @~ break;
    case lpar: @<CASES for |lpar| (R)@>@; @~ break;
    case lbracket: @<CASES for |lbracket| (C)@>@; @~ break;
    case rbracket: @<CASES for |rbracket| (C)@>@; @~ break;
    case unop: @<CASES for |unop| (R)@>@; @~ break;
    case UNOP: @<CASES for |UNOP| (C)@>@; @~ break;
    case unorbinop: @<CASES for |unorbinop| (R)@>@; @~ break;
    case binop: @<CASES for |binop| (R)@>@; @~ break;
    case BINOP: @<CASES for |BINOP| (C)@>@; @~ break;
    case slash_like: @<CASES for |slash_like| (R)@>@; @~ break;
    case colon: @<CASES for |colon| (R)@>@; @~ break;
    case program_like: @<CASES for |program_like| (R)@>@; @~ break;
    case struct_like: @<CASES for |struct_like| (R)@>@; @~ break;
    case struct_hd: @<CASES for |struct_hd| (R)@>@; @~ break;
    case op_like: @<CASES for |op_like| (R)@>@; @~ break;	
    case proc_like: @<CASES for |proc_like| (R)@>@; @~ break;
    case private_like: @<CASES for |private_like| (R)@>@; @~ break;
    case int_like: @<CASES for |int_like| (R)@>@; @~ break;
    case decl_hd: @<CASES for |decl_hd| (R)@>@; @~ break;
    case decl: @<CASES for |decl| (R)@>@; @~ break;
    case fn_decl: @<CASES for |fn_decl| (C)@>@; @~ break;
    case fcn_hd: @<CASES for |fcn_hd| (R)@>@; @~ break;
    case functn: @<CASES for |functn| (R)@>@; @~ break;
    case lbrace: @<CASES for |lbrace| (R)@>@; @~ break;
    case do_like: @<CASES for |do_like| (R)@>@; @~ break;
    case until_like: @<CASES for |until_like| (R)@>@; @~ break;
    case Rdo_like: @<CASES for |Rdo_like| (R)@>@; @~ break;
    case if_like: @<CASES for |if_like| (R)@>@; @~ break;
    case IF_like: @<CASES for |IF_like| (C)@>@; @~ break; /* The C form serves
both. */
    case IF_top: @<CASES for |IF_top| (C)@>@; @~ break;
    case endif_like: @<CASES for |endif_like| (R)@>@; @~ break;
    case end_like: @<CASES for |end_like| (R)@>@; @~ break;
    case END_like: @<CASES for |END_like| (R)@>@; @~ break;
    case go_like: @<CASES for |go_like| (R)@>@; @~ break;
    case for_like: @<CASES for |for_like| (C)@>@; @~ break;
    case for_hd: @<CASES for |for_hd| (C)@>@; @~ break; /* C serves both. */
    case else_like: @<CASES for |else_like| (R)@>@; @~ break;
    case else_hd: @<CASES for |else_hd| (C)@>@; @~ break;
@#if(0)
    case ELSE_like: @<CASES for |ELSE_like| (C)@>@; @~ break; /* C serves
both. */ 
@#endif
    case if_hd: @<CASES for |if_hd| (R)@>@; @~ break;
    case CASE_like: @<CASES for |CASE_like| (R)@>@; @~ break;
    case case_like: @<CASES for |case_like| (R)@>@; @~ break;
    case stmt: @<CASES for |stmt| (R)@>@; @~ break;
    case tag: @<CASES for |tag| (R)@>@; @~ break;
    case label: @<CASES for |label| (R)@>@; @~ break;
    case semi: @<CASES for |semi| (R)@>@; @~ break;

    case common_like: @<CASES for |common_like| (R)@>@; @~ break;
    case common_hd: @<CASES for |common_hd| (R)@>@; @~ break;
    case read_like: @<CASES for |read_like| (R)@>@; @~ break;
    case read_hd: @<CASES for |read_hd| (R)@>@; @~ break;
    case entry_like: @<CASES for |entry_like| (R)@>@; @~ break;
    case implicit_like: @<CASES for |implicit_like| (R)@>@; @~ break;
    case implicit_hd: @<CASES for |implicit_hd| (R)@>@; @~ break;
    case assign_like: @<CASES for |assign_like| (R)@>@; @~ break;
    case define_like: @<CASES for |define_like| (R)@>@; @~ break;
    case built_in: @<CASES for |built_in| (R)@>@; @~ break;
    case no_order: @<CASES for |no_order| (R)@>@; @~ break;
    case newline: @<CASES for |newline| (R)@>@; @~ break;
    case COMMA: @<CASES for |COMMA| (C)@>@; @~ break;

  }
}

@
@<CASES for |expr| (R)@>=
#if FCN_CALLS
	R_expr();
#else
	@<Cases for |expr| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_expr(VOID)
		{
		@<Cases for |expr| (R)@>@;
		}
#endif

@
@<Cases for |expr| (R)@>=
{
if (cat1==unop) SQUASH(pp,2,expr,-2,2);
else if ((cat1==binop || cat1==unorbinop || cat1==colon) && cat2==expr)
/* Here we have to worry about constructions such as `|@r #:0|'. */
	if(cat1==colon && (*pp->trans)[1]==(sixteen_bits)@'#')
		{
		b_app1(pp);
		APP_STR("\\Colon");
		b_app1(pp+2);
		REDUCE(pp,3,expr,-2,3333);
		}
	else if(cat1==binop && **(pp+1)->trans == (sixteen_bits)@'/')
		SQUASH(pp, 1, expr, PLUS 1, 3334);
	else 
		SQUASH(pp,3,expr,-2,3); /* ``|@r x = y|'' or ``|@r x + y|'' or
				``|@r dimension a(0:100)|'' */ 
else if (cat1==comma && (cat2==expr || cat2==end_like))  
	{ /* Note |end_like|; keyword in I/O. */
	  b_app2(pp);
	OPT9;
	b_app1(pp+2); REDUCE(pp,3,expr,-2,4);
	}
else if (cat1==expr)  SQUASH(pp,2,expr,-2,5); /* ``|@r f(x)|'' */
else if (cat1==semi) SQUASH(pp,2,stmt,-2,6); /* ``|@r x=y;|'' */
else if (cat1==colon && cat2==unorbinop &&
		(cat3==rpar || (active_brackets && cat3==rbracket)))
	SQUASH(pp,3,expr,-2,299);  /* ``|@r 0:*|'' */
else if (cat1==colon && cat2!= lpar) /* label */
	{
	  make_underlined (pp);  SQUASH(pp,2,tag,0,7);
	}
else if (cat1==comma && cat2==int_like) /* For macro usage. */
	{
	  b_app2(pp);
	OPT9;
	b_app1(pp+2); REDUCE(pp,3,int_like,-2,4444);
	}
}

@ This route may be unused now.
@<CASES for |key_wd| (R)@>=
#if FCN_CALLS
	R_key_wd();
#else
	@<Cases for |key_wd| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_key_wd(VOID)
		{
		@<Cases for |key_wd| (R)@>@;
		}
#endif

@
@<Cases for |key_wd| (R)@>=
{
SQUASH(pp,1,expr,-2,4445);
}
 
@ Exponentiation. We have to watch out for constructions like \.{x\^(a+b)},
which must be typeset |@r x^(a+b)|, and also the construction
\.{x\^y(z)}, which must be typeset |@r x^y(z)|.

@<CASES for |exp_op| (R)@>=
#if FCN_CALLS
	R_exp_op();
#else
	@<Cases for |exp_op| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_exp_op(VOID)
		{
		@<Cases for |exp_op| (R)@>@;
		}
#endif

@
@<Cases for |exp_op| (R)@>=
{
if(cat1==lpar) SQUASH(pp,1,exp_op,PLUS 1,2995); /* ``|@r x^(a+b)|'' */
else if(cat1==expr)
	if(cat2==lpar) SQUASH(pp,1,exp_op,PLUS 2,2996); /* Expand array
argument. */
	else if(cat2==expr) SQUASH(pp,1,exp_op,PLUS 1,2997); /* The expr is
the result of expanding the array argument. */
	else
		{ /* It's now of the form |@r x^expr|; insert braces around
argument so \TeX\ understands. */ 
		b_app1(pp);
		b_app(@'{'); @~ b_app1(pp+1); @~ b_app(@'}');
		REDUCE(pp,2,expr,-1,2998);
		}
}

@ Keep track of where we are in the nested hierarchy of \Fortran\ program
units; for helping with |@r9 contains|.
@<Glob...@>=

IN_PROD int fcn_level PSET(0);

@ When we recognize the beginning of a program unit, we increment a counter.
@<CASES for |program_like| (R)@>=
#if FCN_CALLS
	R_program_like();
#else
	@<Cases for |program_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_program_like(VOID)
		{
		@<Cases for |program_like| (R)@>@;
		}
#endif

@
@<Cases for |program_like| (R)@>=

if(is_FORTRAN_(language))
	{
	if(cat1==expr && cat2==semi)
		{
		fcn_level++;
		b_app1(pp); @~ b_app(@' ');
		b_app(indent); @~ b_app2(pp+1); @~ b_app(outdent);
		defined_at(make_underlined(pp+1));
		REDUCE(pp,3,fcn_hd,-1,2999);
		}
	else if(cat1==no_order)
		{ // |@r block data|
		PP_PP(1,1);
		REDUCE(pp,2,program_like,0,2997);
		}
	else if(cat1==semi)
		{ // |@r block data;|
		fcn_level++;
		b_app1(pp);
		REDUCE(pp,2,fcn_hd,-1,2996);
		}
	else if(cat1==proc_like)
		{ // |@n9 module procedure|
		PP_PP(1, 1);
		REDUCE(pp, 2, int_like, 0, 2887);
		}
	}
else
	{
	fcn_level++;
	SQUASH(pp,1,int_like,-1,2998);
	}

@
@<CASES for |fcn_hd| (R)@>=
#if FCN_CALLS
	R_fcn_hd();
#else
	@<Cases for |fcn_hd| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_fcn_hd(VOID)
		{
		@<Cases for |fcn_hd| (R)@>@;
		}
#endif

@
@<Cases for |fcn_hd| (R)@>=
{
if(cat1==END_stmt)
	{
	b_app1(pp); @~ b_app(force);
	b_app1(pp+1);
	REDUCE(pp,2,functn,-1,7172);
	}
else if(cat1==stmt && cat2==END_stmt)
	{
	b_app1(pp); @~ b_app(force);
	b_app(indent);
		b_app1(pp+1); /* Body */

		if(fcn_level==0)
			{
			if(containing) 
				b_app(big_force);

			while(containing)
				{
#if(0)
				b_app(outdent);
#endif
				containing--;
				}
			}

	b_app(outdent);
	b_app(force);

	b_app1(pp+2);
	REDUCE(pp,3,functn,-1,7171);
	}
}

@ The |@r9 module procedure| statement doesn't have an |end| statement.
@<CASES for |proc_like| (R)@>=
#if FCN_CALLS
	R_proc_like();
#else
	@<Cases for |proc_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_proc_like(VOID)
		{
		@<Cases for |proc_like| (R)@>@;
		}
#endif

@
@<Cases for |proc_like| (R)@>=

if(fcn_level == 0) {/* Error message */}
else fcn_level--;

SQUASH(pp,1,int_like,-1,2989);

@ Here we handle Fortran--90's |@r9 private|, |@r9 public|, and |@r9
sequence| statements.
@<CASES for |private_like| (R)@>=
#if FCN_CALLS
	R_private_like();
#else
	@<Cases for |private_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_private_like(VOID)
		{
		@<Cases for |private_like| (R)@>@;
		}
#endif

@
@<Cases for |private_like| (R)@>=
{
if(cat1 == (eight_bits)(language==FORTRAN_90 ? semi : colon) )
	{
	app(backup);
	b_app2(pp);
	REDUCE(pp,2,decl,-1,2988);
	}
else SQUASH(pp,1,int_like,-2,2987);
}

@ 
@<CASES for |int_like| (R)@>=
#if FCN_CALLS
	R_int_like();
#else
	@<Cases for |int_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_int_like(VOID)
		{
		@<Cases for |int_like| (R)@>@;
		}
#endif

@
@<Cases for |int_like| (R)@>=
{
if(cat1==lbrace)
	{
	b_app(indent);
	b_app1(pp);
	REDUCE(pp,1,decl_hd,0,940); /* ``|@r block data{}|'' */
	}
else if(cat1==unorbinop && cat2==expr)
	{  /* ``|@r character*(*)|'' */
	b_app1(pp);
	b_app(@'{'); @~ b_app2(pp+1); @~ b_app(@'}');
	REDUCE(pp,3,int_like,-1,941);
	}
else if (cat1==int_like || cat1==no_order) /* ``|@r double precision|'' or
		F88 things like ``|@r integer, pointer|''; |no_order| takes
		care of \&{data} in |@r block data|. */ 
	{
	PP_PP(1,1);
	REDUCE(pp,2,cat0,0,40);
	}
else if(cat1==comma) 
	SQUASH(pp,2,int_like,0,9001); /* F88: ``|@r logical,|'' */
else if(cat1==binop) 
	{ /* F88: ``|@r integer :: i|'' */
	b_app2(pp);
	b_app(indent);
	REDUCE(pp,2,decl_hd,0,9002);
	}
else if(cat1==slashes)
	{
	b_app1(pp);
	b_app(@' ');
	b_app(indent);
	REDUCE(pp,1,decl_hd,0,9002);
	}
else if(cat1==expr && **indirect((pp+1)->trans)==@'(')
	{
	b_app1(pp); @~ @<Append thinspace@>@; @~ b_app1(pp+1);
	REDUCE(pp,2,int_like,0,9003); /* ``|@r integer (KIND=4)|'' */
	}
else if (cat1==expr || cat1==semi)
	 {
	  b_app1(pp); 

	if(cat1 != semi) app(@'~'); 

	b_app(indent); /* Start long declaration. */

	 REDUCE(pp,1,decl_hd,0,41); /* JAK: -1 changed to 0 */
	}
else if(cat1 == rbrace)
	SQUASH(pp, 1, decl, -1, 411); 
		/* See \.{ratfor} example |@r9 module procedure element;|. */
}

@
@<CASES for |struct_like| (R)@>=
#if FCN_CALLS
	R_struct_like();
#else
	@<Cases for |struct_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_struct_like(VOID)
		{
		@<Cases for |struct_like| (R)@>@;
		}
#endif

@
@<Cases for |struct_like| (R)@>=
if(cat1==lpar) 
	{
	b_app1(pp);
#if(0)
	@<Append thinspace@>@; /* Looks nicer with a bit of space. */
#endif
	REDUCE(pp,1,int_like,0,9075); /* \FORTRAN-88 declaration:
``|@r9 type(triangle)|''. */
	}
else if(cat1==comma && cat2==int_like)
	{ /* ``|@r9 type, private|'' */
	b_app2(pp); @~ b_app(@' '); @~ b_app1(pp+2);
	REDUCE(pp,3,struct_like,0,90750);
	}
else if(cat1==binop && **(pp+1)->trans != (sixteen_bits)@'/') 
	SQUASH(pp,2,struct_like,0,90751); /* ``|@r9 type, public::|''  The
		|!=| precluded the VAX |@n9 structure /stuff/| declaration. */
else if(cat1==expr || cat1==slashes || cat1==struct_like)
	{ /* ``|@r9 type person|'', ``|@r9 type /vaxstruct/|'', or ``|@r9
			interface operator|'' */ 
	PP_PP(1,1);
	make_underlined(pp+1);
	REDUCE(pp,2,language==FORTRAN_90 ? struct_hd : struct_like,0,9076);
	}
else if(cat1==semi) 
	SQUASH(pp,1,struct_hd,0,9077); /* |@r9 interface| */
else if (cat1==lbrace)  /* ``|@r9 type person {integer i;};|'' */
	{
	b_app1(pp); @~ indent_force;	
	b_app1(pp+1); REDUCE(pp,2,struct_hd,0,100);
	}

@
@<CASES for |struct_hd| (R)@>=
#if FCN_CALLS
	R_str_hd();
#else
	@<Cases for |struct_hd| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_str_hd(VOID)
		{
		@<Cases for |struct_hd| (R)@>@;
		}
#endif

@
@<Cases for |struct_hd| (R)@>=
if(is_FORTRAN_(language))
 {
if(cat1==expr)
	{
	b_app1(pp); @~ @<Append thinspace@>@; b_app1(pp+1); /* ``|@r9
interface operator(.not.)|'' */
	REDUCE(pp,2,struct_hd,0,90760);
	}
else if(cat1==semi)
	{
	fcn_level++;
	b_app2(pp);
	b_app(indent);
	REDUCE(pp,2,struct_hd,0,90770);
	}
else if(cat1==decl || cat1==functn)
	{
	b_app1(pp);
	b_app(force);
	b_app1(pp+1);
	REDUCE(pp,2,struct_hd,0,9078);
	}
else if(cat1==END_stmt)
	{
	b_app1(pp);
	b_app(outdent);
	b_app(force);
	b_app1(pp+1);
	REDUCE(pp,2,decl,-1,9079);
	}
 }
else @<Cases for |struct_hd| (C)@>@;

@
@<CASES for |op_like| (R)@>=
#if FCN_CALLS
	R_op_like();
#else
	@<Cases for |op_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_op_like(VOID)
		{
		@<Cases for |op_like| (R)@>@;
		}
#endif

@
@<Cases for |op_like| (R)@>=
@B
short n;

if(cat1==lpar)
	{ /* We'll search for the obligatory right paren that terminates
the list. */
	scrap_pointer q;
	int k; /* Counter. */

/* If the paren is missing, we could end up appending the entire rest of
the code, so we limit the search. */
	for(q=pp+2; q <= scrp_ptr && q-pp < MAX_OP_TOKENS; q++)
		if(q->cat == rpar) break;

	n = (q->cat == rpar) ? PTR_DIFF(short, q, pp) : 0;

	if(n > 0)
		{
		b_app1(pp); @~ b_app(@' '); /* |@r9 operator| */
		b_app1(pp+1); /* Left paren. */
		b_app(@'{');
		APP_STR("\\optrue");

		for(k=2; k<n; k++)
			b_app1(pp+k);

		APP_STR("\\opfalse"); /* We need this here in case we
encounter an operator that \FWEAVE\ doesn't know how to overload. */
		b_app(@'}');
		b_app1(pp+k);

		REDUCE(pp,n+1,expr,-2,6667);
		}
	}
}
	
@ 
@<CASES for |decl_hd| (R)@>=
#if FCN_CALLS
	R_dcl_hd();
#else
	@<Cases for |decl_hd| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_dcl_hd(VOID)
		{
		@<Cases for |decl_hd| (R)@>@;
		}
#endif

@
@<Cases for |decl_hd| (R)@>=
if (cat1==comma)
	{ /* ``|@r integer i,j|'' */
	  b_app2(pp); b_app(@' '); REDUCE(pp,2,decl_hd,0,54);
	}
else if (cat1==expr)
	{
	make_underlined(pp+1);

	if(**(pp+2)->trans == (sixteen_bits)@'=') 
		{ // Initialization coming up.
		SQUASH(pp,1,decl_hd,PLUS 1,55);
		}
	else
		{
		SQUASH(pp,2,decl_hd,0,56); 
		}
	}
else if(cat1==slashes)
	{  /* |@r integer i/1/| */
	SQUASH(pp,2,decl_hd,0,57);
	}
@#if 0
else if(cat1==binop && cat2==expr && (cat3==comma || cat3==semi))
	{
	PP_PP(1,2);
	REDUCE(pp,3,decl_hd,-1,5660); /* Initialization */
	}
@#endif
else if (cat1==lbrace || cat1==int_like || cat1==implicit_like) 
	/* |@r subroutine f {}| or |@r function f(x) real x;| or |@r
program main implicit none;|  */
	{
	b_app1(pp);
	b_app(outdent); /* Turn off |indent|. */
	defined_at(FIRST_ID(pp));
	REDUCE(pp,1,fn_decl,0,58);
	}
else if (cat1==semi && (!auto_semi || (auto_semi && cat2 != lbrace))) 
	{
	b_app2(pp);
	b_app(outdent); /* Finish long declaration. */
	REDUCE(pp,2,
  	  (eight_bits)(intermingle ? (intermingle=NO,ignore_scrap) : decl),
		-1,59); 
	}
else if(cat1==built_in)
	{ /* |@r9 use a, only| */
	PP_PP(1,1);
	REDUCE(pp,2,decl_hd,0,5901);
	}
#if(0)
else if(cat1==lpar && cat2==expr) make_underlined(pp+2); /* For
						|$decl_hd|. */
#endif

@ 
@<CASES for |decl| (R)@>=
#if FCN_CALLS
	R_decl();
#else
	@<Cases for |decl| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_decl(VOID)
		{
		@<Cases for |decl| (R)@>@;
		}
#endif

@
@<Cases for |decl| (R)@>=
if(is_FORTRAN_(language) && cat1==END_like) SQUASH(pp,1,stmt,-1,960); 
		/* `` |@r program main; end;|'' */
else if (cat1==decl) 
	{
	  b_app1(pp); @~ b_app(force); 
	b_app1(pp+1);
	  REDUCE(pp,2,decl,-1,60);
	}
else if (cat1==stmt || cat1==functn) 
	{
	  b_app1(pp); @~ b_app(big_force); 
	  b_app1(pp+1); REDUCE(pp,2,cat1,-1,61);
	}

@ |@r subroutine f1{} subroutine f2{}|.
@<CASES for |functn| (R)@>=
#if FCN_CALLS
	R_functn();
#else
	@<Cases for |functn| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_functn(VOID)
		{
		@<Cases for |functn| (R)@>@;
		}
#endif

@
@<Cases for |functn| (R)@>=

if (cat1==functn || (is_RATFOR_(language) && (cat1==decl || cat1==stmt)))
	 {
	b_app1(pp); @~ b_app(big_force); 
	b_app1(pp+1); REDUCE(pp,2,cat1,0,80);
	}
else if(free_Fortran && cat1==semi)
	{ /* Handle possible auto-inserted pseudo-semi after function. */
	b_app2(pp);
	REDUCE(pp, 2, functn, 0, 8088);
	}
#if(0)
else if(cat1==END_like) 
	{
	b_app1(pp);
	REDUCE(pp,1,stmt,-1,9050);
	}
#endif

@ 
@<CASES for |lpar| (R)@>=
#if FCN_CALLS
	R_lpar();
#else
	@<Cases for |lpar| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_lpar(VOID)
		{
		@<Cases for |lpar| (R)@>@;
		}
#endif

@
@<Cases for |lpar| (R)@>=

if (cat1==expr && cat2==rpar) 
	SQUASH(pp,3,expr,-2,120); /* ``|@r (x)|'' */
else if(cat1==expr && cat2==colon && cat3==rpar) /* ``|@r (lower:)|'' */
	{
	b_app3(pp); @~ @<Append thinspace@>; @~ b_app1(pp+3);
	REDUCE(pp,4,expr,-2,9120);
	}
else if(cat1==colon && cat2 != comma) /* ``|@r (:x)|''; watch out for
			deferred-shape-spec-lists.  */
	{
	b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
	REDUCE(pp,2,lpar,0,9121);
	}
else if (cat1==rpar) /* ``|@r ()|'' */
	{
	  b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
	  REDUCE(pp,2,expr,-2,121);
	}
else if (cat1==stmt) /* `` |@r for(x;y;z)|'' */
	{
	  b_app2(pp); b_app(@' '); REDUCE(pp,2,lpar,0,123);
	}

@ 
@<CASES for |colon| (R)@>=
#if FCN_CALLS
	R_colon();
#else
	@<Cases for |colon| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_colon(VOID)
		{
		@<Cases for |colon| (R)@>@;
		}
#endif

@
@<Cases for |colon| (R)@>=

if(cat1==expr || cat1==unorbinop) 
	SQUASH(pp,2,expr,-2,9500); /* ``|@r (:upper)|'' */
else if(cat1==comma && cat2==colon) 
	SQUASH(pp,3,colon,-2,9502);
	/* Deferred-shape-spec-list: |@n9 (:,:,:)|.
		|colon| used to be |expr| */
else 
	SQUASH(pp,1,expr,0,9501); /* |@r (:)| */

@ 
@<CASES for |lbrace| (R)@>=
#if FCN_CALLS
	R_lbrace();
#else
	@<Cases for |lbrace| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_lbrace(VOID)
		{
		@<Cases for |lbrace| (R)@>@;
		}
#endif

@
@<Cases for |lbrace| (R)@>=
if (cat1==rbrace) /* ``|@r {}|'' */
	{
	  b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1); 
	  REDUCE(pp,2,stmt,-2,130);
	}
else if ((cat1==stmt || cat1==decl) && cat2==rbrace)  /* ``|@r {x;}|'' */
	{
	  b_app(force);
	  b_app1(pp);  @~  b_app(force);
	  b_app1(pp+1); @~ b_app(force); 
	  b_app1(pp+2); 
	   REDUCE(pp,3,stmt,-2,131);
	}

@ 
@<CASES for |unop| (R)@>=
#if FCN_CALLS
	R_unop();
#else
	@<Cases for |unop| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_unop(VOID)
		{
		@<Cases for |unop| (R)@>@;
		}
#endif

@
@<Cases for |unop| (R)@>=

if (cat1==expr) SQUASH(pp,2,expr,-2,33); /* ``|@r !flag|'' */

@ 
@<CASES for |unorbinop| (R)@>=
#if FCN_CALLS
	R_unorbinop();
#else
	@<Cases for |unorbinop| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_unorbinop(VOID)
		{
		@<Cases for |unorbinop| (R)@>@;
		}
#endif

@
@<Cases for |unorbinop| (R)@>=

if (cat1==expr) /* ``|@r +1.0|'' */
	{
	  b_app(@'{'); @~ b_app1(pp); @~ b_app(@'}'); 
	b_app1(pp+1); 
	REDUCE(pp,2,expr,-2,140);
	}
else if(cat1==binop) 
	@<Reduce cases like |*=|@>@;
else if (cat1== comma || cat1==rpar) 
	SQUASH(pp,1,expr,-2,141); /* ``|@r *,|'' or ``|@r *)|'' */

@ 
@<Append thinspace@>=
{
b_app(@'\\'); @~ b_app(@',');
}

@ 
@<Append thickspace@>=
{
b_app(@'\\'); @~ b_app(@';');
}

@
@<CASES for |slash_like| (R)@>=
#if FCN_CALLS
	R_slash_like();
#else
	@<Cases for |slash_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_slash_like(VOID)
		{
		@<Cases for |slash_like| (R)@>@;
		}
#endif

@
@<Cases for |slash_like| (R)@>=
if(cat1==slash_like)
	{ // The slash already has braces around it (appended by \FWEAVE).ac
	b_app1(pp);
	@<Append thinspace@>;
	b_app1(pp+1);
	REDUCE(pp,2,slashes,-1,1801);
	}
else if(cat1==expr && cat2==slash_like)
	SQUASH(pp,3,slashes,-1,1802);

@ 
@<CASES for |binop| (R)@>=
#if FCN_CALLS
	R_binop();
#else
	@<Cases for |binop| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_binop(VOID)
		{
		@<Cases for |binop| (R)@>@;
		}
#endif

@
@<Cases for |binop| (R)@>=
{
sixteen_bits tok = **pp->trans;

if(cat1==binop) 
	{ /* ``|@r / /|'' */
	if(tok == (sixteen_bits)@'/')
		{
		if(**(pp+1)->trans == tok)
			@<Append empty slashes@>@;
		else
			{
			APP_STR("\\WSl");
			REDUCE(pp, 1, binop, -1, 1803);
			}
		}
	else 
		@<Reduce cases like |+=|@>@;
	}
else 
	{
	if(tok == (sixteen_bits)@'/')
		{
		if(cat1==expr && cat2==binop && **(pp+2)->trans == tok)
				@<Append full slashes@>@; // |@n common/dia/|
		else
			{
			APP_STR("\\WSl");
			REDUCE(pp, 1, binop, -1, 1804);
			}
		}
	}
}

@
@<Append empty slashes@>=
{
b_app(@'{');
b_app1(pp); @~ @<Append thinspace@>; @~ b_app1(pp+1);
b_app(@'}');
REDUCE(pp,2,slashes,-1,180);
}

@
@<Append full slashes@>=
{
#if 0
b_app(@'{');
b_app1(pp);	/* |'/'| */
b_app(@'}');
#endif

make_underlined(pp+1);	/* Index common block name. */
APP_STR("\\WCMN");
b_app1(pp+1); /* expr/common-block name */

#if 0
b_app(@'{');	
b_app1(pp+2); /* |'/'| */
b_app(@'}');
#endif

REDUCE(pp,3,slashes,-1,9181);
}

@ 
@<Glob...@>=

IN_PROD text_pointer label_text_ptr[50];

@ Follow translations until one gets down to the actual tokens.

@<Part 2@>=@[

text_pointer 
indirect FCN((t))
	text_pointer t C1("")@;
{
Token tok_value;

if(t==NULL) return t;

tok_value = **t;

if(tok_value <= tok_flag) return t;

if(tok_value > inner_tok_flag) tok_value -= (inner_tok_flag - tok_flag);

if(tok_value > tok_flag)
	do
		{
		Token tok_value0 = tok_value;

		t = tok_start + (int)(tok_value - tok_flag);
		tok_value = **t;

		if(tok_value == tok_value0) return t; /* Emergency return;
otherwise infinite loop. */
		}
	while(tok_value > tok_flag);

return t;
}

@ The following compares the texts of two translations, and is needed for
labeled loops in Fortran.
@<Part 2@>=@[
boolean 
compare_text FCN((t0,t1))
	text_pointer t0 C0("")@;
	text_pointer t1 C1("")@;
{
token_pointer p0,p0_end,p1;

if(t0==NULL || t1==NULL) return NO;

t0 = indirect(t0); t1 = indirect(t1);

p0 = *t0; @~ p0_end = *(t0+1);
p1 = *t1;

while(p0 < p0_end)
	{
	if(*p0 == @':') return YES; /* Ends label */
	if(*p0++ != *p1++) return NO;
	}

return YES;
}

@ Return the value of a token that may be buried deep in indirection chains.
@<Part 2@>=@[
sixteen_bits 
tok_val FCN((p))
	scrap_pointer p C1("")@;
{
sixteen_bits tok_value;

tok_value = **(p->trans);

if(tok_value > inner_tok_flag)
	tok_value -= (inner_tok_flag- tok_flag);

if(tok_value > tok_flag)
	do
		{
		tok_value = **(tok_start + (int)(tok_value - tok_flag)); 
		}
	while(tok_value > tok_flag);

return tok_value;
}

@ 
@<CASES for |Rdo_like| (R)@>=
#if FCN_CALLS
	R_Rdo_like();
#else
	@<Cases for |Rdo_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_Rdo_like(VOID)
		{
		@<Cases for |Rdo_like| (R)@>@;
		}
#endif

@
@<Cases for |Rdo_like| (R)@>=

if(is_FORTRAN_(language))
  {
  if(cat1==for_like)  /* \&{do} \&{while} */
	{
	PP_PP(1,1);
	REDUCE(pp,2,Rdo_like,0,9600);
	}
  else if(cat1==expr && ( (cat2==expr && cat3==binop) || cat2==if_like) )
	{ /* ``|@r do 10 i=@e|'' */
	label_text_ptr[indent_level] = (pp+1)->trans; /* Pointer to
			a |token_pointer|---namely, index into |tok_start|. */
	b_app1(pp); // |@n do|
	b_app(@' ');
	b_app1(pp+1);	 // Loop number.
	REDUCE(pp,2,Rdo_like,0,9601); /* Swallow only the loop number. */
	}
  else if(cat1==stmt) /* ``|@r do i=1,10;|'' */
	{
	loop_num[indent_level++] = ++max_loop_num;

	b_app1(pp); /* \&{do} */
	b_app(@' ');
	b_app1(pp+1); /* $i=1,10;$ */
	app_loop_num(max_loop_num);

	b_app(indent);
	REDUCE(pp,2,stmt,-2,9602);
	}
  }
/* \Ratfor. */
else if(cat1==stmt || (cat1==expr && cat2==lbrace)) /* ``|@r do i=1,10;|''
or ``|@r do i=1,10{|'' */
	{
	PP_PP(1,1);
	REDUCE(pp,2,for_hd,0,9603);
	}

@ The following flag handles the option |@r until| in a ``|@r
repeat{}until|'' construction.

@<Glob...@>=

IN_PROD boolean found_until PSET(NO);

@ We have to be slightly tricky here, because in ``|@r repeat{}until|'' the
\&{until} is optional. 
@<CASES for |do_like| (R)@>=
#if FCN_CALLS
	R_do_like();
#else
	@<Cases for |do_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_do_like(VOID)
		{
		@<Cases for |do_like| (R)@>@;
		}
#endif

@
@<Cases for |do_like| (R)@>=

if(cat1==stmt)
	{
	if(cat2==until_like) 
		{
		found_until = YES;
		SQUASH(pp,1,do_like,PLUS 2,9190); /* ``|@r repeat
{} until @e@;|''; expand the \&{until}. */
		}
	else 
		{
		  b_app1(pp); 
		  indent_force;
		   b_app1(pp+1);
		  b_app(outdent);
		  b_app(force);

		if(found_until && cat2==stmt) /* Get here by expanding the
\&{until}. */ 
			{ 
			found_until = NO;
			b_app1(pp+2); REDUCE(pp,3,stmt,-2,9191);
			}
		else REDUCE(pp,2,stmt,-2,9192); /* ``|@r repeat {}|'';
no bottom. */
		}
	}

@ Get here from above by expanding the |@r until|.
@<CASES for |until_like| (R)@>=
#if FCN_CALLS
	R_until_like();
#else
	@<Cases for |until_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_until_like(VOID)
		{
		@<Cases for |until_like| (R)@>@;
		}
#endif

@
@<Cases for |until_like| (R)@>=

SQUASH(pp,1,for_like,0,9195);

@ 
@<Glob...@>=

IN_PROD int indent_level PSET(0); // Indent level.
IN_PROD int loop_num[50], max_loop_num PSET(0);

@ 
@<CASES for |if_like| (R)@>=
#if FCN_CALLS
	R_if_like();
#else
	@<Cases for |if_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_if_like(VOID)
		{
		@<Cases for |if_like| (R)@>@;
		}
#endif

@
@<Cases for |if_like| (R)@>=

if(cat1==CASE_like)
	{
	PP_PP(1,1);	/* |@r9 select case| */
	REDUCE(pp,2,if_like,0,9196);
	}
else
if(is_FORTRAN_(language))
  {
 if(cat1==expr)
  {
  boolean if_form;

  if( (if_form=BOOLEAN(cat2==built_in && cat3==semi)) || cat2==semi) 
	{ /* ``|@n if(x) then;|''  or ``|@n where(x); |'' */ 
	short n; /* Number to append. Things are annoying because the |@n if|
and |@n where| statements aren't completely symmetrical. */

	loop_num[indent_level++] = ++max_loop_num;

	b_app1(pp);	/* \&{if} */
	@<Append thinspace@>;
	b_app1(pp+1); /* $(x)$ */
	b_app(@' ');
	
	if(if_form)
		{
		n = 4;
		b_app2(pp+2); /* \&{then}; */
		}
	else
		{ /* |@n where| */
		n = 3;
		b_app1(pp+2); /* semi */
		}

	app_loop_num(max_loop_num);
	b_app(indent);
	REDUCE(pp,n,stmt,-2,9800);
	}
  else if(cat2==stmt) /* ``|@n if(x) a=b;|'' */
	{
	b_app1(pp); /* \&{if} */
	@<Append thinspace@>;
	b_app1(pp+1); /* $(x)$ */
	app(@' ');
	b_app(cancel);
	b_app1(pp+2); /* Statement */
	REDUCE(pp,3,stmt,-2,9801);
	}
  else 
	{
	b_app1(pp);
	@<Append thinspace@>;
	b_app1(pp+1);
	REDUCE(pp,2,if_hd,0,9802);
	}
  }
 }
/* RATFOR\ */
else @<Cases for |if_like| (C)@>@;


@ Attach a comment with the loop number.

@<Part 2@>=@[

SRTN 
app_loop_num FCN((n))
	int n C1("Loop number.")@;
{
char loop_id[100];

if(!block_nums) return; // We're not supposed to number the blocks/loops.

sprintf(loop_id,"\\Wblock{%d}",n); /* Output the block number. */
@.\\Wc@>
APP_STR(loop_id);
}

@ For the |@r go| keyword, we just have to handle optional white space.
@<CASES for |go_like| (R)@>=
#if FCN_CALLS
	R_go_like();
#else
	@<Cases for |go_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_go_like(VOID)
		{
		@<Cases for |go_like| (R)@>@;
		}
#endif

@
@<Cases for |go_like| (R)@>=

if(cat1==built_in) /* ``|@r go to|'' */
	{
	b_app1(pp); /* \&{go} */
	b_app(@' ');
	b_app1(pp+1); /* \&{to} */
	REDUCE(pp,2,case_like,0,9850); /* \&{goto} */
	}
else SQUASH(pp,1,expr,-2,9851);

@ The keyword |@r end| has two possible meanings: end a loop, or end a
function. 
@<CASES for |end_like| (R)@>=
#if FCN_CALLS
	R_end_like();
#else
	@<Cases for |end_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_end_like(VOID)
		{
		@<Cases for |end_like| (R)@>@;
		}
#endif

@
@<Cases for |end_like| (R)@>=
if(cat1==Rdo_like || cat1==if_like) /* ``|@r end do|'' or ``|@r end if|'' */
	{
	b_app1(pp); /* \&{end} */
	b_app(@' ');
	b_app1(pp+1); /* \&{do} or \&{if} */
	REDUCE(pp,2,endif_like,0,9860); /* Now turned into \&{enddo} or
\&{endif} */ 
	}
else 
	{
	fcn_level--;
	SQUASH(pp,1,END_like,-1,9861); /* \&{end} of function. */
	}

@  \Fortran-90??

@<CASES for |END_like| (R)@>=
#if FCN_CALLS
	R_END();
#else
	@<Cases for |END_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_END(VOID)
		{
		@<Cases for |END_like| (R)@>@;
		}
#endif

@
@<Cases for |END_like| (R)@>=
{
if(cat1==program_like || cat1==struct_like)
	{
	PP_PP(1,1);
	
	if(cat2==expr)
		{
		b_app(@' '); @~ b_app1(pp+2);
		REDUCE(pp,3,END_like,0,9860);
		}
	else 
		REDUCE(pp,2,END_like,0,9861);
	}
else if(cat1==semi) 
	SQUASH(pp,2,END_stmt,-2,9862);
}

@ Handle end of loop. Note that in \Fortran-90, the \It{if-construct-name}
is optional.

@<CASES for |endif_like| (R)@>=
#if FCN_CALLS
	R_endif_like();
#else
	@<Cases for |endif_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_endif_like(VOID)
		{
		@<Cases for |endif_like| (R)@>@;
		}
#endif

@
@<Cases for |endif_like| (R)@>=
{
short n;
boolean no_construct_name;

if((no_construct_name=BOOLEAN(cat1==semi)) || (cat1==expr && cat2==semi) )
	{
	b_app(outdent);
	b_app(force);

	if(no_construct_name)
		{
		n = 2;
		b_app2(pp); /* \&{endif}; or \&{enddo}; */
		}
	else
		{ /* Include \It{if-construct-name} */
		n = 3;
		PP_PP(1,2);
		}

	if(--indent_level < 0)
		indent_level = 0;

	app_loop_num(loop_num[indent_level]);
	REDUCE(pp,n,stmt,-2,9880);
	}
}

@ 
@<CASES for |if_hd| (R)@>=
#if FCN_CALLS
	R_if_hd();
#else
	@<Cases for |if_hd| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_if_hd(VOID)
		{
		@<Cases for |if_hd| (R)@>@;
		}
#endif

@
@<Cases for |if_hd| (R)@>=

if(is_FORTRAN_(language))
	{
	if (cat1==stmt) 
		{
#if 0
		b_app1(pp); @~ b_app(break_space); @~ b_app1(pp+1);
#endif
		b_app1(pp);
		indent_force;
		 b_app1(pp+1);
		b_app(outdent);
		REDUCE(pp,2,stmt,-2,9900);
		}
	}
else 
	@<Cases for |if_hd| (C)@>@;

@ 
@<CASES for |else_like| (R)@>=
#if FCN_CALLS
	R_else_like();
#else
	@<Cases for |else_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_else_like(VOID)
		{
		@<Cases for |else_like| (R)@>@;
		}
#endif

@
@<Cases for |else_like| (R)@>=

if(is_FORTRAN_(language))
   {
   if(cat1==if_like) /* ``|@n else if|'' */
	{
	b_app1(pp); /* \&{else} */
	b_app(@' ');
	b_app1(pp+1); /* \&{if} */
	REDUCE(pp,2,else_like,0,9910); /* \&{elseif} */
	}
   else if(cat1==semi) /* \&{else}; */
	{
	b_app(outdent);
	b_app(force);
	b_app2(pp); /* \&{else} or \&{elseif} */
	app_loop_num(loop_num[indent_level-1]);
	b_app(indent);
	REDUCE(pp,2,stmt,-2,9911);
	}
   else if(cat1==expr && cat2==built_in && cat3==semi)  /* ``|@n else if(x)
then;|'' */
	{
	b_app(outdent);
	b_app(force);

	b_app1(pp);	/* \&{elseif} */
	@<Append thinspace@>;
	b_app1(pp+1); /* $(x)$ */
	b_app(@' ');
	b_app2(pp+2); /* \&{then}; */
	app_loop_num(loop_num[indent_level-1]);

	b_app(indent);
	REDUCE(pp,4,stmt,-2,9912);
	}
  }
/* \Ratfor\ */
else @<Cases for |else_like| (C)@>@;

@ 
@<CASES for |stmt| (R)@>=
#if FCN_CALLS
	R_stmt();
#else
	@<Cases for |stmt| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_stmt(VOID)
		{
		@<Cases for |stmt| (R)@>@;
		}
#endif

@
@<Cases for |stmt| (R)@>=

@#if 0
if(is_FORTRAN_(language) && cat1==program_like) 
	SQUASH(pp, 1, functn, PLUS 1, 9960); 
else 
if(is_FORTRAN_(language) && (cat1==END_like && cat2==semi) ) /* Finally
recognized a function. */
	SQUASH(pp,1,stmt,-1,99661);
		{
#if(0)
		b_app(indent); /* The function body will be indented. */
		b_app(backup); /* But not the first line of function. */
#endif
		b_app1(pp); /* The body. */

		if(fcn_level==0)
			{
			if(containing) b_app(big_force);
			while(containing)
				{
#if(0)
				b_app(outdent);
#endif
				containing--;
				}
			}

/* The \&{end} statement. */
		b_app(force);	
		b_app(outdent);
		b_app2(pp+1);

		REDUCE(pp,3,functn,-1,9961);
		}
else 
@#endif
if(cat1==stmt || (free_Fortran && cat1==decl)) 
	{
	b_app1(pp); 
	b_app(break_space);
	b_app(force);
	b_app1(pp+1); 
	REDUCE(pp,2,stmt,-2,2501);
	}
else if (cat1==functn)
	{
	b_app1(pp); @~ b_app(big_force);
	b_app1(pp+1);
	REDUCE(pp,2,stmt,-2,2511);
	}

@
@<CASES for |CASE_like| (R)@>=
#if FCN_CALLS
	R_CASE();
#else
	@<Cases for |CASE_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_CASE(VOID)
		{
		@<Cases for |CASE_like| (R)@>@;
		}
#endif

@
@<Cases for |CASE_like| (R)@>=

if(is_FORTRAN_(language))
	{
	b_app(backup);
	b_app1(pp);
	REDUCE(pp,1,case_like,0,9258);
	}
else SQUASH(pp,1,case_like,0,9259);

@ 
@<CASES for |case_like| (R)@>=
#if FCN_CALLS
	R_case_like();
#else
	@<Cases for |case_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_case_like(VOID)
		{
		@<Cases for |case_like| (R)@>@;
		}
#endif

@
@<Cases for |case_like| (R)@>=
if(cat1==read_like) /* ``|@r call open|'' */
	{
	b_app1(pp);	/* \&{call} */
	b_app(@' ');
	b_app1(pp+1); /* \&{close}, \&{open}, etc. */
	REDUCE(pp,2,case_like,0,9260);
	}
else if (cat1==semi) SQUASH(pp,2,stmt,-2,260); /* ``|@r return;|'' */
else if (cat1==colon) @<Append an ordinary colon@>@;
else if (cat1==expr && cat2==semi)
	{ /* ``|@r return 1;|'' */
	PP_PP(1,2);
	REDUCE(pp,3,stmt,-2,262);
	}
else if ((cat1==expr || cat1==label) && cat2==colon)
	{ /* ``|@r case 1:|'' */
	PP_PP(1,1);
	APP_STR("\\Colon\\ ");
	REDUCE(pp,3,tag,-1,263);
	}

@
@<Append an ordinary colon@>=
{
b_app1(pp); @~ APP_STR("\\Colon\\ ");
REDUCE(pp,2,tag,-1,261);
}

@ 
@<CASES for |tag| (R)@>=
#if FCN_CALLS
	R_tag();
#else
	@<Cases for |tag| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_tag(VOID)
		{
		@<Cases for |tag| (R)@>@;
		}
#endif

@
@<Cases for |tag| (R)@>=

if (cat1==tag) /* ``|@r case 1: case 2:|'' */
	{
  b_app1(pp); @~  b_app(force);
  b_app(backup);
   b_app1(pp+1); REDUCE(pp,2,tag,-1,270);
	}
else if (cat1==stmt || cat1==END_like) /* ``|@r 10 continue;|'' */
	{
	boolean end_of_loop;

	end_of_loop = NO;

/* Unwind indent levels for labeled loops. */
	while(indent_level > 0 && 
           compare_text(pp->trans,label_text_ptr[indent_level-1]) )
		{
		--indent_level;
		b_app(outdent);
		end_of_loop = YES;
		}

	if(is_FORTRAN_(language) && Fortran_label) 
		{ /* ``|@n EXIT: continue@;|'' */
		b_app(force);
		APP_STR("\\Wlbl{"); @~	b_app1(pp); @~ app(@'}'); 
@.\\Wlbl@>
		}
	else
		{ /* Label on separate line. */
		b_app(big_force);
		b_app(backup);
		b_app1(pp); 	/* Tag (Includes colon.) */
		b_app(force);
		}

	b_app1(pp+1); /* Stmt. */

	if(end_of_loop) 
		app_loop_num(loop_num[indent_level]);

	REDUCE(pp,2,cat1,-2,271);
}


@ 
@<CASES for |label| (R)@>=
#if FCN_CALLS
	R_label();
#else
	@<Cases for |label| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_label(VOID)
		{
		@<Cases for |label| (R)@>@;
		}
#endif

@
@<Cases for |label| (R)@>=
if(cat1==colon)
	{
	b_app1(pp);
	REDUCE(pp,2,label,0,9270); /* Swallow the colon. (Numerical
statement labels won't have any.) Then, for all labels, we put a colon in
during the next block. */
	}
else if(cat1==stmt || cat1==END_like)
	{
	b_app1(pp); @~ APP_STR("\\Colon\\ ");

	if(is_FORTRAN_(language) && Fortran_label) 
		b_app(cancel);

	REDUCE(pp,1,tag,0,9271); /* Convert the label into a tag. Don't
					swallow the statement. */
	}

@ 
@<CASES for |semi| (R)@>=
#if FCN_CALLS
	R_semi();
#else
	@<Cases for |semi| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_semi(VOID)
		{
		@<Cases for |semi| (R)@>@;
		}
#endif

@
@<Cases for |semi| (R)@>=
if(is_RATFOR_(language) && auto_semi)
	{ /* Just throw away semi. */
	text_pointer t;

	t = indirect(pp->trans);

	if(**t == @';') **t = 0;
	SQUASH(pp,1,ignore_scrap,-1,9280);
	}
else
	{
	b_app(@' '); b_app1(pp); REDUCE(pp,1,stmt,-2,280);
	}

@ 
@<CASES for |common_like| (R)@>=
#if FCN_CALLS
	R_common_like();
#else
	@<Cases for |common_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_common_like(VOID)
		{
		@<Cases for |common_like| (R)@>@;
		}
#endif

@
@<Glob...@>=

@
@<Cases for |common_like| (R)@>=
if(cat1==expr || cat1==slashes || cat1==semi) 
	{ /* ``|@r common x| or |@r common/dia/|'' */
#if 0
	b_app1(pp);
#if 0
	if(cat1 != semi) 
		b_app(@' ');
#endif
	b_app(indent);
	REDUCE(pp,1,common_hd,0,9950);
#endif
	SQUASH(pp, 1, common_hd, 0, 9950);
	}

@ 
@<CASES for |common_hd| (R)@>=
#if FCN_CALLS
	R_cmn_hd();
#else
	@<Cases for |common_hd| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_cmn_hd(VOID)
		{
		@<Cases for |common_hd| (R)@>@;
		}
#endif

@
@<Cases for |common_hd| (R)@>=

#if 0
if(cat1== expr) 
	SQUASH(pp,2,common_hd,0,9951); /* ``|@r common x|'' */
else if(cat1==slashes) /* ``|@r common/dia/|'' */
	{
	b_app1(pp);
	b_app(@' ');
	b_app1(pp+1);
	b_app(@' ');
	REDUCE(pp,2,common_hd,0,9952);
	}
else if(cat1==comma) /* ``|@r common x,y|'' */
	{
	b_app2(pp);
	b_app(@' ');
	REDUCE(pp,2,common_hd,0,9953);
	}

if(cat1 == expr) 
	{
	b_app1(pp);
	OPT9;
	b_app1(pp+1);
	REDUCE(pp,2,common_hd,0,9951); /* ``|@r common x|'' */
	}
else if(cat1==slashes)
	{ /* ``|@r common/dia/|'' */
	SQUASH(pp,2,common_hd,0,9952);
	}
else if(cat1==comma) /* ``|@r common x,y|'' */
	{
	SQUASH(pp,2,common_hd,0,9953);
	}
else if(cat1==semi) 
	{
	b_app2(pp);
	b_app(outdent);
	REDUCE(pp,2,decl,-1,9954); /* ``|@r common x;|'' */
	}
#endif
if(cat1 == slashes)
	SQUASH(pp, 2, int_like, 0, 9952); // `` |@4 common/dia/|''
else
	SQUASH(pp, 1, int_like, 0, 9951); // ``|@r common x|''

@ 
@<CASES for |read_like| (R)@>=
#if FCN_CALLS
	R_read_like();
#else
	@<Cases for |read_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_read_like(VOID)
		{
		@<Cases for |read_like| (R)@>@;
		}
#endif

@
@<Cases for |read_like| (R)@>=

if(cat1==lpar && cat2==expr && cat3==rpar) /* |@r read(6,100)| */
	{
	b_app1(pp);
	@<Append thinspace@>;
	b_app3(pp+1);
	b_app(@' ');
	REDUCE(pp,4,read_hd,0,9960);
	}
else if(cat1==expr && cat2==comma) /* ``|@r TYPE 100, i@;|'' */
	{
	b_app1(pp);
	b_app(@' ');
	b_app2(pp+1);
	b_app(@' ');
	REDUCE(pp,3,read_hd,0,9961);
	}
else if(cat1==expr || cat1==unorbinop) /* ``|@r TYPE *|'' */
	{
	PP_PP(1,1);

	if(cat2==expr) b_app(@' '); /* Takes care of |"TYPE 100 i"|. */

	REDUCE(pp,2,read_hd,0,9962);
	}
else if(cat1==semi) SQUASH(pp,1,read_hd,0,9963);


@ 
@<CASES for |read_hd| (R)@>=
#if FCN_CALLS
	R_rd_hd();
#else
	@<Cases for |read_hd| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_rd_hd(VOID)
		{
		@<Cases for |read_hd| (R)@>@;
		}
#endif

@
@<Cases for |read_hd| (R)@>=
if(cat1==comma)  /* ``|@r read(6,100),|'' */
	{
	b_app2(pp);
	b_app(@' ');
	REDUCE(pp,2,read_hd,0,9965);
	}
else if(cat1==expr)
	{
	if(cat2==comma || cat2==semi)
		SQUASH(pp,2,read_hd,0,9966); /* ``|@r write(6,100) i,j@;|'' */
	}
else if(cat1==semi && cat2==read_like) /* Two I/O statements back-to-back. */
	{
	b_app1(pp);
@#if 0
	b_app(big_cancel);
@#endif
	b_app1(pp+1);
	b_app(force);
	b_app1(pp+2);
	REDUCE(pp,3,read_like,0,9967);
	}
else if(cat1==semi)
	{
	b_app1(pp);
@#if 0
	b_app(big_cancel); /* Supposed to kill off preceding blanks. */
@#endif
	b_app1(pp+1);
	REDUCE(pp,2,stmt,-2,9968);
	}

@ 

@f implicit_none implicit

@<CASES for |implicit_like| (R)@>=
#if FCN_CALLS
	R_implicit_like();
#else
	@<Cases for |implicit_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_implicit_like(VOID)
		{
		@<Cases for |implicit_like| (R)@>@;
		}
#endif

@
@<Cases for |implicit_like| (R)@>=
if(cat1==int_like || cat1==expr) /* ``|@r implicit integer|'' or 
					``|@r implicit none|'' */
	{
	b_app1(pp);
	b_app(@' ');
	b_app(indent); /* Start possible long declaration. */
	REDUCE(pp,1,implicit_hd,0,9970);
	}
else if(cat1==semi)
	{ /* ``|@r implicit_none;|''. */
	b_app1(pp);
	b_app(indent);
	REDUCE(pp,1,implicit_hd,0,99700);
	}

@ 
@<CASES for |implicit_hd| (R)@>=
#if FCN_CALLS
	R_imp_hd();
#else
	@<Cases for |implicit_hd| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_imp_hd(VOID)
		{
		@<Cases for |implicit_hd| (R)@>@;
		}
#endif

@
@<Cases for |implicit_hd| (R)@>=
if(cat1==unorbinop && cat2==expr) 
	{ /* ``|@r implicit real*8|'' */
	b_app1(pp);
	b_app(@'{'); @~ b_app2(pp+1); @~ b_app(@'}');
	@<Append thinspace@>;
	REDUCE(pp,3,implicit_hd,0,9971);
	}
else if(cat1==expr) SQUASH(pp,2,implicit_hd,0,9972); /* ``|@r implicit
	integer(a-h)|'' */
else if(cat1==comma || cat1==int_like)
	{
	b_app2(pp);

	if(cat2 != unorbinop)
		if(cat2==int_like) b_app(@' '); /* ``|@r implicit real x,
integer i|'' */
		else @<Append thinspace@>;

	REDUCE(pp,2,implicit_hd,0,9973);
	}
else if(cat1==semi) SQUASH(pp,1,decl_hd,0,9974); /* ``|@r implicit
	integer(a-h);|'' */
	
@ 
@<CASES for |assign_like| (R)@>=
#if FCN_CALLS
	R_assign_like();
#else
	@<Cases for |assign_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_assign_like(VOID)
		{
		@<Cases for |assign_like| (R)@>@;
		}
#endif

@
@<Cases for |assign_like| (R)@>=
if(cat1==expr && cat2==built_in && cat3==expr) /* ``|@r assign 100 to k|'' */
	{
	b_app1(pp);
	b_app(@' ');
	b_app1(pp+1);
	b_app(@' ');
	b_app1(pp+2);
	b_app(@' ');
	b_app1(pp+3);
	REDUCE(pp,4,expr,0,9980);
	}

@ The following flag is used  in \FORTRAN-90 to determine whether a |@r9
contains| is in force, and what level in the block structure we're in.

@<Glob...@>=

IN_PROD int containing PSET(0);

@ 
@<CASES for |entry_like| (R)@>=
#if FCN_CALLS
	R_entry_like();
#else
	@<Cases for |entry_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_entry_like(VOID)
		{
		@<Cases for |entry_like| (R)@>@;
		}
#endif

@
@<Cases for |entry_like| (R)@>=
if(cat1==expr && cat2==semi) /* ``|@r entry E(x);|'' */
	{
	b_app(big_force);
	b_app(backup); @~ PP_PP(1,2); @~ b_app(force);
	REDUCE(pp,3,stmt,-2,9990);
	}
else if(cat1== (eight_bits)(language==FORTRAN_90 ? semi : colon)) 
	{ /* ``|@r9 contains:|'' */
	b_app(big_force);
	b_app(backup); @~ b_app2(pp); @~ b_app(force);

	containing++; 
#if(0)
	b_app(indent);
#endif
	REDUCE(pp,2,stmt,-2,9991);
	}

@ 
@<CASES for |define_like| (R)@>=
#if FCN_CALLS
	R_define_like();
#else
	@<Cases for |define_like| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_define_like(VOID)
		{
		@<Cases for |define_like| (R)@>@;
		}
#endif

@
@<Cases for |define_like| (R)@>=
if(cat1==expr)
	{
	b_app(force);
	b_app(backup); @~ b_app2(pp); @~ b_app(force);
	REDUCE(pp,2,ignore_scrap,-1,9995);
	}

@ \&{data} statements can be intermixed with everything. (VAX). For such
statements, we raise a flag.

@<CASES for |no_order| (R)@>=
#if FCN_CALLS
	R_no_order();
#else
	@<Cases for |no_order| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_no_order(VOID)
		{
		@<Cases for |no_order| (R)@>@;
		}
#endif

@
@<Cases for |no_order| (R)@>=
intermingle = YES;
b_app(force);
b_app1(pp); @~ b_app(@' ');
REDUCE(pp,1,int_like,0,9996);


@ 
@<CASES for |built_in| (R)@>=
#if FCN_CALLS
	R_built_in();
#else
	@<Cases for |built_in| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_built_in(VOID)
		{
		@<Cases for |built_in| (R)@>@;
		}
#endif

@
@<Cases for |built_in| (R)@>=
{
b_app1(pp);
@<Append thinspace@>;
REDUCE(pp,1,expr,-2,9998);
}

@ 
@<CASES for |newline| (R)@>=
#if FCN_CALLS
	R_newline();
#else
	@<Cases for |newline| (R)@>@;
#endif

@
@<Part 2@>=
#if FCN_CALLS
	@[SRTN R_newline(VOID)
		{
		@<Cases for |newline| (R)@>@;
		}
#endif

@
@<Cases for |newline| (R)@>=
SQUASH(pp,1,ignore_scrap,-1,9999);

@* PRODUCTIONS for LITERAL.
@<Part 2@>=@[
SRTN 
V_productions(VOID)
{
switch(pp->cat)
	{
	case expr: @<Cases for |expr| (M)@>@; @~ break;
	case stmt: @<Cases for |stmt| (M)@>@; @~ break;
	}
}

@
@<Cases for |expr| (M)@>=

@
@<Cases for |stmt| (M)@>=

@* PRODUCTIONS for TEX. The productions have been made into individual
functions to accomodate memory-starved pc's.
@<Part 2@>=@[
SRTN 
X_productions(VOID)
{
switch (pp->cat) 
	{
	case expr: @<Cases for |expr| (X)@>@; @~ break;
	case stmt: @<Cases for |stmt| (X)@>@; @~ break;
	}
}

@
@<Cases for |expr| (X)@>=
{
if(cat1==expr) SQUASH(pp,2,expr,0,5);
else if(cat1==semi) 
	{
	b_app1(pp);
	REDUCE(pp,2,stmt,-1,6);
	}
}

@
@<Cases for |stmt| (X)@>=
{
if(cat1==stmt)
	{
	b_app1(pp); 
	b_app(force);
	b_app1(pp+1);
	REDUCE(pp,2,stmt,-1,250);
	}
}

@* CHANGING the SCRAP LIST; APPLYING the PRODUCTIONS.
The `|reduce|' procedure makes the appropriate changes to the scrap list. 

@<Typed...@>=

typedef unsigned long RULE_NO; // Rule number for the productions.

@
@d REDUCE(j,k,c,d,n) reduce(j,k,(eight_bits)(c),d,(RULE_NO)(n))
@<Part 2@>=@[ 
SRTN 
reduce FCN((j,k,c,d,n))
	scrap_pointer j C0("")@;
	short k C0("Number of items to be reduced.")@;
	eight_bits c C0("Reduce to this type.")@;
	short d C0("Move by this amount.")@;
	RULE_NO n C1("Rule number.")@;
{
  scrap_pointer i, i1; /* Pointers into scrap memory */

/* Store the translation. */
  j->cat=c; j->trans=text_ptr;
  j->mathness= (eight_bits)(4*last_mathness+ini_mathness);
  freeze_text;

/* More stuff to the left, overwriting the $k$~items that have been
reduced. */
  if (k>1) 
	{
	for (i=j+k, i1=j+1; i<=lo_ptr; i++, i1++) 
		{
	      i1->cat=i->cat; i1->trans=i->trans;
	      i1->mathness=i->mathness;
		    }

	    lo_ptr=lo_ptr-k+1;
	  }

  @<Change |pp| to $\max(|scrp_base|,|pp+d|)$@>;

#ifdef DEBUG
  @<Print a snapshot of the scrap list if debugging @>;
#endif /* |DEBUG| */

  pp--; /* we next say |pp++| */
}

@ 
@<Change |pp| to $\max...@>=

if (pp+d>=scrp_base) pp=pp+d;
else pp=scrp_base;

@ The |squash| procedure takes advantage of the simplification that occurs
when |k=1|.

@d SQUASH(j,k,c,d,n) squash(j,k,c,d,(RULE_NO)(n))

@<Part 2@>=@[ 
SRTN 
squash FCN((j,k,c,d,n))
	scrap_pointer j C0("")@;
	short k C0("Number to be squashed.")@;
	eight_bits c C0("Make it this type.")@;
	short d C0("Move by this amount.")@;
	RULE_NO n C1("Rule number.")@;
{
  scrap_pointer i; /* pointers into scrap memory */

  if (k==1) 
	{
	    j->cat=c; @<Change |pp|...@>;

#ifdef DEBUG
	    @<Print a snapshot...@>;
#endif /* |DEBUG| */

	    pp--; /* we next say |pp++| */
	    return;
	  }

  for (i=j; i<j+k; i++) b_app1(i);

  reduce(j,k,c,d,n);
}

@ Here now is the code that applies productions as long as possible. It
requires two local labels (|found| and |done|), as well as a local
variable~(|i|).

@<Reduce the scraps using the productions until no more rules apply@>=
{
in_prototype = indented = NO;

WHILE()
	{
	  @<Make sure the entries |pp| through |pp+3| of |cat| are defined@>;

	  if (tok_ptr+8>tok_m_end)
		{
		    if (tok_ptr>mx_tok_ptr) mx_tok_ptr=tok_ptr;
			OVERFLW("tokens","tw");
		}

	if(text_ptr+4>tok_end) 
		{
		    if (text_ptr>mx_text_ptr) mx_text_ptr=text_ptr;
		    OVERFLW("texts",ABBREV(max_texts));
		  }

	  if(pp>lo_ptr) 
		break;

	  @<Match a production...@>;
	  ini_mathness=cur_mathness=last_mathness=maybe_math;
	}
}

@ If we get to the end of the scrap list, category codes equal to zero are
stored, since zero does not match anything in a production.

@<Make sure the entries...@>=

if (lo_ptr<pp+3) 
	{
	  while (hi_ptr<=scrp_ptr && lo_ptr!=pp+3) 
		{
	    (++lo_ptr)->cat=hi_ptr->cat; lo_ptr->mathness=(hi_ptr)->mathness;
	    lo_ptr->trans=(hi_ptr++)->trans;
		  }

	  for (i=lo_ptr+1;i<=pp+3;i++) i->cat=0;
	}

@
@d MAX_CYCLES 500
@<Check for infinite loop@>=
{
static RULE_NO last_rule = ULONG_MAX;
static int ncycles = 0;

if(n && n == last_rule)
	{
	if(ncycles++ > MAX_CYCLES)
		{
		CONFUSION("reduce", "Infinite production loop, rule %lu", n);
		}
	}
else
	{
	last_rule = n;
	ncycles = 0;
	}
}

@ 
@<Print a snapsh...@>= 
@B
  scrap_pointer k; /* pointer into |scrap_info| */

@b
@<Check for infinite loop@>@;

  if (tracing==VERBOSE) 
	{
	printf("%5lu", n); // The rule number.

	if(in_prototype)
		printf(".%i", in_prototype);

	printf(": ");

    for (k=scrp_base; k<=lo_ptr; k++) 
		{
		if (k==pp) 
			putxchar('*'); // Current one.
		else 
			putxchar(' ');

		prn_math(k);
	    }

	    if (hi_ptr<=scrp_ptr) printf("..."); /* indicate that more is
			coming */ 

		@<Print the last translation@>@;

	}
}

@
@<Part 1@>=

SRTN
prn_math FCN((k))
	scrap_pointer k C1("")@;
{
if (INI_MATHNESS(k) == yes_math) 
	putxchar('+');
else if (INI_MATHNESS(k) == no_math) 
	putxchar('-');

prn_cat(k->cat);

if (LAST_MATHNESS(k) == yes_math) 
	putxchar('+');
else if (LAST_MATHNESS(k) == no_math) 
	putxchar('-');

DFLUSH@;
}

@ For debugging, it's helpful to see the translation of the last several scraps
that's printed explicitly.
@<Print the last trans...@>=
{
printf(" ==\""); 

if(lo_ptr > scrp_base) 
	{ 
	prn_trans(lo_ptr-1); // The second-to-last scrap.
	printf("\" \"");
	}

prn_trans(lo_ptr); // Last scrap.
puts("\"");
}

@ The |translate| function assumes that scraps have been stored in
positions |scrp_base| through |scrp_ptr| of |cat| and |trans|. It appends
a |terminator| scrap and begins to apply productions as much as possible.
The result is a token list containing the translation of the given sequence
of scraps.

After calling |translate|, we will have |text_ptr+3<=max_texts| and
|tok_ptr+6<=max_toks|, so it will be possible to create up to three token
lists with up to six tokens without checking for overflow. Before calling
|translate|, we should have |text_ptr<max_texts| and
|scrp_ptr<max_scraps|, since |translate| might add a new text and a new
scrap before it checks for overflow.

@<Part 2@>=@[ 
text_pointer 
translate FCN((mode0))
	PARSING_MODE mode0 C1("")@;
{
LANGUAGE saved_language = language;
scrap_pointer i, /* index into |cat| */
	  j; /* runs through final scraps */

translate_mode = mode0;

pp=scrp_base; lo_ptr=pp-1; hi_ptr=pp;
@<If tracing, print an indication of where we are@>;
@<Reduce the scraps...@>@;
@<Combine the irreducible scraps that remain@>;

language = saved_language;
return text_ptr-1;
}

@ If the initial sequence of scraps does not reduce to a single scrap, we
concatenate the translations of all remaining scraps, separated by blank
spaces, with dollar signs surrounding the translations of scraps whose
category code is |max_math| or less.

@<Combine the irreducible...@>= 
{
EXTERN int math_flag;

  @<If semi-tracing, show the irreducible scraps@>;

  for (j=scrp_base; j<=lo_ptr; j++) 
	{
	    if (j!=scrp_base) 
		app(@' '); // Separate scraps by blanks.

	    if ((INI_MATHNESS(j) == yes_math) && math_flag==NO) 
		{
		app(@'$');
#ifdef DBGM
		app(@'7');
#endif
		}

	    if ((INI_MATHNESS(j) == no_math) && math_flag==YES) 
		{
		app(@' '); 

#ifdef DBGM
		app(@'8');
#endif
		app(@'$');
		}

	    app1(j);

	    if ((LAST_MATHNESS(j) == yes_math) && math_flag==NO) 
		{
#ifdef DBGM
		app(@'9');
#endif
		app(@'$');
		}

	    if ((LAST_MATHNESS(j) == no_math) && math_flag==YES) 
			{
			app(@'$');
#ifdef DBGM
			app(@'0');
#endif
			app(@' ');
			}

	    if (tok_ptr+6>tok_m_end) OVERFLW("tokens","tw");
	  }

  freeze_text; 
}

@ 
@<If semi-tracing, show the irreducible scraps@>=

#ifdef DEBUG
{
scrap_pointer scrap0 = scrp_base;

while(scrap0->cat == ignore_scrap) scrap0++;

if (lo_ptr>scrap0 && tracing==BRIEF) 
	{
	CLR_PRINTF(ALWAYS, warning,
		("\nIrreducible scrap sequence in %s:", 
			MOD_TRANS(module_count)));
	mfree();
	  mark_harmless;

	  for (j=scrap0; j<=lo_ptr; j++) 
		{
		    printf(" "); prn_cat(j->cat);
		  }
	}
}
#endif /* |DEBUG| */

@ Print a header for each section of translated code.
@d OUT_WIDTH 40
@<If tracing,...@>=

#ifdef DEBUG
if (tracing==VERBOSE) 
	{
	CLR_PRINTF(ALWAYS, warning,
		("\nTracing after l. %u (language = %s):  ",
			cur_line,languages[lan_num(language)])); 
	mark_harmless;

	  if (loc>=cur_buffer+OUT_WIDTH) 
		{
		printf("...");
		ASCII_write(loc-OUT_WIDTH,OUT_WIDTH);
		}
	  else ASCII_write(cur_buffer,loc-cur_buffer);

	puts("");
	}
#endif /* |DEBUG| */

@* INDEX.