OS/2 Shareware BBS: 22 gnu

home *** CD-ROM | disk | FTP | other *** search

/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / fweb153.zip / fweb-1.53 / web / prod.web < prev next >

Wrap

Text File | 1995-09-23 | 121KB | 5,881 lines

@z --- prod.web --- FWEB version 1.53 (September 23, 1995) 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(0,zero); default: printf("UNKNOWN"); @~ 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; } #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++))); } 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) 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. */ 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|. @<Part 1@>=@[ SRTN b_app1 FCN((a)) scrap_pointer a C1("Scrap to be appended.")@; { switch (a->mathness % 4) { /* Left boundary (|ini_mathness|) of the current scrap. */ case no_math: if (cur_mathness==maybe_math) ini_mathness = no_math; else if (cur_mathness==yes_math) APP_STR("{}$"); /* End math mode. (The braces take care of ending the math part with something like a~$+$.) */ cur_mathness = last_mathness = a->mathness / 4; /* Right boundary (|last_mathness|) */ 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~$+$.) */ cur_mathness = last_mathness = a->mathness / 4; /* Right boundary (|last_mathness|) */ break; case maybe_math: break; /* No changes */ } 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 isn't defined"); 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; } } @ 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) { printf("\n! (FWEAVE): Implicit phase 2 declaration of `"); prn_id(p); printf("' at %s \ repeats or conflicts with previous 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) { /* 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==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 @ @<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) SQUASH(pp,1,LPROC,0,12); /* ``|#if(0)|'' */ 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(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) b_app(@' '); INDENT; /* Start long declaration. (Note: Whenever we leave |decl_hd|, we must |OUTDENT|.) */ REDUCE(pp,1,decl_hd,-1,41); } else if(cat1==comma) { b_app1(pp); INDENT; REDUCE(pp,1,decl_hd,-2,42); /* Function prototype: |int,|. */ } else if(cat1==rpar) { b_app1(pp); INDENT; 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); INDENT; 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) 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) SQUASH(pp,1,int_like,-2,503); else if(pp == lo_ptr) SQUASH(pp, 1, expr, 0, 5040); else if(cat1==semi || cat1==lbrace) SQUASH(pp,1,_EXPR,0,5042); // |@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 if 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); b_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); OUTDENT; in_function = YES; defined_at(FIRST_ID(pp)); REDUCE(pp,1,fn_decl,0,58); } else if (cat1==semi) { /* ``|int i;|'' */ b_app2(pp); OUTDENT; /* Finish long declaration. */ #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 = 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|. */ PP_PP(1,1); @<Append thinspace@>@; b_app1(pp+2); 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; b_app1(pp); @~ b_app(@' '); /* |operator| */ b_app(@'{'); /* Braces prevent possible spurious blanks before the left paren. */ 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); } @ |@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) 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|'' */ { b_app1(pp); b_app(@' '); b_app1(pp+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 {|'' */ b_app(force); b_app1(pp+1); /* Body */ b_app(force); 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,-3,5001); } @ @<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); /* ``|{|'' */ b_app(force); b_app1(pp+1); /* Body */ b_app(force); 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); } } @ @<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(@' '); 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) 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); @~ b_app(force); 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 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++)@>= { 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 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 { 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) b_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) { b_app2(pp); @~ b_app(@' '); @~ b_app1(pp+2); REDUCE(pp,3,struct_like,0,90750); /* ``|@r9 type, private|'' */ } 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)@>= @{ 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); } #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,expr,-2,9502); /* Deferred-shape-spec-list: |@r (:,:)| */ 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)@>= if(cat1==binop) /* ``|@r / /|'' */ { sixteen_bits tok; tok = **pp->trans; if(tok == (sixteen_bits)@'/' && (**(pp+1)->trans == tok) ) @<Append empty slashes@>@; else @<Reduce cases like |+=|@>@; } else if(cat1==expr && cat2==binop) /* ``|@r /dia/|'' */ { sixteen_bits tok; tok = **pp->trans; if(tok == (sixteen_bits)@'/' && (**(pp+2)->trans == tok) ) @<Append full slashes@>@; } @ @<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@>= { b_app(@'{'); b_app1(pp); /* |'/'| */ b_app(@'}'); make_underlined(pp+1); /* Index common block name. */ b_app1(pp+1); /* expr */ b_app(@'{'); b_app1(pp+2); /* |'/'| */ b_app(@'}'); 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); 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) { b_app1(pp); @~ b_app(break_space); @~ b_app1(pp+1); 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(is_FORTRAN_(language) && cat1==program_like) SQUASH(pp,1,functn, PLUS 1,9960); @#if 0 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); } @#endif else if (cat1==stmt) { b_app1(pp); b_app(break_space); b_app(force); b_app1(pp+1); REDUCE(pp,2,stmt,-2,250); } else if (cat1==functn) { b_app1(pp); @~ b_app(big_force); b_app1(pp+1); REDUCE(pp,2,stmt,-2,251); } @ @<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 @ @<Cases for |common_like| (R)@>= if(cat1==expr || cat1==slashes || cat1==semi) /* ``|@r common x| or |@r common/dia/|'' */ { b_app1(pp); if(cat1 != semi) b_app(@' '); b_app(indent); REDUCE(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(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); } else if(cat1==semi) { b_app2(pp); b_app(outdent); REDUCE(pp,2,decl,-1,9954); /* ``|@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) { outer_char temp[MAX_CYCLES]; SPRINTF(MAX_CYCLES, temp, `"Infinite production loop, rule %lu", n`); CONFUSION("reduce", temp); } } else { last_rule = n; ncycles = 0; } } @ @<Print a snapsh...@>= @{ scrap_pointer k; /* pointer into |scrap_info| */ @b @<Check for infinite loop@>@; if (tracing==2) { 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('*'); else putxchar(' '); if (k->mathness %4 == yes_math) putxchar('+'); else if (k->mathness %4 == no_math) putxchar('-'); prn_cat(k->cat); if (k->mathness /4 == yes_math) putxchar('+'); else if (k->mathness /4 == no_math) putxchar('-'); } if (hi_ptr<=scrp_ptr) printf("..."); /* indicate that more is coming */ @<Print the last translation@>@; } } @ 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) { // The second-to-last scrap. prn_text(indirect((lo_ptr-1)->trans)); printf("\" \""); } prn_text(indirect(lo_ptr->trans)); // 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 ((j->mathness % 4 == yes_math) && math_flag==NO) app(@'$'); if ((j->mathness % 4 == no_math) && math_flag==YES) {app(@' '); app(@'$');} app1(j); if ((j->mathness / 4 == yes_math) && math_flag==NO) app(@'$'); if ((j->mathness / 4 == no_math) && math_flag==YES) {app(@'$'); 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==1) { CLR_PRINTF(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==2) { CLR_PRINTF(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.