home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / fweb153.zip / fweb-1.53 / web / prod.c < prev    next >
Text File  |  1995-09-23  |  137KB  |  8,588 lines
  1. #if(0)
  2.   FTANGLE v1.53, created with UNIX on "Thursday, September 21, 1995 at 15:06."  \
  3.   COMMAND LINE: "web/ftangle web/prod -A -# --F -= 1.53/web/prod.c" \
  4.   RUN TIME: "Saturday, September 23, 1995 at 16:17." \
  5.   WEB FILE:    "web/prod.web" \
  6.   CHANGE FILE: (none)
  7. #endif
  8. #define _PROD_h   \
  9.  
  10. #define normal  0 /* ordinary identifiers have |normal| ilk */
  11. #define roman  1 /* normal index entries have |roman| ilk */
  12. #define wildcard  2 /* user-formatted index entries have |wildcard| ilk */
  13. #define typewriter  3 /* `typewriter type' entries have |typewriter| ilk */ \
  14.  
  15. #define is_reserved(a)(a->ilk>typewriter)/* tells if a name is a reserved word */ \
  16.  
  17. #define append_xref(c)if(xref_ptr==xmem_end) \
  18. OVERFLW("cross-references","r"); \
  19. else \
  20. { \
  21. (++xref_ptr)->num= c; \
  22. xref_ptr->Language= (boolean)language; \
  23. } \
  24.  
  25. #define def_flag  ID_FLAG /* must be strictly larger than |max_modules| */ \
  26.  
  27. #define xref  equiv_or_xref /* The trouble with this is that |xref| is a \
  28.     |xref_pointer| whereas |equiv_or_xref| is |ASCII|. This means that \
  29.     lots of casting needs to be done to keep the compiler happy. Hence \
  30.     the previous |typedef|. */ \
  31.  
  32. #define app(a)*(tok_ptr++)= a /* Ordinary token */
  33. #define APP_ID  app(id_flag+PTR_DIFF(sixteen_bits,id_lookup(id_first,id_loc,normal),name_dir))
  34. #define app1(a)app(tok_flag+PTR_DIFF(sixteen_bits,(a)->trans,tok_start))/* Store translation \
  35.         as token list; should translate to the following: */
  36. #undef expr  
  37. #define expr  1 /* An expression, including perhaps a single identifier. */ \
  38.  
  39. #undef unop  
  40. #define unop  2 /* A unary operator. */ \
  41.  
  42. #undef binop  
  43. #define binop  3 /* A binary operator. */ \
  44.  
  45. #define unorbinop  4 \
  46. /* An operator that can be unary or binary, depending on context. */
  47. #define cast  5 /* A cast. */
  48. #define question  6 /* A question mark and possibly the expressions flanking it. */
  49. #define lbrace  7 /* A left brace. */
  50. #define rbrace  8 /* A right brace. */
  51. #define decl_hd  9 /* An incomplete declaration. */
  52. #define comma  10 /* A comma. */
  53. #define lpar  11 /* A left parenthesis. */
  54. #define rpar  12 /* A right parenthesis. */
  55. #define lbracket  13 /* A left bracket. */
  56. #define rbracket  14 /* A right bracket. */
  57. #define exp_op  18 /* Exponentiation. */ \
  58.  
  59. #define max_math  19 \
  60. /* Category codes less than this can only be printed in math mode. */ \
  61.  
  62. #define struct_hd  21 /* The beginning of a structure specifier. */
  63. #define decl  20 /* A complete declaration. */
  64. #define label  22 /* Fortran statement label. */
  65. #define stmt  23 /* A complete statement. */
  66. #define functn  24 /* A complete function. */
  67. #define fn_decl  25 /* A function declarator. */
  68. #define else_like  26 /* The beginning of a conditional. */
  69. #define semi  27 /* A semicolon. */
  70. #define colon  28 /* A colon. */
  71. #define tag  29 /* A statement label. */
  72. #define if_hd  30 /* The beginning of a conditional. */
  73. #define common_hd  31
  74. #define read_hd  32
  75. #define slashes  33
  76. #define implicit_hd  34
  77. #define lproc  35 /* Begins a preprocessor command. */
  78. #define rproc  36 /* Ends a preprocessor command. */
  79. #define ignore_scrap  37 /* A full preprocessor command. */
  80. #define for_hd  38
  81. #define newline  39
  82. #define language_scrap  40 /* So we can change languages during translation. */ \
  83.  
  84. #define do_like  55 /* \&{do}. */
  85. #define for_like  56 /* \&{for}, \&{switch}. */
  86. #define if_like  57 /* \&{if}, \&{while},  \&{ifdef}, \&{ifndef}, \&{endif}. */
  87. #define int_like  58 /* \&{int}, \&{char}, \&{extern}, \dots. */
  88. #define case_like  59 /* \&{return}, \&{goto}, \&{break}, \&{continue}. */
  89. #define sizeof_like  60 /* \&{sizeof}. */
  90. #define struct_like  61 /* \&{struct}. */
  91. #define typedef_like  62 /* \&{typedef}. */
  92. #define define_like  63 /* \&{define}. */
  93. #define common_like  64 /* \&{common}, \&{save}, \&{namelist} . */
  94. #define read_like  65 /* \&{read}, \&{write}, \&{print}, \&{backspace}, \
  95.     \&{rewind}, \&{open}, \&{close}, \&{endfile}, \&{inquire}, \&{decode}, \
  96.     \&{encode}.  */
  97. #define entry_like  66 /* \&{entry} . */
  98. #define implicit_like  67 /* \&{implicit}. */
  99. #define assign_like  68 /* \&{assign}. */
  100. #define built_in  69 /* \&{changequote}, \&{define}, \&{divert}, \&{eval}, \
  101.     \&{ifdef}, \&{ifdef}, \&{incr}, \&{len}, \&{undefine}, \&{undivert}. */
  102. #define Rdo_like  70 /* \Ratfor\ \&{do}. */
  103. #define endif_like  71 /* \&{endif}, \&{enddo}. */
  104. #define end_like  72 /* \&{end}. */
  105. #define END_like  73
  106. #define go_like  74 /* \&{go}. */
  107. #define no_order  75 /* \&{include}. */
  108. #define until_like  76 /* \&{until}. */
  109. #define IF_like  77
  110. #define IF_top  78
  111. #define else_hd  79
  112. #define ELSE_like  80
  113. #define space  81 /* For C~preprocessor. */
  114. #define LPROC  82
  115. #define UNOP  83 /* ``\.{{\it unop}\ }''. */
  116. #define BINOP  84 /* ``\.{\ {\it binop}\ }''. */
  117. #define COMMA  85 /* ``\.{\ {\it comma}\ }''. */
  118. #define _EXPR  86 /* ``\.{\ {\it expr}}''. */
  119. #define _EXPR_  87 /* ``\.{\ {\it expr}\ }''. */
  120. #define EXPR_  88 /* ''\.{{\it expr}\ }''. */
  121. #define Decl_hd  89
  122. #define key_wd  90 /* May be unused now. */
  123. #define program_like  91 /* |@r program|, |@r subroutine|, |@r function|. */
  124. #define CASE_like  92
  125. #define modifier  93 /* |const|, |volatile|. */
  126. #define class_like  94 /* \Cpp: |class|. */
  127. #define op_like  95 /* \Cpp: |operator|. */
  128. #define new_like  96 /* \Cpp: |new|, |delete|. */
  129. #define proc_like  97 /* \Fortran-90: |@r procedure|. */
  130. #define private_like  98 /* \Fortran-90: |@r private|, |@r public|, |@r sequence|. */
  131. #define slash_like  99 /* \Fortran: slash in |@r data| statement. */
  132. #define fcn_hd  100 /* \Fortran: Beginning of function. */
  133. #define END_stmt  101 /* \Fortran: |@r end;|. */
  134. #define huge_like  102 /* For |huge|. */
  135. #define imp_reserved  103 /* The result of~\.{@`}. */
  136. #define extern_like  104 /* |extern|. */
  137. #define while_do  105 /* |while| after |do|. */
  138. #define template  106 /* |@c++ template| */
  139. #define langle  107 /* A '\.<'. */
  140. #define tstart  108 /* The '\.<' beginning a template list. */
  141. #define tlist  109 /* |@c++ int<int, int>| */
  142. #define rangle  110 /* A '\.>'. */
  143. #define namespace  111 /* |@c++ namespace| */
  144. #define virtual  112 /* |@c++ virtual| */
  145. #define reference  113 /* |@c++ int& ref;| */ \
  146.  
  147. #define DFLUSH  if(dflush)puts(""); \
  148.  
  149. #define math_bin  (eight_bits)0345
  150. #define math_rel  (eight_bits)0346 \
  151.  
  152. #define toggle_meta  (eight_bits)0347 \
  153.  \
  154. /* --- Non-math tokens (see |big_app| in \.{prod.web}) --- */
  155. #define big_cancel  (eight_bits)0350 /* Like |cancel|; also overrides spaces. */
  156. #define cancel  (eight_bits)0351 /* Override |backup|, |break_space|, |force|, |big_force|. */ \
  157.  \
  158. /* \bf The numerical order of the following must be preserved!! */
  159. #define indent  (eight_bits)0352 /* One more tab (\.{\\1}). */
  160. #define outdent  (eight_bits)0353 /* One less tab (\.{\\2}). */
  161. #define opt  (eight_bits)0354 /* Optional break in mid-statement (\.{\\3}). */
  162. #define backup  (eight_bits)0355 /* Stick out one unit to the left (\.{\\4}). */
  163. #define break_space  (eight_bits)0356 /* Optional break between statements (\.{\\5}). */
  164. #define force  (eight_bits)0357 /* Forced break between statements (\.{\\6}). */
  165. #define big_force  (eight_bits)0360 /* Forced break with additional space (\.{\\7}). */ \
  166.  
  167. #define end_translation  (eight_bits)0361 /* Special sentinel token at end of list. */
  168. #define trans  trans_plus.Trans /* translation texts of scraps */
  169. #define no_math  2
  170. #define yes_math  1
  171. #define maybe_math  0 \
  172.  
  173. #define id_flag  ID_FLAG /* Signifies an identifier. */
  174. #define res_flag  2*id_flag /* Signifies a reserved word. */
  175. #define mod_flag  ((sixteen_bits)(3*(sixteen_bits)id_flag)) \
  176. /* Signifies a module name. */
  177. #define tok_flag  ((sixteen_bits)(4*(sixteen_bits)id_flag))/* signifies a token list. */
  178. #define inner_tok_flag  ((sixteen_bits)(5*(sixteen_bits)id_flag)) \
  179. /* Signifies a token list in `\Cb'. */ \
  180.  \
  181.  
  182. #define freeze_text  *(++text_ptr)= tok_ptr \
  183.  
  184. #define b_app2(a)b_app1(a);b_app1(a+1)
  185. #define b_app3(a)b_app2(a);b_app1(a+2)
  186. #define b_app4(a)b_app3(a);b_app1(a+3) \
  187.  
  188. #define FIRST_ID(p)(((tok0= first_id(p->trans))&&tok0!=050)?name_dir+tok0- \
  189. id_flag:name_dir)/* Ptr to actual id. */ \
  190.  
  191. #define cat0  pp->cat
  192. #define cat1  (pp+1)->cat
  193. #define cat2  (pp+2)->cat
  194. #define cat3  (pp+3)->cat
  195. #define cat4  (pp+4)->cat
  196. #define cat5  (pp+5)->cat \
  197.  
  198. #define indent_force  b_app(indent);b_app(force) \
  199.  \
  200. /* Append $m$~things, followed by a space, followed by $n$~things. */
  201. #define OPT9  APP_SPACE;app(opt);app(071) \
  202.  
  203. #define APP_SPACE  APP_STR("\\ ") \
  204.  
  205. #define INDENT  if(!indented) \
  206. { \
  207. b_app(indent); \
  208. indented= YES; \
  209. } \
  210.  
  211. #define OUTDENT  if(indented) \
  212. { \
  213. b_app(outdent); \
  214. indented= NO; \
  215. } \
  216.  
  217. #define MAX_OP_TOKENS  5 /* Maximum \# of tokens that could conceivably make up \
  218.     the function name. */ \
  219.  
  220. #define REDUCE(j,k,c,d,n)reduce(j,k,(eight_bits)(c),d,(RULE_NO)(n))
  221. #define SQUASH(j,k,c,d,n)squash(j,k,c,d,(RULE_NO)(n)) \
  222.  
  223. #define MAX_CYCLES  500
  224. #define OUT_WIDTH  40
  225.  
  226.  
  227.  
  228. #ifndef part
  229. #define part 0 /* Standard value, when the files aren't split. */
  230. #else
  231. #if(part != 1 && part != 2 && part != 3)
  232. #define part 1 /* Should issue error message here. */
  233. #endif
  234. #endif /* |part| */
  235.  
  236.  
  237.  
  238.  
  239. #if(part == 0 || part == 1)
  240. #define part1_or_extern
  241. #define SET1(stuff)  =  stuff
  242. #define TSET1(stuff)  =  stuff
  243. #else
  244. #define part1_or_extern extern
  245. #define SET1(stuff)
  246. #define TSET1(stuff)
  247. #endif
  248.  
  249.  
  250.  
  251.  
  252.  
  253. #include "typedefs.h"
  254.  
  255.  
  256.  
  257.  
  258.  
  259. #include "map.h"
  260.  
  261.  
  262.  
  263.  
  264. typedef struct xref_info0
  265. {
  266. sixteen_bits num;/* module number plus zero or |def_flag| */
  267. struct xref_info0 HUGE*xlink;/* pointer to the previous \
  268.                 cross-reference */
  269. boolean Language;/* Language in force for this module. */
  270. }xref_info;
  271.  
  272. typedef xref_info HUGE*xref_pointer;
  273. typedef ASCII HUGE*XREF_POINTER;/* For assignments like |name_dir->xref = \
  274.                 (XREF_POINTER)xref_ptr|. See the comment \
  275.                 immediately below about~|xref|. */
  276.  
  277.  
  278.  
  279. typedef sixteen_bits Token;
  280. typedef Token HUGE*token_pointer;
  281. typedef token_pointer HUGE*text_pointer;
  282.  
  283.  
  284.  
  285. typedef struct
  286. {
  287. eight_bits cat;/* Category. It would be nice to |enum| this, but \
  288. that would turn it into an |int|, which could be as much as four times \
  289. bigger. */
  290. eight_bits mathness;
  291. union
  292. {
  293. text_pointer Trans;
  294.  
  295.  
  296.  
  297. }trans_plus;
  298. }scrap;
  299.  
  300. typedef scrap HUGE*scrap_pointer;
  301.  
  302.  
  303.  
  304. typedef unsigned long RULE_NO;/* Rule number for the productions. */
  305.  
  306.  
  307.  
  308.  
  309. #include "p_type.h"
  310.  
  311.  
  312.  
  313.  
  314.  
  315. /* The shorter length here is primarily to keep the stack under control. \
  316. Now that |N_MSGBUF| is used  dynamically, maybe this statement isn't \
  317. necessary. */
  318. #ifdef SMALL_MEMORY
  319. #define N_MSGBUF 2000
  320. #else
  321. #define N_MSGBUF 10000
  322. #endif
  323.  
  324.  
  325.  
  326.  
  327.  
  328. EXTERN boolean change_exists;/* has any module changed? */
  329.  
  330.  
  331.  
  332. #ifndef COMMON_FCNS_
  333. IN_COMMON BUF_SIZE max_modules;/* Size allocated in \.{common.web}. */
  334. #endif
  335.  
  336. EXTERN BUF_SIZE max_refs;
  337. EXTERN xref_info HUGE*xmem;/* contains cross-reference information */
  338. EXTERN xref_pointer xmem_end;
  339.  
  340. EXTERN xref_pointer xref_ptr;/* the largest occupied position in |xmem| */
  341.  
  342. EXTERN sixteen_bits xref_switch,mod_xref_switch;/* either zero or |def_flag|. */
  343. EXTERN boolean defd_switch;/* Set by `\.{@[}'. */
  344. EXTERN NAME_TYPE defd_type SET(NEVER_DEFINED);
  345. EXTERN boolean typd_switch;/* Set by `\.{@]}'. */
  346. EXTERN boolean index_short;/* Set by `\.{@+}'. */
  347.  
  348.  
  349.  
  350. EXTERN long max_toks;/* number of symbols in \cee\ texts being parsed; \
  351.   must be less than |@r 65536 == 2^16|. */
  352. EXTERN Token HUGE*tok_mem;/* Dynamic array of tokens. */
  353. EXTERN token_pointer tok_m_end;/* End of |tok_mem|. */
  354.  
  355. EXTERN long max_texts;/* number of phrases in \cee\ texts being parsed; \
  356.   must be less than |ID_FLAG|. */
  357. EXTERN token_pointer HUGE*tok_start;/* Dynamic directory into |tok_mem|. */
  358. EXTERN text_pointer tok_end;/* End of |tok_start|. */
  359.  
  360. EXTERN token_pointer tok_ptr;/* First unused position in |tok_mem|. */
  361. EXTERN text_pointer text_ptr;/* First unused position in |tok_start|. */
  362.  
  363. EXTERN token_pointer mx_tok_ptr;/* Largest value of |tok_ptr|. */
  364. EXTERN text_pointer mx_text_ptr;/* Largest value of |text_ptr|. */
  365.  
  366.  
  367.  
  368. IN_PROD boolean dflush PSET(NO);/* Turn this on from debugger. */
  369.  
  370.  
  371.  
  372. EXTERN long max_scraps;/* Length of the next array. */
  373. EXTERN scrap HUGE*scrp_info;/* Dynamic memory array for scraps */
  374. EXTERN scrap_pointer scrp_end;/* end of |scrap_info|. */
  375.  
  376. EXTERN scrap_pointer pp;/* current position for reducing productions */
  377. EXTERN scrap_pointer scrp_base;/* beginning of the current scrap sequence */
  378. EXTERN scrap_pointer scrp_ptr;/* ending of the current scrap sequence */
  379. EXTERN scrap_pointer lo_ptr;/* last scrap that has been examined */
  380. EXTERN scrap_pointer hi_ptr;/* first scrap that has not been examined */
  381.  
  382. EXTERN scrap_pointer mx_scr_ptr;/* largest value assumed by |scrap_ptr| */
  383.  
  384.  
  385.  
  386. #ifndef COMMON_FCNS_
  387. IN_COMMON int tracing;/* Can be used to show parsing details. */
  388. #endif
  389.  
  390.  
  391.  
  392. IN_PROD int cur_mathness,ini_mathness,last_mathness;
  393.  
  394.  
  395.  
  396. IN_PROD sixteen_bits tok0;
  397.  
  398.  
  399.  
  400. IN_PROD PARSING_MODE translate_mode;/* Set by |translate|. */
  401.  
  402.  
  403.  
  404. IN_PROD boolean active_space PSET(NO);
  405. IN_PROD boolean in_LPROC PSET(NO);
  406. IN_PROD boolean expanded_lproc PSET(NO);
  407.  
  408.  
  409.  
  410. IN_PROD int in_prototype PSET(NO);
  411. /* This is used as a numerical counter. */
  412. IN_PROD int indented PSET(NO);
  413.  
  414.  
  415.  
  416. IN_PROD boolean in_function PSET(NO);
  417.  
  418.  
  419.  
  420. IN_PROD boolean typedefing PSET(NO);/* Are we inside a |typedef|? */
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  
  427. IN_PROD boolean forward_exp PSET(NO);
  428.  
  429.  
  430.  
  431. IN_PROD int fcn_level PSET(0);
  432.  
  433.  
  434.  
  435. IN_PROD text_pointer label_text_ptr[50];
  436.  
  437.  
  438.  
  439. IN_PROD boolean found_until PSET(NO);
  440.  
  441.  
  442.  
  443. IN_PROD int indent_level PSET(0);/* Indent level. */
  444. IN_PROD int loop_num[50],max_loop_num PSET(0);
  445.  
  446.  
  447.  
  448. IN_PROD int containing PSET(0);
  449.  
  450.  
  451.  
  452. /* For pc's, the file is split into two compilable parts using the \
  453. compiler-line macro |part|, which must equal either~1 or~2. */
  454. #if(part != 2)
  455.  
  456. #ifdef DEBUG
  457.  
  458. SRTN
  459. prn_cat FCN((c))
  460. eight_bits c C1("Category.")
  461. {
  462. switch(c)
  463. {
  464. case language_scrap:printf("@L");break;
  465. case expr:printf("expr");break;
  466. case exp_op:printf("^^");break;
  467. case _EXPR:printf("$_EXPR");break;case EXPR_:printf("$EXPR_");break;case _EXPR_:printf("$_EXPR_");break;
  468. case new_like:printf("new_like");break;
  469. case stmt:printf("stmt");break;
  470. case decl:printf("decl");break;
  471. case decl_hd:printf("decl_hd");break;
  472. case Decl_hd:printf("$Decl_hd");break;
  473. case struct_hd:printf("struct_hd");break;
  474. case functn:printf("functn");break;
  475. case fn_decl:printf("fn_decl");break;
  476. case fcn_hd:printf("fcn_hd");break;
  477. case else_like:printf("else");break;
  478. case ELSE_like:printf("ELSE");break;
  479. case if_hd:printf("if_hd");break;
  480. case IF_top:printf("IF_top");break;
  481. case else_hd:printf("else_hd");break;
  482. case for_hd:printf("for_hd");break;
  483. case unop:printf("unop");break;
  484. case UNOP:printf("$UNOP_");break;
  485. case binop:printf("binop");break;
  486. case BINOP:printf("$_BINOP_");break;
  487. case unorbinop:printf("unorbinop");break;
  488. case semi:printf(";");break;
  489. case colon:printf(":");break;
  490. case comma:printf(",");break;
  491. case COMMA:printf("$_COMMA_");break;
  492. case question:printf("?");break;
  493. case tag:printf("tag");break;
  494. case cast:printf("cast");break;
  495. case lpar:printf("(");break;
  496. case rpar:printf(")");break;
  497. case lbracket:printf("[");break;
  498. case rbracket:printf("]");break;
  499. case lbrace:printf("{");break;
  500. case rbrace:printf("}");break;
  501. case common_hd:printf("common_hd");break;
  502. case read_hd:printf("read_hd");break;
  503. case slash_like:printf("slash");break;
  504. case private_like:printf("private");break;
  505. case slashes:printf("slashes");break;
  506. case lproc:printf("#{");break;
  507. case LPROC:printf("LPROC");break;
  508. case rproc:printf("#}");break;
  509. case ignore_scrap:printf("ignore");break;
  510.  
  511. case define_like:printf("define");break;
  512. case no_order:printf("no_order");break;
  513. case do_like:printf("do");break;
  514. case while_do:printf("while");break;
  515. case Rdo_like:printf("Rdo");break;
  516. case if_like:printf("if");break;
  517. case IF_like:printf("IF");break;
  518. case for_like:printf("for");break;
  519. case program_like:printf("program");break;
  520. case int_like:printf("int");break;
  521. case modifier:printf("modifier");break;
  522. case huge_like:printf("huge");break;
  523. case CASE_like:printf("CASE");break;
  524. case case_like:printf("case");break;
  525. case sizeof_like:printf("sizeof");break;
  526. case op_like:printf("op");break;
  527. case proc_like:printf("proc");break;
  528. case class_like:printf("class");break;
  529. case struct_like:printf("struct");break;
  530. case typedef_like:printf("typedef");break;
  531. case imp_reserved:printf("imp_rsrvd");break;
  532. case extern_like:printf("extern");break;
  533. case common_like:printf("common");break;
  534. case read_like:printf("read");break;
  535. case entry_like:printf("entry");break;
  536. case implicit_like:printf("implicit");break;
  537. case implicit_hd:printf("implicit_hd");break;
  538. case built_in:printf("built_in");break;
  539. case endif_like:printf("endif");break;
  540. case end_like:printf("end");break;
  541. case END_like:printf("END");break;
  542. case END_stmt:printf("END_stmt");break;
  543. case go_like:printf("go");break;
  544. case newline:printf("\n");break;
  545. case label:printf("label");break;
  546. case space:printf("space");break;
  547. case until_like:printf("until");break;
  548. case template:printf("template");break;
  549. case langle:printf("langle");break;
  550. case rangle:printf("rangle");break;
  551. case tstart:printf("tstart");break;
  552. case tlist:printf("tlist");break;
  553. case namespace:printf("namespace");break;
  554. case virtual:printf("virtual");break;
  555. case reference:printf("ref");break;
  556.  
  557. case 0:printf("zero");break;
  558. default:printf("UNKNOWN");break;
  559. }
  560.  
  561. DFLUSH;
  562. }
  563.  
  564. #endif /* |DEBUG| */
  565.  
  566.  
  567.  
  568. #ifdef DEBUG
  569.  
  570. SRTN
  571. prn_text FCN((p))
  572. text_pointer p C1("The token list.")
  573. {
  574. token_pointer j;/* index into |tok_mem| */
  575. sixteen_bits r;/* remainder of token after the flag has been stripped off */
  576.  
  577. if(p>=text_ptr)printf("BAD");
  578. else for(j= *p;j<*(p+1);j++)
  579. {
  580. r= (sixteen_bits)(*j%id_flag);
  581.  
  582. switch(*j/id_flag)
  583. {
  584. case 1:printf("\\\\{");prn_id((name_dir+r));printf("}");break;
  585. /* |id_flag| */
  586. case 2:printf("\\&{");prn_id((name_dir+r));printf("}");break;
  587. /* |res_flag| */
  588. case 3:printf("<");prn_id((name_dir+r));printf(">");break;
  589. /* |mod_flag| */
  590. case 4:printf("[[%d]]",r);break;/* |tok_flag| */
  591. case 5:printf("|[[%d]]|",r);break;/* |inner_tok_flag| */
  592. default:
  593.  
  594. switch(r)
  595. {
  596. case math_bin:printf("\\mathbin}");break;
  597. case math_rel:printf("\\mathrel}");break;
  598. case big_cancel:printf("[ccancel]");break;
  599. case cancel:printf("[cancel]");break;
  600. case indent:printf("[indent]");break;
  601. case outdent:printf("[outdent]");break;
  602. case backup:printf("[backup]");break;
  603. case opt:printf("[opt]");break;
  604. case break_space:printf("[break]");break;
  605. case force:printf("[force]");break;
  606. case big_force:printf("[fforce]");break;
  607. case end_translation:printf("[quit]");break;
  608. default:putxchar(XCHR(r));
  609. }
  610.  
  611. ;
  612. }
  613. }
  614.  
  615. DFLUSH;
  616. }
  617.  
  618. #endif /* |DEBUG| */
  619.  
  620.  
  621.  
  622. SRTN
  623. app_str FCN((s))
  624. CONST outer_char HUGE*s C1("String to be appended.")
  625. {
  626. while(*s)app(XORD(*(s++)));
  627. }
  628.  
  629. SRTN
  630. app_ASCII_str FCN((s))
  631. CONST ASCII HUGE*s C1("")
  632. {
  633. while(*s)app(*s++);
  634. }
  635.  
  636.  
  637.  
  638. SRTN
  639. b_app FCN((a))
  640. Token a C1("Token to be appended.")
  641. {
  642. if(a==040||(a>=big_cancel&&a<=big_force))
  643. {/* Appending a non-math token, including a space. */
  644. if(cur_mathness==maybe_math)ini_mathness= no_math;
  645. else if(cur_mathness==yes_math)app(044);/* End math    mode. */
  646.  
  647. cur_mathness= last_mathness= no_math;
  648. }
  649. else
  650. {/* Append a math token. (Tokens can't be |maybe_math|.) */
  651. if(cur_mathness==maybe_math)ini_mathness= yes_math;
  652. else if(cur_mathness==no_math)app(044);/* Begin math mode. */
  653.  
  654. cur_mathness= last_mathness= yes_math;
  655. }
  656.  
  657. app(a);
  658. }
  659.  
  660.  
  661.  
  662. SRTN
  663. b_app1 FCN((a))
  664. scrap_pointer a C1("Scrap to be appended.")
  665. {
  666. switch(a->mathness%4)
  667. {/* Left boundary (|ini_mathness|) of the current scrap. */
  668. case no_math:
  669. if(cur_mathness==maybe_math)
  670. ini_mathness= no_math;
  671. else if(cur_mathness==yes_math)
  672. APP_STR("{}$");/* End math mode. (The braces take care of \
  673. ending the math part with something like a~$+$.) */
  674.  
  675. cur_mathness= last_mathness= a->mathness/4;
  676. /* Right boundary (|last_mathness|) */
  677. break;
  678.  
  679. case yes_math:
  680. if(cur_mathness==maybe_math)
  681. ini_mathness= yes_math;
  682. else if(cur_mathness==no_math)
  683. APP_STR("${}");/* Begin math mode.  (The braces take care \
  684. of beginning the math part with something like a~$+$.) */
  685.  
  686. cur_mathness= last_mathness= a->mathness/4;
  687. /* Right boundary (|last_mathness|) */
  688. break;
  689.  
  690. case maybe_math:
  691. break;/* No changes */
  692. }
  693.  
  694. app(a->trans+tok_flag-tok_start);
  695. }
  696.  
  697.  
  698. int
  699. get_language FCN((xp))
  700. text_pointer xp C1("")
  701. {
  702. token_pointer tp,tp1;
  703.  
  704. tp= *xp;
  705. tp1= *(xp+1)-1;/* The |-1| is because we should always have the \
  706.     combination |begin_language| followed by the language number. */
  707.  
  708. while(tp<tp1)
  709. if(*tp++==begin_language)return*tp;
  710.  
  711. return CONFUSION("get_language",
  712. "Can't find |begin_language| token in language_scrap");
  713. }
  714.  
  715.  
  716.  
  717. SRTN
  718. C_productions(VOID)
  719. {
  720. switch(pp->cat)
  721. {
  722. case ignore_scrap:
  723.  
  724. #if FCN_CALLS
  725. C_ignore_scrap();
  726. #else
  727.  
  728. {
  729. switch(cat1)
  730. {
  731. case stmt:
  732. case functn:
  733. SQUASH(pp,2,cat1,0,1);
  734. break;
  735. }
  736. }
  737.  
  738.  
  739. #endif
  740.  
  741. break;
  742. case built_in:
  743. #if FCN_CALLS
  744. R_built_in();
  745. #else
  746.  
  747. {
  748. b_app1(pp);
  749.  
  750. {
  751. b_app(0134);b_app(054);
  752. }
  753.  
  754. ;
  755. REDUCE(pp,1,expr,-2,9998);
  756. }
  757.  
  758.  
  759. #endif
  760.  
  761. break;
  762. case expr:
  763. #if FCN_CALLS
  764. C_expr();
  765. #else
  766.  
  767. {
  768. if(cat1==lbrace||((!Cpp)&&cat1==int_like))
  769. {/* ``|f(x) {}|'' or ``|f(x) float x;|'' (old-style) */
  770. defined_at(make_underlined(pp));/* Recognized function name; \
  771. remember current module number. */
  772. in_function= YES;
  773. SQUASH(pp,1,fn_decl,0,111);
  774. }
  775. else if(cat1==unop)
  776. SQUASH(pp,2,expr,-2,2);/* ``|x--|'' */
  777. else if(cat1==binop)
  778. {
  779. if(cat2==expr)
  780. SQUASH(pp,3,expr,-2,3);/* ``|x + y|'' */
  781. else if(cat2==decl_hd)
  782. SQUASH(pp,3,tstart,0,6061);
  783. /* Trap for ``|@c++ A<int>|'', with |A| undefined. */
  784. }
  785. else if(cat1==unorbinop&&cat2==expr)
  786. {
  787. sixteen_bits*s= *(pp+1)->trans;
  788. b_app1(pp);
  789.  
  790. /* If the translation of the next scrap begins with an escape character, we \
  791. assume we're seeing \.{\\amp}. */
  792. if((s[0]==(sixteen_bits)0134)&&s[1]==(sixteen_bits)0141
  793. &&s[2]==(sixteen_bits)0155)
  794. {
  795. APP_SPACE;b_app1(pp+1);APP_SPACE;/* ``|x & y|'' */
  796. }
  797. else b_app1(pp+1);/* ``|x*y|'' */
  798.  
  799. b_app1(pp+2);
  800. REDUCE(pp,3,expr,-2,3000);
  801. }
  802. else if(cat1==comma)
  803. {
  804. if((cat2==expr||cat2==int_like))/* ``|x,y|'' or ``|x,char|''  */
  805. {
  806. b_app2(pp);
  807. OPT9;
  808. b_app1(pp+2);REDUCE(pp,3,cat2,-2,4);
  809. }
  810. else if(cat2==space)
  811. SQUASH(pp,3,expr,-2,88);/* Macros. */
  812. }
  813. else if(cat1==expr)
  814. SQUASH(pp,2,expr,-2,5);/* ``|f(x)|'' */
  815. else if(cat1==semi)
  816. SQUASH(pp,2,stmt,-1,6);/* ``|x;|'' */
  817. else if(cat1==colon)/* ``|label:|'' */
  818. {
  819. if(!Cpp||in_function)
  820. {/* Ordinary C tag. */
  821. make_underlined(pp);/* Label name. */
  822. SQUASH(pp,2,tag,0,7);
  823. }
  824. else if(cat2==expr)
  825. {/* Put the spaces in explicitly in case we're not in math \
  826. mode at the time. */
  827. b_app1(pp);b_app(040);b_app1(pp+1);b_app(040);
  828. b_app1(pp+2);
  829. REDUCE(pp,3,expr,-2,701);
  830. /* \Cpp: ``|@c++ derived() : base()|'' */
  831. }
  832. }
  833. else if(cat1==space)
  834. SQUASH(pp,2,expr,-2,8);/* For use in macros. */
  835. }
  836.  
  837.  
  838. #endif
  839.  
  840. break;
  841. case exp_op:
  842. #if FCN_CALLS
  843. R_exp_op();
  844. #else
  845.  
  846. {
  847. if(cat1==lpar)SQUASH(pp,1,exp_op,PLUS 1,2995);/* ``|@r x^(a+b)|'' */
  848. else if(cat1==expr)
  849. if(cat2==lpar)SQUASH(pp,1,exp_op,PLUS 2,2996);/* Expand array \
  850. argument. */
  851. else if(cat2==expr)SQUASH(pp,1,exp_op,PLUS 1,2997);/* The expr is \
  852. the result of expanding the array argument. */
  853. else
  854. {/* It's now of the form |@r x^expr|; insert braces around \
  855. argument so \TeX\ understands. */
  856. b_app1(pp);
  857. b_app(0173);b_app1(pp+1);b_app(0175);
  858. REDUCE(pp,2,expr,-1,2998);
  859. }
  860. }
  861.  
  862.  
  863. #endif
  864.  
  865. break;
  866. case _EXPR:
  867. #if FCN_CALLS
  868. C__E();
  869. #else
  870.  
  871. {
  872. APP_SPACE;b_app1(pp);
  873. REDUCE(pp,1,expr,-2,4446);
  874. }
  875.  
  876.  
  877. #endif
  878.  
  879. break;
  880. case _EXPR_:
  881. #if FCN_CALLS
  882. C__E_();
  883. #else
  884.  
  885. {
  886.  
  887.  
  888. APP_SPACE;b_app1(pp);APP_SPACE;
  889.  
  890. ;
  891. REDUCE(pp,1,expr,-2,4447);
  892. }
  893.  
  894.  
  895. #endif
  896.  
  897. break;
  898. case EXPR_:
  899. #if FCN_CALLS
  900. C_E_();
  901. #else
  902.  
  903. {
  904. b_app1(pp);APP_SPACE;
  905. REDUCE(pp,1,expr,-2,4448);
  906. }
  907.  
  908.  
  909. #endif
  910.  
  911. break;
  912. case new_like:
  913. #if FCN_CALLS
  914. C_new_like();
  915. #else
  916.  
  917. {
  918. if(cat1==decl_hd||cat1==expr)
  919. {/* \Cpp: |@c++ new int| or |@c++ new class(20)| */
  920. b_app1(pp);b_app(040);b_app1(pp+1);
  921. if(cat1==decl_hd)
  922. {
  923. OUTDENT;
  924. }
  925. REDUCE(pp,2,expr,-2,909);
  926. }
  927. }
  928.  
  929.  
  930. #endif
  931.  
  932. break;
  933. case lpar:
  934. #if FCN_CALLS
  935. C_lpar();
  936. #else
  937.  
  938. {
  939. if(cat2==rpar&&(cat1==expr||cat1==unorbinop))
  940. SQUASH(pp,3,expr,-2,120);/* ``|(x)|''  or ``|(*)|''*/
  941. else if(cat1==rpar)
  942. {/* ``|()|''. This looks better with a bit of extra space between \
  943.         the parens. */
  944. b_app1(pp);
  945. {
  946. b_app(0134);b_app(073);
  947. }
  948.  
  949. ;b_app1(pp+1);
  950. REDUCE(pp,2,expr,-2,121);
  951. }
  952. else if((cat1==decl_hd)&&cat2==rpar)
  953. {/* Function prototype or cast, like ``|typedef (*T)|'' where |T| \
  954.         was |typedef|d on the first pass. */
  955. b_app3(pp);
  956.  
  957. OUTDENT;
  958.  
  959. if(in_prototype)
  960. in_prototype--;
  961.  
  962. REDUCE(pp,3,cast,-1,122);
  963. }
  964. else if(cat1==stmt)
  965. {/* ``|for(x;y;z)|'' */
  966. b_app2(pp);b_app(040);REDUCE(pp,2,lpar,0,123);
  967. }
  968. else if(cat1==for_like&&cat2==rpar)
  969. SQUASH(pp,3,expr,-2,1201);/* Macros: |(for)| */
  970. }
  971.  
  972.  
  973. #endif
  974.  
  975. break;
  976. case lbracket:
  977. #if FCN_CALLS
  978. C_lbracket();
  979. #else
  980.  
  981. {
  982. if(active_brackets)
  983. {
  984. b_app(0134);
  985. APP_STR("WXA{");
  986. }
  987. else b_app1(pp);
  988.  
  989. REDUCE(pp,1,lpar,0,5000);
  990. }
  991.  
  992.  
  993. #endif
  994.  
  995. break;
  996. case rbracket:
  997. #if FCN_CALLS
  998. C_rbracket();
  999. #else
  1000.  
  1001. {
  1002. if(active_brackets)
  1003. {
  1004. text_pointer t= indirect(pp->trans);
  1005.  
  1006. if(**t==0135)**t= 0175;
  1007. }
  1008.  
  1009. b_app1(pp);
  1010.  
  1011. REDUCE(pp,1,rpar,-3,5001);
  1012. }
  1013.  
  1014.  
  1015. #endif
  1016.  
  1017. break;
  1018. case question:
  1019. #if FCN_CALLS
  1020. C_question();
  1021. #else
  1022.  
  1023. {
  1024. if(cat1==expr&&cat2==colon)SQUASH(pp,3,binop,-2,30);/* ``|i==1 ? YES : \
  1025.                     NO|'' */
  1026. }
  1027.  
  1028.  
  1029. #endif
  1030.  
  1031. break;
  1032. case unop:
  1033. #if FCN_CALLS
  1034. C__unop();
  1035. #else
  1036.  
  1037. {
  1038. if(cat1==expr)
  1039. SQUASH(pp,2,expr,-2,140);/* ``|!x|'' or ``|++x|'' */
  1040. else if(cat1==int_like)
  1041. SQUASH(pp,2,int_like,0,141);/* \Cpp\ destructor: \
  1042.             ``|@c++ ~base|'' */
  1043. }
  1044.  
  1045.  
  1046. #endif
  1047.  
  1048. break;
  1049. case UNOP:
  1050. #if FCN_CALLS
  1051. C_UNOP();
  1052. #else
  1053.  
  1054. {
  1055. b_app1(pp);APP_SPACE;
  1056. REDUCE(pp,1,unop,-1,4443);
  1057. }
  1058.  
  1059.  
  1060. #endif
  1061.  
  1062. break;
  1063. case unorbinop:
  1064. #if FCN_CALLS
  1065. C_unorbinop();
  1066. #else
  1067.  
  1068. {
  1069. if(cat1==expr||(cat1==int_like&&!(cat2==lpar||cat2==unop)))
  1070. {/* ``|*p|'' or ``|&x|''; ``|typedef \
  1071.         (*T)|'' where |T| was |typedef|d on the first pass.  Not \
  1072. \Cpp:  ``|@c++ x + int(i)|'' or ``|@c++ x + base::y|''. */
  1073. b_app(0173);b_app1(pp);b_app(0175);
  1074. b_app1(pp+1);
  1075. REDUCE(pp,2,cat1,-2,150);
  1076. }
  1077. else if(cat1==binop)
  1078.  
  1079. {
  1080. b_app(math_bin);
  1081. b_app1(pp);
  1082. b_app(0173);b_app1(pp+1);b_app(0175);
  1083. b_app(0175);/* End |math_bin| */
  1084. REDUCE(pp,2,binop,-1,151);
  1085. }
  1086.  
  1087.  
  1088. }
  1089.  
  1090.  
  1091. #endif
  1092.  
  1093. break;
  1094. case binop:
  1095. #if FCN_CALLS
  1096. C__binop();
  1097. #else
  1098.  
  1099. {
  1100. if(cat1==binop)
  1101.  
  1102. {
  1103. b_app(math_bin);b_app1(pp);
  1104. b_app(0173);b_app1(pp+1);b_app(0175);
  1105. b_app(0175);/* End |math_bin| */
  1106. REDUCE(pp,2,binop,-1,180);
  1107. }
  1108.  
  1109. /* ``|+=|'' */
  1110. else if(cat1==space)
  1111. {
  1112. b_app1(pp);/* We eat the space in this macro situation. */
  1113. REDUCE(pp,2,binop,-1,181);/* |#if(a == b)|. */
  1114. }
  1115. else if(Cpp&&cat1==decl_hd)
  1116. SQUASH(pp,2,tstart,0,6063);
  1117. /* Trap for ``|@c++ A<int>|'', with |A| undefined.  See \
  1118.             also Rule 6061. */
  1119. }
  1120.  
  1121.  
  1122. #endif
  1123.  
  1124. break;
  1125. case BINOP:
  1126. #if FCN_CALLS
  1127. C_BINOP();
  1128. #else
  1129.  
  1130. {
  1131.  
  1132.  
  1133. APP_SPACE;b_app1(pp);APP_SPACE;
  1134.  
  1135. ;
  1136. REDUCE(pp,1,binop,-1,4444);
  1137. }
  1138.  
  1139.  
  1140. #endif
  1141.  
  1142. break;
  1143. case COMMA:
  1144. #if FCN_CALLS
  1145. C_COMMA();
  1146. #else
  1147.  
  1148. {
  1149.  
  1150.  
  1151. APP_SPACE;b_app1(pp);APP_SPACE;
  1152.  
  1153. ;
  1154. REDUCE(pp,1,comma,-1,4445);
  1155. }
  1156.  
  1157.  
  1158. #endif
  1159.  
  1160. break;
  1161. case cast:
  1162. #if FCN_CALLS
  1163. C_cast();
  1164. #else
  1165.  
  1166. {
  1167. if(cat1==expr)/* ``|(int *)p|'' */
  1168. {
  1169. b_app1(pp);
  1170. {
  1171. b_app(0134);b_app(054);
  1172. }
  1173.  
  1174. ;b_app1(pp+1);
  1175. REDUCE(pp,2,expr,-2,160);
  1176. }
  1177. else if(cat1==unorbinop||cat1==reference)
  1178. SQUASH(pp,1,cast,PLUS 1,162);/* ``|(int *)&prms|''. */
  1179. else
  1180. SQUASH(pp,1,expr,-2,161);/* Turn function prototype into expression. */
  1181. }
  1182.  
  1183.  
  1184. #endif
  1185.  
  1186. break;
  1187. case sizeof_like:
  1188. #if FCN_CALLS
  1189. C_sizeof_like();
  1190. #else
  1191.  
  1192. {
  1193. if(cat1==cast)
  1194. SQUASH(pp,2,expr,-2,170);/* ``|sizeof (int *)|'' */
  1195. else if(cat1==expr)
  1196. SQUASH(pp,2,expr,-2,171);/* ``|sizeof(x)|'' */
  1197. }
  1198.  
  1199.  
  1200. #endif
  1201.  
  1202. break;
  1203. case int_like:
  1204. #if FCN_CALLS
  1205. C_int_like();
  1206. #else
  1207.  
  1208. {
  1209. if(cat1==unop)
  1210. {
  1211. if(cat2==expr||cat2==int_like)
  1212. SQUASH(pp,3,expr,-2,35);/* \Cpp: |@c++ class::f| or \
  1213.             constructor: |@c++ class::class| */
  1214. else if(cat2==op_like)
  1215. SQUASH(pp,1,int_like,PLUS 2,36);/* \Cpp: Expand |@c++ operator| \
  1216.             construction. */
  1217. }
  1218. else if(cat1==int_like||cat1==struct_like)
  1219. {/* ``|extern int|'' or ``|@c++ typedef int bool|''. */
  1220. b_app1(pp);b_app(040);b_app1(pp+1);
  1221. REDUCE(pp,2,cat1,0,40);
  1222. }
  1223. else if(cat1==reference)
  1224. SQUASH(pp,2,int_like,-2,43);/* |@c++ int &ref;| */
  1225. else if(cat1==expr||cat1==unorbinop||cat1==semi)
  1226. {/* ``|int i|'' or ``|int *|'' */
  1227. b_app1(pp);
  1228.  
  1229. if(cat1!=semi)
  1230. b_app(040);
  1231.  
  1232. INDENT;/* Start long declaration. (Note: Whenever we leave \
  1233.             |decl_hd|, we must |OUTDENT|.) */
  1234.  
  1235. REDUCE(pp,1,decl_hd,-1,41);
  1236. }
  1237. else if(cat1==comma)
  1238. {
  1239. b_app1(pp);
  1240. INDENT;
  1241. REDUCE(pp,1,decl_hd,-2,42);/* Function prototype: |int,|. */
  1242. }
  1243. else if(cat1==rpar)
  1244. {
  1245. b_app1(pp);
  1246. INDENT;
  1247. REDUCE(pp,1,decl_hd,-2,502);
  1248. }
  1249. else if(Cpp&&cat1==lpar&&!in_prototype)
  1250. {/* The \Cpp\ is a KLUDGE. Consider ``|int (*f)()|''. */
  1251. b_app1(pp);
  1252.  
  1253. {
  1254. b_app(0134);b_app(054);
  1255. }
  1256.  
  1257.  
  1258. REDUCE(pp,1,expr,-2,5021);/* \Cpp\ constructor: ``|@c++ base()|''; \
  1259.                     or ``|@c++ int(x)|''. */
  1260. }
  1261. else if(cat1==binop&&cat2==expr)
  1262. SQUASH(pp,3,int_like,-2,5022);/* \Cpp\ initializer: |@c++ base = 0| */
  1263. else if(cat1==langle)
  1264. SQUASH(pp,1,int_like,PLUS 1,5997);/* |@c++ int<24>| */
  1265. else if(cat1==rangle)
  1266. {
  1267. b_app1(pp);
  1268. INDENT;
  1269. REDUCE(pp,1,decl_hd,-2,5998);
  1270. }
  1271. else if(cat1==class_like)
  1272. {/* \Cpp:  |@c++ friend class|. */
  1273. b_app1(pp);b_app(040);b_app1(pp+1);
  1274. REDUCE(pp,2,class_like,0,5995);
  1275. }
  1276. else if(cat1==tlist)
  1277. SQUASH(pp,2,int_like,-2,5999);
  1278. else if(cat1==namespace)
  1279. {/* |@c++ using namespace| */
  1280. b_app1(pp);b_app(040);b_app1(pp+1);
  1281. REDUCE(pp,2,namespace,0,5996);
  1282. }
  1283. }
  1284.  
  1285.  
  1286. #endif
  1287.  
  1288. break;
  1289. case extern_like:
  1290. #if FCN_CALLS
  1291. C_ext_like();
  1292. #else
  1293.  
  1294. {
  1295. if(Cpp&&cat1==expr)
  1296. {/* |@c++ extern "C"| */
  1297. b_app1(pp);b_app(040);b_app1(pp+1);
  1298. if(cat2==lbrace)
  1299. REDUCE(pp,2,fn_decl,0,5025);/* ``|@c++ extern "C" {}|''. */
  1300. else
  1301. REDUCE(pp,2,int_like,0,5023);
  1302. /* ``|@c++ extern "C" int fcn();|'' */
  1303. }
  1304. else
  1305. SQUASH(pp,1,int_like,0,5024);
  1306. }
  1307.  
  1308.  
  1309. #endif
  1310.  
  1311. break;
  1312. case modifier:
  1313. #if FCN_CALLS
  1314. C_modifier();
  1315. #else
  1316.  
  1317. {
  1318. if(cat1==int_like)
  1319. SQUASH(pp,1,int_like,-2,503);
  1320. else if(pp==lo_ptr)
  1321. SQUASH(pp,1,expr,0,5040);
  1322. else if(cat1==semi||cat1==lbrace)
  1323. SQUASH(pp,1,_EXPR,0,5042);
  1324. /* |@c++ int f() const;| or |@c++ int f() const {}|. */
  1325. else
  1326. SQUASH(pp,1,EXPR_,0,5041);
  1327. }
  1328.  
  1329.  
  1330. #endif
  1331.  
  1332. break;
  1333. case huge_like:
  1334. #if FCN_CALLS
  1335. C_huge_like();
  1336. #else
  1337.  
  1338. {
  1339. if(cat1==unorbinop)
  1340. {
  1341. b_app1(pp);APP_SPACE;b_app1(pp+1);
  1342. REDUCE(pp,2,unorbinop,-1,505);
  1343. }
  1344. }
  1345.  
  1346.  
  1347. #endif
  1348.  
  1349. break;
  1350. case decl_hd:
  1351. #if FCN_CALLS
  1352. C_decl_hd();
  1353. #else
  1354.  
  1355. {
  1356. if(cat1==rpar)
  1357. {
  1358. if((pp-1)->cat==lpar)
  1359. SQUASH(pp,1,decl_hd,-1,4990);/* ``|(int i)|''. */
  1360. else if((pp-2)->cat==decl_hd)
  1361. SQUASH(pp,1,decl_hd,-2,4991);/* ``|(int i, int j)|''. */
  1362. else if((pp-3)->cat==decl_hd)
  1363. SQUASH(pp,1,decl_hd,-3,4992);
  1364. }
  1365. else if(cat1==decl_hd)
  1366. SQUASH(pp,2,decl_hd,0,50);/* ``|(int,int)|'' */
  1367. else if(cat1==comma)
  1368. {
  1369. if(cat2==decl_hd)
  1370. {/* For function prototype. */
  1371. b_app2(pp);OPT9;
  1372. b_app1(pp+2);
  1373. REDUCE(pp,3,decl_hd,0,501);
  1374. }
  1375. else if(cat2==ignore_scrap&&cat3==decl_hd)
  1376. {/* For function prototype with comment. */
  1377. b_app2(pp);OPT9;
  1378. b_app2(pp+2);
  1379. REDUCE(pp,4,decl_hd,0,504);
  1380. }
  1381. #if 0
  1382. else if(Cpp&&(cat2==decl||cat2==stmt))
  1383. SQUASH(pp,3,stmt,-2,508);
  1384. /* ``|@c++ for(int i=0, int j=0;;)|'' or ``|@c++ \
  1385.                 for(int i=0, int j=0, int k=0;;)|''. */
  1386. #endif
  1387. else
  1388. {/* ``|int i,|'' */
  1389. if(cat2==ignore_scrap&&(cat3==int_like||cat3==struct_like||
  1390. cat3==modifier))
  1391. {/* Function prototype, with intervening comment. */
  1392. b_app1(pp);
  1393. if((pp-3)->cat!=decl_hd&&(pp-2)->cat!=decl_hd
  1394. &&cat3!=modifier)
  1395. in_prototype++;
  1396. REDUCE(pp,1,decl_hd,PLUS 3,5221);
  1397. }
  1398. else if(cat2==int_like||cat2==struct_like||cat2==modifier)
  1399. {/* Function prototype. */
  1400. b_app1(pp);
  1401. if((pp-3)->cat!=decl_hd&&(pp-2)->cat!=decl_hd
  1402. &&cat2!=modifier)
  1403. in_prototype++;/* The |modifier| clause is to \
  1404. prevent a situation like |(int, const int)| from thinking it's two levels \
  1405. of prototypes. */
  1406. REDUCE(pp,1,decl_hd,PLUS 2,52);
  1407. }
  1408. else
  1409. {/* Expecting list of something. */
  1410. b_app2(pp);b_app(040);
  1411.  
  1412. #if 0
  1413. if(Cpp)
  1414. REDUCE(pp,2,decl_hd,-2,540);
  1415. /* ``|@c++ int i=0, int j=0|'' (e.g., in |for|) */
  1416. else
  1417. #endif
  1418. REDUCE(pp,2,decl_hd,-1,54);/* ``|int i,j|'' */
  1419. }
  1420. }
  1421. }
  1422. else if(cat1==unorbinop)/* ``|int **p|'' */
  1423. {
  1424. b_app1(pp);
  1425. b_app1(pp+1);
  1426. REDUCE(pp,2,decl_hd,-1,55);
  1427. }
  1428. else if(cat1==expr)/* ``|int i|'' or ``|int i, j|'' */
  1429. {
  1430. make_underlined(pp+1);
  1431. SQUASH(pp,2,decl_hd,-1,56);/* The |-1| is to pick up a left \
  1432.                     paren for function prototype. */
  1433. }
  1434. else if((cat1==binop||cat1==colon
  1435. ||cat1==expr /* (for initializations) */
  1436. )&&cat2==expr&&(cat3==comma||cat3==semi||cat3==rpar))
  1437. #if 0
  1438. if(cat1==binop)
  1439. {
  1440. b_app1(pp);b_app(040);b_app2(pp+1);
  1441. REDUCE(pp,3,decl_hd,-1,5660);
  1442. }
  1443. else
  1444. #endif
  1445. SQUASH(pp,3,decl_hd,-1,5661);
  1446. else if(cat1==int_like&&(cat2==unop||cat2==langle))
  1447. SQUASH(pp,1,decl_hd,PLUS 1,5662);
  1448. /* \Cpp:  ``|@c++ void *int::fcn()|'' or ``|@c++ void \
  1449.         *int<int>::fcn()|'' */
  1450. else if(cat1==lbrace||(cat1==int_like&&
  1451. ((pp-1)->trans==NULL||**(pp-1)->trans!=050)))/* \
  1452. Recognize beginning of function: ``|float f() {}|'' or ``|float f(x) float \
  1453. x|'' */
  1454. {
  1455. b_app1(pp);
  1456. OUTDENT;
  1457. in_function= YES;
  1458. defined_at(FIRST_ID(pp));
  1459. REDUCE(pp,1,fn_decl,0,58);
  1460. }
  1461. else if(cat1==semi)
  1462. {/* ``|int i;|'' */
  1463. b_app2(pp);
  1464. OUTDENT;/* Finish long declaration. */
  1465. #if 0
  1466. if(Cpp)
  1467. REDUCE(pp,2,decl,-2,594);
  1468. /* ``|@c++ for(int i=0, int j=0;;)|'' */
  1469. else
  1470. #endif
  1471. REDUCE(pp,2,decl,-1,59);
  1472. }
  1473. else if(Cpp&&cat1==int_like&&cat2==unop)
  1474. SQUASH(pp,1,decl_hd,PLUS 1,590);/* \Cpp: |@c++ void *class::f| */
  1475. else if(Cpp&&cat1==rangle)
  1476. SQUASH(pp,1,decl_hd,-2,591);/* \Cpp:  end of template. */
  1477. else if(Cpp&&cat1==struct_like)
  1478. SQUASH(pp,2,decl_hd,-1,593);
  1479. /* \Cpp: |@c++ template<class C1, class C2>|. */
  1480. }
  1481.  
  1482.  
  1483. #endif
  1484.  
  1485. break;
  1486. case decl:
  1487. #if FCN_CALLS
  1488. C_decl();
  1489. #else
  1490.  
  1491. {
  1492. if(Cpp)
  1493. {
  1494. if(cat1==functn)
  1495. {
  1496. b_app1(pp);b_app(big_force);
  1497. b_app1(pp+1);
  1498. REDUCE(pp,2,functn,-1,61);
  1499. }
  1500. else
  1501. SQUASH(pp,1,stmt,-1,611);/* E.g., ``|@c++ for(int i=0;;)|'' */
  1502. }
  1503. else
  1504. {
  1505. if(cat1==decl)
  1506. {/* ``|int i; float x;|'' */
  1507. b_app1(pp);b_app(force);
  1508. b_app1(pp+1);
  1509. REDUCE(pp,2,decl,-1,60);
  1510. }
  1511. else if(cat1==stmt||cat1==functn)
  1512. {/* ``|int i; x=0;|'' or ``|int i; f(){}|'' */
  1513. b_app1(pp);b_app(big_force);
  1514. b_app1(pp+1);
  1515. REDUCE(pp,2,cat1,-1,61);
  1516. }
  1517. }
  1518. }
  1519.  
  1520.  
  1521. #endif
  1522.  
  1523. break;
  1524. case typedef_like:
  1525. #if FCN_CALLS
  1526. C_typedef_like();
  1527. #else
  1528.  
  1529. {
  1530. if(cat1==decl_hd&&(cat2==expr||cat2==int_like))
  1531. {
  1532. make_underlined(pp+2);make_reserved(pp+2);/* NEEDS TO BE IMPROVED! */
  1533. b_app2(pp+1);
  1534. REDUCE(pp+1,2,decl_hd,0,90);
  1535. }
  1536. else if(cat1==decl)
  1537. {
  1538. b_app1(pp);b_app(040);b_app1(pp+1);
  1539. REDUCE(pp,2,decl,-1,91);
  1540. }
  1541. else if(cat1==semi)
  1542. SQUASH(pp,2,stmt,-1,94);
  1543. /* ``|typedef|''. */
  1544. else if(cat1==stmt)
  1545. {
  1546. b_app1(pp);b_app(040);b_app1(pp+1);
  1547. REDUCE(pp,2,stmt,-1,95);
  1548. /* ``|typedef int I[3]|''. (|I| is defined in first pass.) */
  1549. }
  1550.  
  1551. }
  1552.  
  1553.  
  1554. #endif
  1555.  
  1556. break;
  1557. case imp_reserved:
  1558. #if FCN_CALLS
  1559. C_imp_reserved();
  1560. #else
  1561.  
  1562. {
  1563. if(typedefing)SQUASH(pp,1,expr,-2,92);
  1564. else SQUASH(pp,1,int_like,-2,93);
  1565. }
  1566.  
  1567.  
  1568. #endif
  1569.  
  1570. break;
  1571. case op_like:
  1572. #if FCN_CALLS
  1573. C_op_like();
  1574. #else
  1575.  
  1576. {
  1577. short n;
  1578. /* The actual number of tokens that make up the effective function name. */
  1579.  
  1580. if((cat1==lpar&&cat2==rpar)||(cat1==lbracket&&cat2==rbracket))
  1581. {/* |@c++ operator ()()|  is a special case because it begins with \
  1582. left paren.  |@c++ operator []()| is handled as a special case because we \
  1583. now have the categories |lbracket| and |rbracket|, and |lbracket| doesn't \
  1584. regress when it's reduced to |lpar|. */
  1585. b_app1(pp);b_app(040);b_app1(pp+1);
  1586.  
  1587. {
  1588. b_app(0134);b_app(054);
  1589. }
  1590.  
  1591.  
  1592. b_app1(pp+2);
  1593. n= 3;
  1594. }
  1595. else
  1596. {/* We'll search for the obligatory left paren that indicates the \
  1597. argument list. */
  1598. scrap_pointer q;
  1599. int k;/* Counter. */
  1600.  
  1601. /* If the paren is missing, we could end up appending the entire rest of \
  1602. the code, so we limit the search. */
  1603. for(q= pp+1;q<=scrp_ptr&&q-pp<=MAX_OP_TOKENS;q++)
  1604. if(q->cat==lpar)break;
  1605.  
  1606. n= (q->cat==lpar)?PTR_DIFF(short,q,pp):0;
  1607.  
  1608. /* Append all the tokens between |operator| and left paren. */
  1609. if(n>0)
  1610. {
  1611. text_pointer xp;
  1612. token_pointer tp,tp1;
  1613.  
  1614. b_app1(pp);b_app(040);/* |operator| */
  1615. b_app(0173);/* Braces prevent possible spurious blanks \
  1616. before the left paren. */
  1617.  
  1618. id_first= id_loc= mod_text+1;
  1619.  
  1620. for(k= 1;k<n;k++)
  1621. {
  1622. b_app1(pp+k);
  1623.  
  1624. xp= indirect((pp+k)->trans);
  1625. tp= *xp;
  1626. tp1= *(xp+1);
  1627. while(tp<tp1)
  1628. *id_loc++= (ASCII)(*tp++);
  1629. }
  1630.  
  1631. underline_xref(id_lookup(id_first,id_loc,0));
  1632.  
  1633. b_app(0175);
  1634. }
  1635. }
  1636.  
  1637. if(n>0)
  1638. REDUCE(pp,n,expr,-2,6666);
  1639. }
  1640.  
  1641.  
  1642. #endif
  1643.  
  1644. break;
  1645. case class_like:
  1646. #if FCN_CALLS
  1647. C_class_like();
  1648. #else
  1649.  
  1650. {
  1651. if(cat1==expr||cat1==int_like)
  1652. {/* \Cpp: |@c++ class A| */
  1653. make_underlined(pp+1);make_reserved(pp+1);
  1654.  
  1655. b_app1(pp);b_app(040);b_app1(pp+1);
  1656.  
  1657. if((pp-1)->cat==tstart||(pp-1)->cat==decl_hd)
  1658. REDUCE(pp,2,decl_hd,-1,8998);
  1659. else
  1660. REDUCE(pp,2,struct_like,0,8999);
  1661. }
  1662. else if(cat1==lbrace)
  1663. SQUASH(pp,1,struct_like,0,8987);
  1664. /* |@c++ class{}| or |@c++ struct{}|. */
  1665. }
  1666.  
  1667.  
  1668. #endif
  1669.  
  1670. break;
  1671. case struct_like:
  1672. #if FCN_CALLS
  1673. C_struct_like();
  1674. #else
  1675.  
  1676. {
  1677. if(cat1==lbrace)
  1678. {/* ``|struct {int i;} S;|'' or \Cpp: ``|@c++ class A{int i;};|'' */
  1679. b_app1(pp);indent_force;
  1680. b_app1(pp+1);REDUCE(pp,2,struct_hd,0,100);
  1681. }
  1682. else if(cat1==expr)
  1683. {/* Structure name: ``|struct s|'' */
  1684. if(cat2==lbrace)/* ``|struct s {}|'' */
  1685. {
  1686. /* In \Cpp, this construction defines a new type. */
  1687. if(Cpp)
  1688. {make_underlined(pp+1);make_reserved(pp+1);}
  1689.  
  1690. b_app1(pp);b_app(040);b_app1(pp+1);
  1691. indent_force;
  1692. b_app1(pp+2);
  1693. REDUCE(pp,3,struct_hd,0,101);
  1694. }
  1695. else /* ``|struct s ss|'' */
  1696. {
  1697. b_app1(pp);b_app(040);b_app1(pp+1);
  1698. REDUCE(pp,2,int_like,-1,102);
  1699. }
  1700. }
  1701. else if(cat1==colon&&cat2==int_like&&Cpp)
  1702. {/* |@c++ class A: base| */
  1703. if(cat3==langle)
  1704. SQUASH(pp,1,struct_like,PLUS 3,1023);
  1705. else
  1706. {
  1707. b_app1(pp);b_app(040);b_app1(pp+1);b_app(040);
  1708. b_app1(pp+2);
  1709. REDUCE(pp,3,struct_like,0,1021);
  1710. }
  1711. }
  1712. else if(cat1==comma&&cat2==int_like&&Cpp)
  1713. {/* |@c++ class A: base, base | */
  1714. if(cat3==langle)
  1715. SQUASH(pp,1,struct_like,PLUS 3,1024);
  1716. else
  1717. {
  1718. b_app2(pp);b_app(040);b_app1(pp+2);
  1719. REDUCE(pp,3,struct_like,0,1022);
  1720. }
  1721. }
  1722. else if(cat1==tlist)
  1723. SQUASH(pp,2,struct_like,0,1025);/* \Cpp: |@c++ class A<int>|. */
  1724. else if(cat1==semi)
  1725. SQUASH(pp,2,decl,-1,103);/* \Cpp: |@c++ class base;| */
  1726. else if(cat1==rangle)
  1727. SQUASH(pp,1,decl_hd,-2,592);/* \Cpp:  end of template. */
  1728. }
  1729.  
  1730.  
  1731. #endif
  1732.  
  1733. break;
  1734. case struct_hd:
  1735. #if FCN_CALLS
  1736. C_str_hd();
  1737. #else
  1738.  
  1739. {
  1740. if((cat1==decl||cat1==stmt
  1741. ||cat1==expr /*  (For enum) */
  1742. ||cat1==functn /* \Cpp */
  1743. )&&cat2==rbrace)
  1744. {
  1745. b_app1(pp);/* ``|struct {|'' */
  1746. b_app(force);b_app1(pp+1);/* Body */
  1747. b_app(force);b_app1(pp+2);/* ``|}|'' */
  1748. b_app(outdent);
  1749. REDUCE(pp,3,int_like,-1,110);
  1750. }
  1751. else if(cat1==rbrace)
  1752. {
  1753. b_app1(pp);
  1754. {
  1755. b_app(0134);b_app(054);
  1756. }
  1757.  
  1758. b_app1(pp+1);
  1759. b_app(outdent);
  1760. REDUCE(pp,2,int_like,-1,1101);
  1761. }
  1762. }
  1763.  
  1764.  
  1765. #endif
  1766.  
  1767. break;
  1768. case fn_decl:
  1769. #if FCN_CALLS
  1770. C_fn_decl();
  1771. #else
  1772.  
  1773. {
  1774. if(cat1==semi&&Cpp)
  1775. {/* |@c++ using namespace X;| */
  1776. b_app2(pp);
  1777. REDUCE(pp,2,stmt,-1,72);
  1778. }
  1779. else if(cat1==decl)/* ``|f(x) float x;|'' */
  1780. {
  1781. b_app1(pp);
  1782. b_app(indent);indent_force;
  1783. b_app1(pp+1);/* Accrete old-style declarations. */
  1784. b_app(outdent);b_app(outdent);
  1785. REDUCE(pp,2,fn_decl,0,70);
  1786. }
  1787. else if(cat1==stmt)/* ``|f(){}|'' */
  1788. {
  1789. #if(0)
  1790. b_app(backup);/* Beginning of function. */
  1791. #endif
  1792. b_app1(pp);b_app(force);
  1793. b_app(indent);
  1794. b_app1(pp+1);/* Function body */
  1795. b_app(outdent);
  1796. in_function= NO;
  1797. REDUCE(pp,2,functn,-1,71);
  1798. }
  1799. }
  1800.  
  1801.  
  1802. #endif
  1803.  
  1804. break;
  1805. case functn:
  1806. #if FCN_CALLS
  1807. C_functn();
  1808. #else
  1809.  
  1810. {
  1811. if(cat1==functn||cat1==decl||cat1==stmt)
  1812. {
  1813. b_app1(pp);b_app(big_force);
  1814. b_app1(pp+1);REDUCE(pp,2,cat1,-1,80);/* |-1| for \Cpp */
  1815. }
  1816. }
  1817.  
  1818.  
  1819. #endif
  1820.  
  1821. break;
  1822. case lbrace:
  1823. #if FCN_CALLS
  1824. C_lbrace();
  1825. #else
  1826.  
  1827. {
  1828. if(cat1==rbrace)/* ``|{}|'' */
  1829. {
  1830. b_app1(pp);
  1831. {
  1832. b_app(0134);b_app(054);
  1833. }
  1834.  
  1835. ;b_app1(pp+1);
  1836. REDUCE(pp,2,stmt,-1,130);
  1837. }
  1838. else if((cat1==stmt||cat1==decl||cat1==functn)&&cat2==rbrace)
  1839. /* ``|{x;}|''  or \dots\ or \Cpp:  |@c++ main(){try{}catch(){}}| */
  1840. {
  1841. b_app(force);
  1842. b_app1(pp);/* ``|{|'' */
  1843. b_app(force);
  1844. b_app1(pp+1);/* Body */
  1845. b_app(force);
  1846. b_app1(pp+2);/* ``|}|'' */
  1847. REDUCE(pp,3,stmt,-1,131);
  1848. }
  1849. else if(cat1==expr)
  1850. {
  1851. if(cat2==rbrace)
  1852. SQUASH(pp,3,expr,-2,132);/* ``|enum{red}|'' */
  1853. else if(cat2==comma&&cat3==rbrace)
  1854. SQUASH(pp,4,expr,-2,132);
  1855. }
  1856. }
  1857.  
  1858.  
  1859. #endif
  1860.  
  1861. break;
  1862. case do_like:
  1863. #if FCN_CALLS
  1864. C_do_like();
  1865. #else
  1866.  
  1867. {
  1868. if(cat1==stmt)
  1869. if(cat2==for_like)
  1870. {
  1871. cat2= while_do;
  1872. SQUASH(pp,1,do_like,PLUS 2,191);
  1873. }
  1874. else if(cat2==expr&&cat3==semi)
  1875. {/* ``|do {} while(flag);|'' */
  1876. b_app1(pp);/* ``\&{do}'' */
  1877. indent_force;
  1878. b_app1(pp+1);/* stmt */
  1879. b_app(outdent);
  1880. b_app(force);
  1881. b_app2(pp+2);/* ``\&{while}\dots'' */
  1882. REDUCE(pp,4,stmt,-1,190);
  1883. }
  1884. }
  1885.  
  1886.  
  1887. #endif
  1888.  
  1889. break;
  1890. case while_do:
  1891. #if FCN_CALLS
  1892. C_wh_do();
  1893. #else
  1894.  
  1895. {
  1896. b_app1(pp);
  1897.  
  1898. {
  1899. b_app(0134);b_app(054);
  1900. }
  1901.  
  1902. ;
  1903. REDUCE(pp,1,expr,0,192);
  1904. }
  1905.  
  1906.  
  1907. #endif
  1908.  
  1909. break;
  1910. case if_like:
  1911. #if FCN_CALLS
  1912. C_if_like();
  1913. #else
  1914.  
  1915. {
  1916. if(cat1==lpar&&cat2==expr&&cat3==rpar)/* ``|if(x)|'' */
  1917. {
  1918. b_app1(pp);
  1919. {
  1920. b_app(0134);b_app(054);
  1921. }
  1922.  
  1923. ;b_app3(pp+1);
  1924. #if(0)
  1925. cmnt_after_IF= (cat4==ignore_scrap);/* Comment coming up? */
  1926. #endif
  1927. REDUCE(pp,4,IF_like,0,220);
  1928. }
  1929. }
  1930.  
  1931.  
  1932. #endif
  1933.  
  1934. break;
  1935. case IF_like:
  1936. #if FCN_CALLS
  1937. C_IF();
  1938. #else
  1939.  
  1940. {
  1941. if(cat1==stmt
  1942. ||cat1==lbrace||cat1==if_like||cat1==for_like||cat1==do_like
  1943. ||cat1==Rdo_like
  1944. #if(0)
  1945. ||cmnt_after_IF
  1946. #endif
  1947. )
  1948. SQUASH(pp,1,if_hd,0,230);/* |if_hd| does the indenting. */
  1949. #if(0)
  1950. else if(cat1==stmt)
  1951. {/* Attach simple statement. */
  1952. b_app1(pp);b_app(040);b_app1(pp+1);
  1953. REDUCE(pp,2,IF_top,-1,231);
  1954. }
  1955. #endif
  1956. }
  1957.  
  1958.  
  1959. #endif
  1960.  
  1961. break;
  1962. case IF_top:
  1963. #if FCN_CALLS
  1964. C_IF_top();
  1965. #else
  1966.  
  1967. {
  1968. if(cat1==else_like||cat1==else_hd)
  1969. SQUASH(pp,1,IF_top,1,242);/* Expand ahead. */
  1970. else if(cat1==IF_top)
  1971. {
  1972. b_app1(pp);/* \&{if}\dots */
  1973. b_app(force);
  1974. b_app1(pp+1);/* \&{else if}\dots */
  1975. REDUCE(pp,2,IF_top,-1,238);
  1976. }
  1977. else if(cat1==ELSE_like)
  1978. {
  1979. b_app1(pp);/* \&{if} */
  1980. b_app(force);
  1981. b_app1(pp+1);/* \&{else} */
  1982. REDUCE(pp,2,stmt,-1,239);
  1983. }
  1984. else if(cat1==IF_like&&(cat2==expr||cat2==stmt))
  1985. SQUASH(pp,1,IF_top,1,241);
  1986. else
  1987. SQUASH(pp,1,stmt,-1,240);
  1988. }
  1989.  
  1990.  
  1991. #endif
  1992.  
  1993. break;
  1994. case for_like:
  1995. #if FCN_CALLS
  1996. C_for_like();
  1997. #else
  1998.  
  1999. {
  2000. if(cat1==expr)
  2001. {/* ``\&{for}\dots'' */
  2002. b_app1(pp);
  2003. {
  2004. b_app(0134);b_app(054);
  2005. }
  2006.  
  2007. ;b_app1(pp+1);
  2008. b_app(040);
  2009.  
  2010. if(cat2==semi)
  2011. {/* ``|for(;;);|'' */
  2012. if(!auto_semi||(auto_semi&&cat3==semi))
  2013. {
  2014. indent_force;
  2015. b_app1(pp+2);/* Semi on separate line. */
  2016. b_app(outdent);
  2017. REDUCE(pp,3,stmt,-2,200);/*  The $-2$ is for the \
  2018. \&{do} case. Also get here from Ratfor's \&{until}. */
  2019. }
  2020. else
  2021. REDUCE(pp,3,for_hd,0,2011);/* Eat the |auto_semi|. */
  2022. }
  2023. else
  2024. REDUCE(pp,2,for_hd,0,201);/* Eat the arguments. */
  2025. }
  2026. else if(cat1!=lpar)
  2027. SQUASH(pp,1,expr,0,2010);/* Default possiblity. */
  2028. }
  2029.  
  2030.  
  2031. #endif
  2032.  
  2033. break;
  2034. case for_hd:
  2035. #if FCN_CALLS
  2036. C_forhd();
  2037. #else
  2038.  
  2039. {
  2040. if(cat1==stmt)
  2041. {/* ``|for(;;) x;|'' */
  2042. b_app1(pp);
  2043. indent_force;
  2044. b_app1(pp+1);
  2045. b_app(outdent);
  2046. REDUCE(pp,2,stmt,-1,210);
  2047. }
  2048. }
  2049.  
  2050.  
  2051. #endif
  2052.  
  2053. break;
  2054. case else_like:
  2055. #if FCN_CALLS
  2056. C_else();
  2057. #else
  2058.  
  2059. {
  2060. if(cat1==if_like)/* ``|else if|'' */
  2061. {
  2062. b_app1(pp);b_app(040);b_app1(pp+1);
  2063. REDUCE(pp,2,if_like,0,235);
  2064. }
  2065. else if(cat1==stmt||cat1==lbrace||cat1==for_like||cat1==do_like)
  2066. SQUASH(pp,1,else_hd,0,236);/* ``|else {}|'' */
  2067. #if 0 /* The following puts simple statement on same line. */
  2068. else if(cat1==stmt)/* ``|else z;|'' */
  2069. {
  2070. b_app1(pp);b_app(040);b_app1(pp+1);
  2071. REDUCE(pp,2,ELSE_like,-1,237);
  2072. }
  2073. #endif
  2074. }
  2075.  
  2076.  
  2077. #endif
  2078.  
  2079. break;
  2080. case if_hd:
  2081. #if FCN_CALLS
  2082. C_if_hd();
  2083. #else
  2084.  
  2085. {
  2086. if(cat1==stmt)/* ``|if(x) {}|'' */
  2087. {
  2088. b_app1(pp);/* ``|if(x)|'' */
  2089. indent_force;
  2090. b_app1(pp+1);/* ``|{}|'' */
  2091. b_app(outdent);
  2092. REDUCE(pp,2,IF_top,-1,233);
  2093. }
  2094. else if(cat1==IF_top&&cat2==else_like)
  2095. SQUASH(pp,1,if_hd,2,234);
  2096. }
  2097.  
  2098.  
  2099. #endif
  2100.  
  2101. break;
  2102. case else_hd:
  2103. #if FCN_CALLS
  2104. C_els_hd();
  2105. #else
  2106.  
  2107. {
  2108. if(cat1==stmt)/* ``|if(x) {}|'' */
  2109. {
  2110. b_app1(pp);/* ``|if(x)|'' */
  2111. indent_force;
  2112. b_app1(pp+1);/* ``|{}|'' */
  2113. b_app(outdent);
  2114. REDUCE(pp,2,ELSE_like,-1,241);
  2115. }
  2116. }
  2117.  
  2118.  
  2119. #endif
  2120.  
  2121. break;
  2122. case case_like:
  2123. #if FCN_CALLS
  2124. C_case_like();
  2125. #else
  2126.  
  2127. {
  2128. if(cat1==semi)
  2129. SQUASH(pp,2,stmt,-1,260);/* |return;| */
  2130. else if(cat1==colon)
  2131. SQUASH(pp,2,tag,-1,261);/* |default:| or \Cpp: |@c++ public:| */
  2132. else if(cat1==expr)
  2133. {
  2134. if(cat2==semi)/* |return x;| */
  2135. {
  2136. b_app1(pp);b_app(040);b_app2(pp+1);
  2137. REDUCE(pp,3,stmt,-1,262);
  2138. }
  2139. else if(cat2==colon)/* |case one:| */
  2140. {
  2141. b_app1(pp);b_app(040);b_app2(pp+1);
  2142. REDUCE(pp,3,tag,-1,263);
  2143. }
  2144. }
  2145. else if(cat1==int_like)
  2146. {/* \Cpp: |@c++ public base| */
  2147. b_app1(pp);b_app(040);b_app1(pp+1);
  2148. REDUCE(pp,2,int_like,-2,264);
  2149. }
  2150. }
  2151.  
  2152.  
  2153. #endif
  2154.  
  2155. break;
  2156. case stmt:
  2157. #if FCN_CALLS
  2158. C_stmt();
  2159. #else
  2160.  
  2161. {
  2162. if(cat1==stmt||(Cpp&&cat1==decl))/* ``|x; y;|'' */
  2163. {
  2164. b_app1(pp);b_app(force);
  2165. b_app1(pp+1);REDUCE(pp,2,stmt,-1,250);
  2166. }
  2167. else if(cat1==functn)
  2168. {
  2169. b_app1(pp);b_app(big_force);
  2170. b_app1(pp+1);
  2171. REDUCE(pp,2,stmt,-1,251);
  2172. }
  2173. }
  2174.  
  2175.  
  2176. #endif
  2177.  
  2178. break;
  2179. case tag:
  2180. #if FCN_CALLS
  2181. C_tag();
  2182. #else
  2183.  
  2184. {
  2185. if(cat1==tag)/* ``|case one: case two:|'' */
  2186. {
  2187. b_app1(pp);
  2188. b_app(force);
  2189. b_app(backup);
  2190. b_app1(pp+1);REDUCE(pp,2,tag,-1,270);
  2191. }
  2192. else if(cat1==stmt||cat1==decl||cat1==functn)/* ``|case one: \
  2193.         break;|'' or \Cpp: ``|@c++ public: int constructor();|''  */
  2194. {
  2195. b_app(big_force);
  2196. b_app(backup);b_app1(pp);b_app(force);
  2197. b_app1(pp+1);
  2198. REDUCE(pp,2,cat1,-1,271);
  2199. }
  2200. }
  2201.  
  2202.  
  2203. #endif
  2204.  
  2205. break;
  2206. case semi:
  2207. #if FCN_CALLS
  2208. C_semi();
  2209. #else
  2210.  
  2211. {
  2212. b_app(040);b_app1(pp);
  2213. REDUCE(pp,1,stmt,-1,280);
  2214. }
  2215.  
  2216.  
  2217. #endif
  2218.  
  2219. break;
  2220. case lproc:
  2221. #if FCN_CALLS
  2222. C_lproc();
  2223. #else
  2224.  
  2225. {
  2226. expanded_lproc= YES;
  2227.  
  2228. if(!in_LPROC)
  2229. active_space= YES;
  2230.  
  2231. if(cat1==define_like)
  2232. make_underlined(pp+3);/* ``\.{\#\ define\ M}'' */
  2233.  
  2234. if(cat1==else_like||cat1==if_like||cat1==define_like)
  2235. SQUASH(pp,2,lproc,0,10);/* ``\.{\#\ define}'' $\to$ \
  2236. ``\.{\#define}'' */
  2237. else if(cat1==rproc)
  2238. {
  2239. expanded_lproc= active_space= in_LPROC= NO;
  2240. SQUASH(pp,2,ignore_scrap,-1,11);
  2241. }
  2242. else if(cat1==expr)
  2243. SQUASH(pp,1,LPROC,0,12);/* ``|#if(0)|'' */
  2244. else if(cat1==space)
  2245. {
  2246. if(cat2==lpar)
  2247. SQUASH(pp,1,lproc,PLUS 2,1332);/* \.{if\ (x)} */
  2248. /* Following stuff for \&{\#define}. \
  2249. Absorb the identifier: ``\&{\#define M}'' */
  2250. else if(cat3==lpar)
  2251. SQUASH(pp,1,lproc,PLUS 3,1333);/* Expand the parens. */
  2252. else if(cat3==expr)
  2253. SQUASH(pp,4,LPROC,0,13);/* |expr| should be \
  2254.             ``|()|''; get them too. */
  2255. else if(cat3==space||cat3==ignore_scrap||cat3==rproc)
  2256. SQUASH(pp,3,LPROC,0,14);/* Just the identifier. */
  2257. }
  2258. expanded_lproc= NO;
  2259. }
  2260.  
  2261.  
  2262. #endif
  2263.  
  2264. break;
  2265. case LPROC:
  2266. #if FCN_CALLS
  2267. C_LPRC();
  2268. #else
  2269.  
  2270. {
  2271. active_space= NO;in_LPROC= YES;
  2272.  
  2273. if(cat1==space)
  2274. {
  2275. b_app1(pp);
  2276. b_app(040);
  2277. REDUCE(pp,2,LPROC,0,20);
  2278. }
  2279. else if(cat1==rproc)
  2280. {
  2281. in_LPROC= NO;
  2282. SQUASH(pp,2,ignore_scrap,-1,21);
  2283. }
  2284. else if(cat2==rproc)
  2285. {
  2286. in_LPROC= NO;
  2287. SQUASH(pp,3,ignore_scrap,-1,22);
  2288. }
  2289.  
  2290. #if(0)
  2291. if(cat3==lpar&&cat4==expr&&cat5==rpar)
  2292. if(cat2==rproc)
  2293. {
  2294. b_app1(pp);b_app(040);b_app2(pp+1);
  2295. REDUCE(pp,3,ignore_scrap,-1,53);
  2296. }
  2297. else if(cat2==expr&&cat3==rproc)
  2298. {
  2299. b_app1(pp);b_app(040);b_app1(pp+1);b_app(040);
  2300. b_app2(pp+2);REDUCE(pp,4,ignore_scrap,-1,53);
  2301. }
  2302. #endif
  2303. }
  2304.  
  2305.  
  2306. #endif
  2307.  
  2308. break;
  2309. case space:
  2310. #if FCN_CALLS
  2311. C_space();
  2312. #else
  2313.  
  2314. {
  2315. if(active_space)
  2316. {
  2317. if(expanded_lproc)
  2318. SQUASH(pp,1,space,-1,5336);
  2319. else
  2320. SQUASH(pp,1,space,1,5335);
  2321. }
  2322. else
  2323. REDUCE(pp,1,ignore_scrap,-1,5334);
  2324. }
  2325.  
  2326.  
  2327. #endif
  2328.  
  2329. break;
  2330.  
  2331. case template:
  2332. #if FCN_CALLS
  2333. C_template();
  2334. #else
  2335.  
  2336. {
  2337. if(cat1==langle)
  2338. SQUASH(pp,1,template,PLUS 1,6000);
  2339. else if(cat1==tlist)
  2340. {
  2341. b_app1(pp);b_app(040);b_app1(pp+1);b_app(force);
  2342. REDUCE(pp,2,int_like,0,6001);
  2343. }
  2344. }
  2345.  
  2346.  
  2347. #endif
  2348.  
  2349. break;
  2350. case langle:
  2351. #if FCN_CALLS
  2352. C_langle();
  2353. #else
  2354.  
  2355. {
  2356. if((pp-1)->cat==template||(pp-1)->cat==int_like||(pp-1)->cat==
  2357. struct_like)
  2358. {
  2359. b_app(0134);
  2360. APP_STR("WLA ");/* \.{\\WLA} $\equiv$ `$\WLA$'. */
  2361. REDUCE(pp,1,tstart,0,6050);/* Begining of template parameter list. */
  2362. }
  2363. else
  2364. SQUASH(pp,1,binop,-1,6051);
  2365. }
  2366.  
  2367.  
  2368. #endif
  2369.  
  2370. break;
  2371. case rangle:
  2372. #if FCN_CALLS
  2373. C_rangle();
  2374. #else
  2375.  
  2376. {
  2377. SQUASH(pp,1,binop,-1,6052);
  2378. }
  2379.  
  2380.  
  2381. #endif
  2382.  
  2383. break;
  2384. case tstart:
  2385. #if FCN_CALLS
  2386. C_tstart();
  2387. #else
  2388.  
  2389. {
  2390. if(cat2==rangle&&(cat1==int_like||cat1==decl_hd||cat1==expr
  2391. ||cat1==unorbinop))
  2392. {
  2393. b_app2(pp);
  2394. b_app(0134);
  2395. APP_STR("WRA ");/* Closing of template. */
  2396. OUTDENT;
  2397. REDUCE(pp,3,tlist,-1,6060);
  2398. }
  2399. }
  2400.  
  2401.  
  2402. #endif
  2403.  
  2404. break;
  2405. case tlist:
  2406. #if FCN_CALLS
  2407. C_tlist();
  2408. #else
  2409.  
  2410.  
  2411.  
  2412. #endif
  2413.  
  2414. break;
  2415.  
  2416. case virtual:
  2417. #if FCN_CALLS
  2418. C_virtual();
  2419. #else
  2420.  
  2421. {
  2422. b_app1(pp);
  2423.  
  2424. if(cat1==unop)
  2425. APP_SPACE;/* |@c++ virtual ~base();| */
  2426.  
  2427. REDUCE(pp,1,int_like,0,506);
  2428. }
  2429.  
  2430.  
  2431. #endif
  2432.  
  2433. break;
  2434. case reference:
  2435. #if FCN_CALLS
  2436. C_reference();
  2437. #else
  2438.  
  2439. {
  2440. SQUASH(pp,1,unorbinop,-1,507);
  2441. }
  2442.  
  2443.  
  2444. #endif
  2445.  
  2446. break;
  2447. case namespace:
  2448. #if FCN_CALLS
  2449. C_namespace();
  2450. #else
  2451.  
  2452. {
  2453. if(cat1==expr||cat1==int_like)
  2454. {/* \Cpp: |@c++ namespace A| */
  2455. make_underlined(pp+1);make_reserved(pp+1);
  2456.  
  2457. b_app1(pp);b_app(040);b_app1(pp+1);
  2458.  
  2459. REDUCE(pp,2,fn_decl,0,7901);
  2460. }
  2461. else if(cat1==lbrace)
  2462. SQUASH(pp,1,fn_decl,0,7902);/* |@c++ namespace{}| */
  2463. }
  2464.  
  2465.  
  2466. #endif
  2467.  
  2468. break;
  2469. }
  2470. }
  2471.  
  2472.  
  2473.  
  2474. SRTN
  2475. make_reserved FCN((p))/* Make the first identifier in |p->trans| like \
  2476.                 |int| */
  2477. scrap_pointer p C1("")
  2478. {
  2479. sixteen_bits tok_value= first_id(p->trans);
  2480. /* The first identifier, plus its flag. */
  2481. name_pointer pname= name_dir+tok_value-id_flag;
  2482.  
  2483. if(!tok_value||tok_value==050)
  2484. return;/* Emergency return; no    identifier found. */
  2485.  
  2486. if(DEFINED_TYPE(pname)==M_MACRO||DEFINED_TYPE(pname)==D_MACRO)
  2487. return;/* Don't |typedef| macro names. */
  2488.  
  2489. /* Change categories of all future occurrences of the identifier. */
  2490. for(;p<=scrp_ptr;p++)
  2491. {
  2492. if(p->cat==expr)
  2493. {
  2494. if(**(p->trans)==tok_value)
  2495. {
  2496. p->cat= int_like;
  2497. **(p->trans)+= res_flag-id_flag;/* Mark as reserved. */
  2498. }
  2499. }
  2500. }
  2501.  
  2502. pname->ilk= int_like;
  2503. pname->reserved_word|= (boolean)language;
  2504.  
  2505. if(mark_defined.typedef_name)
  2506. {
  2507. pname->defined_in(language)= module_count;
  2508. SET_TYPE(pname,TYPEDEF_NAME);
  2509. }
  2510. }
  2511.  
  2512.  
  2513.  
  2514. sixteen_bits
  2515. first_id FCN((t))
  2516. text_pointer t C1("Pointer to start of token list")
  2517. {
  2518. token_pointer pk= *t;/* Start of end. */
  2519. token_pointer pk1= *(t+1);/* End of list. */
  2520. sixteen_bits tok_value;/* Current element. */
  2521.  
  2522. for(;pk<pk1;pk++)
  2523. {
  2524. tok_value= *pk;
  2525.  
  2526. if(tok_value>inner_tok_flag)tok_value-= (inner_tok_flag-
  2527. tok_flag);
  2528.  
  2529. if(tok_value<=tok_flag)
  2530. {/* It's an ordinary (non-flagged) token. */
  2531. if(tok_value>=id_flag&&tok_value<res_flag)
  2532. return tok_value;/* Found identifier. */
  2533. else if(tok_value==050)return tok_value;/* STOP!!! */
  2534. }
  2535. else
  2536. {/* Flagged token; use indirection. */
  2537. t= tok_start+(int)(tok_value-tok_flag);/* Flagged token \
  2538. corresponds to a |text_pointer|; |*t|~points to beginning of translation. */
  2539. tok_value= first_id(t);/* Check that translation recursively. */
  2540. if(tok_value)return tok_value;
  2541. }
  2542. }
  2543.  
  2544. return 0;/* Really couldn't find anything! */
  2545. }
  2546.  
  2547.  
  2548.  
  2549. name_pointer
  2550. make_underlined FCN((p))/* underline the entry for the first \
  2551.                 identifier in |p->trans| */
  2552. scrap_pointer p C1("")
  2553. {
  2554. sixteen_bits tok_value;/* the name of this identifier, plus its flag */
  2555.  
  2556. tok_value= **(p->trans);
  2557.  
  2558. if(tok_value>inner_tok_flag)tok_value-= (inner_tok_flag-tok_flag);
  2559.  
  2560. if(tok_value>tok_flag){
  2561. do
  2562. {/* Follow an indirection chain to a real identifier. {\bf \
  2563. Watch the 16-bit arithmetic!} */
  2564. tok_value= **(tok_start+
  2565. (int)(tok_value-tok_flag));/* {\bf Don't \
  2566. remove the parens!} */
  2567. }
  2568. while(tok_value>tok_flag);
  2569.  
  2570. if(tok_value<id_flag||tok_value>=res_flag)return NULL;/* shouldn't \
  2571. happen */
  2572.  
  2573. xref_switch= def_flag;underline_xref(tok_value-id_flag+name_dir);
  2574. }
  2575.  
  2576. if(tok_value<id_flag||tok_value>=res_flag)return NULL;
  2577. /* shouldn't happen! */
  2578.  
  2579. xref_switch= def_flag;return underline_xref(tok_value-id_flag+name_dir);
  2580. }
  2581.  
  2582.  
  2583.  
  2584. name_pointer
  2585. underline_xref FCN((p))
  2586. name_pointer p C1("")
  2587. {
  2588. xref_pointer q= (xref_pointer)p->xref;/* Pointer to cross-reference \
  2589. being examined */
  2590. xref_pointer r;/* Temporary pointer for permuting cross-references */
  2591. sixteen_bits m;/* Cross-reference value to be installed */
  2592. sixteen_bits n;/* Cross-reference value being examined */
  2593. extern boolean strt_off;
  2594.  
  2595. if(no_xref||(strt_off&&!index_hidden))
  2596. return p;
  2597.  
  2598. xref_switch= def_flag;
  2599. m= (sixteen_bits)(module_count+xref_switch);
  2600.  
  2601. while(q!=xmem)
  2602. {
  2603. n= q->num;
  2604.  
  2605. if(n==m)return p;/* Same status; need to do nothing. */
  2606. else if(m==n+def_flag)/* Module numbers match; update to \
  2607.                 defined. */
  2608. {
  2609. q->num= m;return p;
  2610. }
  2611. else if(n>=def_flag&&n<m)break;
  2612.  
  2613. q= q->xlink;
  2614. }
  2615.  
  2616.  
  2617.  
  2618. append_xref(0);/* This number doesn't matter */
  2619. xref_ptr->xlink= (xref_pointer)p->xref;
  2620. r= xref_ptr;p->xref= (ASCII*)xref_ptr;
  2621.  
  2622. while(r->xlink!=q){r->num= r->xlink->num;r= r->xlink;}
  2623.  
  2624. r->num= m;/* Everything from |q| on is left undisturbed */
  2625.  
  2626. ;
  2627.  
  2628. return p;
  2629. }
  2630.  
  2631.  
  2632.  
  2633. SRTN
  2634. defined_at FCN((p))
  2635. name_pointer p C1("")
  2636. {
  2637. extern boolean ok_to_define;
  2638.  
  2639. if(ok_to_define&&translate_mode==OUTER&&p>name_dir)
  2640. {
  2641. sixteen_bits mod_defined= p->defined_in(language);
  2642.  
  2643. if(mod_defined&&mod_defined!=module_count)
  2644. {
  2645. printf("\n! (FWEAVE):  Implicit phase 2 declaration of `");
  2646. prn_id(p);
  2647. printf("' at %s \
  2648. repeats or conflicts with previous declaration at %s.\n",
  2649. (char*)MOD_TRANS(module_count),
  2650. (char*)MOD_TRANS(mod_defined));
  2651. mfree();
  2652. mark_harmless;
  2653. }
  2654. else if(mark_defined.fcn_name)
  2655. {
  2656. p->defined_in(language)= module_count;
  2657. SET_TYPE(p,FUNCTION_NAME);
  2658. }
  2659. }
  2660. }
  2661.  
  2662.  
  2663.  
  2664. #if FCN_CALLS
  2665. SRTN C_ignore_scrap(VOID)
  2666. {
  2667.  
  2668. {
  2669. switch(cat1)
  2670. {
  2671. case stmt:
  2672. case functn:
  2673. SQUASH(pp,2,cat1,0,1);
  2674. break;
  2675. }
  2676. }
  2677.  
  2678.  
  2679. }
  2680. #endif
  2681.  
  2682.  
  2683. #if FCN_CALLS
  2684. SRTN C_expr(VOID)
  2685. {
  2686.  
  2687. {
  2688. if(cat1==lbrace||((!Cpp)&&cat1==int_like))
  2689. {/* ``|f(x) {}|'' or ``|f(x) float x;|'' (old-style) */
  2690. defined_at(make_underlined(pp));/* Recognized function name; \
  2691. remember current module number. */
  2692. in_function= YES;
  2693. SQUASH(pp,1,fn_decl,0,111);
  2694. }
  2695. else if(cat1==unop)
  2696. SQUASH(pp,2,expr,-2,2);/* ``|x--|'' */
  2697. else if(cat1==binop)
  2698. {
  2699. if(cat2==expr)
  2700. SQUASH(pp,3,expr,-2,3);/* ``|x + y|'' */
  2701. else if(cat2==decl_hd)
  2702. SQUASH(pp,3,tstart,0,6061);
  2703. /* Trap for ``|@c++ A<int>|'', with |A| undefined. */
  2704. }
  2705. else if(cat1==unorbinop&&cat2==expr)
  2706. {
  2707. sixteen_bits*s= *(pp+1)->trans;
  2708. b_app1(pp);
  2709.  
  2710. /* If the translation of the next scrap begins with an escape character, we \
  2711. assume we're seeing \.{\\amp}. */
  2712. if((s[0]==(sixteen_bits)0134)&&s[1]==(sixteen_bits)0141
  2713. &&s[2]==(sixteen_bits)0155)
  2714. {
  2715. APP_SPACE;b_app1(pp+1);APP_SPACE;/* ``|x & y|'' */
  2716. }
  2717. else b_app1(pp+1);/* ``|x*y|'' */
  2718.  
  2719. b_app1(pp+2);
  2720. REDUCE(pp,3,expr,-2,3000);
  2721. }
  2722. else if(cat1==comma)
  2723. {
  2724. if((cat2==expr||cat2==int_like))/* ``|x,y|'' or ``|x,char|''  */
  2725. {
  2726. b_app2(pp);
  2727. OPT9;
  2728. b_app1(pp+2);REDUCE(pp,3,cat2,-2,4);
  2729. }
  2730. else if(cat2==space)
  2731. SQUASH(pp,3,expr,-2,88);/* Macros. */
  2732. }
  2733. else if(cat1==expr)
  2734. SQUASH(pp,2,expr,-2,5);/* ``|f(x)|'' */
  2735. else if(cat1==semi)
  2736. SQUASH(pp,2,stmt,-1,6);/* ``|x;|'' */
  2737. else if(cat1==colon)/* ``|label:|'' */
  2738. {
  2739. if(!Cpp||in_function)
  2740. {/* Ordinary C tag. */
  2741. make_underlined(pp);/* Label name. */
  2742. SQUASH(pp,2,tag,0,7);
  2743. }
  2744. else if(cat2==expr)
  2745. {/* Put the spaces in explicitly in case we're not in math \
  2746. mode at the time. */
  2747. b_app1(pp);b_app(040);b_app1(pp+1);b_app(040);
  2748. b_app1(pp+2);
  2749. REDUCE(pp,3,expr,-2,701);
  2750. /* \Cpp: ``|@c++ derived() : base()|'' */
  2751. }
  2752. }
  2753. else if(cat1==space)
  2754. SQUASH(pp,2,expr,-2,8);/* For use in macros. */
  2755. }
  2756.  
  2757.  
  2758. }
  2759. #endif
  2760.  
  2761.  
  2762. #if FCN_CALLS
  2763. SRTN C_UNOP(VOID)
  2764. {
  2765.  
  2766. {
  2767. b_app1(pp);APP_SPACE;
  2768. REDUCE(pp,1,unop,-1,4443);
  2769. }
  2770.  
  2771.  
  2772. }
  2773. #endif
  2774.  
  2775.  
  2776. #if FCN_CALLS
  2777. SRTN C_BINOP(VOID)
  2778. {
  2779.  
  2780. {
  2781.  
  2782.  
  2783. APP_SPACE;b_app1(pp);APP_SPACE;
  2784.  
  2785. ;
  2786. REDUCE(pp,1,binop,-1,4444);
  2787. }
  2788.  
  2789.  
  2790. }
  2791. #endif
  2792.  
  2793.  
  2794. #if FCN_CALLS
  2795. SRTN C_COMMA(VOID)
  2796. {
  2797.  
  2798. {
  2799.  
  2800.  
  2801. APP_SPACE;b_app1(pp);APP_SPACE;
  2802.  
  2803. ;
  2804. REDUCE(pp,1,comma,-1,4445);
  2805. }
  2806.  
  2807.  
  2808. }
  2809. #endif
  2810.  
  2811.  
  2812. #if FCN_CALLS
  2813. SRTN C__E(VOID)
  2814. {
  2815.  
  2816. {
  2817. APP_SPACE;b_app1(pp);
  2818. REDUCE(pp,1,expr,-2,4446);
  2819. }
  2820.  
  2821.  
  2822. }
  2823. #endif
  2824.  
  2825.  
  2826. #if FCN_CALLS
  2827. SRTN C__E_(VOID)
  2828. {
  2829.  
  2830. {
  2831.  
  2832.  
  2833. APP_SPACE;b_app1(pp);APP_SPACE;
  2834.  
  2835. ;
  2836. REDUCE(pp,1,expr,-2,4447);
  2837. }
  2838.  
  2839.  
  2840. }
  2841. #endif
  2842.  
  2843.  
  2844. #if FCN_CALLS
  2845. SRTN C_E_(VOID)
  2846. {
  2847.  
  2848. {
  2849. b_app1(pp);APP_SPACE;
  2850. REDUCE(pp,1,expr,-2,4448);
  2851. }
  2852.  
  2853.  
  2854. }
  2855. #endif
  2856.  
  2857.  
  2858. #if FCN_CALLS
  2859. SRTN C_new_like(VOID)
  2860. {
  2861.  
  2862. {
  2863. if(cat1==decl_hd||cat1==expr)
  2864. {/* \Cpp: |@c++ new int| or |@c++ new class(20)| */
  2865. b_app1(pp);b_app(040);b_app1(pp+1);
  2866. if(cat1==decl_hd)
  2867. {
  2868. OUTDENT;
  2869. }
  2870. REDUCE(pp,2,expr,-2,909);
  2871. }
  2872. }
  2873.  
  2874.  
  2875. }
  2876. #endif
  2877.  
  2878.  
  2879. #if FCN_CALLS
  2880. SRTN C_lproc(VOID)
  2881. {
  2882.  
  2883. {
  2884. expanded_lproc= YES;
  2885.  
  2886. if(!in_LPROC)
  2887. active_space= YES;
  2888.  
  2889. if(cat1==define_like)
  2890. make_underlined(pp+3);/* ``\.{\#\ define\ M}'' */
  2891.  
  2892. if(cat1==else_like||cat1==if_like||cat1==define_like)
  2893. SQUASH(pp,2,lproc,0,10);/* ``\.{\#\ define}'' $\to$ \
  2894. ``\.{\#define}'' */
  2895. else if(cat1==rproc)
  2896. {
  2897. expanded_lproc= active_space= in_LPROC= NO;
  2898. SQUASH(pp,2,ignore_scrap,-1,11);
  2899. }
  2900. else if(cat1==expr)
  2901. SQUASH(pp,1,LPROC,0,12);/* ``|#if(0)|'' */
  2902. else if(cat1==space)
  2903. {
  2904. if(cat2==lpar)
  2905. SQUASH(pp,1,lproc,PLUS 2,1332);/* \.{if\ (x)} */
  2906. /* Following stuff for \&{\#define}. \
  2907. Absorb the identifier: ``\&{\#define M}'' */
  2908. else if(cat3==lpar)
  2909. SQUASH(pp,1,lproc,PLUS 3,1333);/* Expand the parens. */
  2910. else if(cat3==expr)
  2911. SQUASH(pp,4,LPROC,0,13);/* |expr| should be \
  2912.             ``|()|''; get them too. */
  2913. else if(cat3==space||cat3==ignore_scrap||cat3==rproc)
  2914. SQUASH(pp,3,LPROC,0,14);/* Just the identifier. */
  2915. }
  2916. expanded_lproc= NO;
  2917. }
  2918.  
  2919.  
  2920. }
  2921. #endif
  2922.  
  2923.  
  2924. #if FCN_CALLS
  2925. SRTN C_LPRC(VOID)
  2926. {
  2927.  
  2928. {
  2929. active_space= NO;in_LPROC= YES;
  2930.  
  2931. if(cat1==space)
  2932. {
  2933. b_app1(pp);
  2934. b_app(040);
  2935. REDUCE(pp,2,LPROC,0,20);
  2936. }
  2937. else if(cat1==rproc)
  2938. {
  2939. in_LPROC= NO;
  2940. SQUASH(pp,2,ignore_scrap,-1,21);
  2941. }
  2942. else if(cat2==rproc)
  2943. {
  2944. in_LPROC= NO;
  2945. SQUASH(pp,3,ignore_scrap,-1,22);
  2946. }
  2947.  
  2948. #if(0)
  2949. if(cat3==lpar&&cat4==expr&&cat5==rpar)
  2950. if(cat2==rproc)
  2951. {
  2952. b_app1(pp);b_app(040);b_app2(pp+1);
  2953. REDUCE(pp,3,ignore_scrap,-1,53);
  2954. }
  2955. else if(cat2==expr&&cat3==rproc)
  2956. {
  2957. b_app1(pp);b_app(040);b_app1(pp+1);b_app(040);
  2958. b_app2(pp+2);REDUCE(pp,4,ignore_scrap,-1,53);
  2959. }
  2960. #endif
  2961. }
  2962.  
  2963.  
  2964. }
  2965. #endif
  2966.  
  2967.  
  2968. #if FCN_CALLS
  2969. SRTN C_space(VOID)
  2970. {
  2971.  
  2972. {
  2973. if(active_space)
  2974. {
  2975. if(expanded_lproc)
  2976. SQUASH(pp,1,space,-1,5336);
  2977. else
  2978. SQUASH(pp,1,space,1,5335);
  2979. }
  2980. else
  2981. REDUCE(pp,1,ignore_scrap,-1,5334);
  2982. }
  2983.  
  2984.  
  2985. }
  2986. #endif
  2987.  
  2988.  
  2989. #if FCN_CALLS
  2990. SRTN C_question(VOID)
  2991. {
  2992.  
  2993. {
  2994. if(cat1==expr&&cat2==colon)SQUASH(pp,3,binop,-2,30);/* ``|i==1 ? YES : \
  2995.                     NO|'' */
  2996. }
  2997.  
  2998.  
  2999. }
  3000. #endif
  3001.  
  3002.  
  3003. #if FCN_CALLS
  3004. SRTN C_int_like(VOID)
  3005. {
  3006.  
  3007. {
  3008. if(cat1==unop)
  3009. {
  3010. if(cat2==expr||cat2==int_like)
  3011. SQUASH(pp,3,expr,-2,35);/* \Cpp: |@c++ class::f| or \
  3012.             constructor: |@c++ class::class| */
  3013. else if(cat2==op_like)
  3014. SQUASH(pp,1,int_like,PLUS 2,36);/* \Cpp: Expand |@c++ operator| \
  3015.             construction. */
  3016. }
  3017. else if(cat1==int_like||cat1==struct_like)
  3018. {/* ``|extern int|'' or ``|@c++ typedef int bool|''. */
  3019. b_app1(pp);b_app(040);b_app1(pp+1);
  3020. REDUCE(pp,2,cat1,0,40);
  3021. }
  3022. else if(cat1==reference)
  3023. SQUASH(pp,2,int_like,-2,43);/* |@c++ int &ref;| */
  3024. else if(cat1==expr||cat1==unorbinop||cat1==semi)
  3025. {/* ``|int i|'' or ``|int *|'' */
  3026. b_app1(pp);
  3027.  
  3028. if(cat1!=semi)
  3029. b_app(040);
  3030.  
  3031. INDENT;/* Start long declaration. (Note: Whenever we leave \
  3032.             |decl_hd|, we must |OUTDENT|.) */
  3033.  
  3034. REDUCE(pp,1,decl_hd,-1,41);
  3035. }
  3036. else if(cat1==comma)
  3037. {
  3038. b_app1(pp);
  3039. INDENT;
  3040. REDUCE(pp,1,decl_hd,-2,42);/* Function prototype: |int,|. */
  3041. }
  3042. else if(cat1==rpar)
  3043. {
  3044. b_app1(pp);
  3045. INDENT;
  3046. REDUCE(pp,1,decl_hd,-2,502);
  3047. }
  3048. else if(Cpp&&cat1==lpar&&!in_prototype)
  3049. {/* The \Cpp\ is a KLUDGE. Consider ``|int (*f)()|''. */
  3050. b_app1(pp);
  3051.  
  3052. {
  3053. b_app(0134);b_app(054);
  3054. }
  3055.  
  3056.  
  3057. REDUCE(pp,1,expr,-2,5021);/* \Cpp\ constructor: ``|@c++ base()|''; \
  3058.                     or ``|@c++ int(x)|''. */
  3059. }
  3060. else if(cat1==binop&&cat2==expr)
  3061. SQUASH(pp,3,int_like,-2,5022);/* \Cpp\ initializer: |@c++ base = 0| */
  3062. else if(cat1==langle)
  3063. SQUASH(pp,1,int_like,PLUS 1,5997);/* |@c++ int<24>| */
  3064. else if(cat1==rangle)
  3065. {
  3066. b_app1(pp);
  3067. INDENT;
  3068. REDUCE(pp,1,decl_hd,-2,5998);
  3069. }
  3070. else if(cat1==class_like)
  3071. {/* \Cpp:  |@c++ friend class|. */
  3072. b_app1(pp);b_app(040);b_app1(pp+1);
  3073. REDUCE(pp,2,class_like,0,5995);
  3074. }
  3075. else if(cat1==tlist)
  3076. SQUASH(pp,2,int_like,-2,5999);
  3077. else if(cat1==namespace)
  3078. {/* |@c++ using namespace| */
  3079. b_app1(pp);b_app(040);b_app1(pp+1);
  3080. REDUCE(pp,2,namespace,0,5996);
  3081. }
  3082. }
  3083.  
  3084.  
  3085. }
  3086. #endif
  3087.  
  3088.  
  3089. #if FCN_CALLS
  3090. SRTN C_ext_like(VOID)
  3091. {
  3092.  
  3093. {
  3094. if(Cpp&&cat1==expr)
  3095. {/* |@c++ extern "C"| */
  3096. b_app1(pp);b_app(040);b_app1(pp+1);
  3097. if(cat2==lbrace)
  3098. REDUCE(pp,2,fn_decl,0,5025);/* ``|@c++ extern "C" {}|''. */
  3099. else
  3100. REDUCE(pp,2,int_like,0,5023);
  3101. /* ``|@c++ extern "C" int fcn();|'' */
  3102. }
  3103. else
  3104. SQUASH(pp,1,int_like,0,5024);
  3105. }
  3106.  
  3107.  
  3108. }
  3109. #endif
  3110.  
  3111.  
  3112. #if FCN_CALLS
  3113. SRTN C_modifier(VOID)
  3114. {
  3115.  
  3116. {
  3117. if(cat1==int_like)
  3118. SQUASH(pp,1,int_like,-2,503);
  3119. else if(pp==lo_ptr)
  3120. SQUASH(pp,1,expr,0,5040);
  3121. else if(cat1==semi||cat1==lbrace)
  3122. SQUASH(pp,1,_EXPR,0,5042);
  3123. /* |@c++ int f() const;| or |@c++ int f() const {}|. */
  3124. else
  3125. SQUASH(pp,1,EXPR_,0,5041);
  3126. }
  3127.  
  3128.  
  3129. }
  3130. #endif
  3131.  
  3132.  
  3133. #if FCN_CALLS
  3134. SRTN C_huge_like(VOID)
  3135. {
  3136.  
  3137. {
  3138. if(cat1==unorbinop)
  3139. {
  3140. b_app1(pp);APP_SPACE;b_app1(pp+1);
  3141. REDUCE(pp,2,unorbinop,-1,505);
  3142. }
  3143. }
  3144.  
  3145.  
  3146. }
  3147. #endif
  3148.  
  3149.  
  3150. #if FCN_CALLS
  3151. SRTN C_virtual(VOID)
  3152. {
  3153.  
  3154. {
  3155. b_app1(pp);
  3156.  
  3157. if(cat1==unop)
  3158. APP_SPACE;/* |@c++ virtual ~base();| */
  3159.  
  3160. REDUCE(pp,1,int_like,0,506);
  3161. }
  3162.  
  3163.  
  3164. }
  3165. #endif
  3166.  
  3167.  
  3168. #if FCN_CALLS
  3169. SRTN C_reference(VOID)
  3170. {
  3171.  
  3172. {
  3173. SQUASH(pp,1,unorbinop,-1,507);
  3174. }
  3175.  
  3176.  
  3177. }
  3178. #endif
  3179.  
  3180.  
  3181. #if FCN_CALLS
  3182. SRTN C_decl_hd(VOID)
  3183. {
  3184.  
  3185. {
  3186. if(cat1==rpar)
  3187. {
  3188. if((pp-1)->cat==lpar)
  3189. SQUASH(pp,1,decl_hd,-1,4990);/* ``|(int i)|''. */
  3190. else if((pp-2)->cat==decl_hd)
  3191. SQUASH(pp,1,decl_hd,-2,4991);/* ``|(int i, int j)|''. */
  3192. else if((pp-3)->cat==decl_hd)
  3193. SQUASH(pp,1,decl_hd,-3,4992);
  3194. }
  3195. else if(cat1==decl_hd)
  3196. SQUASH(pp,2,decl_hd,0,50);/* ``|(int,int)|'' */
  3197. else if(cat1==comma)
  3198. {
  3199. if(cat2==decl_hd)
  3200. {/* For function prototype. */
  3201. b_app2(pp);OPT9;
  3202. b_app1(pp+2);
  3203. REDUCE(pp,3,decl_hd,0,501);
  3204. }
  3205. else if(cat2==ignore_scrap&&cat3==decl_hd)
  3206. {/* For function prototype with comment. */
  3207. b_app2(pp);OPT9;
  3208. b_app2(pp+2);
  3209. REDUCE(pp,4,decl_hd,0,504);
  3210. }
  3211. #if 0
  3212. else if(Cpp&&(cat2==decl||cat2==stmt))
  3213. SQUASH(pp,3,stmt,-2,508);
  3214. /* ``|@c++ for(int i=0, int j=0;;)|'' or ``|@c++ \
  3215.                 for(int i=0, int j=0, int k=0;;)|''. */
  3216. #endif
  3217. else
  3218. {/* ``|int i,|'' */
  3219. if(cat2==ignore_scrap&&(cat3==int_like||cat3==struct_like||
  3220. cat3==modifier))
  3221. {/* Function prototype, with intervening comment. */
  3222. b_app1(pp);
  3223. if((pp-3)->cat!=decl_hd&&(pp-2)->cat!=decl_hd
  3224. &&cat3!=modifier)
  3225. in_prototype++;
  3226. REDUCE(pp,1,decl_hd,PLUS 3,5221);
  3227. }
  3228. else if(cat2==int_like||cat2==struct_like||cat2==modifier)
  3229. {/* Function prototype. */
  3230. b_app1(pp);
  3231. if((pp-3)->cat!=decl_hd&&(pp-2)->cat!=decl_hd
  3232. &&cat2!=modifier)
  3233. in_prototype++;/* The |modifier| clause is to \
  3234. prevent a situation like |(int, const int)| from thinking it's two levels \
  3235. of prototypes. */
  3236. REDUCE(pp,1,decl_hd,PLUS 2,52);
  3237. }
  3238. else
  3239. {/* Expecting list of something. */
  3240. b_app2(pp);b_app(040);
  3241.  
  3242. #if 0
  3243. if(Cpp)
  3244. REDUCE(pp,2,decl_hd,-2,540);
  3245. /* ``|@c++ int i=0, int j=0|'' (e.g., in |for|) */
  3246. else
  3247. #endif
  3248. REDUCE(pp,2,decl_hd,-1,54);/* ``|int i,j|'' */
  3249. }
  3250. }
  3251. }
  3252. else if(cat1==unorbinop)/* ``|int **p|'' */
  3253. {
  3254. b_app1(pp);
  3255. b_app1(pp+1);
  3256. REDUCE(pp,2,decl_hd,-1,55);
  3257. }
  3258. else if(cat1==expr)/* ``|int i|'' or ``|int i, j|'' */
  3259. {
  3260. make_underlined(pp+1);
  3261. SQUASH(pp,2,decl_hd,-1,56);/* The |-1| is to pick up a left \
  3262.                     paren for function prototype. */
  3263. }
  3264. else if((cat1==binop||cat1==colon
  3265. ||cat1==expr /* (for initializations) */
  3266. )&&cat2==expr&&(cat3==comma||cat3==semi||cat3==rpar))
  3267. #if 0
  3268. if(cat1==binop)
  3269. {
  3270. b_app1(pp);b_app(040);b_app2(pp+1);
  3271. REDUCE(pp,3,decl_hd,-1,5660);
  3272. }
  3273. else
  3274. #endif
  3275. SQUASH(pp,3,decl_hd,-1,5661);
  3276. else if(cat1==int_like&&(cat2==unop||cat2==langle))
  3277. SQUASH(pp,1,decl_hd,PLUS 1,5662);
  3278. /* \Cpp:  ``|@c++ void *int::fcn()|'' or ``|@c++ void \
  3279.         *int<int>::fcn()|'' */
  3280. else if(cat1==lbrace||(cat1==int_like&&
  3281. ((pp-1)->trans==NULL||**(pp-1)->trans!=050)))/* \
  3282. Recognize beginning of function: ``|float f() {}|'' or ``|float f(x) float \
  3283. x|'' */
  3284. {
  3285. b_app1(pp);
  3286. OUTDENT;
  3287. in_function= YES;
  3288. defined_at(FIRST_ID(pp));
  3289. REDUCE(pp,1,fn_decl,0,58);
  3290. }
  3291. else if(cat1==semi)
  3292. {/* ``|int i;|'' */
  3293. b_app2(pp);
  3294. OUTDENT;/* Finish long declaration. */
  3295. #if 0
  3296. if(Cpp)
  3297. REDUCE(pp,2,decl,-2,594);
  3298. /* ``|@c++ for(int i=0, int j=0;;)|'' */
  3299. else
  3300. #endif
  3301. REDUCE(pp,2,decl,-1,59);
  3302. }
  3303. else if(Cpp&&cat1==int_like&&cat2==unop)
  3304. SQUASH(pp,1,decl_hd,PLUS 1,590);/* \Cpp: |@c++ void *class::f| */
  3305. else if(Cpp&&cat1==rangle)
  3306. SQUASH(pp,1,decl_hd,-2,591);/* \Cpp:  end of template. */
  3307. else if(Cpp&&cat1==struct_like)
  3308. SQUASH(pp,2,decl_hd,-1,593);
  3309. /* \Cpp: |@c++ template<class C1, class C2>|. */
  3310. }
  3311.  
  3312.  
  3313. }
  3314. #endif
  3315.  
  3316.  
  3317. #if FCN_CALLS
  3318. SRTN C_decl(VOID)
  3319. {
  3320.  
  3321. {
  3322. if(Cpp)
  3323. {
  3324. if(cat1==functn)
  3325. {
  3326. b_app1(pp);b_app(big_force);
  3327. b_app1(pp+1);
  3328. REDUCE(pp,2,functn,-1,61);
  3329. }
  3330. else
  3331. SQUASH(pp,1,stmt,-1,611);/* E.g., ``|@c++ for(int i=0;;)|'' */
  3332. }
  3333. else
  3334. {
  3335. if(cat1==decl)
  3336. {/* ``|int i; float x;|'' */
  3337. b_app1(pp);b_app(force);
  3338. b_app1(pp+1);
  3339. REDUCE(pp,2,decl,-1,60);
  3340. }
  3341. else if(cat1==stmt||cat1==functn)
  3342. {/* ``|int i; x=0;|'' or ``|int i; f(){}|'' */
  3343. b_app1(pp);b_app(big_force);
  3344. b_app1(pp+1);
  3345. REDUCE(pp,2,cat1,-1,61);
  3346. }
  3347. }
  3348. }
  3349.  
  3350.  
  3351. }
  3352. #endif
  3353.  
  3354.  
  3355. #if FCN_CALLS
  3356. SRTN C_fn_decl(VOID)
  3357. {
  3358.  
  3359. {
  3360. if(cat1==semi&&Cpp)
  3361. {/* |@c++ using namespace X;| */
  3362. b_app2(pp);
  3363. REDUCE(pp,2,stmt,-1,72);
  3364. }
  3365. else if(cat1==decl)/* ``|f(x) float x;|'' */
  3366. {
  3367. b_app1(pp);
  3368. b_app(indent);indent_force;
  3369. b_app1(pp+1);/* Accrete old-style declarations. */
  3370. b_app(outdent);b_app(outdent);
  3371. REDUCE(pp,2,fn_decl,0,70);
  3372. }
  3373. else if(cat1==stmt)/* ``|f(){}|'' */
  3374. {
  3375. #if(0)
  3376. b_app(backup);/* Beginning of function. */
  3377. #endif
  3378. b_app1(pp);b_app(force);
  3379. b_app(indent);
  3380. b_app1(pp+1);/* Function body */
  3381. b_app(outdent);
  3382. in_function= NO;
  3383. REDUCE(pp,2,functn,-1,71);
  3384. }
  3385. }
  3386.  
  3387.  
  3388. }
  3389. #endif
  3390.  
  3391.  
  3392. #if FCN_CALLS
  3393. SRTN C_functn(VOID)
  3394. {
  3395.  
  3396. {
  3397. if(cat1==functn||cat1==decl||cat1==stmt)
  3398. {
  3399. b_app1(pp);b_app(big_force);
  3400. b_app1(pp+1);REDUCE(pp,2,cat1,-1,80);/* |-1| for \Cpp */
  3401. }
  3402. }
  3403.  
  3404.  
  3405. }
  3406. #endif
  3407.  
  3408.  
  3409. #if FCN_CALLS
  3410. SRTN C_typedef_like(VOID)
  3411. {
  3412.  
  3413. {
  3414. if(cat1==decl_hd&&(cat2==expr||cat2==int_like))
  3415. {
  3416. make_underlined(pp+2);make_reserved(pp+2);/* NEEDS TO BE IMPROVED! */
  3417. b_app2(pp+1);
  3418. REDUCE(pp+1,2,decl_hd,0,90);
  3419. }
  3420. else if(cat1==decl)
  3421. {
  3422. b_app1(pp);b_app(040);b_app1(pp+1);
  3423. REDUCE(pp,2,decl,-1,91);
  3424. }
  3425. else if(cat1==semi)
  3426. SQUASH(pp,2,stmt,-1,94);
  3427. /* ``|typedef|''. */
  3428. else if(cat1==stmt)
  3429. {
  3430. b_app1(pp);b_app(040);b_app1(pp+1);
  3431. REDUCE(pp,2,stmt,-1,95);
  3432. /* ``|typedef int I[3]|''. (|I| is defined in first pass.) */
  3433. }
  3434.  
  3435. }
  3436.  
  3437.  
  3438. }
  3439. #endif
  3440.  
  3441.  
  3442. #if FCN_CALLS
  3443. SRTN C_imp_reserved(VOID)
  3444. {
  3445.  
  3446. {
  3447. if(typedefing)SQUASH(pp,1,expr,-2,92);
  3448. else SQUASH(pp,1,int_like,-2,93);
  3449. }
  3450.  
  3451.  
  3452. }
  3453. #endif
  3454.  
  3455.  
  3456. #if FCN_CALLS
  3457. SRTN C_op_like(VOID)
  3458. {
  3459.  
  3460. {
  3461. short n;
  3462. /* The actual number of tokens that make up the effective function name. */
  3463.  
  3464. if((cat1==lpar&&cat2==rpar)||(cat1==lbracket&&cat2==rbracket))
  3465. {/* |@c++ operator ()()|  is a special case because it begins with \
  3466. left paren.  |@c++ operator []()| is handled as a special case because we \
  3467. now have the categories |lbracket| and |rbracket|, and |lbracket| doesn't \
  3468. regress when it's reduced to |lpar|. */
  3469. b_app1(pp);b_app(040);b_app1(pp+1);
  3470.  
  3471. {
  3472. b_app(0134);b_app(054);
  3473. }
  3474.  
  3475.  
  3476. b_app1(pp+2);
  3477. n= 3;
  3478. }
  3479. else
  3480. {/* We'll search for the obligatory left paren that indicates the \
  3481. argument list. */
  3482. scrap_pointer q;
  3483. int k;/* Counter. */
  3484.  
  3485. /* If the paren is missing, we could end up appending the entire rest of \
  3486. the code, so we limit the search. */
  3487. for(q= pp+1;q<=scrp_ptr&&q-pp<=MAX_OP_TOKENS;q++)
  3488. if(q->cat==lpar)break;
  3489.  
  3490. n= (q->cat==lpar)?PTR_DIFF(short,q,pp):0;
  3491.  
  3492. /* Append all the tokens between |operator| and left paren. */
  3493. if(n>0)
  3494. {
  3495. text_pointer xp;
  3496. token_pointer tp,tp1;
  3497.  
  3498. b_app1(pp);b_app(040);/* |operator| */
  3499. b_app(0173);/* Braces prevent possible spurious blanks \
  3500. before the left paren. */
  3501.  
  3502. id_first= id_loc= mod_text+1;
  3503.  
  3504. for(k= 1;k<n;k++)
  3505. {
  3506. b_app1(pp+k);
  3507.  
  3508. xp= indirect((pp+k)->trans);
  3509. tp= *xp;
  3510. tp1= *(xp+1);
  3511. while(tp<tp1)
  3512. *id_loc++= (ASCII)(*tp++);
  3513. }
  3514.  
  3515. underline_xref(id_lookup(id_first,id_loc,0));
  3516.  
  3517. b_app(0175);
  3518. }
  3519. }
  3520.  
  3521. if(n>0)
  3522. REDUCE(pp,n,expr,-2,6666);
  3523. }
  3524.  
  3525.  
  3526. }
  3527. #endif
  3528.  
  3529.  
  3530. #if FCN_CALLS
  3531. SRTN C_class_like(VOID)
  3532. {
  3533.  
  3534. {
  3535. if(cat1==expr||cat1==int_like)
  3536. {/* \Cpp: |@c++ class A| */
  3537. make_underlined(pp+1);make_reserved(pp+1);
  3538.  
  3539. b_app1(pp);b_app(040);b_app1(pp+1);
  3540.  
  3541. if((pp-1)->cat==tstart||(pp-1)->cat==decl_hd)
  3542. REDUCE(pp,2,decl_hd,-1,8998);
  3543. else
  3544. REDUCE(pp,2,struct_like,0,8999);
  3545. }
  3546. else if(cat1==lbrace)
  3547. SQUASH(pp,1,struct_like,0,8987);
  3548. /* |@c++ class{}| or |@c++ struct{}|. */
  3549. }
  3550.  
  3551.  
  3552. }
  3553. #endif
  3554.  
  3555.  
  3556. #if FCN_CALLS
  3557. SRTN C_struct_like(VOID)
  3558. {
  3559.  
  3560. {
  3561. if(cat1==lbrace)
  3562. {/* ``|struct {int i;} S;|'' or \Cpp: ``|@c++ class A{int i;};|'' */
  3563. b_app1(pp);indent_force;
  3564. b_app1(pp+1);REDUCE(pp,2,struct_hd,0,100);
  3565. }
  3566. else if(cat1==expr)
  3567. {/* Structure name: ``|struct s|'' */
  3568. if(cat2==lbrace)/* ``|struct s {}|'' */
  3569. {
  3570. /* In \Cpp, this construction defines a new type. */
  3571. if(Cpp)
  3572. {make_underlined(pp+1);make_reserved(pp+1);}
  3573.  
  3574. b_app1(pp);b_app(040);b_app1(pp+1);
  3575. indent_force;
  3576. b_app1(pp+2);
  3577. REDUCE(pp,3,struct_hd,0,101);
  3578. }
  3579. else /* ``|struct s ss|'' */
  3580. {
  3581. b_app1(pp);b_app(040);b_app1(pp+1);
  3582. REDUCE(pp,2,int_like,-1,102);
  3583. }
  3584. }
  3585. else if(cat1==colon&&cat2==int_like&&Cpp)
  3586. {/* |@c++ class A: base| */
  3587. if(cat3==langle)
  3588. SQUASH(pp,1,struct_like,PLUS 3,1023);
  3589. else
  3590. {
  3591. b_app1(pp);b_app(040);b_app1(pp+1);b_app(040);
  3592. b_app1(pp+2);
  3593. REDUCE(pp,3,struct_like,0,1021);
  3594. }
  3595. }
  3596. else if(cat1==comma&&cat2==int_like&&Cpp)
  3597. {/* |@c++ class A: base, base | */
  3598. if(cat3==langle)
  3599. SQUASH(pp,1,struct_like,PLUS 3,1024);
  3600. else
  3601. {
  3602. b_app2(pp);b_app(040);b_app1(pp+2);
  3603. REDUCE(pp,3,struct_like,0,1022);
  3604. }
  3605. }
  3606. else if(cat1==tlist)
  3607. SQUASH(pp,2,struct_like,0,1025);/* \Cpp: |@c++ class A<int>|. */
  3608. else if(cat1==semi)
  3609. SQUASH(pp,2,decl,-1,103);/* \Cpp: |@c++ class base;| */
  3610. else if(cat1==rangle)
  3611. SQUASH(pp,1,decl_hd,-2,592);/* \Cpp:  end of template. */
  3612. }
  3613.  
  3614.  
  3615. }
  3616. #endif
  3617.  
  3618.  
  3619. #if FCN_CALLS
  3620. SRTN C_str_hd(VOID)
  3621. {
  3622.  
  3623. {
  3624. if((cat1==decl||cat1==stmt
  3625. ||cat1==expr /*  (For enum) */
  3626. ||cat1==functn /* \Cpp */
  3627. )&&cat2==rbrace)
  3628. {
  3629. b_app1(pp);/* ``|struct {|'' */
  3630. b_app(force);b_app1(pp+1);/* Body */
  3631. b_app(force);b_app1(pp+2);/* ``|}|'' */
  3632. b_app(outdent);
  3633. REDUCE(pp,3,int_like,-1,110);
  3634. }
  3635. else if(cat1==rbrace)
  3636. {
  3637. b_app1(pp);
  3638. {
  3639. b_app(0134);b_app(054);
  3640. }
  3641.  
  3642. b_app1(pp+1);
  3643. b_app(outdent);
  3644. REDUCE(pp,2,int_like,-1,1101);
  3645. }
  3646. }
  3647.  
  3648.  
  3649. }
  3650. #endif
  3651.  
  3652.  
  3653. #if FCN_CALLS
  3654. SRTN C_lpar(VOID)
  3655. {
  3656.  
  3657. {
  3658. if(cat2==rpar&&(cat1==expr||cat1==unorbinop))
  3659. SQUASH(pp,3,expr,-2,120);/* ``|(x)|''  or ``|(*)|''*/
  3660. else if(cat1==rpar)
  3661. {/* ``|()|''. This looks better with a bit of extra space between \
  3662.         the parens. */
  3663. b_app1(pp);
  3664. {
  3665. b_app(0134);b_app(073);
  3666. }
  3667.  
  3668. ;b_app1(pp+1);
  3669. REDUCE(pp,2,expr,-2,121);
  3670. }
  3671. else if((cat1==decl_hd)&&cat2==rpar)
  3672. {/* Function prototype or cast, like ``|typedef (*T)|'' where |T| \
  3673.         was |typedef|d on the first pass. */
  3674. b_app3(pp);
  3675.  
  3676. OUTDENT;
  3677.  
  3678. if(in_prototype)
  3679. in_prototype--;
  3680.  
  3681. REDUCE(pp,3,cast,-1,122);
  3682. }
  3683. else if(cat1==stmt)
  3684. {/* ``|for(x;y;z)|'' */
  3685. b_app2(pp);b_app(040);REDUCE(pp,2,lpar,0,123);
  3686. }
  3687. else if(cat1==for_like&&cat2==rpar)
  3688. SQUASH(pp,3,expr,-2,1201);/* Macros: |(for)| */
  3689. }
  3690.  
  3691.  
  3692. }
  3693. #endif
  3694.  
  3695.  
  3696. #if FCN_CALLS
  3697. SRTN C_lbracket(VOID)
  3698. {
  3699.  
  3700. {
  3701. if(active_brackets)
  3702. {
  3703. b_app(0134);
  3704. APP_STR("WXA{");
  3705. }
  3706. else b_app1(pp);
  3707.  
  3708. REDUCE(pp,1,lpar,0,5000);
  3709. }
  3710.  
  3711.  
  3712. }
  3713. #endif
  3714.  
  3715.  
  3716. #if FCN_CALLS
  3717. SRTN C_rbracket(VOID)
  3718. {
  3719.  
  3720. {
  3721. if(active_brackets)
  3722. {
  3723. text_pointer t= indirect(pp->trans);
  3724.  
  3725. if(**t==0135)**t= 0175;
  3726. }
  3727.  
  3728. b_app1(pp);
  3729.  
  3730. REDUCE(pp,1,rpar,-3,5001);
  3731. }
  3732.  
  3733.  
  3734. }
  3735. #endif
  3736.  
  3737.  
  3738. #if FCN_CALLS
  3739. SRTN C_lbrace(VOID)
  3740. {
  3741.  
  3742. {
  3743. if(cat1==rbrace)/* ``|{}|'' */
  3744. {
  3745. b_app1(pp);
  3746. {
  3747. b_app(0134);b_app(054);
  3748. }
  3749.  
  3750. ;b_app1(pp+1);
  3751. REDUCE(pp,2,stmt,-1,130);
  3752. }
  3753. else if((cat1==stmt||cat1==decl||cat1==functn)&&cat2==rbrace)
  3754. /* ``|{x;}|''  or \dots\ or \Cpp:  |@c++ main(){try{}catch(){}}| */
  3755. {
  3756. b_app(force);
  3757. b_app1(pp);/* ``|{|'' */
  3758. b_app(force);
  3759. b_app1(pp+1);/* Body */
  3760. b_app(force);
  3761. b_app1(pp+2);/* ``|}|'' */
  3762. REDUCE(pp,3,stmt,-1,131);
  3763. }
  3764. else if(cat1==expr)
  3765. {
  3766. if(cat2==rbrace)
  3767. SQUASH(pp,3,expr,-2,132);/* ``|enum{red}|'' */
  3768. else if(cat2==comma&&cat3==rbrace)
  3769. SQUASH(pp,4,expr,-2,132);
  3770. }
  3771. }
  3772.  
  3773.  
  3774. }
  3775. #endif
  3776.  
  3777.  
  3778. #if FCN_CALLS
  3779. SRTN C__unop(VOID)
  3780. {
  3781.  
  3782. {
  3783. if(cat1==expr)
  3784. SQUASH(pp,2,expr,-2,140);/* ``|!x|'' or ``|++x|'' */
  3785. else if(cat1==int_like)
  3786. SQUASH(pp,2,int_like,0,141);/* \Cpp\ destructor: \
  3787.             ``|@c++ ~base|'' */
  3788. }
  3789.  
  3790.  
  3791. }
  3792. #endif
  3793.  
  3794.  
  3795. #if FCN_CALLS
  3796. SRTN C_unorbinop(VOID)
  3797. {
  3798.  
  3799. {
  3800. if(cat1==expr||(cat1==int_like&&!(cat2==lpar||cat2==unop)))
  3801. {/* ``|*p|'' or ``|&x|''; ``|typedef \
  3802.         (*T)|'' where |T| was |typedef|d on the first pass.  Not \
  3803. \Cpp:  ``|@c++ x + int(i)|'' or ``|@c++ x + base::y|''. */
  3804. b_app(0173);b_app1(pp);b_app(0175);
  3805. b_app1(pp+1);
  3806. REDUCE(pp,2,cat1,-2,150);
  3807. }
  3808. else if(cat1==binop)
  3809.  
  3810. {
  3811. b_app(math_bin);
  3812. b_app1(pp);
  3813. b_app(0173);b_app1(pp+1);b_app(0175);
  3814. b_app(0175);/* End |math_bin| */
  3815. REDUCE(pp,2,binop,-1,151);
  3816. }
  3817.  
  3818.  
  3819. }
  3820.  
  3821.  
  3822. }
  3823. #endif
  3824.  
  3825.  
  3826. #if FCN_CALLS
  3827. SRTN C_cast(VOID)
  3828. {
  3829.  
  3830. {
  3831. if(cat1==expr)/* ``|(int *)p|'' */
  3832. {
  3833. b_app1(pp);
  3834. {
  3835. b_app(0134);b_app(054);
  3836. }
  3837.  
  3838. ;b_app1(pp+1);
  3839. REDUCE(pp,2,expr,-2,160);
  3840. }
  3841. else if(cat1==unorbinop||cat1==reference)
  3842. SQUASH(pp,1,cast,PLUS 1,162);/* ``|(int *)&prms|''. */
  3843. else
  3844. SQUASH(pp,1,expr,-2,161);/* Turn function prototype into expression. */
  3845. }
  3846.  
  3847.  
  3848. }
  3849. #endif
  3850.  
  3851.  
  3852. #if FCN_CALLS
  3853. SRTN C_sizeof_like(VOID)
  3854. {
  3855.  
  3856. {
  3857. if(cat1==cast)
  3858. SQUASH(pp,2,expr,-2,170);/* ``|sizeof (int *)|'' */
  3859. else if(cat1==expr)
  3860. SQUASH(pp,2,expr,-2,171);/* ``|sizeof(x)|'' */
  3861. }
  3862.  
  3863.  
  3864. }
  3865. #endif
  3866.  
  3867.  
  3868. #if FCN_CALLS
  3869. SRTN C__binop(VOID)
  3870. {
  3871.  
  3872. {
  3873. if(cat1==binop)
  3874.  
  3875. {
  3876. b_app(math_bin);b_app1(pp);
  3877. b_app(0173);b_app1(pp+1);b_app(0175);
  3878. b_app(0175);/* End |math_bin| */
  3879. REDUCE(pp,2,binop,-1,180);
  3880. }
  3881.  
  3882. /* ``|+=|'' */
  3883. else if(cat1==space)
  3884. {
  3885. b_app1(pp);/* We eat the space in this macro situation. */
  3886. REDUCE(pp,2,binop,-1,181);/* |#if(a == b)|. */
  3887. }
  3888. else if(Cpp&&cat1==decl_hd)
  3889. SQUASH(pp,2,tstart,0,6063);
  3890. /* Trap for ``|@c++ A<int>|'', with |A| undefined.  See \
  3891.             also Rule 6061. */
  3892. }
  3893.  
  3894.  
  3895. }
  3896. #endif
  3897.  
  3898.  
  3899. #if FCN_CALLS
  3900. SRTN C_do_like(VOID)
  3901. {
  3902.  
  3903. {
  3904. if(cat1==stmt)
  3905. if(cat2==for_like)
  3906. {
  3907. cat2= while_do;
  3908. SQUASH(pp,1,do_like,PLUS 2,191);
  3909. }
  3910. else if(cat2==expr&&cat3==semi)
  3911. {/* ``|do {} while(flag);|'' */
  3912. b_app1(pp);/* ``\&{do}'' */
  3913. indent_force;
  3914. b_app1(pp+1);/* stmt */
  3915. b_app(outdent);
  3916. b_app(force);
  3917. b_app2(pp+2);/* ``\&{while}\dots'' */
  3918. REDUCE(pp,4,stmt,-1,190);
  3919. }
  3920. }
  3921.  
  3922.  
  3923. }
  3924. #endif
  3925.  
  3926.  
  3927. #if FCN_CALLS
  3928. SRTN C_wh_do(VOID)
  3929. {
  3930.  
  3931. {
  3932. b_app1(pp);
  3933.  
  3934. {
  3935. b_app(0134);b_app(054);
  3936. }
  3937.  
  3938. ;
  3939. REDUCE(pp,1,expr,0,192);
  3940. }
  3941.  
  3942.  
  3943. }
  3944. #endif
  3945.  
  3946.  
  3947. #if FCN_CALLS
  3948. SRTN C_for_like(VOID)
  3949. {
  3950.  
  3951. {
  3952. if(cat1==expr)
  3953. {/* ``\&{for}\dots'' */
  3954. b_app1(pp);
  3955. {
  3956. b_app(0134);b_app(054);
  3957. }
  3958.  
  3959. ;b_app1(pp+1);
  3960. b_app(040);
  3961.  
  3962. if(cat2==semi)
  3963. {/* ``|for(;;);|'' */
  3964. if(!auto_semi||(auto_semi&&cat3==semi))
  3965. {
  3966. indent_force;
  3967. b_app1(pp+2);/* Semi on separate line. */
  3968. b_app(outdent);
  3969. REDUCE(pp,3,stmt,-2,200);/*  The $-2$ is for the \
  3970. \&{do} case. Also get here from Ratfor's \&{until}. */
  3971. }
  3972. else
  3973. REDUCE(pp,3,for_hd,0,2011);/* Eat the |auto_semi|. */
  3974. }
  3975. else
  3976. REDUCE(pp,2,for_hd,0,201);/* Eat the arguments. */
  3977. }
  3978. else if(cat1!=lpar)
  3979. SQUASH(pp,1,expr,0,2010);/* Default possiblity. */
  3980. }
  3981.  
  3982.  
  3983. }
  3984. #endif
  3985.  
  3986.  
  3987. #if FCN_CALLS
  3988. SRTN C_forhd(VOID)
  3989. {
  3990.  
  3991. {
  3992. if(cat1==stmt)
  3993. {/* ``|for(;;) x;|'' */
  3994. b_app1(pp);
  3995. indent_force;
  3996. b_app1(pp+1);
  3997. b_app(outdent);
  3998. REDUCE(pp,2,stmt,-1,210);
  3999. }
  4000. }
  4001.  
  4002.  
  4003. }
  4004. #endif
  4005.  
  4006.  
  4007. #if FCN_CALLS
  4008. SRTN C_if_like(VOID)
  4009. {
  4010.  
  4011. {
  4012. if(cat1==lpar&&cat2==expr&&cat3==rpar)/* ``|if(x)|'' */
  4013. {
  4014. b_app1(pp);
  4015. {
  4016. b_app(0134);b_app(054);
  4017. }
  4018.  
  4019. ;b_app3(pp+1);
  4020. #if(0)
  4021. cmnt_after_IF= (cat4==ignore_scrap);/* Comment coming up? */
  4022. #endif
  4023. REDUCE(pp,4,IF_like,0,220);
  4024. }
  4025. }
  4026.  
  4027.  
  4028. }
  4029. #endif
  4030.  
  4031.  
  4032. #if FCN_CALLS
  4033. SRTN C_IF(VOID)
  4034. {
  4035.  
  4036. {
  4037. if(cat1==stmt
  4038. ||cat1==lbrace||cat1==if_like||cat1==for_like||cat1==do_like
  4039. ||cat1==Rdo_like
  4040. #if(0)
  4041. ||cmnt_after_IF
  4042. #endif
  4043. )
  4044. SQUASH(pp,1,if_hd,0,230);/* |if_hd| does the indenting. */
  4045. #if(0)
  4046. else if(cat1==stmt)
  4047. {/* Attach simple statement. */
  4048. b_app1(pp);b_app(040);b_app1(pp+1);
  4049. REDUCE(pp,2,IF_top,-1,231);
  4050. }
  4051. #endif
  4052. }
  4053.  
  4054.  
  4055. }
  4056. #endif
  4057.  
  4058.  
  4059. #if FCN_CALLS
  4060. SRTN C_if_hd(VOID)
  4061. {
  4062.  
  4063. {
  4064. if(cat1==stmt)/* ``|if(x) {}|'' */
  4065. {
  4066. b_app1(pp);/* ``|if(x)|'' */
  4067. indent_force;
  4068. b_app1(pp+1);/* ``|{}|'' */
  4069. b_app(outdent);
  4070. REDUCE(pp,2,IF_top,-1,233);
  4071. }
  4072. else if(cat1==IF_top&&cat2==else_like)
  4073. SQUASH(pp,1,if_hd,2,234);
  4074. }
  4075.  
  4076.  
  4077. }
  4078. #endif
  4079.  
  4080.  
  4081. #if FCN_CALLS
  4082. SRTN C_els_hd(VOID)
  4083. {
  4084.  
  4085. {
  4086. if(cat1==stmt)/* ``|if(x) {}|'' */
  4087. {
  4088. b_app1(pp);/* ``|if(x)|'' */
  4089. indent_force;
  4090. b_app1(pp+1);/* ``|{}|'' */
  4091. b_app(outdent);
  4092. REDUCE(pp,2,ELSE_like,-1,241);
  4093. }
  4094. }
  4095.  
  4096.  
  4097. }
  4098. #endif
  4099.  
  4100.  
  4101. #if FCN_CALLS
  4102. SRTN C_else(VOID)
  4103. {
  4104.  
  4105. {
  4106. if(cat1==if_like)/* ``|else if|'' */
  4107. {
  4108. b_app1(pp);b_app(040);b_app1(pp+1);
  4109. REDUCE(pp,2,if_like,0,235);
  4110. }
  4111. else if(cat1==stmt||cat1==lbrace||cat1==for_like||cat1==do_like)
  4112. SQUASH(pp,1,else_hd,0,236);/* ``|else {}|'' */
  4113. #if 0 /* The following puts simple statement on same line. */
  4114. else if(cat1==stmt)/* ``|else z;|'' */
  4115. {
  4116. b_app1(pp);b_app(040);b_app1(pp+1);
  4117. REDUCE(pp,2,ELSE_like,-1,237);
  4118. }
  4119. #endif
  4120. }
  4121.  
  4122.  
  4123. }
  4124. #endif
  4125.  
  4126.  
  4127. #if FCN_CALLS
  4128. SRTN C_ELS(VOID)
  4129. {
  4130.  
  4131.  
  4132.  
  4133. }
  4134. #endif
  4135.  
  4136.  
  4137. #if FCN_CALLS
  4138. SRTN C_IF_top(VOID)
  4139. {
  4140.  
  4141. {
  4142. if(cat1==else_like||cat1==else_hd)
  4143. SQUASH(pp,1,IF_top,1,242);/* Expand ahead. */
  4144. else if(cat1==IF_top)
  4145. {
  4146. b_app1(pp);/* \&{if}\dots */
  4147. b_app(force);
  4148. b_app1(pp+1);/* \&{else if}\dots */
  4149. REDUCE(pp,2,IF_top,-1,238);
  4150. }
  4151. else if(cat1==ELSE_like)
  4152. {
  4153. b_app1(pp);/* \&{if} */
  4154. b_app(force);
  4155. b_app1(pp+1);/* \&{else} */
  4156. REDUCE(pp,2,stmt,-1,239);
  4157. }
  4158. else if(cat1==IF_like&&(cat2==expr||cat2==stmt))
  4159. SQUASH(pp,1,IF_top,1,241);
  4160. else
  4161. SQUASH(pp,1,stmt,-1,240);
  4162. }
  4163.  
  4164.  
  4165. }
  4166. #endif
  4167.  
  4168.  
  4169. #if FCN_CALLS
  4170. SRTN C_stmt(VOID)
  4171. {
  4172.  
  4173. {
  4174. if(cat1==stmt||(Cpp&&cat1==decl))/* ``|x; y;|'' */
  4175. {
  4176. b_app1(pp);b_app(force);
  4177. b_app1(pp+1);REDUCE(pp,2,stmt,-1,250);
  4178. }
  4179. else if(cat1==functn)
  4180. {
  4181. b_app1(pp);b_app(big_force);
  4182. b_app1(pp+1);
  4183. REDUCE(pp,2,stmt,-1,251);
  4184. }
  4185. }
  4186.  
  4187.  
  4188. }
  4189. #endif
  4190.  
  4191.  
  4192. #if FCN_CALLS
  4193. SRTN C_case_like(VOID)
  4194. {
  4195.  
  4196. {
  4197. if(cat1==semi)
  4198. SQUASH(pp,2,stmt,-1,260);/* |return;| */
  4199. else if(cat1==colon)
  4200. SQUASH(pp,2,tag,-1,261);/* |default:| or \Cpp: |@c++ public:| */
  4201. else if(cat1==expr)
  4202. {
  4203. if(cat2==semi)/* |return x;| */
  4204. {
  4205. b_app1(pp);b_app(040);b_app2(pp+1);
  4206. REDUCE(pp,3,stmt,-1,262);
  4207. }
  4208. else if(cat2==colon)/* |case one:| */
  4209. {
  4210. b_app1(pp);b_app(040);b_app2(pp+1);
  4211. REDUCE(pp,3,tag,-1,263);
  4212. }
  4213. }
  4214. else if(cat1==int_like)
  4215. {/* \Cpp: |@c++ public base| */
  4216. b_app1(pp);b_app(040);b_app1(pp+1);
  4217. REDUCE(pp,2,int_like,-2,264);
  4218. }
  4219. }
  4220.  
  4221.  
  4222. }
  4223. #endif
  4224.  
  4225.  
  4226. #if FCN_CALLS
  4227. SRTN C_tag(VOID)
  4228. {
  4229.  
  4230. {
  4231. if(cat1==tag)/* ``|case one: case two:|'' */
  4232. {
  4233. b_app1(pp);
  4234. b_app(force);
  4235. b_app(backup);
  4236. b_app1(pp+1);REDUCE(pp,2,tag,-1,270);
  4237. }
  4238. else if(cat1==stmt||cat1==decl||cat1==functn)/* ``|case one: \
  4239.         break;|'' or \Cpp: ``|@c++ public: int constructor();|''  */
  4240. {
  4241. b_app(big_force);
  4242. b_app(backup);b_app1(pp);b_app(force);
  4243. b_app1(pp+1);
  4244. REDUCE(pp,2,cat1,-1,271);
  4245. }
  4246. }
  4247.  
  4248.  
  4249. }
  4250. #endif
  4251.  
  4252.  
  4253. #if FCN_CALLS
  4254. SRTN C_semi(VOID)
  4255. {
  4256.  
  4257. {
  4258. b_app(040);b_app1(pp);
  4259. REDUCE(pp,1,stmt,-1,280);
  4260. }
  4261.  
  4262.  
  4263. }
  4264. #endif
  4265.  
  4266.  
  4267. #if FCN_CALLS
  4268. SRTN C_template(VOID)
  4269. {
  4270.  
  4271. {
  4272. if(cat1==langle)
  4273. SQUASH(pp,1,template,PLUS 1,6000);
  4274. else if(cat1==tlist)
  4275. {
  4276. b_app1(pp);b_app(040);b_app1(pp+1);b_app(force);
  4277. REDUCE(pp,2,int_like,0,6001);
  4278. }
  4279. }
  4280.  
  4281.  
  4282. }
  4283. #endif
  4284.  
  4285.  
  4286. #if FCN_CALLS
  4287. SRTN C_langle(VOID)
  4288. {
  4289.  
  4290. {
  4291. if((pp-1)->cat==template||(pp-1)->cat==int_like||(pp-1)->cat==
  4292. struct_like)
  4293. {
  4294. b_app(0134);
  4295. APP_STR("WLA ");/* \.{\\WLA} $\equiv$ `$\WLA$'. */
  4296. REDUCE(pp,1,tstart,0,6050);/* Begining of template parameter list. */
  4297. }
  4298. else
  4299. SQUASH(pp,1,binop,-1,6051);
  4300. }
  4301.  
  4302.  
  4303. }
  4304. #endif
  4305.  
  4306.  
  4307. #if FCN_CALLS
  4308. SRTN C_rangle(VOID)
  4309. {
  4310.  
  4311. {
  4312. SQUASH(pp,1,binop,-1,6052);
  4313. }
  4314.  
  4315.  
  4316. }
  4317. #endif
  4318.  
  4319.  
  4320. #if FCN_CALLS
  4321. SRTN C_tstart(VOID)
  4322. {
  4323.  
  4324. {
  4325. if(cat2==rangle&&(cat1==int_like||cat1==decl_hd||cat1==expr
  4326. ||cat1==unorbinop))
  4327. {
  4328. b_app2(pp);
  4329. b_app(0134);
  4330. APP_STR("WRA ");/* Closing of template. */
  4331. OUTDENT;
  4332. REDUCE(pp,3,tlist,-1,6060);
  4333. }
  4334. }
  4335.  
  4336.  
  4337. }
  4338. #endif
  4339.  
  4340.  
  4341. #if FCN_CALLS
  4342. SRTN C_tlist(VOID)
  4343. {
  4344.  
  4345.  
  4346.  
  4347. }
  4348. #endif
  4349.  
  4350.  
  4351. #if FCN_CALLS
  4352. SRTN C_namespace(VOID)
  4353. {
  4354.  
  4355. {
  4356. if(cat1==expr||cat1==int_like)
  4357. {/* \Cpp: |@c++ namespace A| */
  4358. make_underlined(pp+1);make_reserved(pp+1);
  4359.  
  4360. b_app1(pp);b_app(040);b_app1(pp+1);
  4361.  
  4362. REDUCE(pp,2,fn_decl,0,7901);
  4363. }
  4364. else if(cat1==lbrace)
  4365. SQUASH(pp,1,fn_decl,0,7902);/* |@c++ namespace{}| */
  4366. }
  4367.  
  4368.  
  4369. }
  4370. #endif
  4371.  
  4372.  
  4373. #endif /* Part 1 */
  4374.  
  4375. #if(part != 1)
  4376.  
  4377.  
  4378. SRTN
  4379. R_productions(VOID)
  4380. {
  4381. switch(pp->cat)
  4382. {
  4383. case ignore_scrap:
  4384.  
  4385. #if FCN_CALLS
  4386. C_ignore_scrap();
  4387. #else
  4388.  
  4389. {
  4390. switch(cat1)
  4391. {
  4392. case stmt:
  4393. case functn:
  4394. SQUASH(pp,2,cat1,0,1);
  4395. break;
  4396. }
  4397. }
  4398.  
  4399.  
  4400. #endif
  4401.  
  4402. break;
  4403. case expr:
  4404. #if FCN_CALLS
  4405. R_expr();
  4406. #else
  4407.  
  4408. {
  4409. if(cat1==unop)SQUASH(pp,2,expr,-2,2);
  4410. else if((cat1==binop||cat1==unorbinop||cat1==colon)&&cat2==expr)
  4411. /* Here we have to worry about constructions such as `|@r #:0|'. */
  4412. if(cat1==colon&&(*pp->trans)[1]==(sixteen_bits)043)
  4413. {
  4414. b_app1(pp);
  4415. APP_STR("\\Colon");
  4416. b_app1(pp+2);
  4417. REDUCE(pp,3,expr,-2,3333);
  4418. }
  4419. else SQUASH(pp,3,expr,-2,3);/* ``|@r x = y|'' or ``|@r x + y|'' or \
  4420.                 ``|@r dimension a(0:100)|'' */
  4421. else if(cat1==comma&&(cat2==expr||cat2==end_like))/* Note |end_like|; \
  4422.                     keyword in I/O. */
  4423. {
  4424. b_app2(pp);
  4425. OPT9;
  4426. b_app1(pp+2);REDUCE(pp,3,expr,-2,4);
  4427. }
  4428. else if(cat1==expr)SQUASH(pp,2,expr,-2,5);/* ``|@r f(x)|'' */
  4429. else if(cat1==semi)SQUASH(pp,2,stmt,-2,6);/* ``|@r x=y;|'' */
  4430. else if(cat1==colon&&cat2==unorbinop&&
  4431. (cat3==rpar||(active_brackets&&cat3==rbracket)))
  4432. SQUASH(pp,3,expr,-2,299);/* ``|@r 0:*|'' */
  4433. else if(cat1==colon&&cat2!=lpar)/* label */
  4434. {
  4435. make_underlined(pp);SQUASH(pp,2,tag,0,7);
  4436. }
  4437. else if(cat1==comma&&cat2==int_like)/* For macro usage. */
  4438. {
  4439. b_app2(pp);
  4440. OPT9;
  4441. b_app1(pp+2);REDUCE(pp,3,int_like,-2,4444);
  4442. }
  4443. }
  4444.  
  4445.  
  4446. #endif
  4447.  
  4448. break;
  4449. case key_wd:
  4450. #if FCN_CALLS
  4451. R_key_wd();
  4452. #else
  4453.  
  4454. {
  4455. SQUASH(pp,1,expr,-2,4445);
  4456. }
  4457.  
  4458.  
  4459. #endif
  4460.  
  4461. break;
  4462. case exp_op:
  4463. #if FCN_CALLS
  4464. R_exp_op();
  4465. #else
  4466.  
  4467. {
  4468. if(cat1==lpar)SQUASH(pp,1,exp_op,PLUS 1,2995);/* ``|@r x^(a+b)|'' */
  4469. else if(cat1==expr)
  4470. if(cat2==lpar)SQUASH(pp,1,exp_op,PLUS 2,2996);/* Expand array \
  4471. argument. */
  4472. else if(cat2==expr)SQUASH(pp,1,exp_op,PLUS 1,2997);/* The expr is \
  4473. the result of expanding the array argument. */
  4474. else
  4475. {/* It's now of the form |@r x^expr|; insert braces around \
  4476. argument so \TeX\ understands. */
  4477. b_app1(pp);
  4478. b_app(0173);b_app1(pp+1);b_app(0175);
  4479. REDUCE(pp,2,expr,-1,2998);
  4480. }
  4481. }
  4482.  
  4483.  
  4484. #endif
  4485.  
  4486. break;
  4487. case _EXPR:
  4488. #if FCN_CALLS
  4489. C__E();
  4490. #else
  4491.  
  4492. {
  4493. APP_SPACE;b_app1(pp);
  4494. REDUCE(pp,1,expr,-2,4446);
  4495. }
  4496.  
  4497.  
  4498. #endif
  4499.  
  4500. break;
  4501. case _EXPR_:
  4502. #if FCN_CALLS
  4503. C__E_();
  4504. #else
  4505.  
  4506. {
  4507.  
  4508.  
  4509. APP_SPACE;b_app1(pp);APP_SPACE;
  4510.  
  4511. ;
  4512. REDUCE(pp,1,expr,-2,4447);
  4513. }
  4514.  
  4515.  
  4516. #endif
  4517.  
  4518. break;
  4519. case EXPR_:
  4520. #if FCN_CALLS
  4521. C_E_();
  4522. #else
  4523.  
  4524. {
  4525. b_app1(pp);APP_SPACE;
  4526. REDUCE(pp,1,expr,-2,4448);
  4527. }
  4528.  
  4529.  
  4530. #endif
  4531.  
  4532. break;
  4533. case lpar:
  4534. #if FCN_CALLS
  4535. R_lpar();
  4536. #else
  4537.  
  4538.  
  4539. if(cat1==expr&&cat2==rpar)SQUASH(pp,3,expr,-2,120);/* ``|@r (x)|'' */
  4540. else if(cat1==expr&&cat2==colon&&cat3==rpar)/* ``|@r (lower:)|'' */
  4541. {
  4542. b_app3(pp);
  4543. {
  4544. b_app(0134);b_app(054);
  4545. }
  4546.  
  4547. ;b_app1(pp+3);
  4548. REDUCE(pp,4,expr,-2,9120);
  4549. }
  4550. else if(cat1==colon&&cat2!=comma)/* ``|@r (:x)|''; watch out for \
  4551.             deferred-shape-spec-lists.  */
  4552. {
  4553. b_app1(pp);
  4554. {
  4555. b_app(0134);b_app(054);
  4556. }
  4557.  
  4558. ;b_app1(pp+1);
  4559. REDUCE(pp,2,lpar,0,9121);
  4560. }
  4561. else if(cat1==rpar)/* ``|@r ()|'' */
  4562. {
  4563. b_app1(pp);
  4564. {
  4565. b_app(0134);b_app(054);
  4566. }
  4567.  
  4568. ;b_app1(pp+1);
  4569. REDUCE(pp,2,expr,-2,121);
  4570. }
  4571. else if(cat1==stmt)/* `` |@r for(x;y;z)|'' */
  4572. {
  4573. b_app2(pp);b_app(040);REDUCE(pp,2,lpar,0,123);
  4574. }
  4575.  
  4576.  
  4577. #endif
  4578.  
  4579. break;
  4580. case lbracket:
  4581. #if FCN_CALLS
  4582. C_lbracket();
  4583. #else
  4584.  
  4585. {
  4586. if(active_brackets)
  4587. {
  4588. b_app(0134);
  4589. APP_STR("WXA{");
  4590. }
  4591. else b_app1(pp);
  4592.  
  4593. REDUCE(pp,1,lpar,0,5000);
  4594. }
  4595.  
  4596.  
  4597. #endif
  4598.  
  4599. break;
  4600. case rbracket:
  4601. #if FCN_CALLS
  4602. C_rbracket();
  4603. #else
  4604.  
  4605. {
  4606. if(active_brackets)
  4607. {
  4608. text_pointer t= indirect(pp->trans);
  4609.  
  4610. if(**t==0135)**t= 0175;
  4611. }
  4612.  
  4613. b_app1(pp);
  4614.  
  4615. REDUCE(pp,1,rpar,-3,5001);
  4616. }
  4617.  
  4618.  
  4619. #endif
  4620.  
  4621. break;
  4622. case unop:
  4623. #if FCN_CALLS
  4624. R_unop();
  4625. #else
  4626.  
  4627.  
  4628. if(cat1==expr)SQUASH(pp,2,expr,-2,33);/* ``|@r !flag|'' */
  4629.  
  4630.  
  4631. #endif
  4632.  
  4633. break;
  4634. case UNOP:
  4635. #if FCN_CALLS
  4636. C_UNOP();
  4637. #else
  4638.  
  4639. {
  4640. b_app1(pp);APP_SPACE;
  4641. REDUCE(pp,1,unop,-1,4443);
  4642. }
  4643.  
  4644.  
  4645. #endif
  4646.  
  4647. break;
  4648. case unorbinop:
  4649. #if FCN_CALLS
  4650. R_unorbinop();
  4651. #else
  4652.  
  4653.  
  4654. if(cat1==expr)/* ``|@r +1.0|'' */
  4655. {
  4656. b_app(0173);b_app1(pp);b_app(0175);
  4657. b_app1(pp+1);
  4658. REDUCE(pp,2,expr,-2,140);
  4659. }
  4660. else if(cat1==binop)
  4661. {
  4662. b_app(math_bin);
  4663. b_app1(pp);
  4664. b_app(0173);b_app1(pp+1);b_app(0175);
  4665. b_app(0175);/* End |math_bin| */
  4666. REDUCE(pp,2,binop,-1,151);
  4667. }
  4668.  
  4669.  
  4670. else if(cat1==comma||cat1==rpar)SQUASH(pp,1,expr,-2,141);/* ``|@r \
  4671. *,|'' or ``|@r *)|'' */
  4672.  
  4673.  
  4674. #endif
  4675.  
  4676. break;
  4677. case binop:
  4678. #if FCN_CALLS
  4679. R_binop();
  4680. #else
  4681.  
  4682.  
  4683. if(cat1==binop)/* ``|@r / /|'' */
  4684. {
  4685. sixteen_bits tok;
  4686.  
  4687. tok= **pp->trans;
  4688.  
  4689. if(tok==(sixteen_bits)057&&(**(pp+1)->trans==tok))
  4690.  
  4691. {
  4692. b_app(0173);
  4693. b_app1(pp);
  4694. {
  4695. b_app(0134);b_app(054);
  4696. }
  4697.  
  4698. ;b_app1(pp+1);
  4699. b_app(0175);
  4700. REDUCE(pp,2,slashes,-1,180);
  4701. }
  4702.  
  4703.  
  4704. else
  4705. {
  4706. b_app(math_bin);b_app1(pp);
  4707. b_app(0173);b_app1(pp+1);b_app(0175);
  4708. b_app(0175);/* End |math_bin| */
  4709. REDUCE(pp,2,binop,-1,180);
  4710. }
  4711.  
  4712.  
  4713. }
  4714. else if(cat1==expr&&cat2==binop)/* ``|@r /dia/|'' */
  4715. {
  4716. sixteen_bits tok;
  4717.  
  4718. tok= **pp->trans;
  4719.  
  4720. if(tok==(sixteen_bits)057&&(**(pp+2)->trans==tok))
  4721.  
  4722. {
  4723. b_app(0173);
  4724. b_app1(pp);/* |'/'| */
  4725. b_app(0175);
  4726.  
  4727. make_underlined(pp+1);/* Index common block name. */
  4728. b_app1(pp+1);/* expr */
  4729.  
  4730. b_app(0173);
  4731. b_app1(pp+2);/* |'/'| */
  4732. b_app(0175);
  4733.  
  4734. REDUCE(pp,3,slashes,-1,9181);
  4735. }
  4736.  
  4737.  
  4738. }
  4739.  
  4740.  
  4741. #endif
  4742.  
  4743. break;
  4744. case BINOP:
  4745. #if FCN_CALLS
  4746. C_BINOP();
  4747. #else
  4748.  
  4749. {
  4750.  
  4751.  
  4752. APP_SPACE;b_app1(pp);APP_SPACE;
  4753.  
  4754. ;
  4755. REDUCE(pp,1,binop,-1,4444);
  4756. }
  4757.  
  4758.  
  4759. #endif
  4760.  
  4761. break;
  4762. case slash_like:
  4763. #if FCN_CALLS
  4764. R_slash_like();
  4765. #else
  4766.  
  4767. if(cat1==slash_like)
  4768. {/* The slash already has braces around it (appended by \FWEAVE).ac */
  4769. b_app1(pp);
  4770.  
  4771. {
  4772. b_app(0134);b_app(054);
  4773. }
  4774.  
  4775. ;
  4776. b_app1(pp+1);
  4777. REDUCE(pp,2,slashes,-1,1801);
  4778. }
  4779. else if(cat1==expr&&cat2==slash_like)
  4780. SQUASH(pp,3,slashes,-1,1802);
  4781.  
  4782.  
  4783. #endif
  4784.  
  4785. break;
  4786. case colon:
  4787. #if FCN_CALLS
  4788. R_colon();
  4789. #else
  4790.  
  4791.  
  4792. if(cat1==expr||cat1==unorbinop)SQUASH(pp,2,expr,-2,9500);/* ``|@r \
  4793. (:upper)|'' */
  4794. else if(cat1==comma&&cat2==colon)SQUASH(pp,3,expr,-2,9502);
  4795. /* Deferred-shape-spec-list: |@r (:,:)| */
  4796. else SQUASH(pp,1,expr,0,9501);/* |@r (:)| */
  4797.  
  4798.  
  4799. #endif
  4800.  
  4801. break;
  4802. case program_like:
  4803. #if FCN_CALLS
  4804. R_program_like();
  4805. #else
  4806.  
  4807.  
  4808. if(is_FORTRAN_(language))
  4809. {
  4810. if(cat1==expr&&cat2==semi)
  4811. {
  4812. fcn_level++;
  4813. b_app1(pp);b_app(040);
  4814. b_app(indent);b_app2(pp+1);b_app(outdent);
  4815. defined_at(make_underlined(pp+1));
  4816. REDUCE(pp,3,fcn_hd,-1,2999);
  4817. }
  4818. else if(cat1==no_order)
  4819. {/* |@r block data| */
  4820. b_app1(pp);b_app(040);b_app1(pp+1);
  4821. REDUCE(pp,2,program_like,0,2997);
  4822. }
  4823. else if(cat1==semi)
  4824. {/* |@r block data;| */
  4825. fcn_level++;
  4826. b_app1(pp);
  4827. REDUCE(pp,2,fcn_hd,-1,2996);
  4828. }
  4829. }
  4830. else
  4831. {
  4832. fcn_level++;
  4833. SQUASH(pp,1,int_like,-1,2998);
  4834. }
  4835.  
  4836.  
  4837. #endif
  4838.  
  4839. break;
  4840. case struct_like:
  4841. #if FCN_CALLS
  4842. R_struct_like();
  4843. #else
  4844.  
  4845. if(cat1==lpar)
  4846. {
  4847. b_app1(pp);
  4848. #if(0)
  4849.  
  4850. {
  4851. b_app(0134);b_app(054);
  4852. }
  4853.  
  4854. /* Looks nicer with a bit of space. */
  4855. #endif
  4856. REDUCE(pp,1,int_like,0,9075);/* \FORTRAN-88 declaration: \
  4857. ``|@r9 type(triangle)|''. */
  4858. }
  4859. else if(cat1==comma&&cat2==int_like)
  4860. {
  4861. b_app2(pp);b_app(040);b_app1(pp+2);
  4862. REDUCE(pp,3,struct_like,0,90750);/* ``|@r9 type, private|'' */
  4863. }
  4864. else if(cat1==binop&&**(pp+1)->trans!=(sixteen_bits)057)
  4865. SQUASH(pp,2,struct_like,0,90751);/* ``|@r9 type, public::|''  The \
  4866.         |!=| precluded the VAX |@n9 structure /stuff/| declaration. */
  4867. else if(cat1==expr||cat1==slashes||cat1==struct_like)
  4868. {/* ``|@r9 type person|'', ``|@r9 type /vaxstruct/|'', or ``|@r9 \
  4869.             interface operator|'' */
  4870. b_app1(pp);b_app(040);b_app1(pp+1);
  4871. make_underlined(pp+1);
  4872. REDUCE(pp,2,language==FORTRAN_90?struct_hd:struct_like,0,9076);
  4873. }
  4874. else if(cat1==semi)
  4875. SQUASH(pp,1,struct_hd,0,9077);/* |@r9 interface| */
  4876. else if(cat1==lbrace)/* ``|@r9 type person {integer i;};|'' */
  4877. {
  4878. b_app1(pp);indent_force;
  4879. b_app1(pp+1);REDUCE(pp,2,struct_hd,0,100);
  4880. }
  4881.  
  4882.  
  4883. #endif
  4884.  
  4885. break;
  4886. case struct_hd:
  4887. #if FCN_CALLS
  4888. R_str_hd();
  4889. #else
  4890.  
  4891. if(is_FORTRAN_(language))
  4892. {
  4893. if(cat1==expr)
  4894. {
  4895. b_app1(pp);
  4896. {
  4897. b_app(0134);b_app(054);
  4898. }
  4899.  
  4900. b_app1(pp+1);/* ``|@r9 \
  4901. interface operator(.not.)|'' */
  4902. REDUCE(pp,2,struct_hd,0,90760);
  4903. }
  4904. else if(cat1==semi)
  4905. {
  4906. fcn_level++;
  4907. b_app2(pp);
  4908. b_app(indent);
  4909. REDUCE(pp,2,struct_hd,0,90770);
  4910. }
  4911. else if(cat1==decl||cat1==functn)
  4912. {
  4913. b_app1(pp);
  4914. b_app(force);
  4915. b_app1(pp+1);
  4916. REDUCE(pp,2,struct_hd,0,9078);
  4917. }
  4918. else if(cat1==END_stmt)
  4919. {
  4920. b_app1(pp);
  4921. b_app(outdent);
  4922. b_app(force);
  4923. b_app1(pp+1);
  4924. REDUCE(pp,2,decl,-1,9079);
  4925. }
  4926. }
  4927. else
  4928. {
  4929. if((cat1==decl||cat1==stmt
  4930. ||cat1==expr /*  (For enum) */
  4931. ||cat1==functn /* \Cpp */
  4932. )&&cat2==rbrace)
  4933. {
  4934. b_app1(pp);/* ``|struct {|'' */
  4935. b_app(force);b_app1(pp+1);/* Body */
  4936. b_app(force);b_app1(pp+2);/* ``|}|'' */
  4937. b_app(outdent);
  4938. REDUCE(pp,3,int_like,-1,110);
  4939. }
  4940. else if(cat1==rbrace)
  4941. {
  4942. b_app1(pp);
  4943. {
  4944. b_app(0134);b_app(054);
  4945. }
  4946.  
  4947. b_app1(pp+1);
  4948. b_app(outdent);
  4949. REDUCE(pp,2,int_like,-1,1101);
  4950. }
  4951. }
  4952.  
  4953.  
  4954.  
  4955.  
  4956. #endif
  4957.  
  4958. break;
  4959. case op_like:
  4960. #if FCN_CALLS
  4961. R_op_like();
  4962. #else
  4963.  
  4964. {
  4965. short n;
  4966.  
  4967. if(cat1==lpar)
  4968. {/* We'll search for the obligatory right paren that terminates \
  4969. the list. */
  4970. scrap_pointer q;
  4971. int k;/* Counter. */
  4972.  
  4973. /* If the paren is missing, we could end up appending the entire rest of \
  4974. the code, so we limit the search. */
  4975. for(q= pp+2;q<=scrp_ptr&&q-pp<MAX_OP_TOKENS;q++)
  4976. if(q->cat==rpar)break;
  4977.  
  4978. n= (q->cat==rpar)?PTR_DIFF(short,q,pp):0;
  4979.  
  4980. if(n>0)
  4981. {
  4982. b_app1(pp);b_app(040);/* |@r9 operator| */
  4983. b_app1(pp+1);/* Left paren. */
  4984. b_app(0173);
  4985. APP_STR("\\optrue");
  4986.  
  4987. for(k= 2;k<n;k++)
  4988. b_app1(pp+k);
  4989.  
  4990. APP_STR("\\opfalse");/* We need this here in case we \
  4991. encounter an operator that \FWEAVE\ doesn't know how to overload. */
  4992. b_app(0175);
  4993. b_app1(pp+k);
  4994.  
  4995. REDUCE(pp,n+1,expr,-2,6667);
  4996. }
  4997. }
  4998. }
  4999.  
  5000.  
  5001. #endif
  5002.  
  5003. break;
  5004. case proc_like:
  5005. #if FCN_CALLS
  5006. R_proc_like();
  5007. #else
  5008.  
  5009.  
  5010. if(fcn_level==0){/* Error message */}
  5011. else fcn_level--;
  5012.  
  5013. SQUASH(pp,1,int_like,-1,2989);
  5014.  
  5015.  
  5016. #endif
  5017.  
  5018. break;
  5019. case private_like:
  5020. #if FCN_CALLS
  5021. R_private_like();
  5022. #else
  5023.  
  5024. {
  5025. if(cat1==(eight_bits)(language==FORTRAN_90?semi:colon))
  5026. {
  5027. app(backup);
  5028. b_app2(pp);
  5029. REDUCE(pp,2,decl,-1,2988);
  5030. }
  5031. else SQUASH(pp,1,int_like,-2,2987);
  5032. }
  5033.  
  5034.  
  5035. #endif
  5036.  
  5037. break;
  5038. case int_like:
  5039. #if FCN_CALLS
  5040. R_int_like();
  5041. #else
  5042.  
  5043. {
  5044. if(cat1==lbrace)
  5045. {
  5046. b_app(indent);
  5047. b_app1(pp);
  5048. REDUCE(pp,1,decl_hd,0,940);/* ``|@r block data{}|'' */
  5049. }
  5050. else if(cat1==unorbinop&&cat2==expr)/* ``|@r character*(*)|'' */
  5051. {
  5052. b_app1(pp);
  5053. b_app(0173);b_app2(pp+1);b_app(0175);
  5054. REDUCE(pp,3,int_like,-1,941);
  5055. }
  5056. else if(cat1==int_like||cat1==no_order)/* ``|@r double precision|'' or \
  5057.         F88 things like ``|@r integer, pointer|''; |no_order| takes \
  5058.         care of \&{data} in |@r block data|. */
  5059. {
  5060. b_app1(pp);b_app(040);b_app1(pp+1);
  5061. REDUCE(pp,2,cat0,0,40);
  5062. }
  5063. else if(cat1==comma)
  5064. SQUASH(pp,2,int_like,0,9001);/* F88: ``|@r logical,|'' */
  5065. else if(cat1==binop)/* F88: ``|@r integer :: i|'' */
  5066. {
  5067. b_app2(pp);
  5068. b_app(indent);
  5069. REDUCE(pp,2,decl_hd,0,9002);
  5070. }
  5071. else if(cat1==slashes)
  5072. {
  5073. b_app1(pp);
  5074. b_app(040);
  5075. b_app(indent);
  5076. REDUCE(pp,1,decl_hd,0,9002);
  5077. }
  5078. else if(cat1==expr&&**indirect((pp+1)->trans)==050)
  5079. {
  5080. b_app1(pp);
  5081. {
  5082. b_app(0134);b_app(054);
  5083. }
  5084.  
  5085. b_app1(pp+1);
  5086. REDUCE(pp,2,int_like,0,9003);/* ``|@r integer (KIND=4)|'' */
  5087. }
  5088. else if(cat1==expr||cat1==semi)
  5089. {
  5090. b_app1(pp);
  5091.  
  5092. if(cat1!=semi)b_app(040);
  5093.  
  5094. b_app(indent);/* Start long declaration. */
  5095.  
  5096. REDUCE(pp,1,decl_hd,0,41);/* JAK: -1 changed to 0 */
  5097. }
  5098. else if(cat1==rbrace)
  5099. SQUASH(pp,1,decl,-1,411);
  5100. /* See \.{ratfor} example |@r9 module procedure element;|. */
  5101. }
  5102.  
  5103.  
  5104. #endif
  5105.  
  5106. break;
  5107. case decl_hd:
  5108. #if FCN_CALLS
  5109. R_dcl_hd();
  5110. #else
  5111.  
  5112. if(cat1==comma)
  5113. {/* ``|@r integer i,j|'' */
  5114. b_app2(pp);b_app(040);REDUCE(pp,2,decl_hd,0,54);
  5115. }
  5116. else if(cat1==expr)
  5117. {
  5118. make_underlined(pp+1);
  5119.  
  5120. if(**(pp+2)->trans==(sixteen_bits)075)
  5121. {/* Initialization coming up. */
  5122. SQUASH(pp,1,decl_hd,PLUS 1,55);
  5123. }
  5124. else
  5125. {
  5126. SQUASH(pp,2,decl_hd,0,56);
  5127. }
  5128. }
  5129. else if(cat1==slashes)
  5130. {/* |@r integer i/1/| */
  5131. SQUASH(pp,2,decl_hd,0,57);
  5132. }
  5133. else if(cat1==lbrace||cat1==int_like||cat1==implicit_like)
  5134. /* |@r subroutine f {}| or |@r function f(x) real x;| or |@r \
  5135. program main implicit none;|  */
  5136. {
  5137. b_app1(pp);
  5138. b_app(outdent);/* Turn off |indent|. */
  5139. defined_at(FIRST_ID(pp));
  5140. REDUCE(pp,1,fn_decl,0,58);
  5141. }
  5142. else if(cat1==semi&&(!auto_semi||(auto_semi&&cat2!=lbrace)))
  5143. {
  5144. b_app2(pp);
  5145. b_app(outdent);/* Finish long declaration. */
  5146. REDUCE(pp,2,
  5147. (eight_bits)(intermingle?(intermingle= NO,ignore_scrap):decl),
  5148. -1,59);
  5149. }
  5150. else if(cat1==built_in)
  5151. {/* |@r9 use a, only| */
  5152. b_app1(pp);b_app(040);b_app1(pp+1);
  5153. REDUCE(pp,2,decl_hd,0,5901);
  5154. }
  5155. #if(0)
  5156. else if(cat1==lpar&&cat2==expr)make_underlined(pp+2);/* For \
  5157.                         |$decl_hd|. */
  5158. #endif
  5159.  
  5160.  
  5161. #endif
  5162.  
  5163. break;
  5164. case decl:
  5165. #if FCN_CALLS
  5166. R_decl();
  5167. #else
  5168.  
  5169. if(is_FORTRAN_(language)&&cat1==END_like)SQUASH(pp,1,stmt,-1,960);
  5170. /* `` |@r program main; end;|'' */
  5171. else if(cat1==decl)
  5172. {
  5173. b_app1(pp);b_app(force);
  5174. b_app1(pp+1);
  5175. REDUCE(pp,2,decl,-1,60);
  5176. }
  5177. else if(cat1==stmt||cat1==functn)
  5178. {
  5179. b_app1(pp);b_app(big_force);
  5180. b_app1(pp+1);REDUCE(pp,2,cat1,-1,61);
  5181. }
  5182.  
  5183.  
  5184. #endif
  5185.  
  5186. break;
  5187. case fn_decl:
  5188. #if FCN_CALLS
  5189. C_fn_decl();
  5190. #else
  5191.  
  5192. {
  5193. if(cat1==semi&&Cpp)
  5194. {/* |@c++ using namespace X;| */
  5195. b_app2(pp);
  5196. REDUCE(pp,2,stmt,-1,72);
  5197. }
  5198. else if(cat1==decl)/* ``|f(x) float x;|'' */
  5199. {
  5200. b_app1(pp);
  5201. b_app(indent);indent_force;
  5202. b_app1(pp+1);/* Accrete old-style declarations. */
  5203. b_app(outdent);b_app(outdent);
  5204. REDUCE(pp,2,fn_decl,0,70);
  5205. }
  5206. else if(cat1==stmt)/* ``|f(){}|'' */
  5207. {
  5208. #if(0)
  5209. b_app(backup);/* Beginning of function. */
  5210. #endif
  5211. b_app1(pp);b_app(force);
  5212. b_app(indent);
  5213. b_app1(pp+1);/* Function body */
  5214. b_app(outdent);
  5215. in_function= NO;
  5216. REDUCE(pp,2,functn,-1,71);
  5217. }
  5218. }
  5219.  
  5220.  
  5221. #endif
  5222.  
  5223. break;
  5224. case fcn_hd:
  5225. #if FCN_CALLS
  5226. R_fcn_hd();
  5227. #else
  5228.  
  5229. {
  5230. if(cat1==END_stmt)
  5231. {
  5232. b_app1(pp);b_app(force);
  5233. b_app1(pp+1);
  5234. REDUCE(pp,2,functn,-1,7172);
  5235. }
  5236. else if(cat1==stmt&&cat2==END_stmt)
  5237. {
  5238. b_app1(pp);b_app(force);
  5239. b_app(indent);
  5240. b_app1(pp+1);/* Body */
  5241.  
  5242. if(fcn_level==0)
  5243. {
  5244. if(containing)b_app(big_force);
  5245. while(containing)
  5246. {
  5247. #if(0)
  5248. b_app(outdent);
  5249. #endif
  5250. containing--;
  5251. }
  5252. }
  5253.  
  5254. b_app(outdent);
  5255. b_app(force);
  5256.  
  5257. b_app1(pp+2);
  5258. REDUCE(pp,3,functn,-1,7171);
  5259. }
  5260. }
  5261.  
  5262.  
  5263. #endif
  5264.  
  5265. break;
  5266. case functn:
  5267. #if FCN_CALLS
  5268. R_functn();
  5269. #else
  5270.  
  5271.  
  5272. if(cat1==functn||(is_RATFOR_(language)&&(cat1==decl||cat1==stmt)))
  5273. {
  5274. b_app1(pp);b_app(big_force);
  5275. b_app1(pp+1);REDUCE(pp,2,cat1,0,80);
  5276. }
  5277. #if(0)
  5278. else if(cat1==END_like)
  5279. {
  5280. b_app1(pp);
  5281. REDUCE(pp,1,stmt,-1,9050);
  5282. }
  5283. #endif
  5284.  
  5285.  
  5286. #endif
  5287.  
  5288. break;
  5289. case lbrace:
  5290. #if FCN_CALLS
  5291. R_lbrace();
  5292. #else
  5293.  
  5294. if(cat1==rbrace)/* ``|@r {}|'' */
  5295. {
  5296. b_app1(pp);
  5297. {
  5298. b_app(0134);b_app(054);
  5299. }
  5300.  
  5301. ;b_app1(pp+1);
  5302. REDUCE(pp,2,stmt,-2,130);
  5303. }
  5304. else if((cat1==stmt||cat1==decl)&&cat2==rbrace)/* ``|@r {x;}|'' */
  5305. {
  5306. b_app(force);
  5307. b_app1(pp);b_app(force);
  5308. b_app1(pp+1);b_app(force);
  5309. b_app1(pp+2);
  5310. REDUCE(pp,3,stmt,-2,131);
  5311. }
  5312.  
  5313.  
  5314. #endif
  5315.  
  5316. break;
  5317. case do_like:
  5318. #if FCN_CALLS
  5319. R_do_like();
  5320. #else
  5321.  
  5322.  
  5323. if(cat1==stmt)
  5324. {
  5325. if(cat2==until_like)
  5326. {
  5327. found_until= YES;
  5328. SQUASH(pp,1,do_like,PLUS 2,9190);/* ``|@r repeat \
  5329. {} until ;|''; expand the \&{until}. */
  5330. }
  5331. else
  5332. {
  5333. b_app1(pp);
  5334. indent_force;
  5335. b_app1(pp+1);
  5336. b_app(outdent);
  5337. b_app(force);
  5338.  
  5339. if(found_until&&cat2==stmt)/* Get here by expanding the \
  5340. \&{until}. */
  5341. {
  5342. found_until= NO;
  5343. b_app1(pp+2);REDUCE(pp,3,stmt,-2,9191);
  5344. }
  5345. else REDUCE(pp,2,stmt,-2,9192);/* ``|@r repeat {}|''; \
  5346. no bottom. */
  5347. }
  5348. }
  5349.  
  5350.  
  5351. #endif
  5352.  
  5353. break;
  5354. case until_like:
  5355. #if FCN_CALLS
  5356. R_until_like();
  5357. #else
  5358.  
  5359.  
  5360. SQUASH(pp,1,for_like,0,9195);
  5361.  
  5362.  
  5363. #endif
  5364.  
  5365. break;
  5366. case Rdo_like:
  5367. #if FCN_CALLS
  5368. R_Rdo_like();
  5369. #else
  5370.  
  5371.  
  5372. if(is_FORTRAN_(language))
  5373. {
  5374. if(cat1==for_like)/* \&{do} \&{while} */
  5375. {
  5376. b_app1(pp);b_app(040);b_app1(pp+1);
  5377. REDUCE(pp,2,Rdo_like,0,9600);
  5378. }
  5379. else if(cat1==expr&&((cat2==expr&&cat3==binop)||cat2==if_like))
  5380. /* ``|@r do 10 i='' */
  5381. {
  5382. label_text_ptr[indent_level]= (pp+1)->trans;/* Pointer to \
  5383.             a |token_pointer|---namely, index into |tok_start|. */
  5384. b_app1(pp);
  5385. b_app(040);
  5386. b_app1(pp+1);/* Loop number. */
  5387. REDUCE(pp,2,Rdo_like,0,9601);/* Swallow only the loop number. */
  5388. }
  5389. else if(cat1==stmt)/* ``|@r do i=1,10;|'' */
  5390. {
  5391. loop_num[indent_level++]= ++max_loop_num;
  5392.  
  5393. b_app1(pp);/* \&{do} */
  5394. b_app(040);
  5395. b_app1(pp+1);/* $i=1,10;$ */
  5396. app_loop_num(max_loop_num);
  5397.  
  5398. b_app(indent);
  5399. REDUCE(pp,2,stmt,-2,9602);
  5400. }
  5401. }
  5402. /* \Ratfor. */
  5403. else if(cat1==stmt||(cat1==expr&&cat2==lbrace))/* ``|@r do i=1,10;|'' \
  5404. or ``|@r do i=1,10{|'' */
  5405. {
  5406. b_app1(pp);b_app(040);b_app1(pp+1);
  5407. REDUCE(pp,2,for_hd,0,9603);
  5408. }
  5409.  
  5410.  
  5411. #endif
  5412.  
  5413. break;
  5414. case if_like:
  5415. #if FCN_CALLS
  5416. R_if_like();
  5417. #else
  5418.  
  5419.  
  5420. if(cat1==CASE_like)
  5421. {
  5422. b_app1(pp);b_app(040);b_app1(pp+1);/* |@r9 select case| */
  5423. REDUCE(pp,2,if_like,0,9196);
  5424. }
  5425. else
  5426. if(is_FORTRAN_(language))
  5427. {
  5428. if(cat1==expr)
  5429. {
  5430. boolean if_form;
  5431.  
  5432. if((if_form= BOOLEAN(cat2==built_in&&cat3==semi))||cat2==semi)
  5433. {/* ``|@n if(x) then;|''  or ``|@n where(x); |'' */
  5434. short n;/* Number to append. Things are annoying because the |@n if| \
  5435. and |@n where| statements aren't completely symmetrical. */
  5436.  
  5437. loop_num[indent_level++]= ++max_loop_num;
  5438.  
  5439. b_app1(pp);/* \&{if} */
  5440.  
  5441. {
  5442. b_app(0134);b_app(054);
  5443. }
  5444.  
  5445. ;
  5446. b_app1(pp+1);/* $(x)$ */
  5447. b_app(040);
  5448.  
  5449. if(if_form)
  5450. {
  5451. n= 4;
  5452. b_app2(pp+2);/* \&{then}; */
  5453. }
  5454. else
  5455. {/* |@n where| */
  5456. n= 3;
  5457. b_app1(pp+2);/* semi */
  5458. }
  5459.  
  5460. app_loop_num(max_loop_num);
  5461. b_app(indent);
  5462. REDUCE(pp,n,stmt,-2,9800);
  5463. }
  5464. else if(cat2==stmt)/* ``|@n if(x) a=b;|'' */
  5465. {
  5466. b_app1(pp);/* \&{if} */
  5467.  
  5468. {
  5469. b_app(0134);b_app(054);
  5470. }
  5471.  
  5472. ;
  5473. b_app1(pp+1);/* $(x)$ */
  5474. app(040);
  5475. b_app(cancel);
  5476. b_app1(pp+2);/* Statement */
  5477. REDUCE(pp,3,stmt,-2,9801);
  5478. }
  5479. else
  5480. {
  5481. b_app1(pp);
  5482.  
  5483. {
  5484. b_app(0134);b_app(054);
  5485. }
  5486.  
  5487. ;
  5488. b_app1(pp+1);
  5489. REDUCE(pp,2,if_hd,0,9802);
  5490. }
  5491. }
  5492. }
  5493. /* RATFOR\ */
  5494. else
  5495. {
  5496. if(cat1==lpar&&cat2==expr&&cat3==rpar)/* ``|if(x)|'' */
  5497. {
  5498. b_app1(pp);
  5499. {
  5500. b_app(0134);b_app(054);
  5501. }
  5502.  
  5503. ;b_app3(pp+1);
  5504. #if(0)
  5505. cmnt_after_IF= (cat4==ignore_scrap);/* Comment coming up? */
  5506. #endif
  5507. REDUCE(pp,4,IF_like,0,220);
  5508. }
  5509. }
  5510.  
  5511.  
  5512.  
  5513.  
  5514.  
  5515. #endif
  5516.  
  5517. break;
  5518. case IF_like:
  5519. #if FCN_CALLS
  5520. C_IF();
  5521. #else
  5522.  
  5523. {
  5524. if(cat1==stmt
  5525. ||cat1==lbrace||cat1==if_like||cat1==for_like||cat1==do_like
  5526. ||cat1==Rdo_like
  5527. #if(0)
  5528. ||cmnt_after_IF
  5529. #endif
  5530. )
  5531. SQUASH(pp,1,if_hd,0,230);/* |if_hd| does the indenting. */
  5532. #if(0)
  5533. else if(cat1==stmt)
  5534. {/* Attach simple statement. */
  5535. b_app1(pp);b_app(040);b_app1(pp+1);
  5536. REDUCE(pp,2,IF_top,-1,231);
  5537. }
  5538. #endif
  5539. }
  5540.  
  5541.  
  5542. #endif
  5543.  
  5544. break;/* The C form serves \
  5545. both. */
  5546. case IF_top:
  5547. #if FCN_CALLS
  5548. C_IF_top();
  5549. #else
  5550.  
  5551. {
  5552. if(cat1==else_like||cat1==else_hd)
  5553. SQUASH(pp,1,IF_top,1,242);/* Expand ahead. */
  5554. else if(cat1==IF_top)
  5555. {
  5556. b_app1(pp);/* \&{if}\dots */
  5557. b_app(force);
  5558. b_app1(pp+1);/* \&{else if}\dots */
  5559. REDUCE(pp,2,IF_top,-1,238);
  5560. }
  5561. else if(cat1==ELSE_like)
  5562. {
  5563. b_app1(pp);/* \&{if} */
  5564. b_app(force);
  5565. b_app1(pp+1);/* \&{else} */
  5566. REDUCE(pp,2,stmt,-1,239);
  5567. }
  5568. else if(cat1==IF_like&&(cat2==expr||cat2==stmt))
  5569. SQUASH(pp,1,IF_top,1,241);
  5570. else
  5571. SQUASH(pp,1,stmt,-1,240);
  5572. }
  5573.  
  5574.  
  5575. #endif
  5576.  
  5577. break;
  5578. case endif_like:
  5579. #if FCN_CALLS
  5580. R_endif_like();
  5581. #else
  5582.  
  5583. {
  5584. short n;
  5585. boolean no_construct_name;
  5586.  
  5587. if((no_construct_name= BOOLEAN(cat1==semi))||(cat1==expr&&cat2==semi))
  5588. {
  5589. b_app(outdent);
  5590. b_app(force);
  5591.  
  5592. if(no_construct_name)
  5593. {
  5594. n= 2;
  5595. b_app2(pp);/* \&{endif}; or \&{enddo}; */
  5596. }
  5597. else
  5598. {/* Include \It{if-construct-name} */
  5599. n= 3;
  5600. b_app1(pp);b_app(040);b_app2(pp+1);
  5601. }
  5602.  
  5603. if(--indent_level<0)
  5604. indent_level= 0;
  5605.  
  5606. app_loop_num(loop_num[indent_level]);
  5607. REDUCE(pp,n,stmt,-2,9880);
  5608. }
  5609. }
  5610.  
  5611.  
  5612. #endif
  5613.  
  5614. break;
  5615. case end_like:
  5616. #if FCN_CALLS
  5617. R_end_like();
  5618. #else
  5619.  
  5620. if(cat1==Rdo_like||cat1==if_like)/* ``|@r end do|'' or ``|@r end if|'' */
  5621. {
  5622. b_app1(pp);/* \&{end} */
  5623. b_app(040);
  5624. b_app1(pp+1);/* \&{do} or \&{if} */
  5625. REDUCE(pp,2,endif_like,0,9860);/* Now turned into \&{enddo} or \
  5626. \&{endif} */
  5627. }
  5628. else
  5629. {
  5630. fcn_level--;
  5631. SQUASH(pp,1,END_like,-1,9861);/* \&{end} of function. */
  5632. }
  5633.  
  5634.  
  5635. #endif
  5636.  
  5637. break;
  5638. case END_like:
  5639. #if FCN_CALLS
  5640. R_END();
  5641. #else
  5642.  
  5643. {
  5644. if(cat1==program_like||cat1==struct_like)
  5645. {
  5646. b_app1(pp);b_app(040);b_app1(pp+1);
  5647.  
  5648. if(cat2==expr)
  5649. {
  5650. b_app(040);b_app1(pp+2);
  5651. REDUCE(pp,3,END_like,0,9860);
  5652. }
  5653. else
  5654. REDUCE(pp,2,END_like,0,9861);
  5655. }
  5656. else if(cat1==semi)
  5657. SQUASH(pp,2,END_stmt,-2,9862);
  5658. }
  5659.  
  5660.  
  5661. #endif
  5662.  
  5663. break;
  5664. case go_like:
  5665. #if FCN_CALLS
  5666. R_go_like();
  5667. #else
  5668.  
  5669.  
  5670. if(cat1==built_in)/* ``|@r go to|'' */
  5671. {
  5672. b_app1(pp);/* \&{go} */
  5673. b_app(040);
  5674. b_app1(pp+1);/* \&{to} */
  5675. REDUCE(pp,2,case_like,0,9850);/* \&{goto} */
  5676. }
  5677. else SQUASH(pp,1,expr,-2,9851);
  5678.  
  5679.  
  5680. #endif
  5681.  
  5682. break;
  5683. case for_like:
  5684. #if FCN_CALLS
  5685. C_for_like();
  5686. #else
  5687.  
  5688. {
  5689. if(cat1==expr)
  5690. {/* ``\&{for}\dots'' */
  5691. b_app1(pp);
  5692. {
  5693. b_app(0134);b_app(054);
  5694. }
  5695.  
  5696. ;b_app1(pp+1);
  5697. b_app(040);
  5698.  
  5699. if(cat2==semi)
  5700. {/* ``|for(;;);|'' */
  5701. if(!auto_semi||(auto_semi&&cat3==semi))
  5702. {
  5703. indent_force;
  5704. b_app1(pp+2);/* Semi on separate line. */
  5705. b_app(outdent);
  5706. REDUCE(pp,3,stmt,-2,200);/*  The $-2$ is for the \
  5707. \&{do} case. Also get here from Ratfor's \&{until}. */
  5708. }
  5709. else
  5710. REDUCE(pp,3,for_hd,0,2011);/* Eat the |auto_semi|. */
  5711. }
  5712. else
  5713. REDUCE(pp,2,for_hd,0,201);/* Eat the arguments. */
  5714. }
  5715. else if(cat1!=lpar)
  5716. SQUASH(pp,1,expr,0,2010);/* Default possiblity. */
  5717. }
  5718.  
  5719.  
  5720. #endif
  5721.  
  5722. break;
  5723. case for_hd:
  5724. #if FCN_CALLS
  5725. C_forhd();
  5726. #else
  5727.  
  5728. {
  5729. if(cat1==stmt)
  5730. {/* ``|for(;;) x;|'' */
  5731. b_app1(pp);
  5732. indent_force;
  5733. b_app1(pp+1);
  5734. b_app(outdent);
  5735. REDUCE(pp,2,stmt,-1,210);
  5736. }
  5737. }
  5738.  
  5739.  
  5740. #endif
  5741.  
  5742. break;/* C serves both. */
  5743. case else_like:
  5744. #if FCN_CALLS
  5745. R_else_like();
  5746. #else
  5747.  
  5748.  
  5749. if(is_FORTRAN_(language))
  5750. {
  5751. if(cat1==if_like)/* ``|@n else if|'' */
  5752. {
  5753. b_app1(pp);/* \&{else} */
  5754. b_app(040);
  5755. b_app1(pp+1);/* \&{if} */
  5756. REDUCE(pp,2,else_like,0,9910);/* \&{elseif} */
  5757. }
  5758. else if(cat1==semi)/* \&{else}; */
  5759. {
  5760. b_app(outdent);
  5761. b_app(force);
  5762. b_app2(pp);/* \&{else} or \&{elseif} */
  5763. app_loop_num(loop_num[indent_level-1]);
  5764. b_app(indent);
  5765. REDUCE(pp,2,stmt,-2,9911);
  5766. }
  5767. else if(cat1==expr&&cat2==built_in&&cat3==semi)/* ``|@n else if(x) \
  5768. then;|'' */
  5769. {
  5770. b_app(outdent);
  5771. b_app(force);
  5772.  
  5773. b_app1(pp);/* \&{elseif} */
  5774.  
  5775. {
  5776. b_app(0134);b_app(054);
  5777. }
  5778.  
  5779. ;
  5780. b_app1(pp+1);/* $(x)$ */
  5781. b_app(040);
  5782. b_app2(pp+2);/* \&{then}; */
  5783. app_loop_num(loop_num[indent_level-1]);
  5784.  
  5785. b_app(indent);
  5786. REDUCE(pp,4,stmt,-2,9912);
  5787. }
  5788. }
  5789. /* \Ratfor\ */
  5790. else
  5791. {
  5792. if(cat1==if_like)/* ``|else if|'' */
  5793. {
  5794. b_app1(pp);b_app(040);b_app1(pp+1);
  5795. REDUCE(pp,2,if_like,0,235);
  5796. }
  5797. else if(cat1==stmt||cat1==lbrace||cat1==for_like||cat1==do_like)
  5798. SQUASH(pp,1,else_hd,0,236);/* ``|else {}|'' */
  5799. #if 0 /* The following puts simple statement on same line. */
  5800. else if(cat1==stmt)/* ``|else z;|'' */
  5801. {
  5802. b_app1(pp);b_app(040);b_app1(pp+1);
  5803. REDUCE(pp,2,ELSE_like,-1,237);
  5804. }
  5805. #endif
  5806. }
  5807.  
  5808.  
  5809.  
  5810.  
  5811. #endif
  5812.  
  5813. break;
  5814. case else_hd:
  5815. #if FCN_CALLS
  5816. C_els_hd();
  5817. #else
  5818.  
  5819. {
  5820. if(cat1==stmt)/* ``|if(x) {}|'' */
  5821. {
  5822. b_app1(pp);/* ``|if(x)|'' */
  5823. indent_force;
  5824. b_app1(pp+1);/* ``|{}|'' */
  5825. b_app(outdent);
  5826. REDUCE(pp,2,ELSE_like,-1,241);
  5827. }
  5828. }
  5829.  
  5830.  
  5831. #endif
  5832.  
  5833. break;
  5834. case if_hd:
  5835. #if FCN_CALLS
  5836. R_if_hd();
  5837. #else
  5838.  
  5839.  
  5840. if(is_FORTRAN_(language))
  5841. {
  5842. if(cat1==stmt)
  5843. {
  5844. b_app1(pp);b_app(break_space);b_app1(pp+1);
  5845. REDUCE(pp,2,stmt,-2,9900);
  5846. }
  5847. }
  5848. else
  5849. {
  5850. if(cat1==stmt)/* ``|if(x) {}|'' */
  5851. {
  5852. b_app1(pp);/* ``|if(x)|'' */
  5853. indent_force;
  5854. b_app1(pp+1);/* ``|{}|'' */
  5855. b_app(outdent);
  5856. REDUCE(pp,2,IF_top,-1,233);
  5857. }
  5858. else if(cat1==IF_top&&cat2==else_like)
  5859. SQUASH(pp,1,if_hd,2,234);
  5860. }
  5861.  
  5862.  
  5863.  
  5864.  
  5865. #endif
  5866.  
  5867. break;
  5868. case CASE_like:
  5869. #if FCN_CALLS
  5870. R_CASE();
  5871. #else
  5872.  
  5873.  
  5874. if(is_FORTRAN_(language))
  5875. {
  5876. b_app(backup);
  5877. b_app1(pp);
  5878. REDUCE(pp,1,case_like,0,9258);
  5879. }
  5880. else SQUASH(pp,1,case_like,0,9259);
  5881.  
  5882.  
  5883. #endif
  5884.  
  5885. break;
  5886. case case_like:
  5887. #if FCN_CALLS
  5888. R_case_like();
  5889. #else
  5890.  
  5891. if(cat1==read_like)/* ``|@r call open|'' */
  5892. {
  5893. b_app1(pp);/* \&{call} */
  5894. b_app(040);
  5895. b_app1(pp+1);/* \&{close}, \&{open}, etc. */
  5896. REDUCE(pp,2,case_like,0,9260);
  5897. }
  5898. else if(cat1==semi)SQUASH(pp,2,stmt,-2,260);/* ``|@r return;|'' */
  5899. else if(cat1==colon)
  5900. {
  5901. b_app1(pp);APP_STR("\\Colon\\ ");
  5902. REDUCE(pp,2,tag,-1,261);
  5903. }
  5904.  
  5905.  
  5906. else if(cat1==expr&&cat2==semi)
  5907. {/* ``|@r return 1;|'' */
  5908. b_app1(pp);b_app(040);b_app2(pp+1);
  5909. REDUCE(pp,3,stmt,-2,262);
  5910. }
  5911. else if((cat1==expr||cat1==label)&&cat2==colon)
  5912. {/* ``|@r case 1:|'' */
  5913. b_app1(pp);b_app(040);b_app1(pp+1);
  5914. APP_STR("\\Colon\\ ");
  5915. REDUCE(pp,3,tag,-1,263);
  5916. }
  5917.  
  5918.  
  5919. #endif
  5920.  
  5921. break;
  5922. case stmt:
  5923. #if FCN_CALLS
  5924. R_stmt();
  5925. #else
  5926.  
  5927.  
  5928. if(is_FORTRAN_(language)&&cat1==program_like)SQUASH(pp,1,functn,
  5929. PLUS 1,9960);
  5930. else if(cat1==stmt)
  5931. {
  5932. b_app1(pp);
  5933. b_app(break_space);
  5934. b_app(force);
  5935.  
  5936. b_app1(pp+1);REDUCE(pp,2,stmt,-2,250);
  5937. }
  5938. else if(cat1==functn)
  5939. {
  5940. b_app1(pp);b_app(big_force);
  5941. b_app1(pp+1);
  5942. REDUCE(pp,2,stmt,-2,251);
  5943. }
  5944.  
  5945.  
  5946. #endif
  5947.  
  5948. break;
  5949. case tag:
  5950. #if FCN_CALLS
  5951. R_tag();
  5952. #else
  5953.  
  5954.  
  5955. if(cat1==tag)/* ``|@r case 1: case 2:|'' */
  5956. {
  5957. b_app1(pp);b_app(force);
  5958. b_app(backup);
  5959. b_app1(pp+1);REDUCE(pp,2,tag,-1,270);
  5960. }
  5961. else if(cat1==stmt||cat1==END_like)/* ``|@r 10 continue;|'' */
  5962. {
  5963. boolean end_of_loop;
  5964.  
  5965. end_of_loop= NO;
  5966.  
  5967. /* Unwind indent levels for labeled loops. */
  5968. while(indent_level>0&&
  5969. compare_text(pp->trans,label_text_ptr[indent_level-1]))
  5970. {
  5971. --indent_level;
  5972. b_app(outdent);
  5973. end_of_loop= YES;
  5974. }
  5975.  
  5976. if(is_FORTRAN_(language)&&Fortran_label)
  5977. {/* ``|@n EXIT: continue'' */
  5978. b_app(force);
  5979. APP_STR("\\Wlbl{");b_app1(pp);app(0175);
  5980.  
  5981. }
  5982. else
  5983. {/* Label on separate line. */
  5984. b_app(big_force);
  5985. b_app(backup);
  5986. b_app1(pp);/* Tag (Includes colon.) */
  5987. b_app(force);
  5988. }
  5989.  
  5990. b_app1(pp+1);/* Stmt. */
  5991.  
  5992. if(end_of_loop)
  5993. app_loop_num(loop_num[indent_level]);
  5994.  
  5995. REDUCE(pp,2,cat1,-2,271);
  5996. }
  5997.  
  5998.  
  5999.  
  6000. #endif
  6001.  
  6002. break;
  6003. case label:
  6004. #if FCN_CALLS
  6005. R_label();
  6006. #else
  6007.  
  6008. if(cat1==colon)
  6009. {
  6010. b_app1(pp);
  6011. REDUCE(pp,2,label,0,9270);/* Swallow the colon. (Numerical \
  6012. statement labels won't have any.) Then, for all labels, we put a colon in \
  6013. during the next block. */
  6014. }
  6015. else if(cat1==stmt||cat1==END_like)
  6016. {
  6017. b_app1(pp);APP_STR("\\Colon\\ ");
  6018.  
  6019. if(is_FORTRAN_(language)&&Fortran_label)
  6020. b_app(cancel);
  6021.  
  6022. REDUCE(pp,1,tag,0,9271);/* Convert the label into a tag. Don't \
  6023.                     swallow the statement. */
  6024. }
  6025.  
  6026.  
  6027. #endif
  6028.  
  6029. break;
  6030. case semi:
  6031. #if FCN_CALLS
  6032. R_semi();
  6033. #else
  6034.  
  6035. if(is_RATFOR_(language)&&auto_semi)
  6036. {/* Just throw away semi. */
  6037. text_pointer t;
  6038.  
  6039. t= indirect(pp->trans);
  6040.  
  6041. if(**t==073)**t= 0;
  6042. SQUASH(pp,1,ignore_scrap,-1,9280);
  6043. }
  6044. else
  6045. {
  6046. b_app(040);b_app1(pp);REDUCE(pp,1,stmt,-2,280);
  6047. }
  6048.  
  6049.  
  6050. #endif
  6051.  
  6052. break;
  6053.  
  6054. case common_like:
  6055. #if FCN_CALLS
  6056. R_common_like();
  6057. #else
  6058.  
  6059. if(cat1==expr||cat1==slashes||cat1==semi)
  6060. /* ``|@r common x| or |@r common/dia/|'' */
  6061. {
  6062. b_app1(pp);
  6063. if(cat1!=semi)b_app(040);
  6064. b_app(indent);
  6065. REDUCE(pp,1,common_hd,0,9950);
  6066. }
  6067.  
  6068.  
  6069. #endif
  6070.  
  6071. break;
  6072. case common_hd:
  6073. #if FCN_CALLS
  6074. R_cmn_hd();
  6075. #else
  6076.  
  6077.  
  6078. if(cat1==expr)SQUASH(pp,2,common_hd,0,9951);/* ``|@r common x|'' */
  6079. else if(cat1==slashes)/* ``|@r common/dia/|'' */
  6080. {
  6081. b_app1(pp);
  6082. b_app(040);
  6083. b_app1(pp+1);
  6084. b_app(040);
  6085. REDUCE(pp,2,common_hd,0,9952);
  6086. }
  6087. else if(cat1==comma)/* ``|@r common x,y|'' */
  6088. {
  6089. b_app2(pp);
  6090. b_app(040);
  6091. REDUCE(pp,2,common_hd,0,9953);
  6092. }
  6093. else if(cat1==semi)
  6094. {
  6095. b_app2(pp);
  6096. b_app(outdent);
  6097. REDUCE(pp,2,decl,-1,9954);/* ``|@r common x;|'' */
  6098. }
  6099.  
  6100.  
  6101. #endif
  6102.  
  6103. break;
  6104. case read_like:
  6105. #if FCN_CALLS
  6106. R_read_like();
  6107. #else
  6108.  
  6109.  
  6110. if(cat1==lpar&&cat2==expr&&cat3==rpar)/* |@r read(6,100)| */
  6111. {
  6112. b_app1(pp);
  6113.  
  6114. {
  6115. b_app(0134);b_app(054);
  6116. }
  6117.  
  6118. ;
  6119. b_app3(pp+1);
  6120. b_app(040);
  6121. REDUCE(pp,4,read_hd,0,9960);
  6122. }
  6123. else if(cat1==expr&&cat2==comma)/* ``|@r TYPE 100, i'' */
  6124. {
  6125. b_app1(pp);
  6126. b_app(040);
  6127. b_app2(pp+1);
  6128. b_app(040);
  6129. REDUCE(pp,3,read_hd,0,9961);
  6130. }
  6131. else if(cat1==expr||cat1==unorbinop)/* ``|@r TYPE *|'' */
  6132. {
  6133. b_app1(pp);b_app(040);b_app1(pp+1);
  6134.  
  6135. if(cat2==expr)b_app(040);/* Takes care of |"TYPE 100 i"|. */
  6136.  
  6137. REDUCE(pp,2,read_hd,0,9962);
  6138. }
  6139. else if(cat1==semi)SQUASH(pp,1,read_hd,0,9963);
  6140.  
  6141.  
  6142.  
  6143. #endif
  6144.  
  6145. break;
  6146. case read_hd:
  6147. #if FCN_CALLS
  6148. R_rd_hd();
  6149. #else
  6150.  
  6151. if(cat1==comma)/* ``|@r read(6,100),|'' */
  6152. {
  6153. b_app2(pp);
  6154. b_app(040);
  6155. REDUCE(pp,2,read_hd,0,9965);
  6156. }
  6157. else if(cat1==expr)
  6158. {
  6159. if(cat2==comma||cat2==semi)
  6160. SQUASH(pp,2,read_hd,0,9966);/* ``|@r write(6,100) i,j'' */
  6161. }
  6162. else if(cat1==semi&&cat2==read_like)/* Two I/O statements back-to-back. */
  6163. {
  6164. b_app1(pp);
  6165. b_app1(pp+1);
  6166. b_app(force);
  6167. b_app1(pp+2);
  6168. REDUCE(pp,3,read_like,0,9967);
  6169. }
  6170. else if(cat1==semi)
  6171. {
  6172. b_app1(pp);
  6173. b_app1(pp+1);
  6174. REDUCE(pp,2,stmt,-2,9968);
  6175. }
  6176.  
  6177.  
  6178. #endif
  6179.  
  6180. break;
  6181. case entry_like:
  6182. #if FCN_CALLS
  6183. R_entry_like();
  6184. #else
  6185.  
  6186. if(cat1==expr&&cat2==semi)/* ``|@r entry E(x);|'' */
  6187. {
  6188. b_app(big_force);
  6189. b_app(backup);b_app1(pp);b_app(040);b_app2(pp+1);b_app(force);
  6190. REDUCE(pp,3,stmt,-2,9990);
  6191. }
  6192. else if(cat1==(eight_bits)(language==FORTRAN_90?semi:colon))
  6193. {/* ``|@r9 contains:|'' */
  6194. b_app(big_force);
  6195. b_app(backup);b_app2(pp);b_app(force);
  6196.  
  6197. containing++;
  6198. #if(0)
  6199. b_app(indent);
  6200. #endif
  6201. REDUCE(pp,2,stmt,-2,9991);
  6202. }
  6203.  
  6204.  
  6205. #endif
  6206.  
  6207. break;
  6208. case implicit_like:
  6209. #if FCN_CALLS
  6210. R_implicit_like();
  6211. #else
  6212.  
  6213. if(cat1==int_like||cat1==expr)/* ``|@r implicit integer|'' or \
  6214.                     ``|@r implicit none|'' */
  6215. {
  6216. b_app1(pp);
  6217. b_app(040);
  6218. b_app(indent);/* Start possible long declaration. */
  6219. REDUCE(pp,1,implicit_hd,0,9970);
  6220. }
  6221. else if(cat1==semi)/* ``|@r implicit_none;|''. */
  6222. {
  6223. b_app1(pp);
  6224. b_app(indent);
  6225. REDUCE(pp,1,implicit_hd,0,99700);
  6226. }
  6227.  
  6228.  
  6229. #endif
  6230.  
  6231. break;
  6232. case implicit_hd:
  6233. #if FCN_CALLS
  6234. R_imp_hd();
  6235. #else
  6236.  
  6237. if(cat1==unorbinop&&cat2==expr)
  6238. {/* ``|@r implicit real*8|'' */
  6239. b_app1(pp);
  6240. b_app(0173);b_app2(pp+1);b_app(0175);
  6241.  
  6242. {
  6243. b_app(0134);b_app(054);
  6244. }
  6245.  
  6246. ;
  6247. REDUCE(pp,3,implicit_hd,0,9971);
  6248. }
  6249. else if(cat1==expr)SQUASH(pp,2,implicit_hd,0,9972);/* ``|@r implicit \
  6250.     integer(a-h)|'' */
  6251. else if(cat1==comma||cat1==int_like)
  6252. {
  6253. b_app2(pp);
  6254.  
  6255. if(cat2!=unorbinop)
  6256. if(cat2==int_like)b_app(040);/* ``|@r implicit real x, \
  6257. integer i|'' */
  6258. else
  6259. {
  6260. b_app(0134);b_app(054);
  6261. }
  6262.  
  6263. ;
  6264.  
  6265. REDUCE(pp,2,implicit_hd,0,9973);
  6266. }
  6267. else if(cat1==semi)SQUASH(pp,1,decl_hd,0,9974);/* ``|@r implicit \
  6268.     integer(a-h);|'' */
  6269.  
  6270.  
  6271. #endif
  6272.  
  6273. break;
  6274. case assign_like:
  6275. #if FCN_CALLS
  6276. R_assign_like();
  6277. #else
  6278.  
  6279. if(cat1==expr&&cat2==built_in&&cat3==expr)/* ``|@r assign 100 to k|'' */
  6280. {
  6281. b_app1(pp);
  6282. b_app(040);
  6283. b_app1(pp+1);
  6284. b_app(040);
  6285. b_app1(pp+2);
  6286. b_app(040);
  6287. b_app1(pp+3);
  6288. REDUCE(pp,4,expr,0,9980);
  6289. }
  6290.  
  6291.  
  6292. #endif
  6293.  
  6294. break;
  6295. case define_like:
  6296. #if FCN_CALLS
  6297. R_define_like();
  6298. #else
  6299.  
  6300. if(cat1==expr)
  6301. {
  6302. b_app(force);
  6303. b_app(backup);b_app2(pp);b_app(force);
  6304. REDUCE(pp,2,ignore_scrap,-1,9995);
  6305. }
  6306.  
  6307.  
  6308. #endif
  6309.  
  6310. break;
  6311. case built_in:
  6312. #if FCN_CALLS
  6313. R_built_in();
  6314. #else
  6315.  
  6316. {
  6317. b_app1(pp);
  6318.  
  6319. {
  6320. b_app(0134);b_app(054);
  6321. }
  6322.  
  6323. ;
  6324. REDUCE(pp,1,expr,-2,9998);
  6325. }
  6326.  
  6327.  
  6328. #endif
  6329.  
  6330. break;
  6331. case no_order:
  6332. #if FCN_CALLS
  6333. R_no_order();
  6334. #else
  6335.  
  6336. intermingle= YES;
  6337. b_app(force);
  6338. b_app1(pp);b_app(040);
  6339. REDUCE(pp,1,int_like,0,9996);
  6340.  
  6341.  
  6342.  
  6343. #endif
  6344.  
  6345. break;
  6346. case newline:
  6347. #if FCN_CALLS
  6348. R_newline();
  6349. #else
  6350.  
  6351. SQUASH(pp,1,ignore_scrap,-1,9999);
  6352.  
  6353.  
  6354. #endif
  6355.  
  6356. break;
  6357. case COMMA:
  6358. #if FCN_CALLS
  6359. C_COMMA();
  6360. #else
  6361.  
  6362. {
  6363.  
  6364.  
  6365. APP_SPACE;b_app1(pp);APP_SPACE;
  6366.  
  6367. ;
  6368. REDUCE(pp,1,comma,-1,4445);
  6369. }
  6370.  
  6371.  
  6372. #endif
  6373.  
  6374. break;
  6375.  
  6376. }
  6377. }
  6378.  
  6379.  
  6380. #if FCN_CALLS
  6381. SRTN R_expr(VOID)
  6382. {
  6383.  
  6384. {
  6385. if(cat1==unop)SQUASH(pp,2,expr,-2,2);
  6386. else if((cat1==binop||cat1==unorbinop||cat1==colon)&&cat2==expr)
  6387. /* Here we have to worry about constructions such as `|@r #:0|'. */
  6388. if(cat1==colon&&(*pp->trans)[1]==(sixteen_bits)043)
  6389. {
  6390. b_app1(pp);
  6391. APP_STR("\\Colon");
  6392. b_app1(pp+2);
  6393. REDUCE(pp,3,expr,-2,3333);
  6394. }
  6395. else SQUASH(pp,3,expr,-2,3);/* ``|@r x = y|'' or ``|@r x + y|'' or \
  6396.                 ``|@r dimension a(0:100)|'' */
  6397. else if(cat1==comma&&(cat2==expr||cat2==end_like))/* Note |end_like|; \
  6398.                     keyword in I/O. */
  6399. {
  6400. b_app2(pp);
  6401. OPT9;
  6402. b_app1(pp+2);REDUCE(pp,3,expr,-2,4);
  6403. }
  6404. else if(cat1==expr)SQUASH(pp,2,expr,-2,5);/* ``|@r f(x)|'' */
  6405. else if(cat1==semi)SQUASH(pp,2,stmt,-2,6);/* ``|@r x=y;|'' */
  6406. else if(cat1==colon&&cat2==unorbinop&&
  6407. (cat3==rpar||(active_brackets&&cat3==rbracket)))
  6408. SQUASH(pp,3,expr,-2,299);/* ``|@r 0:*|'' */
  6409. else if(cat1==colon&&cat2!=lpar)/* label */
  6410. {
  6411. make_underlined(pp);SQUASH(pp,2,tag,0,7);
  6412. }
  6413. else if(cat1==comma&&cat2==int_like)/* For macro usage. */
  6414. {
  6415. b_app2(pp);
  6416. OPT9;
  6417. b_app1(pp+2);REDUCE(pp,3,int_like,-2,4444);
  6418. }
  6419. }
  6420.  
  6421.  
  6422. }
  6423. #endif
  6424.  
  6425.  
  6426. #if FCN_CALLS
  6427. SRTN R_key_wd(VOID)
  6428. {
  6429.  
  6430. {
  6431. SQUASH(pp,1,expr,-2,4445);
  6432. }
  6433.  
  6434.  
  6435. }
  6436. #endif
  6437.  
  6438.  
  6439. #if FCN_CALLS
  6440. SRTN R_exp_op(VOID)
  6441. {
  6442.  
  6443. {
  6444. if(cat1==lpar)SQUASH(pp,1,exp_op,PLUS 1,2995);/* ``|@r x^(a+b)|'' */
  6445. else if(cat1==expr)
  6446. if(cat2==lpar)SQUASH(pp,1,exp_op,PLUS 2,2996);/* Expand array \
  6447. argument. */
  6448. else if(cat2==expr)SQUASH(pp,1,exp_op,PLUS 1,2997);/* The expr is \
  6449. the result of expanding the array argument. */
  6450. else
  6451. {/* It's now of the form |@r x^expr|; insert braces around \
  6452. argument so \TeX\ understands. */
  6453. b_app1(pp);
  6454. b_app(0173);b_app1(pp+1);b_app(0175);
  6455. REDUCE(pp,2,expr,-1,2998);
  6456. }
  6457. }
  6458.  
  6459.  
  6460. }
  6461. #endif
  6462.  
  6463.  
  6464. #if FCN_CALLS
  6465. SRTN R_program_like(VOID)
  6466. {
  6467.  
  6468.  
  6469. if(is_FORTRAN_(language))
  6470. {
  6471. if(cat1==expr&&cat2==semi)
  6472. {
  6473. fcn_level++;
  6474. b_app1(pp);b_app(040);
  6475. b_app(indent);b_app2(pp+1);b_app(outdent);
  6476. defined_at(make_underlined(pp+1));
  6477. REDUCE(pp,3,fcn_hd,-1,2999);
  6478. }
  6479. else if(cat1==no_order)
  6480. {/* |@r block data| */
  6481. b_app1(pp);b_app(040);b_app1(pp+1);
  6482. REDUCE(pp,2,program_like,0,2997);
  6483. }
  6484. else if(cat1==semi)
  6485. {/* |@r block data;| */
  6486. fcn_level++;
  6487. b_app1(pp);
  6488. REDUCE(pp,2,fcn_hd,-1,2996);
  6489. }
  6490. }
  6491. else
  6492. {
  6493. fcn_level++;
  6494. SQUASH(pp,1,int_like,-1,2998);
  6495. }
  6496.  
  6497.  
  6498. }
  6499. #endif
  6500.  
  6501.  
  6502. #if FCN_CALLS
  6503. SRTN R_fcn_hd(VOID)
  6504. {
  6505.  
  6506. {
  6507. if(cat1==END_stmt)
  6508. {
  6509. b_app1(pp);b_app(force);
  6510. b_app1(pp+1);
  6511. REDUCE(pp,2,functn,-1,7172);
  6512. }
  6513. else if(cat1==stmt&&cat2==END_stmt)
  6514. {
  6515. b_app1(pp);b_app(force);
  6516. b_app(indent);
  6517. b_app1(pp+1);/* Body */
  6518.  
  6519. if(fcn_level==0)
  6520. {
  6521. if(containing)b_app(big_force);
  6522. while(containing)
  6523. {
  6524. #if(0)
  6525. b_app(outdent);
  6526. #endif
  6527. containing--;
  6528. }
  6529. }
  6530.  
  6531. b_app(outdent);
  6532. b_app(force);
  6533.  
  6534. b_app1(pp+2);
  6535. REDUCE(pp,3,functn,-1,7171);
  6536. }
  6537. }
  6538.  
  6539.  
  6540. }
  6541. #endif
  6542.  
  6543.  
  6544. #if FCN_CALLS
  6545. SRTN R_proc_like(VOID)
  6546. {
  6547.  
  6548.  
  6549. if(fcn_level==0){/* Error message */}
  6550. else fcn_level--;
  6551.  
  6552. SQUASH(pp,1,int_like,-1,2989);
  6553.  
  6554.  
  6555. }
  6556. #endif
  6557.  
  6558.  
  6559. #if FCN_CALLS
  6560. SRTN R_private_like(VOID)
  6561. {
  6562.  
  6563. {
  6564. if(cat1==(eight_bits)(language==FORTRAN_90?semi:colon))
  6565. {
  6566. app(backup);
  6567. b_app2(pp);
  6568. REDUCE(pp,2,decl,-1,2988);
  6569. }
  6570. else SQUASH(pp,1,int_like,-2,2987);
  6571. }
  6572.  
  6573.  
  6574. }
  6575. #endif
  6576.  
  6577.  
  6578. #if FCN_CALLS
  6579. SRTN R_int_like(VOID)
  6580. {
  6581.  
  6582. {
  6583. if(cat1==lbrace)
  6584. {
  6585. b_app(indent);
  6586. b_app1(pp);
  6587. REDUCE(pp,1,decl_hd,0,940);/* ``|@r block data{}|'' */
  6588. }
  6589. else if(cat1==unorbinop&&cat2==expr)/* ``|@r character*(*)|'' */
  6590. {
  6591. b_app1(pp);
  6592. b_app(0173);b_app2(pp+1);b_app(0175);
  6593. REDUCE(pp,3,int_like,-1,941);
  6594. }
  6595. else if(cat1==int_like||cat1==no_order)/* ``|@r double precision|'' or \
  6596.         F88 things like ``|@r integer, pointer|''; |no_order| takes \
  6597.         care of \&{data} in |@r block data|. */
  6598. {
  6599. b_app1(pp);b_app(040);b_app1(pp+1);
  6600. REDUCE(pp,2,cat0,0,40);
  6601. }
  6602. else if(cat1==comma)
  6603. SQUASH(pp,2,int_like,0,9001);/* F88: ``|@r logical,|'' */
  6604. else if(cat1==binop)/* F88: ``|@r integer :: i|'' */
  6605. {
  6606. b_app2(pp);
  6607. b_app(indent);
  6608. REDUCE(pp,2,decl_hd,0,9002);
  6609. }
  6610. else if(cat1==slashes)
  6611. {
  6612. b_app1(pp);
  6613. b_app(040);
  6614. b_app(indent);
  6615. REDUCE(pp,1,decl_hd,0,9002);
  6616. }
  6617. else if(cat1==expr&&**indirect((pp+1)->trans)==050)
  6618. {
  6619. b_app1(pp);
  6620. {
  6621. b_app(0134);b_app(054);
  6622. }
  6623.  
  6624. b_app1(pp+1);
  6625. REDUCE(pp,2,int_like,0,9003);/* ``|@r integer (KIND=4)|'' */
  6626. }
  6627. else if(cat1==expr||cat1==semi)
  6628. {
  6629. b_app1(pp);
  6630.  
  6631. if(cat1!=semi)b_app(040);
  6632.  
  6633. b_app(indent);/* Start long declaration. */
  6634.  
  6635. REDUCE(pp,1,decl_hd,0,41);/* JAK: -1 changed to 0 */
  6636. }
  6637. else if(cat1==rbrace)
  6638. SQUASH(pp,1,decl,-1,411);
  6639. /* See \.{ratfor} example |@r9 module procedure element;|. */
  6640. }
  6641.  
  6642.  
  6643. }
  6644. #endif
  6645.  
  6646.  
  6647. #if FCN_CALLS
  6648. SRTN R_struct_like(VOID)
  6649. {
  6650.  
  6651. if(cat1==lpar)
  6652. {
  6653. b_app1(pp);
  6654. #if(0)
  6655.  
  6656. {
  6657. b_app(0134);b_app(054);
  6658. }
  6659.  
  6660. /* Looks nicer with a bit of space. */
  6661. #endif
  6662. REDUCE(pp,1,int_like,0,9075);/* \FORTRAN-88 declaration: \
  6663. ``|@r9 type(triangle)|''. */
  6664. }
  6665. else if(cat1==comma&&cat2==int_like)
  6666. {
  6667. b_app2(pp);b_app(040);b_app1(pp+2);
  6668. REDUCE(pp,3,struct_like,0,90750);/* ``|@r9 type, private|'' */
  6669. }
  6670. else if(cat1==binop&&**(pp+1)->trans!=(sixteen_bits)057)
  6671. SQUASH(pp,2,struct_like,0,90751);/* ``|@r9 type, public::|''  The \
  6672.         |!=| precluded the VAX |@n9 structure /stuff/| declaration. */
  6673. else if(cat1==expr||cat1==slashes||cat1==struct_like)
  6674. {/* ``|@r9 type person|'', ``|@r9 type /vaxstruct/|'', or ``|@r9 \
  6675.             interface operator|'' */
  6676. b_app1(pp);b_app(040);b_app1(pp+1);
  6677. make_underlined(pp+1);
  6678. REDUCE(pp,2,language==FORTRAN_90?struct_hd:struct_like,0,9076);
  6679. }
  6680. else if(cat1==semi)
  6681. SQUASH(pp,1,struct_hd,0,9077);/* |@r9 interface| */
  6682. else if(cat1==lbrace)/* ``|@r9 type person {integer i;};|'' */
  6683. {
  6684. b_app1(pp);indent_force;
  6685. b_app1(pp+1);REDUCE(pp,2,struct_hd,0,100);
  6686. }
  6687.  
  6688.  
  6689. }
  6690. #endif
  6691.  
  6692.  
  6693. #if FCN_CALLS
  6694. SRTN R_str_hd(VOID)
  6695. {
  6696.  
  6697. if(is_FORTRAN_(language))
  6698. {
  6699. if(cat1==expr)
  6700. {
  6701. b_app1(pp);
  6702. {
  6703. b_app(0134);b_app(054);
  6704. }
  6705.  
  6706. b_app1(pp+1);/* ``|@r9 \
  6707. interface operator(.not.)|'' */
  6708. REDUCE(pp,2,struct_hd,0,90760);
  6709. }
  6710. else if(cat1==semi)
  6711. {
  6712. fcn_level++;
  6713. b_app2(pp);
  6714. b_app(indent);
  6715. REDUCE(pp,2,struct_hd,0,90770);
  6716. }
  6717. else if(cat1==decl||cat1==functn)
  6718. {
  6719. b_app1(pp);
  6720. b_app(force);
  6721. b_app1(pp+1);
  6722. REDUCE(pp,2,struct_hd,0,9078);
  6723. }
  6724. else if(cat1==END_stmt)
  6725. {
  6726. b_app1(pp);
  6727. b_app(outdent);
  6728. b_app(force);
  6729. b_app1(pp+1);
  6730. REDUCE(pp,2,decl,-1,9079);
  6731. }
  6732. }
  6733. else
  6734. {
  6735. if((cat1==decl||cat1==stmt
  6736. ||cat1==expr /*  (For enum) */
  6737. ||cat1==functn /* \Cpp */
  6738. )&&cat2==rbrace)
  6739. {
  6740. b_app1(pp);/* ``|struct {|'' */
  6741. b_app(force);b_app1(pp+1);/* Body */
  6742. b_app(force);b_app1(pp+2);/* ``|}|'' */
  6743. b_app(outdent);
  6744. REDUCE(pp,3,int_like,-1,110);
  6745. }
  6746. else if(cat1==rbrace)
  6747. {
  6748. b_app1(pp);
  6749. {
  6750. b_app(0134);b_app(054);
  6751. }
  6752.  
  6753. b_app1(pp+1);
  6754. b_app(outdent);
  6755. REDUCE(pp,2,int_like,-1,1101);
  6756. }
  6757. }
  6758.  
  6759.  
  6760.  
  6761.  
  6762. }
  6763. #endif
  6764.  
  6765.  
  6766. #if FCN_CALLS
  6767. SRTN R_op_like(VOID)
  6768. {
  6769.  
  6770. {
  6771. short n;
  6772.  
  6773. if(cat1==lpar)
  6774. {/* We'll search for the obligatory right paren that terminates \
  6775. the list. */
  6776. scrap_pointer q;
  6777. int k;/* Counter. */
  6778.  
  6779. /* If the paren is missing, we could end up appending the entire rest of \
  6780. the code, so we limit the search. */
  6781. for(q= pp+2;q<=scrp_ptr&&q-pp<MAX_OP_TOKENS;q++)
  6782. if(q->cat==rpar)break;
  6783.  
  6784. n= (q->cat==rpar)?PTR_DIFF(short,q,pp):0;
  6785.  
  6786. if(n>0)
  6787. {
  6788. b_app1(pp);b_app(040);/* |@r9 operator| */
  6789. b_app1(pp+1);/* Left paren. */
  6790. b_app(0173);
  6791. APP_STR("\\optrue");
  6792.  
  6793. for(k= 2;k<n;k++)
  6794. b_app1(pp+k);
  6795.  
  6796. APP_STR("\\opfalse");/* We need this here in case we \
  6797. encounter an operator that \FWEAVE\ doesn't know how to overload. */
  6798. b_app(0175);
  6799. b_app1(pp+k);
  6800.  
  6801. REDUCE(pp,n+1,expr,-2,6667);
  6802. }
  6803. }
  6804. }
  6805.  
  6806.  
  6807. }
  6808. #endif
  6809.  
  6810.  
  6811. #if FCN_CALLS
  6812. SRTN R_dcl_hd(VOID)
  6813. {
  6814.  
  6815. if(cat1==comma)
  6816. {/* ``|@r integer i,j|'' */
  6817. b_app2(pp);b_app(040);REDUCE(pp,2,decl_hd,0,54);
  6818. }
  6819. else if(cat1==expr)
  6820. {
  6821. make_underlined(pp+1);
  6822.  
  6823. if(**(pp+2)->trans==(sixteen_bits)075)
  6824. {/* Initialization coming up. */
  6825. SQUASH(pp,1,decl_hd,PLUS 1,55);
  6826. }
  6827. else
  6828. {
  6829. SQUASH(pp,2,decl_hd,0,56);
  6830. }
  6831. }
  6832. else if(cat1==slashes)
  6833. {/* |@r integer i/1/| */
  6834. SQUASH(pp,2,decl_hd,0,57);
  6835. }
  6836. else if(cat1==lbrace||cat1==int_like||cat1==implicit_like)
  6837. /* |@r subroutine f {}| or |@r function f(x) real x;| or |@r \
  6838. program main implicit none;|  */
  6839. {
  6840. b_app1(pp);
  6841. b_app(outdent);/* Turn off |indent|. */
  6842. defined_at(FIRST_ID(pp));
  6843. REDUCE(pp,1,fn_decl,0,58);
  6844. }
  6845. else if(cat1==semi&&(!auto_semi||(auto_semi&&cat2!=lbrace)))
  6846. {
  6847. b_app2(pp);
  6848. b_app(outdent);/* Finish long declaration. */
  6849. REDUCE(pp,2,
  6850. (eight_bits)(intermingle?(intermingle= NO,ignore_scrap):decl),
  6851. -1,59);
  6852. }
  6853. else if(cat1==built_in)
  6854. {/* |@r9 use a, only| */
  6855. b_app1(pp);b_app(040);b_app1(pp+1);
  6856. REDUCE(pp,2,decl_hd,0,5901);
  6857. }
  6858. #if(0)
  6859. else if(cat1==lpar&&cat2==expr)make_underlined(pp+2);/* For \
  6860.                         |$decl_hd|. */
  6861. #endif
  6862.  
  6863.  
  6864. }
  6865. #endif
  6866.  
  6867.  
  6868. #if FCN_CALLS
  6869. SRTN R_decl(VOID)
  6870. {
  6871.  
  6872. if(is_FORTRAN_(language)&&cat1==END_like)SQUASH(pp,1,stmt,-1,960);
  6873. /* `` |@r program main; end;|'' */
  6874. else if(cat1==decl)
  6875. {
  6876. b_app1(pp);b_app(force);
  6877. b_app1(pp+1);
  6878. REDUCE(pp,2,decl,-1,60);
  6879. }
  6880. else if(cat1==stmt||cat1==functn)
  6881. {
  6882. b_app1(pp);b_app(big_force);
  6883. b_app1(pp+1);REDUCE(pp,2,cat1,-1,61);
  6884. }
  6885.  
  6886.  
  6887. }
  6888. #endif
  6889.  
  6890.  
  6891. #if FCN_CALLS
  6892. SRTN R_functn(VOID)
  6893. {
  6894.  
  6895.  
  6896. if(cat1==functn||(is_RATFOR_(language)&&(cat1==decl||cat1==stmt)))
  6897. {
  6898. b_app1(pp);b_app(big_force);
  6899. b_app1(pp+1);REDUCE(pp,2,cat1,0,80);
  6900. }
  6901. #if(0)
  6902. else if(cat1==END_like)
  6903. {
  6904. b_app1(pp);
  6905. REDUCE(pp,1,stmt,-1,9050);
  6906. }
  6907. #endif
  6908.  
  6909.  
  6910. }
  6911. #endif
  6912.  
  6913.  
  6914. #if FCN_CALLS
  6915. SRTN R_lpar(VOID)
  6916. {
  6917.  
  6918.  
  6919. if(cat1==expr&&cat2==rpar)SQUASH(pp,3,expr,-2,120);/* ``|@r (x)|'' */
  6920. else if(cat1==expr&&cat2==colon&&cat3==rpar)/* ``|@r (lower:)|'' */
  6921. {
  6922. b_app3(pp);
  6923. {
  6924. b_app(0134);b_app(054);
  6925. }
  6926.  
  6927. ;b_app1(pp+3);
  6928. REDUCE(pp,4,expr,-2,9120);
  6929. }
  6930. else if(cat1==colon&&cat2!=comma)/* ``|@r (:x)|''; watch out for \
  6931.             deferred-shape-spec-lists.  */
  6932. {
  6933. b_app1(pp);
  6934. {
  6935. b_app(0134);b_app(054);
  6936. }
  6937.  
  6938. ;b_app1(pp+1);
  6939. REDUCE(pp,2,lpar,0,9121);
  6940. }
  6941. else if(cat1==rpar)/* ``|@r ()|'' */
  6942. {
  6943. b_app1(pp);
  6944. {
  6945. b_app(0134);b_app(054);
  6946. }
  6947.  
  6948. ;b_app1(pp+1);
  6949. REDUCE(pp,2,expr,-2,121);
  6950. }
  6951. else if(cat1==stmt)/* `` |@r for(x;y;z)|'' */
  6952. {
  6953. b_app2(pp);b_app(040);REDUCE(pp,2,lpar,0,123);
  6954. }
  6955.  
  6956.  
  6957. }
  6958. #endif
  6959.  
  6960.  
  6961. #if FCN_CALLS
  6962. SRTN R_colon(VOID)
  6963. {
  6964.  
  6965.  
  6966. if(cat1==expr||cat1==unorbinop)SQUASH(pp,2,expr,-2,9500);/* ``|@r \
  6967. (:upper)|'' */
  6968. else if(cat1==comma&&cat2==colon)SQUASH(pp,3,expr,-2,9502);
  6969. /* Deferred-shape-spec-list: |@r (:,:)| */
  6970. else SQUASH(pp,1,expr,0,9501);/* |@r (:)| */
  6971.  
  6972.  
  6973. }
  6974. #endif
  6975.  
  6976.  
  6977. #if FCN_CALLS
  6978. SRTN R_lbrace(VOID)
  6979. {
  6980.  
  6981. if(cat1==rbrace)/* ``|@r {}|'' */
  6982. {
  6983. b_app1(pp);
  6984. {
  6985. b_app(0134);b_app(054);
  6986. }
  6987.  
  6988. ;b_app1(pp+1);
  6989. REDUCE(pp,2,stmt,-2,130);
  6990. }
  6991. else if((cat1==stmt||cat1==decl)&&cat2==rbrace)/* ``|@r {x;}|'' */
  6992. {
  6993. b_app(force);
  6994. b_app1(pp);b_app(force);
  6995. b_app1(pp+1);b_app(force);
  6996. b_app1(pp+2);
  6997. REDUCE(pp,3,stmt,-2,131);
  6998. }
  6999.  
  7000.  
  7001. }
  7002. #endif
  7003.  
  7004.  
  7005. #if FCN_CALLS
  7006. SRTN R_unop(VOID)
  7007. {
  7008.  
  7009.  
  7010. if(cat1==expr)SQUASH(pp,2,expr,-2,33);/* ``|@r !flag|'' */
  7011.  
  7012.  
  7013. }
  7014. #endif
  7015.  
  7016.  
  7017. #if FCN_CALLS
  7018. SRTN R_unorbinop(VOID)
  7019. {
  7020.  
  7021.  
  7022. if(cat1==expr)/* ``|@r +1.0|'' */
  7023. {
  7024. b_app(0173);b_app1(pp);b_app(0175);
  7025. b_app1(pp+1);
  7026. REDUCE(pp,2,expr,-2,140);
  7027. }
  7028. else if(cat1==binop)
  7029. {
  7030. b_app(math_bin);
  7031. b_app1(pp);
  7032. b_app(0173);b_app1(pp+1);b_app(0175);
  7033. b_app(0175);/* End |math_bin| */
  7034. REDUCE(pp,2,binop,-1,151);
  7035. }
  7036.  
  7037.  
  7038. else if(cat1==comma||cat1==rpar)SQUASH(pp,1,expr,-2,141);/* ``|@r \
  7039. *,|'' or ``|@r *)|'' */
  7040.  
  7041.  
  7042. }
  7043. #endif
  7044.  
  7045.  
  7046. #if FCN_CALLS
  7047. SRTN R_slash_like(VOID)
  7048. {
  7049.  
  7050. if(cat1==slash_like)
  7051. {/* The slash already has braces around it (appended by \FWEAVE).ac */
  7052. b_app1(pp);
  7053.  
  7054. {
  7055. b_app(0134);b_app(054);
  7056. }
  7057.  
  7058. ;
  7059. b_app1(pp+1);
  7060. REDUCE(pp,2,slashes,-1,1801);
  7061. }
  7062. else if(cat1==expr&&cat2==slash_like)
  7063. SQUASH(pp,3,slashes,-1,1802);
  7064.  
  7065.  
  7066. }
  7067. #endif
  7068.  
  7069.  
  7070. #if FCN_CALLS
  7071. SRTN R_binop(VOID)
  7072. {
  7073.  
  7074.  
  7075. if(cat1==binop)/* ``|@r / /|'' */
  7076. {
  7077. sixteen_bits tok;
  7078.  
  7079. tok= **pp->trans;
  7080.  
  7081. if(tok==(sixteen_bits)057&&(**(pp+1)->trans==tok))
  7082.  
  7083. {
  7084. b_app(0173);
  7085. b_app1(pp);
  7086. {
  7087. b_app(0134);b_app(054);
  7088. }
  7089.  
  7090. ;b_app1(pp+1);
  7091. b_app(0175);
  7092. REDUCE(pp,2,slashes,-1,180);
  7093. }
  7094.  
  7095.  
  7096. else
  7097. {
  7098. b_app(math_bin);b_app1(pp);
  7099. b_app(0173);b_app1(pp+1);b_app(0175);
  7100. b_app(0175);/* End |math_bin| */
  7101. REDUCE(pp,2,binop,-1,180);
  7102. }
  7103.  
  7104.  
  7105. }
  7106. else if(cat1==expr&&cat2==binop)/* ``|@r /dia/|'' */
  7107. {
  7108. sixteen_bits tok;
  7109.  
  7110. tok= **pp->trans;
  7111.  
  7112. if(tok==(sixteen_bits)057&&(**(pp+2)->trans==tok))
  7113.  
  7114. {
  7115. b_app(0173);
  7116. b_app1(pp);/* |'/'| */
  7117. b_app(0175);
  7118.  
  7119. make_underlined(pp+1);/* Index common block name. */
  7120. b_app1(pp+1);/* expr */
  7121.  
  7122. b_app(0173);
  7123. b_app1(pp+2);/* |'/'| */
  7124. b_app(0175);
  7125.  
  7126. REDUCE(pp,3,slashes,-1,9181);
  7127. }
  7128.  
  7129.  
  7130. }
  7131.  
  7132.  
  7133. }
  7134. #endif
  7135.  
  7136.  
  7137.  
  7138. text_pointer
  7139. indirect FCN((t))
  7140. text_pointer t C1("")
  7141. {
  7142. Token tok_value;
  7143.  
  7144. if(t==NULL)return t;
  7145.  
  7146. tok_value= **t;
  7147.  
  7148. if(tok_value<=tok_flag)return t;
  7149.  
  7150. if(tok_value>inner_tok_flag)tok_value-= (inner_tok_flag-tok_flag);
  7151.  
  7152. if(tok_value>tok_flag)
  7153. do
  7154. {
  7155. Token tok_value0= tok_value;
  7156.  
  7157. t= tok_start+(int)(tok_value-tok_flag);
  7158. tok_value= **t;
  7159.  
  7160. if(tok_value==tok_value0)return t;/* Emergency return; \
  7161. otherwise infinite loop. */
  7162. }
  7163. while(tok_value>tok_flag);
  7164.  
  7165. return t;
  7166. }
  7167.  
  7168.  
  7169. boolean
  7170. compare_text FCN((t0,t1))
  7171. text_pointer t0 C0("")
  7172. text_pointer t1 C1("")
  7173. {
  7174. token_pointer p0,p0_end,p1;
  7175.  
  7176. if(t0==NULL||t1==NULL)return NO;
  7177.  
  7178. t0= indirect(t0);t1= indirect(t1);
  7179.  
  7180. p0= *t0;p0_end= *(t0+1);
  7181. p1= *t1;
  7182.  
  7183. while(p0<p0_end)
  7184. {
  7185. if(*p0==072)return YES;/* Ends label */
  7186. if(*p0++!=*p1++)return NO;
  7187. }
  7188.  
  7189. return YES;
  7190. }
  7191.  
  7192.  
  7193. sixteen_bits
  7194. tok_val FCN((p))
  7195. scrap_pointer p C1("")
  7196. {
  7197. sixteen_bits tok_value;
  7198.  
  7199. tok_value= **(p->trans);
  7200.  
  7201. if(tok_value>inner_tok_flag)
  7202. tok_value-= (inner_tok_flag-tok_flag);
  7203.  
  7204. if(tok_value>tok_flag)
  7205. do
  7206. {
  7207. tok_value= **(tok_start+(int)(tok_value-tok_flag));
  7208. }
  7209. while(tok_value>tok_flag);
  7210.  
  7211. return tok_value;
  7212. }
  7213.  
  7214.  
  7215. #if FCN_CALLS
  7216. SRTN R_Rdo_like(VOID)
  7217. {
  7218.  
  7219.  
  7220. if(is_FORTRAN_(language))
  7221. {
  7222. if(cat1==for_like)/* \&{do} \&{while} */
  7223. {
  7224. b_app1(pp);b_app(040);b_app1(pp+1);
  7225. REDUCE(pp,2,Rdo_like,0,9600);
  7226. }
  7227. else if(cat1==expr&&((cat2==expr&&cat3==binop)||cat2==if_like))
  7228. /* ``|@r do 10 i='' */
  7229. {
  7230. label_text_ptr[indent_level]= (pp+1)->trans;/* Pointer to \
  7231.             a |token_pointer|---namely, index into |tok_start|. */
  7232. b_app1(pp);
  7233. b_app(040);
  7234. b_app1(pp+1);/* Loop number. */
  7235. REDUCE(pp,2,Rdo_like,0,9601);/* Swallow only the loop number. */
  7236. }
  7237. else if(cat1==stmt)/* ``|@r do i=1,10;|'' */
  7238. {
  7239. loop_num[indent_level++]= ++max_loop_num;
  7240.  
  7241. b_app1(pp);/* \&{do} */
  7242. b_app(040);
  7243. b_app1(pp+1);/* $i=1,10;$ */
  7244. app_loop_num(max_loop_num);
  7245.  
  7246. b_app(indent);
  7247. REDUCE(pp,2,stmt,-2,9602);
  7248. }
  7249. }
  7250. /* \Ratfor. */
  7251. else if(cat1==stmt||(cat1==expr&&cat2==lbrace))/* ``|@r do i=1,10;|'' \
  7252. or ``|@r do i=1,10{|'' */
  7253. {
  7254. b_app1(pp);b_app(040);b_app1(pp+1);
  7255. REDUCE(pp,2,for_hd,0,9603);
  7256. }
  7257.  
  7258.  
  7259. }
  7260. #endif
  7261.  
  7262.  
  7263. #if FCN_CALLS
  7264. SRTN R_do_like(VOID)
  7265. {
  7266.  
  7267.  
  7268. if(cat1==stmt)
  7269. {
  7270. if(cat2==until_like)
  7271. {
  7272. found_until= YES;
  7273. SQUASH(pp,1,do_like,PLUS 2,9190);/* ``|@r repeat \
  7274. {} until ;|''; expand the \&{until}. */
  7275. }
  7276. else
  7277. {
  7278. b_app1(pp);
  7279. indent_force;
  7280. b_app1(pp+1);
  7281. b_app(outdent);
  7282. b_app(force);
  7283.  
  7284. if(found_until&&cat2==stmt)/* Get here by expanding the \
  7285. \&{until}. */
  7286. {
  7287. found_until= NO;
  7288. b_app1(pp+2);REDUCE(pp,3,stmt,-2,9191);
  7289. }
  7290. else REDUCE(pp,2,stmt,-2,9192);/* ``|@r repeat {}|''; \
  7291. no bottom. */
  7292. }
  7293. }
  7294.  
  7295.  
  7296. }
  7297. #endif
  7298.  
  7299.  
  7300. #if FCN_CALLS
  7301. SRTN R_until_like(VOID)
  7302. {
  7303.  
  7304.  
  7305. SQUASH(pp,1,for_like,0,9195);
  7306.  
  7307.  
  7308. }
  7309. #endif
  7310.  
  7311.  
  7312. #if FCN_CALLS
  7313. SRTN R_if_like(VOID)
  7314. {
  7315.  
  7316.  
  7317. if(cat1==CASE_like)
  7318. {
  7319. b_app1(pp);b_app(040);b_app1(pp+1);/* |@r9 select case| */
  7320. REDUCE(pp,2,if_like,0,9196);
  7321. }
  7322. else
  7323. if(is_FORTRAN_(language))
  7324. {
  7325. if(cat1==expr)
  7326. {
  7327. boolean if_form;
  7328.  
  7329. if((if_form= BOOLEAN(cat2==built_in&&cat3==semi))||cat2==semi)
  7330. {/* ``|@n if(x) then;|''  or ``|@n where(x); |'' */
  7331. short n;/* Number to append. Things are annoying because the |@n if| \
  7332. and |@n where| statements aren't completely symmetrical. */
  7333.  
  7334. loop_num[indent_level++]= ++max_loop_num;
  7335.  
  7336. b_app1(pp);/* \&{if} */
  7337.  
  7338. {
  7339. b_app(0134);b_app(054);
  7340. }
  7341.  
  7342. ;
  7343. b_app1(pp+1);/* $(x)$ */
  7344. b_app(040);
  7345.  
  7346. if(if_form)
  7347. {
  7348. n= 4;
  7349. b_app2(pp+2);/* \&{then}; */
  7350. }
  7351. else
  7352. {/* |@n where| */
  7353. n= 3;
  7354. b_app1(pp+2);/* semi */
  7355. }
  7356.  
  7357. app_loop_num(max_loop_num);
  7358. b_app(indent);
  7359. REDUCE(pp,n,stmt,-2,9800);
  7360. }
  7361. else if(cat2==stmt)/* ``|@n if(x) a=b;|'' */
  7362. {
  7363. b_app1(pp);/* \&{if} */
  7364.  
  7365. {
  7366. b_app(0134);b_app(054);
  7367. }
  7368.  
  7369. ;
  7370. b_app1(pp+1);/* $(x)$ */
  7371. app(040);
  7372. b_app(cancel);
  7373. b_app1(pp+2);/* Statement */
  7374. REDUCE(pp,3,stmt,-2,9801);
  7375. }
  7376. else
  7377. {
  7378. b_app1(pp);
  7379.  
  7380. {
  7381. b_app(0134);b_app(054);
  7382. }
  7383.  
  7384. ;
  7385. b_app1(pp+1);
  7386. REDUCE(pp,2,if_hd,0,9802);
  7387. }
  7388. }
  7389. }
  7390. /* RATFOR\ */
  7391. else
  7392. {
  7393. if(cat1==lpar&&cat2==expr&&cat3==rpar)/* ``|if(x)|'' */
  7394. {
  7395. b_app1(pp);
  7396. {
  7397. b_app(0134);b_app(054);
  7398. }
  7399.  
  7400. ;b_app3(pp+1);
  7401. #if(0)
  7402. cmnt_after_IF= (cat4==ignore_scrap);/* Comment coming up? */
  7403. #endif
  7404. REDUCE(pp,4,IF_like,0,220);
  7405. }
  7406. }
  7407.  
  7408.  
  7409.  
  7410.  
  7411.  
  7412. }
  7413. #endif
  7414.  
  7415.  
  7416.  
  7417. SRTN
  7418. app_loop_num FCN((n))
  7419. int n C1("Loop number.")
  7420. {
  7421. char loop_id[100];
  7422.  
  7423. if(!block_nums)return;/* We're not supposed to number the blocks/loops. */
  7424.  
  7425. sprintf(loop_id,"\\Wblock{%d}",n);/* Output the block number. */
  7426.  
  7427. APP_STR(loop_id);
  7428. }
  7429.  
  7430.  
  7431. #if FCN_CALLS
  7432. SRTN R_go_like(VOID)
  7433. {
  7434.  
  7435.  
  7436. if(cat1==built_in)/* ``|@r go to|'' */
  7437. {
  7438. b_app1(pp);/* \&{go} */
  7439. b_app(040);
  7440. b_app1(pp+1);/* \&{to} */
  7441. REDUCE(pp,2,case_like,0,9850);/* \&{goto} */
  7442. }
  7443. else SQUASH(pp,1,expr,-2,9851);
  7444.  
  7445.  
  7446. }
  7447. #endif
  7448.  
  7449.  
  7450. #if FCN_CALLS
  7451. SRTN R_end_like(VOID)
  7452. {
  7453.  
  7454. if(cat1==Rdo_like||cat1==if_like)/* ``|@r end do|'' or ``|@r end if|'' */
  7455. {
  7456. b_app1(pp);/* \&{end} */
  7457. b_app(040);
  7458. b_app1(pp+1);/* \&{do} or \&{if} */
  7459. REDUCE(pp,2,endif_like,0,9860);/* Now turned into \&{enddo} or \
  7460. \&{endif} */
  7461. }
  7462. else
  7463. {
  7464. fcn_level--;
  7465. SQUASH(pp,1,END_like,-1,9861);/* \&{end} of function. */
  7466. }
  7467.  
  7468.  
  7469. }
  7470. #endif
  7471.  
  7472.  
  7473. #if FCN_CALLS
  7474. SRTN R_END(VOID)
  7475. {
  7476.  
  7477. {
  7478. if(cat1==program_like||cat1==struct_like)
  7479. {
  7480. b_app1(pp);b_app(040);b_app1(pp+1);
  7481.  
  7482. if(cat2==expr)
  7483. {
  7484. b_app(040);b_app1(pp+2);
  7485. REDUCE(pp,3,END_like,0,9860);
  7486. }
  7487. else
  7488. REDUCE(pp,2,END_like,0,9861);
  7489. }
  7490. else if(cat1==semi)
  7491. SQUASH(pp,2,END_stmt,-2,9862);
  7492. }
  7493.  
  7494.  
  7495. }
  7496. #endif
  7497.  
  7498.  
  7499. #if FCN_CALLS
  7500. SRTN R_endif_like(VOID)
  7501. {
  7502.  
  7503. {
  7504. short n;
  7505. boolean no_construct_name;
  7506.  
  7507. if((no_construct_name= BOOLEAN(cat1==semi))||(cat1==expr&&cat2==semi))
  7508. {
  7509. b_app(outdent);
  7510. b_app(force);
  7511.  
  7512. if(no_construct_name)
  7513. {
  7514. n= 2;
  7515. b_app2(pp);/* \&{endif}; or \&{enddo}; */
  7516. }
  7517. else
  7518. {/* Include \It{if-construct-name} */
  7519. n= 3;
  7520. b_app1(pp);b_app(040);b_app2(pp+1);
  7521. }
  7522.  
  7523. if(--indent_level<0)
  7524. indent_level= 0;
  7525.  
  7526. app_loop_num(loop_num[indent_level]);
  7527. REDUCE(pp,n,stmt,-2,9880);
  7528. }
  7529. }
  7530.  
  7531.  
  7532. }
  7533. #endif
  7534.  
  7535.  
  7536. #if FCN_CALLS
  7537. SRTN R_if_hd(VOID)
  7538. {
  7539.  
  7540.  
  7541. if(is_FORTRAN_(language))
  7542. {
  7543. if(cat1==stmt)
  7544. {
  7545. b_app1(pp);b_app(break_space);b_app1(pp+1);
  7546. REDUCE(pp,2,stmt,-2,9900);
  7547. }
  7548. }
  7549. else
  7550. {
  7551. if(cat1==stmt)/* ``|if(x) {}|'' */
  7552. {
  7553. b_app1(pp);/* ``|if(x)|'' */
  7554. indent_force;
  7555. b_app1(pp+1);/* ``|{}|'' */
  7556. b_app(outdent);
  7557. REDUCE(pp,2,IF_top,-1,233);
  7558. }
  7559. else if(cat1==IF_top&&cat2==else_like)
  7560. SQUASH(pp,1,if_hd,2,234);
  7561. }
  7562.  
  7563.  
  7564.  
  7565.  
  7566. }
  7567. #endif
  7568.  
  7569.  
  7570. #if FCN_CALLS
  7571. SRTN R_else_like(VOID)
  7572. {
  7573.  
  7574.  
  7575. if(is_FORTRAN_(language))
  7576. {
  7577. if(cat1==if_like)/* ``|@n else if|'' */
  7578. {
  7579. b_app1(pp);/* \&{else} */
  7580. b_app(040);
  7581. b_app1(pp+1);/* \&{if} */
  7582. REDUCE(pp,2,else_like,0,9910);/* \&{elseif} */
  7583. }
  7584. else if(cat1==semi)/* \&{else}; */
  7585. {
  7586. b_app(outdent);
  7587. b_app(force);
  7588. b_app2(pp);/* \&{else} or \&{elseif} */
  7589. app_loop_num(loop_num[indent_level-1]);
  7590. b_app(indent);
  7591. REDUCE(pp,2,stmt,-2,9911);
  7592. }
  7593. else if(cat1==expr&&cat2==built_in&&cat3==semi)/* ``|@n else if(x) \
  7594. then;|'' */
  7595. {
  7596. b_app(outdent);
  7597. b_app(force);
  7598.  
  7599. b_app1(pp);/* \&{elseif} */
  7600.  
  7601. {
  7602. b_app(0134);b_app(054);
  7603. }
  7604.  
  7605. ;
  7606. b_app1(pp+1);/* $(x)$ */
  7607. b_app(040);
  7608. b_app2(pp+2);/* \&{then}; */
  7609. app_loop_num(loop_num[indent_level-1]);
  7610.  
  7611. b_app(indent);
  7612. REDUCE(pp,4,stmt,-2,9912);
  7613. }
  7614. }
  7615. /* \Ratfor\ */
  7616. else
  7617. {
  7618. if(cat1==if_like)/* ``|else if|'' */
  7619. {
  7620. b_app1(pp);b_app(040);b_app1(pp+1);
  7621. REDUCE(pp,2,if_like,0,235);
  7622. }
  7623. else if(cat1==stmt||cat1==lbrace||cat1==for_like||cat1==do_like)
  7624. SQUASH(pp,1,else_hd,0,236);/* ``|else {}|'' */
  7625. #if 0 /* The following puts simple statement on same line. */
  7626. else if(cat1==stmt)/* ``|else z;|'' */
  7627. {
  7628. b_app1(pp);b_app(040);b_app1(pp+1);
  7629. REDUCE(pp,2,ELSE_like,-1,237);
  7630. }
  7631. #endif
  7632. }
  7633.  
  7634.  
  7635.  
  7636.  
  7637. }
  7638. #endif
  7639.  
  7640.  
  7641. #if FCN_CALLS
  7642. SRTN R_stmt(VOID)
  7643. {
  7644.  
  7645.  
  7646. if(is_FORTRAN_(language)&&cat1==program_like)SQUASH(pp,1,functn,
  7647. PLUS 1,9960);
  7648. else if(cat1==stmt)
  7649. {
  7650. b_app1(pp);
  7651. b_app(break_space);
  7652. b_app(force);
  7653.  
  7654. b_app1(pp+1);REDUCE(pp,2,stmt,-2,250);
  7655. }
  7656. else if(cat1==functn)
  7657. {
  7658. b_app1(pp);b_app(big_force);
  7659. b_app1(pp+1);
  7660. REDUCE(pp,2,stmt,-2,251);
  7661. }
  7662.  
  7663.  
  7664. }
  7665. #endif
  7666.  
  7667.  
  7668. #if FCN_CALLS
  7669. SRTN R_CASE(VOID)
  7670. {
  7671.  
  7672.  
  7673. if(is_FORTRAN_(language))
  7674. {
  7675. b_app(backup);
  7676. b_app1(pp);
  7677. REDUCE(pp,1,case_like,0,9258);
  7678. }
  7679. else SQUASH(pp,1,case_like,0,9259);
  7680.  
  7681.  
  7682. }
  7683. #endif
  7684.  
  7685.  
  7686. #if FCN_CALLS
  7687. SRTN R_case_like(VOID)
  7688. {
  7689.  
  7690. if(cat1==read_like)/* ``|@r call open|'' */
  7691. {
  7692. b_app1(pp);/* \&{call} */
  7693. b_app(040);
  7694. b_app1(pp+1);/* \&{close}, \&{open}, etc. */
  7695. REDUCE(pp,2,case_like,0,9260);
  7696. }
  7697. else if(cat1==semi)SQUASH(pp,2,stmt,-2,260);/* ``|@r return;|'' */
  7698. else if(cat1==colon)
  7699. {
  7700. b_app1(pp);APP_STR("\\Colon\\ ");
  7701. REDUCE(pp,2,tag,-1,261);
  7702. }
  7703.  
  7704.  
  7705. else if(cat1==expr&&cat2==semi)
  7706. {/* ``|@r return 1;|'' */
  7707. b_app1(pp);b_app(040);b_app2(pp+1);
  7708. REDUCE(pp,3,stmt,-2,262);
  7709. }
  7710. else if((cat1==expr||cat1==label)&&cat2==colon)
  7711. {/* ``|@r case 1:|'' */
  7712. b_app1(pp);b_app(040);b_app1(pp+1);
  7713. APP_STR("\\Colon\\ ");
  7714. REDUCE(pp,3,tag,-1,263);
  7715. }
  7716.  
  7717.  
  7718. }
  7719. #endif
  7720.  
  7721.  
  7722. #if FCN_CALLS
  7723. SRTN R_tag(VOID)
  7724. {
  7725.  
  7726.  
  7727. if(cat1==tag)/* ``|@r case 1: case 2:|'' */
  7728. {
  7729. b_app1(pp);b_app(force);
  7730. b_app(backup);
  7731. b_app1(pp+1);REDUCE(pp,2,tag,-1,270);
  7732. }
  7733. else if(cat1==stmt||cat1==END_like)/* ``|@r 10 continue;|'' */
  7734. {
  7735. boolean end_of_loop;
  7736.  
  7737. end_of_loop= NO;
  7738.  
  7739. /* Unwind indent levels for labeled loops. */
  7740. while(indent_level>0&&
  7741. compare_text(pp->trans,label_text_ptr[indent_level-1]))
  7742. {
  7743. --indent_level;
  7744. b_app(outdent);
  7745. end_of_loop= YES;
  7746. }
  7747.  
  7748. if(is_FORTRAN_(language)&&Fortran_label)
  7749. {/* ``|@n EXIT: continue'' */
  7750. b_app(force);
  7751. APP_STR("\\Wlbl{");b_app1(pp);app(0175);
  7752.  
  7753. }
  7754. else
  7755. {/* Label on separate line. */
  7756. b_app(big_force);
  7757. b_app(backup);
  7758. b_app1(pp);/* Tag (Includes colon.) */
  7759. b_app(force);
  7760. }
  7761.  
  7762. b_app1(pp+1);/* Stmt. */
  7763.  
  7764. if(end_of_loop)
  7765. app_loop_num(loop_num[indent_level]);
  7766.  
  7767. REDUCE(pp,2,cat1,-2,271);
  7768. }
  7769.  
  7770.  
  7771.  
  7772. }
  7773. #endif
  7774.  
  7775.  
  7776. #if FCN_CALLS
  7777. SRTN R_label(VOID)
  7778. {
  7779.  
  7780. if(cat1==colon)
  7781. {
  7782. b_app1(pp);
  7783. REDUCE(pp,2,label,0,9270);/* Swallow the colon. (Numerical \
  7784. statement labels won't have any.) Then, for all labels, we put a colon in \
  7785. during the next block. */
  7786. }
  7787. else if(cat1==stmt||cat1==END_like)
  7788. {
  7789. b_app1(pp);APP_STR("\\Colon\\ ");
  7790.  
  7791. if(is_FORTRAN_(language)&&Fortran_label)
  7792. b_app(cancel);
  7793.  
  7794. REDUCE(pp,1,tag,0,9271);/* Convert the label into a tag. Don't \
  7795.                     swallow the statement. */
  7796. }
  7797.  
  7798.  
  7799. }
  7800. #endif
  7801.  
  7802.  
  7803. #if FCN_CALLS
  7804. SRTN R_semi(VOID)
  7805. {
  7806.  
  7807. if(is_RATFOR_(language)&&auto_semi)
  7808. {/* Just throw away semi. */
  7809. text_pointer t;
  7810.  
  7811. t= indirect(pp->trans);
  7812.  
  7813. if(**t==073)**t= 0;
  7814. SQUASH(pp,1,ignore_scrap,-1,9280);
  7815. }
  7816. else
  7817. {
  7818. b_app(040);b_app1(pp);REDUCE(pp,1,stmt,-2,280);
  7819. }
  7820.  
  7821.  
  7822. }
  7823. #endif
  7824.  
  7825.  
  7826. #if FCN_CALLS
  7827. SRTN R_common_like(VOID)
  7828. {
  7829.  
  7830. if(cat1==expr||cat1==slashes||cat1==semi)
  7831. /* ``|@r common x| or |@r common/dia/|'' */
  7832. {
  7833. b_app1(pp);
  7834. if(cat1!=semi)b_app(040);
  7835. b_app(indent);
  7836. REDUCE(pp,1,common_hd,0,9950);
  7837. }
  7838.  
  7839.  
  7840. }
  7841. #endif
  7842.  
  7843.  
  7844. #if FCN_CALLS
  7845. SRTN R_cmn_hd(VOID)
  7846. {
  7847.  
  7848.  
  7849. if(cat1==expr)SQUASH(pp,2,common_hd,0,9951);/* ``|@r common x|'' */
  7850. else if(cat1==slashes)/* ``|@r common/dia/|'' */
  7851. {
  7852. b_app1(pp);
  7853. b_app(040);
  7854. b_app1(pp+1);
  7855. b_app(040);
  7856. REDUCE(pp,2,common_hd,0,9952);
  7857. }
  7858. else if(cat1==comma)/* ``|@r common x,y|'' */
  7859. {
  7860. b_app2(pp);
  7861. b_app(040);
  7862. REDUCE(pp,2,common_hd,0,9953);
  7863. }
  7864. else if(cat1==semi)
  7865. {
  7866. b_app2(pp);
  7867. b_app(outdent);
  7868. REDUCE(pp,2,decl,-1,9954);/* ``|@r common x;|'' */
  7869. }
  7870.  
  7871.  
  7872. }
  7873. #endif
  7874.  
  7875.  
  7876. #if FCN_CALLS
  7877. SRTN R_read_like(VOID)
  7878. {
  7879.  
  7880.  
  7881. if(cat1==lpar&&cat2==expr&&cat3==rpar)/* |@r read(6,100)| */
  7882. {
  7883. b_app1(pp);
  7884.  
  7885. {
  7886. b_app(0134);b_app(054);
  7887. }
  7888.  
  7889. ;
  7890. b_app3(pp+1);
  7891. b_app(040);
  7892. REDUCE(pp,4,read_hd,0,9960);
  7893. }
  7894. else if(cat1==expr&&cat2==comma)/* ``|@r TYPE 100, i'' */
  7895. {
  7896. b_app1(pp);
  7897. b_app(040);
  7898. b_app2(pp+1);
  7899. b_app(040);
  7900. REDUCE(pp,3,read_hd,0,9961);
  7901. }
  7902. else if(cat1==expr||cat1==unorbinop)/* ``|@r TYPE *|'' */
  7903. {
  7904. b_app1(pp);b_app(040);b_app1(pp+1);
  7905.  
  7906. if(cat2==expr)b_app(040);/* Takes care of |"TYPE 100 i"|. */
  7907.  
  7908. REDUCE(pp,2,read_hd,0,9962);
  7909. }
  7910. else if(cat1==semi)SQUASH(pp,1,read_hd,0,9963);
  7911.  
  7912.  
  7913.  
  7914. }
  7915. #endif
  7916.  
  7917.  
  7918. #if FCN_CALLS
  7919. SRTN R_rd_hd(VOID)
  7920. {
  7921.  
  7922. if(cat1==comma)/* ``|@r read(6,100),|'' */
  7923. {
  7924. b_app2(pp);
  7925. b_app(040);
  7926. REDUCE(pp,2,read_hd,0,9965);
  7927. }
  7928. else if(cat1==expr)
  7929. {
  7930. if(cat2==comma||cat2==semi)
  7931. SQUASH(pp,2,read_hd,0,9966);/* ``|@r write(6,100) i,j'' */
  7932. }
  7933. else if(cat1==semi&&cat2==read_like)/* Two I/O statements back-to-back. */
  7934. {
  7935. b_app1(pp);
  7936. b_app1(pp+1);
  7937. b_app(force);
  7938. b_app1(pp+2);
  7939. REDUCE(pp,3,read_like,0,9967);
  7940. }
  7941. else if(cat1==semi)
  7942. {
  7943. b_app1(pp);
  7944. b_app1(pp+1);
  7945. REDUCE(pp,2,stmt,-2,9968);
  7946. }
  7947.  
  7948.  
  7949. }
  7950. #endif
  7951.  
  7952.  
  7953. #if FCN_CALLS
  7954. SRTN R_implicit_like(VOID)
  7955. {
  7956.  
  7957. if(cat1==int_like||cat1==expr)/* ``|@r implicit integer|'' or \
  7958.                     ``|@r implicit none|'' */
  7959. {
  7960. b_app1(pp);
  7961. b_app(040);
  7962. b_app(indent);/* Start possible long declaration. */
  7963. REDUCE(pp,1,implicit_hd,0,9970);
  7964. }
  7965. else if(cat1==semi)/* ``|@r implicit_none;|''. */
  7966. {
  7967. b_app1(pp);
  7968. b_app(indent);
  7969. REDUCE(pp,1,implicit_hd,0,99700);
  7970. }
  7971.  
  7972.  
  7973. }
  7974. #endif
  7975.  
  7976.  
  7977. #if FCN_CALLS
  7978. SRTN R_imp_hd(VOID)
  7979. {
  7980.  
  7981. if(cat1==unorbinop&&cat2==expr)
  7982. {/* ``|@r implicit real*8|'' */
  7983. b_app1(pp);
  7984. b_app(0173);b_app2(pp+1);b_app(0175);
  7985.  
  7986. {
  7987. b_app(0134);b_app(054);
  7988. }
  7989.  
  7990. ;
  7991. REDUCE(pp,3,implicit_hd,0,9971);
  7992. }
  7993. else if(cat1==expr)SQUASH(pp,2,implicit_hd,0,9972);/* ``|@r implicit \
  7994.     integer(a-h)|'' */
  7995. else if(cat1==comma||cat1==int_like)
  7996. {
  7997. b_app2(pp);
  7998.  
  7999. if(cat2!=unorbinop)
  8000. if(cat2==int_like)b_app(040);/* ``|@r implicit real x, \
  8001. integer i|'' */
  8002. else
  8003. {
  8004. b_app(0134);b_app(054);
  8005. }
  8006.  
  8007. ;
  8008.  
  8009. REDUCE(pp,2,implicit_hd,0,9973);
  8010. }
  8011. else if(cat1==semi)SQUASH(pp,1,decl_hd,0,9974);/* ``|@r implicit \
  8012.     integer(a-h);|'' */
  8013.  
  8014.  
  8015. }
  8016. #endif
  8017.  
  8018.  
  8019. #if FCN_CALLS
  8020. SRTN R_assign_like(VOID)
  8021. {
  8022.  
  8023. if(cat1==expr&&cat2==built_in&&cat3==expr)/* ``|@r assign 100 to k|'' */
  8024. {
  8025. b_app1(pp);
  8026. b_app(040);
  8027. b_app1(pp+1);
  8028. b_app(040);
  8029. b_app1(pp+2);
  8030. b_app(040);
  8031. b_app1(pp+3);
  8032. REDUCE(pp,4,expr,0,9980);
  8033. }
  8034.  
  8035.  
  8036. }
  8037. #endif
  8038.  
  8039.  
  8040. #if FCN_CALLS
  8041. SRTN R_entry_like(VOID)
  8042. {
  8043.  
  8044. if(cat1==expr&&cat2==semi)/* ``|@r entry E(x);|'' */
  8045. {
  8046. b_app(big_force);
  8047. b_app(backup);b_app1(pp);b_app(040);b_app2(pp+1);b_app(force);
  8048. REDUCE(pp,3,stmt,-2,9990);
  8049. }
  8050. else if(cat1==(eight_bits)(language==FORTRAN_90?semi:colon))
  8051. {/* ``|@r9 contains:|'' */
  8052. b_app(big_force);
  8053. b_app(backup);b_app2(pp);b_app(force);
  8054.  
  8055. containing++;
  8056. #if(0)
  8057. b_app(indent);
  8058. #endif
  8059. REDUCE(pp,2,stmt,-2,9991);
  8060. }
  8061.  
  8062.  
  8063. }
  8064. #endif
  8065.  
  8066.  
  8067. #if FCN_CALLS
  8068. SRTN R_define_like(VOID)
  8069. {
  8070.  
  8071. if(cat1==expr)
  8072. {
  8073. b_app(force);
  8074. b_app(backup);b_app2(pp);b_app(force);
  8075. REDUCE(pp,2,ignore_scrap,-1,9995);
  8076. }
  8077.  
  8078.  
  8079. }
  8080. #endif
  8081.  
  8082.  
  8083. #if FCN_CALLS
  8084. SRTN R_no_order(VOID)
  8085. {
  8086.  
  8087. intermingle= YES;
  8088. b_app(force);
  8089. b_app1(pp);b_app(040);
  8090. REDUCE(pp,1,int_like,0,9996);
  8091.  
  8092.  
  8093.  
  8094. }
  8095. #endif
  8096.  
  8097.  
  8098. #if FCN_CALLS
  8099. SRTN R_built_in(VOID)
  8100. {
  8101.  
  8102. {
  8103. b_app1(pp);
  8104.  
  8105. {
  8106. b_app(0134);b_app(054);
  8107. }
  8108.  
  8109. ;
  8110. REDUCE(pp,1,expr,-2,9998);
  8111. }
  8112.  
  8113.  
  8114. }
  8115. #endif
  8116.  
  8117.  
  8118. #if FCN_CALLS
  8119. SRTN R_newline(VOID)
  8120. {
  8121.  
  8122. SQUASH(pp,1,ignore_scrap,-1,9999);
  8123.  
  8124.  
  8125. }
  8126. #endif
  8127.  
  8128.  
  8129. SRTN
  8130. V_productions(VOID)
  8131. {
  8132. switch(pp->cat)
  8133. {
  8134. case expr:
  8135.  
  8136. break;
  8137. case stmt:
  8138.  
  8139. break;
  8140. }
  8141. }
  8142.  
  8143.  
  8144. SRTN
  8145. X_productions(VOID)
  8146. {
  8147. switch(pp->cat)
  8148. {
  8149. case expr:
  8150. {
  8151. if(cat1==expr)SQUASH(pp,2,expr,0,5);
  8152. else if(cat1==semi)
  8153. {
  8154. b_app1(pp);
  8155. REDUCE(pp,2,stmt,-1,6);
  8156. }
  8157. }
  8158.  
  8159. break;
  8160. case stmt:
  8161. {
  8162. if(cat1==stmt)
  8163. {
  8164. b_app1(pp);
  8165. b_app(force);
  8166. b_app1(pp+1);
  8167. REDUCE(pp,2,stmt,-1,250);
  8168. }
  8169. }
  8170.  
  8171. break;
  8172. }
  8173. }
  8174.  
  8175.  
  8176. SRTN
  8177. reduce FCN((j,k,c,d,n))
  8178. scrap_pointer j C0("")
  8179. short k C0("Number of items to be reduced.")
  8180. eight_bits c C0("Reduce to this type.")
  8181. short d C0("Move by this amount.")
  8182. RULE_NO n C1("Rule number.")
  8183. {
  8184. scrap_pointer i,i1;/* Pointers into scrap memory */
  8185.  
  8186. /* Store the translation. */
  8187. j->cat= c;j->trans= text_ptr;
  8188. j->mathness= (eight_bits)(4*last_mathness+ini_mathness);
  8189. freeze_text;
  8190.  
  8191. /* More stuff to the left, overwriting the $k$~items that have been \
  8192. reduced. */
  8193. if(k>1)
  8194. {
  8195. for(i= j+k,i1= j+1;i<=lo_ptr;i++,i1++)
  8196. {
  8197. i1->cat= i->cat;i1->trans= i->trans;
  8198. i1->mathness= i->mathness;
  8199. }
  8200.  
  8201. lo_ptr= lo_ptr-k+1;
  8202. }
  8203.  
  8204.  
  8205.  
  8206. if(pp+d>=scrp_base)pp= pp+d;
  8207. else pp= scrp_base;
  8208.  
  8209. ;
  8210.  
  8211. #ifdef DEBUG
  8212.  
  8213. {
  8214. scrap_pointer k;/* pointer into |scrap_info| */
  8215.  
  8216.  
  8217.  
  8218. {
  8219. static RULE_NO last_rule= ULONG_MAX;
  8220. static int ncycles= 0;
  8221.  
  8222. if(n&&n==last_rule)
  8223. {
  8224. if(ncycles++>MAX_CYCLES)
  8225. {
  8226. outer_char temp[MAX_CYCLES];
  8227.  
  8228.  
  8229. if(
  8230. nsprintf(temp,OC("Infinite production loop, rule %lu"),1,n)>=(int)(MAX_CYCLES))OVERFLW("temp","");
  8231. CONFUSION("reduce",temp);
  8232. }
  8233. }
  8234. else
  8235. {
  8236. last_rule= n;
  8237. ncycles= 0;
  8238. }
  8239. }
  8240.  
  8241.  
  8242.  
  8243. if(tracing==2)
  8244. {
  8245. printf("%5lu",n);/* The rule number. */
  8246.  
  8247. if(in_prototype)
  8248. printf(".%i",in_prototype);
  8249.  
  8250. printf(": ");
  8251.  
  8252. for(k= scrp_base;k<=lo_ptr;k++)
  8253. {
  8254. if(k==pp)putxchar('*');else putxchar(' ');
  8255.  
  8256. if(k->mathness%4==yes_math)putxchar('+');
  8257. else if(k->mathness%4==no_math)putxchar('-');
  8258.  
  8259. prn_cat(k->cat);
  8260.  
  8261. if(k->mathness/4==yes_math)putxchar('+');
  8262. else if(k->mathness/4==no_math)putxchar('-');
  8263. }
  8264.  
  8265. if(hi_ptr<=scrp_ptr)printf("...");/* indicate that more is \
  8266.             coming */
  8267.  
  8268.  
  8269. {
  8270. printf(" ==\"");
  8271. if(lo_ptr>scrp_base)
  8272. {/* The second-to-last scrap. */
  8273. prn_text(indirect((lo_ptr-1)->trans));
  8274. printf("\" \"");
  8275. }
  8276. prn_text(indirect(lo_ptr->trans));/* Last scrap. */
  8277. puts("\"");
  8278. }
  8279.  
  8280.  
  8281.  
  8282. }
  8283. }
  8284.  
  8285. ;
  8286. #endif /* |DEBUG| */
  8287.  
  8288. pp--;/* we next say |pp++| */
  8289. }
  8290.  
  8291.  
  8292. SRTN
  8293. squash FCN((j,k,c,d,n))
  8294. scrap_pointer j C0("")
  8295. short k C0("Number to be squashed.")
  8296. eight_bits c C0("Make it this type.")
  8297. short d C0("Move by this amount.")
  8298. RULE_NO n C1("Rule number.")
  8299. {
  8300. scrap_pointer i;/* pointers into scrap memory */
  8301.  
  8302. if(k==1)
  8303. {
  8304. j->cat= c;
  8305.  
  8306. if(pp+d>=scrp_base)pp= pp+d;
  8307. else pp= scrp_base;
  8308.  
  8309. ;
  8310.  
  8311. #ifdef DEBUG
  8312.  
  8313. {
  8314. scrap_pointer k;/* pointer into |scrap_info| */
  8315.  
  8316.  
  8317.  
  8318. {
  8319. static RULE_NO last_rule= ULONG_MAX;
  8320. static int ncycles= 0;
  8321.  
  8322. if(n&&n==last_rule)
  8323. {
  8324. if(ncycles++>MAX_CYCLES)
  8325. {
  8326. outer_char temp[MAX_CYCLES];
  8327.  
  8328.  
  8329. if(
  8330. nsprintf(temp,OC("Infinite production loop, rule %lu"),1,n)>=(int)(MAX_CYCLES))OVERFLW("temp","");
  8331. CONFUSION("reduce",temp);
  8332. }
  8333. }
  8334. else
  8335. {
  8336. last_rule= n;
  8337. ncycles= 0;
  8338. }
  8339. }
  8340.  
  8341.  
  8342.  
  8343. if(tracing==2)
  8344. {
  8345. printf("%5lu",n);/* The rule number. */
  8346.  
  8347. if(in_prototype)
  8348. printf(".%i",in_prototype);
  8349.  
  8350. printf(": ");
  8351.  
  8352. for(k= scrp_base;k<=lo_ptr;k++)
  8353. {
  8354. if(k==pp)putxchar('*');else putxchar(' ');
  8355.  
  8356. if(k->mathness%4==yes_math)putxchar('+');
  8357. else if(k->mathness%4==no_math)putxchar('-');
  8358.  
  8359. prn_cat(k->cat);
  8360.  
  8361. if(k->mathness/4==yes_math)putxchar('+');
  8362. else if(k->mathness/4==no_math)putxchar('-');
  8363. }
  8364.  
  8365. if(hi_ptr<=scrp_ptr)printf("...");/* indicate that more is \
  8366.             coming */
  8367.  
  8368.  
  8369. {
  8370. printf(" ==\"");
  8371. if(lo_ptr>scrp_base)
  8372. {/* The second-to-last scrap. */
  8373. prn_text(indirect((lo_ptr-1)->trans));
  8374. printf("\" \"");
  8375. }
  8376. prn_text(indirect(lo_ptr->trans));/* Last scrap. */
  8377. puts("\"");
  8378. }
  8379.  
  8380.  
  8381.  
  8382. }
  8383. }
  8384.  
  8385. ;
  8386. #endif /* |DEBUG| */
  8387.  
  8388. pp--;/* we next say |pp++| */
  8389. return;
  8390. }
  8391.  
  8392. for(i= j;i<j+k;i++)b_app1(i);
  8393.  
  8394. reduce(j,k,c,d,n);
  8395. }
  8396.  
  8397.  
  8398. text_pointer
  8399. translate FCN((mode0))
  8400. PARSING_MODE mode0 C1("")
  8401. {
  8402. LANGUAGE saved_language= language;
  8403. scrap_pointer i,/* index into |cat| */
  8404. j;/* runs through final scraps */
  8405.  
  8406. translate_mode= mode0;
  8407.  
  8408. pp= scrp_base;lo_ptr= pp-1;hi_ptr= pp;
  8409.  
  8410.  
  8411. #ifdef DEBUG
  8412. if(tracing==2)
  8413. {
  8414. CLR_PRINTF(warning,
  8415. ("\nTracing after l. %u (language = %s):  ",
  8416. cur_line,languages[lan_num(language)]));
  8417. mark_harmless;
  8418.  
  8419. if(loc>=cur_buffer+OUT_WIDTH)
  8420. {
  8421. printf("...");
  8422. ASCII_write(loc-OUT_WIDTH,OUT_WIDTH);
  8423. }
  8424. else ASCII_write(cur_buffer,loc-cur_buffer);
  8425.  
  8426. puts("");
  8427. }
  8428. #endif /* |DEBUG| */
  8429.  
  8430. ;
  8431.  
  8432. {
  8433. in_prototype= indented= NO;
  8434.  
  8435. WHILE()
  8436. {
  8437.  
  8438.  
  8439. if(lo_ptr<pp+3)
  8440. {
  8441. while(hi_ptr<=scrp_ptr&&lo_ptr!=pp+3)
  8442. {
  8443. (++lo_ptr)->cat= hi_ptr->cat;lo_ptr->mathness= (hi_ptr)->mathness;
  8444. lo_ptr->trans= (hi_ptr++)->trans;
  8445. }
  8446.  
  8447. for(i= lo_ptr+1;i<=pp+3;i++)i->cat= 0;
  8448. }
  8449.  
  8450. ;
  8451.  
  8452. if(tok_ptr+8>tok_m_end)
  8453. {
  8454. if(tok_ptr>mx_tok_ptr)mx_tok_ptr= tok_ptr;
  8455. OVERFLW("tokens","tw");
  8456. }
  8457.  
  8458. if(text_ptr+4>tok_end)
  8459. {
  8460. if(text_ptr>mx_text_ptr)mx_text_ptr= text_ptr;
  8461. OVERFLW("texts","x");
  8462. }
  8463.  
  8464. if(pp>lo_ptr)
  8465. break;
  8466.  
  8467.  
  8468. {
  8469. if(cat0==language_scrap)
  8470. {
  8471. language= lan_enum(get_language(pp->trans));/* Get language from \
  8472. language~\#. */
  8473. ini0_language();/* Reset params like |auto_semi|. */
  8474. SQUASH(pp,1,ignore_scrap,-1,0);
  8475. }
  8476. else if(cat1==ignore_scrap)SQUASH(pp,2,cat0,-2,0);/*Gobble an |ignore_scrap|. */
  8477. else switch(language)
  8478. {
  8479. case NO_LANGUAGE:
  8480. CONFUSION("match production","Language isn't defined");
  8481.  
  8482. case C:
  8483. case C_PLUS_PLUS:
  8484. C_productions();
  8485. break;
  8486.  
  8487. case RATFOR:
  8488. case RATFOR_90:
  8489. if(!RAT_OK("(translate)"))
  8490. CONFUSION("match production",
  8491. "Language shouldn't be Ratfor here");
  8492.  
  8493. case FORTRAN:
  8494. case FORTRAN_90:
  8495. R_productions();
  8496. break;
  8497.  
  8498. case LITERAL:
  8499. V_productions();
  8500. break;
  8501.  
  8502. case TEX:
  8503. X_productions();
  8504. break;
  8505.  
  8506. case NUWEB_OFF:
  8507. case NUWEB_ON:
  8508. CONFUSION("match a production","Invalid language");
  8509. }
  8510.  
  8511. pp++;/* if no match was found, we move to the right and try again. */
  8512. }
  8513.  
  8514. ;
  8515. ini_mathness= cur_mathness= last_mathness= maybe_math;
  8516. }
  8517. }
  8518.  
  8519.  
  8520.  
  8521. {
  8522. EXTERN int math_flag;
  8523.  
  8524.  
  8525.  
  8526. #ifdef DEBUG
  8527. {
  8528. scrap_pointer scrap0= scrp_base;
  8529.  
  8530. while(scrap0->cat==ignore_scrap)scrap0++;
  8531.  
  8532. if(lo_ptr>scrap0&&tracing==1)
  8533. {
  8534. CLR_PRINTF(warning,
  8535. ("\nIrreducible scrap sequence in %s:",
  8536. MOD_TRANS(module_count)));
  8537. mfree();
  8538. mark_harmless;
  8539.  
  8540. for(j= scrap0;j<=lo_ptr;j++)
  8541. {
  8542. printf(" ");prn_cat(j->cat);
  8543. }
  8544. }
  8545. }
  8546. #endif /* |DEBUG| */
  8547.  
  8548. ;
  8549.  
  8550. for(j= scrp_base;j<=lo_ptr;j++)
  8551. {
  8552. if(j!=scrp_base)app(040);/* Separate scraps by blanks. */
  8553.  
  8554. if((j->mathness%4==yes_math)&&math_flag==NO)app(044);
  8555.  
  8556. if((j->mathness%4==no_math)&&math_flag==YES)
  8557. {app(040);app(044);}
  8558.  
  8559. app1(j);
  8560.  
  8561. if((j->mathness/4==yes_math)&&math_flag==NO)app(044);
  8562.  
  8563. if((j->mathness/4==no_math)&&math_flag==YES)
  8564. {app(044);app(040);}
  8565.  
  8566. if(tok_ptr+6>tok_m_end)OVERFLW("tokens","tw");
  8567. }
  8568.  
  8569. freeze_text;
  8570. }
  8571.  
  8572. ;
  8573.  
  8574. language= saved_language;
  8575. return text_ptr-1;
  8576. }
  8577.  
  8578.  
  8579. #endif /* Part 2 */
  8580.  
  8581.  
  8582.  
  8583.  
  8584.  
  8585.  
  8586.  
  8587.  
  8588.